src/perlmods/OpenSRF/DOM/Element/domainObject.pm

   1 package OpenSRF::DOM::Element::domainObject;
   2 use strict; use warnings;
   3 use base 'OpenSRF::DOM::Element';
   4 use OpenSRF::DOM;
   5 use OpenSRF::DOM::Element::domainObjectAttr;
   6 use OpenSRF::Utils::Logger qw(:level);
   7 use OpenSRF::EX qw(:try);
   8 use Carp;
   9 #use OpenSRF::DomainObject::oilsPrimitive;
  10 #use OpenSRF::DomainObject::oilsResponse;
  11 use vars qw($AUTOLOAD);
  12
  13 sub AUTOLOAD {
  14         my $self = shift;
  15         (my $name = $AUTOLOAD) =~ s/.*://;   # strip fully-qualified portion
  16
  17         return class($self) if ($name eq 'class');
  18         if ($self->can($name)) {
  19                 return $self->$name(@_);
  20         }
  21
  22         if (1) {
  23                 ### Check for recursion
  24                 my $calling_method = (caller(1))[3];
  25                 my @info = caller(1);
  26
  27                 if( @info ) {
  28                         if ($info[0] =~ /AUTOLOAD/) { @info = caller(2); }
  29                 }
  30                 unless( @info ) { @info = caller(); }
  31
  32                 if( $calling_method  and $calling_method eq "OpenSRF::DOM::Element::domainObject::AUTOLOAD" ) {
  33                         warn Carp::cluck;
  34                         throw OpenSRF::EX::PANIC ( "RECURSION! Caller [ @info[0..2] ] | Object [ ".ref($self)." ]\n ** Trying to call $name", ERROR );
  35                 }
  36                 ### Check for recursion
  37         }
  38
  39         my @args = @_;
  40         my $meth = class($self).'::'.$name;
  41
  42         try {
  43                 return $self->$meth(@args);
  44         } catch Error with {
  45                 my $e = shift;
  46                 if( $e ) {
  47                         OpenSRF::Utils::Logger->error( $@ . $e);
  48                 } else {
  49                         OpenSRF::Utils::Logger->error( $@ );
  50                 }
  51                 die $@;
  52         };
  53
  54
  55         my $node = OpenSRF::DOM::Element::domainObject::upcast($self);
  56         OpenSRF::Utils::Logger->debug( "Autoloaded to: ".ref($node), INTERNAL );
  57
  58         return $node->$name(@_);
  59 }
  60
  61 sub downcast {
  62         my $obj = shift;
  63         return bless $obj => 'XML::LibXML::Element';
  64 }
  65
  66 sub upcast {
  67         my $self = shift;
  68         return bless $self => class($self);
  69 }
  70
  71 sub new {
  72         my $class = shift;
  73         my $type = shift;
  74         my $obj = $class->SUPER::new( name => $type );
  75         while (@_) {
  76                 my ($attr,$val) = (shift,shift);
  77                 last unless ($attr and $val);
  78                 $obj->addAttr( $attr, $val );
  79                 #$obj->appendChild( OpenSRF::DOM::Element::domainObjectAttr->new($attr, $val) );
  80         }
  81         return $obj;
  82 }
  83
  84 sub class {
  85         my $self = shift;
  86         return 'OpenSRF::DomainObject::'.$self->getAttribute('name');
  87 }
  88
  89 sub base_type {
  90         my $self = shift;
  91         return $self->getAttribute('name');
  92 }
  93
  94 sub addAttr {
  95         my $self = shift;
  96         $self->appendChild( $_ ) for OpenSRF::DOM::Element::domainObjectAttr->new(@_);
  97         return $self;
  98 }
  99
 100 sub attrNode {
 101         my $self = shift;
 102         my $type = shift;
 103         return (grep { $_->getAttribute('name') eq $type } $self->getChildrenByTagName("oils:domainObjectAttr"))[0];
 104 }
 105
 106 sub attrHash {
 107         my $self = shift;
 108         my %attrs = map { ( $_->getAttribute('name') => $_->getAttribute('value') ) } $self->getChildrenByTagName('oils:domainObjectAttr');
 109
 110         return \%attrs;
 111 }
 112
 113 sub attrValue {
 114         my $self = shift;
 115         return $self->attrHash->{shift};
 116 }
 117
 118 1;