File Coverage

blib/lib/FedoraCommons/APIA.pm

Criterion	Covered	Total	%
statement	18	211	8.5
branch	0	92	0.0
condition			n/a
subroutine	6	21	28.5
pod			n/a
total	24	324	7.4

# ========================================================================= #
#
#     FedoraCommons::APIA - interface to Fedora's SOAP based API-A
#
# ========================================================================= #
#
#  Copyright (c) 2011, Cornell University www.cornell.edu (enhancements)
#  Copyright (c) 2010, Cornell University www.cornell.edu (enhancements)
#  Copyright (c) 2007, The Pennsylvania State University, www.psu.edu
#
#  This library is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#
#  See pod documentation for further license and copyright information.
#
#  History: APIA interface was developed at PSU in 2006/2007. This code
#           was built on top of an existing module which used SOAP (Technical
#           Knowledge Center of Denmark[2006]).
#
#           Cornell University began using the module for scripts
#           to import legacy digital collections into a new cloud-based
#           Archival Repository (2009). During this work the module has been
#           enhanced with several new methods implemented.
#
#           The module made interacting with a Fedora Commons repository
#           easy thus the decision to share the module on CPAN.
#
#
# Manifest of APIA API methods and APIA Module methods:
#                                                                    POD
# Fedora 3.0 APIA API Methods              Supported    Status    Documented
# ---------------------------              ---------    ------    ----------
#
#   * Repository Access
#          o describeRepository               No
#   * Object Access
#          o findObjects                   Supported      OK         Yes
#          o resumeFindObjects             Supported      OK         Yes
#          o getObjectHistory                 No
#          o getObjectProfile                 No
#   * Datastream Access
#          o getDatastreamDissemination    Supported      OK         Yes
#          o listDatastreams               Supported      OK         Yes (PSU)
#   * Dissemination Access
#          o getDissemination                 No
#          o listMethods                      No
#
# Local Additions:
#
#   * Datastream Access
#          o datastreamExists              Supported      OK         Yes
#
#
# *PSU - Implemented by Penn State University
#
# ========================================================================= #
#
#  $Id: APIA.pm,v 1.3 2007/06/25 15:22:25 dlf2 Exp $
#
# ========================================================================= #
#

package FedoraCommons::APIA;

use 5.008005;
use strict;
use warnings;

require SOAP::Lite;
use Time::HiRes qw(time);
use Carp;

require Exporter;
use AutoLoader qw(AUTOLOAD);

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 FedoraCommons::APIA ':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 = '0.5';

our $FEDORA_VERSION = "3.2";

sub import {
  my $pkg = shift;
  while (@_) {
    my $command = shift;
    my $parameter = shift;
    if ($command eq 'version') {

      # Add legal Fedora version numbers as they become available
      if ($parameter eq "3.2") {
        $FEDORA_VERSION = $parameter;
      }

    }
  }
}

my $ERROR_MESSAGE;

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.



# ========================================================================= #
#
#  Public Methods
#
# ========================================================================= #



# Constructor
#
# Args in parameter hash:
#   host :    Fedora host
#   port :    Port
#   usr :     Fedora Admin user
#   pwd :     Fedora Admin password
#   timeout:  Allowed timeout
#
# Return:
#   The Fedora::APIA object
#
sub new {
  my $class = shift;
  my %args = @_;
  my $self = {};
  $self->{'protocol'} = "http";

  foreach my $k (keys %args) {
    if ($k eq 'usr') {
      $self->{$k} = $args{$k};
    } elsif ( $k eq 'pwd') {
      $self->{$k} = $args{$k};
    } elsif ( $k eq 'host') {
      $self->{$k} = $args{$k};
    } elsif ( $k eq 'port') {
      $self->{$k} = $args{$k};
    } elsif ( $k eq 'timeout') {
      $self->{$k} = $args{$k};
    } elsif ( $k eq 'protocol') {
      $self->{$k} = $args{$k};
    }
  }

  # Check mandatory parameters
  Carp::croak "Initialisation parameter 'host' missing" unless defined($self->{'host'});
  Carp::croak "Initialisation parameter 'port' missing" unless defined($self->{'port'});
  Carp::croak "Initialisation parameter 'usr' missing" unless defined($self->{'usr'});
  Carp::croak "Initialisation parameter 'pwd' missing" unless defined($self->{'pwd'});

  # Bless object
  bless $self;

  # Initialise SOAP class
  my $apia=SOAP::Lite
      -> uri("http://www.fedora.info/definitions/api/")
      -> proxy($self->_get_proxy());
  if (defined($self->{timeout})) {
    $apia->proxy->timeout($self->{timeout});
  }
  $self->{apia} = $apia;

  return $self;
}

