/[sap_import]/mail2sap.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 /mail2sap.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Tue Nov 19 09:03:22 2002 UTC (16 years, 9 months ago) by dpavlin
Branch: MAIN
Changes since 1.2: +15 -11 lines
File MIME type: text/plain
move configuration to xml

1 dpavlin 1.1 #!/usr/bin/perl -w
2    
3     # read e-mail from stdit (pipe from /etc/aliases) and call SAP rfc function
4     #
5     # 2002-11-18 Dobrica Pavlinusic <dpavlin@pliva.hr>
6    
7     require 5.001;
8    
9     use strict;
10     use vars qw($Msgno);
11 dpavlin 1.2 use SAP::Rfc;
12 dpavlin 1.1 use Digest::MD5 qw(md5_hex);
13     use MIME::Parser;
14 dpavlin 1.3 use XML::Simple;
15     use Data::Dumper;
16 dpavlin 1.1
17 dpavlin 1.3 # read configuration from xml file
18     my $config = XMLin();
19 dpavlin 1.1
20     # directory in which attachemnts will be left
21 dpavlin 1.3 my $outdir = $config->{outdir} || die "config: on <outdir> defined";
22 dpavlin 1.1 # temporary directory (ON SAME FILESYSTEM AS $outdir -- we use rename!)
23     # for extraction of *ALL* attachements
24 dpavlin 1.3 my $msgdir = $config->{msgdir} || die "config: no <msgdir> defined";
25     $msgdir .= "$$"; # append PID to make it unique
26     my $log = $config->{log} || die "config: no <log> defined";
27 dpavlin 1.1
28 dpavlin 1.2 # open log and redirect die to it...
29     open(LOG,">> $log") || warn "open log $log: $!";
30     local $SIG{__DIE__} = sub { print LOG $_[0] ; die $_[0] };
31    
32     # init SAP rfc
33     #
34 dpavlin 1.1 my $rfc = new SAP::Rfc(
35 dpavlin 1.3 ASHOST => $config->{sap}->{ashost},
36     USER => $config->{sap}->{user},
37     PASSWD => $config->{sap}->{passwd},
38     LANG => $config->{sap}->{lang},
39     CLIENT => $config->{sap}->{client},
40     SYSNR => $config->{sap}->{sysnr},
41     TRACE => $config->{sap}->{trace}
42 dpavlin 1.1 ) || die "new: $!";
43    
44    
45     # no user editable content beyond this point
46    
47     umask 022; # world readable
48    
49 dpavlin 1.2 $rfc->is_connected || die "SAP rfc: not connected";
50 dpavlin 1.1
51     #------------------------------------------------------------
52     # dump_entity - dump an entity's file info
53     #------------------------------------------------------------
54     sub dump_entity {
55     my $ent = shift;
56     my @parts = $ent->parts;
57    
58     if (@parts) { # multipart...
59     map { dump_entity($_) } @parts;
60     } else { # single part...
61     # print " Part: ", $ent->bodyhandle->path,
62     # " (", scalar($ent->head->mime_type), ")\n";
63     if ($ent->head->mime_type =~ m,text/plain,i) {
64     # open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
65     # while(<I>) { print LOG $_; }
66     # close(I);
67     unlink $ent->bodyhandle->path;
68     } else {
69     my $file=$ent->bodyhandle->path;
70     my $new=$file;
71     $new=~s/ +/_/g;
72     $new=~s/^.*\/([^\/]+)$/$1/g;
73     $new=~s/[^a-zA-Z._0-9]//g;
74 dpavlin 1.2
75     # never try to overwrite file
76     my $suffix = "";
77     while (-e "$outdir/$new$suffix") { $suffix++; }
78     $new .= $suffix;
79    
80 dpavlin 1.1 rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";
81     print LOG scalar localtime," $new\n";
82    
83     # now, call SAP rfc
84    
85 dpavlin 1.2 my $it = $rfc->discover("Z_ZDMM0123_SIGMA_RFC") || die "discover: $!";
86    
87     $it->FILEPATH( "ZSIGMA" );
88     $it->FILENAME( $new );
89     $it->PORT( "ZIDOC" );
90    
91 dpavlin 1.1 $rfc->callrfc( $it );
92     }
93     }
94     }
95    
96     $rfc->close();
97    
98     #------------------------------------------------------------
99     # main
100     #------------------------------------------------------------
101     sub main {
102     my $file;
103     my $entity;
104    
105     mkdir $msgdir,0755 || die "can't create $msgdir: $!";
106     die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);
107    
108     my $parser = new MIME::Parser;
109     ### $parser->parse_nested_messages('REPLACE');
110    
111     $parser->output_dir($msgdir);
112    
113     open FILE, "-" or die "couldn't open $file";
114     $entity = $parser->read(\*FILE) or
115     print STDERR "Couldn't parse MIME in $file; continuing...\n";
116     close FILE;
117    
118     dump_entity($entity) if $entity;
119     ### $entity->dump_skeleton if $entity;
120    
121     rmdir $msgdir || die "can't remove $msgdir: $!";
122    
123     1;
124     }
125    
126     exit (&main ? 0 : -1);
127     #------------------------------------------------------------
128     1;
129    

  ViewVC Help
Powered by ViewVC 1.1.26