OpenSRF/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;