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
  60 use Getopt::Long;
  61 use Pod::Usage;
  62
  63 use Display;
  64 use MAPS;
  65 use MAPSWeb;
  66
  67 use CGI qw/:standard *table/;
  68 use CGI::Carp "fatalsToBrowser";
  69
  70 my ($userid, $Userid);
  71
  72 my %opts = (
  73   usage       => sub { pod2usage },
  74   help        => sub { pod2usage(-verbose => 2)},
  75   verbose     => sub { set_verbose },
  76   debug       => sub { set_debug },
  77 );
  78
  79 $opts{type} = param 'type';
  80 $opts{file} = param 'filename';
  81
  82 die "File not specified" unless $opts{file};
  83
  84 sub importList ($$) {
  85   my ($list, $type) = @_;
  86
  87   my $count = 0;
  88
  89   my @output;
  90
  91   $| = 1;
  92   while (<$list>) {
  93     next if /^\s*#/;
  94
  95     chomp;
  96
  97     my ($sender, $comment, $hit_count, $last_hit, $retention) = split /,/;
  98
  99     my $alreadyExists;
 100
 101     # The code for checking if a sender is on a list does not expect the $sender
 102     # to have any regexs
 103     my $cleansedSender = $sender;
 104
 105     $cleansedSender =~ s/(\^|\+)//g;
 106
 107     # TODO: While this works well for real email addresses it does not handle
 108     # our regexes. True it can weed out some duplicates where a more specific
 109     # email address is already covered by a more general regex. For example,
 110     # I may have say andrew@someplace.ru in a null list but also have say
 111     # ".*\.ru$" which covers andrew@someplace.ru. Using On<List>list functions
 112     # will always see ".*\.ru$" as nonexistant and readd it.
 113     if ($type eq 'white') {
 114       ($alreadyExists) = OnWhitelist($cleansedSender, $userid);
 115     } elsif ($type eq 'black') {
 116       ($alreadyExists) = OnBlacklist($cleansedSender, $userid);
 117     } elsif ($type eq 'null') {
 118       ($alreadyExists) = OnNulllist($cleansedSender, $userid);
 119     } # if
 120
 121     unless ($alreadyExists) {
 122       # Some senders lack '@' as they are username only senders. But AddList
 123       # complains if there is no '@'. For such senders tack on a '@'n
 124       if ($sender !~ /\@/) {
 125         $sender .= '@';
 126       } # if
 127
 128       AddList(
 129         userid    => $userid,
 130         type      => $type,
 131         sender    => $sender,
 132         sequence  => 0,
 133         comment   => $comment,
 134         hit_count => $hit_count,
 135         last_hit  => $last_hit,
 136         retention => $retention,
 137       );
 138
 139       print "Added $sender to ${Userid}'s ${type}list<br>";
 140       push @output, "Added $sender to ${Userid}'s ${type}list<br>";
 141
 142       $count++;
 143     } else {
 144       push @output, "$sender is already on your " . ucfirst($type) . 'list<br>';
 145     } # unless
 146   } # while
 147
 148   print $_ for @output;
 149
 150   return $count;
 151 } # importList
 152
 153 # Main
 154 GetOptions(
 155   \%opts,
 156   'usage',
 157   'help',
 158   'verbose',
 159   'debug',
 160   #'file=s',
 161   'type=s',
 162 );
 163
 164 pod2usage 'Type not specified' unless $opts{type};
 165 pod2usage 'File not specified' unless $opts{file};
 166
 167 # Now let's see if we can get that file
 168 my $list = upload('filename');
 169
 170 #pod2usage "Unable to read $opts{file}" unless -r $opts{file};
 171
 172 $userid = Heading(
 173   'getcookie',
 174   '',
 175   'Import List',
 176   'Import List',
 177 );
 178
 179 $userid //= $ENV{USER};
 180 $Userid = ucfirst $userid;
 181
 182 SetContext($userid);
 183
 184 NavigationBar($userid);
 185
 186 my $count = importList($list, $opts{type});
 187
 188 if ($count == 1) {
 189   print br "$count list entry imported";
 190 } elsif ($count == 0) {
 191   print br 'No entries imported';
 192 } else {
 193   print br "$count list entries imported";
 194 } # if
 195
 196 exit;