The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
[%# A template for an async service base code.
    ===================================

    Expected/recognized parameters:

      obj         ... a service definition, type SADI::Service::Instance
      module_name ... the name of the module (scalar string)
-%]
#-----------------------------------------------------------------
# Authority:    [% obj.Authority %]
# Service name: [% obj.ServiceName %]
# Generated:    [% USE Date (format = '%d-%b-%Y %H:%M:%S %Z') %][% Date.format %]
# Contact: Edward Kawas <edward.kawas@gmail.com>
#-----------------------------------------------------------------

package [% module_name %];

use FindBin qw( $Bin );
use lib $Bin;

use SADI::Base;
use SADI::Service::ServiceBase;
use SADI::RDF::Core;
use SADI::FileStore;
use SADI::Service::Instance;

use RDF::Notation3::RDFCore;
use RDF::Core::Storage::Memory;
use RDF::Core::Model::Serializer;

use POSIX qw(setsid);
use Data::Dumper;

no strict;

use vars qw( @ISA );
@ISA = qw( SADI::Service::ServiceBase );

use strict;

#-----------------------------------------------------------------
# store
#   saves the state of our service invocation given a $uid.
# throws exception if $core isnt a SADI::RDF::Core object of if
# there are any problems saving data to disk.
#----------------------------------------------------------------- 
sub store {
    my ($self, $core, $is_finished, $uid) = @_;
    # get uid from the env unless it is defined
    $uid = $ENV{SADI_UID} unless defined $uid;
    
    # make sure that $core is correctly typed
    $self->throw(
         "[% module_name %]::store(): incorrect parameter!" .
         "SADI::RDF::Core is required as parameter\n"
    ) unless UNIVERSAL::isa ($core, 'SADI::RDF::Core');
    my $store = SADI::FileStore->new(ServiceName => "[% obj.ServiceName %]");
    my %hash;
    $hash{value} = $core->serializeOutputModel();
    # save the content type of our data ... just in case 
    # the client changes their mind
    $hash{content_type} = $core->ContentType();
    $hash{done} = $is_finished ? 1 : 0;
    $Data::Dumper::Purity = 1;
    my $str = Data::Dumper->Dump( [ \%hash ], ['*Data'] );
    $store->add($uid, $str);
}

#-----------------------------------------------------------------
# retrieve
#   given a $uid, retrieves the current saved state for our service
#   invocation
# NOTE: if a value is retrieved, then it removed from the cache
#----------------------------------------------------------------- 
sub retrieve {
    my ($self, $uid) = @_;
    $uid = $ENV{SADI_UID} unless defined $uid;
    my $store = SADI::FileStore->new(ServiceName => "[% obj.ServiceName %]");
    use vars qw ( %Data );
    eval ($store->get($uid)) if $store->get($uid);
    $self->throw("Error getting data for service ('[% obj.ServiceName %]') given $uid\n$@") if $@;
    eval ($store->get($uid)) if $store->get($uid);
    $store->remove($uid) if $Data{value};
    if (defined $Data{value}) {
    	my $value = $Data{value};
    	return $value if ($Data{content_type} eq $self->get_response_content_type());
    	# need to convert the value now ...
    	# originally request one content type, and now a different one ...
    	if ($self->get_response_content_type() eq 'text/rdf+n3') {
    		# get n3 format from rdf/xml ...
    		my $storage = new RDF::Core::Storage::Memory;
    		my $model = new RDF::Core::Model( Storage => $storage );
	        my %options = (
	            Model      => $model,
	            Source     => $value,
	            SourceType => 'string',
	            #parserOptions
	            BaseURI     => "http://www.foo.com/",
	            BNodePrefix => "genid"
	        );
	        my $parser = new RDF::Core::Model::Parser(%options);
	        eval {$parser->parse;};
	        # return what we have if there is an error
            return $value if $@;
            # now output n3
            my $rdf_n3 = RDF::Notation3::RDFCore->new();
            my $n3;
            eval{$n3 = $rdf_n3->get_n3($model);};
            return $value if $@;
            return $n3;
    	} else {
    		# get rdf/xml from n3 format ...
    		my $storage = new RDF::Core::Storage::Memory;
            my $model;
    		my $rdf_n3 = RDF::Notation3::RDFCore->new();
            $rdf_n3->set_storage($storage);
            eval{$model = $rdf_n3->parse_string($$value);};
            # return what we have if there is an error
            return $value if $@;
            # now serialize rdf/xml
            my $output;
            my $serializer = new RDF::Core::Model::Serializer(
                Model  => $model,
                Output => \$output,
            );
            $serializer->serialize;
            return $value if $@;
            return $output;
    	}
    }
    $self->throw("No value to retrieve!\n");
}

