Catmandu-FedoraCommons-0.5000755000765000024 013375261174 15754 5ustar00hochstenstaff000000000000README100644000765000024 4641413375261174 16746 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5NAME Catmandu::FedoraCommons - Low level Catmandu interface to the Fedora Commons REST API SYNOPSIS # Use the command line tools $ fedora_admin.pl # Or the low-level API-s use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $result = $fedora->findObjects(terms=>'*'); die $result->error unless $result->is_ok; my $hits = $result->parse_content(); for my $hit (@{ $hits->{results} }) { printf "%s\n" , $hit->{pid}; } # Or using the higher level Catmandu::Store codes you can do things like use Catmandu::Store::FedoraCommons; my $store = Catmandu::Store::FedoraCommons->new( baseurl => 'http://localhost:8080/fedora', username => 'fedoraAdmin', password => 'fedoraAdmin', model => 'Catmandu::Store::FedoraCommons::DC' # default ); $store->bag->each(sub { my $model = shift; printf "title: %s\n" , join("" , @{ $model->{title} }); printf "creator: %s\n" , join("" , @{ $model->{creator} }); my $pid = $model->{_id}; my $ds = $store->fedora->listDatastreams(pid => $pid)->parse_content; }); my $obj = $store->bag->add({ title => ['The Master and Margarita'] , creator => ['Bulgakov, Mikhail'] } ); $store->fedora->addDatastream(pid => $obj->{_id} , url => "http://myurl/rabbit.jpg"); # Add your own perl version of a descriptive metadata model by implementing your own # model that can do a serialize and deserialize. DESCRIPTION Catmandu::FedoraCommons is an Perl API to the Fedora Commons REST API (http://www.fedora.info/). Supported versions are Fedora Commons 3.6 or better. ACCESS METHODS new($base_url,$username,$password) Create a new Catmandu::FedoraCommons connecting to the baseurl of the Fedora Commons installation. findObjects(query => $query, maxResults => $maxResults) findObjects(terms => $terms , maxResults => $maxResults) Execute a search query on the Fedora Commons server. One of 'query' or 'terms' is required. Query contains a phrase optionally including '*' and '?' wildcards. Terms contain one or more conditions separated by space. A condition is a field followed by an operator, followed by a value. The = operator will match if the field's entire value matches the value given. The ~ operator will match on phrases within fields, and accepts the ? and * wildcards. The <, >, <=, and >= operators can be used with numeric values, such as dates. Examples: query => "*o*" query => "?edora" terms => "pid~demo:* description~fedora" terms => "cDate>=1976-03-04 creator~*n*" terms => "mDate>2002-10-2 mDate<2002-10-2T12:00:00" Optionally a maxResults parameter may be specified limiting the number of search results (default is 20). This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::findObjects model. resumeFindObjects(sessionToken => $token) This method returns the next batch of search results. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::findObjects model. Example: my $result = $fedora->findObjects(terms=>'*'); die $result->error unless $result->is_ok; my $hits = $result->parse_content(); for my $hit (@{ $hits->{results} }) { printf "%s\n" , $hit->{pid}; } my $result = $fedora->resumeFindObjects(sessionToken => $hits->{token}); my $hits = $result->parse_content(); ... getDatastreamDissemination(pid => $pid, dsID=> $dsID, asOfDateTime => $date, callback => \&callback) This method returns a datastream from the Fedora Commons repository. Required parameters are the identifier of the object $pid and the identifier of the datastream $dsID. Optionally a datestamp $asOfDateTime can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::getDatastreamDissemination model. To stream the contents of the datastream a callback function can be provided. Example: $fedora->getDatastreamDissemination(pid => 'demo:5', dsID => 'VERYHIGHRES', callback => \&process); sub process { my ($data, $response, $protocol) = @_; print $data; } getDissemination(pid => $pid , sdefPid => $sdefPid , method => $method , %method_parameters , callback => \&callback) This method execute a dissemination method on the Fedora Commons server. Required parametes are the object $pid, the service definition $sdefPid and the name of the method $method. Optionally further method parameters can be provided and a callback function to stream the results (see getDatastreamDissemination). This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::getDatastreamDissemination model. Example: $fedora->getDissemination(pid => 'demo:29', sdefPid => 'demo:27' , method => 'resizeImage' , width => 100, callback => \&process); getObjectHistory(pid => $pid) This method returns the version history of an object. Required is the object $pid. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::getObjectHistory model. Example: my $obj = $fedora->getObjectHistory(pid => 'demo:29')->parse_content; for @{$obj->{objectChangeDate}} {} print "$_\n; } getObjectProfile(pid => $pid, asOfDateTime => $date) This method returns a detailed description of an object. Required is the object $pid. Optionally a version date asOfDateTime can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::getObjectProfile model. Example: my $obj = $fedora->getObjectProfile(pid => 'demo:29')->parse_content; printf "Label: %s\n" , $obj->{objLabel}; listDatastreams(pid => $pid, asOfDateTime => $date) This method returns a list of datastreams provided in the object. Required is the object $pid. Optionally a version date asOfDateTime can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::listDatastreams model. Example: my $obj = $fedora->listDatastreams(pid => 'demo:29')->parse_content; for (@{ $obj->{datastream}} ) { printf "Label: %s\n" , $_->{label}; } listMethods(pid => $pid , sdefPid => $sdefPid , asOfDateTime => $date) This method return a list of methods that can be executed on an object. Required is the object $pid and the object $sdefPid. Optionally a version date asOfDateTime can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::listMethods model. Example: my $obj = $fedora->listMethods(pid => 'demo:29')->parse_content; for ( @{ $obj->{sDef} }) { printf "[%s]\n" , $_->{$pid}; for my $m ( @{ $_->{method} } ) { printf "\t%s\n" , $m->{name}; } } describeRepository This method returns information about the fedora repository. No arguments required. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::describeRepository model. Example: my $desc = $fedora->describeRepository()->parse_content(); MODIFY METHODS addDatastream(pid => $pid , dsID => $dsID, url => $remote_location, %args) addDatastream(pid => $pid , dsID => $dsID, file => $filename , %args) addDatastream(pid => $pid , dsID => $dsID, xml => $xml , %args) This method adds a data stream to the object. Required parameters are the object $pid, a new datastream $dsID and a remote $url, a local $file or an $xml string which contains the content. Optionally any of these datastream modifiers may be provided: controlGroup, altIDs, dsLabel, versionable, dsState, formatURI, checksumType, checksum, mimeType, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamProfile model. Example: my $obj = $fedora->addDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README', mimeType => 'text/plain')->parse_content; print "Uploaded at: %s\n" , $obj->{dateTime}; addRelationship(pid => $pid, relation => [ $subject, $predicate, $object] [, dataType => $dataType]) This methods adds a triple to the 'RELS-EXT' data stream of the object. Requires parameters are the object $pid and a relation as a triple ARRAY reference. Optionally the $datatype of the literal may be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::addRelationship model. Example: $fedora->addRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']); export(pid => $pid [, format => $format , context => $context , encoding => $encoding]) This method exports the data model of the object in FOXML,METS or ATOM. Required is $pid of the object. Optionally a $context may be provided and the $format of the export. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::export model. Example: my $res = $fedora->export(pid => 'demo:29'); print $res->raw; print "%s\n" , $res->parse_content->{objectProperties}->{label}; getDatastream(pid => $pid, dsID => $dsID , %args) This method return metadata about a data stream. Required is the object $pid and the $dsID of the data stream. Optionally a version 'asOfDateTime' can be provided and a 'validateChecksum' check. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamProfile model. Example: my $obj = $fedora->getDatastream(pid => 'demo:29', dsID => 'DC')->parse_content; printf "Label: %s\n" , $obj->{profile}->{dsLabel}; getDatastreamHistory(pid => $pid , dsID => $dsID , %args) This method returns the version history of a data stream. Required paramter is the $pid of the object and the $dsID of the data stream. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamHistory model. Example: my $obj = $fedora->getDatastreamHistory(pid => 'demo:29', dsID => 'DC')->parse_content; for (@{ $obj->{profile} }) { printf "Version: %s\n" , $_->{dsCreateDate}; } getNextPID(namespace => $namespace, numPIDs => $numPIDs) This method generates a new pid. Optionally a 'namespace' can be provided and the required 'numPIDs' you need. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::pidList model. Example: my $pid = $fedora->getNextPID()->parse_content->[0]; getObjectXML(pid => $pid) This method exports the data model of the object in FOXML format. Required is $pid of the object. This method returns a Catmandu::FedoraCommons::Response object . Example: my $res = $fedora->getObjectXML(pid => 'demo:29'); print $res->raw; getRelationships(pid => $pid [, relation => [$subject, $predicate, undef] , format => $format ]) This method returns all RELS-EXT triples for an object. Required parameter is the $pid of the object. Optionally the triples may be filetered using the 'relation' parameter. Format defines the returned format. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::getRelationships model. Example: my $obj = $fedora->getRelationships(pid => 'demo:29')->parse_content; my $iter = $obj->get_statements(); print "Names of things:\n"; while (my $st = $iter->next) { my $s = $st->subject; my $name = $st->object; print "The name of $s is $name\n"; } ingest(pid => $pid , file => $filename , xml => $xml , format => $format , %args) ingest(pid => 'new' , file => $filename , xml => $xml , format => $format , %args) This method ingest an object into Fedora Commons. Required is the $pid of the new object (which can be the string 'new' when Fedora has to generate a new pid), and the $filename or $xml to upload writen as $format. Optionally the following parameters can be provided: label, encoding, namespace, ownerId, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::ingest model. Example: my $obj = $fedora->ingest(pid => 'new', file => 't/obj_demo_40.zip', format => 'info:fedora/fedora-system:ATOMZip-1.1')->parse_content; printf "created: %s\n" , $obj->{pid}; modifyDatastream(pid => $pid , dsID => $dsID, url => $remote_location, %args) modifyDatastream(pid => $pid , dsID => $dsID, file => $filename , %args) modifyDatastream(pid => $pid , dsID => $dsID, xml => $xml , %args) This method updated a data stream in the object. Required parameters are the object $pid, a new datastream $dsID and a remote $url, a local $file or an $xml string which contains the content. Optionally any of these datastream modifiers may be provided: controlGroup, altIDs, dsLabel, versionable, dsState, formatURI, checksumType, checksum, mimeType, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamProfile model. Example: my $obj = $fedora->modifyDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README', mimeType => 'text/plain')->parse_content; print "Uploaded at: %s\n" , $obj->{dateTime}; modifyObject(pid => $pid, label => $label , ownerId => ownerId , state => $state , logMessage => $logMessage , lastModifiedDate => $lastModifiedDate) This method updated the metadata of an object. Required parameter is the $pid of the object. Optionally one or more of label, ownerId, state, logMessage and lastModifiedDate can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::modifyObject model. Example: $fedora->modifyObject(pid => 'demo:29' , state => 'I'); purgeDatastream(pid => $pid , dsID => $dsID , startDT => $startDT , endDT => $endDT , logMessage => $logMessage) This method purges a data stream from an object. Required parameters is the $pid of the object and the $dsID of the data stream. Optionally a range $startDT to $endDT versions can be provided to be deleted. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::purgeDatastream model. Example: $fedora->purgeDatastream(pid => 'demo:29', dsID => 'TEST')->parse_content; purgeObject(pid => $pid, logMessage => $logMessage) This method purges an object from Fedora Commons. Required parameter is the $pid of the object. Optionally a $logMessage can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::purgeObject model. Example: $fedora->purgeObject(pid => 'demo:29'); purgeRelationship(pid => $pid, relation => [ $subject, $predicate, $object] [, dataType => $dataType]) This method removes a triple from the RELS-EXT data stream of an object. Required parameters are the $pid of the object and the relation to be deleted. Optionally the $dataType of the literal can be provided. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::purgeRelationship model. Example: $fedora->purgeRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']) setDatastreamState(pid => $pid, dsID => $dsID, dsState => $dsState) This method can be used to put a data stream on/offline. Required parameters are the $pid of the object , the $dsID of the data stream and the required new $dsState ((A)ctive, (I)nactive, (D)eleted). This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamProfile model. Example: $fedora->setDatastreamState(pid => 'demo:29' , dsID => 'url' , dsState => 'I'); setDatastreamVersionable(pid => $pid, dsID => $dsID, versionable => $versionable) This method updates the versionable state of a data stream. Required parameters are the $pid of the object, the $dsID of the data stream and the new $versionable (true|false) state. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::datastreamProfile model. Example: $fedora->setDatastreamVersionable(pid => 'demo:29' , dsID => 'url' , versionable => 'false'); validate(pid => $pid) This method can be used to validate the content of an object. Required parameter is the $pid of the object. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::validate model. Example: my $obj = $fedora->validate(pid => 'demo:29')->parse_content; print "Is valid: %s\n" , $obj->{valid}; upload(file => $file) This method uploads a file to the Fedora Server. Required parameter is the $file name. This method returns a Catmandu::FedoraCommons::Response object with a Catmandu::FedoraCommons::Model::upload- model. Example: my $obj = $fedora->upload(file => 't/marc.xml')->parse_content; print "Upload id: %s\n" , $obj->{id}; SEE ALSO Catmandu::FedoraCommons::Response, Catmandu::Model::findObjects, Catmandu::Model::getObjectHistory, Catmandu::Model::getObjectProfile, Catmandu::Model::listDatastreams, Catmandu::Model::listMethods AUTHOR * Patrick Hochstenbach, LICENSE AND COPYRIGHT This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Changes100644000765000024 130313375261174 17325 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5Revision history for Catmandu-OAI 0.5 2018-11-21 14:49:43 CET - Adding Catmandu::FileStore dependency 0.4 2017-11-06 14:46:28 CET - Fixing File::Store add to work like Store add 0.3 2017-08-31 16:20:32 CEST - Adding support file Catmandu::FileStore - Adding more tests 0.274 2016-02-24 15:44:52 CET - Fixing code fo Catmandu 1.0 release 0.273 2015-11-17 14:42:02 CET - Adding describeRepository command - Adding support for reading and adding to the Fedora default namespace - Adding support to switch namespaces using the bag('name') - Listing all objects is only within one namespace 0.272 2015-05-21 09:49:18 CEST - Upgrade to Dist::Milla - Upgrade to latest Catmandu LICENSE100644000765000024 4370513375261174 17073 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5This software is copyright (c) 2018 by Patrick Hochstenbach. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2018 by Patrick Hochstenbach. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program 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 1, or (at your option) any later version. This program 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2018 by Patrick Hochstenbach. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End cpanfile100644000765000024 120513375261174 17537 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5requires 'perl', 'v5.14'; on 'test', sub { requires 'Test::Simple', '1.001003'; requires 'Test::More', '1.001003'; requires 'Test::Exception','0.32'; requires 'Test::Pod','1.49'; }; requires 'Catmandu', '1.06'; requires 'Catmandu::FileStore', '1.13'; requires 'Date::Parse','0'; requires 'Data::Validate::URI', '0.06'; requires 'Data::Validate::Type', '1.5.1'; requires 'HTTP::Request::Common', '6.04'; requires 'RDF::Trine', '1.014'; requires 'Test::JSON', '0.11'; requires 'XML::LibXML', '2.0121'; requires 'IO::File::WithFilename', '0.01'; # Need recent SSL to talk to https endpoint correctly requires 'IO::Socket::SSL', '2.015'; Build.PL100644000765000024 27313375261174 17313 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5# This Build.PL for Catmandu-FedoraCommons was generated by Dist::Zilla::Plugin::ModuleBuildTiny 0.015. use strict; use warnings; use v5.14.0; use Module::Build::Tiny 0.034; Build_PL(); META.yml100644000765000024 245213375261174 17311 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5--- abstract: 'Low level Catmandu interface to the Fedora Commons REST API' author: - =over build_requires: Test::Exception: '0.32' Test::More: '1.001003' Test::Pod: '1.49' Test::Simple: '1.001003' configure_requires: Module::Build::Tiny: '0.034' dynamic_config: 0 generated_by: 'Dist::Milla version v1.0.17, Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Catmandu-FedoraCommons no_index: directory: - eg - examples - inc - share - t - xt requires: Catmandu: '1.06' Catmandu::FileStore: '1.13' Data::Validate::Type: v1.5.1 Data::Validate::URI: '0.06' Date::Parse: '0' HTTP::Request::Common: '6.04' IO::File::WithFilename: '0.01' IO::Socket::SSL: '2.015' RDF::Trine: '1.014' Test::JSON: '0.11' XML::LibXML: '2.0121' perl: v5.14.0 resources: bugtracker: https://github.com/LibreCat/Catmandu-FedoraCommons/issues homepage: https://github.com/LibreCat/Catmandu-FedoraCommons repository: https://github.com/LibreCat/Catmandu-FedoraCommons.git version: '0.5' x_contributors: - 'njfranck ' - 'Patrick Hochstenbach ' x_serialization_backend: 'YAML::Tiny version 1.69' MANIFEST100644000765000024 546213375261174 17175 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008. Build.PL Changes LICENSE MANIFEST MANIFEST.SKIP META.json META.yml README bin/fedora_admin.pl catmandu.yml cpanfile lib/Catmandu/FedoraCommons.pm lib/Catmandu/FedoraCommons/Model/addRelationship.pm lib/Catmandu/FedoraCommons/Model/datastreamHistory.pm lib/Catmandu/FedoraCommons/Model/datastreamProfile.pm lib/Catmandu/FedoraCommons/Model/describeRepository.pm lib/Catmandu/FedoraCommons/Model/export.pm lib/Catmandu/FedoraCommons/Model/findObjects.pm lib/Catmandu/FedoraCommons/Model/getDatastreamDissemination.pm lib/Catmandu/FedoraCommons/Model/getObjectHistory.pm lib/Catmandu/FedoraCommons/Model/getObjectProfile.pm lib/Catmandu/FedoraCommons/Model/getRelationships.pm lib/Catmandu/FedoraCommons/Model/ingest.pm lib/Catmandu/FedoraCommons/Model/listDatastreams.pm lib/Catmandu/FedoraCommons/Model/listMethods.pm lib/Catmandu/FedoraCommons/Model/modifyObject.pm lib/Catmandu/FedoraCommons/Model/pidList.pm lib/Catmandu/FedoraCommons/Model/purgeDatastream.pm lib/Catmandu/FedoraCommons/Model/purgeObject.pm lib/Catmandu/FedoraCommons/Model/purgeRelationship.pm lib/Catmandu/FedoraCommons/Model/upload.pm lib/Catmandu/FedoraCommons/Model/validate.pm lib/Catmandu/FedoraCommons/Response.pm lib/Catmandu/Store/FedoraCommons.pm lib/Catmandu/Store/FedoraCommons/DC.pm lib/Catmandu/Store/FedoraCommons/FOXML.pm lib/Catmandu/Store/File/FedoraCommons.pm lib/Catmandu/Store/File/FedoraCommons/Bag.pm lib/Catmandu/Store/File/FedoraCommons/Index.pm t/01_load.t t/02_access.t t/03_modify.t t/04_store.t t/Catmandu-FedoraCommons-Model-addRelationship.t t/Catmandu-FedoraCommons-Model-datastreamHistory.t t/Catmandu-FedoraCommons-Model-datastreamProfile.t t/Catmandu-FedoraCommons-Model-describeRepository.t t/Catmandu-FedoraCommons-Model-export.t t/Catmandu-FedoraCommons-Model-findObjects.t t/Catmandu-FedoraCommons-Model-getDatastreamDissemination.t t/Catmandu-FedoraCommons-Model-getObjectHistory.t t/Catmandu-FedoraCommons-Model-getObjectProfile.t t/Catmandu-FedoraCommons-Model-getRelationships.t t/Catmandu-FedoraCommons-Model-ingest.t t/Catmandu-FedoraCommons-Model-listDatastreams.t t/Catmandu-FedoraCommons-Model-listMethods.t t/Catmandu-FedoraCommons-Model-modifyObject.t t/Catmandu-FedoraCommons-Model-pidList.t t/Catmandu-FedoraCommons-Model-purgeDatastream.t t/Catmandu-FedoraCommons-Model-purgeObject.t t/Catmandu-FedoraCommons-Model-purgeRelationship.t t/Catmandu-FedoraCommons-Model-upload.t t/Catmandu-FedoraCommons-Model-validate.t t/Catmandu-FedoraCommons-Response.t t/Catmandu-FedoraCommons.t t/Catmandu-Store-FedoraCommons-DC.t t/Catmandu-Store-FedoraCommons-FOXMLt t/Catmandu-Store-FedoraCommons.t t/Catmandu-Store-File-FedoraCommons-Bag.t t/Catmandu-Store-File-FedoraCommons-Index.t t/Catmandu-Store-File-FedoraCommons.t t/author-pod-syntax.t t/marc.xml t/obj_demo_40.zip META.json100644000765000024 435713375261174 17467 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5{ "abstract" : "Low level Catmandu interface to the Fedora Commons REST API", "author" : [ "=over" ], "dynamic_config" : 0, "generated_by" : "Dist::Milla version v1.0.17, Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Catmandu-FedoraCommons", "no_index" : { "directory" : [ "eg", "examples", "inc", "share", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.034" } }, "develop" : { "requires" : { "Dist::Milla" : "v1.0.17", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Catmandu" : "1.06", "Catmandu::FileStore" : "1.13", "Data::Validate::Type" : "v1.5.1", "Data::Validate::URI" : "0.06", "Date::Parse" : "0", "HTTP::Request::Common" : "6.04", "IO::File::WithFilename" : "0.01", "IO::Socket::SSL" : "2.015", "RDF::Trine" : "1.014", "Test::JSON" : "0.11", "XML::LibXML" : "2.0121", "perl" : "v5.14.0" } }, "test" : { "requires" : { "Test::Exception" : "0.32", "Test::More" : "1.001003", "Test::Pod" : "1.49", "Test::Simple" : "1.001003" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/LibreCat/Catmandu-FedoraCommons/issues" }, "homepage" : "https://github.com/LibreCat/Catmandu-FedoraCommons", "repository" : { "type" : "git", "url" : "https://github.com/LibreCat/Catmandu-FedoraCommons.git", "web" : "https://github.com/LibreCat/Catmandu-FedoraCommons" } }, "version" : "0.5", "x_contributors" : [ "njfranck ", "Patrick Hochstenbach " ], "x_serialization_backend" : "Cpanel::JSON::XS version 3.0233" } t000755000765000024 013375261174 16140 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5marc.xml100644000765000024 677113375261174 17757 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/t 01142cam 2200301 a 4500 92005291 DLC 19930521155141.9 920219s1993 caua j 000 0 eng 92005291 0152038655 : $15.95 DLC DLC DLC lcac PS3537.A618 A88 1993 811/.52 20 Sandburg, Carl, 1878-1967. Arithmetic / Carl Sandburg ; illustrated as an anamorphic adventure by Ted Rand. 1st ed. San Diego : Harcourt Brace Jovanovich, c1993. 1 v. (unpaged) : ill. (some col.) ; 26 cm. One Mylar sheet included in pocket. A poem about numbers and their characteristics. Features anamorphic, or distorted, drawings which can be restored to normal by viewing from a particular angle or by viewing the image's reflection in the provided Mylar cone. Arithmetic Juvenile poetry. Children's poetry, American. Arithmetic Poetry. American poetry. Visual perception. Rand, Ted, ill. 01_load.t100644000765000024 100613375261174 17701 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse Test::More tests=>3; BEGIN { use_ok( 'Catmandu::FedoraCommons' ); } require_ok('Catmandu::FedoraCommons'); my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 1 if (! $host || ! $port || ! $user || ! $pwd); ok(Catmandu::FedoraCommons->new("http://$host:$port/fedora",$user,$pwd), "new"); } catmandu.yml100644000765000024 51513375261174 20335 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5--- store: fedora: package: FedoraCommons options: baseurl: http://localhost:8080/fedora username: fedoraAdmin password: fedoraAdmin files: package: File::FedoraCommons options: baseurl: http://localhost:8080/fedora username: fedoraAdmin password: fedoraAdmin model: DC purge: 1 04_store.t100644000765000024 247613375261174 20135 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse Test::More tests=>21; use Data::Dumper; BEGIN { use_ok( 'Catmandu::Store::FedoraCommons' ); } require_ok('Catmandu::Store::FedoraCommons'); my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 19 if (! $host || ! $port || ! $user || ! $pwd); ok($x = Catmandu::Store::FedoraCommons->new(baseurl => "http://$host:$port/fedora", username => $user, password => $pwd), "new"); ok($x->fedora, 'fedora'); my $count = 0; $x->bag('demo')->take(10)->each(sub { my $obj = $_[0]; $count++; ok($obj,"take(10) - $count"); }); ok($obj = $x->bag('demo')->add({ title => ['test']}), 'add'); my $pid = $obj->{_id}; ok($pid,"pid = $pid"); is($obj->{title}->[0] , 'test' , 'obj content ok'); $obj->{creator}->[0] = 'Patrick'; ok($x->bag('demo')->add($obj),'update using add'); ok($x->bag('demo')->get($pid), 'get'); is($obj->{creator}->[0] , 'Patrick' , 'obj content ok'); ok($x->bag('demo')->delete($pid), "delete $pid"); #print Dumper($x->bag->delete_all()); } MANIFEST.SKIP100644000765000024 1113375261174 17663 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5dist.ini 02_access.t100644000765000024 503213375261174 20227 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse Test::More tests=>31; use Data::Dumper; use Catmandu::FedoraCommons; my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 31 if (! $host || ! $port || ! $user || ! $pwd); my $x = Catmandu::FedoraCommons->new("http://$host:$port/fedora",$user,$pwd); ok($res = $x->findObjects(terms=>'*'),'findObjects'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content,'parse_content'); is(@{ $obj->{results} } , 20 , 'resultList'); printf "[session = %s]\n" , $obj->{token}; for my $hit (@{ $obj->{results} }) { printf "%s\n" , $hit->{pid}; } ok($res = $x->resumeFindObjects(sessionToken => $obj->{token}), 'resumeFindObjects'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content,'parse_content'); is(@{ $obj->{results} } , 20 , 'resultList'); printf "[session = %s]\n" , $obj->{token}; for my $hit (@{ $obj->{results} }) { printf "%s\n" , $hit->{pid}; } ok($res = $x->getDatastreamDissemination(pid => 'demo:5', dsID => 'THUMBRES_IMG')); ok($res->is_ok,'is_ok'); ok(length $res->raw > 0, 'raw'); ok($res = $x->getDatastreamDissemination(pid => 'demo:5', dsID => 'VERYHIGHRES', callback => \&process),'callback'); ok($res = $x->getDissemination(pid => 'demo:29', sdefPid => 'demo:27' , method => 'resizeImage' , width => 100),'getDissemination'); is($res->content_type, 'image/jpeg','content_type'); ok($res->length > 3000, 'length'); ok($res = $x->getObjectHistory(pid => 'demo:29'),'getObjectHistory'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); is($obj->{objectChangeDate}->[0],'2008-07-02T05:09:43.234Z','objectChangeDate'); ok($res = $x->getObjectProfile(pid => 'demo:29' ), 'getObjectProfile'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); is($obj->{pid},'demo:29','pid'); ok($res = $x->listDatastreams(pid => 'demo:29'), 'listDatastreams'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok(@{ $obj->{datastream} } == 3, 'count datastreams'); ok($res = $x->listMethods(pid => 'demo:29')); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok(@{ $obj->{sDef} } == 2, 'count methods'); } sub process { my ( $data, $response, $protocol ) = @_; ok($data, 'callback'); } 03_modify.t100644000765000024 1215713375261174 20304 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse Test::More tests=>72; use Data::Dumper; use Catmandu::FedoraCommons; my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 72 if (! $host || ! $port || ! $user || ! $pwd); my $x = Catmandu::FedoraCommons->new("http://$host:$port/fedora",$user,$pwd); ok($res = $x->addDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README', mimeType => 'text/plain'), 'addDatastream(file)'); ok($res->is_ok, 'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($obj->{dsID} eq 'TEST','got a new dsID'); ok($obj->{profile}->{dsMIME} eq 'text/plain','text/plain type'); ok($res = $x->addDatastream(pid => 'demo:29', dsID => 'TEST2' , url => 'http://www.google.com', mimeType => 'text/html' , controlGroup => 'R'), 'addDatastream(url)'); ok($res->is_ok, 'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($obj->{dsID} eq 'TEST2','got a new dsID'); ok($obj->{profile}->{dsControlGroup} eq 'R','got R as control group'); ok($res = $x->addDatastream(pid => 'demo:29', dsID => 'TEST3' , file => 't/marc.xml', mimeType => 'text/xml' , controlGroup => 'X'), 'addDatastream(xml)'); ok($res->is_ok, 'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($obj->{dsID} eq 'TEST3','got a new dsID'); ok($obj->{profile}->{dsControlGroup} eq 'X','got X as control group'); ok($res = $x->purgeDatastream(pid => 'demo:29', dsID => 'TEST'),'purge TEST'); ok($res = $x->purgeDatastream(pid => 'demo:29', dsID => 'TEST2'),'purge TEST2'); ok($res = $x->purgeDatastream(pid => 'demo:29', dsID => 'TEST3'),'purge TEST3'); ok($res = $x->addRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']),'add relationship'); ok($res->is_ok, 'is_ok'); ok($res->parse_content, 'parse_content'); ok($res = $x->getRelationships(pid => 'demo:29', relation => [ undef , 'http://my.org/name']),'get relationship'); ok($res->is_ok,'is_ok'); ok($model = $res->parse_content,'parse_content'); ok(exists $model->as_hashref->{'info:fedora/demo:29'},'check model'); ok($res = $x->purgeRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']),'purge relationship'); ok($res = $x->export(pid => 'demo:29'),'export'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content,'parse_content'); ok($res = $x->getDatastream(pid => 'demo:29', dsID => 'DC'),'getDatastream'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); is($obj->{profile}->{dsFormatURI},'http://www.openarchives.org/OAI/2.0/oai_dc/','check model'); ok($res = $x->getDatastreamHistory(pid => 'demo:29', dsID => 'DC'),'getDatastreamHistory'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok(@{$obj->{profile}} == 1,'check model'); ok($res = $x->getNextPID('changeme'),'getNextPID'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok(@{$obj} == 1,'check model'); ok($res = $x->getObjectXML(pid => 'demo:29'),'getObjectXML'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content,'parse_content'); ok($res = $x->ingest(pid => 'demo:40', file => 't/obj_demo_40.zip', format => 'info:fedora/fedora-system:ATOMZip-1.1'),'ingest demo:40'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->purgeObject(pid => 'demo:40'),'purge demo:40'); $res = $x->addDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README' , mimeType => 'text/plain'); ok($res = $x->modifyDatastream(pid => 'demo:29', dsID => 'TEST' , file => 't/marc.xml', mimeType => 'text/xml'),'modifyDatastream'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->purgeDatastream(pid => 'demo:29', dsID => 'TEST'),'purgeDatastream'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->modifyObject(pid => 'demo:29' , state => 'I'),'modifyObject'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->modifyObject(pid => 'demo:29' , state => 'A'),'modifyObject'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->setDatastreamState(pid => 'demo:29' , dsID => 'url' , dsState => 'A'),'setDatastreamState'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->setDatastreamVersionable(pid => 'demo:29' , dsID => 'url' , versionable => 'false'),'setDatastreamVersionable'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->validate(pid => 'demo:29'),'validate'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); ok($res = $x->upload(file => 't/marc.xml'),'upload'); ok($res->is_ok,'is_ok'); ok($obj = $res->parse_content, 'parse_content'); } obj_demo_40.zip100644000765000024 333013375261174 21104 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tPK¢œGBDyE  DC1.0.xmlUT OôQdôQux öm‘MkÃ0 †ïý¦ç·c§ÊN…Á`_×á8j¢ +Ëúïç¤IVÂ|2Òó¼öFL§ð¿*“WFüØÖÅtyÜ6Ì!—2tÔfžjY -Xpå>ÛËíÄ^Ý…ïû>óœ&Óà7ÄÑ}9å}¶“WVnÕF,§Hƒ¹õä[ŒÐYN¼z …\Z+Þhö¤ÞOŽ½o¬C q4ææʉ]yÃê0,ÆéÖÜ s´µ¹¿Ò*ˆ†00z§ŽV× üIü»é-¹ ]™„H}¸ô(‘/CÎ'RµxÆ’4]Æœ?x•ròd5+¶çõˆOÕ‹Uú(Ž>&î.´™F‚ãÌñŸ›• ±òùÎ~B;µd?‡ •:ñÆ:ÄÒ„vX‹€—`»T™Úᢄ<Ó*c­ÅÈ´”ZÙ†Aî;n©Ð…¡Ϙ9Ô­˜åFXå¨w´Uª@"= GÆ•YŽ¥¬ÓáIGübêOæX]ÉëAÔ;8|Ê+Æ ®~ÒÀäi›³ÓeH1 HƒjÛæÑZàçôÿæ_¢ÞlI²Æ~kñÙèºZîL½¥^[`cñRDôëë37è»Ò<8BUѨÉNUŽ ò—b°œzgY'”¥T­Qbÿžˆ°Æ>W¡JLC§É 9ù¾< _Üý¹û¦+PÌd%úÇì¶]ŸS¼äT3>Ê3ºIh’¹ëËóõ ÖcT49ÑÈ%dÚ佺’[¢»Ý.µ`c ÒÚZJæ³¾¤¥]êêC£zæ)Ê‹0VëwD~ì3Ì"JoµŽ.O¿| Oo®VŠæ1h‡æÓ%ùoAÿˆ­%l#M½žu76¥å œ5#xzïÂæ;pG¦t9<#ß¼6%’h ëÚ½Ž%=!h•1±ªxL>y÷èQs¿ïT¨Õ•‚jÖwèOˆÿW[ÓékÚˆ«u"z=CÂd{Ñ>´Ôô­ÅÏÁ-Ô’”¼(ÉmUæ5²;èZ²ÊšèmE{ó[…Æ—Qû‚Š,EW“oµ\VÂfûl&kúãEx¼e¦‘PÿÊN÷~PK¢œGBDyE  ¤DC1.0.xmlUTOôQux öPKªœGB¢.øÁb¤ORELS-EXT1.0.xmlUT_ôQux öPK™œGBR~—Ž%”¤Yatommanifest.xmlUTBôQux öPKúÈbin000755000765000024 013375261174 16445 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5fedora_admin.pl100644000765000024 4706313375261174 21604 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/bin#!/usr/bin/env perl =head1 NAME fedora_admin.pl - Fedora Commons Administrative client =head1 SYNOPSIS ./fedora_admin.pl [options] [cmd] cmd: list doc ID [DSID] find query|terms STR update ID [active|inactive|deleted] purge ID list_datastreams ID list_methods ID list_relationships ID set_relationships ID FILE get_dissemination ID SDEFPID METHOD get_datastream ID DSID [DATE] set_datastream ID DSID url|file|xml FILE update_datastream ID DSID active|inactive|deleted|versionable|notversionable purge_datastream ID DSID validate ID history ID [DSID] xml ID export ID import ID|new file|xml FILE options: --database= --exporter= --importer= --param foo=bar -y -d directory_containing_catmandu.yml =head1 DESCRIPTION B is a B-compatible client that execute HTTP Rest commands to a Fedora server. B is intended to be conformat to Fedora Commons version up to Fedore 3.6.x. =head1 CONFIGURATION This script requires a catmandu.yml file containing the connection parameters to the Fedora repository. Here is an example 'catmandu.yml' file: --- store: fedora: package: FedoraCommons options: baseurl: http://localhost:8080/fedora username: fedoraAdmin password: fedoraAdmin This file needs to be provided in the working directory or can be specified in the directory given by the -d option or specified in the environment by setting CATMANDU_CONF export CATMANDU_CONF=/etc/catamandu_conf_dir =head1 OPTIONS =over 4 =item --database I Name of a Fedora Commons server configured in I. =item --exporter I Name of a Catmandu::Exporter or a configuration in I. =item --importer I Name of a Catmandu::Importer or a configuration in I. =item --param FOO=BAR Pass a parameter "FOO" with value "BAR" as optional parameter to a fedora_admin.pl command. =item -y Answer yes to all question. =item -f directory_containing_catmandu.yml Configuration directory =back =head1 COMMANDS =over 4 =item list Returns a list of all object identifiers (I-s) that are store in the Fedora server. =item doc ID Returns a short description of the object with identifier ID (audit trail, dublin core, object properties, pid and version). =item doc ID DSID Return a short description about the latets version of datastream DSID in object ID. =item find query|term QUERY Execute a search query on the Fedora Commons server. One of 'query' or 'terms' is required. =item update ID active|inactive|deleted Updates the status of an object with identifier ID. =item purge ID Purges the object with identifier ID. =item list_datastreams ID Returns a listing of all datastreams for an object with identifier ID. =item list_methods ID Returns a listing of all methods for an object with identifier ID. =item list_relations ID Returns a RDF/Turtle expression of all relationships defined for an object with identifier ID. The turtle includes all relationships for all the datastreams. =item set_relationships ID FILE Updates all relationships of an object with identifier ID with RDF/Turtle expressions from FILE. $ cat /tmp/rel.ttl ; , ; . $ fedora_admin.pl set_relationships demo:20 /tmp/rel.ttl =item get_dissemination ID SDEFPID METHOD Returns the binary stream when executing a dissemination on an object with identifier ID, sDef definition SDEFPID and method identifier METHOD. $ fedora_admin.pl --param width=100 demo:29 demo:27 resizeImage =item get_datastream ID DSID Returns the binary stream for an object with identifier ID and data stream identifier DSID. =item set_datastream ID DSID url|file|xml FILE Updates a data stream DSID for an object with identifiet ID. Use the url, file or xml upload mechanism to import a file FILE. $ fedora_admin.pl demo:99 PDF file /tmp/my/pdf $ fedora_admin.pl --param controlGroep=E \ demo:99 PDF url http://inst.org/my.pdf =item update_datastream ID DSID active|inactive|deleted|versionable|notversionable Update the datastream status of an object with identifier ID and data stream identifier DSID. =item purge_datastream ID DSID Purges the data stream DSID from an object with identifier ID. =item validate ID Validate the content of an object with identifier ID. =item history ID [DSID] Returns the version history of an object with identifier ID. Optionally provide a data stream identifier DSID. =item xml ID Return an XML dump of an object with identifier ID. =item export ID Exports the object with identifier ID to standard ouput. $ fedora_admin.pl --param context=archive demo:999 See L for possible parameters. =item import ID|new file|xml FILE Imports an object into the Fedora store. Force an own identifier using or let the Fedora store mint a new one using 'new'. $ fedora_admin.pl --param format=info:fedora/fedora-system:ATOMZip-1.1 \ demo:999 file /tmp/demo_999.zip $ fedora_admin.pl --param format=info:fedora/fedora-system:ATOMZip-1.1 \ --param ownerId=admin \ new file /tmp/demo_999.zip See L for possible parameters. =back =head1 SEE ALSO L, L =head1 AUTHORS Patrick Hochstenbach, "" =head1 LICENSE AND COPYRIGHT This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut $|++; use Catmandu -all; use Catmandu::Util; use Getopt::Long; use RDF::Trine; use Data::Dumper; use Cwd; my $database = 'fedora'; my $config = $ENV{CATMANDU_CONF} // Cwd::getcwd(); my $exporter = 'YAML'; my $importer = 'YAML'; my $yes = undef; my %params = (); GetOptions("database=s" => \$database, "exporter=s" => \$exporter, "importer=s" => \$importer, "param=s" => \%params, "y" => \$yes, "d=s" => \$config); my $cmd = shift; if (defined $config) { Catmandu->load($config); } unless (defined Catmandu->config->{store}->{$database}) { &usage("Need a catmandu.yml file or use the -f option"); } if (undef) {} elsif ($cmd eq 'list') { &cmd_list; } elsif ($cmd eq 'find') { my $type = shift; my $query = shift; &usage("find query|terms STR") unless defined $type && $type =~ /^(query|terms)$/; &cmd_find($type,$query); } elsif ($cmd eq 'doc') { my $id = shift; my $dsid = shift; &usage("doc ID") unless defined $id; &cmd_doc($id,$dsid); } elsif ($cmd eq 'update') { my $id = shift; my $action = shift; &usage("update ID") unless defined $id; &cmd_update($id,$action); } elsif ($cmd eq 'list_datastreams') { my $id = shift; &usage("list_datastreams ID") unless defined $id; &cmd_list_datastreams($id); } elsif ($cmd eq 'list_methods') { my $id = shift; &usage("list_methods ID") unless defined $id; &cmd_list_methods($id); } elsif ($cmd eq 'get_datastream') { my $id = shift; my $dsid = shift; &usage("get_datastream ID DSID") unless defined $id && defined $dsid; &cmd_get_datastream($id,$dsid); } elsif ($cmd eq 'get_dissemination') { my $id = shift; my $sdefpid = shift; my $method = shift; &usage("get_dissemination ID SDEFPID METHOD") unless defined $id && defined $sdefpid && defined $method; &cmd_get_dissemination($id,$sdefpid,$method); } elsif ($cmd eq 'set_datastream') { my $id = shift; my $dsid = shift; my $type = shift; my $file = shift; &usage("set_datastream ID DSID url|file|xml FILE") unless defined $id && defined $dsid && defined $file && $type =~ /^(url|file|xml)$/; &cmd_set_datastream($id,$dsid,$type,$file); } elsif ($cmd eq 'update_datastream') { my $id = shift; my $dsid = shift; my $action = shift; &usage("update_datastream ID DSID action") unless defined $id && defined $dsid && defined $action && $action =~ /^(active|inactive|deleted|versionable|notversionable)$/; &cmd_update_datastream($id,$dsid,$action); } elsif ($cmd eq 'purge_datastream') { my $id = shift; my $dsid = shift; &usage("purge_datastream ID DSID") unless defined $id && defined $dsid; &cmd_purge_datastream($id,$dsid); } elsif ($cmd eq 'purge') { my $id = shift; &usage("purge ID") unless defined $id; &cmd_purge($id); } elsif ($cmd eq 'history') { my $id = shift; my $dsid = shift; &usage("history ID") unless defined $id; &cmd_history($id,$dsid); } elsif ($cmd eq 'list_relationships') { my $id = shift; &usage("list_relationships ID") unless defined $id; &cmd_list_relationships($id); } elsif ($cmd eq 'set_relationships') { my $id = shift; my $file = shift; &usage("set_relationships ID FILE") unless defined $id && defined $file && -r $file; &cmd_set_relationships($id,$file); } elsif ($cmd eq 'xml') { my $id = shift; &usage("xml ID") unless defined $id; &cmd_xml($id); } elsif ($cmd eq 'validate') { my $id = shift; &usage("validate ID") unless defined $id; &cmd_validate($id); } elsif ($cmd eq 'export') { my $id = shift; &usage("export ID") unless defined $id; &cmd_export($id); } elsif ($cmd eq 'import') { my $id = shift; my $type = shift; my $file = shift; &usage("import ID|new file|xml") unless defined $id && defined $type && $type =~ /^(file|xml)/; &cmd_import($id,$type,$file); } else { &usage; } sub cmd_list { store($database)->bag->each(sub { my $obj = shift; printf "%s\n" , $obj->{_id}; }); } sub cmd_find { my $type = shift; my $query = shift; my $hits = store($database)->fedora->findObjects( $type => $query )->parse_content; my $token = $hits->{token}; my $e = exporter($exporter); my $stop = 0; do { for (@{ $hits->{results} }) { $e->add($_); } if (defined $token) { $hits = store($database)->fedora->resumeFindObjects(sessionToken => $token)->parse_content; $token = $hits->{token}; } else { $stop = 1; } } while ( ! $stop ); } sub cmd_doc { my $id = shift; my $dsid = shift; my $obj; if ($dsid) { $obj = store($database)->fedora->getDatastream(pid => $id , dsID => $dsid)->parse_content->{profile}; } else { $obj = store($database)->fedora->export(pid => $id)->parse_content; } die "no such object $id" unless $obj; my $e = exporter($exporter); $e->add($obj); $e->commit; } sub cmd_update { my $id = shift; my $action = shift // ''; if ($action eq 'active') { $params{state} = 'A'; } elsif ($action eq 'inactive') { $params{state} = 'I'; } elsif ($action eq 'deleted') { $params{state} = 'D'; } my $res = store($database)->fedora->modifyObject(pid => $id, %params); die "failed" unless ($res->is_ok); &cmd_doc($id); } sub cmd_list_datastreams { my $id = shift; my $obj = store($database)->fedora->listDatastreams(pid => $id)->parse_content; die "no such object $id" unless $obj; my $e = exporter('CSV',header=>1); for (@{ $obj->{datastream}} ) { $e->add($_); } $e->commit; } sub cmd_list_methods { my $id = shift; my $obj = store($database)->fedora->listMethods(pid => $id)->parse_content; die "no such object $id" unless $obj; my $e = exporter($exporter); $e->add($obj->{sDef}); $e->commit; } sub cmd_get_dissemination { my $id = shift; my $sdefpid = shift; my $method = shift; binmode(STDOUT,':raw'); store($database)->fedora->getDissemination( pid => $id , sdefPid => $sdefpid , method => $method, %params , callback => sub { my ($data, undef, undef) = @_; print $data; }); } sub cmd_history { my $id = shift; my $dsid = shift; if (defined $dsid) { my $obj = store($database)->fedora->getDatastreamHistory(pid => $id, dsID => $dsid)->parse_content; die "no such object $id" unless $obj; my $e = exporter('CSV',header=>1); for (@{ $obj->{profile}} ) { $e->add($_); } $e->commit; } else { my $obj = store($database)->fedora->getObjectHistory(pid => $id)->parse_content; die "no such object $id" unless $obj; my $e = exporter('CSV',header=>1); for (@{ $obj->{objectChangeDate}} ) { $e->add({objectChangeDate => $_}); } $e->commit; } } sub cmd_get_datastream { my $id = shift; my $dsid = shift; binmode(STDOUT,':raw'); store($database)->fedora->getDatastreamDissemination( pid => $id , dsID => $dsid, callback => sub { my ($data, undef, undef) = @_; print $data; }); } sub cmd_set_datastream { my $id = shift; my $dsid = shift; my $type = shift; my $file = shift; if ($type eq 'xml') { $file = Catmandu::Util::read_file($file); } my $exists = store($database)->fedora->getDatastream( pid => $id , dsID => $dsid )->is_ok; my $obj; if ($exists) { $obj = store($database)->fedora->modifyDatastream( pid => $id , dsID => $dsid , $type => $file , %params )->parse_content; } else { $obj = store($database)->fedora->addDatastream( pid => $id , dsID => $dsid , $type => $file , %params )->parse_content; } my $e = exporter('YAML'); $e->add($obj->{profile}); $e->commit; } sub cmd_update_datastream { my $id = shift; my $dsid = shift; my $action = shift; my $res; if ($action eq 'active') { $res = store($database)->fedora->setDatastreamState(pid => $id , dsID => $dsid , dsState => 'A'); } elsif ($action eq 'inactive') { $res = store($database)->fedora->setDatastreamState(pid => $id , dsID => $dsid , dsState => 'I'); } elsif ($action eq 'deleted') { $res = store($database)->fedora->setDatastreamState(pid => $id , dsID => $dsid , dsState => 'D'); } elsif ($action eq 'versionable') { $res = store($database)->fedora->setDatastreamVersionable(pid => $id , dsID => $dsid , versionable=> 'true'); } elsif ($action eq 'notversionable') { $res = store($database)->fedora->setDatastreamVersionable(pid => $id , dsID => $dsid , versionable=> 'false'); } die "failed" unless $res->is_ok; } sub cmd_purge_datastream { my $id = shift; my $dsid = shift; return unless &confirm; my $res = store($database)->fedora->purgeDatastream(pid => $id , dsID => $dsid , %params); die "failed" unless $res->is_ok; } sub cmd_purge { my $id = shift; return unless &confirm; my $res = store($database)->fedora->purgeObject(pid => $id , %params); die "failed" unless $res->is_ok; } sub cmd_list_relationships { my $id = shift; my $rdf_ext = store($database)->fedora->getDatastreamDissemination(pid => $id, dsID => 'RELS-EXT'); my $rdf_int = store($database)->fedora->getDatastreamDissemination(pid => $id, dsID => 'RELS-INT'); die "no relations $id" unless ($rdf_ext->is_ok || $rdf_int->is_ok); my $model = undef; $model = &turtle2model($rdf_ext->raw,$model,'rdfxml') if $rdf_ext->is_ok; $model = &turtle2model($rdf_int->raw,$model,'rdfxml') if $rdf_int->is_ok; my $serializer = RDF::Trine::Serializer::Turtle->new(); print $serializer->serialize_model_to_string($model); } sub cmd_set_relationships { my $id = shift; my $file = shift; my $obj = store($database)->get($id); die "no such object $id" unless $obj; my $turtle = Catmandu::Util::read_file($file); my $model = &turtle2model($turtle); &cmd_reset_relationships($id); my $iter = $model->get_statements(); while(my $st = $iter->next) { my $subject = $st->subject->value; my $predicate = $st->predicate->value; my $object = $st->object->value; my $isLiteral = $st->object->is_literal; my $dataType = $isLiteral ? $st->object->literal_datatype : undef; store($database)->fedora->addRelationship( pid => $id, relation => [ $subject, $predicate, $object ], dataType => $dataType ); } &cmd_list_relationships($id); } sub cmd_xml { my $id = shift; my $res = store($database)->fedora->getObjectXML(pid => $id); print $res->raw if $res->is_ok; } sub cmd_validate { my $id = shift; my $res = store($database)->fedora->validate(pid => $id); die "failed: " . $res->error unless $res->is_ok; my $e = exporter($exporter); $e->add($res->parse_content); $e->commit; } sub cmd_export { my $id = shift; my $res = store($database)->fedora->export(pid => $id , %params); die "no such object $id" unless $res->is_ok; print $res->raw; } sub cmd_import { my $id = shift; my $type = shift; my $file = shift; if ($type eq 'xml') { $file = Catmandu::Util::read_file($file); } my $res = store($database)->fedora->ingest(pid => $id , $type => $file , %params); die "failed: " . $res->error unless $res->is_ok; print $res->parse_content->{pid} , "\n"; } sub cmd_reset_relationships { my $id = shift; store($database)->fedora->purgeDatastream(pid => $id , dsID => 'RELS-EXT'); store($database)->fedora->purgeDatastream(pid => $id , dsID => 'RELS-INT'); } sub turtle2model { my $turtle = shift; my $model = shift // RDF::Trine::Model->temporary_model; my $type = shift // 'turtle'; my $parser = RDF::Trine::Parser->new($type); $parser->parse_into_model(undef, $turtle, $model); return $model; } sub confirm { return 1 if $yes; my $msg = shift // 'Are you sure?'; print "$msg [y/N] "; my $ans = ; chop($ans); $ans eq 'y'; } sub usage { my $msg = shift; print STDERR < --exporter= --importer= --param foo=bar -y -d directory_containing_catmandu.yml config file: Requires a YAML configuration file 'catmandu.yml' in working directory or use -d option. Syntax like: --- store: fedora: package: FedoraCommons options: baseurl: http://localhost:8080/fedora username: fedoraAdmin password: fedoraAdmin EOF exit 1; } author-pod-syntax.t100644000765000024 45413375261174 22056 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Catmandu-FedoraCommons.t100644000765000024 25313375261174 22733 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu000755000765000024 013375261174 20177 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/libFedoraCommons.pm100644000765000024 12446213375261174 23502 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu=head1 NAME Catmandu::FedoraCommons - Low level Catmandu interface to the Fedora Commons REST API =head1 SYNOPSIS # Use the command line tools $ fedora_admin.pl # Or the low-level API-s use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $result = $fedora->findObjects(terms=>'*'); die $result->error unless $result->is_ok; my $hits = $result->parse_content(); for my $hit (@{ $hits->{results} }) { printf "%s\n" , $hit->{pid}; } # Or using the higher level Catmandu::Store codes you can do things like use Catmandu::Store::FedoraCommons; my $store = Catmandu::Store::FedoraCommons->new( baseurl => 'http://localhost:8080/fedora', username => 'fedoraAdmin', password => 'fedoraAdmin', model => 'Catmandu::Store::FedoraCommons::DC' # default ); $store->bag->each(sub { my $model = shift; printf "title: %s\n" , join("" , @{ $model->{title} }); printf "creator: %s\n" , join("" , @{ $model->{creator} }); my $pid = $model->{_id}; my $ds = $store->fedora->listDatastreams(pid => $pid)->parse_content; }); my $obj = $store->bag->add({ title => ['The Master and Margarita'] , creator => ['Bulgakov, Mikhail'] } ); $store->fedora->addDatastream(pid => $obj->{_id} , url => "http://myurl/rabbit.jpg"); # Add your own perl version of a descriptive metadata model by implementing your own # model that can do a serialize and deserialize. =head1 DESCRIPTION Catmandu::FedoraCommons is an Perl API to the Fedora Commons REST API (http://www.fedora.info/). Supported versions are Fedora Commons 3.6 or better. =head1 ACCESS METHODS =cut package Catmandu::FedoraCommons; use Catmandu::FedoraCommons::Response; our $VERSION = '0.5'; use v5.14; use URI::Escape; use HTTP::Request::Common qw(GET POST DELETE PUT HEAD); use LWP::UserAgent; use MIME::Base64; use strict; use Carp; use Data::Validate::URI qw(is_uri); =head2 new($base_url,$username,$password) Create a new Catmandu::FedoraCommons connecting to the baseurl of the Fedora Commons installation. =cut sub new { my ($class,$baseurl,$username,$password) = @_; Carp::croak "baseurl missing" unless defined $baseurl; my $ua = LWP::UserAgent->new( agent => 'Catmandu-FedoraCommons/' . $VERSION, timeout => 180, ); $baseurl =~ m/(\w+):\/\/([^\/:]+)(:(\d+))?(\S+)/; bless { baseurl => $baseurl, scheme => $1, host => $2, port => $4 || 8080, path => $5, username => $username, password => $password, ua => $ua} , $class; } sub _GET { my ($self,$path,$data,$callback,$headers) = @_; $headers = {} unless $headers; my @parts; for my $part (@$data) { my ($key) = keys %$part; my $name = uri_escape($key) || ""; my $value = uri_escape($part->{$key}) || ""; push @parts , "$name=$value"; } my $query = join("&",@parts); my $req = GET $self->{baseurl} . $path . '?' . $query , %$headers; $req->authorization_basic($self->{username}, $self->{password}); defined $callback ? return $self->{ua}->request($req, $callback, 4096) : return $self->{ua}->request($req); } sub _POST { my ($self,$path,$data,$callback) = @_; my $content = undef; my @parts; for my $part (@$data) { my ($key) = keys %$part; if (ref $part->{$key} eq 'ARRAY') { $content = [ $key => $part->{$key} ]; } else { my $name = uri_escape($key) || ""; my $value = uri_escape($part->{$key}) || ""; push @parts , "$name=$value"; } } my $query = join("&",@parts); my $req; if (defined $content) { $req = POST $self->{baseurl} . $path . '?' . $query, Content_Type => 'form-data' , Content => $content; } else { # Need a Content_Type text/xml because of a Fedora 'ingest' feature that requires it... $req = POST $self->{baseurl} . $path . '?' . $query, Content_Type => 'text/xml'; } $req->authorization_basic($self->{username}, $self->{password}); defined $callback ? return $self->{ua}->request($req, $callback, 4096) : return $self->{ua}->request($req); } sub _PUT { my ($self,$path,$data,$callback) = @_; my $content = undef; my @parts; for my $part (@$data) { my ($key) = keys %$part; if (ref $part->{$key} eq 'ARRAY') { $content = $part->{$key}; } else { push @parts , uri_escape($key) . "=" . uri_escape($part->{$key}); } } my $query = join("&",@parts); my $req; if (defined $content) { if (@$content == 1) { my $file = $content->[0]; $req = PUT $self->{baseurl} . $path . '?' . $query; open(my $fh,'<',$file) or Carp::croak "can't open $file : $!"; local($/) = undef; $req->content(scalar(<$fh>)); $req->header( 'Content-Length' => -s $file ); close($fh); } else { my $xml = $content->[-1]; $req = PUT $self->{baseurl} . $path . '?' . $query; $req->content($xml); $req->header( 'Content-Length' => length($xml) ); } } else { # Need a Content_Type text/xml because of a Fedora 'ingest' feature that requires it... $req = PUT $self->{baseurl} . $path . '?' . $query, Content_Type => 'text/xml'; } $req->authorization_basic($self->{username}, $self->{password}); defined $callback ? return $self->{ua}->request($req, $callback, 4096) : return $self->{ua}->request($req); } sub _DELETE { my ($self,$path,$data,$callback) = @_; my @parts; for my $part (@$data) { my ($key) = keys %$part; my $name = uri_escape($key) || ""; my $value = uri_escape($part->{$key}) || ""; push @parts , "$name=$value"; } my $query = join("&",@parts); my $req = DELETE sprintf("%s%s%s", $self->{baseurl} , $path , $query ? '?' . $query : ""); $req->authorization_basic($self->{username}, $self->{password}); defined $callback ? return $self->{ua}->request($req, $callback, 4096) : return $self->{ua}->request($req); } =head2 findObjects(query => $query, maxResults => $maxResults) =head2 findObjects(terms => $terms , maxResults => $maxResults) Execute a search query on the Fedora Commons server. One of 'query' or 'terms' is required. Query contains a phrase optionally including '*' and '?' wildcards. Terms contain one or more conditions separated by space. A condition is a field followed by an operator, followed by a value. The = operator will match if the field's entire value matches the value given. The ~ operator will match on phrases within fields, and accepts the ? and * wildcards. The <, >, <=, and >= operators can be used with numeric values, such as dates. Examples: query => "*o*" query => "?edora" terms => "pid~demo:* description~fedora" terms => "cDate>=1976-03-04 creator~*n*" terms => "mDate>2002-10-2 mDate<2002-10-2T12:00:00" Optionally a maxResults parameter may be specified limiting the number of search results (default is 20). This method returns a L object with a L model. =cut sub findObjects { my $self = shift; my %args = (query => "", terms => "", maxResults => 20, @_); Carp::croak "terms or query required" unless defined $args{terms} || defined $args{query}; my %defaults = (pid => 'true' , label => 'true' , state => 'true' , ownerId => 'true' , cDate => 'true' , mDate => 'true' , dcmDate => 'true' , title => 'true' , creator => 'true' , subject => 'true' , description => 'true' , publisher => 'true' , contributor => 'true' , date => 'true' , type => 'true' , format => 'true' , identifier => 'true' , source => 'true' , language => 'true' , relation => 'true' , coverage => 'true' , rights => 'true' , resultFormat => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'findObjects' , $self->_GET('/objects',$form_data) ); } =head2 resumeFindObjects(sessionToken => $token) This method returns the next batch of search results. This method returns a L object with a L model. Example: my $result = $fedora->findObjects(terms=>'*'); die $result->error unless $result->is_ok; my $hits = $result->parse_content(); for my $hit (@{ $hits->{results} }) { printf "%s\n" , $hit->{pid}; } my $result = $fedora->resumeFindObjects(sessionToken => $hits->{token}); my $hits = $result->parse_content(); ... =cut sub resumeFindObjects { my $self = shift; my %args = (sessionToken => undef , query => "", terms => "", maxResults => 20, @_); Carp::croak "sessionToken required" unless defined $args{sessionToken}; Carp::croak "terms or query required" unless defined $args{terms} || defined $args{query}; my %defaults = (pid => 'true' , label => 'true' , state => 'true' , ownerId => 'true' , cDate => 'true' , mDate => 'true' , dcmDate => 'true' , title => 'true' , creator => 'true' , subject => 'true' , description => 'true' , publisher => 'true' , contributor => 'true' , date => 'true' , type => 'true' , format => 'true' , identifier => 'true' , source => 'true' , language => 'true' , relation => 'true' , coverage => 'true' , rights => 'true' , resultFormat => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'resumeFindObjects' , $self->_GET('/objects',$form_data) ); } =head2 getDatastreamDissemination(pid => $pid, dsID=> $dsID, asOfDateTime => $date, callback => \&callback) This method returns a datastream from the Fedora Commons repository. Required parameters are the identifier of the object $pid and the identifier of the datastream $dsID. Optionally a datestamp $asOfDateTime can be provided. This method returns a L object with a L model. To stream the contents of the datastream a callback function can be provided. Example: $fedora->getDatastreamDissemination(pid => 'demo:5', dsID => 'VERYHIGHRES', callback => \&process); sub process { my ($data, $response, $protocol) = @_; print $data; } =cut sub getDatastreamDissemination { my $self = shift; my %args = (pid => undef , dsID => undef , asOfDateTime => undef, download => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; my $pid = $args{pid}; my $dsId = $args{dsID}; my $callback = $args{callback}; delete $args{pid}; delete $args{dsID}; delete $args{callback}; my $form_data = []; for my $name (keys %args) { push @$form_data , { $name => $args{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getDatastreamDissemination' , $self->_GET('/objects/' . $pid . '/datastreams/' . $dsId . '/content' , $form_data, $callback) ); } =head2 getDissemination(pid => $pid , sdefPid => $sdefPid , method => $method , %method_parameters , callback => \&callback) This method execute a dissemination method on the Fedora Commons server. Required parametes are the object $pid, the service definition $sdefPid and the name of the method $method. Optionally further method parameters can be provided and a callback function to stream the results (see getDatastreamDissemination). This method returns a L object with a L model. Example: $fedora->getDissemination(pid => 'demo:29', sdefPid => 'demo:27' , method => 'resizeImage' , width => 100, callback => \&process); =cut sub getDissemination { my $self = shift; my %args = (pid => undef , sdefPid => undef , method => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{sdefPid}; Carp::croak "need method" unless $args{method}; my $pid = $args{pid}; my $sdefPid = $args{sdefPid}; my $method = $args{method}; my $callback = $args{callback}; delete $args{pid}; delete $args{sdefPid}; delete $args{method}; delete $args{callback}; my $form_data = []; for my $name (keys %args) { push @$form_data , { $name => $args{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getDissemination' , $self->_GET('/objects/' . $pid . '/methods/' . $sdefPid . '/' . $method , $form_data, $callback) ); } =head2 getObjectHistory(pid => $pid) This method returns the version history of an object. Required is the object $pid. This method returns a L object with a L model. Example: my $obj = $fedora->getObjectHistory(pid => 'demo:29')->parse_content; for @{$obj->{objectChangeDate}} {} print "$_\n; } =cut sub getObjectHistory { my $self = shift; my %args = (pid => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = ( format => 'xml' ); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getObjectHistory' , $self->_GET('/objects/' . $pid . '/versions', $form_data) ); } =head2 getObjectProfile(pid => $pid, asOfDateTime => $date) This method returns a detailed description of an object. Required is the object $pid. Optionally a version date asOfDateTime can be provided. This method returns a L object with a L model. Example: my $obj = $fedora->getObjectProfile(pid => 'demo:29')->parse_content; printf "Label: %s\n" , $obj->{objLabel}; =cut sub getObjectProfile { my $self = shift; my %args = (pid => undef , asOfDateTime => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = ( format => 'xml' ); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getObjectProfile' , $self->_GET('/objects/' . $pid , $form_data) ); } =head2 listDatastreams(pid => $pid, asOfDateTime => $date) This method returns a list of datastreams provided in the object. Required is the object $pid. Optionally a version date asOfDateTime can be provided. This method returns a L object with a L model. Example: my $obj = $fedora->listDatastreams(pid => 'demo:29')->parse_content; for (@{ $obj->{datastream}} ) { printf "Label: %s\n" , $_->{label}; } =cut sub listDatastreams { my $self = shift; my %args = (pid => undef , asOfDateTime => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = ( format => 'xml' ); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'listDatastreams' , $self->_GET('/objects/' . $pid . '/datastreams', $form_data) ); } =head2 listMethods(pid => $pid , sdefPid => $sdefPid , asOfDateTime => $date) This method return a list of methods that can be executed on an object. Required is the object $pid and the object $sdefPid. Optionally a version date asOfDateTime can be provided. This method returns a L object with a L model. Example: my $obj = $fedora->listMethods(pid => 'demo:29')->parse_content; for ( @{ $obj->{sDef} }) { printf "[%s]\n" , $_->{$pid}; for my $m ( @{ $_->{method} } ) { printf "\t%s\n" , $m->{name}; } } =cut sub listMethods { my $self = shift; my %args = (pid => undef , sdefPid => undef, asOfDateTime => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; my $sdefPid = $args{sdefPid}; delete $args{pid}; delete $args{sdefPid}; my %defaults = ( format => 'xml' ); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'listMethods' , $self->_GET('/objects/' . $pid . '/methods' . ( defined $sdefPid ? "/$sdefPid" : "" ), $form_data) ); } =head2 describeRepository This method returns information about the fedora repository. No arguments required. This method returns a L object with a L model. Example: my $desc = $fedora->describeRepository()->parse_content(); =cut sub describeRepository { my $self = $_[0]; my $form_data = [ { xml => "true" } ]; return Catmandu::FedoraCommons::Response->factory( 'describeRepository' , $self->_GET('/describe', $form_data) ); } *describe = \&describeRepository; =head1 MODIFY METHODS =head2 addDatastream(pid => $pid , dsID => $dsID, url => $remote_location, %args) =head2 addDatastream(pid => $pid , dsID => $dsID, file => $filename , %args) =head2 addDatastream(pid => $pid , dsID => $dsID, xml => $xml , %args) This method adds a data stream to the object. Required parameters are the object $pid, a new datastream $dsID and a remote $url, a local $file or an $xml string which contains the content. Optionally any of these datastream modifiers may be provided: controlGroup, altIDs, dsLabel, versionable, dsState, formatURI, checksumType, checksum, mimeType, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $obj = $fedora->addDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README', mimeType => 'text/plain')->parse_content; print "Uploaded at: %s\n" , $obj->{dateTime}; =cut sub addDatastream { my $self = shift; my %args = (pid => undef , dsID => undef, url => undef , file => undef , xml => undef , @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; Carp::croak "need url or file (filename)" unless defined $args{url} || defined $args{file} || defined $args{xml}; my $pid = $args{pid}; my $dsID = $args{dsID}; my $url = $args{url}; my $file = $args{file}; my $xml = $args{xml}; delete $args{pid}; delete $args{dsID}; delete $args{url}; delete $args{file}; delete $args{xml}; my %defaults = ( versionable => 'false'); if (defined $file) { $defaults{file} = ["$file"]; $defaults{controlGroup} = 'M'; } elsif (defined $xml) { $defaults{file} = [ undef , 'upload.xml' , Content => $xml ]; $defaults{controlGroup} = 'X'; $defaults{mimeType} = 'text/xml'; } elsif (defined $url) { $defaults{dsLocation} = $url; $defaults{controlGroup} = 'M'; } my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'addDatastream' , $self->_POST('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 addRelationship(pid => $pid, relation => [ $subject, $predicate, $object] [, dataType => $dataType]) This methods adds a triple to the 'RELS-EXT' data stream of the object. Requires parameters are the object $pid and a relation as a triple ARRAY reference. Optionally the $datatype of the literal may be provided. This method returns a L object with a L model. Example: $fedora->addRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']); =cut sub addRelationship { my $self = shift; my %args = (pid => undef , relation => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need relation" unless defined $args{relation} && ref $args{relation} eq 'ARRAY'; my $pid = $args{pid}; my $subject = $args{relation}->[0]; my $predicate = $args{relation}->[1]; my $object = $args{relation}->[2]; my $dataType = $args{dataType}; my $isLiteral = is_uri($object) ? "false" : "true"; my $form_data = [ { subject => $subject }, { predicate => $predicate }, { object => $object }, { dataType => $dataType }, { isLiteral => $isLiteral }, ]; return Catmandu::FedoraCommons::Response->factory( 'addRelationship' , $self->_POST('/objects/' . $pid . '/relationships/new', $form_data) ); } =head2 export(pid => $pid [, format => $format , context => $context , encoding => $encoding]) This method exports the data model of the object in FOXML,METS or ATOM. Required is $pid of the object. Optionally a $context may be provided and the $format of the export. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $res = $fedora->export(pid => 'demo:29'); print $res->raw; print "%s\n" , $res->parse_content->{objectProperties}->{label}; =cut sub export { my $self = shift; my %args = (pid => undef , format => undef , context => undef , encoding => undef, @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'export' , $self->_GET('/objects/' . $pid . '/export', $form_data) ); } =head2 getDatastream(pid => $pid, dsID => $dsID , %args) This method return metadata about a data stream. Required is the object $pid and the $dsID of the data stream. Optionally a version 'asOfDateTime' can be provided and a 'validateChecksum' check. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $obj = $fedora->getDatastream(pid => 'demo:29', dsID => 'DC')->parse_content; printf "Label: %s\n" , $obj->{profile}->{dsLabel}; =cut sub getDatastream { my $self = shift; my %args = (pid => undef , dsID => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; my $pid = $args{pid}; my $dsID = $args{dsID}; delete $args{pid}; delete $args{dsID}; my %defaults = ( format => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getDatastream' , $self->_GET('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 getDatastreamHistory(pid => $pid , dsID => $dsID , %args) This method returns the version history of a data stream. Required paramter is the $pid of the object and the $dsID of the data stream. This method returns a L object with a L model. Example: my $obj = $fedora->getDatastreamHistory(pid => 'demo:29', dsID => 'DC')->parse_content; for (@{ $obj->{profile} }) { printf "Version: %s\n" , $_->{dsCreateDate}; } =cut sub getDatastreamHistory { my $self = shift; my %args = (pid => undef , dsID => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; my $pid = $args{pid}; my $dsID = $args{dsID}; delete $args{pid}; delete $args{dsID}; my %defaults = ( format => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getDatastreamHistory' , $self->_GET('/objects/' . $pid . '/datastreams/' . $dsID . '/history', $form_data) ); } =head2 getNextPID(namespace => $namespace, numPIDs => $numPIDs) This method generates a new pid. Optionally a 'namespace' can be provided and the required 'numPIDs' you need. This method returns a L object with a L model. Example: my $pid = $fedora->getNextPID()->parse_content->[0]; =cut sub getNextPID { my $self = shift; my %args = (namespace => undef, @_); my %defaults = ( format => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getNextPID' , $self->_POST('/objects/nextPID', $form_data) ); } =head2 getObjectXML(pid => $pid) This method exports the data model of the object in FOXML format. Required is $pid of the object. This method returns a L object . Example: my $res = $fedora->getObjectXML(pid => 'demo:29'); print $res->raw; =cut sub getObjectXML { my $self = shift; my %args = (pid => undef, @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'getObjectXML' , $self->_GET('/objects/' . $pid . '/objectXML', $form_data) ); } =head2 getRelationships(pid => $pid [, relation => [$subject, $predicate, undef] , format => $format ]) This method returns all RELS-EXT triples for an object. Required parameter is the $pid of the object. Optionally the triples may be filetered using the 'relation' parameter. Format defines the returned format. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $obj = $fedora->getRelationships(pid => 'demo:29')->parse_content; my $iter = $obj->get_statements(); print "Names of things:\n"; while (my $st = $iter->next) { my $s = $st->subject; my $name = $st->object; print "The name of $s is $name\n"; } =cut sub getRelationships { my $self = shift; my %args = (pid => undef , relation => undef, @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; my $format = $args{format}; my ($subject,$predicate); if (defined $args{relation} && ref $args{relation} eq 'ARRAY') { $subject = $args{relation}->[0]; $predicate = $args{relation}->[1]; } my %defaults = (subject => $subject, predicate => $predicate, format => 'xml'); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} } if defined $values{$name}; } return Catmandu::FedoraCommons::Response->factory( 'getRelationships' , $self->_GET('/objects/' . $pid . '/relationships', $form_data) ); } =head2 ingest(pid => $pid , file => $filename , xml => $xml , format => $format , %args) =head2 ingest(pid => 'new' , file => $filename , xml => $xml , format => $format , %args) This method ingest an object into Fedora Commons. Required is the $pid of the new object (which can be the string 'new' when Fedora has to generate a new pid), and the $filename or $xml to upload writen as $format. Optionally the following parameters can be provided: label, encoding, namespace, ownerId, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $obj = $fedora->ingest(pid => 'new', file => 't/obj_demo_40.zip', format => 'info:fedora/fedora-system:ATOMZip-1.1')->parse_content; printf "created: %s\n" , $obj->{pid}; =cut sub ingest { my $self = shift; my %args = (pid => undef , file => undef , xml => undef , @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need file or xml" unless defined $args{file} || defined $args{xml}; my $pid = $args{pid}; my $file = $args{file}; my $xml = $args{xml}; delete $args{pid}; delete $args{file}; delete $args{xml}; my %defaults = (ignoreMime => 'true'); if (defined $file) { $defaults{format} = 'info:fedora/fedora-system:FOXML-1.1'; $defaults{encoding} = 'UTF-8'; $defaults{file} = ["$file"]; } elsif (defined $xml) { $defaults{format} = 'info:fedora/fedora-system:FOXML-1.1'; $defaults{encoding} = 'UTF-8'; $defaults{file} = [undef, 'upload.xml' , Content => $xml]; } my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'ingest' , $self->_POST('/objects/' . $pid, $form_data) ); } =head2 modifyDatastream(pid => $pid , dsID => $dsID, url => $remote_location, %args) =head2 modifyDatastream(pid => $pid , dsID => $dsID, file => $filename , %args) =head2 modifyDatastream(pid => $pid , dsID => $dsID, xml => $xml , %args) This method updated a data stream in the object. Required parameters are the object $pid, a new datastream $dsID and a remote $url, a local $file or an $xml string which contains the content. Optionally any of these datastream modifiers may be provided: controlGroup, altIDs, dsLabel, versionable, dsState, formatURI, checksumType, checksum, mimeType, logMessage. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: my $obj = $fedora->modifyDatastream(pid => 'demo:29', dsID => 'TEST' , file => 'README', mimeType => 'text/plain')->parse_content; print "Uploaded at: %s\n" , $obj->{dateTime}; =cut sub modifyDatastream { my $self = shift; my %args = (pid => undef , dsID => undef, url => undef , file => undef , xml => undef , @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; Carp::croak "need url or file (filename)" unless defined $args{url} || defined $args{file} || defined $args{xml}; my $pid = $args{pid}; my $dsID = $args{dsID}; my $url = $args{url}; my $file = $args{file}; my $xml = $args{xml}; delete $args{pid}; delete $args{dsID}; delete $args{url}; delete $args{file}; delete $args{xml}; my %defaults = (versionable => 'false'); if (defined $file) { $defaults{file} = ["$file"]; $defaults{controlGroup} = 'M'; } elsif (defined $xml) { $defaults{file} = [undef, 'upload.xml' , Content => $xml]; $defaults{controlGroup} = 'X'; $defaults{mimeType} = 'text/xml'; } elsif (defined $url) { $defaults{dsLocation} = $url; $defaults{controlGroup} = 'E'; } my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'modifyDatastream' , $self->_PUT('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 modifyObject(pid => $pid, label => $label , ownerId => ownerId , state => $state , logMessage => $logMessage , lastModifiedDate => $lastModifiedDate) This method updated the metadata of an object. Required parameter is the $pid of the object. Optionally one or more of label, ownerId, state, logMessage and lastModifiedDate can be provided. This method returns a L object with a L model. Example: $fedora->modifyObject(pid => 'demo:29' , state => 'I'); =cut sub modifyObject { my $self = shift; my %args = (pid => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'modifyObject' , $self->_PUT('/objects/' . $pid , $form_data) ); } =head2 purgeDatastream(pid => $pid , dsID => $dsID , startDT => $startDT , endDT => $endDT , logMessage => $logMessage) This method purges a data stream from an object. Required parameters is the $pid of the object and the $dsID of the data stream. Optionally a range $startDT to $endDT versions can be provided to be deleted. See: https://wiki.duraspace.org/display/FEDORA36/REST+API for more information. This method returns a L object with a L model. Example: $fedora->purgeDatastream(pid => 'demo:29', dsID => 'TEST')->parse_content; =cut sub purgeDatastream { my $self = shift; my %args = (pid => undef , dsID => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; my $pid = $args{pid}; my $dsID = $args{dsID}; delete $args{pid}; delete $args{dsID}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'purgeDatastream' , $self->_DELETE('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 purgeObject(pid => $pid, logMessage => $logMessage) This method purges an object from Fedora Commons. Required parameter is the $pid of the object. Optionally a $logMessage can be provided. This method returns a L object with a L model. Example: $fedora->purgeObject(pid => 'demo:29'); =cut sub purgeObject { my $self = shift; my %args = (pid => undef, @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'purgeObject' , $self->_DELETE('/objects/' . $pid, $form_data) ); } =head2 purgeRelationship(pid => $pid, relation => [ $subject, $predicate, $object] [, dataType => $dataType]) This method removes a triple from the RELS-EXT data stream of an object. Required parameters are the $pid of the object and the relation to be deleted. Optionally the $dataType of the literal can be provided. This method returns a L object with a L model. Example: $fedora->purgeRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter']) =cut sub purgeRelationship { my $self = shift; my %args = (pid => undef , relation => undef, @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need relation" unless defined $args{relation} && ref $args{relation} eq 'ARRAY'; my $pid = $args{pid}; my $subject = $args{relation}->[0]; my $predicate = $args{relation}->[1]; my $object = $args{relation}->[2]; my $dataType = $args{dataType}; my $isLiteral = is_uri($object) ? "false" : "true"; my $form_data = [ { subject => $subject }, { predicate => $predicate }, { object => $object }, { dataType => $dataType }, { isLiteral => $isLiteral }, ]; return Catmandu::FedoraCommons::Response->factory( 'purgeRelationship' , $self->_DELETE('/objects/' . $pid . '/relationships', $form_data) ); } =head2 setDatastreamState(pid => $pid, dsID => $dsID, dsState => $dsState) This method can be used to put a data stream on/offline. Required parameters are the $pid of the object , the $dsID of the data stream and the required new $dsState ((A)ctive, (I)nactive, (D)eleted). This method returns a L object with a L model. Example: $fedora->setDatastreamState(pid => 'demo:29' , dsID => 'url' , dsState => 'I'); =cut sub setDatastreamState { my $self = shift; my %args = (pid => undef , dsID => undef, dsState => undef , @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; Carp::croak "need dsState" unless $args{dsState}; my $pid = $args{pid}; my $dsID = $args{dsID}; delete $args{pid}; delete $args{dsID}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'setDatastreamState' , $self->_PUT('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 setDatastreamVersionable(pid => $pid, dsID => $dsID, versionable => $versionable) This method updates the versionable state of a data stream. Required parameters are the $pid of the object, the $dsID of the data stream and the new $versionable (true|false) state. This method returns a L object with a L model. Example: $fedora->setDatastreamVersionable(pid => 'demo:29' , dsID => 'url' , versionable => 'false'); =cut sub setDatastreamVersionable { my $self = shift; my %args = (pid => undef , dsID => undef, versionable => undef , @_); Carp::croak "need pid" unless $args{pid}; Carp::croak "need dsID" unless $args{dsID}; Carp::croak "need versionable" unless $args{versionable}; my $pid = $args{pid}; my $dsID = $args{dsID}; delete $args{pid}; delete $args{dsID}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'setDatastreamVersionable' , $self->_PUT('/objects/' . $pid . '/datastreams/' . $dsID, $form_data) ); } =head2 validate(pid => $pid) This method can be used to validate the content of an object. Required parameter is the $pid of the object. This method returns a L object with a L model. Example: my $obj = $fedora->validate(pid => 'demo:29')->parse_content; print "Is valid: %s\n" , $obj->{valid}; =cut sub validate { my $self = shift; my %args = (pid => undef , @_); Carp::croak "need pid" unless $args{pid}; my $pid = $args{pid}; delete $args{pid}; my %defaults = (); my %values = (%defaults,%args); my $form_data = []; for my $name (keys %values) { push @$form_data , { $name => $values{$name} }; } return Catmandu::FedoraCommons::Response->factory( 'validate' , $self->_GET('/objects/' . $pid . '/validate', $form_data) ); } =head2 upload(file => $file) This method uploads a file to the Fedora Server. Required parameter is the $file name. This method returns a L object with a L model. Example: my $obj = $fedora->upload(file => 't/marc.xml')->parse_content; print "Upload id: %s\n" , $obj->{id}; =cut sub upload { my $self = shift; my %args = (file => undef , @_); Carp::croak "need file" unless $args{file}; my $file = $args{file}; delete $args{file}; my $form_data = [ { file => [ "$file"] }]; return Catmandu::FedoraCommons::Response->factory( 'upload' , $self->_POST('/upload', $form_data) ); } =head1 SEE ALSO L, L, L, L, L, L =head1 AUTHOR =over =item * Patrick Hochstenbach, C<< >> =back =head1 LICENSE AND COPYRIGHT This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut 1; Catmandu-Store-FedoraCommons.t100644000765000024 26213375261174 24025 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::Store::FedoraCommons'; use_ok $pkg; } require_ok $pkg; done_testing; Store000755000765000024 013375261174 21273 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/CatmanduFedoraCommons.pm100644000765000024 2105113375261174 24544 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Storepackage Catmandu::Store::FedoraCommons; use Catmandu::Sane; use Catmandu::FedoraCommons; use Moo; with 'Catmandu::Store'; has baseurl => (is => 'ro' , required => 1); has username => (is => 'ro' , default => sub { '' } ); has password => (is => 'ro' , default => sub { '' } ); has model => (is => 'ro' , default => sub { 'Catmandu::Store::FedoraCommons::DC' } ); has fedora => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_fedora', ); has _repository_description => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_repository_description' ); has _default_namespace => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_default_namespace' ); has _pid_delimiter => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_pid_delimiter' ); sub _build_fedora { my $self = $_[0]; Catmandu::FedoraCommons->new($self->baseurl, $self->username, $self->password); } #namespace corresponds to name of bag #don't use "data", but use the internal default namespace of fedora around default_bag => sub { my($orig,$self) = @_; $self->_default_namespace(); }; sub _build_repository_description { $_[0]->fedora->describeRepository()->parse_content(); } sub _build_default_namespace { my $self = $_[0]; my $desc = $self->_repository_description(); $desc->{repositoryPID}->{'PID-namespaceIdentifier'}; } sub _build_pid_delimiter { my $self = $_[0]; my $desc = $self->_repository_description(); $desc->{repositoryPID}->{'PID-delimiter'}; } package Catmandu::Store::FedoraCommons::Bag; use Catmandu::Sane; use Catmandu::Store::FedoraCommons::FOXML; use Moo; use Catmandu::Util qw(:is); with 'Catmandu::Bag'; has _namespace_prefix => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_namespace_prefix' ); has _namespace_prefix_re => ( is => 'ro', init_arg => undef, lazy => 1, builder => '_build_namespace_prefix_re' ); sub _build_namespace_prefix { my $self = $_[0]; my $name = $self->name(); my $pid_delimiter = $self->store->_pid_delimiter(); "${name}${pid_delimiter}"; } sub _build_namespace_prefix_re { my $self = $_[0]; my $p = $self->_namespace_prefix(); qr/$p/; } sub _id_valid { my ($self,$id) = @_; return ( index( $id, $self->_namespace_prefix() ) == 0 ) ? 1 : 0; } #add namespace to generated ID if it does not start with the namespace prefix before add => sub { my ($self, $data) = @_; unless( $self->_id_valid( $data->{_id} ) ) { $data->{_id} = $self->_namespace_prefix().$data->{_id}; } }; #make it impossible to find 'islandora:1' in bag 'archive.ugent.be' around 'get' => sub { my($orig,$self,$id) = @_; return undef unless $self->_id_valid( $id ); $orig->($self,$id); }; #make it impossible to delete 'islandora:1' when using bag 'archive.ugent.be' around 'delete' => sub { my($orig,$self,$id) = @_; return undef unless $self->_id_valid( $id ); $orig->($self,$id); }; sub _get_model { my ($self, $obj) = @_; my $pid = $obj->{pid}; my $fedora = $self->store->fedora; my $model = $self->store->model; eval "use $model"; my $x = $model->new(fedora => $fedora); my $res = $x->get($pid); return $res; } sub _update_model { my ($self, $obj) = @_; my $fedora = $self->store->fedora; my $model = $self->store->model; eval "use $model"; my $x = $model->new(fedora => $fedora); my $res = $x->update($obj); return $res; } sub _ingest_model { my ($self, $data) = @_; my $serializer = Catmandu::Store::FedoraCommons::FOXML->new; my ($valid,$reason) = $serializer->valid($data); unless ($valid) { warn "data is not valid"; return undef; } my $xml = $serializer->serialize($data); my %args = ( pid => $data->{_id} , xml => $xml , format => 'info:fedora/fedora-system:FOXML-1.1' ); my $result = $self->store->fedora->ingest(%args); return undef unless $result->is_ok; $data->{_id} = $result->parse_content->{pid}; return $self->_update_model($data); } sub generator { my ($self) = @_; my $fedora = $self->store->fedora; sub { state $hits; state $row; state $ns_prefix = $self->_namespace_prefix; if( ! defined $hits) { my $res = $fedora->findObjects( query => "pid~${ns_prefix}*" ); unless ($res->is_ok) { warn $res->error; return undef; } $row = 0; $hits = $res->parse_content; } if ($row + 1 == @{ $hits->{results} } && defined $hits->{token}) { my $result = $hits->{results}->[ $row ]; my $res = $fedora->findObjects(sessionToken => $hits->{token}); unless ($res->is_ok) { warn $res->error; return undef; } $row = 0; $hits = $res->parse_content; return $self->_get_model($result); } else { my $result = $hits->{results}->[ $row++ ]; return $self->_get_model($result); } }; } sub add { my ($self,$data) = @_; if ( defined $self->get($data->{_id}) ) { my $ok = $self->_update_model($data); die "failed to update" unless $ok; } else { my $ok = $self->_ingest_model($data); die "failed to ingest" unless $ok; } return $data; } sub get { my ($self, $id) = @_; return $self->_get_model({ pid => $id }); } sub delete { my ($self, $id) = @_; return undef unless defined $id; my $fedora = $self->store->fedora; $fedora->purgeObject(pid => $id)->is_ok; } sub delete_all { my ($self) = @_; my $count = 0; $self->each(sub { my $obj = $_[0]; my $pid = $obj->{_id}; my $ret = $self->delete($pid); $count += 1 if $ret; }); $count; } 1; =head1 NAME Catmandu::Store::FedoraCommons - A Catmandu::Store plugin for the Fedora Commons repository =head1 SYNOPSIS use Catmandu::Store::FedoraCommons; my $store = Catmandu::Store::FedoraCommons->new( baseurl => 'http://localhost:8080/fedora', username => 'fedoraAdmin', password => 'fedoraAdmin', model => 'Catmandu::Store::FedoraCommons::DC' # default ); # We use the DC model, lets store some DC my $obj1 = $store->bag->add({ title => ['The Master and Margarita'] , creator => ['Bulgakov, Mikhail'] } ); printf "obj1 stored as %s\n" , $obj1->{_id}; # Force an id in the store my $obj2 = $store->bag->add({ _id => 'demo:120812' , title => ['The Master and Margarita'] }); my $obj3 = $store->bag->get('demo:120812'); $store->bag->delete('demo:120812'); $store->bag->delete_all; # All bags are iterators $store->bag->each(sub { my $obj = $_[0]; my $pid = $obj->{_id}; my $ds = $store->fedora->listDatastreams(pid => $pid)->parse_content; }); $store->bag->take(10)->each(sub { ... }); =head1 DESCRIPTION A Catmandu::Store::FedoraCommons is a Perl package that can store data into FedoraCommons backed databases. The database as a whole is called a 'store'. Databases also have compartments (e.g. tables) called Catmandu::Bag-s. In Fedora we have namespaces. A bag corresponds to a namespace. The default bag corresponds to the default namespace in Fedora. By default Catmandu::Store::FedoraCommons works with a Dublin Core data model. You can use the add,get and delete methods of the store to retrieve and insert Perl HASH-es that mimic Dublin Core records. Optionally other models can be provided by creating a model package that implements a 'get' and 'update' method. =head1 METHODS =head2 new(baseurl => $fedora_baseurl , username => $username , password => $password , model => $model ) Create a new Catmandu::Store::FedoraCommons store at $fedora_baseurl. Optionally provide a name of a $model to serialize your Perl hashes into a Fedora Commons model. =head2 bag('$namespace') Create or retrieve a bag. Returns a Catmandu::Bag. Use this for storing or retrieving records from a fedora namespace. =head2 fedora Returns a low level Catmandu::FedoraCommons reference. =head1 INHERITED METHODS This Catmandu::Store implements: =over 3 =item L =back Each Catmandu::Bag in this Catmandu::Store implements: =over 3 =item L =back =head1 SEE ALSO L =head1 AUTHOR =over =item * Patrick Hochstenbach, C<< >> =back =cut Catmandu-FedoraCommons-Response.t100644000765000024 26513375261174 24532 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Response'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-Store-FedoraCommons-DC.t100644000765000024 26613375261174 24315 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::Store::FedoraCommons::DC'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-Store-FedoraCommons-FOXMLt100644000765000024 27113375261174 24632 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::Store::FedoraCommons::FOXML'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-Store-File-FedoraCommons.t100644000765000024 172413375261174 24726 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; my $pkg; BEGIN { $pkg = 'Catmandu::Store::File::FedoraCommons'; use_ok $pkg; } require_ok $pkg; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 100 if (! $host || ! $port || ! $user || ! $pwd); my $store = $pkg->new(purge => 1); ok $store , 'got a store'; my $bags = $store->bag(); ok $bags , 'store->bag()'; isa_ok $bags , 'Catmandu::Store::File::FedoraCommons::Index'; throws_ok {$store->bag('1235')} 'Catmandu::Error', 'bag(1235) doesnt exist'; lives_ok {$store->bag('1')} 'bag(1) exists'; my $index = $store->index; ok $index , 'got an index'; my @bags = [ $index->to_array ]; ok @bags > 0 , 'got some folders'; } done_testing; FedoraCommons000755000765000024 013375261174 22733 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/CatmanduResponse.pm100644000765000024 1756213375261174 25262 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons=head1 NAME Catmandu::FedoraCommons::Response - Perl model for generic Fedora Commons REST API responses =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $result = $fedora->findObjects(terms=>'*'); die $resut->error unless $result->is_ok; my $obj = $result->parse_content; $result->is_ok; $result->error; $result->raw; $result->content_type; $result->length; $result->date; $result->parse_content(); $result->parse_content($my_model); =head1 DESCRIPTION A Catmandu::FedoraCommons::Response gets returned for every Catmandu::FedoraCommons method. This response contains the raw HTTP content of a Fedora Commons request and can also be used to parse XML responses into Perl objects using the parse_content function. For more information on the Perl objects see the information in the Catmandu::FedoraCommons::Model packages. =head2 METHODS =cut package Catmandu::FedoraCommons::Response; use Catmandu::FedoraCommons::Model::findObjects; use Catmandu::FedoraCommons::Model::getObjectHistory; use Catmandu::FedoraCommons::Model::getObjectProfile; use Catmandu::FedoraCommons::Model::listDatastreams; use Catmandu::FedoraCommons::Model::listMethods; use Catmandu::FedoraCommons::Model::findObjects; use Catmandu::FedoraCommons::Model::datastreamProfile; use Catmandu::FedoraCommons::Model::pidList; use Catmandu::FedoraCommons::Model::validate; use Catmandu::FedoraCommons::Model::getRelationships; use Catmandu::FedoraCommons::Model::export; use Catmandu::FedoraCommons::Model::datastreamHistory; use Catmandu::FedoraCommons::Model::purgeDatastream; use Catmandu::FedoraCommons::Model::addRelationship; use Catmandu::FedoraCommons::Model::ingest; use Catmandu::FedoraCommons::Model::modifyObject; use Catmandu::FedoraCommons::Model::purgeObject; use Catmandu::FedoraCommons::Model::upload; use Catmandu::FedoraCommons::Model::purgeRelationship; use Catmandu::FedoraCommons::Model::getDatastreamDissemination; use Catmandu::FedoraCommons::Model::describeRepository; sub factory { my ($class, $method , $response) = @_; bless { method => $method , response => $response } , $class; } =head2 is_ok() Returns true when the result Fedora Commons response contains no errors. =cut sub is_ok { my ($self) = @_; $self->{response}->code =~ /^(200|201|202)$/; } =head2 error() Returns the error message of the Fedora Commons response if available. =cut sub error { my ($self) = @_; $self->{response}->message; } =head2 parse_content($model) Returns a Perl representation of the Fedora Commons response. Optionally a model object can be provided that implements a $obj->parse($bytes) method and returns a Perl object. If no model is provided then default models from the Catmandu::FedoraCommons::Model namespace are used. Example: package MyParser; sub new { my $class = shift; return bless {} , $class; } sub parse { my ($self,$bytes) = @_; ... return $perl } package main; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $result = $fedora->findObjects(terms=>'*'); my $perl = $result->parse_content(MyParser->new); =cut sub parse_content { my ($self,$model) = @_; my $method = $self->{method}; my $xml = $self->raw; if ($method eq 'addRelationship') { return Catmandu::FedoraCommons::Model::addRelationship->parse($xml); } elsif ($method eq 'ingest') { return Catmandu::FedoraCommons::Model::ingest->parse($xml); } elsif ($method eq 'modifyObject') { return Catmandu::FedoraCommons::Model::modifyObject->parse($xml); } elsif ($method eq 'purgeObject') { return Catmandu::FedoraCommons::Model::purgeObject->parse($xml); } elsif ($method eq 'purgeRelationship') { return Catmandu::FedoraCommons::Model::purgeRelationship->parse($xml); } elsif ($method eq 'upload') { return Catmandu::FedoraCommons::Model::upload->parse($xml); } elsif ($method eq 'purgeDatastream') { return Catmandu::FedoraCommons::Model::purgeDatastream->parse($xml); } elsif ($method eq 'getDatastreamDissemination') { return Catmandu::FedoraCommons::Model::getDatastreamDissemination->parse($xml); } elsif ($method eq 'getDissemination') { return Catmandu::FedoraCommons::Model::getDatastreamDissemination->parse($xml); } unless ($self->content_type =~ /(text|application)\/(xml|rdf\+xml)/) { Carp::carp "You probably want to use the raw() method"; return undef; } if (defined $model) { return $model->parse($xml); } elsif ($method eq 'findObjects') { return Catmandu::FedoraCommons::Model::findObjects->parse($xml); } elsif ($method eq 'getObjectHistory') { return Catmandu::FedoraCommons::Model::getObjectHistory->parse($xml); } elsif ($method eq 'getObjectProfile') { return Catmandu::FedoraCommons::Model::getObjectProfile->parse($xml); } elsif ($method eq 'listDatastreams') { return Catmandu::FedoraCommons::Model::listDatastreams->parse($xml); } elsif ($method eq 'listMethods') { return Catmandu::FedoraCommons::Model::listMethods->parse($xml); } elsif ($method eq 'resumeFindObjects') { return Catmandu::FedoraCommons::Model::findObjects->parse($xml); } elsif ($method eq 'addDatastream') { return Catmandu::FedoraCommons::Model::datastreamProfile->parse($xml); } elsif ($method eq 'getDatastream') { return Catmandu::FedoraCommons::Model::datastreamProfile->parse($xml); } elsif ($method eq 'getDatastreamHistory') { return Catmandu::FedoraCommons::Model::datastreamHistory->parse($xml); } elsif ($method eq 'getNextPID') { return Catmandu::FedoraCommons::Model::pidList->parse($xml); } elsif ($method eq 'modifyDatastream') { return Catmandu::FedoraCommons::Model::datastreamProfile->parse($xml); } elsif ($method eq 'setDatastreamState') { return Catmandu::FedoraCommons::Model::datastreamProfile->parse($xml); } elsif ($method eq 'setDatastreamVersionable') { return Catmandu::FedoraCommons::Model::datastreamProfile->parse($xml); } elsif ($method eq 'validate') { return Catmandu::FedoraCommons::Model::validate->parse($xml); } elsif ($method eq 'getRelationships') { return Catmandu::FedoraCommons::Model::getRelationships->parse($xml); } elsif ($method eq 'export') { return Catmandu::FedoraCommons::Model::export->parse($xml); } elsif ($method eq 'getObjectXML') { return Catmandu::FedoraCommons::Model::export->parse($xml); } elsif ($method eq 'describeRepository') { return Catmandu::FedoraCommons::Model::describeRepository->parse($xml); } else { Carp::croak "no model found for $method"; } } =head2 raw() Returns the raw Fedora Commons response as a string. =cut sub raw { my ($self) = @_; $self->{response}->content; } =head2 content_type() Returns the Content-Type of the Fedora Commons response. =cut sub content_type { my ($self) = @_; $self->{response}->header('Content-Type'); } =head2 length() Returns the byte length of the Fedora Commons response. =cut sub length { my ($self) = @_; $self->{response}->header('Content-Length'); } =head2 date() Returns the date of the Fedora Commons response. =cut sub date { my ($self) = @_; $self->{response}->header('Date'); } =head1 AUTHORS =over 4 =item * Patrick Hochstenbach, C<< >> =back =head1 SEE ALSO L, L, L, L, L =cut 1; FedoraCommons000755000765000024 013375261174 24027 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/StoreDC.pm100644000765000024 702613375261174 25020 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/FedoraCommonspackage Catmandu::Store::FedoraCommons::DC; use Moo; use XML::LibXML; use Data::Validate::Type qw(:boolean_tests); has fedora => (is => 'ro' , required => 1); # REQUIRED METHODS FOR A MODEL sub get { my ($self,$pid) = @_; return undef unless $pid; my $res = $self->fedora->getDatastreamDissemination( pid => $pid , dsID => 'DC'); return undef unless $res->is_ok; my $data = $res->parse_content; my $perl = $self->deserialize($data); { _id => $pid , %$perl }; } sub update { my ($self,$obj) = @_; my $pid = $obj->{_id}; return undef unless $pid; my ($valid,$reason) = $self->valid($obj); unless ($valid) { warn "data is not valid"; return undef; } my $xml = $self->serialize($obj); my $result = $self->fedora->modifyDatastream( pid => $pid , dsID => 'DC', xml => $xml); return $result->is_ok; } # HELPER METHODS # Die fast data validator sub valid { my ($self,$perl) = @_; unless (is_hashref($perl)) { return wantarray ? (0, "not a HASH ref") : undef ; } unless (Data::Validate::Type::filter_hashref($perl, allow_empty => 0)) { return wantarray ? (0, "empty HASH ref") : undef; } my $found = undef; for my $key (keys %$perl) { my $value = $perl->{$key}; next if $key eq '_id'; unless ($key =~ m{^(contributor|coverage|creator|date|description|format|identifier|language|publisher|relation|rights|source|subject|title|type)$}) { return wantarray ? (0, "unknown field $key") : undef; } unless (is_arrayref($value)) { return wantarray ? (0, "field $key isn't an ARRAY") : undef; } for my $value_str (@$value) { unless (is_string($value_str)) { return wantarray ? (0, "field $key value isn't a string") : undef; } } $found = 1; } unless (defined $found) { return wantarray ? (0, "need at least one field") : undef; } return wantarray ? (1,"ok") : 1; } sub serialize { my ($self,$perl) = @_; my $dom = XML::LibXML::Document->new( '1.0', 'UTF-8' ); my $dc = $dom->createElementNS('http://www.openarchives.org/OAI/2.0/oai_dc/','oai_dc:dc'); $dom->setDocumentElement($dc); for my $dc_elem (qw(contributor coverage creator date description format identifier language publisher relation rights source subject title type)) { next unless (exists $perl->{$dc_elem} && ref $perl->{$dc_elem} eq 'ARRAY'); for my $dc_value (@{$perl->{$dc_elem}}) { my $node = $dom->createElementNS('http://purl.org/dc/elements/1.1/',"dc:$dc_elem"); $node->appendTextNode($dc_value); $dc->appendChild($node); } } my $xml = $dom->toString(2); $xml =~ s{<\?[^>]+\?>}{}; return $xml; } sub deserialize { my ($self,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); my $xc = XML::LibXML::XPathContext->new( $dom ); $xc->registerNs('oai_dc','http://www.openarchives.org/OAI/2.0/oai_dc/'); $xc->registerNs('dc','http://purl.org/dc/elements/1.1/'); my $result = {}; my @nodes = $xc->findnodes("//oai_dc:dc/*"); for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; $name =~ s/\w+://; push @{ $result->{$name} } , $value; } return $result; } 1;Catmandu-FedoraCommons-Model-export.t100644000765000024 27213375261174 25311 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::export'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-ingest.t100644000765000024 27213375261174 25261 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::ingest'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-upload.t100644000765000024 27213375261174 25254 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::upload'; use_ok $pkg; } require_ok $pkg; done_testing; File000755000765000024 013375261174 22152 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/StoreFedoraCommons.pm100644000765000024 1510013375261174 25421 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/Filepackage Catmandu::Store::File::FedoraCommons; our $VERSION = '0.5'; use Catmandu::Sane; use Moo; use Carp; use Catmandu; use Catmandu::Util; use Catmandu::FedoraCommons; use Catmandu::Store::File::FedoraCommons::Index; use Catmandu::Store::File::FedoraCommons::Bag; use Data::UUID; use namespace::clean; with 'Catmandu::FileStore', 'Catmandu::Droppable'; has baseurl => (is => 'ro', default => sub {'http://localhost:8080/fedora'}); has user => (is => 'ro', default => sub {'fedoraAdmin'}); has password => (is => 'ro', default => sub {'fedoraAdmin'}); has namespace => (is => 'ro', default => sub {'demo'}); has dsnamespace => (is => 'ro', default => sub {'DS'}); has md5enabled => (is => 'ro', default => sub {'1'}); has versionable => (is => 'ro', default => sub {'0'}); has purge => (is => 'ro', default => sub {'0'}); has model => (is => 'ro', predicate => 1 ); has fedora => (is => 'lazy'); sub _build_fedora { my ($self) = @_; my $fedora = Catmandu::FedoraCommons->new($self->baseurl, $self->user, $self->password); $fedora->{namespace} = $self->namespace; $fedora->{dsnamespace} = $self->dsnamespace; $fedora->{md5enabled} = $self->md5enabled; $fedora->{versionable} = $self->versionable; $fedora->{purge} = $self->purge; my $model = $self->model; if ($model && !(Catmandu::Util::is_invocant($model) || Catmandu::Util::is_code_ref($model))) { my $class = $model =~ /^\+(.+)/ ? $1 : "Catmandu::Store::FedoraCommons::$model"; eval { $self->{model} = Catmandu::Util::require_package($class)->new(fedora => $fedora); }; if ($@) { croak $@; } } $fedora; } sub drop { my ($self) = @_; $self->index->delete_all; } 1; __END__ =pod =head1 NAME Catmandu::Store::File::FedoraCommons - A Catmandu::FileStore to store files on disk into a Fedora3 server =head1 SYNOPSIS # From the command line # Create a configuration file $ cat catmandu.yml --- store: files: package: File::FedoraCommons options: baseurl: http://localhost:8080/fedora username: fedoraAdmin password: fedoraAdmin namespace: demo model: DC purge: 1 # Export a list of all file containers $ catmandu export files to YAML # Export a list of all files in container 'demo:1234' $ catmandu export files --bag 1234 to YAML # Add a file to the container 'demo:1234' $ catmandu stream /tmp/myfile.txt to files --bag 1234 --id myfile.txt # Download the file 'myfile.txt' from the container 'demo:1234' $ catmandu stream files --bag 1234 --id myfile.txt to /tmp/output.txt # Delete the file 'myfile.txt' from the container 'demo:1234' $ catmandu delete files --root t/data --bag 1234 --id myfile.txt # From Perl use Catmandu; my $store = Catmandu->store('File::FedoraCommons' , baseurl => 'http://localhost:8080/fedora' , username => 'fedoraAdmin' , password => 'fedoraAdmin' , namespace => 'demo' , purge => 1); my $index = $store->index; # List all folder $index->bag->each(sub { my $container = shift; print "%s\n" , $container->{_id}; }); # Add a new folder $index->add({ _id => '1234' }); # Get the folder my $files = $index->files('1234'); # Add a file to the folder $files->upload(IO::File->new('get('foobar.txt'); # Stream the contents of a file $files->stream(IO::File->new('>foobar.txt'), $file); # Delete a file $files->delete('foobar.txt'); # Delete a folder $index->delete('1234'); =head1 DESCRIPTION L is a L implementation to store files in a Fedora Commons 3 server. Each L. =head1 METHODS =head2 new(%connection_parameters) Create a new Catmandu::Store::FedoraCommons. The following connection paramaters can be provided: =over =item baseurl The location of the Fedora Commons endpoint. Default: http://localhost:8080/fedora =item user The username to connect to Fedora Commons =item password The password to connect to Fedora Commons =item namespace The namespace in which all bag identifiers live. Default: demo =item dsnamespace The namespace used to create new data streams. Default: DS =item md5enabled Calculate and add a MD5 checksum when uploading content. Default: 1 =item versionable Make data streams in Fedora versionable. Default: 0 =item purge When purge is active, deletion of datastreams and records will purge the content in FedoraCommons. Otherwise it will set the status to 'D' (deleted). Default: 0 =item model When a model is set, then descriptive metadata can be added to the File::Store folders. Only one type of model is currenty available 'DC'. Examples: $ cat record.yml --- _id: 1234 title: - My title creator: - John Brown - Max Musterman description: - Files and more things ... $ catmandu import YAML to files < record.yml $ catmandu export files to YAML --id 1234 --- _id: 1234 title: - My title creator: - John Brown - Max Musterman description: - Files and more things ... $ catmandu stream foobar.pdf to files --bag 1234 --id foobar.pdf $ catmandu export files --bag 1234 --- _id: foobar.pdf _stream: !!perl/code '{ "DUMMY" }' content_type: application/pdf control_group: M created: '1504170797' format_uri: '' info_type: '' location: demo:1234+DS.0+DS.0.0 locationType: INTERNAL_ID md5: 6112b4f1b1a439917b8bbacc93b7d3fa modified: '1504170797' size: '534' state: A version_id: DS.0.0 versionable: 'false' ... $ catmandu stream files --bag 1234 --id foobar.pdf > foobar.pdf =back =head1 INHERITED METHODS This Catmandu::FileStore implements: =over 3 =item L =item L =back The index Catmandu::Bag in this Catmandu::Store implements: =over 3 =item L =item L =item L =back The file Catmandu::Bag in this Catmandu::Store implements: =over 3 =item L =item L =item L =back =head1 SEE ALSO L, L, L =cut Catmandu-FedoraCommons-Model-pidList.t100644000765000024 27313375261174 25401 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::pidList'; use_ok $pkg; } require_ok $pkg; done_testing; FOXML.pm100644000765000024 227713375261174 25422 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/FedoraCommonspackage Catmandu::Store::FedoraCommons::FOXML; use Moo; sub valid { my ($self) = @_; return (1,"ok"); } sub serialize { my ($self) = @_; # This is the minimum object that can be created in Fedora return < EOF } sub deserialize { die "not implemented"; } 1;Catmandu-FedoraCommons-Model-validate.t100644000765000024 27413375261174 25563 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::validate'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-Store-File-FedoraCommons-Bag.t100644000765000024 444513375261174 25420 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; use IO::File; use IO::File::WithFilename; use Catmandu::Store::File::FedoraCommons; my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; my $pkg; BEGIN { $pkg = 'Catmandu::Store::File::FedoraCommons::Bag'; use_ok $pkg; } require_ok $pkg; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 100 if (! $host || ! $port || ! $user || ! $pwd); my $store = Catmandu::Store::File::FedoraCommons->new(purge => 1); ok $store , 'got a store'; my $index = $store->bag; ok $index , 'got an index'; ok $index->add({_id => 1234}), 'adding bag `1234`'; my $bag = $store->bag('1234'); ok $bag , 'got bag(1234)'; note("add"); { ok $bag->upload(IO::File::WithFilename->new('t/marc.xml'),'marc.xml'); ok $bag->upload(IO::File->new('t/obj_demo_40.zip'),'obj_demo_40.zip'); } note("list"); { my $array = [sort @{$bag->map(sub {shift->{_id}})->to_array}]; ok $array , 'list got a response'; is_deeply $array , [qw(marc.xml obj_demo_40.zip)], 'got correct response'; } note("exists"); { for (qw(marc.xml obj_demo_40.zip)) { ok $bag->exists($_), "exists($_)"; } } note("get"); { for (qw(marc.xml obj_demo_40.zip)) { ok $bag->get($_), "get($_)"; } my $file = $bag->get("marc.xml"); my $str = $bag->as_string_utf8($file); ok $str , 'can stream the data'; like $str , qr/Carl Sandburg ; illustrated as an anamorphic adventure by Ted Rand./, 'got the correct data'; } note("delete"); { ok $bag->delete('marc.xml'), 'marc.xml)'; my $array = [sort @{$bag->map(sub {shift->{_id}})->to_array}]; ok $array , 'list got a response'; is_deeply $array , [qw(obj_demo_40.zip)], 'got correct response'; } note("delete_all"); { lives_ok {$bag->delete_all()} 'delete_all'; my $array = $bag->to_array; is_deeply $array , [], 'got correct response'; } ok $index->delete('1234'), 'delete(1234)'; } done_testing; Model000755000765000024 013375261174 23773 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommonsexport.pm100644000765000024 721113375261174 26013 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::export - Perl model for the Fedora 'export' and 'getObjectXML' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->export(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'version' => '1.1', 'objectProperties' => { 'state' => 'Inactive' , 'label' => 'Data Object for Image Manipulation Demo' , 'ownerId' => 'fedoraAdmin' , 'createdDate' => '2008-07-02T05:09:42.015Z' , 'lastModifiedDate' => '2013-02-07T19:57:27.140Z' , }, 'auditTrail' => [ { 'id' => 'AUDREC1' , 'process' => 'Fedora API-M' , 'action' => 'addDatastream' , 'componentID' => 'TEST' , 'responsibility' => 'fedoraAdmin' , 'date' => '2013-02-07T18:42:24.518Z' , 'justification' => '' , }, ], 'dc' => { 'title' => [ 'Coliseum in Rome' ] , 'creator' => [ 'Thornton Staples' ] , 'subject' => [ 'Architecture, Roman' ] , 'description' => [ 'Image of Coliseum in Rome' ] , 'publisher' => [ 'University of Virginia Library' ] , 'format' => [ 'image/jpeg' ] , 'identifier' => [ 'demo:29' ], }, } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::export; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('info:fedora/fedora-system:def/foxml#','foxml'); my $xc = XML::LibXML::XPathContext->new( $dom ); $xc->registerNs('audit', 'info:fedora/fedora-system:def/audit#'); $xc->registerNs('oai_dc','http://www.openarchives.org/OAI/2.0/oai_dc/'); $xc->registerNs('dc','http://purl.org/dc/elements/1.1/'); my @nodes; @nodes = $xc->findnodes("/foxml:digitalObject/foxml:objectProperties//foxml:property"); my $result; for my $node (@nodes) { my $name = $node->getAttribute('NAME'); my $value = $node->getAttribute('VALUE'); $name =~ s{.*#}{}; $result->{objectProperties}->{$name} = $value; } @nodes = $xc->findnodes("//audit:auditTrail/audit:record"); my @auditTrail = (); for my $node (@nodes) { my $id = $node->findvalue('@ID'); my $process = $node->findvalue('./audit:process/@type'); my $action = $node->findvalue('./audit:action'); my $componentID = $node->findvalue('./audit:componentID'); my $responsibility = $node->findvalue('./audit:responsibility'); my $date = $node->findvalue('./audit:date'); my $justification = $node->findvalue('./audit:justification'); push(@auditTrail , { id => $id , process => $process , action => $action , componentID => $componentID , responsibility => $responsibility , date => $date , justification => $justification , }); } $result->{auditTrail} = \@auditTrail; @nodes = $xc->findnodes("//oai_dc:dc/*"); for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; push @{ $result->{dc}->{$name} } , $value; } my $pid = $dom->firstChild()->getAttribute('PID'); $result->{pid} = $pid; my $version = $dom->firstChild()->getAttribute('VERSION'); $result->{version} = $version; return $result; } 1;ingest.pm100644000765000024 114513375261174 25763 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::ingest - Perl model for the Fedora 'ingest' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->ingest(pid => 'demo:40', file => 't/obj_demo_40.zip', format => 'info:fedora/fedora-system:ATOMZip-1.1')->parse_content; { 'pid' => 'demo:40' } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::ingest; sub parse { my ($class,$bytes) = @_; return { pid => $bytes }; } 1;upload.pm100644000765000024 103313375261174 25752 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::upload - Perl model for the Fedora 'upload' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->upload(file => 't/marc.xml')->parse_content; { 'id' => 'upload://11' } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::upload; sub parse { my ($class,$bytes) = @_; return { id => $bytes }; } 1;pidList.pm100644000765000024 156513375261174 26110 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::pidList - Perl model for the Fedora 'getNextPID' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getNextPID()->parse_content; [ 'changeme:102' ] =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::pidList; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/management/','m'); my @nodes = $dom->findnodes("/m:pidList/m:pid"); my $result; foreach my $node (@nodes) { my $value = $node->textContent; push @$result , $value; } return $result; } 1;Catmandu-Store-File-FedoraCommons-Index.t100644000765000024 244613375261174 25775 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; use Catmandu::Store::File::FedoraCommons; my $host = $ENV{FEDORA_HOST} || ""; my $port = $ENV{FEDORA_PORT} || ""; my $user = $ENV{FEDORA_USER} || ""; my $pwd = $ENV{FEDORA_PWD} || ""; my $pkg; BEGIN { $pkg = 'Catmandu::Store::File::FedoraCommons::Index'; use_ok $pkg; } require_ok $pkg; SKIP: { skip "No Fedora server environment settings found (FEDORA_HOST," . "FEDORA_PORT,FEDORA_USER,FEDORA_PWD).", 100 if (! $host || ! $port || ! $user || ! $pwd); my $store = Catmandu::Store::File::FedoraCommons->new(purge => 1); ok $store , 'got a store'; my $index; note("index"); { $index = $store->bag(); ok $index , 'got the index bag'; } note("list"); { my $array = $index->to_array; ok $array , 'list got a response'; ok grep({ $_->{_id} eq 'SmileyWastebasket' } @$array), 'got a SmileyWastebasket'; } note("get"); { for (qw(SmileyToiletBrush SmileyTallRoundCup SmileyWastebasket)) { ok $index->get($_), "get($_)"; } } note("add"); { ok $index->add({_id => '1234'}) , 'add(1234)'; } note("delete"); { ok $index->delete('1234'), 'delete(1234)'; } } done_testing; validate.pm100644000765000024 462113375261174 26265 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::validate - Perl model for the Fedora 'validate' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->validate(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'valid' => 'false' , 'asOfDateTime' => '2013-02-08T10:09:09.273Z' , 'model' => [ 'info:fedora/demo:UVA_STD_IMAGE' , 'info:fedora/fedora-system:FedoraObject-3.0' , ], 'problem' => [ 'test' ] , 'datastream' => [ { 'dsID' => 'url' , 'problem' => [ "Datastream 'url' is does not have the FORMAT_URI and MIME_TYPE attributes required by 'demo:UVA_STD_IMAGE'" , ] } ] , } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::validate; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/management/','m'); my $result; $result->{asOfDateTime} = $dom->findnodes("/m:validation/m:asOfDateTime")->[0]->textContent; my @nodes; @nodes = $dom->findnodes("/m:validation/m:contentModels/m:model"); for my $node (@nodes) { my $value = $node->textContent; push @{$result->{model}} , $value; } @nodes = $dom->findnodes("/m:validation/m:datastreamProblems/m:datastream"); for my $node (@nodes) { my $dsID = $node->getAttribute('datastreamID'); my $value = $node->textContent; my $datastream = { dsID => $dsID }; my @subnodes = $node->findnodes("./m:problem"); for my $subnode (@subnodes) { my $value = $node->textContent; push @{$datastream->{problem}} , $value; } push @{$result->{datastream}} , $datastream; } @nodes = $dom->findnodes("/m:validation/m:problems/m:problem"); for my $node (@nodes) { my $value = $node->textContent; push @{$result->{problem}} , $value; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; my $valid = $dom->firstChild()->getAttribute('valid'); $result->{valid} = $valid; return $result; } 1;FedoraCommons000755000765000024 013375261174 24706 5ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/FileBag.pm100644000765000024 3136513375261174 26125 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/File/FedoraCommonspackage Catmandu::Store::File::FedoraCommons::Bag; use Catmandu::Sane; our $VERSION = '0.5'; use Moo; use Date::Parse; use File::Copy; use Carp; use Catmandu::Util qw(content_type); use namespace::clean; with 'Catmandu::Bag'; with 'Catmandu::FileBag'; with 'Catmandu::Droppable'; sub generator { my ($self) = @_; my $key = $self->name; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:$key"; my $dsnamespace = $fedora->{dsnamespace}; $self->log->debug("Listing datastreams for $pid"); my $response = $fedora->listDatastreams(pid => $pid); unless ($response->is_ok) { $self->log->error("Failed to list datastreams for $pid"); $self->log->error($response->error); return (); } my $obj = $response->parse_content; my @children = grep { $_->{dsid} =~ /^$dsnamespace\./ } @{$obj->{datastream}}; sub { my $child = shift @children; return undef unless $child; my $dsid = $child->{dsid}; $self->log->debug("adding $dsid"); return $self->_get($dsid); }; } sub exists { my ($self, $key) = @_; defined($self->_dsid_by_label($key)) ? 1 : undef; } sub get { my ($self, $key) = @_; my $dsid = $self->_dsid_by_label($key); return undef unless $dsid; return $self->_get($dsid); } sub add { my ($self,$data) = @_; my $key = $data->{_id}; my $io = $data->{_stream}; if ($io->can('filename')) { my $filename = $io->filename; $self->log->debug("adding a stream from the filename"); return $self->_add_filename($key, $io, $filename); } else { $self->log->debug("copying a stream to a filename"); return $self->_add_stream($key, $io); } my $new_data = $self->get($key); $data->{$_} = $new_data->{$_} for keys %$new_data; 1; } sub delete { my ($self, $key) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; my $dsid = $self->_dsid_by_label($key); return undef unless $dsid; my $response; if ($fedora->{purge}) { $self->log->debug("Purge datastream $pid:$dsid"); $response = $fedora->purgeDatastream(pid => $pid, dsID => $dsid); } else { $self->log->debug("Set datastream state D $pid:$dsid"); $response = $fedora->setDatastreamState( pid => $pid, dsID => $dsid, dsState => 'D' ); } unless ($response->is_ok) { warn $response->error; $self->log->error("Failed to purge/set datastream for $pid:$dsid"); $self->log->error($response->error); return undef; } 1; } sub delete_all { my ($self) = @_; $self->each( sub { my $key = shift->{_id}; $self->delete($key); } ); 1; } sub drop { $_[0]->delete_all; } sub commit { return 1; } sub _dsid_by_label { my ($self, $key) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; $self->log->debug("Listing datastreams for $pid"); my $response = $fedora->listDatastreams(pid => $pid); unless ($response->is_ok) { $self->log->error("Failed to list datastreams for $pid"); $self->log->error($response->error); return (); } my $obj = $response->parse_content; for my $ds (@{$obj->{datastream}}) { my $dsid = $ds->{dsid}; my $label = $ds->{label}; return $dsid if $label eq $key; } return undef; } sub _list_dsid { my ($self) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; my $dsnamespace = $fedora->{dsnamespace}; $self->log->debug("Listing datastreams for $pid"); my $response = $fedora->listDatastreams(pid => $pid); unless ($response->is_ok) { $self->log->error("Failed to list datastreams for $pid"); $self->log->error($response->error); return (); } my $obj = $response->parse_content; my @result = (); for my $ds (@{$obj->{datastream}}) { my $dsid = $ds->{dsid}; my $label = $ds->{label}; unless ($dsid =~ /^$dsnamespace\./) { $self->log->debug("skipping $dsid (not in $dsnamespace)"); next; } $self->log->debug("adding $dsid"); my $cnt = $dsid; $cnt =~ s/^$dsnamespace\.//; push @result, {n => $cnt, dsid => $dsid, label => $label}; } return sort {$a->{n} <=> $b->{n}} @result; } sub _next_dsid { my ($self, $key) = @_; my $fedora = $self->store->fedora; my $dsnamespace = $fedora->{dsnamespace}; my $cnt = -1; for ($self->_list_dsid) { if ($key eq $_->{label}) { return ('MODIFIY', $_->{dsid}); } $cnt = $_->{n}; } return ('ADD', "$dsnamespace." . ($cnt + 1)); } sub _get { my ($self, $dsid) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; $self->log->debug("Get datastream history for $pid:$dsid"); my $response = $fedora->getDatastreamHistory(pid => $pid, dsID => $dsid); unless ($response->is_ok) { $self->log->error("Failed to get datastream history for $pid:$dsid"); $self->log->error($response->error); return undef; } my $object = $response->parse_content; my $first = $object->{profile}->[0]; my $last = $object->{profile}->[-1]; my $created = str2time($last->{dsCreateDate}); $created =~ s{\..*}{}; my $modified = str2time($first->{dsCreateDate}); $modified =~ s{\..*}{}; return undef unless $first->{dsState} eq 'A'; return { _id => $first->{dsLabel} , size => $first->{dsSize} , md5 => $first->{dsChecksum} , content_type => $first->{dsMIME} , created => $created , modified => $modified , info_type => $first->{dsInfoType} , state => $first->{dsState} , versionable => $first->{dsVersionable} , location => $first->{dsLocation} , locationType => $first->{dsLocationType} , version_id => $first->{dsVersionID} , control_group => $first->{dsControlGroup} , format_uri => $first->{dsFormatURI} , _stream => sub { my $out = shift; my $bytes = 0; my $res = $fedora->getDatastreamDissemination( pid => $pid, dsID => $dsid, callback => sub { my ($data, $response, $protocol) = @_; # Support the Dancer send_file "write" callback if ($out->can('syswrite')) { $bytes += $out->syswrite($data); } else { $bytes += $out->write($data); } } ); $out->close; $bytes; } }; } sub _add_filename { my ($self, $key, $data, $filename) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; my $dsnamespace = $fedora->{dsnamespace}; my $versionable = $fedora->{versionable} ? 'true' : 'false'; my %options = ('versionable' => $versionable); if ($fedora->{md5enabled}) { my $ctx = Digest::MD5->new; my $checksum = $ctx->addfile($data)->hexdigest; $options{checksum} = $checksum; $options{checksumType} = 'MD5'; } my $mimeType = content_type($key); my ($operation, $dsid) = $self->_next_dsid($key); my $response; if ($operation eq 'ADD') { $self->log->debug( "Add datastream $pid:$dsid $filename $key $mimeType"); $response = $fedora->addDatastream( pid => $pid, dsID => $dsid, file => $filename, dsLabel => $key, mimeType => $mimeType, %options ); } else { $self->log->debug( "Modify datastream $pid:$dsid $filename $key $mimeType"); $response = $fedora->modifyDatastream( pid => $pid, dsID => $dsid, file => $filename, dsLabel => $key, mimeType => $mimeType, %options ); } unless ($response->is_ok) { $self->log->error( "Failed to add/modify datastream history for $pid:$dsid"); $self->log->error($response->error); return undef; } 1; } sub _add_stream { my ($self, $key, $io) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $pid = "$ns_prefix:" . $self->name; my $dsnamespace = $fedora->{dsnamespace}; my $versionable = $fedora->{versionable} ? 'true' : 'false'; my ($fh, $filename) = File::Temp::tempfile( "librecat-filestore-container-fedoracommons-XXXX", UNLINK => 1); if (Catmandu::Util::is_invocant($io)) { # We got a IO::Handle $self->log->debug("..copying to $filename"); File::Copy::cp($io, $filename); $io->close; } else { # We got a string $self->log->debug("..string to $filename"); Catmandu::Util::write_file($filename, $io); } $fh->close; my %options = ('versionable' => $versionable); if ($fedora->{md5enabled}) { my $ctx = Digest::MD5->new; my $data = IO::File->new($filename); my $checksum = $ctx->addfile($data)->hexdigest; $options{checksum} = $checksum; $options{checksumType} = 'MD5'; $data->close(); } my $mimeType = content_type($key); my ($operation, $dsid) = $self->_next_dsid($key); my $response; if ($operation eq 'ADD') { $self->log->debug( "Add datastream $pid:$dsid $filename $key $mimeType"); $response = $fedora->addDatastream( pid => $pid, dsID => $dsid, file => $filename, dsLabel => $key, mimeType => $mimeType, %options ); } else { $self->log->debug( "Modify datastream $pid:$dsid $filename $key $mimeType"); $response = $fedora->modifyDatastream( pid => $pid, dsID => $dsid, file => $filename, dsLabel => $key, mimeType => $mimeType, %options ); } unlink $filename; unless ($response->is_ok) { $self->log->error( "Failed to add/modify datastream history for $pid:$dsid"); $self->log->error($response->error); return undef; } 1; } 1; __END__ =pod =head1 NAME Catmandu::Store::File::FedoraCommons::Bag - Index of all "files" in a Catmandu::Store::File::FedoraCommons "folder" =head1 SYNOPSIS use Catmandu; my $store = Catmandu->store('File::FedoraCommons' , baseurl => 'http://localhost:8080/fedora' , username => 'fedoraAdmin' , password => 'fedoraAdmin' , namespace => 'demo' , purge => 1); my $index = $store->index; # List all containers $index->each(sub { my $container = shift; print "%s\n" , $container->{_id}; }); # Add a new folder $index->add({_id => '1234'}); # Delete a folder $index->delete(1234); # Get a folder my $folder = $index->get(1234); # Get the files in an folder my $files = $index->files(1234); $files->each(sub { my $file = shift; my $name = $file->_id; my $size = $file->size; my $content_type = $file->content_type; my $created = $file->created; my $modified = $file->modified; $file->stream(IO::File->new(">/tmp/$name"), file); }); # Add a file $files->upload(IO::File->new("upload(IO::File::WithFilename->new("get("data.dat"); # Stream a file to an IO::Handle $files->stream(IO::File->new(">data.dat"),$file); # Delete a file $files->delete("data.dat"); # Delete a folders $index->delete("1234"); =head1 INHERITED METHODS This Catmandu::Bag implements: =over 3 =item L =item L =item L =back =cut Catmandu-FedoraCommons-Model-findObjects.t100644000765000024 27713375261174 26227 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::findObjects'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-listMethods.t100644000765000024 27713375261174 26274 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::listMethods'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-purgeObject.t100644000765000024 27713375261174 26246 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::purgeObject'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-modifyObject.t100644000765000024 30013375261174 26376 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::modifyObject'; use_ok $pkg; } require_ok $pkg; done_testing; Index.pm100644000765000024 1551613375261174 26503 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/Store/File/FedoraCommonspackage Catmandu::Store::File::FedoraCommons::Index; our $VERSION = '0.5'; use Catmandu::Sane; use Moo; use Carp; use Clone qw(clone); use Catmandu::Store::FedoraCommons::FOXML; use namespace::clean; use Data::Dumper; with 'Catmandu::Bag'; with 'Catmandu::FileBag::Index'; with 'Catmandu::Droppable'; sub generator { my ($self) = @_; my $fedora = $self->store->fedora; $self->log->debug("creating generator for Fedora @ " . $self->store->baseurl); return sub { state $hits; state $row; state $ns_prefix = $self->store->namespace; if (!defined $hits) { my $res = $fedora->findObjects(query => "pid~${ns_prefix}* state=A"); unless ($res->is_ok) { $self->log->error($res->error); return undef; } $row = 0; $hits = $res->parse_content; } if ($row + 1 == @{$hits->{results}} && defined $hits->{token}) { my $result = $hits->{results}->[$row]; my $res = $fedora->findObjects(sessionToken => $hits->{token}); unless ($res->is_ok) { warn $res->error; return undef; } $row = 0; $hits = $res->parse_content; my $pid = $result->{pid}; return undef unless $pid; $pid =~ s{^$ns_prefix:}{}; return $self->get($pid); } else { my $result = $hits->{results}->[$row++]; my $pid = $result->{pid}; return undef unless $pid; $pid =~ s{^$ns_prefix:}{}; return $self->get($pid); } }; } sub exists { my ($self, $key) = @_; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; croak "Need a key" unless defined $key; $self->log->debug("Checking exists $key"); my $obj = $fedora->getObjectProfile(pid => "$ns_prefix:$key"); $obj->is_ok; } sub add { my ($self, $data) = @_; croak "Need an id" unless defined $data && exists $data->{_id}; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $key = $data->{_id}; if ($self->exists($key)) { $self->log->debug("Updating container for $key"); if ($self->store->has_model) { my $model_data = clone($data); delete $model_data->{_stream}; $model_data->{_id} = "$ns_prefix:$key"; $self->store->model->update($model_data); } } else { $self->log->debug("Creating container for $key"); my $xml = Catmandu::Store::FedoraCommons::FOXML->new->serialize(); $self->log->debug("Ingest object $ns_prefix:$key"); my $response = $fedora->ingest( pid => "$ns_prefix:$key", xml => $xml, format => 'info:fedora/fedora-system:FOXML-1.1' ); unless ($response->is_ok) { $self->log->error("Failed ingest object $ns_prefix:$key"); $self->log->error($response->error); return undef; } if ($self->store->has_model) { my $model_data = clone($data); delete $model_data->{_stream}; $model_data->{_id} = "$ns_prefix:$key"; $self->store->model->update($model_data); } } my $new_data = $self->get($key); $data->{$_} = $new_data->{$_} for keys %$new_data; 1; } sub get { my ($self, $key) = @_; croak "Need a key" unless defined $key; $self->log->debug("Loading container for $key"); my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; $self->log->debug("Get object profile $ns_prefix:$key"); my $response = $fedora->getObjectProfile(pid => "$ns_prefix:$key"); unless ($response->is_ok) { $self->log->error("Failed get object profile $ns_prefix:$key"); $self->log->error($response->error); return undef; } if ($self->store->has_model) { my $item = $self->store->model->get("$ns_prefix:$key"); my $id = $item->{_id}; $item->{_id} = substr($id,length($ns_prefix)+1); return $item; } else { return +{_id => $key}; } } sub delete { my ($self, $key) = @_; croak "Need a key" unless defined $key; my $fedora = $self->store->fedora; my $ns_prefix = $fedora->{namespace}; my $response; if ($fedora->{purge}) { $self->log->debug("Purge object $ns_prefix:$key"); $response = $fedora->purgeObject(pid => "$ns_prefix:$key"); } else { $self->log->debug("Modify object state D $ns_prefix:$key"); $response = $fedora->modifyObject(pid => "$ns_prefix:$key", state => 'D'); } unless ($response->is_ok) { $self->log->error("Failed purge/modify object $ns_prefix:$key"); $self->log->error($response->error); return undef; } 1; } sub delete_all { my ($self) = @_; $self->each( sub { my $key = shift->{_id}; $self->delete($key); } ); } sub drop { $_[0]->delete_all; } sub commit { return 1; } 1; __END__ =pod =head1 NAME Catmandu::Store::File::FedoraCommons::Index - Index of all "Folders" in a Catmandu::Store::File::FedoraCommons =head1 SYNOPSIS use Catmandu; my $store = Catmandu->store('File::FedoraCommons' , baseurl => 'http://localhost:8080/fedora' , username => 'fedoraAdmin' , password => 'fedoraAdmin' , namespace => 'demo' , purge => 1); my $index = $store->index; # List all containers $index->each(sub { my $container = shift; print "%s\n" , $container->{_id}; }); # Add a new folder $index->add({_id => '1234'}); # Delete a folder $index->delete(1234); # Get a folder my $folder = $index->get(1234); # Get the files in an folder my $files = $index->files(1234); $files->each(sub { my $file = shift; my $name = $file->_id; my $size = $file->size; my $content_type = $file->content_type; my $created = $file->created; my $modified = $file->modified; $file->stream(IO::File->new(">/tmp/$name"), file); }); # Add a file $files->upload(IO::File->new("get("data.dat"); # Stream a file to an IO::Handle $files->stream(IO::File->new(">data.dat"),$file); # Delete a file $files->delete("data.dat"); # Delete a folders $index->delete("1234"); =head1 INHERITED METHODS This Catmandu::Bag implements: =over 3 =item L =item L =item L =back =cut findObjects.pm100644000765000024 464213375261174 26731 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::findObjects - Perl model for the Fedora 'findObjects' and 'resumeFindObjects' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->findObjects(terms=>'*')->parse_content; { 'token' => '92b0ae4028f9459ce7cd0600f562adb2' , 'cursor' => 0, 'expirationDate' => '2013-02-08T09:37:55.860Z', 'results' => [ { 'pid' => 'demo:29' , 'label' => 'Data Object for Image Manipulation Demo' , 'state' => 'I' , 'ownerId' => 'fedoraAdmin' , 'cDate' => '2008-07-02T05:09:42.015Z' , 'mDate' => '2013-02-07T19:57:27.140Z' , 'dcmDate' => '2008-07-02T05:09:43.234Z' , 'title' => [ 'Coliseum in Rome' ] , 'creator' => [ 'Thornton Staples' ] , 'subject' => [ 'Architecture, Roman' ] , 'description' => [ 'Image of Coliseum in Rome' ] , 'publisher' => [ 'University of Virginia Library' ] , 'format' => [ 'image/jpeg' ] , 'identifier' => [ 'demo:29' ], }, ] , } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::findObjects; use XML::LibXML; our %SCALAR_TYPES = (pid => 1 , label => 1 , state => 1 , ownerId => 1 , cDate => 1 , mDate => 1 , dcmDate => 1); sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/types/','t'); my $result = { results => [] }; my @nodes; @nodes = $dom->findnodes("/t:result/t:listSession/*"); for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; $result->{$name} = $value; } @nodes = $dom->findnodes("/t:result/t:resultList/t:objectFields"); for my $node (@nodes) { my @vals = $node->findnodes("./*"); my $rec = {}; foreach my $val (@vals) { my $name = $val->nodeName; my $value = $val->textContent; if (exists $SCALAR_TYPES{$name}) { $rec->{$name} = $value; } else { push @{ $rec->{$name} } , $value; } } push @{$result->{results}}, $rec; } return $result; } 1; listMethods.pm100644000765000024 502413375261174 26771 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::listMethods - Perl model for the Fedora 'listMethods' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->listMethods(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'baseURL' => 'http://localhost:8080/fedora/' , 'sDef' => [ { 'pid' => 'demo:27', 'method' => [ { 'name' => 'resizeImage' , 'methodParm' => [ { 'parmDefaultValue' => '150', 'parmLabel' => 'fix me', 'parmRequired' => 'true', 'parmName' => 'width' } ], }, ] } ] } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::listMethods; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a'); my @nodes = $dom->findnodes("/a:objectMethods/*"); my $result; for my $node (@nodes) { my @attributes = $node->attributes(); my %values = map { $_->getName() , $_->getValue() } @attributes; my $sDef = \%values; for my $method ($node->findnodes("./a:method")) { my $name = $method->getAttribute('name'); my $m = { name => $name }; for my $param ($method->findnodes("./a:methodParm")) { my @attributes = $param->attributes(); my %values = map { $_->getName() , $_->getValue() } @attributes; for my $domain ($param->findnodes("./a:methodParmDomain/a:methodParmValue")) { my $value = $domain->textContent; push @{ $values{methodParmValue}} , $value; } push @{ $m->{methodParm} } , \%values; } push @{ $sDef->{method} } , $m; } push @{ $result->{sDef} }, $sDef; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; my $baseURL = $dom->firstChild()->getAttribute('baseURL'); $result->{baseURL} = $baseURL; return $result; } 1;purgeObject.pm100644000765000024 107413375261174 26744 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::purgeObject - Perl model for the Fedora 'purgeObject' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->purgeObject(pid => 'demo:29')->parse_content; { 'date' => '2013-02-08T10:09:09.273Z' } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::purgeObject; sub parse { my ($class,$bytes) = @_; return { date => $bytes }; } 1;modifyObject.pm100644000765000024 111713375261174 27107 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::modifyObject - Perl model for the Fedora 'modifyObject' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->modifyObject(pid => 'demo:29' , state => 'I')->parse_content; { 'date' => '2013-02-08T10:09:09.273Z' } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::modifyObject; sub parse { my ($class,$bytes) = @_; return { date => $bytes }; } 1;Catmandu-FedoraCommons-Model-addRelationship.t100644000765000024 30313375261174 27075 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::addRelationship'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-listDatastreams.t100644000765000024 30313375261174 27127 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::listDatastreams'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-purgeDatastream.t100644000765000024 30313375261174 27113 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::purgeDatastream'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-getObjectHistory.t100644000765000024 30413375261174 27254 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::getObjectHistory'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-getObjectProfile.t100644000765000024 30413375261174 27213 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::getObjectProfile'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-getRelationships.t100644000765000024 30413375261174 27310 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::getRelationships'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-datastreamHistory.t100644000765000024 30513375261174 27474 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::datastreamHistory'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-datastreamProfile.t100644000765000024 30513375261174 27433 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::datastreamProfile'; use_ok $pkg; } require_ok $pkg; done_testing; Catmandu-FedoraCommons-Model-purgeRelationship.t100644000765000024 30513375261174 27471 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::purgeRelationship'; use_ok $pkg; } require_ok $pkg; done_testing; addRelationship.pm100644000765000024 110613375261174 27601 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::addRelationship - Perl model for the Fedora 'addRelationship' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->addRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter'])->parse_content; Returns 1 on success. =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::addRelationship; sub parse { 1; } 1;listDatastreams.pm100644000765000024 333513375261174 27641 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::listDatastreams - Perl model for the Fedora 'listDatastreams' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->listDatastreams(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'baseURL' => 'http://localhost:8080/fedora/' , 'datastream' => [ { 'dsid' => 'DC' , 'label' => 'Dublin Core Record for this object' , 'mimeType' => 'text/xml' , }, { 'dsid' => 'RELS-EXT' , 'label' => 'RDF Statements about this object' , 'mimeType' => 'application/rdf+xml' , }, { 'dsid' => 'url' , 'label' => 'Thorny\'s Coliseum high jpg image' , 'mimeType' => 'text/xml' , }, ] , } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::listDatastreams; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a'); my @nodes = $dom->findnodes("/a:objectDatastreams/*"); my $result; foreach my $node (@nodes) { my @attributes = $node->attributes(); my %values = map { $_->getName() , $_->getValue() } @attributes; push @{ $result->{datastream} }, \%values; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; my $baseURL = $dom->firstChild()->getAttribute('baseURL'); $result->{baseURL} = $baseURL; return $result; } 1; purgeDatastream.pm100644000765000024 115113375261174 27617 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::purgeDatastream - Perl model for the Fedora 'purgeDatastream' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->purgeDatastream(pid => 'demo:29', dsID => 'TEST')->parse_content; [ '2013-02-08T10:18:21.019Z' ]; =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::purgeDatastream; use JSON; sub parse { my ($class,$bytes) = @_; return decode_json($bytes); } 1;Catmandu-FedoraCommons-Model-describeRepository.t100644000765000024 30613375261174 27646 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::describeRepository'; use_ok $pkg; } require_ok $pkg; done_testing; getObjectHistory.pm100644000765000024 225113375261174 27761 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::getObjectHistory - Perl model for the Fedora 'getObjectHistory' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getObjectHistory(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'objectChangeDate' => [ '2008-07-02T05:09:43.234Z' , '2013-02-07T18:42:24.672Z' , ] , } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::getObjectHistory; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a'); my $result = {}; my @nodes = $dom->findnodes("/a:fedoraObjectHistory/*"); for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; push @{ $result->{$name} } , $value; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; return $result; } 1;getObjectProfile.pm100644000765000024 370513375261174 27725 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::getObjectProfile - Perl model for the Fedora 'getObjectProfile' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getObjectProfile(pid => 'demo:29')->parse_content; { 'pid' => 'demo:29' , 'objLabel' => 'Data Object for Image Manipulation Demo' , 'objOwnerId' => 'fedoraAdmin' , 'objCreateDate' => '2008-07-02T05:09:42.015Z' , 'objLastModDate' => '2013-02-07T19:57:27.140Z' , 'objDissIndexViewURL' => 'http://localhost:8080/fedora/objects/demo%3A29/methods/fedora-system%3A3/viewMethodIndex' , 'objItemIndexViewURL' => 'http://localhost:8080/fedora/objects/demo%3A29/methods/fedora-system%3A3/viewItemIndex' , 'objState' => 'I' , 'objModels' => [ 'info:fedora/fedora-system:FedoraObject-3.0' , 'info:fedora/demo:UVA_STD_IMAGE' , ], } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::getObjectProfile; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a'); my @nodes = $dom->findnodes("/a:objectProfile/*"); my $result = {}; for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; if ($name eq 'objModels') { for my $model ($node->findnodes("./*")) { my $name = $model->nodeName; my $value = $model->textContent; push @{ $result->{objModels} } , $value; } } else { $result->{$name} = $value; } } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; return $result; } 1;getRelationships.pm100644000765000024 140213375261174 30012 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::getRelationships - Perl model for the Fedora 'getRelationships' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getRelationships(pid => 'demo:29')->parse_content; Returns a RDF::Trine::Model model =head1 SEE ALSO L L =cut package Catmandu::FedoraCommons::Model::getRelationships; use RDF::Trine; sub parse { my ($class,$xml) = @_; my $model = RDF::Trine::Model->temporary_model; my $parser = RDF::Trine::Parser->new('rdfxml'); $parser->parse_into_model(undef,$xml,$model); return $model; } 1;datastreamHistory.pm100644000765000024 377013375261174 30207 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::datastreamHistory - Perl model for the Fedora 'getDatastreamHistory' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getDatastreamHistory(pid => 'demo:29', dsID => 'DC')->parse_content; { 'pid' => 'demo:29' , 'dsID' => 'DC', 'profile' => [ { 'dsLabel' => 'Dublin Core Record for this object' , 'dsVersionID' => 'DC1.0' , 'dsCreateDate' => '2008-07-02T05:09:43.234Z' , 'dsState' => 'A' , 'dsMIME' => 'text/xml' , 'dsFormatURI' => 'http://www.openarchives.org/OAI/2.0/oai_dc/' , 'dsControlGroup' => 'X' , 'dsSize' => 626, 'dsVersionable' => 'true' , 'dsInfoType' => '' , 'dsLocation' => 'demo:29+DC+DC1.0' , 'dsLocationType' => '' , 'dsChecksumType' => 'DISABLED' , 'dsChecksum' => 'none' , } ] } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::datastreamHistory; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/management/','m'); my @nodes = $dom->findnodes("/m:datastreamHistory/m:datastreamProfile"); my $result; for my $node (@nodes) { my @sub_nodes = $node->findnodes("./*"); my $profile; for my $sub_node (@sub_nodes) { my $name = $sub_node->nodeName; my $value = $sub_node->textContent; $profile->{$name} = $value; } push @{ $result->{profile} }, $profile; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; my $dsID = $dom->firstChild()->getAttribute('dsID'); $result->{dsID} = $dsID; return $result; } 1;datastreamProfile.pm100644000765000024 376113375261174 30146 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::datastreamProfile - Perl model for the Fedora 'addDatastream', 'getDatastream', 'modifyDatastream','setDatastreamState' and 'setDatastreamVersionable' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->getDatastream(pid => 'demo:29', dsID => 'DC')->parse_content; { 'pid' => 'demo:29' , 'dsID' => 'DC', 'dateTime' => '2008-07-02T05:09:43.234Z' , 'profile' => { 'dsLabel' => 'Dublin Core Record for this object' , 'dsVersionID' => 'DC1.0' , 'dsCreateDate' => '2008-07-02T05:09:43.234Z' , 'dsState' => 'A' , 'dsMIME' => 'text/xml' , 'dsFormatURI' => 'http://www.openarchives.org/OAI/2.0/oai_dc/' , 'dsControlGroup' => 'X' , 'dsSize' => 626, 'dsVersionable' => 'true' , 'dsInfoType' => '' , 'dsLocation' => 'demo:29+DC+DC1.0' , 'dsLocationType' => '' , 'dsChecksumType' => 'DISABLED' , 'dsChecksum' => 'none' , } } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::datastreamProfile; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/management/','m'); my @nodes = $dom->findnodes("/m:datastreamProfile/*"); my $result; for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; $result->{profile}->{$name} = $value; } my $pid = $dom->firstChild()->getAttribute('pid'); $result->{pid} = $pid; my $dsID = $dom->firstChild()->getAttribute('dsID'); $result->{dsID} = $dsID; my $dateTime = $dom->firstChild()->getAttribute('dateTime'); $result->{dateTime} = $dateTime; return $result; } 1;purgeRelationship.pm100644000765000024 122313375261174 30173 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::purgeRelationship - Perl model for the Fedora 'purgeRelationship' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->purgeRelationship(pid => 'demo:29' , relation => [ 'info:fedora/demo:29' , 'http://my.org/name' , 'Peter'])->parse_content; { 'purged' => 'upload://11' } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::purgeRelationship; sub parse { my ($class,$bytes) = @_; return { purged => $bytes }; } 1;describeRepository.pm100644000765000024 371713375261174 30361 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::describeRepository - Perl model for the Fedora 'describe' method call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->describeRepository()->parse_content; { "sampleOAI-URL" : "http://localhost:8080/fedora/oai?verb=Identify", "repositoryName" : "Fedora Repository", "repositoryOAI-identifier" : { "OAI-delimiter" : ":", "OAI-namespaceIdentifier" : "localhost", "OAI-sample" : "oai:localhost:islandora:100" }, "repositoryBaseURL" : "http://localhost:8080/fedora", "sampleAccess-URL" : "http://localhost:8080/fedora/objects/demo:5", "adminEmail" : "libservice@ugent.be", "repositoryVersion" : "3.7.1", "repositoryPID" : { "PID-sample" : "islandora:100", "PID-delimiter" : ":", "PID-namespaceIdentifier" : "islandora", "retainPID" : "*" }, "sampleSearch-URL" : "http://localhost:8080/fedora/objects" } =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::describeRepository; use XML::LibXML; sub parse { my ($class,$xml) = @_; my $dom = XML::LibXML->load_xml(string => $xml); $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a'); my @nodes = $dom->findnodes("/a:fedoraRepository/*"); my $result = {}; for my $node (@nodes) { my $name = $node->nodeName; my $value = $node->textContent; if ($name eq 'repositoryPID' || $name eq 'repositoryOAI-identifier') { $result->{$name} ||= {}; for my $model ($node->findnodes("./*")) { my $n = $model->nodeName; my $v = $model->textContent; $result->{$name}->{$n} = $v; } } else { $result->{$name} = $value; } } return $result; } 1; Catmandu-FedoraCommons-Model-getDatastreamDissemination.t100644000765000024 31613375261174 31303 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/tuse strict; use warnings; use Test::More; use Test::Exception; my $pkg; BEGIN { $pkg = 'Catmandu::FedoraCommons::Model::getDatastreamDissemination'; use_ok $pkg; } require_ok $pkg; done_testing; getDatastreamDissemination.pm100644000765000024 116613375261174 32011 0ustar00hochstenstaff000000000000Catmandu-FedoraCommons-0.5/lib/Catmandu/FedoraCommons/Model=head1 NAME Catmandu::FedoraCommons::Model::getDatastreamDissemination - Perl model for the Fedora 'getDatastreamDissemination' or 'getDissemination' REST call =head1 SYNOPSIS use Catmandu::FedoraCommons; my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin'); my $obj = $fedora->purgeDatastream(pid => 'demo:29', dsID => 'TEST')->parse_content; Returns the bytes returned. =head1 SEE ALSO L =cut package Catmandu::FedoraCommons::Model::getDatastreamDissemination; sub parse { my ($class,$bytes) = @_; return $bytes; } 1;