/[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.11 - (hide annotations)
Wed Apr 2 07:16:44 2003 UTC (16 years, 4 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.10: +3 -6 lines
File MIME type: text/plain
better logs, better handling of attachements

1 dpavlin 1.7 #!/usr/bin/suidperl
2 dpavlin 1.1
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 dpavlin 1.8 my $mntdir = $msgdir;
26     $msgdir .="/mime";
27 dpavlin 1.3 $msgdir .= "$$"; # append PID to make it unique
28     my $log = $config->{log} || die "config: no <log> defined";
29 dpavlin 1.1
30 dpavlin 1.2 # open log and redirect die to it...
31     open(LOG,">> $log") || warn "open log $log: $!";
32 dpavlin 1.10 local $SIG{__DIE__} = sub { print LOG scalar localtime,$_[0] ; die $_[0] };
33 dpavlin 1.2
34 dpavlin 1.1 umask 022; # world readable
35    
36    
37     #------------------------------------------------------------
38     # dump_entity - dump an entity's file info
39     #------------------------------------------------------------
40     sub dump_entity {
41     my $ent = shift;
42     my @parts = $ent->parts;
43    
44     if (@parts) { # multipart...
45     map { dump_entity($_) } @parts;
46     } else { # single part...
47 dpavlin 1.11 print LOG scalar localtime," Att: ", $ent->bodyhandle->path, " (", scalar($ent->head->mime_type), ")\n";
48     if ($ent->head->mime_type =~ m,text/plain,i && $ent->bodyhandle->path !~ m/(Orders|edi)/i) {
49 dpavlin 1.1 # open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
50     # while(<I>) { print LOG $_; }
51     # close(I);
52     unlink $ent->bodyhandle->path;
53     } else {
54     my $file=$ent->bodyhandle->path;
55     my $new=$file;
56     $new=~s/ +/_/g;
57     $new=~s/^.*\/([^\/]+)$/$1/g;
58     $new=~s/[^a-zA-Z._0-9]//g;
59 dpavlin 1.2
60     # never try to overwrite file
61     my $suffix = "";
62     while (-e "$outdir/$new$suffix") { $suffix++; }
63     $new .= $suffix;
64    
65 dpavlin 1.1 rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";
66    
67     # now, call SAP rfc
68    
69 dpavlin 1.4 # init SAP rfc
70     #
71     my $rfc = new SAP::Rfc(
72     ASHOST => $config->{sap}->{ashost},
73     USER => $config->{sap}->{user},
74     PASSWD => $config->{sap}->{passwd},
75     LANG => $config->{sap}->{lang},
76     CLIENT => $config->{sap}->{client},
77     SYSNR => $config->{sap}->{sysnr},
78     TRACE => $config->{sap}->{trace}
79     ) || die "new: $!";
80    
81     $rfc->is_connected || die "SAP rfc: not connected";
82    
83 dpavlin 1.6 my $it = $rfc->discover($config->{sap}->{discover}) || die "discover: $!";
84 dpavlin 1.2
85 dpavlin 1.7 foreach my $p ($config->{sap}->{params}) {
86     foreach my $p_name (keys %{$p}) {
87     $it->$p_name($p->{$p_name});
88     }
89     }
90    
91 dpavlin 1.2 $it->FILENAME( $new );
92    
93 dpavlin 1.11 print LOG scalar localtime," RFC: $new\n";
94 dpavlin 1.1 $rfc->callrfc( $it );
95 dpavlin 1.4
96     $rfc->close();
97 dpavlin 1.1 }
98     }
99     }
100    
101    
102     #------------------------------------------------------------
103     # main
104     #------------------------------------------------------------
105     sub main {
106     my $file;
107     my $entity;
108 dpavlin 1.8
109     chdir ($mntdir) || die "can't chdir to $mntdir: $!";
110     mkdir ($msgdir,0755) || die `id`."can't create $msgdir: $!";
111 dpavlin 1.1 die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);
112    
113     my $parser = new MIME::Parser;
114     ### $parser->parse_nested_messages('REPLACE');
115    
116     $parser->output_dir($msgdir);
117    
118     open FILE, "-" or die "couldn't open $file";
119     $entity = $parser->read(\*FILE) or
120     print STDERR "Couldn't parse MIME in $file; continuing...\n";
121     close FILE;
122    
123     dump_entity($entity) if $entity;
124     ### $entity->dump_skeleton if $entity;
125    
126     rmdir $msgdir || die "can't remove $msgdir: $!";
127    
128     1;
129     }
130    
131     exit (&main ? 0 : -1);
132     #------------------------------------------------------------
133     1;
134    

  ViewVC Help
Powered by ViewVC 1.1.26