Skip to content
Permalink
3.3
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
=for Pod2Wiki {{Version|since=3.3.0}}
=head1 NAME
EPrints::Apache::CRUD - Create, read, update and delete via HTTP
=head1 SYNOPSIS
$crud = EPrints::Apache::CRUD->new(
repository => $repo,
request => $r,
datasetid => "eprint",
dataobjid => "23",
);
=head1 DESCRIPTION
The CRUD (Create/Read/Update/Delete) module provides the Web API for manipulating content on the server. The API is an AtomPub implementation that exposes Import and Export plugins via simple URLs and HTTP content type negotiation.
You should use the <link> entries in the repository's home page to locate the CRUD endpoint, as they may change in the future:
<link rel="Sword" href="https://myrepo/sword-app/servicedocument" />
<link rel="SwordDeposit" href="https://myrepo/id/contents" />
=head2 Examples
Create a new eprint based on a single file:
curl -X POST \
-i \
-u user:password \
-d 'Hello, World!' \
-H 'Content-Type: text/plain' \
https://myrepo/id/contents
HTTP/1.1 201 Created
Content-Type: application/atom+xml;charset=utf-8
...
Add a file to an existing eprint:
curl -X POST \
-i \
-u user:password \
-d 'Hello, World!' \
-H 'Content-Disposition: attachment; filename=hello.txt' \
-H 'Content-Type: text/plain' \
https://myrepo/id/eprint/23/contents
HTTP/1.1 201 Created
Content-Type: application/atom+xml;charset=utf-8
...
Get an eprint's metadata in Atom XML:
curl -X GET \
-i \
-u user:password \
-H 'Accept: application/atom+xml' \
https://myrepo/id/eprint/23
HTTP/1.1 200 OK
Content-Type: application/atom+xml;charset=utf-8
...
Get the list of contents (documents) of an eprint in Atom XML:
curl -X GET \
-i \
-u user:password \
-H 'Accept: application/atom+xml' \
https://myrepo/id/eprint/23/contents
HTTP/1.1 200 OK
Content-Type: application/atom+xml;charset=utf-8
...
You can find more examples in the F<tests/84_sword.t> unit test.
=head2 URI layout
These URIs are relative to your EPrints HTTP/HTTPs root.
=over 4
=item /id/contents GET,HEAD,OPTIONS,POST
Requires authentication.
GET a list of the eprints owned by the user. POST to create a new EPrint object.
=item /id/[datasetid]/[dataobjid] DELETE,GET,HEAD,OPTIONS,PUT
Requires authentication depending on user's privileges and object visibility.
GET an object's metadata or, for L<File|EPrints::DataObj::File> objects, the file content. PUT to replace the metadata and/or contents (see L</Updating complex objects using PUT>). If the object does not exist will attempt to create it with the given dataobjid (requires 'upsert' privilege).
=item /id/[datasetid]/[dataobjid]/contents DELETE,GET,HEAD,OPTIONS,POST,PUT
Requires authentication depending on user's privileges and object visibility.
GET the logical contents of the object: documents for eprints or files for documents. PUT to replace the existing contents or POST to add to the existing contents.
=back
=head2 HTTP Content Negotiation
GET/HEAD requests are processed using L<Export|EPrints::Plugin::Export> plugins. POST/PUT requests are processed using L<Import|EPrints::Plugin::Import> plugins.
The plugin used depends on the request's I<Accept> (GET/HEAD) or I<Content-Type> (POST/PUT) header and the type of object being acted on. For example, the following request:
GET /id/eprint/23 HTTP/1.1
Accept: application/vnd.eprints.data+xml
Will search for an Export plugin that accepts objects of type B<dataobj/eprint> and can produce output in the MIME type B<application/vnd.eprints.data+xml>. This will most likely be the L<EP3 XML|EPrints::Plugin::Export::XML> plugin.
In addition to the general plugin negotiation behaviour some special cases are supported to improve compatibility with Atom Pub/Web Browser clients:
=over 4
=item /id/eprint/...
Requesting L<EPrint|EPrints::DataObj::EPrint> objects as text/html will result in a 303 Redirect to the eprint object's abstract page or, if the eprint is not public, its L<View|EPrints::Plugin::Screen::EPrint::View> page.
=item /id/document/.../contents
Requesting the I</contents> of a L<Document|EPrints::DataObj::Document> object will return the content of the document's main file.
=item /id/file/...
Requesting a L<File|EPrints::DataObj::File> object with no I<Accept> header (or B<*/*>) will return the file's content.
=item POST /id/.../contents
When creating new records via POST, content negotiation is performed against the Import plugins.
If no Import plugin supports the I<Content-Type> header the content will be treated as B<application/octet-stream> and stored in a new object. The resulting Atom entry will describe the new object (e.g. the I<eprint> object in which the new I<document> and I<file> objects were created).
Otherwise, the result will depend on the Import plugin's output. Import plugins may produce a single object, multiple objects or an object plus content file(s).
=item Content-Type header
If no I<Content-Type> header is given the MIME type defaults to B<application/octet-stream> for POSTs and PUTs.
=item Content-Disposition header
If the I<Content-Disposition> header is missing or does not contain a I<filename> parameter the filename defaults to F<main.bin> for POSTs and PUTs.
=back
=head2 Updating complex objects using PUT
Eprint objects contain zero or more documents, which each contain zero or more files. When you update (PUT) an eprint object the contained documents will only be replaced if the Import plugin defines new documents e.g. the Atom Import plugin will never define new documents so PUTing Atom content will only update the eprint's metadata. PUTing L<EP3 XML|EPrints::Plugin::Export::XML> will replace the documents if you include a <documents> XML element.
PUTing to I</contents> will always replace all contents - PUTing to I</eprint/23/contents> is equivalent to I<DELETE /eprint/23/contents> then I<POST /eprint/23/contents>.
=head2 PUT/DELETE from Javascript
=for MediaWiki {{Available|since=3.3.9}}
Web browsers only allow GET and POST requests. To perform other requests use the 'X-Method' header with POST to specify the actual method you want:
POST /id/eprint/23 HTTP/1.1
X-Method: PUT
...
=head2 Upserting objects with PUT
=for MediaWiki {{Available|since=3.3.9}}
If you have the I<upsert> privilege objects will be created on demand, otherwise attempting to PUT to a non-existent object will result in an error.
=head1 METHODS
=over 4
=cut
package EPrints::Apache::CRUD;
use EPrints::Const qw( :http );
use MIME::Base64;
use HTTP::Headers::Util;
use Digest::MD5;
use EPrints::Apache::Auth;
use Apache2::Access;
our $PACKAGING_PREFIX = "sword:";
use constant {
CRUD_SCOPE_USER_CONTENTS => 1,
CRUD_SCOPE_DATASET => 2,
CRUD_SCOPE_DATAOBJ => 3,
CRUD_SCOPE_FIELD => 4,
CRUD_SCOPE_CONTENTS => 5,
CRUD_SCOPE_SERVICEDOCUMENT => 6,
};
use strict;
my %CONTENTSMAP = (
"EPrints::DataObj::EPrint" => "documents",
"EPrints::DataObj::Document" => "files",
);
sub new
{
my( $class, %self ) = @_;
my $self = bless \%self, $class;
my $rc = $self->process_headers;
$self->request->status( $rc ), return if $rc != OK;
$self{options} = [qw( GET HEAD OPTIONS )];
# servicedocument FIXME
return $self if !exists $self{datasetid};
my $repo = $self{repository};
# /id/FOO...
if( defined $self{datasetid} )
{
$self{dataset} = $repo->dataset( $self{datasetid} );
if( !defined $self{dataset} )
{
$self{request}->status( HTTP_NOT_FOUND );
return;
}
$self{options} = [qw( GET HEAD POST OPTIONS )];
$self{scope} = CRUD_SCOPE_DATASET;
}
# /id/contents
else
{
$self{dataset} = $repo->dataset( "eprint" );
$self{options} = [qw( GET HEAD POST OPTIONS )];
$self{scope} = CRUD_SCOPE_USER_CONTENTS;
}
# /id/FOO/BAR
if( defined $self{dataobjid} )
{
my @relations;
if( $self{dataset}->base_id eq "document" )
{
($self{dataobjid}, @relations) = split /\./, $self{dataobjid};
@relations = grep { length($_) } @relations;
}
$self{dataobj} = $self{dataset}->dataobj( $self{dataobjid} );
# resolve 11.hassmallThumbnailVersion
$self{dataobj} = $self->resolve_relations( $self{dataobj}, @relations );
# adjust /id/eprint/23 to /id/archive/23
$self{dataset} = $self{dataobj}->get_dataset if defined $self{dataobj};
$self{options} = [qw( GET HEAD PUT PATCH OPTIONS )];
$self{scope} = CRUD_SCOPE_DATAOBJ;
}
# /id/FOO/BAR/xxx
if( defined $self{fieldid} )
{
if( $self{fieldid} eq "contents" )
{
$self{options} = [qw( GET HEAD POST PUT OPTIONS )];
$self{scope} = CRUD_SCOPE_CONTENTS;
my $fieldid = $CONTENTSMAP{ref($self->dataobj)};
if( !defined $fieldid )
{
$self{request}->status( HTTP_NOT_FOUND );
return;
}
$self{field} = $self{dataset}->field( $fieldid );
$self{dataset} = $repo->dataset(
$self{field}->property( "datasetid" )
);
}
elsif( !$self{dataset}->has_field( $self{fieldid} ) )
{
$self{request}->status( HTTP_NOT_FOUND );
return;
}
else
{
$self{field} = $self{dataset}->field( $self{fieldid} );
$self{options} = [qw( GET HEAD PUT OPTIONS )];
$self{scope} = CRUD_SCOPE_FIELD;
}
}
if( !defined $self{plugin} )
{
$self{plugin} = $self->content_negotiate_best_plugin;
}
return $self;
}
=item $repo = $crud->repository()
Returns the current repository.
=cut
sub repository { $_[0]->{repository} }
=item $r = $crud->request()
Returns the current L<Apache2::RequestUtil>.
=cut
sub request { $_[0]->{request} }
=item $method = $crud->method()
Returns the HTTP method.
=cut
sub method { $_[0]->{method} }
=item $scope = $crud->scope()
Returns the scope of the action being performed.
=cut
sub scope { $_[0]->{scope} }
=item $dataset = $crud->dataset()
Returns the current dataset (if any).
=cut
sub dataset { $_[0]->{dataset} }
=item $dataobj = $crud->dataobj()
Returns the current dataobj (if any).
=cut
sub dataobj { $_[0]->{dataobj} }
=item $field = $crud->field()
Returns the current field (if available);
=cut
sub field { $_[0]->{field} }
=item $headers = $crud->headers()
Get the processed headers.
=cut
sub headers { $_[0]->{headers} }
=item @verbs = $crud->options()
Returns the available HTTP verbs for the current request.
=cut
sub options { @{$_[0]->{options}} }
=item $plugin = $crud->plugin()
Returns the current plugin (if available).
=cut
sub plugin { $_[0]->{plugin} }
=item $bool = $crud->is_write()
Returns true if the request is not a read-only method.
=cut
sub is_write { $_[0]->method !~ /^GET|HEAD|OPTIONS$/ }
=item $accept_type = $crud->accept_type()
Returns the EPrints type for the current request.
=cut
sub accept_type
{
my( $self ) = @_;
my $accept_type = $self->dataset->base_id;
if(
$self->is_write ||
$self->scope == CRUD_SCOPE_DATAOBJ ||
$self->scope == CRUD_SCOPE_SERVICEDOCUMENT
)
{
$accept_type = "dataobj/".$accept_type;
}
else
{
$accept_type = "list/".$accept_type;
}
return $accept_type;
}
=item $rc = $crud->check_packaging()
Check the Packaging header is ok, if given.
=cut
sub check_packaging
{
my( $self ) = @_;
my $headers = $self->headers;
if( $headers->{packaging} && !defined $self->plugin )
{
return $self->sword_error(
status => HTTP_BAD_REQUEST,
href => "http://purl.org/net/sword/error/ErrorContent",
summary => "No support for packaging '$headers->{packaging}'",
);
}
return OK;
}
=item $dataobj = $crud->resolve_relations( $dataobj [, @relations ] )
Resolve the relation path from $dataobj and return the resulting dataobj.
Returns undef if there is no such related object.
=cut
sub resolve_relations
{
my( $self, $dataobj, @relations ) = @_;
foreach my $r (@relations)
{
last if !defined $dataobj;
$r =~ s/^has(.+)$/is$1Of/;
$dataobj = $dataobj->search_related( $r )->item( 0 );
}
return $dataobj;
}
sub _priv
{
my( $self ) = @_;
my $r = $self->request;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
my $field = $self->field;
my $priv;
# /id/xx/yy/contents
if( $self->scope eq CRUD_SCOPE_CONTENTS )
{
$priv = $self->is_write ? "edit" : "view";
$dataobj = $dataobj->parent
if $dataobj->isa( "EPrints::DataObj::File" );
$dataobj = $dataobj->parent
if $dataobj->isa( "EPrints::DataObj::Document" );
$dataset = $dataobj->get_dataset;
}
elsif( $self->method eq "POST" )
{
$priv = "create";
}
elsif( $self->method eq "PUT" )
{
if( $self->scope == CRUD_SCOPE_DATAOBJ && !defined $dataobj )
{
$priv = "upsert";
}
else
{
$priv = "edit";
}
}
elsif( $self->method eq "PATCH" )
{
$priv = "edit";
}
elsif( $self->method eq "DELETE" )
{
$priv = "destroy";
}
elsif( defined($plugin) && $plugin->get_subtype ne "SummaryPage" )
{
$priv = "export";
}
else
{
$priv = "view";
}
if( $dataset->base_id eq "eprint" && $priv eq "create" )
{
$priv = "create_eprint";
}
elsif( $self->scope eq CRUD_SCOPE_USER_CONTENTS && $dataset->base_id eq "eprint" && $priv eq "view" )
{
$priv = "items";
}
elsif( $dataset->id ne $dataset->base_id )
{
return(
join('/', $dataset->base_id, $dataset->id, $priv ),
join('/', $dataset->base_id, $priv ),
);
}
else
{
$priv = join('/', $dataset->base_id, $priv );
}
return $priv;
}
# authentication
sub authen
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
# POST, PUT, DELETE must authenticate
if( $self->is_write )
{
return EPrints::Apache::Auth::authen( $r );
}
# a staff-plugin implicitly requires a user
if( defined($plugin) && $plugin->param( "visible" ) eq "staff" )
{
return EPrints::Apache::Auth::authen( $r );
}
# /id/contents implicitly requires a user
if( $self->scope eq CRUD_SCOPE_USER_CONTENTS )
{
return EPrints::Apache::Auth::authen( $r );
}
my @privs = $self->_priv;
if( defined $dataobj )
{
foreach my $priv (@privs)
{
return OK if $dataobj->permit( $priv );
}
}
else
{
foreach my $priv (@privs)
{
return OK if $repo->allow_anybody( $priv );
}
}
return EPrints::Apache::Auth::authen( $r );
}
# authorisation
sub authz
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
my $user = $repo->current_user;
if( defined($plugin) && $plugin->param( "visible" ) eq "staff" )
{
return HTTP_FORBIDDEN if !defined $user || !$user->is_staff;
}
my @privs = $self->_priv;
if( defined $dataobj )
{
foreach my $priv (@privs)
{
return OK if $dataobj->permit( $priv, $user );
}
}
elsif( defined $user )
{
foreach my $priv (@privs)
{
return OK if $user->allow( $priv );
}
}
else
{
foreach my $priv (@privs)
{
return OK if $repo->allow_anybody( $priv );
}
}
return HTTP_FORBIDDEN;
}
=item $list = $crud->parse_input( $plugin, $f [, %params ] )
Parse the content submitted by the user using the given $plugin. $f is called by epdata_to_dataobj to convert epdata to a dataobj. %params are passed to the plugin's input_fh method.
Returns undef on error.
=cut
sub _read_content
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $headers = $self->headers;
my $ctx = $headers->{content_md5} ? Digest::MD5->new : undef;
my $tmpfile = File::Temp->new( SUFFIX => $headers->{extension} );
binmode($tmpfile);
my $len = 0;
while($r->read(my $buffer, 4096)) {
$len += length($buffer);
$ctx->add( $buffer ) if defined $ctx;
print $tmpfile $buffer;
}
seek($tmpfile,0,0);
if( defined $ctx && $ctx->hexdigest ne $headers->{content_md5} )
{
$self->sword_error(
status => HTTP_PRECONDITION_FAILED,
href => "http://purl.org/net/sword/error/ErrorChecksumMismatch",
summary => "MD5 digest mismatch between headers and content",
);
return undef;
}
return $tmpfile;
}
sub parse_input
{
my( $self, $plugin, $f, %params ) = @_;
my $repo = $self->repository;
my $headers = $self->headers;
my @messages;
my $count = 0;
$plugin->set_handler( EPrints::CLIProcessor->new(
message => sub { push @messages, $_[1] },
epdata_to_dataobj => sub { ++$count; &$f },
) );
my $tmpfile = $self->_read_content();
return undef if !defined $tmpfile;
my %content_type_params;
for(keys %{$headers->{content_type_params}})
{
next if !$plugin->has_argument( $_ );
$content_type_params{$_} = $headers->{content_type_params}->{$_};
}
my $list = eval { $plugin->input_fh(
%content_type_params,
dataset => $self->dataset,
fh => $tmpfile,
filename => $headers->{filename},
mime_type => $headers->{mime_type},
content_type => $headers->{content_type},
actions => $headers->{actions},
%params,
) };
if( !defined $list )
{
$self->plugin_error( $plugin, \@messages );
return undef;
}
elsif( $count == 0 )
{
$plugin->handler->message( "error", "Import plugin didn't create anything" );
$self->plugin_error( $plugin, \@messages );
return undef;
}
return $list;
}
sub create_dataobj
{
my( $self, $owner, $epdata ) = @_;
$epdata = {} if !defined $epdata;
my $repo = $self->repository;
my $dataset = $self->dataset;
local $repo->{config}->{enable_import_fields} = 1;
$epdata->{$dataset->key_field->name} = $self->{dataobjid};
if( $dataset->base_id eq "eprint" )
{
$epdata->{userid} = $owner->id;
$epdata->{eprint_status} = "inbox";
}
return $dataset->create_dataobj( $epdata );
}
=item @plugins = $crud->import_plugins( [ %params ] )
Returns all matching import plugins against %params ordered by descending 'q' score.
=cut
sub import_plugins
{
my( $self, %params ) = @_;
my $user = $self->repository->current_user;
if( defined $user && !$user->is_staff )
{
$params{is_visible} = "all";
}
my @plugins = $self->repository->get_plugins(
type => "Import",
can_produce => $self->accept_type,
%params,
);
my %qs = map { $_ => ($_->param( "qs" ) || 0) } @plugins;
my %ids = map { $_ => $_->get_id } @plugins;
return sort {
$qs{$b} <=> $qs{$a} || $ids{$a} cmp $ids{$b}
} @plugins;
}
=item @plugins = $crud->export_plugins( [ %params ] )
Returns all matching export plugins against %params ordered by descending 'q' score.
=cut
sub export_plugins
{
my( $self, %params ) = @_;
my $user = $self->repository->current_user;
if( defined $user && !$user->is_staff )
{
$params{is_visible} = "all";
}
my @plugins = $self->repository->get_plugins(
type => "Export",
can_accept => $self->accept_type,
%params,
);
my %qs = map { $_ => ($_->param( "qs" ) || 0) } @plugins;
my %ids = map { $_ => $_->get_id } @plugins;
return sort {
$qs{$b} <=> $qs{$a} || $ids{$a} cmp $ids{$b}
} @plugins;
}
=item $plugin = $crud->content_negotiate_best_plugin()
Work out the best plugin to export/update an object based on the client-headers.
=cut
sub content_negotiate_best_plugin
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $field = $self->field;
my $headers = $self->headers;
return undef if $self->method eq "DELETE";
my $accept_type = $self->accept_type;
if( defined(my $package = $headers->{packaging}) )
{
my $plugin;
if( $self->is_write )
{
($plugin) = $self->import_plugins(
can_accept => $PACKAGING_PREFIX.$package,
can_action => $headers->{actions},
);
}
else
{
($plugin) = $self->export_plugins(
can_produce => $PACKAGING_PREFIX.$package,
);
}
return $plugin;
}
my @plugins;
if( $self->is_write )
{
@plugins = $self->import_plugins(
can_action => $headers->{actions},
);
}
else
{
@plugins = $self->export_plugins();
}
my %pset;
foreach my $plugin ( @plugins )
{
my $mimetype = $plugin->get_type eq "Export" ?
$plugin->param( "produce" ) :
$plugin->param( "accept" );
$mimetype = join ',', @$mimetype;
for( HTTP::Headers::Util::split_header_words( $mimetype ) )
{
my( $type, undef, %params ) = @$_;
push @{$pset{$type}}, {
%params,
plugin => $plugin,
q => $plugin->param( "qs" ),
id => $plugin->get_id,
};
}
}
# sort plugins internally by q then id
for(values(%pset))
{
@$_ = sort { $b->{q} <=> $a->{q} || $a->{id} cmp $b->{id} } @$_;
}
# sort supported types by the highest plugin score
my @pset_order = sort {
$pset{$b}->[0]->{q} <=> $pset{$a}->[0]->{q}
} keys %pset;
my $accept;
if( $self->is_write )
{
$accept = $r->headers_in->{'Content-Type'};
}
else
{
# summary page is higher priority than anything else for /id/eprint/23
# and /id/contents
if( ( $self->scope == CRUD_SCOPE_DATAOBJ && $self->{dataset}->base_id ne "subject" ) || $self->scope == CRUD_SCOPE_USER_CONTENTS )
{
my $plugin = $repo->plugin( "Export::SummaryPage" );
my $mimetype = $plugin->param( "produce" );
$mimetype = join ',', @$mimetype;
for( HTTP::Headers::Util::split_header_words( $mimetype ) )
{
my( $type, undef, %params ) = @$_;
unshift @pset_order, $type;
unshift @{$pset{$type}}, {
charset => 'utf-8',
q => $plugin->param( "qs" ),
plugin => $plugin,
};
}
}
$accept = $r->headers_in->{Accept} || "*/*";
}
my @accept = parse_media_range( $accept || "" );
my $match;
CHOICE: foreach my $choice ( @accept )
{
my( $mime_type, undef, %params ) = @$choice;
my( $type, $subtype ) = split '/', $mime_type;
# find matching entries by mime-type
if( exists $pset{$mime_type} )
{
# pick the best plugin based on parameters and then plugin qs
my $plugins = $pset{$mime_type};
for(keys %params) {
next if $_ eq "q";
foreach my $match (@$plugins) {
$match->{q}++
if exists($match->{$_}) && $match->{$_} eq $params{$_};
}
}
$match = (sort { $b->{q} <=> $a->{q} || $a->{id} cmp $b->{id} } @$plugins)[0]->{plugin};
$r->pnotes->{mime_type} = $mime_type;
last CHOICE;
}
# */*
elsif( $type eq '*' && $subtype eq '*' )
{
$match = $pset{$pset_order[0]}->[0]->{plugin};
$r->pnotes->{mime_type} = $mime_type;
last CHOICE;
}
# text/*
elsif( $subtype eq '*' )
{
for(@pset_order)
{
if( m#^$type/# )
{
$match = $pset{$_}->[0]->{plugin};
$r->pnotes->{mime_type} = $mime_type;
last CHOICE;
}
}
}
}
return $match;
}
# http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.1
sub parse_media_range
{
my( $media_range ) = @_;
my @accept = HTTP::Headers::Util::split_header_words( $media_range );
for(@accept)
{
my( $mime_type, undef, %params ) = @$_;
$params{'mime_type'} = $mime_type;
$params{q} = 1 if !defined $params{q};
$_ = \%params;
}
@accept = sort {
# q-scores
$b->{q} <=> $a->{q} ||
# text/html is higher than text/*
$a->{mime_type} cmp $b->{mime_type} ||
# text/html;level=1 is higher than text/html
scalar(keys %$b) <=> scalar(keys %$a)
} @accept;
return map { [ delete $_->{mime_type}, undef, %$_ ] } @accept;
}
sub handler
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
my $user = $repo->current_user;
my( $rc, $owner ) = $self->on_behalf_of( $user );
return $rc if $rc != OK;
# Subject URI's redirect to the top of that particular subject tree
# rather than the node in the tree.
if( UNIVERSAL::isa( $dataobj, "EPrints::DataObj::Subject" ) )
{
$dataobj = $dataobj->top || $dataobj;
$self->{dataobj} = $dataobj;
}
if( $self->method eq "DELETE" )
{
return $self->DELETE( $owner );
}
elsif( $self->method eq "POST" )
{
return $self->POST( $owner );
}
elsif( $self->method eq "PUT" )
{
if( $self->scope == CRUD_SCOPE_CONTENTS )
{
return $self->PUT_contents( $owner );
}
else
{
return $self->PUT( $owner );
}
}
elsif( $self->method eq "PATCH" )
{
return $self->PUT( $owner, "patch" => 1 );
}
elsif( $self->method eq "GET" || $self->method eq "HEAD" || $self->method eq "OPTIONS" )
{
$r->err_headers_out->{Allow} = join ',', $self->options;
return $self->GET( $owner );
}
return HTTP_METHOD_NOT_ALLOWED;
}
=item $rc = $crud->DELETE()
Handle DELETE requests.
=over 4
=item HTTP_METHOD_NOT_ALLOWED
Can't perform DELETE on F</id/contents>.
=item HTTP_NOT_FOUND
No such object.
=item HTTP_CONFLICT
Lock conflict with another user.
=item HTTP_NO_CONTENT
Successfully removed the object.
=back
=cut
sub DELETE
{
my( $self ) = @_;
my $repo = $self->repository;
my $dataobj = $self->dataobj;
my $user = $repo->current_user;
# /id/contents
return HTTP_METHOD_NOT_ALLOWED if $self->scope == CRUD_SCOPE_USER_CONTENTS;
# already deleted?
return NOT_FOUND if !defined $dataobj;
# obtain parent lock, if available
my $lock_obj = $dataobj;
while( defined($lock_obj) && !$lock_obj->can( "obtain_lock" ) )
{
$lock_obj = $lock_obj->can( "parent" ) ? $lock_obj->parent : undef;
}
if( defined $lock_obj )
{
$lock_obj->obtain_lock( $user )
or return HTTP_CONFLICT;
}
# allow DELETE /id/foo/bar/contents because /contents is the edit-media URI
if( $self->scope == CRUD_SCOPE_CONTENTS )
{
$_->remove for @{$self->field->get_value( $dataobj )};
}
else
{
$dataobj->remove;
}
if( defined $lock_obj && $lock_obj ne $dataobj )
{
$lock_obj->remove_lock( $user );
}
return HTTP_NO_CONTENT;
}
=item $rc = $crud->GET( [ $owner ] )
Handle GET requests.
=over 4
=item HTTP_NO_CONTENT
No sub-objects in I</id/.../contents>.
=item HTTP_NOT_ACCEPTABLE
More than one sub-object in I</id/.../contents>.
=item HTTP_UNSUPPORTED_MEDIA_TYPE
No L<Export|EPrints::Plugin::Export> plugin matches the I<Accept> header/object type.
=item HTTP_SEE_OTHER
Redirect to a non-CRUD EPrints page.
=item HTTP_NOT_FOUND
Object not found.
=item HTTP_OK
Object outputted successfully.
=back
=cut
sub GET
{
my( $self, $owner ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $field = $self->field;
my $plugin = $self->plugin;
# what to do when the user doesn't ask for a specific content type
if( $r->pnotes->{mime_type} eq "*/*" || $r->pnotes->{mime_type} eq "" )
{
# GET/HEAD XX/contents without mime type, default to content
if( $self->scope == CRUD_SCOPE_CONTENTS )
{
if( $dataobj->isa( "EPrints::DataObj::EPrint" ) )
{
my @docs = $dataobj->get_all_documents;
if( @docs == 0 )
{
return HTTP_NO_CONTENT;
}
elsif( @docs == 1 )
{
$dataobj = $docs[0];
}
else
{
return $self->sword_error(
status => HTTP_NOT_ACCEPTABLE,
summary => "More than one resource at this location",
);
}
}
return EPrints::Apache::Rewrite::redir_see_other( $r, $dataobj->get_url );
}
# GET/HEAD /id/contents without mime type, default to Atom
elsif( $self->scope == CRUD_SCOPE_USER_CONTENTS )
{
$plugin = $repo->plugin( "Export::Atom" );
}
}
return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin;
if( $dataset->base_id eq "subject" )
{
return EPrints::Apache::Rewrite::redir_see_other( $r, $plugin->dataobj_export_url( $dataobj ) );
}
my %args = %{$plugin->param( "arguments" )};
# fetch the plugin arguments, if any
foreach my $argname (keys %args)
{
if( defined $repo->param( $argname ) )
{
$args{$argname} = $repo->param( $argname );
}
}
if( $self->scope == CRUD_SCOPE_USER_CONTENTS )
{
my $indexOffset = $repo->param( "indexOffset" ) || 0;
my $page_size = 20;
my $base = $repo->current_url( host => 1 );
my $next = $base->clone;
$next->query_form( indexOffset => $indexOffset + $page_size );
my $previous = $base->clone;
$previous->query_form( indexOffset => $indexOffset - $page_size );
my $list = $owner->owned_eprints_list(
limit => $indexOffset + $page_size,
custom_order => "-lastmod",
);
$list->{ids} = $list->ids( $indexOffset, $page_size );
$r->content_type( $plugin->param( "mimetype" ) );
$plugin->initialise_fh( \*STDOUT );
$plugin->output_list(
startIndex => $indexOffset,
list => $list,
fh => \*STDOUT,
offsets => {
self => $repo->current_url( host => 1, query => 1 ),
first => $base,
next => $next,
($indexOffset >= $page_size ? (previous => $previous) : ()),
},
);
}
elsif( $self->scope == CRUD_SCOPE_CONTENTS )
{
my $datasetid = $field->property( "datasetid" );
my @ids;
if( $dataobj->isa( "EPrints::DataObj::EPrint" ) )
{
@ids = map { $_->id } $dataobj->get_all_documents;
}
else
{
@ids = map { $_->id } @{$field->get_value( $dataobj )};
}
$r->content_type( $plugin->param( "mimetype" ) );
$plugin->initialise_fh( \*STDOUT );
$plugin->output_list(
%args,
list => EPrints::List->new(
session => $repo,
dataset => $repo->dataset( $datasetid ),
ids => \@ids
),
fh => \*STDOUT,
);
}
elsif( $self->scope == CRUD_SCOPE_DATAOBJ )
{
return HTTP_NOT_FOUND if !defined $dataobj;
if ( $repo->config("use_long_url_format") && ($dataset->base_id eq "file") && ( !defined $plugin || $plugin->get_type ne "Export" ) )
{
## redirect /id/file/234 to /id/eprint/23/1.pdf (part of the 84_sword.pl test) when use_long_url_format is turned on, instead of the summary page of the file dataobj.
my $url = $dataobj->get_url;
if( defined( $url ) && $url ne $dataobj->uri )
{
return EPrints::Apache::Rewrite::redir_see_other( $r, $url );
}
}
# user wants HTML and there is a static page available
my $url = ($dataset->base_id eq "eprint" && $dataset->id ne "archive") ?
$dataobj->get_control_url :
$dataobj->get_url;
if( $plugin->get_subtype eq "SummaryPage" )
{
if( defined( $url ) && $url ne $dataobj->uri )
{
return EPrints::Apache::Rewrite::redir_see_other( $r, $url );
}
}
# set Last-Modified header for individual objects
if( my $field = $dataset->get_datestamp_field() )
{
my $datestamp = $field->get_value( $dataobj );
$r->headers_out->{'Last-Modified'} = Apache2::Util::ht_time(
$r->pool,
EPrints::Time::datestring_to_timet( undef, $datestamp )
);
}
$r->content_type( $plugin->param( "mimetype" ) );
$plugin->initialise_fh( \*STDOUT );
my $output = $plugin->output_dataobj( $dataobj,
%args,
fh => \*STDOUT,
);
# optional for output_dataobj to support 'fh'
print $output if defined $output;
}
# /id/eprint, not supported yet (what would it do?)
else
{
return HTTP_NOT_FOUND;
}
return OK;
}
=item $rc = $crud->POST( [ $owner ] )
Handle POST requests.
=over 4
=item HTTP_METHOD_NOT_ALLOWED
Can only POST to I</id/.../contents>.
=item HTTP_BAD_REQUEST
No plugin for the SWORD I<Packaging> header.
=item HTTP_CREATED
Object(s) successfully created.
=back
=cut
sub POST
{
my( $self, $owner ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $field = $self->field;
my $plugin = $self->plugin;
my $user = $repo->current_user;
# can only post to XX/contents and /id/contents
if(
$self->scope != CRUD_SCOPE_CONTENTS &&
$self->scope != CRUD_SCOPE_USER_CONTENTS
)
{
return HTTP_METHOD_NOT_ALLOWED;
}
my $headers = $self->headers;
my $rc = $self->check_packaging;
return $rc if $rc != OK;
# we can import any file type into /contents
if( !defined $plugin )
{
$plugin = $repo->plugin( "Import::Binary" );
}
my @items;
my $status;
my $rev_number;
if( $self->scope == CRUD_SCOPE_USER_CONTENTS )
{
$status = $headers->{in_progress} ? "inbox" : "buffer";
$status = "archive" if ($repo->config("skip_buffer") and $status eq "buffer");
}
my $list = $self->parse_input( $plugin, sub {
my( $epdata ) = @_;
if (!$self->is_file_ok($epdata))
{
$self->sword_error(
status => HTTP_PRECONDITION_FAILED,
href => "http://purl.org/net/sword/error/ErrorChecksumMismatch",
summary => "Attachment file integrity check failed. (Filesize not specified, filesize does not match or MD5 checksum mismatch)",
);
return undef;
}
if( $self->scope == CRUD_SCOPE_USER_CONTENTS )
{
$epdata->{userid} = $owner->id;
$epdata->{sword_depositor} = $user->id;
$epdata->{eprint_status} = $status;
$epdata->{rev_number} = $rev_number;
push @items, $dataset->create_dataobj( $epdata );
}
else
{
push @items, $dataobj->create_subdataobj( $field->name, $epdata );
}
return $items[-1];
}
);
return undef if !defined $list;
if( $self->scope == CRUD_SCOPE_CONTENTS && $headers->{metadata_relevant} )
{
$self->metadata_relevant( $items[0] );
}
my $atom = $repo->plugin( "Export::Atom" );
# producing more than one item (potentially)
if( $self->scope == CRUD_SCOPE_CONTENTS && $headers->{flags}->{unpack} )
{
return $self->send_response(
HTTP_CREATED,
$atom->param( "mimetype" ),
$atom->output_list( list => $list ),
);
}
else
{
$r->err_headers_out->{Location} = $items[0]->uri;
# DEBUG CODE
if( defined $field && $headers->{mime_type} ne "application/atom+xml" )
{
$r->err_headers_out->{Location} = $items[0]->uri . '/contents';
}
# DEBUG CODE
return $self->send_response(
HTTP_CREATED,
$atom->param( "mimetype" ),
$atom->output_dataobj( $items[0] ),
);
}
}
=item $rc = $crud->PUT( [ $owner ] )
Handle PUT requests.
=over 4
=item HTTP_UNSUPPORTED_MEDIA_TYPE
No L<Import|EPrints::Plugin::Import> plugin matched the I<Content-Type> header/object type.
=item HTTP_RANGE_NOT_SATISFIABLE
I<Range> header is invalid or unsupported for the I<object type>.
=item HTTP_FORBIDDEN
User does not have permission to create/update the I<object>.
=item HTTP_CREATED
Object was successfully created.
=item HTTP_NO_CONTENT
Object was successfully updated.
=back
=cut
# PUT /id/eprint/23
sub PUT
{
my( $self, $owner, %opts ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $self->dataset;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
my $user = $repo->current_user;
my $headers = $self->headers;
my $rc = $self->check_packaging;
return $rc if $rc != OK;
if( !defined $plugin && $dataset->base_id eq "file" )
{
$plugin = $repo->plugin( "Import::Binary" );
}
return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin;
# We support Content-Ranges for writing to files
if( defined(my $offset = $headers->{offset}) )
{
my $total = $headers->{total};
if( $dataset->base_id ne "file" || !defined $dataobj )
{
return $self->sword_error(
status => HTTP_RANGE_NOT_SATISFIABLE,
summary => "Content-Range unsupported for ".$dataset->base_id,
);
}
my $tmpfile = $self->_read_content;
return $r->status if !defined $tmpfile;
if( $total eq '*' || ($offset + -s $tmpfile) > $total )
{
return $self->sword_error(
status => HTTP_RANGE_NOT_SATISFIABLE,
summary => "Won't write beyond total file size (or total size not given)",
);
}
my $rlen = $dataobj->set_file_chunk( $tmpfile, -s $tmpfile, $offset, $total );
return $self->sword_error(
status => HTTP_INTERNAL_SERVER_ERROR,
summary => "Error occurred during writing - check server logs",
) if !defined $rlen;
$dataobj->commit;
return HTTP_NO_CONTENT;
}
my $epdata;
my $list = $self->parse_input( $plugin, sub {
( $epdata ) = @_; return undef
} );
return if !defined $list;
if (!$self->is_file_ok($epdata))
{
$self->sword_error(
status => HTTP_PRECONDITION_FAILED,
href => "http://purl.org/net/sword/error/ErrorChecksumMismatch",
summary => "Filesize not specified or filesize does not match",
);
return undef;
}
# implicit create on unknown URI
if( !defined $dataobj )
{
$dataobj = $self->create_dataobj( $owner );
return $self->sword_error(
status => HTTP_FORBIDDEN,
summary => "An item already exists at this location or you do not have sufficient privileges to create an item with a predefined identifier",
) if !defined $dataobj;
}
my( $old_status, $new_status );
if( $dataset->base_id eq "eprint" )
{
$old_status = $dataobj->value( "eprint_status" );
$new_status = delete $epdata->{eprint_status};
$epdata->{userid} = $owner->id;
$epdata->{sword_depositor} = $user->id;
$epdata->{eprint_status} = $old_status;
$epdata->{rev_number} = $dataobj->value( "rev_number" );
# check the user has permission to move this eprint, before we perform
# any other changes.
my $priv = "eprint/$old_status/move_$new_status";
if(
EPrints::Utils::is_set( $new_status ) &&
$new_status ne $old_status &&
!$user->allow( $priv, $dataobj )
)
{
return $self->sword_error(
status => HTTP_FORBIDDEN,
summary => "Insufficient privileges to transfer item from $old_status to $new_status",
);
}
}
$dataobj->empty() unless ( defined $opts{patch} );
#$dataobj->set_value('eprint_status','inbox') if $dataobj->get_dataset_id() eq "eprint";
$dataobj->update( $epdata, include_subdataobjs => 1 );
$dataobj->commit;
# transfer the eprint, if needed
if(
EPrints::Utils::is_set( $new_status ) &&
$new_status ne $old_status
)
{
$dataobj->_transfer( $new_status );
}
if( !defined $self->dataobj )
{
my $atom = $repo->plugin( "Export::Atom" );
$self->request->err_headers_out->{Location} = $dataobj->uri;
return $self->send_response(
HTTP_CREATED,
$atom->param( "mimetype" ),
$atom->output_dataobj( $dataobj ),
);
}
return HTTP_NO_CONTENT;
}
=item $rc = $crud->PUT_contents( [ $owner ] )
Equivalent to C<DELETE /id/.../contents> then C<POST /id/.../contents>.
See L</DELETE> and L</POST>.
=cut
sub PUT_contents
{
my( $self, $owner ) = @_;
my $repo = $self->repository;
my $dataobj = $self->dataobj;
my $plugin = $self->plugin;
my $field = $self->field;
my $headers = $self->headers;
my $rc = $self->check_packaging;
return $rc if $rc != OK;
# we can import any file type into XX/contents
if( !defined $plugin )
{
$plugin = $repo->plugin( "Import::Binary" );
}
return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin;
# PUT /XX/contents implies DELETE existing contents
$_->remove for @{$field->get_value( $dataobj )};
my @items;
my $list = $self->parse_input( $plugin, sub {
my( $epdata ) = @_;
push @items, $dataobj->create_subdataobj( $field->name, $epdata );
return $items[-1];
}
);
return if !defined $list;
if( $headers->{metadata_relevant} )
{
$self->metadata_relevant( $items[0] );
}
return HTTP_NO_CONTENT;
}
sub metadata_relevant
{
my( $self, $file ) = @_;
my $repo = $self->repository;
if( $file->isa( "EPrints::DataObj::EPrint" ) )
{
$file = ($file->get_all_documents())[0];
}
if( defined $file && $file->isa( "EPrints::DataObj::Document" ) )
{
$file = $file->stored_file( $file->value( "main" ) );
}
return if !defined $file;
my $eprint = eval { $file->parent->parent };
return if !defined $eprint;
my $fh = $file->get_local_copy;
return if !defined $fh;
my $dataset = $repo->dataset( "eprint" );
my $epdata = {};
my @plugins = $repo->get_plugins(
type => "Import",
can_accept => $file->value( "mime_type" ),
can_produce => "dataobj/".$dataset->base_id,
can_action => "metadata",
);
@plugins = sort { $a->{qs} <=> $b->{qs} } @plugins;
my @messages;
my $handler = EPrints::CLIProcessor->new(
message => sub { push @messages, $_[1] },
epdata_to_dataobj => sub {
my( $data ) = @_;
foreach my $fieldname (keys %$data)
{
next if !$dataset->has_field( $fieldname );
my $f = $dataset->field( $fieldname );
delete $epdata->{$fieldname} if exists $epdata->{$fieldname};
$epdata->{$fieldname} = $data->{$fieldname};
}
return undef;
}
);
foreach my $plugin ( @plugins )
{
$plugin->set_handler( $handler );
seek($fh,0,0);
$plugin->input_fh(
fh => $fh,
dataset => $dataset,
filename => $file->value( "filename" ),
actions => ["metadata"],
);
}
for(qw( eprint_status userid sword_depositor rev_number ))
{
$epdata->{$_} = $eprint->value( $_ );
}
$eprint->empty();
$eprint->update( $epdata );
$eprint->commit;
}
sub servicedocument
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $dataset = $repo->dataset( "eprint" );
my $xml = $repo->xml;
my $user = $repo->current_user;
EPrints->abort( "unprotected" ) if !defined $user; # Rewrite foobar
my ( $status, $on_behalf_of ) = $self->on_behalf_of( $user );
if( $status != OK )
{
return $self->sword_error(
status => HTTP_FORBIDDEN,
href => "http://purl.org/net/sword/error/TargetOwnerUnknown",
summary => "Target user unknown or no permission to act on-behalf-of",
);
}
# SERVICE and WORKSPACE DEFINITION
my $service = $xml->create_element( "service",
xmlns => "http://www.w3.org/2007/app",
"xmlns:atom" => "http://www.w3.org/2005/Atom",
"xmlns:sword" => "http://purl.org/net/sword/",
"xmlns:dcterms" => "http://purl.org/dc/terms/" );
my $title = $repo->phrase( "archive_name" ) . ": " . $repo->phrase( "Plugin/Screen/Items:title" );
my $workspace = $xml->create_data_element( "workspace", [
[ "atom:title", $title ],
# SWORD LEVEL
[ "sword:version", "2.0" ],
# SWORD VERBOSE (Unsupported)
# [ "sword:verbose", "true" ],
# SWORD NOOP (Unsupported)
# [ "sword:noOp", "true" ],
]);
$service->appendChild( $workspace );
my $collection = $xml->create_data_element( "collection", [
# COLLECTION TITLE
[ "atom:title", $repo->dataset( "eprint" )->render_name ],
# COLLECTION POLICY
# [ "sword:collectionPolicy", $service_conf->{sword_policy} ],
# COLLECTION MEDIATED
[ "sword:mediation", "true" ],
# DCTERMS ABSTRACT
# [ "dcterms:abstract", $service_conf->{dcterms_abstract} ],
# COLLECTION TREATMENT
# [ "sword:treatment", $treatment ],
], "href" => $repo->current_url( host => 1, path => "static", "id/contents" ),
);
$workspace->appendChild( $collection );
if( $user->allow( "create_eprint" ) )
{
foreach my $plugin ($self->import_plugins( is_advertised => 1 ))
{
foreach my $mime_type (@{$plugin->param( "accept" )})
{
if( $mime_type =~ /^$PACKAGING_PREFIX(.+)$/ )
{
$collection->appendChild( $xml->create_data_element( "sword:acceptPackaging", $1 ) );
}
else
{
$collection->appendChild( $xml->create_data_element( "accept", $mime_type, alternate => "multipart-related" ) );
}
}
}
# we always accept simple files
$collection->appendChild( $xml->create_data_element( "acceptPackaging", "http://purl.org/net/sword/package/Binary" ) );
$collection->appendChild( $xml->create_data_element( "accept", "application/octet-stream", alternate => "multipart-related" ) );
}
else
{
$collection->appendChild( $xml->create_data_element( "accept" ) );
}
my $categories = $collection->appendChild( $xml->create_element( "categories", fixed => "yes" ) );
foreach my $type ($dataset->field( "type" )->tags)
{
$categories->appendChild( $xml->create_element( "atom:category",
scheme => $repo->config( "base_url" )."/data/eprint/type",
term => $type,
) );
}
foreach my $type ($dataset->field( "eprint_status" )->tags)
{
$categories->appendChild( $xml->create_element( "atom:category",
scheme => EPrints::Const::EP_NS_DATA . "/eprint/eprint_status",
term => $type,
) );
}
my $content = "<?xml version='1.0' encoding='UTF-8'?>\n" .
$xml->to_string( $service, indent => 1 );
return $self->send_response(
OK,
'application/atomsvc+xml; charset=utf-8',
$content
);
}
### Utility methods below
sub on_behalf_of
{
my( $self, $user ) = @_;
my $repo = $self->repository;
my $r = $self->request;
my $on_behalf_of =
$r->headers_in->{'On-Behalf-Of'} || # SWORD 2.0
$r->headers_in->{'X-On-Behalf-Of'}; # SWORD 1.3
return( OK, $user ) if !$on_behalf_of;
my $owner = $repo->user_by_username( $on_behalf_of );
return ( HTTP_FORBIDDEN, undef )
if !defined $owner;
return ( HTTP_FORBIDDEN, undef )
if !$user->allow( "user/mediate", $owner );
return( OK, $owner );
}
sub is_true
{
return defined($_[0]) && lc($_[0]) eq "true";
}
sub is_false
{
return defined($_[0]) && lc($_[0]) eq "false";
}
##check the filesize is set correctly in the given epdata obj and the md5 check sum matching
##The check only happens when file is using "_content"
sub is_file_ok
{
my( $self, $epdata ) = @_;
my $file_checking_succ=1;
return $file_checking_succ unless defined $epdata->{documents};
foreach my $doc (@{$epdata->{documents}})
{
foreach (@{$doc->{files}})
{
my $content = $_->{_content};
if (defined $content) ##when content is defined, we expect the filesize exist and same as the the one in xml.
{
if (!defined $_->{filesize})
{
$file_checking_succ=0;
}
my $filesize = -s $content;
if ($filesize ne $_->{filesize}) ##if file size do not match, file check fail
{
$file_checking_succ=0;
}
##checking md5 checksum
if (defined($_->{hash_type}) && defined($_->{hash}))
{
if (lc($_->{hash_type}) eq 'md5')
{
my $ctx = Digest::MD5->new->addfile($content);
seek($content,0,0);
if ($ctx->hexdigest ne $_->{hash})
{
$file_checking_succ=0;
}
}
}
}
}
}
return $file_checking_succ;
}
sub process_headers
{
my( $self ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my %response;
$self->{headers} = \%response;
# X-Method (pseudo-PUTs etc. from POST)
$self->{method} = uc($r->method);
if( $self->method eq "POST" )
{
if( $r->headers_in->{'X-Method'} )
{
$self->{method} = uc($r->headers_in->{'X-Method'});
}
# or via Ruby-on-Rails "_method" query parameter
my %q = URI::http->new( $r->unparsed_uri )->query_form;
if( $q{_method} )
{
$self->{method} = uc($q{_method});
}
}
# In-Progress
$response{in_progress} = is_true( $r->headers_in->{'In-Progress'} );
# X-Verbose
$response{verbose} = is_true( $r->headers_in->{'X-Verbose'} );
# Content-Type
$response{content_type} = $r->headers_in->{'Content-Type'};
$response{content_type} = "application/octet-stream"
if !EPrints::Utils::is_set( $response{content_type} );
( $response{mime_type}, my %params ) = @{(HTTP::Headers::Util::split_header_words($response{content_type}))[0]};
$response{content_type_params} = \%params;
# Content-Length
$response{content_length} = $r->headers_in->{'Content-Length'};
# Content-Range
my $range = $r->headers_in->{'Content-Range'};
if( defined $range )
{
if( $range =~ m{^(\d+)-(\d+)/(\d+|\*)$} && $1 <= $2 )
{
$response{content_range} = $range;
$response{offset} = $1;
$response{total} = $3;
if( !defined $response{content_length} )
{
$response{content_length} = $2 - $1;
}
}
else
{
return HTTP_RANGE_NOT_SATISFIABLE;
}
}
# Content-MD5
$response{content_md5} = $r->headers_in->{'Content-MD5'};
# Content-Disposition
my @values = @{(HTTP::Headers::Util::split_header_words( $r->headers_in->{'Content-Disposition'} || '' ))[0] || []};
for(my $i = 0; $i < @values; $i += 2)
{
if( $values[$i] eq "filename" )
{
$response{filename} = $values[$i+1];
}
}
$response{filename} = "main.bin"
if !EPrints::Utils::is_set( $response{filename} );
($response{extension}) = $response{filename} =~ /((?:\.[^\.]+){1,2})$/;
# X-No-Op
$response{no_op} = is_true( $r->headers_in->{'X-No-Op'} );
# X-Packaging
$response{packaging} =
$r->headers_in->{'Packaging'} || # SWORD 2.0
$r->headers_in->{'X-Packaging'} || # SWORD 1.3
$r->headers_in->{'X-Format-Namespace'}; # SWORD 1.2
# Slug
$response{slug} = $r->headers_in->{'Slug'};
# userAgent
$response{user_agent} = $r->headers_in->{'User-Agent'};
# Metadata-relevant
$response{metadata_relevant} =
is_true($r->headers_in->{'Metadata-Relevant'}) || # SWORD 2.0
is_true($r->headers_in->{'X-Override-Metadata'}); # SWORD 2.0a
# actions
my $actions = $response{actions} = [];
# push @$actions, "metadata" if $response{metadata_relevant};
push @$actions, "unpack" if $response{packaging} && $response{packaging} eq "http://purl.org/net/sword/package/SimpleZip";
$response{flags} = {map { $_ => 1 } @$actions};
return OK;
}
sub sword_error
{
my( $self, %opts ) = @_;
my $r = $self->request;
my $repo = $self->repository;
my $xml = generate_error_document( $repo, %opts );
$opts{status} = HTTP_BAD_REQUEST if !defined $opts{status};
$r->status( $opts{status} );
return $self->send_response(
$opts{status},
'application/xml; charset=UTF-8',
$xml
);
}
# input_fh() failed
sub plugin_error
{
my( $self, $plugin, $messages ) = @_;
my $repo = $self->repository;
$plugin->handler->message( "error", $@ ) if $@ ne "\n";
my $ul = $repo->xml->create_element( "ul" );
for(@{$messages}) {
$ul->appendChild( $repo->xml->create_data_element( "li", $_ ) );
}
my $err = $repo->xhtml->to_xhtml( $ul );
$repo->xml->dispose( $ul );
return $self->sword_error(
status => HTTP_INTERNAL_SERVER_ERROR,
summary => $err
);
}
# other helper functions:
sub generate_error_document
{
my ( $repo, %opts ) = @_;
my $xml = $repo->xml;
$opts{href} = "http://eprints.org/sword/error/UnknownError"
if !defined $opts{href};
my $error = $xml->create_data_element( "sword:error", [
[ "title", "ERROR" ],
[ "updated", EPrints::Time::get_iso_timestamp() ],
[ "generator", $repo->phrase( "archive_name" ),
uri => "http://www.eprints.org/",
version => EPrints->human_version,
],
[ "summary", $opts{summary} ],
[ "sword:userAgent", $opts{user_agent} ],
],
"xmlns" => "http://www.w3.org/2005/Atom",
"xmlns:sword" => "http://purl.org/net/sword/",
href => $opts{href},
);
return "<?xml version='1.0' encoding='UTF-8'?>\n" .
$xml->to_string( $error, indent => 1 );
}
sub send_response
{
my( $self, $status, $content_type, $content ) = @_;
my $r = $self->request;
use bytes;
$r->status( $status == OK ? HTTP_OK : $status );
$r->content_type( $content_type );
if( defined $content )
{
$r->err_headers_out->{'Content-Length'} = length $content;
binmode(STDOUT, ":utf8");
print $content;
}
return OK;
}
1;
=back
=head1 SEE ALSO
http://en.wikipedia.org/wiki/Create,_read,_update_and_delete
http://en.wikipedia.org/wiki/Content_negotiation
=head1 COPYRIGHT
=for COPYRIGHT BEGIN
Copyright 2000-2011 University of Southampton.
=for COPYRIGHT END
=for LICENSE BEGIN
This file is part of EPrints L<http://www.eprints.org/>.
EPrints is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
EPrints is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public
License along with EPrints. If not, see L<http://www.gnu.org/licenses/>.
=for LICENSE END