5 =head1 NAME $RCSfile: importlist.cgi,v $
7 Imports a white, black or null list into MAPS
15 Andrew DeFaria <Andrew@DeFaria.com>
23 Mon Jan 16 20:25:32 PST 2006
27 $Date: 2019/04/04 13:40:10 $
33 Usage; importlist.cgi [-usa|ge] [-h|elp] [-v|erbose] [-de|bug]
34 [-type <white|black|null>] [-file <filename>]
37 -usa|ge Print this usage
39 -v|erbose Verbose mode (Default: Not verbose)
40 -de|bug Turn on debugging (Default: Off)
42 -t|ype Type of list - white, black or null
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.
56 local $0 = $FindBin::Script;
58 use lib "$FindBin::Bin/../lib";
59 use lib "$FindBin::Bin/../../lib";
68 use CGI qw/:standard *table/;
69 use CGI::Carp "fatalsToBrowser";
71 my ($userid, $Userid);
74 usage => sub { pod2usage },
75 help => sub { pod2usage(-verbose => 2)},
76 verbose => sub { set_verbose },
77 debug => sub { set_debug },
80 $opts{type} = param 'type';
81 $opts{file} = param 'filename';
83 die "File not specified" unless $opts{file};
86 my ($list, $type) = @_;
98 my ($sender, $comment, $hit_count, $last_hit, $retention) = split /,/;
102 # The code for checking if a sender is on a list does not expect the $sender
104 my $cleansedSender = $sender;
106 $cleansedSender =~ s/(\^|\+)//g;
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);
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 !~ /\@/) {
135 hit_count => $hit_count,
136 last_hit => $last_hit,
137 retention => $retention,
140 print "Added $sender to ${Userid}'s ${type}list<br>";
141 push @output, "Added $sender to ${Userid}'s ${type}list<br>";
145 push @output, "$sender is already on your " . ucfirst($type) . 'list<br>';
149 print $_ for @output;
165 pod2usage 'Type not specified' unless $opts{type};
166 pod2usage 'File not specified' unless $opts{file};
168 # Now let's see if we can get that file
169 my $list = upload('filename');
171 #pod2usage "Unable to read $opts{file}" unless -r $opts{file};
180 $userid //= $ENV{USER};
181 $Userid = ucfirst $userid;
185 NavigationBar($userid);
187 my $count = importList($list, $opts{type});
190 print br "$count list entry imported";
191 } elsif ($count == 0) {
192 print br 'No entries imported';
194 print br "$count list entries imported";