[MacPerl] VCard - Seek and destroy script

[Vicki Brown <vlb@cfcl.com>]

I finally got tired enough of all the #^@&!* .vcf files that people keep
"sending" me that I wrote this. I was going to ask the list if anyone had
such a script; I haven't had much time to write any code lately... then I
thought "Sheesh, I should be able to write this! It can't be that hard." It
wasn't, although I needed some help with finding the System Folder and with
selecting a folder (I couldn't leave it hard wired to the Attachments folder).

If you don't use Eudora, your mileage may vary but if you put in the default
folder where Attachments go you should be OK. Or just let it prompt you.

I'd put this on the MacPerl pages under Cool Code Submissions but, um, er,
I'm the person who installs those and I am Soooooo behind. Any volunteers?
Sigh.

I think I fixed all the lines that might wrap in email.

- Vicki

=== cut here ===
#! /usr/local/bin/perl -w
#
# killVCF
#
# written by Vicki Brown
#
# Delete VCard files in Eudora Attachments folder
# Default folder is "System Folder:Eudora Folder:Attachments Folder"
# or you can drop a folder, or change this default, or the script will prompt
#
#        1         2         3         4         5         6         7

#23456789012345678901234567890123456789012345678901234567890123456789012345678

#
# "Global" variables
#
use strict 'refs';
no strict 'subs';
no strict 'vars';

use File::Copy;
use File::Basename;
use Mac::Files;
use Mac::StandardFile;

#
# Global "constants"
#

# $RCSID = '$Id$';          # uncomment if used

#
# Global variables
#
use vars qw($verbose);
$verbose = 1;       # print stuff to the screen if ($verbose)

use vars qw($sysfile $eudorafldr $attachdir);
$sysfile = FindFolder(kOnSystemDisk, kSystemFolderType);
$eudorafldr = "$sysfile:Eudora Folder";
$attachdir = "$sysfile:Eudora Folder:Attachments Folder";  # As installed
$attachdir = "$sysfile:Eudora Folder:Attachments";  # localized

#
# Main
#
{
    # general setup...

    my $vcf_cnt = 0;    # count number of Vcards found

    if (@ARGV > 0) {
        $attachdir = shift; # drop a folder to override default
    # } else {
        # use default from above; if not found, script will prompt
    }


    # Open input directory
    if (-d "$attachdir") {
        # it exists (dropped or hardwired) and is a directory
        opendir(INDIR, "$attachdir") ||
          die "Oops, canot open $attachdir!\n";
    } elsif (-e "$attachdir") {
        # it exists but is not a directory
        die "$attachdir is not a folder!\n";
    } else {
        # ask the user
        $attachdir = get_folder(
          "Choose a folder to grovel.",
          $eudorafldr
          );

        if (-e "$attachdir") {
            opendir(INDIR, "$attachdir") ||
              die "Oops, cannot open $attachdir!\n";
        } else {
            die "Cannot open $attachdir!\n";
        }

    }

    print "Attachments are in $attachdir\n" if ($verbose);
    # loop over the list of files in the directory
    # while ($name = readdir(INDIR)) {
    @files = readdir(INDIR);
    close(INDIR);

    foreach $name (sort @files) {
        # Do stuff
            if ($name =~ /\.vcf$|\.vcf \d/) {
                $vcf_cnt++;
                print "$name\n" if ($verbose);
                unlink("$attachdir:$name");
            }

    } # while ($name = readdir(INDIR))
    closedir(INDIR);

    print "Found $vcf_cnt VCards.\n" if ($verbose);
    exit(0);

} # main block

sub get_folder {
    my($prompt, $default) = @_;
    my $nav = eval {require Mac::Navigation};
    $default = '' unless defined($default);
    if ($nav) {
        my($opt, $fold, $file);
        Mac::Navigation->import();
        $opt = NavGetDefaultDialogOptions();
        $opt->message($prompt);
        $fold = NavChooseFolder($default, $opt) or die $^E;
        $file = $fold->file(1);
        $file =~ s/:$//;
        $file;
    } else {
        require 'GUSI.ph';
        MacPerl::Choose(
          GUSI::AF_FILE(), 0, $prompt, '',
          GUSI::CHOOSE_DIR() +
              ($default ? GUSI::CHOOSE_DEFAULT() : 0),
          $default
        );
    }
}

__END__
--       |\      _,,,---,,_  Vicki Brown <vlb@cfcl.com>
-- ZZZzz /,`.-'`'    -.  ;-;;,_  P.O. Box 1269, San Bruno, CA 94066
--      |,4-  ) )-,_. ,\ (  `'-' http://www.cfcl.com/~vlb
--     '---''(_/--'  `-'\_) Journeyman Sourceror: Scripts & Philtres

# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org