Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / DOM / Element / domainObjectCollection.pm
1 package OpenSRF::DOM::Element::domainObjectCollection;
2 use base 'OpenSRF::DOM::Element';
3 use OpenSRF::DOM::Element::domainObjectAttr;
4 use OpenSRF::EX;
5
6 sub AUTOLOAD {
7         my $self = CORE::shift;
8         (my $name = $AUTOLOAD) =~ s/.*://;   # strip fully-qualified portion
9
10         return  class($self) if ($name eq 'class');
11
12         my @args = @_;
13         my $meth = class($self).'::'.$name;
14
15         ### Check for recursion
16         my $calling_method = (caller(1))[3];
17         my @info = caller(1);
18
19         if( @info ) {
20                 if ($info[0] =~ /AUTOLOAD/) { @info = caller(2); }
21         }
22         unless( @info ) { @info = caller(); }
23                 if( $calling_method  and $calling_method eq "OpenSRF::DOM::Element::domainObjectCollection::AUTOLOAD" ) {
24                 throw OpenSRF::EX::PANIC ( "RECURSION! Caller [ @info ] | Object [ ".ref($self)." ]\n ** Trying to call $name", ERROR );
25         }
26         ### Check for recursion
27
28         try {
29                 return $self->$meth(@args);;
30         } catch Error with {
31                 my $e = shift;
32                 OpenSRF::Utils::Logger->error( $@ . $e);
33                 die $@;
34         };
35
36         return upcast($self)->$name(@_);
37 }
38
39 sub downcast {
40         my $obj = CORE::shift;
41         return bless $obj => 'XML::LibXML::Element';
42 }
43
44 sub upcast {
45         my $self = CORE::shift;
46         return bless $self => class($self);
47 }
48
49 sub new {
50         my $class = CORE::shift;
51         my $type = CORE::shift;
52         my $obj = $class->SUPER::new( name => $type );
53         while ( my $val = shift) {
54                 throw OpenSRF::EX::NotADomainObject
55                         if (ref $val and $val->nodeName !~ /^oils:domainObject/o);
56                 $obj->appendChild( $val );
57         }
58         return $obj;
59 }
60
61 sub class {
62         my $self = shift;
63         return 'OpenSRF::DomainObjectCollection::'.$self->getAttribute('name');
64 }
65
66 sub base_type {
67         my $self = shift;
68         return $self->getAttribute('name');
69 }
70
71 sub pop { 
72         my $self = CORE::shift;
73         return $self->removeChild( $self->lastChild )->upcast;
74 }
75
76 sub push { 
77         my $self = CORE::shift;
78         my @args = @_;
79         for my $node (@args) {
80                 #throw OpenSRF::EX::NotADomainObject ( "$_ must be a oils:domainOjbect*, it's a ".$_->nodeName )
81                 #       unless ($_->nodeName =~ /^oils:domainObject/o);
82                 
83                 unless ($node->nodeName =~ /^oils:domainObject/o) {
84                         $node = OpenSRF::DomainObject::oilsScalar->new($node);
85                 }
86
87                 $self->appendChild( $node );
88         }
89 }
90
91 sub shift { 
92         my $self = CORE::shift;
93         return $self->removeChild( $self->firstChild )->upcast;
94 }
95
96 sub unshift { 
97         my $self = CORE::shift;
98         my @args = @_;
99         for (reverse @args) {
100                 throw OpenSRF::EX::NotADomainObject
101                         unless ($_->nodeName =~ /^oils:domainObject/o);
102                 $self->insertBefore( $_, $self->firstChild );
103         }
104 }
105
106 sub first {
107         my $self = CORE::shift;
108         return $self->firstChild->upcast;
109 }
110
111 sub list {
112         my $self = CORE::shift;
113         return map {(bless($_ => 'OpenSRF::DomainObject::'.$_->getAttribute('name')))} $self->childNodes;
114 }
115
116 1;