--- nfo/perl/scripts/dispatchmail/bin/dispatchmail	2003/01/22 07:16:51	1.3
+++ nfo/perl/scripts/dispatchmail/bin/dispatchmail	2003/01/22 17:50:56	1.4
@@ -7,10 +7,13 @@
 #    with the Perl-module "Mail::Audit" 
 #    available from CPAN.
 #
-#  $Id: dispatchmail,v 1.3 2003/01/22 07:16:51 root Exp $
+#  $Id: dispatchmail,v 1.4 2003/01/22 17:50:56 root Exp $
 #
 # ============================================================
 #  $Log: dispatchmail,v $
+#  Revision 1.4  2003/01/22 17:50:56  root
+#  - refactored most code to Mail::Audit::Dispath
+#
 #  Revision 1.3  2003/01/22 07:16:51  root
 #  + sub traceEntry
 #  + further refactorings
@@ -23,219 +26,38 @@
 use strict;
 # don't use warnings;
 
-use Mail::Audit;
 use Data::Dumper;
 use Getopt::Long;
-
+use Hash::Merge qw( merge );
 
 use lib qw( /data/libs/nfo/perl/libs );
-use org::netfrag::shortcuts qw( now );
-
+use Mail::Audit::Dispatch;
 
 
 # - - - - - - - - - - - - - - - - - - - -
 #               options
 # - - - - - - - - - - - - - - - - - - - -
-my $opt_base      = '';
-my $opt_rulesfile = '';
-GetOptions(
-  'base=s'  => \$opt_base,
-  'rules=s' => \$opt_rulesfile,
-);
-$opt_base ||= $ENV{HOME};
-$opt_base ||= $ENV{PWD};
-
-my $LOG     = 1;	# writes reports to logfile
-my $VERBOSE = 1;	# writes reports to STDOUT
-my $TRACE   = 1;	# writes contents of messages to logfile
-
-# - - - - - - - - - - - - - - - - - - - -
-#
-#                targets
-#
-#  declare and initialize some variables
-#      these are mostly base paths
-#      mail should be delivered to
-#
-# - - - - - - - - - - - - - - - - - - - -
-my $USER      = $ENV{USER};
-my $HOME      = $opt_base;
-my $MAILDIR   = "$HOME/Mail";
-my $RULESFILE = "$HOME/.dispatchmailrc.pm";
-#my $LOCKFILE  = "$HOME/.procmail.lockfile";
-my $LOCKFILE  = "$HOME/.dispatchmail.lockfile";
-my $LOGFILE   = "$MAILDIR/.dispatchmail.log";
-my $DEFAULT   = "$MAILDIR/Inbox";
-
-# override settings
-  # override $RULESFILE if given as option on the command line
-  $RULESFILE = $opt_rulesfile if ($opt_rulesfile);
-  # change logfile
-  $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
-
-  $USER ||= '';
-
-
-
-# - - - - - - - - - - - - - - - - - - - -
-#                 main
-# - - - - - - - - - - - - - - - - - - - -
-
-  # "jump" into processing of new incoming mail and get a "handler" to this mail
-  my $incoming = Mail::Audit->new;
-
-  sub traceEntry {
-    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
-    s2f("From:    " . gchomp($incoming->from));
-    s2f("To:      " . gchomp($incoming->to));
-    s2f("Subject: " . gchomp($incoming->subject));
-    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
-  }
-
-
-  # 0.a. pre flight tracing
-    my $now = now();
-    report("$0 running at $now for user '$USER'.");
-    traceEntry() if $TRACE;
-
-  # 0.b. pre flight checks
-
-     # TODO: check if $HOME is empty
-
-     # check if $HOME exists
-     if (! -e $MAILDIR) {
-       my $msg = "delivery failed, base directory $MAILDIR does not exist";
-       report($msg);
-       forward_delivery();
-     }
-
-  # 1. include rules or fallback
-    # check if $RULESFILE exists
-    if (-f $RULESFILE) {
-      report("Loading rules from \"$RULESFILE\".");
-      require $RULESFILE;
-    } else {
-      #die("$RULESFILE doesn't exist");
-      report("Configured rulesfile \"$RULESFILE\" doesn't exist.");
-      forward_delivery();
-    }
-
-  # 2. export required stuff to rules namespace
-    export_symbols();
-
-  # 3. run dispatcher
-    report("Running \"rules::dispatch\".");
-    rules::dispatch();
-
-  # 4. dispatcher didn't do anything
-    report("dispatcher could not apply any filter, using default delivery");
-
-    # the default-handler: simply accept all mails and route them to "/var/spool/mail"
-    # $incoming->accept();
-
-    # if you want to reject all mails coming through to here, do a ...
-    # $incoming->reject;
-
-    # catch all mails and route them to a "DEFAULT"-inbox
-    jaccept($DEFAULT);
-
-
 