#-----------------------------------------------------------------
# completed
#   given a $uid, retrieves the current state our service
#   invocation. a Perl true value if completed, 0 | undef otherwise.
# Throws exception if there is nothing to retrieve for the given $uid
#----------------------------------------------------------------- 
sub completed {
    my ($self, $uid) = @_;
    $uid = $ENV{SADI_UID} unless defined $uid;
    my $store = SADI::FileStore->new(ServiceName => "[% obj.ServiceName %]");
    use vars qw ( %Data );
    eval ($store->get($uid)) if $store->get($uid);
    $self->throw("Error getting state for service ('[% obj.ServiceName %]') given $uid\n$@") if $@;
    return $Data{done} if defined $Data{done};
    $self->throw("Invalid uid '$uid'!");
}

#-----------------------------------------------------------------
# [% obj.ServiceName %]
#   the main method; corresponds to the name of this SADI web service
#----------------------------------------------------------------- 
sub [% obj.ServiceName %] {
    my ($self, $data) = @_;

    my $uid = $ENV{SADI_UID};
    # instantiate a new SADI::RDF::Core object
    my $core = SADI::RDF::Core->new;
    $core->ContentType($self->get_request_content_type());
    # set the Instance for $core
    $core->Signature($self->get_service_signature('[% obj.ServiceName %]'));

    Log::Log4perl::NDC->push ($$);
    $LOG->info ('*** REQUEST START *** ' . "\n" . $self->log_request);

    no warnings 'newline';
    my $in_testing_mode = (-f $data);
    use warnings 'newline';
    if ($in_testing_mode) {
       # need to save uid to $ENV, because this is a local service call
       unless (defined $uid) {
         $uid = SADI::FileStore->new(ServiceName => "[% obj.ServiceName %]")->generate_uid();
         $ENV{SADI_UID} = $uid;
       }
       # read the file into $data
	   open (RAWXML, "<$data") or $LOG->logdie ("Cannot open $data: $!\n");
	   $data = join ('', <RAWXML>);
	   close RAWXML;
	   $LOG->debug ("Input raw data:\n$data\n") if ($LOG->is_debug);
    } else {
        $LOG->debug ("Input raw data (first 1000 characters):\n" . substr ($data, 0, 1000)) if ($LOG->is_debug);
    }
    

    $self->default_throw_with_stack (0) unless $in_testing_mode;

    # get/parse the incoming RDF
    eval {
	    $core->Prepare($data) 
	      or $self->throw("Error parsing the input RDF. Couldn't create a model!");
    };
    # set the content type that the client wants us to return
    $core->ContentType($self->get_response_content_type());
    
    # save the input URIs for polling RDF
    {   my @URIS;
        push @URIS, $_->getURI foreach ( $core->getInputNodes() );
        $ENV{SADI_INPUT_URIS} =  join("\t", @URIS);
    }
    # error in creating parser, or parsing input
    if ($@) {
		$LOG->logdie ($@) if $in_testing_mode;
		# construct an outgoing message
		my $stack = $self->format_stack ($@);
        $core->_add_error($@, 'Error parsing input message for sadi service!', $stack);
        $LOG->error ($stack);
		$LOG->info ('*** FATAL ERROR RESPONSE BACK ***');
		Log::Log4perl::NDC->pop();
		$self->store($core, 1, $uid);
		return;
    }

    unless (defined( my $pid = fork() )) {
    } elsif ($pid == 0) {
        # Daemonize 
        open STDIN, "/dev/null";
        open STDOUT, ">/dev/null";
        open STDERR, ">/dev/null";
        setsid;
    
        # child process
        # do something (this service main task)
        eval {
            # save $core before we begin
            $self->store($core);
            my @inputs = $core->getInputNodes();
            $self->process_it (\@inputs, $core);
        };
        # error thrown by the implementation class
        if ($@) {
    		$LOG->logdie ($@) if $in_testing_mode;
    		# TODO how to report errors?
    		my $stack = $self->format_stack ($@);
            $core->_add_error($@, 'Error running sadi service!', $stack);
            $LOG->error ($stack);
    		$LOG->info ('*** REQUEST TERMINATED RESPONSE BACK ***');
    		Log::Log4perl::NDC->pop();
    		# signal that we are done
            $self->store($core, 1, $uid);
    		return ;
        }
        
        # return result
        $LOG->info ('*** RESPONSE READY *** ');
        if ($in_testing_mode) {
            Log::Log4perl::NDC->pop();
            # signal that we are done
            $self->store($core, 1, $uid);
            return;
        } else {
            if ($LOG->is_debug) {
                my $xml_output = $core->serializeOutputModel();
                $LOG->debug ("Output raw data (first 1000 characters): " .
                     substr ($xml_output,0,1000));
                Log::Log4perl::NDC->pop();
                # signal that we are done
                $self->store($core, 1, $uid);
                return;
            } else {
                Log::Log4perl::NDC->pop();
                # signal that we are done
                $self->store($core, 1, $uid);
                return;
            }
        }
    } else {
        # parent process
        if ($in_testing_mode) {
            $LOG->debug("In testing mode ... waiting for service to finish execution") if $LOG->is_debug;
            # wait for the child process - in testing mode
            waitpid($pid,0);
            $LOG->debug("In testing mode ... Service execution finished!") if $LOG->is_debug;
            return $self->retrieve();
        }
        return;
    }
}

