SAP::BC - Interface to SAP's Business Connector

SAP-BC-XMLRFC documentation Contained in the SAP-BC-XMLRFC distribution.

Index

Code Index:

NAME

Top

SAP::BC - Interface to SAP's Business Connector

SYNOPSIS

Top

 use SAP::BC;

 my $bc = SAP::BC->new( server   => 'http://karma:5555',
                        user     => 'dj',
                        password => 'secret' );

 my $service_ref = $bc->services(); # list (SAP) services available

DESCRIPTION

Top

SAP::BC is an OO interface that exposes functions within SAP's Business Connector (BC) as methods. It was primarily written as a class for discovering services and their respective RFC components for another module project SAP::BC::Proxy::SOAP which is a SOAP (to RFCXML) proxy for calls to SAP via the BC.

METHODS

Top

new() (constructor)

Use this to create a BC instance. You can pass either a single argument, which is the URL of the BC you want to manipulate, or a list of values, like this:

 my $bc = SAP::BC->new('http://karma:5555'); not allowed after BC 4.x

 or

 my $bc = SAP::BC->new( 'server'   => 'http://karma',
                        'user'     => 'username',
                        'password' => 'secret' ); <= manditory after BC 4.x

where the user and password parameters are the ones for the SAP BC itself.

authentication()

Use this method to get or set the user and password values for authentication with the BC.

SAP_systems()

Use this method to get a list of SAP systems known to the BC. The data will be cached after the first call.

services()

To discover a list of services associated with the SAP systems known to the BC, use this method. You can pass a list of SAP systems for which you want to discover the services, or

if you don't pass anything, services for all the SAP systems known to the BC will be returned. If the SAP systems haven't previously been discovered using the SAP_systems method, this will happen automatically.

A reference to a hash will be returned, with the keys being the service names, and the argument being a hashref with the details, like this:

 { 
   'SOAP:getStateName'   =>
          {
            'sapsys'  => 'LNX',
            'rfcname' => 'Z_SOAP_GET_STATE_NAME',
          },
   'SOAP:getStateStruct' =>
          {
            'sapsys'  => 'LNX',
            'rfcname' => 'Z_SOAP_GET_STATE_STRUCT',
          },
   ...
 }
disconnect()

Disconnects from the BC and frees the session.

_clear_caches()