+my $defaults = {
+  LOG     => 1,		# writes reports to logfile
+  VERBOSE => 1,		# writes reports to STDOUT
+  TRACE   => 1,		# writes contents of messages to logfile
+};
 
+my $args;
+GetOptions(
+  'user=s'  => \$args->{user},
+  'base=s'  => \$args->{base},
+  'rules=s' => \$args->{rules},
+);
 
-  # - - - - - - - - - - - - - - - - - - - -
-  #          tracing & reporting
-  # - - - - - - - - - - - - - - - - - - - -
-  sub s2f {
-    my $str = shift;
-    open(FH, '>>' . $LOGFILE);
-    print FH $str, "\n";
-    close(FH);
-  }
-
-  sub report {
-    my $msg = shift;    
-    # TODO: tracing, debugging
-
-    print $msg, "\n" if $VERBOSE;
-    if ($LOG) {
-      s2f($msg);
-    }
-
-  }
-
-  # - - - - - - - - - - - - - - - - - - - -
-  #             processing mail
-  # - - - - - - - - - - - - - - - - - - - -
-
-  sub compareTarget {
-    my $pattern = shift;
-    my $ok = 0;
-    $ok = 1 if ($incoming->to =~ m/$pattern/);
-    $ok = 1 if ($incoming->cc =~ m/$pattern/);
-    $ok = 1 if ($incoming->bcc =~ m/$pattern/);
-    return $ok;
-  }
-
-  sub jaccept {
-    my $deliver_to = shift;
-    
-    report("ACCEPT: $deliver_to");
-
-    # check deliver_to path
-    if (! -e $deliver_to) {
-      report("deliver_to path \"$deliver_to\" doesn't exist");
-      forward_delivery();
-      return;
-    }
-
-    $incoming->accept($deliver_to);
-  }
-
-  sub accept_spool {
-    my $path = "/var/spool/mail/$USER";
-    report("defaulting to spool delivery ($path)");
-    $incoming->accept($path);
-  }
-
-  sub forward_delivery {
-    report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
-    $incoming->accept;
-  }
+my $args_dispatch = merge($defaults, $args);
 
+#print Dumper($args_dispatch);
+#exit;
 
-# - - - - - - - - - - - - - - - - - - - -
-#             helper functions
-# - - - - - - - - - - - - - - - - - - - -
+my @args_array = %$args_dispatch;
+my $dispatcher = Mail::Audit::Dispatch->new(@args_array);
+$dispatcher->run();
 
-sub get_coderef {
-  my $codepack = shift;
-  my $method = shift;
-  $codepack || return '[error]';
-  $method ||= '';
-  $method && ($codepack .= '::');
-  return eval '\&' . $codepack . $method . ';';
-}
-
-sub export_symbols {
-  #  my $callpack = 'rules';
-  #  my @EXPORT = qw( incoming subject MAILDIR jaccept );
-  #  foreach my $sym (@EXPORT) {
-      no strict 'refs';
-  #    *{"${callpack}::$sym"} = get_coderef('main', $sym);
-  #  }
-  {
-    no strict 'refs';
-    *{"rules::jaccept"}       = get_coderef('main', 'jaccept');
-    *{"rules::report"}        = get_coderef('main', 'report');
-    *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
-  }
-  $rules::MAILDIR  = $MAILDIR;
-  $rules::incoming = $incoming;
-}
-
-sub gchomp {
-  my $str = shift;
-  chomp($str);
-  return $str;
-}
+1;