home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Iface.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-14  |  15.2 KB  |  747 lines
  1. package SAP::WAS::Iface;
  2.  
  3. use strict;
  4. use vars qw($VERSION $AUTOLOAD);
  5.  
  6.  
  7. # Globals
  8.  
  9. # Valid parameters
  10. my $VALID = {
  11.    NAME => 1,
  12.    PARAMETERS => 1,
  13.    TABLES => 1,
  14.    EXCEPTIONS => 1
  15. };
  16.  
  17. $VERSION = '0.02';
  18.  
  19. # empty destroy method to stop capture by autoload
  20. sub DESTROY {
  21. }
  22.  
  23. sub AUTOLOAD {
  24.  
  25.   my $self = shift;
  26.   my @parms = @_;
  27.   my $type = ref($self)
  28.           or die "$self is not an Object in autoload of Iface";
  29.   my $name = $AUTOLOAD;
  30.   $name =~ s/.*://;
  31.  
  32. # Autoload parameters and tables
  33.   if ( exists $self->{PARAMETERS}->{uc($name)} ) {
  34.       &Parm($self, $name);
  35.   } elsif ( exists $self->{TABLES}->{uc($name)} ) {
  36.       &Tab($self, $name);
  37.   } else {
  38.       die "Parameter $name does not exist in Interface - no autoload";
  39.   };
  40. }
  41.  
  42.  
  43. # Construct a new SAP::Interface object
  44. sub new {
  45.  
  46.   my $proto = shift;
  47.   my $class = ref($proto) || $proto;
  48.   my $self = {
  49.       PARAMETERS => {},
  50.       TABLES => {},
  51.       EXCEPTIONS => {},
  52.     @_
  53.   };
  54.   die "No RFC Name supplied to Interface !" if ! exists $self->{NAME};
  55.  
  56. # Validate parameters
  57.   map { delete $self->{$_} if ! exists $VALID->{$_} } keys %{$self};
  58.   $self->{NAME} = $self->{NAME};
  59.  
  60. # create the object and return it
  61.   bless ($self, $class);
  62.   return $self;
  63. }
  64.  
  65.  
  66. # get the name
  67. sub name {
  68.  
  69.   my $self = shift;
  70.   return $self->{NAME};
  71.  
  72. }
  73.  
  74.  
  75. # Add an export parameter Object
  76. sub addParm {
  77.  
  78.   my $self = shift;
  79.   die "No parameter supplied to Interface !" if ! @_;
  80.   my $parm;
  81.   if (my $ref = ref($_[0])){
  82.       die "This is not an Parameter for the Interface - $ref ! "
  83.       if $ref ne "SAP::WAS::Parms";
  84.       $parm = $_[0];
  85.   } else {
  86.       $parm = SAP::WAS::Parms->new( @_ );
  87.   };
  88.  
  89.   return $self->{PARAMETERS}->{$parm->name()} = $parm;
  90.  
  91. }
  92.  
  93.  
  94. # Access the export parameters
  95. sub Parm {
  96.  
  97.   my $self = shift;
  98.   die "No parameter name supplied for interface" if ! @_;
  99.   my $parm = uc(shift);
  100.   die "Export $parm Does not exist in interface !"
  101.            if ! exists $self->{PARAMETERS}->{$parm};
  102.   return $self->{PARAMETERS}->{$parm};
  103.  
  104. }
  105.  
  106.  
  107. # Return the parameter list
  108. sub Parms {
  109.  
  110.   my $self = shift;
  111.   return sort { $a->name() cmp $b->name() } values %{$self->{PARAMETERS}};
  112.  
  113. }
  114.  
  115.  
  116. # Add an Table Object
  117. sub addTab {
  118.  
  119.   my $self = shift;
  120.   die "No Table supplied for interface !" if ! @_;
  121.   my $table;
  122.   if ( my $ref = ref($_[0]) ){
  123.       die "This is not a Table for interface: $ref ! "
  124.       if $ref ne "SAP::WAS::Tab";
  125.       $table = $_[0];
  126.   } else {
  127.       $table = SAP::WAS::Tab->new( @_ );
  128.   };
  129.   return $self->{TABLES}->{$table->name()} = $table;
  130.  
  131. }
  132.  
  133.  
  134. # Access the Tables
  135. sub Tab {
  136.  
  137.   my $self = shift;
  138.   die "No Table name supplied for interface" if ! @_;
  139.   my $table = uc(shift);
  140.   die "Table $table Does not exist in interface  !"
  141.      if ! exists $self->{TABLES}->{ $table };
  142.   return $self->{TABLES}->{ $table };
  143.  
  144. }
  145.  
  146.  
  147. # Return the Table list
  148. sub Tabs {
  149.  
  150.   my $self = shift;
  151.   return sort { $a->name() cmp $b->name() } values %{$self->{TABLES}};
  152.  
  153. }
  154.  
  155.  
  156. # Empty The contents of all tables in an interface
  157. sub emptyTables {
  158.  
  159.   my $self = shift;
  160.   map {
  161.       my $table = $self->{TABLES}->{ $_ };
  162.       $table->empty();
  163.   } keys %{$self->{TABLES}};
  164.  
  165. }
  166.  
  167.  
  168. =head1 NAME
  169.  
  170. SAP::WAS::Iface - Perl extension for parsing and creating an Interface Object.  The interface object would then be passed to the SAP::WAS::SOAP object to carry out the actual call, and return of values.
  171.  
  172. =head1 SYNOPSIS
  173.  
  174.   use SAP::WAS::Iface;
  175.   $iface = new SAP::WAS::Iface( NAME =>"SAPWAS:ServiceName" );
  176.  
  177.   NAME is mandatory.
  178.  
  179. =head1 DESCRIPTION
  180.  
  181. This class is used to construct a valid interface object ( SAP::WAS::Iface.pm ).
  182. The constructor requires the parameter value pairs to be passed as
  183. hash key values ( see SYNOPSIS ).
  184. Generally you would not create one of these manually as it is far easier to use the "discovery" functionality of the SAP::WAS::SOAP->Iface() method.  Tis takes the name of an existing WAS service, and returns a fully formed interface object.
  185.  
  186. Methods:
  187. new
  188.   use SAP::WAS::Iface;
  189.   $iface = new SAP::WAS::Iface( NAME =>"SAPWAS:ServiceName" );
  190.  
  191. Create a new Interface object.
  192.  
  193.  
  194. =head1 Exported constants
  195.  
  196.   NONE
  197.  
  198. =cut
  199.  
  200. package SAP::WAS::Tab;
  201.  
  202. use strict;
  203. use vars qw($VERSION);
  204.  
  205. # Globals
  206.  
  207. # Valid parameters
  208. my $VALID = {
  209.    DATA => 1,
  210.    NAME => 1,
  211.    STRUCTURE => 1
  212. };
  213.  
  214. # Construct a new SAP::WAS::Table object.
  215. sub new {
  216.  
  217.   my $proto = shift;
  218.   my $class = ref($proto) || $proto;
  219.   my $self = {
  220.      DATA => [],
  221.      TYPE => "chars",
  222.      @_
  223.   };
  224.  
  225.   die "Table Name not supplied !" if ! exists $self->{NAME};
  226.   die "Table Structure not supplied !" if ! exists $self->{STRUCTURE};
  227.  
  228. # Validate parameters
  229.   map { delete $self->{$_} if ! exists $VALID->{$_} } keys %{$self};
  230.   $self->{NAME} = uc($self->{NAME});
  231.  
  232. # create the object and return it
  233.   bless ($self, $class);
  234.   return $self;
  235.  
  236. }
  237.  
  238.  
  239. # Set/get the table rows - pass a reference to a anon array
  240. sub rows {
  241.  
  242.   my $self = shift;
  243.   $self->{DATA} = shift if @_;
  244.   return @{$self->{DATA}};
  245.  
  246. }
  247.  
  248.  
  249. # Return the next available row from a table
  250. sub nextrow {
  251.  
  252.   my $self = shift;
  253.   my $row = shift  @{$self->{DATA}};
  254.  
  255.   return { map {$self->structure->Fieldname( $_ ) => $row->[$_ - 1] }
  256.   ( 1 .. scalar @{[$self->structure->Fields]} ) } if $row;
  257.  
  258. }
  259.  
  260.  
  261. # Set/get the structure parameter
  262. sub structure {
  263.  
  264.   my $self = shift;
  265.   $self->{STRUCTURE} = shift if @_;
  266.   return $self->{STRUCTURE};
  267.  
  268. }
  269.  
  270.  
  271. # add a row
  272. sub addrow {
  273.  
  274.   my $self = shift;
  275.   push(@{$self->{DATA}}, @_) if @_;
  276.  
  277. }
  278.  
  279.  
  280. # Delete all rows in the table
  281. sub empty {
  282.  
  283.   my $self = shift;
  284.   $self->{DATA} = [ ];
  285.   return @{$self->{DATA}};
  286.  
  287. }
  288.  
  289. # Get the table name
  290. sub name {
  291.  
  292.   my $self = shift;
  293.   return  $self->{NAME};
  294.  
  295. }
  296.  
  297.  
  298. # Get the number of rows
  299. sub rowcount {
  300.  
  301.   my $self = shift;
  302.   return  $#{$self->{DATA}} + 1;
  303.  
  304. }
  305.  
  306.  
  307.  
  308. # Autoload methods go after =cut, and are processed by the autosplit program.
  309.  
  310.  
  311. =head1 NAME
  312.  
  313. SAP::WAS::Tab - Perl extension for parsing and creating Tables to be added to an RFC Iface.
  314.  
  315. =head1 SYNOPSIS
  316.  
  317.   use SAP::WAS::Tab;
  318.   $tab1 = new SAP::WAS::Tab( NAME => XYZ, VALUE => abc );
  319.  
  320. =head1 DESCRIPTION
  321.  
  322. This class is used to construct a valid Table object to be add to an interface
  323. object ( SAP::WAS::Iface.pm ).
  324. The constructor requires the parameter value pairs to be passed as
  325. hash key values ( see SYNOPSIS ).
  326.  
  327. Methods:
  328. new
  329.   use SAP::WAS::Tab;
  330.   $tab1 = new SAP::WAS::Tab( NAME => XYZ, ROWLENGTH => 1,
  331.              DATA => [a, b, c, ..] );
  332.  
  333. rows
  334.   @r = $tab1->rows( [ row1, row2, row3 .... ] );
  335.   optionally set and Give the current rows of a table.
  336.  
  337. rowcount
  338.   $c = $tab1->rowcount();
  339.   return the current number of rows in a table object.
  340.  
  341.  
  342. =head1 Exported constants
  343.  
  344.   NONE
  345.  
  346. =cut
  347.  
  348. package SAP::WAS::Parms;
  349.  
  350. use strict;
  351. use vars qw($VERSION);
  352.  
  353. # Globals
  354.  
  355. # Valid parameters
  356. my $VALID = {
  357.    NAME => 1,
  358.    PHASE => 1,
  359.    STRUCTURE => 1,
  360.    TYPE => 1,
  361.    VALUE => 1
  362. };
  363.  
  364. # Valid data types
  365. my $VALTYPE = {
  366.    chars => 1,
  367.    date => 1,
  368.    time  => 1,
  369.    int => 1,
  370.    decimal => 1,
  371.    num => 1,
  372.    float => 1
  373. };
  374.  
  375. # Construct a new SAP::Parms parameter object.
  376. sub new {
  377.  
  378.   my $proto = shift;
  379.   my $class = ref($proto) || $proto;
  380.   my $self = {
  381.      TYPE => "chars",
  382.      VALUE => undef,
  383.      PHASE => 'I',
  384.      @_
  385.   };
  386.  
  387.   die "Parameter Name not supplied !" if ! exists $self->{NAME};
  388.   die "Parameter Type not valid $self->{TYPE} !" 
  389.      if ! exists $VALTYPE->{$self->{TYPE}};
  390.  
  391. # Validate parameters
  392.   map { delete $self->{$_} if ! exists $VALID->{$_} } keys %{$self};
  393.   $self->{NAME} = uc($self->{NAME});
  394.  
  395. # create the object and return it
  396.   bless ($self, $class);
  397.   return $self;
  398. }
  399.  
  400.  
  401. # Set/get the value of phase
  402. sub phase {
  403.  
  404.   my $self = shift;
  405.   $self->{PHASE} = shift if @_;
  406.   return $self->{PHASE};
  407.  
  408. }
  409.  
  410.  
  411. # Set/get the value of type
  412. sub type {
  413.  
  414.   my $self = shift;
  415.   $self->{TYPE} = shift if @_;
  416.   die "Parameter Type not valid $self->{TYPE} !"
  417.      if ! exists $VALTYPE->{$self->{TYPE}};
  418.   return $self->{TYPE};
  419.  
  420. }
  421.  
  422.  
  423. # Set/get the parameter value
  424. sub value {
  425.  
  426.   my $self = shift;
  427.   $self->{VALUE} = shift if @_;
  428.   if ($self->{VALUE}){
  429.       return $self->{VALUE};
  430.   } else {
  431.       return "";
  432.   };
  433.  
  434. }
  435.  
  436.  
  437. # Set/get the parameter structure
  438. sub structure {
  439.  
  440.   my $self = shift;
  441.   $self->{STRUCTURE} = shift if @_;
  442.   return $self->{STRUCTURE};
  443.  
  444. }
  445.  
  446.  
  447. # get the name
  448. sub name {
  449.  
  450.   my $self = shift;
  451.   return $self->{NAME};
  452.  
  453. }
  454.  
  455.  
  456.  
  457. # Below is the stub of documentation for your module. You better edit it!
  458.  
  459. =head1 NAME
  460.  
  461. SAP::WAS::Parms - Perl extension for parsing and creating an SAP parameter to be added to an RFC Interface.
  462.  
  463. =head1 SYNOPSIS
  464.  
  465.   use SAP::WAS::Parms;
  466.   $imp1 = new SAP::WAS::Parms( NAME => XYZ,
  467.              TYPE => chars, VALUE => abc );
  468.  
  469. =head1 DESCRIPTION
  470.  
  471. This class is used to construct a valid parameter to add to an interface
  472. object ( SAP::WAS::Iface.pm ).
  473. The constructor requires the parameter value pairs to be passed as
  474. hash key values ( see SYNOPSIS ).
  475.  
  476. Methods:
  477. new
  478.   use SAP::WAS::Parms;
  479.   $imp1 = new SAP::WAS::Parms( NAME => XYZ,
  480.       TYPE => chars, VALUE => abc );
  481.  
  482. value
  483.   $v = $imp1->value( [ val ] );
  484.   optionally set and Give the current value.
  485.  
  486. type
  487.   $t = $imp1->type( [ type ] );
  488.   optionally set and Give the current value of type.
  489.  
  490. =head1 Exported constants
  491.  
  492.   NONE
  493.  
  494. =cut
  495.  
  496.  
  497. package SAP::WAS::Struc;
  498.  
  499. use strict;
  500. use vars qw($VERSION $AUTOLOAD);
  501.  
  502. #  require AutoLoader;
  503.  
  504. # Globals
  505.  
  506. # Valid parameters
  507. my $VALID = {
  508.    NAME => 1,
  509.    FIELDS => 1
  510. };
  511.  
  512. # Valid Field parameters
  513. my $FIELDVALID = {
  514.    NAME => 1,
  515.    TYPE => 1,
  516.    POSITION => 1,
  517.    VALUE => 1
  518. };
  519.  
  520.  
  521. # Valid data types
  522. my $VALTYPE = {
  523.    chars => 1,
  524.    num => 1,
  525.    int => 1,
  526.    date => 1,
  527.    time => 1,
  528.    decimal => 1,
  529.    float => 1
  530. };
  531.  
  532. # empty destroy method to stop capture by autoload
  533. sub DESTROY {
  534. }
  535.  
  536. sub AUTOLOAD {
  537.  
  538.   my $self = shift;
  539.   my @parms = @_;
  540.   my $type = ref($self)
  541.           or die "$self is not an Object in autoload of Structure";
  542.   my $name = $AUTOLOAD;
  543.   $name =~ s/.*://;
  544.   unless ( exists $self->{FIELDS}->{uc($name)} ) {
  545.       die "Field $name does not exist in structure - no autoload";
  546.   };
  547.   &Fieldvalue($self,$name,@parms);
  548. }
  549.  
  550. # Construct a new SAP::WAS::Struct parameter object.
  551. sub new {
  552.  
  553.   my $proto = shift;
  554.   my $class = ref($proto) || $proto;
  555.   my $self = {
  556.      FIELDS => {},
  557.      @_
  558.   };
  559.  
  560.   die "Structure Name not supplied !" if ! exists $self->{NAME};
  561.   $self->{NAME} = uc($self->{NAME});
  562.  
  563. # Validate parameters
  564.   map { delete $self->{$_} if ! exists $VALID->{$_} } keys %{$self};
  565.  
  566. # create the object and return it
  567.   bless ($self, $class);
  568.   return $self;
  569.  
  570. }
  571.  
  572.  
  573. # Set/get structure field
  574. sub addField {
  575.  
  576.   my $self = shift;
  577.  
  578.   my %field = @_;
  579.   map { delete $field{$_} if ! exists $FIELDVALID->{$_} } keys %field;
  580.   die "Structure NAME not supplied!" if ! exists $field{NAME};
  581.   $field{NAME} = uc($field{NAME});
  582.   $field{NAME} =~ s/ //g;
  583.   die "Structure NAME allready exists - $field{NAME}!" 
  584.      if exists $self->{FIELDS}->{$field{NAME}};
  585.   $field{TYPE} =~ s/ //g;
  586.  
  587.   die "Structure TYPE not supplied!" if ! exists $field{TYPE};
  588.   die "Structure Type not valid $field{TYPE} !" 
  589.      if ! exists $VALTYPE->{$field{TYPE}};
  590.   $field{POSITION} = ( scalar keys %{$self->{FIELDS}} ) + 1;
  591.  
  592.   return $self->{FIELDS}->{$field{NAME}} = 
  593.                     { map { $_ => $field{$_} } keys %field };
  594.  
  595. }
  596.  
  597.  
  598. # Delete a field from the structure
  599. sub deleteField {
  600.  
  601.   my $self = shift;
  602.   my $field = shift;
  603.   die "Structure field does not exist: $field "
  604.      if ! exists $self->{FIELDS}->{uc($field)};
  605.   delete $self->{FIELDS}->{uc($field)};
  606.   return $field;
  607.  
  608. }
  609.  
  610.  
  611. # Set/get the field value and update the overall structure value
  612. sub Fieldvalue {
  613.  
  614.   my $self = shift;
  615.   my $field = shift;
  616.   $field = ($self->Fields)[$field] if $field =~ /^\d+$/;
  617.   die "Structure field does not exist: $field "
  618.      if ! exists $self->{FIELDS}->{uc($field)};
  619.   $field = $self->{FIELDS}->{uc($field)};
  620.   if (scalar @_ > 0){
  621.     $field->{VALUE} = shift @_;
  622.   } 
  623.  
  624.   return $field->{VALUE};
  625.  
  626. }
  627.  
  628.  
  629. # get the field name by position
  630. sub Fieldname {
  631.  
  632.   my $self = shift;
  633.   my $field = shift;
  634. #  print "Number: $field \n";
  635.   die "Structure field does not exist by array position: $field "
  636.      if ! ($self->Fields)[$field - 1];
  637.   return ($self->Fields)[$field - 1 ];
  638.  
  639. }
  640.  
  641.  
  642. # get the name
  643. sub Name {
  644.  
  645.   my $self = shift;
  646.   return $self->{NAME};
  647.  
  648. }
  649.  
  650.  
  651. # return the current set of field names
  652. sub Fields {
  653.  
  654.   my $self = shift;
  655.   return  sort { $self->{FIELDS}->{$a}->{POSITION} cmp
  656.           $self->{FIELDS}->{$b}->{POSITION} }
  657.           keys %{$self->{FIELDS}};
  658.  
  659. }
  660.  
  661.  
  662. =head1 NAME
  663.  
  664. SAP::WAS::Struc - Perl extension for parsing and creating a Structure definition.   The resulting structure object is then used for SAP::WAS::Parms, and SAP::WAS::Tab objects to manipulate complex data elements.
  665.  
  666. =head1 SYNOPSIS
  667.  
  668.   use SAP::WAS::Struc;
  669.   $struct = new SAP::WAS::Struc( NAME => XYZ, FIELDS => [......] );
  670.  
  671. =head1 DESCRIPTION
  672.  
  673. This class is used to construct a valid structure object - a structure object that would be used in an Export(Parms), Import(Parms), and Table(Tab) object ( SAP::WAS::Iface.pm ).
  674. The constructor requires the parameter value pairs to be passed as
  675. hash key values ( see SYNOPSIS ).  The value of each field can either be accessed through $str->Fieldvalue(field1), or through the autoloaded method of the field name eg. $str->field1().
  676.  
  677. Methods:
  678. new
  679.   use SAP::WAS::Struc;
  680.   $str = new SAP::WAS::Struc( NAME => XYZ );
  681.  
  682.  
  683. addField
  684.   use SAP::WAS::Struc;
  685.   $str = new SAP::WAS::Struc( NAME => XYZ );
  686.   $str->addField( NAME => field1,
  687.                   TYPE => chars );
  688.   add a new field into the structure object.  The field is given a position counter of the number of the previous number of fields + 1.  Name is mandatory, but type will be defaulted to chars if omitted.
  689.  
  690.  
  691. deleteField
  692.   use SAP::WAS::Struc;
  693.   $str = new SAP::WAS::Struc( NAME => XYZ );
  694.   $str->addField( NAME => field1,
  695.                   TYPE => chars );
  696.   $str->deleteField('field1');
  697.   Allow fields to be deleted from a structure.
  698.  
  699.  
  700. Name
  701.   $name = $str->Name();
  702.   Get the name of the structure.
  703.  
  704.  
  705. Fieldtype
  706.   $ftype = $str->Fieldtype(field1, [ new field type ]);
  707.   Set/Get the SAP WAS field type of a component field of the structure.  This will force the overall value of the structure to be recalculated.
  708.  
  709.  
  710. Fieldvalue
  711.   $fvalue = $str->Fieldvalue(field1,
  712.                           [new component value]);
  713.   Set/Get the value of a component field of the structure.  This will force the overall value of the structure to be recalculated.
  714.  
  715.  
  716. Field
  717.   $fhashref = $str->Field(field1);
  718.   Set/Get the value of a component field of the structure.  This will force the overall value of the structure to be recalculated.
  719.  
  720.  
  721. Fields
  722.   @f = &$struct->Fields();
  723.   Return an array of the fields of a structure sorted in positional order.
  724.  
  725.  
  726. =head1 Exported constants
  727.  
  728.   NONE
  729.  
  730.  
  731. =head1 AUTHOR
  732.  
  733. Piers Harding, saprfc@kogut.demon.co.uk.
  734.  
  735. But Credit must go to all those that have helped.
  736.  
  737. =head1 SEE ALSO
  738.  
  739. perl(1), SAP::WAS::SOAP(3), SAP::WAS::Iface(3)
  740.  
  741. =cut
  742.  
  743.  
  744. 1;
  745.  
  746. __END__
  747.