Initial revision
[OpenSRF.git] / 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;
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                 OpenSRF::Utils::Logger->error( $@ . $e);
47                 die $@;
48         };
49
50
51         my $node = OpenSRF::DOM::Element::domainObject::upcast($self);
52         OpenSRF::Utils::Logger->debug( "Autoloaded to: ".ref($node), INTERNAL );
53
54         return $node->$name(@_);
55 }
56
57 sub downcast {
58         my $obj = shift;
59         return bless $obj => 'XML::LibXML::Element';
60 }
61
62 sub upcast {
63         my $self = shift;
64         return bless $self => class($self);
65 }
66
67 sub new {
68         my $class = shift;
69         my $type = shift;
70         my $obj = $class->SUPER::new( name => $type );
71         while (@_) {
72                 my ($attr,$val) = (shift,shift);
73                 last unless ($attr and $val);
74                 $obj->addAttr( $attr, $val );
75                 #$obj->appendChild( OpenSRF::DOM::Element::domainObjectAttr->new($attr, $val) );
76         }
77         return $obj;
78 }
79
80 sub class {
81         my $self = shift;
82         return 'OpenSRF::DomainObject::'.$self->getAttribute('name');
83 }
84
85 sub base_type {
86         my $self = shift;
87         return $self->getAttribute('name');
88 }
89
90 sub addAttr {
91         my $self = shift;
92         $self->appendChild( $_ ) for OpenSRF::DOM::Element::domainObjectAttr->new(@_);
93         return $self;
94 }
95
96 sub attrNode {
97         my $self = shift;
98         my $type = shift;
99         return (grep { $_->getAttribute('name') eq $type } $self->getChildrenByTagName("oils:domainObjectAttr"))[0];
100 }
101
102 sub attrHash {
103         my $self = shift;
104         my %attrs = map { ( $_->getAttribute('name') => $_->getAttribute('value') ) } $self->getChildrenByTagName('oils:domainObjectAttr');
105
106         return \%attrs;
107 }
108
109 sub attrValue {
110         my $self = shift;
111         return $self->attrHash->{shift};
112 }
113
114 1;