viewvc.cgi/clipping/mimex

#!/usr/bin/perl -w

require 5.001;

use strict;
use vars qw($Msgno);
use Digest::MD5 qw(md5_hex);

use MIME::Parser;

my $outdir = "/data/store";
my $msgdir = "/data/store/tmp/mime$$";  # temp
my $from = 'clipping-info@pliva.hr';
my $to = 'clipdir@pliva.hr';
my $log = "/data/store/mimex.log";

open(LOG,">> $log") || warn "log $log: $!";

open(MAIL,"| /usr/sbin/sendmail $to") || die "sendmail: $!";

print MAIL "From: Press Clipping <$from>\nSubject: Press Clipping update\n\n";

#------------------------------------------------------------
# dump_entity - dump an entity's file info
#------------------------------------------------------------
sub dump_entity {
    my $ent = shift;
    my @parts = $ent->parts;

    my $md5=md5_hex(time());
    mkdir "$outdir/$md5",0755 || die "mkdir $outdir/$md5: $!";

    if (@parts) {       # multipart...
        map { dump_entity($_) } @parts;
    } else {            # single part...
#       print "    Part: ", $ent->bodyhandle->path, 
#             " (", scalar($ent->head->mime_type), ")\n";
        if ($ent->head->mime_type =~ m,text/plain,i) {
                open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
                while(<I>) { print MAIL $_; }
                close(I);
                unlink $ent->bodyhandle->path;
        } else {
                my $file=$ent->bodyhandle->path;
                my $new=$file;
                $new=~s/ +/_/g;
                $new=~s/^.*\/([^\/]+)$/$1/g;
                $new=~s/[^a-zA-Z._0-9]//g;
                rename $file,"$outdir/$md5/$new" || die "$file -> $md5 $new: $!";
                print MAIL "\n","-" x 76,"\nhttp://store.pliva.hr/$md5/$new\n";
                print LOG "$md5/$new\n";
        }
    }
}

#------------------------------------------------------------
# main
#------------------------------------------------------------
sub main {
        my $file;
        my $entity;

        mkdir $msgdir,0755 || die "can't create $msgdir: $!";

        my $parser = new MIME::Parser;
        ### $parser->parse_nested_messages('REPLACE');
    
        $parser->output_dir($msgdir);
    
        open FILE, "-" or die "couldn't open $file";
        $entity = $parser->read(\*FILE) or 
            print STDERR "Couldn't parse MIME in $file; continuing...\n";
        close FILE;

        dump_entity($entity) if $entity;
        ### $entity->dump_skeleton if $entity;

        rmdir $msgdir || die "can't remove $msgdir: $!";

        1;
}

exit (&main ? 0 : -1);
#------------------------------------------------------------
1;

1	#!/usr/bin/perl -w
2
3	require 5.001;
4
5	use strict;
6	use vars qw($Msgno);
7	use Digest::MD5 qw(md5_hex);
8
9	use MIME::Parser;
10
11	my $outdir = "/data/store";
12	my $msgdir = "/data/store/tmp/mime$$"; # temp
13	my $from = 'clipping-info@pliva.hr';
14	my $to = 'clipdir@pliva.hr';
15	my $log = "/data/store/mimex.log";
16
17	open(LOG,">> $log") \|\| warn "log $log: $!";
18
19	open(MAIL,"\| /usr/sbin/sendmail $to") \|\| die "sendmail: $!";
20
21	print MAIL "From: Press Clipping <$from>\nSubject: Press Clipping update\n\n";
22
23	#------------------------------------------------------------
24	# dump_entity - dump an entity's file info
25	#------------------------------------------------------------
26	sub dump_entity {
27	my $ent = shift;
28	my @parts = $ent->parts;
29
30	my $md5=md5_hex(time());
31	mkdir "$outdir/$md5",0755 \|\| die "mkdir $outdir/$md5: $!";
32
33	if (@parts) { # multipart...
34	map { dump_entity($_) } @parts;
35	} else { # single part...
36	# print " Part: ", $ent->bodyhandle->path,
37	# " (", scalar($ent->head->mime_type), ")\n";
38	if ($ent->head->mime_type =~ m,text/plain,i) {
39	open(I,$ent->bodyhandle->path) \|\| die "$ent->bodyhandle->path: $!";
40	while(<I>) { print MAIL $_; }
41	close(I);
42	unlink $ent->bodyhandle->path;
43	} else {
44	my $file=$ent->bodyhandle->path;
45	my $new=$file;
46	$new=~s/ +/_/g;
47	$new=~s/^.*\/([^\/]+)$/$1/g;
48	$new=~s/[^a-zA-Z._0-9]//g;
49	rename $file,"$outdir/$md5/$new" \|\| die "$file -> $md5 $new: $!";
50	print MAIL "\n","-" x 76,"\nhttp://store.pliva.hr/$md5/$new\n";
51	print LOG "$md5/$new\n";
52	}
53	}
54	}
55
56	#------------------------------------------------------------
57	# main
58	#------------------------------------------------------------
59	sub main {
60	my $file;
61	my $entity;
62
63	mkdir $msgdir,0755 \|\| die "can't create $msgdir: $!";
64
65	my $parser = new MIME::Parser;
66	### $parser->parse_nested_messages('REPLACE');
67
68	$parser->output_dir($msgdir);
69
70	open FILE, "-" or die "couldn't open $file";
71	$entity = $parser->read(\*FILE) or
72	print STDERR "Couldn't parse MIME in $file; continuing...\n";
73	close FILE;
74
75	dump_entity($entity) if $entity;
76	### $entity->dump_skeleton if $entity;
77
78	rmdir $msgdir \|\| die "can't remove $msgdir: $!";
79
80	1;
81	}
82
83	exit (&main ? 0 : -1);
84	#------------------------------------------------------------
85	1;
86