/[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

Annotation of /mimex

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Sat Nov 3 10:15:41 2001 UTC (22 years, 4 months ago) by dpavlin
Branch: MAIN
Changes since 1.3: +1 -1 lines
fix: nedostajuci "

1 dpavlin 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 dpavlin 1.2 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 dpavlin 1.3 my $log = "/data/store/mimex.log";
16    
17 dpavlin 1.4 open(LOG,">> $log") || warn "log $log: $!";
18 dpavlin 1.1
19 dpavlin 1.2 open(MAIL,"| /usr/sbin/sendmail $to") || die "sendmail: $!";
20    
21     print MAIL "From: Press Clipping <$from>\nSubject: Press Clipping update\n\n";
22 dpavlin 1.1
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 dpavlin 1.2 while(<I>) { print MAIL $_; }
38 dpavlin 1.1 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 dpavlin 1.2 print MAIL "\n","-" x 76,"\nhttp://store.pliva.hr/$md5/$new\n";
50 dpavlin 1.3 print LOG "http://store.pliva.hr/$md5/$new\n";
51 dpavlin 1.1 }
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