/[perl]/email_attachements.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /email_attachements.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Sat May 10 15:06:17 2003 UTC (20 years, 10 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +19 -6 lines
File MIME type: text/plain
better customization, first released version

1 dpavlin 1.1 #!/usr/bin/perl -w
2    
3 dpavlin 1.2 # send same message and different attachements to people. Run this script
4     # without arguments to see usage, and customize message on top of script
5     #
6     # Dobrica Pavlinusic, http://www.rot13.org/~dpavlin/sysadmin.html
7    
8 dpavlin 1.1 use strict;
9     use MIME::Lite;
10    
11 dpavlin 1.2 # customize this part !!
12     my $from = 'Joe Doe <joe.doe@nobody.com>';
13     my $subject = "New informations about...";
14     my $errors = 'postmaster@nobody.com';
15     my $body = "Please find attached more information about...";
16     # end of user configuration
17    
18 dpavlin 1.1 my %ext2mime;
19    
20     open(MIME,"/etc/mime.types") || die "mime.types: $!";
21     while(<MIME>) {
22     chomp;
23     next if (/^ *$/ || /^ *#/);
24     my ($type,$exts) = split(/[ \t]+/,$_,2);
25     if ($exts) {
26     foreach my $ext (split(/[ \t]+/,$exts)) {
27     $ext2mime{$ext} = $type;
28     }
29     }
30    
31     }
32     close(MIME);
33    
34     my $curr_dir = shift @ARGV;
35    
36     if (! $curr_dir) {
37     print "\nUsage: $0 [directory]\n\n";
38 dpavlin 1.2 print "directory should containt directories which are valid e-mail\n";
39 dpavlin 1.1 print "addresses (like first.last\@pliva.com) and attachements inside\n";
40     print "that directory (directories without \@ will be ignored !!).\n";
41     print "All files in selected directory will be ignored.\n\n";
42     exit 1;
43     }
44    
45     opendir(DIR, $curr_dir) || warn "can't opendir $curr_dir: $!";
46     my @dirs = grep { !/^\./ && -d "$curr_dir/$_" } readdir(DIR);
47     closedir(DIR);
48    
49     print "Using dirs: ",join(", ",@dirs),"\n\n";
50    
51     my @failed;
52    
53     sub f {
54     my $msg = shift;
55     push @failed, $msg;
56     print STDERR "$msg\n";
57     }
58    
59    
60     my $max = $#dirs+1;
61     my $nr = 1;
62    
63     foreach my $dir (@dirs) {
64    
65     if ($dir !~ m/\@/) {
66     f("directory '$dir' don't have @ in name!");
67     next;
68     }
69    
70     if (! opendir(DIR, "$curr_dir/$dir")) {
71     f("can't open '$dir': $!");
72     next;
73     }
74    
75     my @files = grep { !/^\./ && -f "$curr_dir/$dir/$_" } readdir(DIR);
76     closedir(DIR);
77    
78     my $msg = new MIME::Lite(
79 dpavlin 1.2 From => $from,
80 dpavlin 1.1 To => $dir,
81 dpavlin 1.2 Subject => $subject,
82 dpavlin 1.1 Type =>'multipart/mixed');
83    
84 dpavlin 1.2 $msg->add('Errors-To' => $errors);
85 dpavlin 1.1
86     # debug
87     $msg->add('X-To' => $dir);
88    
89     print STDERR "[$nr/$max] working on $dir...\n";
90     $nr++;
91    
92     attach $msg (
93 dpavlin 1.2 Type => 'TEXT',
94     Data => $body
95     );
96 dpavlin 1.1
97     foreach my $file (@files) {
98    
99     my $type = 'application/octet-stream';
100    
101     if ($file =~ m/\.([^\.]+)$/) {
102     $type = $ext2mime{$1} if ($ext2mime{$1});
103     }
104    
105     print STDERR "\tadding '$file' ($type)\n";
106    
107     attach $msg (
108     Type => $type,
109     Path => "$curr_dir/$dir/$file",
110     Filename => $file);
111    
112     }
113    
114     if (! $msg->send) {
115     f("can't send e-mail to: $dir");
116     }
117     }
118    
119     if (@failed) {
120     open(ERRORS,"> errors.log") || warn "can't open errors.log: $!";
121     print "\nERRORS during this run (also saved in errors.log):\n";
122     print join("\n",@failed);
123     print ERRORS join("\n",@failed);
124     print "\n";
125     close(ERRORS);
126     }

  ViewVC Help
Powered by ViewVC 1.1.26