# Error from most recent operation
sub error {
  my $self = shift;
  return $self->{ERROR_MESSAGE};
}

# Elapsed time of most recent operation
sub get_time {
  my $self = shift;
  return $self->{TIME};
}

# Statistics
sub get_stat {
  my $self = shift;
  return $self->{STAT};
}

sub get_proxy {
  my $self = shift;
  return $self->_get_proxy();
}

# Start statistic gathering over
sub start_stat {
  my $self = shift;
  $self->{STAT} = {};
  return;
}

# findObjects
#
# Args in parameter hash:
#   maxResults:        Max number of results returned
#   fldsrchProperty:   The field (aka property) being searched
#   fldsrchValue:      Operator for comparing a property to a value
#   fldsrchOperator:   The value of the field being searched
#   searchRes_ref:     Reference to scalar to hold search results
#
# Return:
#
#   0 = success
#   1 = Error
#   2 = Error on remote server
#
sub findObjects{
  my $self = shift;
  my %args = @_;

  $self->{ERROR_MESSAGE}=undef;
  $self->{TIME}=undef;

  Carp::croak "Parameter 'maxResults' missing" unless defined($args{maxResults});
  Carp::croak "Parameter 'fldsrchProperty' missing" unless defined($args{fldsrchProperty});
  Carp::croak "Parameter 'fldsrchOperator' missing" unless defined($args{fldsrchOperator});
  Carp::croak "Parameter 'fldsrchValue' missing" unless defined($args{fldsrchValue});
  Carp::croak "Parameter 'searchRes_ref' missing" unless defined($args{searchRes_ref})
;

  # List Datastreams
  my $findobjs_result;
  eval {
    my $start=time;
    $findobjs_result = $self->{apia}->findObjects(
      SOAP::Data->name('resultFields'=> \SOAP::Data->value('pid')),
      SOAP::Data->name('maxResults')->value($args{maxResults})->type('xsd:nonNegativeInteger'),
      SOAP::Data->name('query'=> \SOAP::Data->value(
        SOAP::Data->name("conditions" => \SOAP::Data->value(
	  SOAP::Data->name("condition" => \SOAP::Data->value(
            SOAP::Data->name("property" => $args{fldsrchProperty}),
            SOAP::Data->name("operator" => $args{fldsrchOperator})->type('xsd:enumeration'),
            SOAP::Data->name("value" => $args{fldsrchValue})))))))
     );
    my $elapse_time = time - $start;
    $self->{TIME} = $elapse_time;
    $self->{STAT}->{'findObjects'}{count}++;
    $self->{STAT}->{'findObjects'}{time} += $elapse_time;
  };
  if ($@) {
    $self->{ERROR_MESSAGE}=$self->_handle_exceptions($@);
    return 1;
  }

  # Handle error from Fedora target
  if ($findobjs_result->fault) {
    $self->{ERROR_MESSAGE}=
           $findobjs_result->faultcode."; ".
           $findobjs_result->faultstring."; ".
           $findobjs_result->faultdetail;
    return 2;
  }

  # Handle success
  ${$args{searchRes_ref}} = $findobjs_result->result();
  return 0;

}


