#!/usr/bin/perl  -I../. -I../blib/arch -I../blib/lib 
use SAP::Rfc;
use SAP::Test;

$| = 1;
$segname = 'ORDERS01';
$outfile = 'segcode.txt';

$CHAR = { CHAR => C,
          DATS => C,
          TIMS => C,
          CUKY => C,
          LANG => C,
          UNIT => C,
          QUAN => C,
          INT1 => I,
          DEC => C,
          NUMC => C };

# Create a new RFC Object
$rfc = new SAP::Rfc;
$cdata = new SAP::Test;

# Update the login parameters
$rfc->login->add(
      $cdata->conndata()
     );

# Intiate a Connection
$h = $rfc->connect();

# discover the complete structure of an IDOC
$idoctype = $rfc->discover('IDOCTYPE_READ_COMPLETE');
$idoctype->Export('PI_IDOCTYP')->value($segname);
print "RELEASE: ", $idoctype->Export('PI_RELEASE')->value(), "\n";
print "VERSION: ", $idoctype->Export('PI_VERSION')->value(), "\n";
print "CIMTYP: ", $idoctype->Export('PI_CIMTYP')->value(), "\n";
print "IDOCTYP: ", $idoctype->Export('PI_IDOCTYP')->value(), "\n";
$segments = $idoctype->Table('PT_SEGMENTS');
$segstr = $segments->structure();
$fields = $idoctype->Table('PT_FIELDS');
$fieldstr = $fields->structure();
$fvalues = $idoctype->Table('PT_FVALUES');
$fvaluestr = $fvalues->structure();
$messages = $idoctype->Table('PT_MESSAGES');
print "Doing RFC call \n";
#$r = $rfc->callrfc($idoctype);
$r = $rfc->xmlrfc($idoctype);
if ($r){
  print " RFC ERROR: ", $rfc->return();
  exit 0;
}

# build a hash of the segment type information
print "Doing fields \n";
while ( $fields->nextrow() ){
  $seg = $fieldstr->SEGMENTTYP();
  $seg =~ s/^\s*(\w+)\s*$/$1/;
  $SEGMENTS{$seg} = { NAME => $seg,
                      FIELDS => { },
                      STRUCTURE => new SAP::Structure( NAME => $seg )
		      } if ! exists $SEGMENTS{$seg};
  $type = $fieldstr->DATATYPE;
  $SEGMENTS{$seg}->{FIELDS}->{ $fieldstr->FIELDNAME } =  {
                FIELDNAME => $fieldstr->FIELDNAME,
                INTLEN  => $fieldstr->EXTLEN,
                DATATYPE  => $CHAR->{$fieldstr->DATATYPE},
                DESCRP  => $fieldstr->DESCRP
                              };
  $type =~ s/ //g;
#  print " SEG: ", $seg, " FIELD: ", $fieldstr->FIELDNAME, " LEN ",
#                $fieldstr->INTLEN, " TYPE ",
#                $CHAR->{$type}, " OTH ", $type, "\n";
  $SEGMENTS{$seg}->{STRUCTURE}->addField(
                NAME => $fieldstr->FIELDNAME,
                LENGTH  => $fieldstr->EXTLEN,
                TYPE  => $CHAR->{$type} );
};


printseg();
exit 0;

#  get the IDOC function module
$idoc = $rfc->discover('IDOC_INBOUND_SINGLE');
$control = $idoc->Export('PI_IDOC_CONTROL_REC_40');
$controlstr = $control->structure();
$number = $idoc->Import('PE_IDOC_NUMBER');
$error = $idoc->Import('PE_ERROR_PRIOR_TO_APPLICATION');
$errorstr = $error->structure();
$data = $idoc->Table('PT_IDOC_DATA_RECORDS_40');
$datastr = $data->structure();


# FM IDOC_RECORD_READ gives the current IDOC interface structure
#  at this release level

$date = sapdate();
$client = '001';
$cnt = 1;
# setup the control record
$controlstr->TABNAM('EDI_DC40');
$controlstr->MANDT($client);
$controlstr->DOCREL('45B');
$controlstr->DIRECT('2');
$controlstr->IDOCTYP('ORDERS01');
$controlstr->MESTYP('ORDERS');
$controlstr->SNDPOR('A000000015');
$controlstr->SNDPRT('LS');
$controlstr->SNDPFC('AG');
$controlstr->SNDPRN('SALES');
$controlstr->RCVPOR('SAPC11');
$controlstr->RCVPRT('LS');
#$controlstr->RCVPFC('SP');
$controlstr->RCVPRN('SALES');
$controlstr->CREDAT($date);
$control->value( $controlstr->Value() );
$row = $controlstr->Value();
$row =~ s/^(.*?)\s*$/$1/;
print "CONTROL: ", $row, "\n";

# setup each segment and add to the data records
$level = '01';
$str = $SEGMENTS{'E1EDK01'}->{STRUCTURE};
$str->Value( undef );
$str->ACTION('000');
$str->BSART('OR');
#$str->ABRVW('E');
&addseg();

