The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#-----------------------------------------------------------------
# SADI::Service::Instance
# Author: Edward Kawas <edward.kawas@gmail.com>,
#
# For copyright and disclaimer see below.
#
# $Id: Instance.pm,v 1.6 2010-03-23 16:30:16 ubuntu Exp $
#-----------------------------------------------------------------
package SADI::Service::Instance;

use SADI::Base;
use base ("SADI::Base");
use strict;

# add versioning to this module
use vars qw /$VERSION/;
$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /: (\d+)\.(\d+)/;

=head1 NAME

SADI::Service::Instance - A module that describes a SADI web service.

=head1 SYNOPSIS

 use SADI::Service::Instance;

 # create a new blank SADI service instance object
 my $data = SADI::Service::Instance->new ();

 # create a new primed SADI service instance object
 $data = SADI::Service::Instance->new (
     ServiceName => "helloworld",
     ServiceType => "http://someontology.org/services/sometype",
     InputClass => "http://someontology.org/datatypes#Input1",
     OutputClass => "http://someontology.org/datatypes#Output1",
     Description => "the usual hello world service",
     UniqueIdentifier => "urn:lsid:myservices:helloworld",
     Authority => "helloworld.com",
     Authoritative => 1,
     Provider => 'myaddress@organization.org',
     ServiceURI => "http://helloworld.com/cgi-bin/helloworld.pl",
     URL => "http://helloworld.com/cgi-bin/helloworld.pl",
     SignatureURL =>"http://foo.bar/myServiceDescription",
 );

 # get the service name
 my $name = $data->ServiceName;
 # set the service name
 $data->ServiceName($name);

 # get the service type
 my $type = $data->ServiceType;
 # set the service type
 $data->ServiceType($type);

 # get the input class URI
 my $input_class = $data->InputClass;
 # set the input class URI
 $data->InputClass($input_class);

 # get the output class URI
 my $output_class = $data->OutputClass;
 # set the output class URI
 $data->OutputClass($input_class);

 # get the description
 my $desc = $data->Description;
 # set the description
 $data->Description($desc);

 # get the unique id
 my $id = $data->UniqueIdentifier;
 # set the unique id
 $data->UniqueIdentifier($id);

 # get the authority
 my $auth = $data->Authority;
 # set the authority
 $data->Authority($auth);

 # get the service provider URI
 my $uri = $data->Provider;
 # set the service provider URI
 $data->Provider($uri);

 # get the service URI
 my $uri = $data->ServiceURI;
 # set the service URI
 $data->ServiceURI($uri);

 # get the service URL
 my $url = $data->URL;
 # set the service URL
 $data->URL($url);

 # get the signature url
 my $sig = $data->SignatureURL;
 # set the signature url
 $data->SignatureURL($sig);

=head1 DESCRIPTION

An object representing a SADI service signature.

=head1 AUTHORS

 Edward Kawas (edward.kawas [at] gmail [dot] com)

=cut

#-----------------------------------------------------------------
# A list of allowed attribute names. See SADI::Base for details.
#-----------------------------------------------------------------

=head1 ACCESSIBLE ATTRIBUTES

Details are in L<SADI::Base>. Here just a list of them (additionally
to the attributes from the parent classes)

=over

=item B<ServiceName>

A name for the service.

=item B<ServiceType>

Our SADI service type.

=item B<InputClass>

The URI to the input class for our SADI service.

=item B<OutputClass>

The URI to the output class for our SADI service.

=item B<Description>

A description for our SADI service.

=item B<UniqueIdentifier>

A unique identifier (like an LSID, etc) for our SADI service.

=item B<Authority>

The service provider URI for our SADI service.

=item B<ServiceURI>

The service URI for our SADI service.

=item B<URL>

The URL to our SADI service.

=item B<Provider>

The email address of the service provider. 
B<Note: This method throws an exception if the address is syntactically invalid!>.

=item B<Authoritative>

Whether or not the provider of the SADI service is an authority over the data. 
This value must be a boolean value. True values match =~ /true|\+|1|yes|ano/. 
All other values are false.

Defaults to 1;

=item B<Format>

The format of the service. More than likely, it will be 'sadi' if it is a SADI web service.

=item B<SignatureURL>

A url to the SADI service signature.

=back

=cut

{
	my %_allowed = (
		ServiceName      => { type => SADI::Base->STRING },
		ServiceType      => { type => SADI::Base->STRING },
		InputClass       => { type => SADI::Base->STRING },
		OutputClass      => { type => SADI::Base->STRING },
		Description      => { type => SADI::Base->STRING },
		UniqueIdentifier => { type => SADI::Base->STRING },
		Authority        => {
			type => SADI::Base->STRING,
			post => sub {
				my $i      = shift;
				my $domain = $i->Authority; 
				if ($domain =~ /[\@\&\%\#\(\)\=]/gi) {
					$i->{Authority} = ""; 
                    $i->throw(
    "Invalid authority specified! '$domain' contains invalid characters ."
                    );
				}
				  unless ($domain =~ /.+\.+.+/gi) {
				  	$i->{Authority} = "";
                    $i->throw(
                       "Invalid authority specified! '$domain' must take the form NNN.NNN.NNN." );
				  }
				my $uri = new URI($domain);
                $i->{Authority} = $uri->authority if defined $uri->authority;
			  }
		},
		Provider => {
			type => SADI::Base->STRING,
			post => sub {
				my $i = shift;
				my ( $name, $domain ) = $i->Provider =~ /^(.*)@(.*)$/;
				$i->throw(   "Invalid email address specified! '"
						   . $i->Provider
						   . "' is not a valid address" )
				  unless $name and $domain;
				$i->throw(
"Invalid email address specified! Invalid characters found in username."
				) if $name =~ /[\@\&\%\#\(\)\=]/gi;
				$i->throw(
"Invalid email address specified! Invalid characters found in domain."
				) if $domain =~ /[\@\&\%\#\(\)\=]/gi;
				$i->throw(
"Invalid email address specified! Please check the domain of the address."
				) unless $domain =~ /.+\.+.+/gi;

			  }
		},
		ServiceURI => { type => SADI::Base->STRING },
		URL        => {
			type => SADI::Base->STRING,
			post => sub {
				my $i = shift;

				# set the signature url to be the URL address unless defined
				$i->SignatureURL( $i->URL ) unless $i->SignatureURL;
				# set the service uri to be the URL address unless defined
                $i->ServiceURI( $i->URL ) unless $i->ServiceURI;
                # set the unique id to be the URL address unless defined
                $i->UniqueIdentifier( $i->URL ) unless $i->UniqueIdentifier;
			  }
		},
		Authoritative => { type => SADI::Base->BOOLEAN },
		Format        => { type => SADI::Base->STRING },
		SignatureURL  => { type => SADI::Base->STRING },
		UnitTest     => { type => 'SADI::Service::UnitTest', is_array => 1 },
	);

	sub _accessible {
		my ( $self, $attr ) = @_;
		exists $_allowed{$attr} or $self->SUPER::_accessible($attr);
	}

	sub _attr_prop {
		my ( $self, $attr_name, $prop_name ) = @_;
		my $attr = $_allowed{$attr_name};
		return ref($attr) ? $attr->{$prop_name} : $attr if $attr;
		return $self->SUPER::_attr_prop( $attr_name, $prop_name );
	}
}

#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
	my ($self) = shift;
	$self->SUPER::init();

	# set the default format for this signature
	$self->Format('sadi');
	$self->Authoritative(1);
}

1;

__END__