LS - Perl module for building clients and servers which resolve and perform

 use LS::ID;
 use LS::Locator;

 $lsid = LS::ID->new(
    'urn:lsid:biomoby.org:servicetype:Retrieval:2001-09-21T16-00-00Z'
     );

 $locator = LS::Locator->new();
 $authority = $locator->resolveAuthority($lsid);

 $resource = $authority->getResource($lsid);

 $data = $resource->getData();

 $response = $data->response();

 # $response is a filehandle, so you can use it as with any other

 print <$response>;

 Creates default accessor methods for an array ref of method names
 in the package specified by $package

 Package error string.

 Holds the Carp stack traces

 Appends additional information to the error string
 Parameters - $extraMessage, Required. The additional information to store.

 Parameters - $errorMessage, Required. The message to be stored in the class's
 rror string.

 Appends a Carp stack trace to the error string

 Retrieves a copy (in the form of an arrayref) of the 
 stack traces associated with this object.

 Returns - An arrayref that is a COPY of the arrayref containing
 all of the stack traces.

 Determins whether or not a stack trace is present

 Returns - True if there is a stack trace
 		   False / undef if no stack trace is available
=cut

 Clears the stack trace

 Returns one of two error strings:

 1. if the class has been blessed in to a reference, the internal
 class error string is returned.
 2. if the class has not been blessed in to a reference, the package
 error string is returned.

 These values may be undef if no error has occured.

 Synonym for errorString

 Returns the complete error with all applicable 
 stack traces.

 Returns - A very detailed error message

# =====================================================================
# Copyright (c) 2002,2003 IBM Corporation
# All rights reserved.  This program and the accompanying materials
# are made available under the terms of the Common Public License v1.0
# which accompanies this distribution, and is available at
# http://www.opensource.org/licenses/cpl.php
#
# =====================================================================
use Error qw(:try);

package LS;

use 5.006;
use strict;
use warnings;

our $VERSION = '1.1.7';

sub makeAccessorMethods {

	my $methodList = shift;
	my $package = shift;
	
	unless(UNIVERSAL::isa($methodList, 'ARRAY')) {
	
		return undef;
	}
	
	unless($package) {
		
		return undef;
	}
	
	# 
	# Create the accessor / mutator methods for the bindings class
	#
	for my $field (@{ $methodList }) {
	
		no strict "refs";
	
		my $slot = "${package}__${field}";
		my $fn = "${package}::${field}";
		
		*$fn= sub {
	
			my $self = shift;
			
			@_ ? $self->{ $slot } = $_[0] : return $self->{ $slot };
		}
	}
}

package LS::Base;

use strict;
use warnings;

use vars qw( $_ERR $_STACK_TRACE );

use Carp qw(:DEFAULT);

$_ERR = '';

$_STACK_TRACE = [];

sub appendError {

	my ($self, $error) = @_;

	if($self && ref $self) {

		$self->{'_err'} .= "\n -> $error";
	}
	else {

		$_ERR .= "\n -> $error";
	}
}

sub recordError {

	my ($self, $error) = @_;

	if($self && ref $self) {

		$self->{'_err'} = $error;
	}
	else {

		$_ERR = $error;
	}
}

sub addStackTrace {

	my $self = shift;
	my $previousTraces = shift;

	if($self && ref $self) {

		# Initialize the stack traces on the first call
		$self->{'_stack_trace'} = [] unless(UNIVERSAL::isa($self->{'_stack_trace'}, 'ARRAY'));

		# Copy an applicable stack traces in before adding our own
		@{ $self->{'_stack_trace'} } = @{ $previousTraces } if( ref $previousTraces eq 'ARRAY');

		push @{ $self->{'_stack_trace'} }, Carp::longmess('Stack trace');
	}
	else {

		# Copy an applicable stack traces in before adding our own
		@{ $_STACK_TRACE } = @{ $previousTraces } if( ref $previousTraces eq 'ARRAY');

		push @{ $_STACK_TRACE }, Carp::longmess('Stack trace');
	}
}

sub getStackTrace {

	my $self = shift;

	my $copy = [];

	foreach my $st (@{ $self->{'_stack_trace'} }) {

		push @{ $copy }, $st;
	}

	# Eh, there won't be that many of them
	@{ $copy } = reverse( @{ $copy } );

	return $copy;
}

sub hasStackTrace {

	my $self = shift;

	if($self && ref $self) {

		return (scalar(@{ $self->{'_stack_trace'} } > 0) );
	}
	else {

		return (scalar(@{ $_STACK_TRACE }) > 0);
	}
}

sub clearStackTrace {

	my $self = shift;

	if($self && ref $self) {

		$self->{'_stack_trace'} = [];
	}
	else {

		$_STACK_TRACE = [];
	}
}

sub errorString {

        my $self = shift;

        if ($self && ref $self) {

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

        return $_ERR;
}

sub error_string {

        my $self = shift;
        return $self->errorString();
}

sub errorDetails {

        my $self = shift;

	my $errorMessage;

        if ($self && ref $self) {

		$errorMessage = $self->{'_err'};

		foreach my $st (@{ $self->{'_stack_trace'} }) {

			$errorMessage .= "\n\n" . $st;
		}

		return $errorMessage;
        }

	$errorMessage = $_ERR;

	foreach my $st (@{ $self->{'_stack_trace'} }) {

		$errorMessage .= "\n\n" . $st;
	}

        return $errorMessage;
}

package LS::Exception;

use strict;
use warnings;

use base 'Error';
use overload ('""' => 'stringify');


sub new
{
	my $self = shift;
	
	my $text = shift;
	my $object = shift;
	
	local $Error::Depth = $Error::Depth + 1;
	local $Error::Debug = 1;
	
	return $self->SUPER::new(-text=> ($text || ""), -object=> $object);
}


package LS::InvalidParameterException;
use base 'LS::Exception';

package LS::MalformedParameterException;
use base 'LS::Exception';

package LS::RuntimeException;
use base 'LS::Exception';

package LS::ClientException;
use base 'LS::Exception';

1;

__END__