The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Need to suppress warinings ?
BEGIN { $^W = 0; $| = 1; print "1..6\n"; }
END {print "not ok 1\n" unless $loaded;}
use SAP::Rfc;
$loaded = 1;
print "ok 1\n";                                                                                     

my $rfc = new SAP::Rfc( './testconn' );

print "Testing SAP::Rfc-$SAP::Rfc::VERSION\n";
print $rfc->is_connected ? "ok 2" : "not ok 2", "\n";
print $rfc->discover('RFC_READ_REPORT') ? "ok 3" : "not ok 3", "\n";
print getSource( $rfc ) ? "ok 4" : "not ok 4", "\n";
print getTable( $rfc ) ? "ok 5" : "not ok 5", "\n";
print getError( $rfc ) ? "ok 6" : "not ok 6", "\n";




sub getSource{

 my $rfc = shift;
 use Data::Dumper;
 #my $if = $rfc->discover('RFC_READ_REPORT'); # code commented out
 my $if = $rfc->discover('RFC_READ_DEVELOPMENT_OBJECT'); 
 $if->PROGRAM('SAPLGRFC');
 $rfc->callrfc( $if );
# print STDERR Dumper($if);

 # Check for a particular line
 #print STDERR "SOURCE: ".join("\n",Dumper($if->tab('QTAB')->rows()));
 return join('', map { $_->{LINE} } $if->tab('QTAB')->hashRows() ) =~ /LGRFCUXX/s;

}


sub getError {

 my $rfc = shift;
 use Data::Dumper;
 my $if = $rfc->discover('RFC_READ_REPORT');
 # break the interface definition
 $if->{'NAME'} = 'WIBBLE';
 $if->PROGRAM('SAPLGRFC');
 eval { $rfc->callrfc( $if ); };
 #warn "the Error is: ".$rfc->error."\n";
 return $rfc->error() =~ /WIBBLE/s ? 1 : 0;

}


sub getTable {

 my $rfc = shift;
 my $cnt = 0;
 my $if = $rfc->discover("RFC_READ_TABLE");
 $if->QUERY_TABLE('T000');
 my $flds = $if->tab('FIELDS')->structure();
 $if->FIELDS([{ 'FIELDNAME' => "MANDT"}, { 'FIELDNAME' => "MTEXT"}, { 'FIELDNAME' => "ORT01"}]);
 my $str = $rfc->structure('T000');
 #warn Dumper($str)."\n";
 $rfc->callrfc($if);
 foreach my $row ($if->DATA()){
   #warn Dumper($row)."\n";
	 if ($if->unicode){
	   #warn "unicode\n";
     $str->value($row->{'WA'});
	 } else {
     $str->value($row);
	 }
	 #warn $str->MANDT ."\n";
   $cnt += 1 if $str->MANDT eq '066';
 }
 $if->reset;
# $if->QUERY_TABLE('TNRO');
# $if->DELIMITER('|');
# my $flds = $if->tab('FIELDS')->structure();
# $if->OPTIONS( [ {'TEXT' => "OBJECT LIKE 'ARCHIVELNK%'"}] );
# #my $str = $rfc->structure('TNRO');
# $rfc->callrfc($if);
# foreach my $row ($if->DATA()){
##   $str->value($row);
##   return 1 if $str->MANDT eq '066';
#   warn "row: ".$row."\n";
# }
# foreach my $row ($if->DATA()){
#   $str->value($row);
#   $cnt +=1 if $str->OBJECT =~ /ARCHIVE/;
#   #warn "TNRO: ".$str->OBJECT." ".$str->PERCENTAGE."\n";
#   #warn "blah: ".SAP::Rfc::MyBcdToChar($str->PERCENTAGE);
# }
# my $if = $rfc->discover("Z_TNRO_TEST");
# $rfc->callrfc($if);
# foreach my $row ($if->tab('TTNRO')->hashRows()){
#   warn "TTNRO: ".Dumper($row)."\n";
# }
 return $cnt >=1 ? 1 : 0;

}