sub get_polling_rdf {
    my ($self) = @_;
    # instantiate a new SADI::RDF::Core object
    my $signature = $self->get_service_signature('[% obj.ServiceName %]');
    # generate from template
    my $polling_rdf = '';
    my $tt = Template->new( ABSOLUTE => 1, TRIM => 1 );
    my $input = File::Spec->rel2abs(
                      SADI::Utils->find_file(
                          $Bin, 'SADI', 'Generators', 'templates', 'async-polling-rdf.tt'
                      )
    );
    my @URIS = split("\t", $ENV{SADI_INPUT_URIS});
    $tt->process(
                  $input,
                  {
                     inputURIs     => \@URIS,
                     outClass      => $signature->OutputClass, 
                     url           => $signature->URL . '?poll=' . $ENV{SADI_UID},
                  },
                  \$polling_rdf
    ) || $LOG->logdie( $tt->error() );
    # hack to output the pollinng rdf in n3 ...
    if ($self->get_response_content_type() eq 'text/rdf+n3') {
        my $rdf = RDF::Notation3::RDFCore->new();
        my $storage = RDF::Core::Storage::Memory->new();
        my $model = new RDF::Core::Model( Storage => $storage );
        my %options = (
            Model      => $model,
            Source     => $polling_rdf,
            SourceType => 'string',
            #parserOptions
            BaseURI     => "http://www.foo.com/",
            BNodePrefix => "genid"
        );
        my $parser = new RDF::Core::Model::Parser(%options);
        eval {$parser->parse;};
        return $rdf->get_n3($model) unless $@;
    }
    return $polling_rdf;
}

1;