File Coverage

blib/lib/Catmandu/FedoraCommons/Model/getObjectProfile.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Catmandu::FedoraCommons::Model::getObjectProfile - Perl model for the Fedora 'getObjectProfile' REST call
4              
5             =head1 SYNOPSIS
6              
7             use Catmandu::FedoraCommons;
8            
9             my $fedora = Catmandu::FedoraCommons->new('http://localhost:8080/fedora','fedoraAdmin','fedoraAdmin');
10            
11             my $obj = $fedora->getObjectProfile(pid => 'demo:29')->parse_content;
12            
13             {
14             'pid' => 'demo:29' ,
15             'objLabel' => 'Data Object for Image Manipulation Demo' ,
16             'objOwnerId' => 'fedoraAdmin' ,
17             'objCreateDate' => '2008-07-02T05:09:42.015Z' ,
18             'objLastModDate' => '2013-02-07T19:57:27.140Z' ,
19             'objDissIndexViewURL' => 'http://localhost:8080/fedora/objects/demo%3A29/methods/fedora-system%3A3/viewMethodIndex' ,
20             'objItemIndexViewURL' => 'http://localhost:8080/fedora/objects/demo%3A29/methods/fedora-system%3A3/viewItemIndex' ,
21             'objState' => 'I' ,
22             'objModels' => [
23             'info:fedora/fedora-system:FedoraObject-3.0' ,
24             'info:fedora/demo:UVA_STD_IMAGE' ,
25             ],
26             }
27            
28             =head1 SEE ALSO
29              
30             L<Catmandu::FedoraCommons>
31              
32             =cut
33             package Catmandu::FedoraCommons::Model::getObjectProfile;
34              
35 1     1   49454 use XML::LibXML;
  0            
  0            
36              
37             sub parse {
38             my ($class,$xml) = @_;
39             my $dom = XML::LibXML->load_xml(string => $xml);
40             $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a');
41              
42             my @nodes = $dom->findnodes("/a:objectProfile/*");
43              
44             my $result = {};
45              
46             for my $node (@nodes) {
47             my $name = $node->nodeName;
48             my $value = $node->textContent;
49            
50             if ($name eq 'objModels') {
51             for my $model ($node->findnodes("./*")) {
52             my $name = $model->nodeName;
53             my $value = $model->textContent;
54            
55             push @{ $result->{objModels} } , $value;
56             }
57             }
58             else {
59             $result->{$name} = $value;
60             }
61             }
62            
63             my $pid = $dom->firstChild()->getAttribute('pid');
64             $result->{pid} = $pid;
65              
66             return $result;
67             }
68              
69             1;