# resumeFindObjects
#
# Args in parameter hash:
#   sessionToken:
#   searchRes_ref:     Reference to scalar to hold search results
#
# Return:
#
#   0 = success
#   1 = Error
#   2 = Error on remote server
#
sub resumeFindObjects{
  my $self = shift;
  my %args = @_;

  $self->{ERROR_MESSAGE}=undef;
  $self->{TIME}=undef;

  Carp::croak "Parameter 'sessionToken' missing" unless defined($args{sessionToken});
  Carp::croak "Parameter 'searchRes_ref' missing" unless defined($args{searchRes_ref})
;

  # List Datastreams
  my $resumefindobjs_result;
  eval {
    my $start=time;
    $resumefindobjs_result = $self->{apia}->resumeFindObjects($args{sessionToken});
    my $elapse_time = time - $start;
    $self->{TIME} = $elapse_time;
    $self->{STAT}->{'resumeFindObjects'}{count}++;
    $self->{STAT}->{'resumeFindObjects'}{time} += $elapse_time;
  };
  if ($@) {
    $self->{ERROR_MESSAGE}=$self->_handle_exceptions($@);
    return 1;
  }

  # Handle error from Fedora target
  if ($resumefindobjs_result->fault) {
    $self->{ERROR_MESSAGE}=
           $resumefindobjs_result->faultcode."; ".
           $resumefindobjs_result->faultstring."; ".
           $resumefindobjs_result->faultdetail;
    return 2;
  }

  # Handle success
  ${$args{searchRes_ref}} = $resumefindobjs_result->result();
  return 0;

}


# getDatastreamDissemination
#
# Args in parameter hash:
#   pid:          Record PID in fedora
#   dsID:         Datastream PID
#   asOfDateTime
#   stream_ref    Reference to scalar to hold resulting stream
#
# Return:
#
#   0 = success
#   1 = Error
#   2 = Error on remote server
#
sub getDatastreamDissemination {
  my $self = shift;
  my %args = @_;

  $self->{ERROR_MESSAGE}=undef;
  $self->{TIME}=undef;

  Carp::croak "Parameter 'pid' missing" unless defined($args{pid});
  Carp::croak "Parameter 'dsID' missing" unless defined($args{dsID});
  Carp::croak "Parameter 'stream_ref' missing" unless defined($args{stream_ref})
;

  # Set Defaults
  if (!defined($args{asOfDateTime})) {
    $args{asOfDateTime} = "undef";
  }

  # Get Datastream Dissemination
  my $gdd_result;
  eval {
    my $start=time;
    $gdd_result = $self->{apia}->getDatastreamDissemination(
      $args{pid},
      $args{dsID},
     # $args{asOfDateTime},
      undef,
    );
    my $elapse_time = time - $start;
    $self->{TIME} = $elapse_time;
    $self->{STAT}->{'getDatastreamDissemination'}{count}++;
    $self->{STAT}->{'getDatastreamDissemination'}{time} += $elapse_time;
  };
  if ($@) {
    $self->{ERROR_MESSAGE}=$self->_handle_exceptions($@);
    return 1;
  }

  # Handle error from Fedora target
  if ($gdd_result->fault) {
    $self->{ERROR_MESSAGE}=
           $gdd_result->faultcode."; ".
           $gdd_result->faultstring."; ".
           $gdd_result->faultdetail;
    return 2;
  }

  # Handle success
  # Decode Stream
  ${$args{stream_ref}} = MIME::Base64::decode_base64($gdd_result->result()->{'stream'});

  return 0;

}


# listDatastreams
#
# Args in parameter hash:
#   pid:              Record PID in fedora
#   asOfDateTime:
#   datastream_ref:   Reference to scalar to hold result
#   list:             Reference to list. When provides will create list of
#                     datastream ids.
#
# Return:
#
#   0 = success
#   1 = Error
#   2 = Error on remote server
#
sub listDatastreams{
  my $self = shift;
  my %args = @_;

  $self->{ERROR_MESSAGE}=undef;
  $self->{TIME}=undef;

  Carp::croak "Parameter 'pid' missing" unless defined($args{pid});
  Carp::croak "Parameter 'datastream_ref' missing" unless defined($args{datastream_ref});

  # Set Defaults
  if (!defined($args{asOfDateTime})) {
    $args{asOfDateTime} = "undef";
  }

  # List Datastreams
  my $lds_result;
  eval {
    my $start=time;
    $lds_result = $self->{apia}->listDatastreams(
      $args{pid},
     # $args{asOfDateTime},
      undef
    );
    my $elapse_time = time - $start;
    $self->{TIME} = $elapse_time;
    $self->{STAT}->{'listDatastreams'}{count}++;
    $self->{STAT}->{'listDatastreams'}{time} += $elapse_time;
  };
  if ($@) {
    $self->{ERROR_MESSAGE}=$self->_handle_exceptions($@);
    return 1;
  }

  # Handle error from Fedora target
  if ($lds_result->fault) {
    $self->{ERROR_MESSAGE}=
           $lds_result->faultcode."; ".
           $lds_result->faultstring."; ".
           $lds_result->faultdetail;
    return 2;
  }

  # Does the user want a list of datastream identifiers.
  if ($args{list}) {

    my $datastreams;
    $datastreams = $lds_result;

    foreach my $ds ($datastreams->valueof('//datastreamDef')) {
      push(@{$args{list}},$ds->{ID});
    }
  }

  # Handle success
  ${$args{datastream_ref}} = $lds_result;
  return 0;

}

