maps/bin/importlist.cgi

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME $RCSfile: importlist.cgi,v $
   6
   7 Imports a white, black or null list into MAPS
   8
   9 =head1 VERSION
  10
  11 =over
  12
  13 =item Author
  14
  15 Andrew DeFaria <Andrew@DeFaria.com>
  16
  17 =item Revision
  18
  19 $Revision: 1.1 $
  20
  21 =item Created:
  22
  23 Mon Jan 16 20:25:32 PST 2006
  24
  25 =item Modified:
  26
  27 $Date: 2019/04/04 13:40:10 $
  28
  29 =back
  30
  31 =head1 SYNOPSIS
  32
  33  Usage; importlist.cgi [-usa|ge] [-h|elp] [-v|erbose] [-de|bug]
  34                        [-type <white|black|null>] [-file <filename>]
  35
  36  Where:
  37    -usa|ge       Print this usage
  38    -h|elp        Detailed help
  39    -v|erbose     Verbose mode (Default: Not verbose)
  40    -de|bug       Turn on debugging (Default: Off)
  41
  42    -t|ype        Type of list - white, black or null
  43    -f|ile        File to import
  44
  45 =head1 DESCRIPTION
  46
  47 This script will import list entries from a list file for white, black or null
  48 lists. Normally this script is run from the Import List button.
  49
  50 =cut
  51
  52 use strict;
  53 use warnings;
  54
  55 use FindBin;
  56 local $0 = $FindBin::Script;
  57
  58 use lib "$FindBin::Bin/../lib";
  59 use lib "$FindBin::Bin/../../lib";
  60
  61 use Getopt::Long;
  62 use Pod::Usage;
  63
  64 use Display;
  65 use MAPS;
  66 use MAPSWeb;
  67
  68 use CGI qw/:standard *table/;
  69 use CGI::Carp "fatalsToBrowser";
  70
  71 my ($userid, $Userid);
  72
  73 my %opts = (
  74   usage       => sub { pod2usage },
  75   help        => sub { pod2usage(-verbose => 2)},
  76   verbose     => sub { set_verbose },
  77   debug       => sub { set_debug },
  78 );
  79
  80 $opts{type} = param 'type';
  81 $opts{file} = param 'filename';
  82
  83 die "File not specified" unless $opts{file};
  84
  85 sub importList ($$) {
  86   my ($list, $type) = @_;
  87
  88   my $count = 0;
  89
  90   my @output;
  91
  92   $| = 1;
  93   while (<$list>) {
  94     next if /^\s*#/;
  95
  96     chomp;
  97
  98     my ($sender, $comment, $hit_count, $last_hit, $retention) = split /,/;
  99
 100     my $alreadyExists;
 101
 102     # The code for checking if a sender is on a list does not expect the $sender
 103     # to have any regexs
 104     my $cleansedSender = $sender;
 105
 106     $cleansedSender =~ s/(\^|\+)//g;
 107
 108     # TODO: While this works well for real email addresses it does not handle
 109     # our regexes. True it can weed out some duplicates where a more specific
 110     # email address is already covered by a more general regex. For example,
 111     # I may have say andrew@someplace.ru in a null list but also have say
 112     # ".*\.ru$" which covers andrew@someplace.ru. Using On<List>list functions
 113     # will always see ".*\.ru$" as nonexistant and readd it.
 114     if ($type eq 'white') {
 115       ($alreadyExists) = OnWhitelist($cleansedSender, $userid);
 116     } elsif ($type eq 'black') {
 117       ($alreadyExists) = OnBlacklist($cleansedSender, $userid);
 118     } elsif ($type eq 'null') {
 119       ($alreadyExists) = OnNulllist($cleansedSender, $userid);
 120     } # if
 121
 122     unless ($alreadyExists) {
 123       # Some senders lack '@' as they are username only senders. But AddList
 124       # complains if there is no '@'. For such senders tack on a '@'n
 125       if ($sender !~ /\@/) {
 126         $sender .= '@';
 127       } # if
 128
 129       AddList(
 130         userid    => $userid,
 131         type      => $type,
 132         sender    => $sender,
 133         sequence  => 0,
 134         comment   => $comment,
 135         hit_count => $hit_count,
 136         last_hit  => $last_hit,
 137         retention => $retention,
 138       );
 139
 140       print "Added $sender to ${Userid}'s ${type}list<br>";
 141       push @output, "Added $sender to ${Userid}'s ${type}list<br>";
 142
 143       $count++;
 144     } else {
 145       push @output, "$sender is already on your " . ucfirst($type) . 'list<br>';
 146     } # unless
 147   } # while
 148
 149   print $_ for @output;
 150
 151   return $count;
 152 } # importList
 153
 154 # Main
 155 GetOptions(
 156   \%opts,
 157   'usage',
 158   'help',
 159   'verbose',
 160   'debug',
 161   #'file=s',
 162   'type=s',
 163 );
 164
 165 pod2usage 'Type not specified' unless $opts{type};
 166 pod2usage 'File not specified' unless $opts{file};
 167
 168 # Now let's see if we can get that file
 169 my $list = upload('filename');
 170
 171 #pod2usage "Unable to read $opts{file}" unless -r $opts{file};
 172
 173 $userid = Heading(
 174   'getcookie',
 175   '',
 176   'Import List',
 177   'Import List',
 178 );
 179
 180 $userid //= $ENV{USER};
 181 $Userid = ucfirst $userid;
 182
 183 SetContext($userid);
 184
 185 NavigationBar($userid);
 186
 187 my $count = importList($list, $opts{type});
 188
 189 if ($count == 1) {
 190   print br "$count list entry imported";
 191 } elsif ($count == 0) {
 192   print br 'No entries imported';
 193 } else {
 194   print br "$count list entries imported";
 195 } # if
 196
 197 exit;