#!/usr/bin/perl
use strict;
use SAP::Rfc;
use Data::Dumper;
use File::Path;
use Env;
use Net::SMTP;
my $rfc = new SAP::Rfc(
ASHOST => 'server',
USER => 'rfcuser',
PASSWD => 'password',
LANG => 'EN',
CLIENT => '100',
SYSNR => '00',
TRACE => '0'
);
sub valide_bon
{
my $vbeln=$_[0];
my $it = $rfc->discover("ZRFC_PICKING_VALIDE");
$it->NUMERO($vbeln);
my $ret= $rfc->callrfc($it) ;
# Enregistrement Sortie Marchandises
my $it2 = $rfc->discover("ZRFC_OUTBOUND_PGI"); ## cette fonction appelle le programme ZOUTBOUND_VALID
$it2->NUMERO($vbeln);
$rfc->callrfc($it2) ;
}
sub ligne_odelivery{
my $vbeln=$_[0];
my $it_listOrder = $rfc->discover("ZPICKING");
$it_listOrder->SHIP_POINT('ZBFC');
$it_listOrder->NDELIVERY($vbeln);
$rfc->callrfc($it_listOrder);
return $it_listOrder->tab('DATA')->hashRows();
}
my $vbeln='0080014147'; # Outboud Delivery Number
valide_bon($vbeln);
my @lignes =ligne_odelivery($vbeln);
my $it = $rfc->discover("BAPI_GOODSMVT_CREATE");
$it->GOODSMVT_CODE('01');
my $table_item = $it->tab('GOODSMVT_ITEM');
my $s = $rfc->structure('BAPI2017_GM_ITEM_CREATE');
foreach my $ligne (@lignes)
{
my $plant = $ligne->{'WERKS'};
my $lot = $ligne->{'CHARG'};
my $uom = $ligne->{'MEINS'};
my $qte = $ligne->{'LFIMG'};
print $ligne->{'UMVKZ'}."\n";
print $qte." : ".$uom."\n";
my $item=[{MOVE_TYPE=>'101',
DELIV_NUMB=>$ligne->{'VBELN'},
DELIV_ITEM=>$ligne->{'POSNR'},
PLANT=>$plant,
STGE_LOC=>$ligne->{'LGORT'},
ENTRY_QNT=>$qte,
ENTRY_UOM=>$uom,
PO_NUMBER=>$ligne->{'VGBEL'},
PO_ITEM=>$ligne->{'POSNR'},
MVT_IND=>'B'}];
$table_item->rows($item);
}
$it->GOODSMVT_HEADER({'REF_DOC_NO'=>$vbeln,'PSTNG_DATE'=>'20070123','DOC_DATE'=>'20070123','pr_uname'=>'USER'});
$rfc->callrfc($it);
print "Numero material Document : ".$it->MATERIALDOCUMENT."\n";
print "Annee material Document : ". $it->MATDOCUMENTYEAR."\n";
foreach my $message ($it->tab('RETURN')->hashRows())
{
print $message->{'MESSAGE'}."\n";
}
print $rfc->error;
$it = $rfc->discover("BAPI_TRANSACTION_COMMIT");
$rfc->callrfc($it) ;
$rfc->close();