plstaf.pm

Software Testing Automation Framework (STAF)的开发代码

#############################################################################
# Software Testing Automation Framework (STAF)                              #
# (C) Copyright IBM Corp. 2001                                              #
#                                                                           #
# This software is licensed under the Common Public License (CPL) V1.0.     #
#############################################################################

###############################################################################
# THIS MODULE IS REQUIRED BY ALL PERL APPS THAT WANT TO INTERACT WITH STAF    #
# AND SHOULD NOT BE MODIFIED.                                                 #
###############################################################################

package PLSTAF;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration       use PLSTAF ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
        
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
        
);

our $VERSION = '3.0';

require XSLoader;
XSLoader::load('PLSTAF', $VERSION);

sub STAF::Submit2
{
    if ($#_ < 3)
    {
        die "Usage: STAF::Submit2(SYNCOPTION, MACHINE, SERVICE, REQUEST)\n";
    }

    my $syncoption = shift;

    return STAF::Submit(shift, shift, shift, $syncoption);
}

sub STAF::STAFHandle::new
{
    if ($#_ < 1)
    {
        die 'Usage: $handle = STAFHandle->new(NAME)';
    }

    my $type = shift;
    my $self = {};

    $self->{rc}     = STAF::Register(shift);
    $self->{handle} = $STAF::Handle;

    return bless $self, $type;
}

sub STAF::STAFHandle::submit
{
    if ($#_ < 3)
    {
        die 'Usage: $handle->submit(MACHINE, SERVICE, REQUEST)';
    }

    my $self = shift;
    $STAF::Handle = $self->{handle};

    $self->{rc} = STAF::Submit(shift, shift, shift);

    return STAF::STAFResult->new($STAF::RC, $STAF::Result);
}

sub STAF::STAFHandle::submit2
{
    if ($#_ < 4)
    {
        die 'Usage: $handle->submit2(SYNCOPTION, MACHINE, SERVICE, REQUEST)';
    }

    my $self = shift;

    $self->{rc} = STAF::Submit2(shift, shift, shift, shift);

    return STAF::STAFResult->new($STAF::RC, $STAF::Result);
}

sub STAF::STAFHandle::unRegister
{
    if ($#_ < 0)
    {
        die 'Usage: $handle->unRegister()';
    }

    my $self = shift;
    $STAF::Handle = $self->{handle};

    $self->{rc} = STAF::UnRegister();

    return $STAF::RC;
}

sub STAF::STAFResult::new
{
    if ($#_ < 2)
    {
        die "Usage: STAFResult->new(RC, RESULT)\n";
    }

    my $type   = shift;
    my $self   = {};

    $self->{rc}     = shift;
    $self->{result} = shift;

    return bless $self, $type;
}

sub STAF::WrapData
{
    if ($#_ < 0)
    {
        die "Usage: STAF::WrapData(MESSAGE)\n";
    }

    my $text = shift;
    return ":".length($text).":$text";
}

sub STAF::STAFUtil::WrapData
{
    if ($#_ < 0)
    {
        die "Usage: STAFUtil::WrapData(MESSAGE)\n";
    }

    my $text = shift;
    return ":".length($text).":$text";
}

################################################################################

sub STAF::STAFMapClassDefinition::new
{
    my $type = shift;
    my $self = {};

    $self->{keys} = [];
    $self->{name}  = shift;

    return bless $self, $type;
}


sub STAF::STAFMapClassDefinition::_new
{
    my $type = shift;
    my $self = shift;

    return bless $self, $type;
}


sub STAF::STAFMapClassDefinition::name
{
    my $self = shift;

    return $self->{name};
}


sub STAF::STAFMapClassDefinition::addKey
{
    my $self = shift;
    my %key = ( 'key' => shift );

    $key{'display-name'} = shift if (@_);

    push @{$self->{keys}}, \%key;
}


sub STAF::STAFMapClassDefinition::setKeyProperty
{
    my $self = shift;
    my $keyName = shift;
    my $keyProperty = shift;
    my $keyValue = shift;

    for my $key ($self->keys())
    {
        $key->{$keyProperty} = $keyValue if ($key->{key} eq $keyName);
    }
}


sub STAF::STAFMapClassDefinition::keys
{
    my $self = shift;

    return @{$self->{keys}};
}


sub STAF::STAFMarshallingContext::new
{
    my $type = shift;
    my $self = { mapClassMap => {}, rootObject => undef };

    return bless $self, $type;
}

sub STAF::STAFMarshallingContext::setMapClassDefinition
{
    my $self = shift;
    my $mapClassDef = shift;

    $self->{mapClassMap}{$mapClassDef->name()} = $mapClassDef;
}

sub STAF::STAFMarshallingContext::getMapClassDefinition
{
    my $self = shift;
    my $mapClassDefName = shift;

    if (exists($self->{mapClassMap}{$mapClassDefName}))
    {
        return STAF::STAFMapClassDefinition->_new(
                   $self->{mapClassMap}{$mapClassDefName});
    }
    else
    {
        return STAF::STAFMapClassDefinition->new(undef);
    }
}

sub STAF::STAFMarshallingContext::hasMapClassDefinition
{
    my $self = shift;
    my $mapClassDefName = shift;

    return exists($self->{mapClassMap}{$mapClassDefName});
}

sub STAF::STAFMarshallingContext::mapClassDefinitionList()
{
    my $self = shift;

    return sort keys %{$self->{mapClassMap}};
}

sub STAF::STAFMarshallingContext::setRootObject
{
    my $self = shift;

    $self->{rootObject} = shift;
}

sub STAF::STAFMarshallingContext::getRootObject
{
    my $self = shift;

    return $self->{rootObject};
}

sub STAF::STAFMarshallingContext::getPrimaryObject()
{
    my $self = shift;

    return (keys %{$self->{mapClassMap}} > 0) ? $self : $self->{rootObject};
}


sub STAF::STAFIsMarshalledData
{
    return shift =~ /\@SDT\//;
}

sub STAF::STAFUnmarshall
{
    my $input = shift;
    my $inputContext = STAF::STAFMarshallingContext->new();

    if (@_ && (ref($_[0]) eq "STAF::STAFMarshallingContext"))
    {
        $inputContext = shift;
    }

    my %parms = (@_);
    my $context = STAF::STAFMarshallingContext->new();

    # @SDT<type><typeInfo>:<length>:<data>

    my ($type, $typeInfo, $length, $data) =
        ($input =~ m/^\@SDT\/(.)([^:]*):([^:]*):(.*)/so);
    
    if ($type eq "\$")
    {
        if (($typeInfo eq "S") && ($data =~ /\@SDT\//) &&
            (!exists($parms{IGNORE_INDIRECT_OBJECTS}) ||
             !$parms{IGNORE_INDIRECT_OBJECTS}))
        {
            $context = STAF::STAFUnmarshall($data, $inputContext, %parms);
        }
        elsif ($typeInfo ne "0")
        {
            $context->setRootObject($data);
        }