File Coverage

blib/lib/Catmandu/FedoraCommons/Model/listMethods.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::listMethods - Perl model for the Fedora 'listMethods' 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->listMethods(pid => 'demo:29')->parse_content;
12            
13             {
14             'pid' => 'demo:29' ,
15             'baseURL' => 'http://localhost:8080/fedora/' ,
16             'sDef' => [
17             {
18             'pid' => 'demo:27',
19             'method' => [
20             {
21             'name' => 'resizeImage' ,
22             'methodParm' => [
23             {
24             'parmDefaultValue' => '150',
25             'parmLabel' => 'fix me',
26             'parmRequired' => 'true',
27             'parmName' => 'width'
28             }
29             ],
30             },
31             ]
32             }
33             ]
34             }
35            
36             =head1 SEE ALSO
37              
38             L<Catmandu::FedoraCommons>
39              
40             =cut
41             package Catmandu::FedoraCommons::Model::listMethods;
42              
43 1     1   77186 use XML::LibXML;
  0            
  0            
44              
45             sub parse {
46             my ($class,$xml) = @_;
47             my $dom = XML::LibXML->load_xml(string => $xml);
48             $dom->getDocumentElement()->setNamespace('http://www.fedora.info/definitions/1/0/access/','a');
49              
50             my @nodes = $dom->findnodes("/a:objectMethods/*");
51            
52             my $result;
53            
54             for my $node (@nodes) {
55             my @attributes = $node->attributes();
56             my %values = map { $_->getName() , $_->getValue() } @attributes;
57            
58             my $sDef = \%values;
59            
60             for my $method ($node->findnodes("./a:method")) {
61             my $name = $method->getAttribute('name');
62             my $m = { name => $name };
63            
64             for my $param ($method->findnodes("./a:methodParm")) {
65             my @attributes = $param->attributes();
66             my %values = map { $_->getName() , $_->getValue() } @attributes;
67            
68             for my $domain ($param->findnodes("./a:methodParmDomain/a:methodParmValue")) {
69             my $value = $domain->textContent;
70             push @{ $values{methodParmValue}} , $value;
71             }
72            
73             push @{ $m->{methodParm} } , \%values;
74             }
75            
76             push @{ $sDef->{method} } , $m;
77             }
78            
79             push @{ $result->{sDef} }, $sDef;
80             }
81            
82             my $pid = $dom->firstChild()->getAttribute('pid');
83             $result->{pid} = $pid;
84              
85             my $baseURL = $dom->firstChild()->getAttribute('baseURL');
86             $result->{baseURL} = $baseURL;
87            
88             return $result;
89             }
90              
91             1;