Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

SAP BAPI interface pretty printer

by shmem (Chancellor)
on Aug 06, 2007 at 18:21 UTC ( #630879=CUFP: print w/replies, xml ) Need Help??

I recently stumbled over ajt's scratchpad. On it, as of the time of writing this, there's a sap-discover script which dumps a SAP BAPI interface.

Here's my version (rfc-discover) which does some formatting and features a bit of xterm color. It helped me a lot writing interface scripts to that leviathan.

#!/usr/bin/perl # $Id$ $|=1; use strict; use SAP::Rfc; use Getopt::Std; use Data::Dumper; $Data::Dumper::Deepcopy = 1; $Data::Dumper::Indent = 1; my $Usage = "usage: $0 [-l] -h host -u user -c client <rfcfuntion>\n +you will be prompted for a password.\n"; my(%o,$pass); getopts('flh:u:c:o:p:',\%o); $o{'h'} ||= 'sap';; $o{'u'} ||= $ENV{'LOGNAME'}; $o{'c'} ||= '123'; my $rfcfunc = shift or die $Usage; $pass = $o{'p'}; unless ($o{'p'}) { print STDERR "Password: "; system 'stty -echo'; chop($pass = <STDI +N>); system "stty echo"; print STDERR "\n"; } # colour escape sequences (for xterm) my ($red,$green,$yellow,$norm); if ($ENV{TERM} =~ /xterm/ || $ENV{TERM} =~ /screen/) { $red = "\033[;31m"; $green = "\033[;32m"; $yellow = "\033[;33m"; $norm = "\033[m"; } else { $red = $green = $yellow = $norm = ''; } # separator line my $sline = '=' x 80 . "\n"; # various pictures for text formatting my $pic_table_sep = '+'.'-' x 58 . '+' . '-' x 19 . '+'; my $pic_table = "| TABLE | $red" . '@' . '<' x 31 . $norm . '| LE +N @>>>>>>>>>| INTYPE @>>>>>>>>>>|'; $pic_table = join("\n",$pic_table_sep,$pic_table) . "\n"; my $pic_struc_sep = '+--------+---------------------------------+----- +-+--------+--------+----------+'; my $pic_struc_top = '| POS | NAME | LEN + | INTYPE | OFFSET | DECIMALS |'; $pic_struc_top = join("\n",$pic_struc_sep, $pic_struc_top, $pic_str +uc_sep) . "\n"; my $pic_struchead = "| STRUCT | $green\@" . '<' x 46 . $norm . ' | VAL +UE LEN @>>>>>> |' . "\n"; my $pic_struc = '| @>>>>> | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>> + | @>>>>> | @>>>>> | @>>>>>>> |' . "\n"; my $pic_parm_sep = '|------------------------------------+----------- +------------------------------+'; my $pic_parm_top = '| VALUE | LEN | TYPE | INT +YPE | DECIMALS | DEFAULT |'; my $pic_parm = '| @>>>>>>>>>>>>>>>>>>>>>>>> | @>>>>> | @>>> | @>> +>>> | @>>>>>>> | @>>>>>>>>>>>>|' . "\n"; my $pic_parmhead = "| PARAMETER $yellow\@" . '<' x 23 . "$norm | STRU +CTURE $green\@" . '<' x 28 . "$norm |"; $pic_parmhead = join("\n",$pic_parm_sep,$pic_parmhead,$pic_parm_to +p) . "\n"; # open the rfc connection our $rfc = new SAP::Rfc(ASHOST=>$o{'h'},USER=>$o{'u'},PASSWD=>$pass,LA +NG=>'DE',CLIENT=>$o{'c'},SYSNR=>'00',TRACE=>'1'); unless ($rfc->is_connected()) { print STDERR "no connection to $o{'h'}!\n" ; exit 2; } else { our $iface = $rfc->discover($rfcfunc); unless ($iface) { print STDERR "could not discover $rfcfunc\n" ; print STDERR "------------- rfc ------------------\n"; print Dumper($rfc); print STDERR "------------- iface ----------------\n"; print Dumper($iface); exit 1; } if($o{'o'}) { print "redirecting STDOUT to $o{o}\n"; open(STDOUT,">$o{o}") or die "Can't open $o{o} for writing: $! +\n"; } if (! $o{'f'}) { print $sline, "Interface ",$iface->name(),"\n", $sline; my @tabs = $iface->tabs(); foreach my $tab (@tabs) { format_struc($tab); print $^A,"\n\n"; $^A = ''; } print $sline, "Parameter\n", $sline; my @parms = $iface->parms(); foreach my $parm (@parms) { format_parm($parm); print $^A,"\n\n"; $^A = ''; } if(defined($o{'l'})) { print $sline,"COMPLETE INTERFACE DUMP\n",$sline; print Dumper($iface); } } else { my @tabs = $iface->tabs(); my @parms = $iface->parms(); print "# $rfcfunc\n\n"; map { print "my ", $_->{'STRUCTURE'} ? "\%" : "\$"; print lc($_->name),";\n"; } (@tabs,@parms); foreach my $tp(@tabs,@parms) { if($tp->{'STRUCTURE'}) { print "\%",lc($tp->name())," = (\n"; map { print " " x 4, $tp->{'STRUCTURE'}->{'FIELDS'}->{$_ +}->{'NAME'}; print "\t=> ", $tp->{'STRUCTURE'}->{'FIELDS'}->{$_ +}->{'DEFAULT'} ? "'". $tp->{'STRUCTURE'}->{'FIELDS'}->{$_}-> +{'DEFAULT'}."'" : "undef"; print ",\t# len: "; (my $len = $tp->{'STRUCTURE'}->{'FIELDS'}->{$_}->{ +'LEN'}) =~ s/^0+//; print "$len := "; print "(default '".$tp->{'STRUCTURE'}->{'FIELDS'}- +>{$_}->{'DEFAULT'}."') "; print "\n"; } sort { $tp->{'STRUCTURE'}->{'FIELDS'}->{$a}->{'POSITION'} <=> $tp->{'STRUCTURE'}->{'FIELDS'}->{$b}->{'POSITION'} } keys %{$tp->{'STRUCTURE'}->{'FIELDS'}}; print ");\n"; } else { print "\$",lc($tp->name())," = '",$tp->{'VALUE'},"';\t +# len: ",$tp->{'LEN'}," := "; print "(default '".$tp->{'DEFAULT'}."') " if defined $ +tp->{'DEFAULT'}; print "\n"; } } } } $rfc->close(); sub format_struc { my $tab = shift; my $struc = $tab->structure(); my @fields = $struc->fields(); formline($pic_table, $tab->name, $tab->leng, $tab->intype); my $value = ref($tab->{'VALUE'}) ? length($tab->{'VALUE'}->[0]) : +'(none)'; formline($pic_struchead, $struc->{'NAME'},$value); formline($pic_struc_top); my $g_len = 0; map { my $r = $struc->{'FIELDS'}->{$_}; ( my $len = $r->{'LEN'} ) =~ s/^0+//; ( my $off = $r->{'OFFSET'} ) =~ s/^0+//; my $dec = $r->{'DECIMALS'} + 0; $g_len += $len; formline($pic_struc, $r->{'POSITION'}, $r->{'NAME'}, $len, $r->{'INTYPE'}, $off, $dec ); } @fields; formline($pic_struc,'---','- Sum -',$g_len,undef,undef,undef); } sub format_parm { my $parm = shift; my $strucname = ref($parm->{'STRUCTURE'}) ? $parm->{'STRUCTURE'}-> +{'NAME'} : '(none)'; formline($pic_parmhead,$parm->name(),$strucname); formline($pic_parm, $parm->value(), $parm->leng(), $parm->type() == 1 ? 'IN' : 'OUT',"\n", $parm->intype(), $parm->{'DECIMALS'}, $parm->default() ); format_struc($parm) if $parm->{'STRUCTURE'}; }

I should have refactored that code, specially replace all the hash deref mumbo jumbo with method calls... but I'm soo lazy right now :)

--shmem

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://630879]
Approved by almut
Front-paged by liverpole
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (5)
As of 2021-06-13 09:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (54 votes). Check out past polls.

    Notices?