$level = '02';
$str = $SEGMENTS{'E1EDK14'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('008'); # sales org
$str->ORGID('0001');
&addseg();

$level = '02';
$str = $SEGMENTS{'E1EDK14'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('007'); # Dist channel
$str->ORGID('01');
&addseg();

$level = '02';
$str = $SEGMENTS{'E1EDK14'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('006'); # Division
$str->ORGID('01');
&addseg();

$level = '02';
$str = $SEGMENTS{'E1EDK14'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('016'); # Sales Office
$str->ORGID('0001');
&addseg();



$str = $SEGMENTS{'E1EDK03'}->{STRUCTURE};
$str->Value( undef );
$str->IDDAT('011');  # IDOC Date
$str->DATUM($date);
&addseg();

$str = $SEGMENTS{'E1EDK03'}->{STRUCTURE};
$str->Value( undef );
$str->IDDAT('012');  # Document Date
$str->DATUM($date);
&addseg();


$str = $SEGMENTS{'E1EDK03'}->{STRUCTURE};
$str->Value( undef );
$str->IDDAT('022');  # Purchase Order Date
$str->DATUM($date);
&addseg();


$str = $SEGMENTS{'E1EDK03'}->{STRUCTURE};
$str->Value( undef );
$str->IDDAT('023');  # Pricing Date
$str->DATUM($date);
&addseg();


$str = $SEGMENTS{'E1EDKA1'}->{STRUCTURE};
$str->Value( undef );
$str->PARVW('AG');  # Sold TO
$str->PARTN('1');
&addseg();


$str = $SEGMENTS{'E1EDK02'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('001');
$str->BELNR('x3');
$str->DATUM($date);
&addseg();

$str = $SEGMENTS{'E1EDK17'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('001');
$str->LKOND('CFR');
$str->LKTEXT('');
&addseg();

$str = $SEGMENTS{'E1EDK17'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('002');
$str->LKOND('');
$str->LKTEXT('x');
&addseg();

$str = $SEGMENTS{'E1EDP01'}->{STRUCTURE};
$str->Value( undef );
$str->POSEX('00010');
$str->ACTION('001');
$str->PSTYP('0');
$str->ABRVW('E  ');
$str->WERKS('0001');
$str->MATNR('000000000000000003');
$str->MENGE('12345');
&addseg();

$level = '03';
$str = $SEGMENTS{'E1EDP19'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('002');
$str->IDTNR('000000000000000003');
&addseg();

$level = '02';
$str = $SEGMENTS{'E1EDP01'}->{STRUCTURE};
$str->Value( undef );
$str->POSEX('00020');
$str->ACTION('001');
$str->PSTYP('0');
$str->ABRVW('E  ');
$str->WERKS('0001');
#$str->MATNR('000000000000000011');
$str->MENGE('45');
&addseg();

$level = '03';
$str = $SEGMENTS{'E1EDP19'}->{STRUCTURE};
$str->Value( undef );
$str->QUALF('002');
$str->IDTNR('000000000000000002');
&addseg();


for (1..2){
# post the IDOC
#  $r = $rfc->callrfc($idoc);
  $r = $rfc->xmlrfc($idoc);
  if ($r){
    print " RFC ERROR:  \n";
      %h = $rfc->return();
      map { print "   KEY $_ = $h{$_} \n" } keys %h;
    exit 0;
  }

# play back the messages

  print "IDOC NUMBER: ", $number->value(), "\n";
  print "IDOC MESSAGE: ", $error->value(), "\n";

  print "do status check \n";
# get IDOC status
  get_status( $number->value());

}

$rfc->close();



# add each segment to the data table
sub addseg {

$datastr->Value( undef );
$datastr->SEGNAM( $str->Name );
$datastr->MANDT($client);
$datastr->HLEVEL($level);
$datastr->SEGNUM($cnt++);
if ( $datastr->HLEVEL < '03' ){
  $last = $datastr->SEGNUM;
} else {
  $datastr->PSGNUM($last);
}
$datastr->SDATA($str->Value());
$data->addrow( $datastr->Value() );
$row = $datastr->Value();
$row =~ s/^(.*?)\s*$/$1/;
print "DATA: ", $row, "\n";

}

# print out details of the segments 
sub printseg {

map { $seg = $SEGMENTS{$_}->{STRUCTURE}; 
      print " SEGMENT: ", $seg->Name(), "\n";
      $seg->Gencode('./sales_struct.pl');
      #map { $f = $seg->{FIELDS}->{$_};
      map { $f = $_;
              print "   FIELD: ",
                     #$f->{FIELDNAME}, "  ",
                     $f, "  ",
                     #$f->{INTLEN}, "  ",
                     $seg->Fieldlength($f), "  ",
                     $seg->Fieldtype($f), "  ",
                      "\n"
		} ( $seg->Fields())
		#} keys %{$seg->{FIELDS}}
		    } keys %SEGMENTS;

}

# retrieve the status records for an IDOC
sub get_status {

  my $docnum = shift;
  $rfc->discover('RFC_READ_TABLE') 
    if ! $rfc->Interface('RFC_READ_TABLE');
  my $iedids = $rfc->Interface('RFC_READ_TABLE');
  $iedids->emptyTables();
  my ($data, $fields, $options) = $iedids->Tables();
  $iedids->Export('QUERY_TABLE')->value("EDIDS");
  $data->structure( $rfc->structure('EDIDS') );
  map { $data->structure->deleteField($_) } ( 'MANDT', 'TID', 'STATXT');
  $fields->addrow( $data->structure->Fields() );
  $options->addrow("DOCNUM = \'$docnum\'"); 
#  my $r = $rfc->callrfc($iedids);
  my $r = $rfc->xmlrfc($iedids);
  while ( my $i = $data->nextrow() ){
    print "Status: ", $data->structure->DOCNUM, "  ",
                      int($data->structure->COUNTR), "  ",
                      $data->structure->LOGDAT, "  ",
                      $data->structure->LOGTIM, "  ",
                      $data->structure->STATUS, "  ",
                      $data->structure->STATYP, "  ",
                      $data->structure->STAMQU, "  ",
                      $data->structure->STAMNO, "  ",
                      $data->structure->UNAME, "  ",
                      $data->structure->STAPA1, "  ",
                      $data->structure->STAPA2, "  ",
                      $data->structure->STAPA3, "  ",
                      $data->structure->STAPA4, "\n";
  };

}

