File Coverage

blib/lib/Class/STAF.pm

Criterion	Covered	Total	%
statement	52	74	70.2
branch	5	10	50.0
condition			n/a
subroutine	14	20	70.0
pod	0	5	0.0
total	71	109	65.1

package Class::STAF;
use strict;
use threads::shared;
use Class::STAF::Marshalled qw(:all);

our $VERSION = 0.02;
our @ISA = qw{Exporter};

our @EXPORT = qw{
    Marshall
    UnMarshall
};

our @EXPORT_OK = qw{
    get_staf_fields
    get_staf_class_name
};

my %thread_ref_count;
my $id_counter = 1;

sub new {
    my ($class, $processName) = @_;
    require PLSTAF;
    my $handle = STAF::STAFHandle->new($processName);
    if ($handle->{rc} != $STAF::kOk) {
        $! = $handle->{rc};
        return;
    }
    my $refcount : shared = 1;
    my $key = $id_counter++;
    $thread_ref_count{$key} = \$refcount;
    return bless {handle => $handle, refcount => $key}, $class;
}

sub CLONE {
    foreach (values %thread_ref_count) {
        lock $$_;
        $$_++;
    }
}

sub submit {
    my ($self, $location, $service, $request) = @_;
    my $result = $self->{handle}->submit($location, $service, $request);
    if ($result->{rc} != $STAF::kOk) {
        $! = $result->{rc};
        $self->{LastError} = $result->{result};
        return;
    }
    return $result->{result};
}

sub submit2 {
    my ($self, $syncOption, $location, $service, $request) = @_;
    my $result = $self->{handle}->submit2($syncOption, $location, $service, $request);
    if ($result->{rc} != $STAF::kOk) {
        $! = $result->{rc};
        $self->{LastError} = $result->{result};
        return;
    }
    return $result->{result};
}

sub host {
    my ($self, $hostname) = @_;
    return Class::STAF::Host->new($self, $hostname);
}

sub LastError {
    my $self = shift;
    return $self->{LastError};
}

sub DESTROY {
    my $self = shift;
    my $key = $self->{refcount};
    {
        my $ref = $thread_ref_count{$key};
        lock $$ref;
        $$ref--;
        delete $thread_ref_count{$key};
        return unless $$ref == 0;
    }
    my $rc = $self->{handle}->unRegister();
    if ($rc != $STAF::kOk) {
        warn "Failed to unRegister from STAF";
    }
}

package # hide?
    Class::STAF::Host;

sub new {
    my ($class, $parent, $hostname) = @_;
    my $self = { Parent => $parent, Host => $hostname };
    return bless $self, $class;
}

sub submit {
    my ($self, $service, $request) = @_;
    return $self->{Parent}->submit($self->{Host}, $service, $request);
}

sub submit2 {
    my ($self, $syncOption, $service, $request) = @_;
    return $self->{Parent}->submit2($syncOption, $self->{Host}, $service, $request);
}

sub LastError {
    my $self = shift;
    return $self->{Parent}->{LastError};
}

sub service {
    my ($self, $service) = @_;
    return Class::STAF::Service->new($self->{Parent}, $self->{Host}, $service);
}

package # hide?
    Class::STAF::Service;

sub new {
    my ($class, $parent, $hostname, $service) = @_;
    my $self = { Parent => $parent, Host => $hostname, Service => $service };
    return bless $self, $class;
}

sub submit {
    my ($self, $request) = @_;
    return $self->{Parent}->submit($self->{Host}, $self->{Service}, $request);
}

sub submit2 {
    my ($self, $syncOption, $request) = @_;
    return $self->{Parent}->submit2($syncOption, $self->{Host}, $self->{Service}, $request);
}

sub LastError {
    my $self = shift;
    return $self->{Parent}->{LastError};
}

1;

__END__