This is an internal method that removes the cached information (such as that determined by SAP_systems and services - so that the information can be refreshed by another call, if e.g. services have been added to the BC.

properties()

An experimental method that returns a hashref of properties pertaining to the BC instance connected to.

It relies on parsing some HTML, which is flakey at best.

_prime_ua()

An internal method to prime a UserAgent.

SAP-BC-XMLRFC documentation Contained in the SAP-BC-XMLRFC distribution. 
#
#  Utils for SAP Business Connector (BC)
#


package SAP::BC;


use strict;

use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Cookies;

use vars qw($VERSION %BC $COOKIES);

$VERSION = '0.03';

# Not sure about the usefulness of this hash, yet, but I'll
# keep it for now. It keeps the BC implemention details visible.

%BC = (
        'listServers'     => '/invoke/sap.admin.server/list',
        'listServiceMaps' => '/invoke/sap.admin.map/list',
        'getProperties'   => '/WmRoot/server-environment.dsp',
        'disconnect'      => '/invoke/wm.server/disconnect',
      );

$COOKIES = new HTTP::Cookies(hide_cookie2 => 1);

# The constructor.
# Represents a Business Connector instance.


sub new {
  my $class = shift;

  my $self;

  if ($#_ == 0) {     # if there's only one thing passed
    my $arg = shift;
    if (ref($arg) eq 'HASH') {   # and it's a hash-ref
      $self = $arg;              # great - take that for $self
    }
    else {                          # otherwise..
      $self = { 'server' => $arg }; # assume it's the BC's URL
    }
  }
  else {              # otherwise, if there's more stuff passed,
    $self = { @_ };   # so make a hash out of it
  }

# $self->{'server'} =~ s/\/?$//; # remove possible trailing slash
# die "Cannot connect to $self->{'server'}: $!\n" unless get $self->{'server'};

  bless $self, $class;
  return $self;
}


sub authentication {
  my $self = shift;

# Set if passed
  if ($#_ > 0) {
    $self->{'user'} = shift;
    $self->{'password'} = shift;
  }

# Make sure there's no undefs
#  $self->{'user'} ||= '';
#  $self->{'password'} ||= '';

# Return both values
  return ($self->{'user'},$self->{'password'});

}


sub SAP_systems {
# Return a list of SAP systems
  my $self = shift;

  unless (exists ($self->{'SAP_systems'})) {

#   Prime
    $self->{'SAP_systems'} = [];

#   Call service on BC
#    my $res = get "$self->{'server'}$BC{'listServers'}"
#      or die "Cannot retrieve server list: $!\n";
#   Call service on BC
    $self->_prime_ua();
    my $req = HTTP::Request->new('GET', "$self->{'server'}$BC{'listServers'}");
    $req->authorization_basic($self->authentication);
	$req = $self->{'ua'}->prepare_request($req);
    my $res =  $self->{'ua'}->request($req)->content()
        or die "Cannot retrieve server list: $!\n";
    $res =~ s/\n//g;
    # print STDERR "The Server List: ".$res."\n";

#   Parse results for server names
    #foreach (grep(/$BC{'listServiceMaps'}/,split("\n",$res))) {
    foreach (grep(/\>serverName/,split(/<\/TR>/,$res))) {
#     print STDERR "LINE: $_ \n";
      #my ($sapsys) = $_ =~ m/$BC{'listServiceMaps'}\?serverName=(\w{3})/;
      my ($sapsys) = $_ =~ m/(\w+)<\/TD>.*?$/;
      push(@{$self->{'SAP_systems'}},$sapsys);
    }

  }

  return $self->{'SAP_systems'};

}


sub services {
# Return a list of BC (-> SAP) services)
# Can receive an optional list of SAP systems
# to use to restrict the search
  my $self = shift;
  my $sys_list = shift || $self->SAP_systems();

  unless (exists($self->{'services'})) {
	$self->_prime_ua();

#   Prime
    $self->{'services'} = {};

#   Invoke the map list service for each of the SAP systems
    foreach my $sys (@{$sys_list}) {
      my $req = HTTP::Request->new('GET', "$self->{'server'}$BC{'listServiceMaps'}?serverName=$sys");
      $req->authorization_basic($self->authentication);
      my $res =  $self->{'ua'}->request($req)->content()
          or die "Cannot retrieve Service Map for $sys: $!\n";
      $res =~ s/\n//g;
      #print STDERR "SERVICE LIST: $res \n";
      #my $res = get "$self->{'server'}$BC{'listServiceMaps'}?serverName=$sys" 
      #  or die "Cannot retrieve Service Map for $sys: $!\n";

      #foreach my $serviceMap (grep(/editServiceMap.*svcname/,split("\n",$res))) {
      while  ( $res =~ m/serverName<\/b><\/td><td>([\w_]+).*?outboundMaps<\/b><\/td>/gi) {
      my ( $srvname, $outbm ) = ( $1, $' );
      while  ( $outbm =~ m/functionName<\/b><\/td><td>(\w+).*?folder<\/b><\/td><td>([\w.]+).*?service<\/b><\/td><td>(\w+)/gi) {
      my ( $rfcname, $srvpath, $service ) = ( $1, $2, $3 );
#        print STDERR "LINE: $srvname $rfcname $srvpath $service $package \n";
#        my ($sapsys, $rfcname, $service) = 
#	        $serviceMap =~ m/^.*?serverName\=(.*?)\&.*?rfcname\=(.*?)\&.*?svcname\=(.*?)\&.*$/;
        $self->{'services'}->{$srvpath.':'.$service} = {
                                            'sapsys'  => $srvname,
                                            'rfcname' => $rfcname,
                                          };
  
#        $self->{'services'}->{$service} = {
#                                            'sapsys'  => $sapsys,
#                                            'rfcname' => $rfcname,
#                                          };

      }
      }

    }

  }

  return $self->{'services'};
  
}


sub disconnect {
  my $self = shift;
  my $ua = LWP::UserAgent->new(timeout => 5);
  $ua->agent("sap::bc/$VERSION");
  $ua->cookie_jar($COOKIES);
  my $req = HTTP::Request->new('GET', "$self->{'server'}$BC{'disconnect'}");
  $req->authorization_basic($self->authentication);
  my $res = $ua->request($req);
  return 1;
}



sub _clear_caches {
  my $self = shift;
  delete $self->{'SAP_systems'};
  delete $self->{'services'};

  return 1;
}


sub properties {
  my $self = shift;

  unless (exists ($self->{'properties'})) {

#   Prime
    $self->{'properties'} = {};

#   Call service on BC
    $self->_prime_ua();
    my $req = HTTP::Request->new('GET', "$self->{'server'}$BC{'getProperties'}");
    $req->authorization_basic($self->authentication);

    $self->{'scratch'} =  $self->{'ua'}->request($req);

  }

  return $self->{'scratch'};

}


sub _prime_ua {
  my $self = shift;

# Don't do anything if it's already primed
  return if exists $self->{'ua'};

  $self->{'ua'} = LWP::UserAgent->new();
  $self->{'ua'}->agent("sap::bc/$VERSION");
  $self->{'ua'}->cookie_jar($COOKIES);
}



1;