/[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.2 - (hide annotations)
Tue Nov 19 08:34:40 2002 UTC (21 years, 4 months ago) by dpavlin
Branch: MAIN
Changes since 1.1: +20 -9 lines
File MIME type: text/plain
some changes

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    
15     # configuration
16    
17     # directory in which attachemnts will be left
18     my $outdir = "/var/autofs/data/export_sigma";
19     # temporary directory (ON SAME FILESYSTEM AS $outdir -- we use rename!)
20     # for extraction of *ALL* attachements
21     my $msgdir = "/var/autofs/data/export_sigma/mime$$"; # temp
22     my $log = "/data/sap_sigma/orders.log";
23    
24 dpavlin 1.2 # open log and redirect die to it...
25     open(LOG,">> $log") || warn "open log $log: $!";
26     local $SIG{__DIE__} = sub { print LOG $_[0] ; die $_[0] };
27    
28     # init SAP rfc
29     #
30 dpavlin 1.1 my $rfc = new SAP::Rfc(
31     ASHOST => 'cipkg',
32     USER => 'rfctest',
33     PASSWD => 'dinamo',
34     LANG => 'HR',
35     CLIENT => '200',
36     SYSNR => '20',
37     TRACE => '0'
38     ) || die "new: $!";
39    
40    
41     # no user editable content beyond this point
42    
43     umask 022; # world readable
44    
45 dpavlin 1.2 $rfc->is_connected || die "SAP rfc: not connected";
46 dpavlin 1.1
47     #------------------------------------------------------------
48     # dump_entity - dump an entity's file info
49     #------------------------------------------------------------
50     sub dump_entity {
51     my $ent = shift;
52     my @parts = $ent->parts;
53    
54     if (@parts) { # multipart...
55     map { dump_entity($_) } @parts;
56     } else { # single part...
57     # print " Part: ", $ent->bodyhandle->path,
58     # " (", scalar($ent->head->mime_type), ")\n";
59     if ($ent->head->mime_type =~ m,text/plain,i) {
60     # open(I,$ent->bodyhandle->path) || die "$ent->bodyhandle->path: $!";
61     # while(<I>) { print LOG $_; }
62     # close(I);
63     unlink $ent->bodyhandle->path;
64     } else {
65     my $file=$ent->bodyhandle->path;
66     my $new=$file;
67     $new=~s/ +/_/g;
68     $new=~s/^.*\/([^\/]+)$/$1/g;
69     $new=~s/[^a-zA-Z._0-9]//g;
70 dpavlin 1.2
71     # never try to overwrite file
72     my $suffix = "";
73     while (-e "$outdir/$new$suffix") { $suffix++; }
74     $new .= $suffix;
75    
76 dpavlin 1.1 rename $file,"$outdir/$new" || die "move $file -> $outdir/$new: $!";
77     print LOG scalar localtime," $new\n";
78    
79     # now, call SAP rfc
80    
81 dpavlin 1.2 my $it = $rfc->discover("Z_ZDMM0123_SIGMA_RFC") || die "discover: $!";
82    
83     $it->FILEPATH( "ZSIGMA" );
84     $it->FILENAME( $new );
85     $it->PORT( "ZIDOC" );
86    
87 dpavlin 1.1 $rfc->callrfc( $it );
88     }
89     }
90     }
91    
92     $rfc->close();
93    
94     #------------------------------------------------------------
95     # main
96     #------------------------------------------------------------
97     sub main {
98     my $file;
99     my $entity;
100    
101     mkdir $msgdir,0755 || die "can't create $msgdir: $!";
102     die "problems with creation of directory $msgdir: $!" if (! -w $msgdir);
103    
104     my $parser = new MIME::Parser;
105     ### $parser->parse_nested_messages('REPLACE');
106    
107     $parser->output_dir($msgdir);
108    
109     open FILE, "-" or die "couldn't open $file";
110     $entity = $parser->read(\*FILE) or
111     print STDERR "Couldn't parse MIME in $file; continuing...\n";
112     close FILE;
113    
114     dump_entity($entity) if $entity;
115     ### $entity->dump_skeleton if $entity;
116    
117     rmdir $msgdir || die "can't remove $msgdir: $!";
118    
119     1;
120     }
121    
122     exit (&main ? 0 : -1);
123     #------------------------------------------------------------
124     1;
125    

  ViewVC Help
Powered by ViewVC 1.1.26