#!/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'};
}
[download]