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

Diff of /pipe2sap.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by dpavlin, Tue Dec 17 19:24:37 2002 UTC revision 1.7 by dpavlin, Mon Mar 10 15:49:01 2003 UTC
# Line 21  my $log = $config->{log} || die "config: Line 21  my $log = $config->{log} || die "config:
21    
22  # open log and redirect die to it...  # open log and redirect die to it...
23  open(LOG,">> $log") || warn "open log $log: $!";  open(LOG,">> $log") || warn "open log $log: $!";
24  local $SIG{__DIE__} = sub { print LOG $_[0] ; die $_[0] };  local $SIG{__DIE__} = sub { print scalar localtime LOG $_[0] ; die $_[0] };
25    
26  # directory in which files will be left  # directory in which files will be left
27  my $outdir = $config->{outdir} || die "config: on <outdir> defined";  my $outdir = $config->{outdir} || die "config: on <outdir> defined";
# Line 29  my $outdir = $config->{outdir} || die "c Line 29  my $outdir = $config->{outdir} || die "c
29  # create output filename  # create output filename
30  my ($ss,$mm,$hh,$dd,$mm,$yy) = localtime(time);  my ($ss,$mm,$hh,$dd,$mm,$yy) = localtime(time);
31  $yy += 1900;  $yy += 1900;
32    $mm++;
33  my $outfile = $config_file;  my $outfile = $config_file;
34  $outfile =~ s/\.xml//i;  $outfile =~ s/\.xml//i;
35  $outfile .= "_${yy}-${mm}-${dd}_${hh}:${mm}:${ss}_$$";  $outfile =~ s/^.*\/([^\/]+)/$1/i;       # basename
36    $outfile .= sprintf("_%04d-%02d-%02d_%02d:%02d:%02d_%d",$yy,$mm,$dd,$hh,$mm,$ss,$$);
37    
38  my $rfc = new SAP::Rfc(  my $rfc = new SAP::Rfc(
39          ASHOST  => $config->{sap}->{ashost},          ASHOST  => $config->{sap}->{ashost},
# Line 60  print "Using file '$outfile'\n"; Line 62  print "Using file '$outfile'\n";
62    
63  my @data;       # array for order  my @data;       # array for order
64  my $lines;      # number of lines in order  my $lines;      # number of lines in order
65    my $nr;         # order number
66    
67  my $first = <STDIN>;  my $first = <STDIN>;
68  push @data,$first;  push @data,$first;
69  chomp $first;  chomp $first;
70  if ($first =~ m/\s+(\d+)\w+$/) {  $first=~s/ //g;
71          $lines = $1;  if ($first =~ m/\s+(\d+)\s+(\d+)\w+\s*$/) {
72          print "Processing $lines lines\n";          ($nr,$lines) = ($1,$2);
73            print "Processing $lines lines order no. $nr\n";
74  } else {  } else {
75          die "FATAL: can't find number of lines in first line ($first) of input file.";          die "FATAL: can't find number of lines in first line ($first) of input file.";
76  }  }
# Line 80  while(<STDIN>) { Line 84  while(<STDIN>) {
84  if ($#data != $lines) {  if ($#data != $lines) {
85          print "FATAL: file integrity check failed: ";          print "FATAL: file integrity check failed: ";
86          if ($#data > $lines) {          if ($#data > $lines) {
87                  print "too many";                  print "too many ($#data > $lines)";
88          } else {          } else {
89                  print "too few";                  print "too few ($#data < $lines)";
90          }          }
91          print " lines ($#data)...\n";          print " lines...\n";
92  } else {  } else {
93          print "File integrity checked, saving file...\n";          print "File integrity checked, saving file...\n";
94          open(OUT, "> $outdir/$outfile") || die "FATAL: can't open '$outdir/$outfile': $!";          open(OUT, "> $outdir/$outfile") || die "FATAL: can't open '$outdir/$outfile': $!";
# Line 93  if ($#data != $lines) { Line 97  if ($#data != $lines) {
97          print OUT $first,@data;          print OUT $first,@data;
98          close(OUT);          close(OUT);
99    
100            # cludge filename to medika
101            link("$outdir/$outfile","$outdir/medika");
102            chmod 0664,"$outdir/medika";
103            $it->FILENAME("medika");
104    
105          # call SAP R/3          # call SAP R/3
106          $rfc->callrfc( $it );          $rfc->callrfc( $it );
107  }  }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.26