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

Contents of /mimex

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Mon Oct 22 18:17:12 2001 UTC (22 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.2: +4 -0 lines
loging

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 if (@parts) { # multipart...
31 map { dump_entity($_) } @parts;
32 } else { # single part...
33 # print " Part: ", $ent->bodyhandle->path,
34 # " (", scalar($ent->head->mime_type), ")\n";
35 if ($ent->head->mime_type =~ m,text/plain,i) {
36 open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
37 while(<I>) { print MAIL $_; }
38 close(I);
39 unlink $ent->bodyhandle->path;
40 } else {
41 my $file=$ent->bodyhandle->path;
42 my $new=$file;
43 $new=~s/ +/_/g;
44 $new=~s/^.*\/([^\/]+)$/$1/g;
45 $new=~s/[^a-zA-Z._0-9]//g;
46 my $md5=md5_hex($new.time());
47 mkdir "$outdir/$md5",0755 || die "mkdir $outdir/$md5: $!";
48 rename $file,"$outdir/$md5/$new" || die "$file -> $md5 $new: $!";
49 print MAIL "\n","-" x 76,"\nhttp://store.pliva.hr/$md5/$new\n";
50 print LOG "http://store.pliva.hr/$md5/$new\n";
51 }
52 }
53 }
54
55 #------------------------------------------------------------
56 # main
57 #------------------------------------------------------------
58 sub main {
59 my $file;
60 my $entity;
61
62 mkdir $msgdir,0755 || die "can't create $msgdir: $!";
63
64 my $parser = new MIME::Parser;
65 ### $parser->parse_nested_messages('REPLACE');
66
67 $parser->output_dir($msgdir);
68
69 open FILE, "-" or die "couldn't open $file";
70 $entity = $parser->read(\*FILE) or
71 print STDERR "Couldn't parse MIME in $file; continuing...\n";
72 close FILE;
73
74 dump_entity($entity) if $entity;
75 ### $entity->dump_skeleton if $entity;
76
77 rmdir $msgdir || die "can't remove $msgdir: $!";
78
79 1;
80 }
81
82 exit (&main ? 0 : -1);
83 #------------------------------------------------------------
84 1;
85

  ViewVC Help
Powered by ViewVC 1.1.26