# datastreamExists (Boolean)
#
# Args in parameter hash:
#   pid:              Record PID in fedora
#   dsID:             Datastream identifier. Will check
#                     existence of datastream.
#
# Return:
#
#   0 = False, datastream does not exist
#   1 = True, datastream exists
#
sub datastreamExists {
  my $self = shift;
  my %args = @_;

  Carp::croak "Parameter 'pid' missing" unless defined($args{pid});
  Carp::croak "Parameter 'dsID' missing" unless defined($args{dsID});



  my $pid  = $args{'pid'};
  my $dsID = $args{'dsID'};
  my $datastreams;

  if ($self->listDatastreams(pid=>$pid,
			     datastream_ref =>\$datastreams) == 0) {
    my @dslist = ();

    foreach my $ds ($datastreams->valueof('//datastreamDef')) {
      push(@dslist,$ds->{ID});
    }
    if (grep $dsID eq $_, @dslist) {
      return 1;
    } else {
      return 0;
    }
  }
  return 0;
}



# getObjectProfile
#
# Args in parameter hash:
#   pid:          PID of the object
#   asOfDateTime:
#   profile_ref: reference to return metadata profile
#
# Return:
#
#   0 = success
#   1 = Error
#   2 = Error on remote server
#
sub getObjectProfile {
  my $self = shift;
  my %args = @_;

  $self->{ERROR_MESSAGE}=undef;
  $self->{TIME}=undef;

  Carp::croak "Parameter 'pid' missing" unless defined($args{pid});
  Carp::croak "Parameter 'profile_ref' missing" unless defined($args{profile_ref});

  # Set Defaults
  if (!defined($args{asOfDateTime})) {
    $args{asOfDateTime} = "undef";
  }
  my $gds_result;
  eval {
    my $start=time;
    $gds_result = $self->{apia}->getObjectProfile (
      $args{pid},
      );
    my $elapse_time = time - $start;
    $self->{TIME} = $elapse_time;
    $self->{STAT}->{'getDatastream'}{count}++;
    $self->{STAT}->{'getDatastream'}{time} += $elapse_time;
  };
  if ($@) {
    $self->{ERROR_MESSAGE}=$self->_handle_exceptions($@);
    return 1;
  }

  # Handle error from Fedora target
  if ($gds_result->fault) {
    $self->{ERROR_MESSAGE}=
           $gds_result->faultcode."; ".
           $gds_result->faultstring."; ".
           $gds_result->faultdetail;
    return 2;
  }

  my $data = $gds_result->result();

  # Handle success
  ${$args{profile_ref}} = $gds_result->result();
  return 0;

} # getObjectProfile

###

# ========================================================================= #
#
#  Private Methods
#
# ========================================================================= #



# Map die exceptions from SOAP::Lite calls to Fedora::APIA error messages
sub _handle_exceptions {
  my ($self, $exception_text) = @_;
  if ($exception_text =~ m{^401 Unauthorized}) { return "401 Unauthorized"; }
  return $exception_text;
}

# Method for constructing proxy URL
sub _get_proxy {
  my ($self) = @_;
  return "$self->{'protocol'}://".
           $self->{usr}.":".$self->{pwd}.
           "\@".$self->{host}.":".$self->{port}.
           "/fedora/services/access";
}

1;
__END__