1#!/usr/local/bin/perl
2
3# $Header: /mhub4/sources/imap-tools/maildir_to_imap.pl,v 1.5 2012/02/29 01:19:37 rick Exp $
4
5##########################################################################
6#   Program name    maildir_to_imap.pl                                   #
7#   Written by      Rick Sanders                                         #
8#                                                                        #
9#   Description                                                          #
10#                                                                        #
11#   maildir_to_imap is used to copy the messages in a maildir to a       #
12#   user's IMAP mailbox.  maildir_to_imap is executed like this:         #
13#                                                                        #
14#   ./maildir_to_imap.pl -i <user list> -D <imapserver[:port]>           #
15#                                                                        #
16#   The user list is a file with one or more entries containing the      #
17#   location of the user's maildir and his IMAP username and password.   #
18#                                                                        #
19#   For example:                                                         #
20#         /mhub4/maildirs/rwilson@abc.net,rich.wilson,welcome            #
21#         /mhub4/maildirs/jane.eyre@abc.net,jane.eyre,mypass             #
22#                                                                        #
23#   See usage() for a list of arguments                                  #
24##########################################################################
25
26use IMAP::Utils;
27
28init();
29$debug = 1;
30get_user_list( \@users );
31migrate_user_list( \@users );
32
33exit;
34
35
36sub migrate_user_list {
37
38my $users = shift;
39
40  #  Migrate a set of users
41
42  foreach $userinfo ( @$users ) {
43     $usercount++;
44     ($user) = split(/\s*,\s*/, $userinfo);
45     Log("migrate $user");
46
47     #  Start the migration.  Unless maxChildren has been set to 1
48     #  fork off child processes to do the migration in parallel.
49
50     if ($maxChildren == 1) {
51	migrate ($userinfo, $imaphost);
52     } else {
53  	Log("There are $children running") if $debug;
54  	if ( $children < $maxChildren ) {
55   	   Log("   Forking to migrate $user") if $debug;
56     	   if ( $pid = fork ) {	# Parent
57	      Log ("   Parent $$ forked $pid") if $debug;
58     	   } elsif (defined $pid) {	# Child
59	      Log ("  Child process $$ processing $sourceUser") if $debug;
60              migrate($userinfo, $imaphost);
61              Log("   $user is done");
62              exit 0;
63     	   } else {
64              Log("Error forking child to migrate $user");
65              next;
66     	   }
67     	   $children++;
68     	   $children{$pid} = $user;
69  	}
70
71  	Log ("I'm PID $$") if $debug;
72  	while ( $children >= $maxChildren ) {
73     	   Log(" $$ - Max children running.  Waiting...") if $debug;
74     	   $foundPid = wait;	# Wait for a child to terminate
75	   if ($? != 0) {
76	      Log ("ERROR: PID $foundPid exited with status $?");
77	   }
78	   delete $children{$foundPid};
79     	   $children--;
80  	}
81  	Log("OK to launch another user migration") if $debug;
82  }
83
84}
85}
86
87sub xxxx {
88
89   if ($maxChildren > 1) {
90      Log("All children have been launched, waiting for them to finish");
91      foreach $pid ( keys(%children) ) {
92         $user = $children{$pid};
93         Log("Waiting on process $pid ($user) to finish");
94         waitpid($pid, 0);
95         if ($? != 0) {
96            Log ("ERROR: PID $pid exited with status $?");
97         }
98      }
99   }
100}
101
102
103sub    sum {
104summarize();
105$elapsed = sprintf("%.2f", (time()-$start)/3600);
106Log("Elapsed time  $elapsed hours");
107Log("Migration completed");
108exit;
109}
110
111sub migrate {
112
113my $userinfo = shift;
114my $imaphost = shift;
115
116   my ($user,$pwd,$userpath) = split(/,/, $userinfo);
117
118   return unless connectToHost($imaphost, \$dst);
119   return unless login($user,$pwd, $dst);
120
121   get_maildir_folders( $userpath, \%folders );
122
123   my $messages;
124   foreach $maildir_folder ( keys %folders ) {
125      print STDERR "maildir_folder $maildir_folder\n";
126      $maildir_folder =~ s/\&/&-/;   # Encode the '&' char
127      $maildir_folder =~ s/\s+$//;
128      $folder_path = $folders{"$maildir_folder"};
129      createMbx( $maildir_folder, $dst ) unless mbxExists( $maildir_folder, $dst );
130
131      get_maildir_msgs( $folder_path, \@msgs );
132      my $msgcount = $#msgs + 1;
133      Log("     $maildir_folder ($msgcount msgs) $folder_path");
134
135      next if !@msgs;
136
137      $inserted=0;
138      foreach $msgfn ( @msgs ) {
139         $inserted++ if insert_msg( $msgfn, $maildir_folder, $dst );
140      }
141      Log("     Inserted $inserted messages into $maildir_folder\n");
142   }
143
144   $conn_timed_out=0;
145
146}
147
148sub init {
149
150use Getopt::Std;
151use Fcntl;
152use Socket;
153use IO::Socket;
154use sigtrap;
155use FileHandle;
156require "ctime.pl";
157
158   $start = time();
159
160   #  Set up signal handling
161   $SIG{'ALRM'} = 'signalHandler';
162   $SIG{'HUP'}  = 'signalHandler';
163   $SIG{'INT'}  = 'signalHandler';
164   $SIG{'TERM'} = 'signalHandler';
165   $SIG{'URG'}  = 'signalHandler';
166
167   getopts('H:i:L:n:ht:M:SLdD:Um:I');
168
169   # usage() if $opt_h;
170   #  usage();
171
172   $userlist     = $opt_i;
173   $logfile      = $opt_L;
174   $maxChildren  = $opt_n;
175   $usage        = $opt_h;
176   $timeout      = $opt_t;
177   $imaphost     = $opt_H;
178   $imaphost     = $opt_D;
179   $mbxList      = $opt_m;
180   $debug=1      if $opt_d;
181   $showIMAP=1   if $opt_I;
182
183   $timeout = 45 unless $timeout;
184   $maxChildren = 1 unless $maxChildren;
185
186   IMAP::Utils::init();
187   $logfile = "maildir_to_imap.log" unless $logfile;
188   openLog($logfile);
189   Log("$0 starting");
190
191   $date = ctime(time);
192   chomp($date);
193
194}
195
196sub usage {
197
198   print "\nUsage:  iu-maildirtoimap -i <users> -D imapHost\n\n";
199   print "Optional arguments:\n\n";
200   print " -i <file of usernames>\n";
201   print " -n <number of simultaneous migration processes to run>\n";
202   print " -m <list of mailboxes> eg Inbox,Drafts,Sent\n";
203   print " -L <logfile, default is maildir_to_imap.log>\n";
204   print " -t <timeout in seconds>\n";
205   print " -d debug mode\n";
206   print " -I record IMAP protocol exchanges\n\n";
207   exit;
208
209}
210
211
212sub format_bytes {
213
214my $bytes = shift;
215
216   #  Format the number nicely
217
218   if ( length($bytes) >= 10 ) {
219      $bytes = $bytes/1000000000;
220      $tag = 'GB';
221   } elsif ( length($bytes) >= 7 ) {
222      $bytes = $bytes/1000000;
223      $tag = 'MB';
224   } else {
225      $bytes = $bytes/1000;
226      $tag = 'KB';
227   }
228
229   # commafy
230   $_ = $bytes;
231   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
232   $bytes = sprintf("%.2f", $_) . " $tag";
233
234   return $bytes;
235}
236
237
238sub commafy {
239
240my $number = shift;
241
242   $_ = $number;
243   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
244   $number = $_;
245
246   return $number;
247}
248
249#  Reconnect to a server after a timeout error.
250#
251sub reconnect {
252
253my $checkpoint = shift;
254my $conn = shift;
255
256   Log("This is reconnect, conn is $conn") if $debug;
257   logout( $conn );
258   close $conn;
259   sleep 5;
260   ($mbx,$shost,$suser,$spwd,$dhost,$duser,$dpwd) = split(/\|/, $checkpoint);
261   if ( $conn eq $src ) {
262      $host = $shost;
263      $user = $suser;
264      $pwd  = $spwd;
265   } else {
266      $host = $dhost;
267      $user = $duser;
268      $pwd  = $dpwd;
269   }
270   connectToHost($host,$conn);
271   login($user,$pwd,$conn);
272   selectMbx( $mbx, $conn );
273   createMbx( $mbx, $dst );   # Just in case
274   Log("leaving reconnect");
275}
276
277#  Handle signals
278
279sub signalHandler {
280
281my $sig = shift;
282
283   if ( $sig eq 'ALRM' ) {
284      Log("Caught a SIG$sig signal, timeout error");
285      $conn_timed_out = 1;
286   } else {
287      Log("Caught a SIG$sig signal, shutting down");
288      exit;
289   }
290}
291
292#  Get the total message count and bytes and write
293#  it to the log.
294
295sub summarize {
296
297   #  Each child appends its totals to /tmp/migrateEmail.sum so
298   #  we read the lines and add up the grand totals.
299
300   $totalUsers=$totalMsgs=$totalBytes=0;
301   open(SUM, "</tmp/migrateIMAP.sum");
302   while ( <SUM> ) {
303      chomp;
304      ($msgs,$bytes) = split(/\|/, $_);
305      $totalUsers++;
306      $totalMsgs  += $msgs;
307      $totalBytes += $bytes;
308   }
309
310   $_ = $totalMsgs;
311   1 while s/^([-+]?\d+)(\d{3})/$1,$2/;  #  Commafy the message total
312   $totalMsgs = $_;
313   $totalBytes = formatBytes( $totalBytes );
314
315   Log("Summary of migration");
316   Log("Migrated $totalUsers users, $totalMsgs messages, $totalBytes.");
317
318}
319
320sub fix_ts {
321
322my $date = shift;
323
324   #  Make sure the hrs part of the date is 2 digits.  At least
325   #  one IMAP server expects this.
326
327   $$date =~ s/^\s+//;
328   $$date =~ /(.+) (.+):(.+):(.+) (.+)/;
329   my $hrs = $2;
330
331   return if length( $hrs ) == 2;
332
333   my $newhrs = '0' . $hrs if length( $hrs ) == 1;
334   $$date =~ s/ $hrs/ $newhrs/;
335
336}
337
338sub stats {
339
340   print "\n";
341   print "Users migrated   $users\n";
342   print "Total messages   $total_msgs\n";
343   print "Total bytes      $total_bytes\n";
344
345   $elapsed = time() - $start;
346   $minutes = $elapsed/60;
347   print "Elapsed time     $minutes minutes\n";
348
349}
350
351sub processArgs {
352
353   if ( !getopts( "" ) ) {
354      usage();
355   }
356}
357
358#  Handle signals
359
360sub signalHandler {
361
362my $sig = shift;
363
364   if ( $sig eq 'ALRM' ) {
365      Log("Caught a SIG$sig signal, timeout error");
366      $conn_timed_out = 1;
367   } else {
368      Log("Caught a SIG$sig signal, shutting down");
369      exit;
370   }
371   Log("Resuming");
372}
373
374sub insert_msg {
375
376my $msgfn   = shift;
377my $folder  = shift;
378my $dst     = shift;
379
380   #  Put a message in the user's folder
381
382#  Log("insert $msgfn into $folder") if $debug;
383
384   my $flag = 'Unseen';
385   if ( $msgfn =~ /,/ ) {
386      $flag = '\\Seen' if $msgfn =~ /,S$/;
387   }
388
389   if ( !open(MESSAGE, "<$msgfn")) {
390      Log( "    Can't open message fn $msgfn: $!" );
391      return 0;
392   }
393   my ($date,$message,$msgid);
394   while( <MESSAGE> ) {
395       chomp;
396       # print STDERR "message line $_\n";
397       if ( /^Date: (.+)/ and !$date ) {
398          $date = $1;
399       }
400       if ( /^Message-Id: (.+)/i and !$msgid ) {
401          $msgid = $1;
402          Log("msgid $msgid") if $debug;
403       }
404       $message .= "$_\r\n";
405   }
406   close MESSAGE;
407
408   fix_date( \$date );
409
410   $status = insert_imap_msg( $dst, $folder, \$message, $flag, $date );
411
412   return $status;
413
414}
415
416sub entry_exists {
417
418my $mail  = shift;
419my $ldap  = shift;
420my $pwd   = shift;
421my $dn;
422my $i;
423
424   my $attrs = [ 'mailpassword' ];
425   my $base = 'o=site';
426   my $filter = "mail=$mail";
427
428   my $result = $ldap->search(
429            base   => $base,
430            filter => $filter,
431            scope  => "subtree",
432            attrs  => $attrs
433   );
434
435   if ( $result->code ) {
436      my $error = $result->code;
437      my $errtxt = ldap_error_name( $result->code );
438      Log("Error searching for $filter: $errtxt");
439      exit;
440   }
441
442   my @entries = $result->entries;
443   my $i = $#entries + 1;
444
445   $entry = $entries[0];
446   $$pwd = $entry->get_value( 'mailpassword' );
447
448   return $i;
449}
450
451sub get_user_list {
452
453my $users    = shift;
454
455   #  Build a list of the users and their maildirs
456
457   open(F, "<$userlist") or die "Can't open user list $userlist: $!";
458   while( <F> ) {
459      chomp;
460      s/^\s+//;
461      next if /^#/;
462      next unless $_;
463      my( $maildir,$user,$pwd) = split(/,/, $_);
464      push( @$users, "$user,$pwd,$maildir" );
465   }
466   close F;
467
468}
469
470#
471#  $response = readResponse
472#
473#  This subroutine reads and formats an IMAP protocol response from an
474#  IMAP server on a specified connection.
475#
476
477sub readResponse {
478
479my $fd = shift;
480
481   exit unless defined $fd;
482   $response = <$fd>;
483   chop $response;
484   $response =~ s/\r//g;
485   push (@response,$response);
486   Log ("<< *** Connection timeout ***") if $conn_timed_out;
487   Log ("<< $response") if $showIMAP;
488   return $response;
489}
490
491sub getMailboxList {
492
493my $user = shift;
494my $conn = shift;
495my @mbxs;
496my @mailboxes;
497
498   #  Get a list of the user's mailboxes
499   #
500  if ( $mbxList ) {
501      #  The user has supplied a list of mailboxes so only processes
502      #  the ones in that list
503      @mbxs = split(/,/, $mbxList);
504      foreach $mbx ( @mbxs ) {
505         trim( *mbx );
506         push( @mailboxes, $mbx );
507      }
508      return @mailboxes;
509   }
510
511   if ($debug) { Log("Get list of user's mailboxes",2); }
512
513   sendCommand ($conn, "1 LIST \"\" *");
514   undef @response;
515   while ( 1 ) {
516	$response = readResponse ($conn);
517	if ( $response =~ /^1 OK/i ) {
518		last;
519	}
520	elsif ( $response !~ /^\*/ ) {
521		Log ("unexpected response: $response");
522		return 0;
523	}
524   }
525
526   undef @mbxs;
527
528   for $i (0 .. $#response) {
529        $response[$i] =~ s/\s+/ /;
530        if ( $response[$i] =~ /"$/ ) {
531           $response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i;
532           $mbx = $3;
533        } else {
534           $response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i;
535           $mbx = $3;
536        }
537	$mbx =~ s/^\s+//;  $mbx =~ s/\s+$//;
538
539	if ($response[$i] =~ /NOSELECT/i) {
540		if ($debug) { Log("$mbx is set NOSELECT,skip it",2); }
541		next;
542	}
543	if (($mbx =~ /^\#/) && ($user ne 'anonymous')) {
544		#  Skip public mbxs unless we are migrating them
545		next;
546	}
547	if ($mbx =~ /^\./) {
548		# Skip mailboxes starting with a dot
549		next;
550	}
551	push ( @mbxs, $mbx ) if $mbx ne '';
552   }
553
554   if ( $mbxList ) {
555      #  The user has supplied a list of mailboxes so only processes
556      #  those
557      @mbxs = split(/,/, $mbxList);
558   }
559
560   return @mbxs;
561}
562
563#  getMsgList
564#
565#  Get a list of the user's messages in the indicated mailbox on
566#  the source host
567#
568sub getMsgList {
569
570my $mailbox = shift;
571my $msgs    = shift;
572my $conn    = shift;
573my $seen;
574my $empty;
575my $msgnum;
576my $from;
577my $flags;
578
579   @$msgs  = ();
580   trim( *mailbox );
581   sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
582   undef @response;
583   $empty=0;
584   while ( 1 ) {
585	$response = readResponse ( $conn );
586	if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
587	if ( $response =~ /^1 OK/i ) {
588		# print STDERR "response $response\n";
589		last;
590	}
591	elsif ( $response !~ /^\*/ ) {
592		Log ("unexpected response: $response");
593		# print STDERR "Error: $response\n";
594		return 0;
595	}
596   }
597
598   if ( $empty ) {
599      Log("$mailbox is empty");
600      return;
601   }
602
603   Log("Fetch the header info") if $debug;
604
605   sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])");
606   undef @response;
607   while ( 1 ) {
608	$response = readResponse ( $conn );
609	return if $conn_timed_out;
610	if ( $response =~ /^1 OK/i ) {
611	   last;
612	} elsif ( $response =~ /could not be processed/i ) {
613           Log("Error:  response from server: $response");
614           return;
615        } elsif ( $response =~ /^1 NO|^1 BAD/i ) {
616           return;
617        }
618   }
619
620   $flags = '';
621   for $i (0 .. $#response) {
622	$seen=0;
623	$_ = $response[$i];
624
625	last if /OK FETCH complete/;
626
627        if ($response[$i] =~ /FLAGS/) {
628           #  Get the list of flags
629           $response[$i] =~ /FLAGS \(([^\)]*)/;
630           $flags = $1;
631           $flags =~ s/\\Recent//;
632        }
633
634        if ( $response[$i] =~ /INTERNALDATE/) {
635           $response[$i] =~ /INTERNALDATE (.+) BODY/;
636           # $response[$i] =~ /INTERNALDATE "(.+)" BODY/;
637           $date = $1;
638
639           $date =~ /"(.+)"/;
640           $date = $1;
641           $date =~ s/"//g;
642        }
643
644        if ( $response[$i] =~ /\* (.+) FETCH/ ) {
645           ($msgnum) = split(/\s+/, $1);
646        }
647
648        if ( $msgnum && $date ) {
649           if ( $unseen ) {
650	      push (@$msgs,"$msgnum|$date|$flags") unless $flags =~ /Seen/i;
651           } else {
652	      push (@$msgs,"$msgnum|$date|$flags");
653           }
654           $msgnum = $date = '';
655        }
656   }
657
658}
659
660#  insert_imap_msg
661#
662#  This routine inserts an RFC822 message into a user's folder
663#
664sub insert_imap_msg {
665
666my $conn    = shift;
667my $mbx     = shift;
668my $message = shift;
669my $flags   = shift;
670my $date    = shift;
671my ($lsn,$lenx);
672
673   $lenx = length($$message);
674   Log("   Inserting message") if $debug;
675   Log("message size $lenx bytes");
676
677   $date =~ s/\((.+)\)//;
678   $date =~ s/\s+$//g;
679
680   $totalBytes = $totalBytes + $lenx;
681   $totalMsgs++;
682
683   #  Create the mailbox unless we have already done so
684   if ($destMbxs{"$mbx"} eq '') {
685      createMbx( $mbx, $conn );
686   }
687   $destMbxs{"$mbx"} = '1';
688
689   $flags =~ s/\\Recent//i;
690   $flags =~ s/Unseen//i;
691
692   if ( $date ) {
693      sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}");
694   } else {
695      sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}");
696   }
697
698   $response = readResponse ($conn);
699   if ($conn_timed_out) {
700       Log ("unexpected response timeout appending message");
701       push(@errors,"Error appending message to $mbx for $user");
702       return 0;
703   }
704
705   if ( $response !~ /^\+/ ) {
706       Log ("unexpected APPEND response: >$response<");
707       # next;
708       push(@errors,"Error appending message to $mbx for $user");
709       return 0;
710   }
711
712   print $conn "$$message\r\n";
713
714   undef @response;
715   while ( 1 ) {
716       $response = readResponse ($conn);
717       if ( $response =~ /^1 OK/i ) {
718	   last;
719       }
720       elsif ( $response !~ /^\*/ ) {
721	   Log ("Unexpected APPEND response: >$response<");
722	   # next;
723	   return 0;
724       }
725   }
726
727   return 1;
728}
729
730sub get_maildir_folders {
731
732my $userpath = shift;
733my $folders  = shift;
734
735   #  Get a list of the user's folders
736
737   %$folders = ();
738
739   if ( $mbxList ) {
740      #  The user has supplied a list of mailboxes
741      foreach $mbx ( split(/,/, $mbxList ) ) {
742         $$folders{"$mbx"} = $userpath . '/.' . $mbx;
743      }
744      return;
745   }
746
747   opendir D, $userpath;
748   my @files = readdir( D );
749   closedir D;
750
751   $$folders{'INBOX'} = $userpath;
752   foreach $fn ( @files ) {
753      next if $fn eq '.';
754      next if $fn eq '..';
755      next unless $fn =~ /^\./;
756      my $fname = $fn;
757      $fname =~ s/\./\//;
758      $fname =~ s/^\///;
759      $$folders{"$fname"} = "$userpath/$fn";
760   }
761
762}
763
764sub get_maildir_msgs {
765
766my $path = shift;
767my $msgs = shift;
768my @subdirs = qw( tmp cur new );
769
770   @$msgs = ();
771   foreach $subdir ( @subdirs ) {
772      opendir D, "$path/$subdir";
773      my @files = readdir( D );
774      closedir D;
775
776      foreach $fn ( @files ) {
777         next if $fn =~ /^\./;
778         my $msgfn = "$path/$subdir/$fn";
779         push( @$msgs, $msgfn );
780      }
781   }
782
783}
784
785sub imap_message_exists {
786
787my $msgid = shift;
788my $conn  = shift;
789my $msgnum;
790my $loops;
791
792   # Search a mailbox on the server for a message by its msgid.
793
794   Log("   Search for $msgid") if $debug;
795   sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\"");
796   while (1) {
797        $response = readResponse ($conn);
798        if ( $response =~ /\* SEARCH /i ) {
799           ($dmy, $msgnum) = split(/\* SEARCH /i, $response);
800           ($msgnum) = split(/ /, $msgnum);
801        }
802
803        last if $response =~ /^1 OK|^1 NO|^1 BAD/;
804        last if $response =~ /complete/i;
805
806        last if $loops++ > 10;
807   }
808
809   if ( $debug ) {
810      Log("$msgid was not found") unless $msgnum;
811   }
812
813   return $msgnum;
814}
815
816sub fix_date {
817
818my $date = shift;
819
820   #  Try to make the date acceptable to IMAP
821
822   return if $$date eq '';
823   fix_ts( $date );
824
825   $$date =~ s/\((.+)\)$//;
826   $$date =~ s/\s+$//g;
827
828   if ( $$date =~ /\s*,\s*/ ) {
829      ($dow,$$date) = split(/\s*,\s*/, $$date);
830   }
831   $$date =~ s/ /-/;
832   $$date =~ s/ /-/;
833
834   return;
835
836   my @terms = split(/\s+/, $$date);
837
838   if ( $terms[0] =~ /(.+),/ ) {
839      my $dow = $1;
840      if ( length( $dow ) > 3 ) {
841         #  Day of week can't be more than 3 chars
842         my $DOW = substr($dow,0,3);
843         $$date =~ s/$dow/$DOW/;
844      }
845   }
846
847   if ( $terms[1] =~ /jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec/i ) {
848      #  The month and day are swapped.
849      my $temp = $terms[1];
850      $terms[1] = $terms[2];
851      $terms[2] = $temp;
852   }
853
854   if ( $terms[5] =~ /\((.+)\)/ ) {
855      #  The date is missing the TZ offset
856      $terms[5] = "+0000 ($1)";
857   }
858
859   if ( $terms[5] =~ /"(.+)"/ ) {
860      #  The TZ code has quotes instead of parens
861      $terms[5] =~ s/"/\(/;
862      $terms[5] =~ s/"/\)/;
863      $terms[5] = "+0000 $terms[5]";
864   }
865
866   if ( $terms[5] =~ /-[0-9]-[0-9][0-9]/ ) {
867      #  Lots of dates are like '-0-500'
868      $terms[5] =~ s/-//g;
869      $terms[5] = '-' . $terms[5];
870   }
871
872   if ( $terms[5] eq '-0-100' ) {
873      #  Don't know what this is supposed to mean
874      $terms[5] = "+0000";
875   }
876
877   if ( $terms[5] eq '00800' ) {
878      $terms[5] = "+0800";
879   }
880
881   if ( $terms[5] eq '-' ) {
882      $terms[5] .= $terms[6];
883      $terms[5] =~ s/\s+//g;
884      $terms[6] = '';
885   }
886   if ( $terms[4] =~ /\./ ) {
887      $terms[4] =~ s/\./:/g;
888   }
889
890   if ( $terms[5] =~ /[a-zA-Z]/ ) {
891      $terms[5] = "-0000 ($terms[5])" unless $terms[5] eq 'UT';
892   }
893
894   $$date = join( " ", @terms );
895
896}
897
898