lib/MOBY/Client/SecondaryArticle.pm

   1 package MOBY::Client::SecondaryArticle;
   2 use strict;
   3 use Carp;
   4 use XML::LibXML;
   5 use MOBY::MobyXMLConstants;
   6 use vars qw($AUTOLOAD @ISA);
   7
   8 =head1 NAME
   9
  10 MOBY::Client::SecondaryArticle - a small object describing the Simple articles from the findService Response message of MOBY Central
  11
  12 =head1 SYNOPSIS
  13
  14 experimental and untested - please do NOT use in your code
  15
  16 =cut
  17
  18 =head1 DESCRIPTION
  19
  20
  21 =head1 AUTHORS
  22
  23 Mark Wilkinson (markw at illuminae dot com)
  24
  25 =head1 METHODS
  26
  27
  28 =head2 new
  29
  30  Usage     :    my $SA = MOBY::Client::SecondaryArticle->new(%args)
  31  Function  :    create SecondaryArticle object
  32  Returns   :    MOBY::Client::SecondaryArticle object
  33  Args      :    articleName => "NameOfArticle"
  34                 datatype => Integer|Float|String|DateTime,
  35                 default => $some_default_value,
  36                 max => $maximum_value,
  37                 min => $minimum_value,
  38                 enum => \@valid_values
  39                 XML_DOM => $XML_DOM node of the Secondary article (optional)
  40                 XML  => $XML XML string representing the Secondary article (optional)
  41
  42 =head2 articleName
  43
  44  Usage     :    $name = $SA->articleName($name)
  45  Function  :    get/set articleName
  46  Returns   :    string
  47  Arguments :    (optional) string representing articleName to set
  48
  49 =head2 objectType
  50
  51  Usage     :    $type = $SA->objectType($type)
  52  Function  :    get/set name
  53  Returns   :    string
  54  Arguments :    (optional) string representing objectType to set
  55
  56 =head2 namespaces
  57
  58  Usage     :    $namespaces = $SA->namespaces(\@namespaces)
  59  Function  :    get/set namespaces for the objectType
  60  Returns   :    arrayref of namespace strings
  61  Arguments :    (optional) arrayref of namespace strings to set
  62
  63 =head2 XML
  64
  65  Usage     :   $SA = $SA->XML($XML)
  66  Function  :    set/reset all parameters for this object from the XML
  67  Returns   :    MOBY::Client::SecondaryArticle
  68  Arguments :    (optional) XML fragment from and including <Simple>...</Simple>
  69
  70 =head2 XML_DOM
  71
  72  Usage     :    $namespaces = $SA->XML_DOM($XML_DOM_NODE)
  73  Function  :    set/reset all parameters for this object from the XML::DOM node for <Simple>
  74  Returns   :    MOBY::Client::SecondaryArticle
  75  Arguments :    (optional) an $XML::DOM node from the <Simple> article of a DOM
  76
  77 =head2 isSecondary
  78
  79  Usage     :    $boolean = $IN->isSecondary()
  80  Function  :    is this a SecondaryArticle type? (yes, I know this is obvious)
  81  Returns   :    1 (true)
  82
  83 =head2 isSimple
  84
  85  Usage     :    $boolean = $IN->isSimple()
  86  Function  :    is this a SimpleArticle type
  87  Returns   :    0 (false)
  88
  89 =head2 isCollection
  90
  91  Usage     :    $boolean = $IN->isCollection()
  92  Function  :    is this a CollectionArticle type
  93  Returns   :    0 for false
  94
  95 =cut
  96
  97 {
  98
  99         # Encapsulated:
 100         # DATA
 101         #___________________________________________________________
 102         #ATTRIBUTES
 103         my %_attr_data =    #  DEFAULT          ACCESSIBILITY
 104           (
 105                 articleName  => [ undef, 'read/write' ],
 106                 objectType   => [ undef, 'read/write' ],
 107                 namespaces   => [ [], 'read/write' ],
 108                 XML_DOM      => [ undef, 'read/write' ],
 109                 XML          => [ undef, 'read/write' ],
 110                 isSecondary  => [ 1,     'read' ],
 111                 isSimple     => [ 0,     'read' ],
 112                 isCollection => [ 0,     'read' ],
 113                 datatype     => [ undef, 'read/write' ],
 114                 default      => [ undef, 'read/write' ],
 115                 max          => [ undef, 'read/write' ],
 116                 min          => [ undef, 'read/write' ],
 117                 enum         => [ undef, 'read/write' ],
 118                 value        => [ undef, 'read/write' ],
 119           );
 120
 121         #_____________________________________________________________
 122         # METHODS, to operate on encapsulated class data
 123         # Is a specified object attribute accessible in a given mode
 124         sub _accessible {
 125                 my ( $self, $attr, $mode ) = @_;
 126                 $_attr_data{$attr}[1] =~ /$mode/;
 127         }
 128
 129         # Classwide default value for a specified object attribute
 130         sub _default_for {
 131                 my ( $self, $attr ) = @_;
 132                 $_attr_data{$attr}[0];
 133         }
 134
 135         # List of names of all specified object attributes
 136         sub _standard_keys {
 137                 keys %_attr_data;
 138         }
 139
 140         sub addEnum {
 141           # No return value necessary
 142           my ( $self, $enum ) = @_;
 143           $self->{enum} = [] unless $self->{enum};
 144           return() unless defined ($enum);
 145           push @{ $self->{enum} }, $enum;
 146         }
 147 }
 148
 149 sub new {
 150   my ( $caller, %args ) = @_;
 151   my $caller_is_obj = ref( $caller );
 152   return $caller if $caller_is_obj;
 153   my $class = $caller_is_obj || $caller;
 154   my $proxy;
 155   my $self = bless {}, $class;
 156   foreach my $attrname ( $self->_standard_keys ) {
 157     if ( exists $args{$attrname} ) {
 158       $self->{$attrname} = $args{$attrname};
 159     } elsif ( $caller_is_obj ) {
 160       $self->{$attrname} = $caller->{$attrname};
 161     } else {
 162       $self->{$attrname} = $self->_default_for( $attrname );
 163     }
 164   }
 165   $self->{enum} = [] unless $self->enum;
 166   if ( $self->XML && ref( $self->XML ) ) {
 167     return 0;
 168   } elsif ( $self->XML_DOM && !( ref( $self->XML_DOM ) =~ /libxml/i ) ) {
 169     return 0;
 170   }
 171   $self->createFromXML                   if ( $self->XML );
 172   $self->createFromDOM( $self->XML_DOM ) if ( $self->XML_DOM );
 173   return $self;
 174 }
 175
 176 sub createFromXML {
 177         my ( $self ) = @_;
 178         my $p        = XML::LibXML->new;
 179         my $doc      = $p->parse_string( $self->XML );
 180         my $root     = $doc->getDocumentElement;
 181         return 0 unless ( $root && ( $root->nodeName eq "Parameter" ) );
 182         return $self->createFromDOM( $root );
 183 }
 184
 185 sub createFromDOM {
 186         my ( $self, $dom ) = @_;
 187         return 0 unless ( $dom && ( $dom->nodeName eq "Parameter" ) );
 188         $self->XML( $dom->toString );    # set the string version of the DOM
 189         $self->namespaces( [] );         # reset!
 190         $self->articleName( "" );
 191         $self->objectType( "" );
 192         my $attr        = $dom->getAttributeNode( 'articleName' );
 193         $self->articleName( $attr ? $attr->getValue : "" );
 194         if ( @{ $dom->getElementsByTagName( 'Value' ) }[0] ) {
 195           return $self->_createInstantiatedArticle( $dom );
 196         } else {
 197           return $self->_createTemplateArticle( $dom );
 198         }
 199 }
 200
 201 sub _createTemplateArticle {
 202   my ( $self, $dom ) = @_;
 203
 204   #datatype    => [undef,          'read/write'      ],
 205   #default     => [undef,          'read/write'      ],
 206   #max         => [undef,          'read/write'      ],
 207   #min         => [undef,          'read/write'      ],
 208   #enum        => [[],          'read/write'      ],
 209   my @single_valued = qw/datatype default max min/;
 210   my $objects;
 211   foreach my $param (@single_valued) {
 212     $objects = $dom->getElementsByTagName( $param );
 213     if ( $objects->get_node( 1 ) ) {
 214       my $data;
 215       foreach my $child ( $objects->get_node( 1 )->childNodes ) {
 216         next unless $child->nodeType == TEXT_NODE;
 217         $data .= $child->toString;
 218         $data =~ s/\s//g;       # Trim all whitespace
 219       }
 220       $self->$param( $data );
 221     }
 222   }
 223   # Since it is (array)multi-valued, 'enum' is a little different from the others.
 224   $objects = $dom->getElementsByTagName( "enum" );
 225   if ( $objects->get_node( 1 ) ) {
 226     foreach ( 1 .. $objects->size() ) {
 227       foreach my $child ( $objects->get_node( $_ )->childNodes ) {
 228         my $val;
 229         next unless $child->nodeType == TEXT_NODE;
 230         $val = $child->toString;
 231         next unless defined( $val );
 232         # Trim space from front and back, but leave alone in middle....?
 233         $val =~ s/^\s//;
 234         $val =~ s/\s$//;
 235         $self->addEnum( $val );
 236       }
 237     }
 238   }
 239   return $self;
 240 }
 241
 242 sub _createInstantiatedArticle {
 243   my ( $self, $dom ) = @_;
 244
 245   #<Parameter articleName='foo'><Value>43764</Value></Parameter>
 246   my $values = $dom->getElementsByTagName( 'Value' );
 247   $self->value( "" ); # Initialize to 1) avoid Perl warnings 2) be good.
 248   foreach my $child ( $values->get_node( 1 )->childNodes ) {
 249     next unless $child->nodeType == TEXT_NODE;
 250     # Would we *really* want to catenate values like this?
 251     $self->value( $self->value . $child->toString );
 252   }
 253 }
 254
 255 sub AUTOLOAD {
 256         no strict "refs";
 257         my ( $self, $newval ) = @_;
 258         $AUTOLOAD =~ /.*::(\w+)/;
 259         my $attr = $1;
 260         if ( $self->_accessible( $attr, 'write' ) ) {
 261                 *{$AUTOLOAD} = sub {
 262                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 263                         return $_[0]->{$attr};
 264                 };    ### end of created subroutine
 265 ###  this is called first time only
 266                 if ( defined $newval ) {
 267                         $self->{$attr} = $newval;
 268                 }
 269                 return $self->{$attr};
 270         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 271                 *{$AUTOLOAD} = sub {
 272                         return $_[0]->{$attr};
 273                 };    ### end of created subroutine
 274                 return $self->{$attr};
 275         }
 276
 277         # Must have been a mistake then...
 278         croak "No such method: $AUTOLOAD";
 279 }
 280 sub DESTROY { }
 281 1;