WebSVN – sysadmin_scripts – Diff – /trunk/archiveIMAP/archiveIMAP

 # the default values for everything. These are overridden
 # by default values in the conf file (.yaml) or by individual
 # accounts entries.
 my $config = {
    'default' => {
+      # if set, most log stuff is sent to this file
+      'logfile' => '',
+      # defines the amount of crap which ends up in the logfile
+      'loglevel' => 4,
       # where the mail is going to
       'target' => {
                   # these have no defaults. They should be in the configuration file
                   # 'password' => 'password',
                   # 'username' => 'username',
       # if 0, will not be processed
       'enabled' => 1,
+   }
 };
+# prints to a log file, if defined. Otherwise, prints to STDOUT
+sub logit {
+   my $priority = shift;
+   return unless $priority <= $config->{'default'}->{'loglevel'};
+   if ( $config->{'default'}->{'logfile'} ) {
+      open( my $logfile, '>>', $config->{'default'}->{'logfile'} ) || die "Could not write to $config->{default}->{logfile}: $!\n";
+      while ( my $message = shift ) {
+         print $logfile "$message\n";
+      }
+      close( $logfile );
+   } else {
+      print STDOUT join( "\n", @_ ) . "\n";
+   }
+   return;
+} # logit
+#
 # find where the script is actually located as cfg should be there
+#
 sub getScriptLocation {
 # If folder has messages that match the criteria, move them to target
 # creates the target folder if necessary
+#
 sub processFolder {
    my ( $source, $target, $folder, $TESTING ) = @_;
-   #$dateBefore, $sourceDelimiter, $targetDelimiter, $deleteOnSuccess
-   print "\n=== Processing $folder\n";
+   &logit( 1, '', "=== Processing $folder" );
    my $sourceAccount = $source->{'connection'};
    my $targetAccount = $target->{'connection'};
    my $numMessages = 0;
    $sourceAccount->expunge_mailbox( $folder ); # clean it up so we don't copy deleted messages
    $sourceAccount->select( $folder ) or die "Could not connect to folder $folder\n"; # move into the correct folder for the source
    my @ids = $sourceAccount->search_sent_before( $source->{'before date'} ); # use sent_before to get the sent date from message
-   print "Found " . scalar( @ids ) . " messages to process\n";
    return 0 unless @ids; # we have nothing to copy, so exit
+   &logit( 3, "Found " . scalar( @ids ) . " messages to process" );
    # make life easier by precalculating some paths as array pointers
    my @sourceFolders = split( '\\' . $source->{'separator'}, $folder );
    my @pattern = split '\\^', $target->{'hierarchy'};
    $source->{'source folder list'} = \@sourceFolders;
    $target->{'hierachy pattern'} = \@pattern;
    # process each message to be done
    while ( my $id = shift ( @ids ) ) {
       # get the flags
       my @flags = $sourceAccount->msg_flags( $id );
       # get the message
-      my $message = $sourceAccount->get( $id ) or die $sourceAccount->errstr;
+      my $message = $sourceAccount->get( $id ) or die "Error getting message ID $id: $sourceAccount->errstr\n";
       # calculate where we are going to move this to
       my $targetFolder = &calculateTargetFolder( $message, $source, $target );
       if ( $TESTING ) {
-         print "Would have " . ( $source->{'deleteOnSuccess'} ? 'moved' : 'copied' )  . " message to $targetFolder\n";
+         &logit( 0, "Would have " . ( $source->{'deleteOnSuccess'} ? 'moved' : 'copied' )  . " message to $targetFolder" );
          next;
+      }
       if ( $target->{'connection'}->select( $targetFolder ) || &makeFolder( $target->{'connection'}, $targetFolder, $target->{'separator'} ) ) {
          if ( $target->{'connection'}->put( $targetFolder, $message, @flags ) ) {
             $source->{'connection'}->delete( $id ) if ( $source->{'deleteOnSuccess'} ) ;
 # fully qualified path with the correct delimiters
+#
 sub makeFolder {
    my ($imap, $folder, $delimiter) = @_;
-   #print "\n\t\tCreating folder $folder";
+   &logit( 3,  "\n\t\tCreating folder $folder" );
    # you must create the parent folder before creating the children
    my $escapedDelimiter = '\\' . $delimiter;
    my @folders = split( $escapedDelimiter, $folder );
    $folder = '';
    # take them from the left and, if they don't exist, create it
    while ( my $subdir = shift @folders ) {
       $folder .= $delimiter if $folder;
       $folder .= $subdir;
       next if $imap->select( $folder ); # already created, so look deeper in hierachy
-      print "\n\t\t\tCreating subfolder $folder";
+      &logit( 1, "\n\t\t\tCreating subfolder $folder" );
       $imap->create_mailbox( $folder ) || warn $imap->errstr();
       $imap->folder_subscribe( $folder ) || die $imap->errstr();
       unless ( $imap->select( $folder ) ) { # verify it was created
          warn "Unable to create $folder on target account\n";
          return 0;
    my $separator = $source->{'separator'};
    return 1 if $folder eq 'INBOX'; # do NOT mess with INBOX
    return 2 if $sourceAccount->select($folder) > 0; # do not mess with it if it still has messages in it
    return 3 if $sourceAccount->mailboxes( $folder . $separator . '*' ); # do not mess with it if it has subfolders
    return 4 if $source->{'system folders'}->{lc $folder}; # do not mess with system folders
-   print "\n\t\tDeleting empty folder $folder" . ( $TESTING ? ' Dry Run' : '' );
+   &logit( 1, "\n\t\tDeleting empty folder $folder" . ( $TESTING ? ' Dry Run' : '' ) );
-   return if $TESTING;
+   return 0 if $TESTING;
+   # select something other than the folder to be deleted
+   $sourceAccount->select( 'INBOX' );
-   $sourceAccount->folder_unsubscribe($folder);
+   if ( $sourceAccount->folder_unsubscribe($folder) ) {
-   $sourceAccount->delete_mailbox( $folder );
+      if ( $sourceAccount->delete_mailbox( $folder ) ) {
+         return 0;
+      } else {
+         warn "Error trying to delete mailbox $folder: " . $sourceAccount->errstr . "\n";
+      }
+   } else {
+      warn "Error trying to unsubscribe from $folder: " . $sourceAccount->errstr . "\n";
+   }
+   return 0;
+}
 # main process loop to handle one account
+#
    my $account = shift;
    return 0 unless $account->{'enabled'}; # blow it off if it is not enabled
    my $TESTING = $account->{'testing'}; # create mini global if we should test this account
-   print "========= Test Mode ========\n" if $TESTING;
+   &logit( 0, "========= Test Mode ========\n" ) if $TESTING;
    # open and log into both source and target, and get the separator used
    foreach my $acct ( 'target','source' ) {
       $account->{$acct}->{'connection'} = &openIMAPConnection( $account->{$acct}->{'server'}, $account->{$acct}->{'username'}, $account->{$acct}->{'password'} );
       unless ( $account->{$acct}->{'connection'} ) {
    my %temp = map{ lc($_) => 1 } @{$source->{'system'}};
    $source->{'system folders'} = \%temp;
    $source->{'before date'} = &getDate( $source->{'age'} );
-   print "\t" . ( $source->{'deleteOnSuccess'} ? 'Moving' : 'Copying' ) . " all messages before $source->{'before date'}\n";
+   &logit( 1, "\t" . ( $source->{'deleteOnSuccess'} ? 'Moving' : 'Copying' ) . " all messages before $source->{'before date'}" );
    # get a list of all folders to be processed on the source
    $source->{'folders'} = &getFolders( $source->{'connection'}, $source->{'ignore'}, $source->{'separator'} );
    if ( $TESTING ) {
       my $messages;
       $messages = &processFolder( $source, $target, $folder, $TESTING ); #, $date, $$source{'separator'}, $$target{'separator'}, $deleteOnSuccess );
       $TESTING ? print "Would expunge $folder\n" : $source->{'connection'}->expunge_mailbox( $folder );
       # delete folder if empty and client has requested it.
-      &deleteAFolder( $source, $folder, $TESTING ) if $account->{'source'}->{'deleteEmptyFolders'};
+      if ( $account->{'source'}->{'deleteEmptyFolders'} ) {
+         my $returnCode = &deleteAFolder( $source, $folder, $TESTING );
+         &logit( 3, "Return code from deleteAFolder is $returnCode" );
+      }
-      print "\n\t\t$messages processed\n";
+      &logit( 1,  "$messages processed" );
       $count += $messages;
       $processedCount++;
       # next line used only for testing. Dies after 5 folders on first account
       last if $processedCount > 5 and $TESTING;
+   }
 #                   Main                                              #
 #######################################################################
 # read and evaluate configuration file
 &readConfig() || die "could not load config file\n";
 #print Dumper( $config ); die;
 foreach my $account ( keys %{$config->{'accounts'}} ) {
     $config->{'accounts'}->{$account} = &fixupAccount( $config->{'default'}, $config->{'accounts'}->{$account} );
+}
 #die Dumper( $accounts );
 # now, process each in turn
 foreach my $account ( keys %$accounts ) {
    # talk to user
-   print "Processing account $account\n";
+   &logit( 1,  "Processing account $account" );
    # do the account. This is the main worker bee
    $accounts->{$account}->{'processed'} = &processAccount( $accounts->{$account} );
-   print "Done, $accounts->{$account}->{'processed'} messages copied\n";
+   &logit( 1,  "Done, $accounts->{$account}->{'processed'} messages copied" );
    $processed{'Accounts'}++;
    $processed{'Messages'} += $accounts->{$account}->{'processed'};
    # free up space we allocated since we stored a bunch of stuff in there, and we don't need it anymore
    $accounts->{$account} = undef;
 } # foreach loop
-print "$processed{'Accounts'} accounts processed, $processed{'Messages'} messages\n";
+&logit( 1, "$processed{Accounts} accounts processed, $processed{Messages} messages" );
 ;

Subversion Repositories sysadmin_scripts

(root)/trunk/archiveIMAP/archiveIMAP – Rev 57 → 58