1 |
dpavlin |
1.1 |
#!/usr/bin/perl |
2 |
|
|
use strict; |
3 |
|
|
use SAP::Rfc; |
4 |
|
|
use Data::Dumper; |
5 |
|
|
use XML::Simple; |
6 |
|
|
|
7 |
|
|
my $config_file; |
8 |
|
|
|
9 |
|
|
if ($#ARGV < 0) { |
10 |
|
|
print "usage: $0 config.xml\n"; |
11 |
|
|
exit 1; |
12 |
|
|
} else { |
13 |
|
|
$config_file = $ARGV[0]; |
14 |
|
|
} |
15 |
|
|
|
16 |
|
|
$|++; |
17 |
|
|
|
18 |
|
|
my $config = XMLin($config_file); |
19 |
|
|
|
20 |
|
|
my $log = $config->{log} || die "config: no <log> defined"; |
21 |
|
|
|
22 |
|
|
# open log and redirect die to it... |
23 |
|
|
open(LOG,">> $log") || warn "open log $log: $!"; |
24 |
|
|
local $SIG{__DIE__} = sub { print LOG $_[0] ; die $_[0] }; |
25 |
|
|
|
26 |
|
|
# directory in which files will be left |
27 |
|
|
my $outdir = $config->{outdir} || die "config: on <outdir> defined"; |
28 |
|
|
|
29 |
|
|
# create output filename |
30 |
|
|
my ($ss,$mm,$hh,$dd,$mm,$yy) = localtime(time); |
31 |
|
|
$yy += 1900; |
32 |
|
|
my $outfile = $config_file; |
33 |
|
|
$outfile =~ s/\.xml//i; |
34 |
|
|
$outfile .= "_${yy}-${mm}-${dd}_${hh}:${mm}:${ss}_$$"; |
35 |
|
|
|
36 |
|
|
my $rfc = new SAP::Rfc( |
37 |
|
|
ASHOST => $config->{sap}->{ashost}, |
38 |
|
|
USER => $config->{sap}->{user}, |
39 |
|
|
PASSWD => $config->{sap}->{passwd}, |
40 |
|
|
LANG => $config->{sap}->{lang}, |
41 |
|
|
CLIENT => $config->{sap}->{client}, |
42 |
|
|
SYSNR => $config->{sap}->{sysnr}, |
43 |
|
|
TRACE => $config->{sap}->{trace} |
44 |
|
|
) || die "new: $!"; |
45 |
|
|
|
46 |
|
|
$rfc->is_connected || die "FATAL: SAP not connected"; |
47 |
|
|
|
48 |
|
|
my $it = $rfc->discover($config->{sap}->{discover}) || die "FATAL: SAP discover: $!"; |
49 |
|
|
|
50 |
|
|
foreach my $p ($config->{sap}->{params}) { |
51 |
|
|
foreach my $p_name (keys %{$p}) { |
52 |
|
|
# print "$p_name --> ",$p->{$p_name},"\n"; |
53 |
|
|
$it->$p_name($p->{$p_name}); |
54 |
|
|
} |
55 |
|
|
} |
56 |
|
|
|
57 |
|
|
# override FILENAME with my name |
58 |
|
|
$it->FILENAME($outfile); |
59 |
|
|
print "Using file '$outfile'\n"; |
60 |
|
|
|
61 |
|
|
my @data; # array for order |
62 |
|
|
my $lines; # number of lines in order |
63 |
|
|
|
64 |
|
|
my $first = <STDIN>; |
65 |
|
|
push @data,$first; |
66 |
|
|
chomp $first; |
67 |
|
|
if ($first =~ m/\s+(\d+)\w+$/) { |
68 |
|
|
$lines = $1; |
69 |
|
|
print "Processing $lines lines\n"; |
70 |
|
|
} else { |
71 |
|
|
die "FATAL: can't find number of lines in first line ($first) of input file."; |
72 |
|
|
} |
73 |
|
|
|
74 |
|
|
# suck file in array |
75 |
|
|
while(<STDIN>) { |
76 |
|
|
push @data,$_; |
77 |
|
|
} |
78 |
|
|
|
79 |
|
|
# check integrity of file |
80 |
|
|
if ($#data != $lines) { |
81 |
|
|
print "FATAL: file integrity check failed: "; |
82 |
|
|
if ($#data > $lines) { |
83 |
|
|
print "too many"; |
84 |
|
|
} else { |
85 |
|
|
print "too few"; |
86 |
|
|
} |
87 |
|
|
print " lines ($#data)...\n"; |
88 |
|
|
} else { |
89 |
|
|
print "File integrity checked, saving file...\n"; |
90 |
|
|
open(OUT, "> $outdir/$outfile") || die "FATAL: can't open '$outdir/$outfile': $!"; |
91 |
|
|
|
92 |
|
|
# dump order to file |
93 |
|
|
print OUT $first,@data; |
94 |
|
|
close(OUT); |
95 |
|
|
|
96 |
|
|
# call SAP R/3 |
97 |
|
|
$rfc->callrfc( $it ); |
98 |
|
|
} |
99 |
|
|
|
100 |
|
|
$rfc->close(); |
101 |
|
|
|