lib/MOBY/Client/SimpleArticle.pm

   1 package MOBY::Client::SimpleArticle;
   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::SimpleArticle - a small object describing the Simple articles from the findService Response message of MOBY Central
  11
  12 =head1 SYNOPSIS
  13
  14 experimental - please do not use in your code
  15
  16 =cut
  17
  18 =head1 DESCRIPTION
  19
  20 This describes the Simple articles from either the findService Response of MOBY Central
  21 (i.e. the description of the service), or Simple articles
  22 as provided in a service invocation or response message
  23 (i.e. simple articles containing data)
  24
  25 Basically it parses the following part of a findService response:
  26
  27 <Simple articleName='foo'>
  28     <objectType>someNbject</objectType>
  29     <Namespace>someNamespace</Namespace>
  30     <Namespace>someNamespace2</Namespace>
  31 </Simple>
  32
  33 OR  it parses the following part of a service invocation or response message:
  34
  35 <Simple articleName='foo'>
  36     <SomeObject namespace='someNamespace' id='someID'>.....</SomeObject>
  37 </Simple>
  38
  39 The articleName is retrieved with ->articleName
  40 The namespace(s) are retrieved with ->namespaces
  41 The objectType is retrieved with ->objectType
  42 the id (if instantiated) is retrieved with ->id
  43
  44
  45 =head1 AUTHORS
  46
  47 Mark Wilkinson (markw at illuminae dot com)
  48
  49 =cut
  50
  51 =head1 METHODS
  52
  53
  54 =head2 new
  55
  56  Usage     :    my $SA = MOBY::Client::SimpleArticle->new(%args)
  57  Function  :    create SimpleArticle object
  58  Returns   :    MOBY::Client::SimpleArticle object
  59  Args      :    either of the following two methods may be used to auto-generate the
  60                 object by passing the appropriate XML node as a string, or XML::DOM node object
  61
  62                 XML => $XML
  63                 XML_DOM => $XML::DOM::NODE
  64
  65
  66
  67 =head2 articleName
  68
  69  Usage     :    $name = $SA->articleName($name)
  70  Function  :    get/set articleName
  71  Returns   :    string
  72  Arguments :    (optional) string representing articleName to set
  73
  74 =head2 objectType
  75
  76  Usage     :    $type = $SA->objectType($type)
  77  Function  :    get/set name
  78  Returns   :    string
  79  Arguments :    (optional) string representing objectType to set
  80
  81 =head2 objectLSID
  82
  83  Usage     :    $type = $SA->objectLSID($type)
  84  Function  :    get/set LSID
  85  Returns   :    string
  86  Arguments :    (optional) string representing objectLSID to set
  87
  88
  89 =head2 namespaces
  90
  91  Usage     :    $namespaces = $SA->namespaces(\@namespaces)
  92  Function  :    get/set namespaces for the objectType
  93  Returns   :    arrayref of namespace strings
  94  Arguments :    (optional) arrayref of namespace strings to set
  95
  96
  97 =head2 XML
  98
  99  Usage     :   $SA = $SA->XML($XML)
 100  Function  :    set/reset all parameters for this object from the XML
 101  Returns   :    MOBY::Client::SimpleArticle
 102  Arguments :    (optional) XML fragment from and including <Simple>...</Simple>
 103
 104 =head2 XML_DOM
 105
 106  Usage     :    $namespaces = $SA->XML_DOM($XML_DOM_NODE)
 107  Function  :    set/reset all parameters for this object from the XML::DOM node for <Simple>
 108  Returns   :    MOBY::Client::SimpleArticle
 109  Arguments :    (optional) an $XML::DOM node from the <Simple> article of a DOM
 110
 111
 112 =head2 addNamespace
 113
 114  Usage     :    $namespaces = $IN->addNamespace($namespace)
 115  Function  :    add another namespace for the objectType
 116  Returns   :    namespace string
 117
 118 =head2 isSimple
 119
 120  Usage     :    $boolean = $IN->isSimple()
 121  Function  :    is this a SimpleArticle type
 122                 (yes, I know this is obvious, but since you can
 123                  get both Simple and Collection objects in your
 124                  Input and output lists, it is good to be able
 125                  to test what you have in-hand)
 126  Returns   :    1 (true)
 127
 128
 129 =head2 isCollection
 130
 131  Usage     :    $boolean = $IN->isCollection()
 132  Function  :    is this a CollectionArticle type
 133                 (yes, I know this is obvious, but since you can
 134                  get both Simple and Collection objects in your
 135                  Input and output lists, it is good to be able
 136                  to test what you have in-hand)
 137  Returns   :    0 for false
 138
 139 =head2 isSecondary
 140
 141  Usage     :    $boolean = $IN->isSecondary()
 142  Function  :    is this a SecondaryArticle type?
 143                 (yes, I know this is obvious)
 144  Returns   :    0 (true)
 145
 146 =cut
 147
 148 {
 149
 150         # Encapsulated:
 151         # DATA
 152         #___________________________________________________________
 153         #ATTRIBUTES
 154         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
 155           (
 156                 articleName => [ undef, 'read/write' ],
 157                 objectType  => [ undef, 'read/write' ],
 158                 objectLSID  => [ undef, 'read/write' ],
 159                 namespaces => [ [], 'read/write' ],
 160                 id           => [ undef, 'read/write' ],
 161                 XML_DOM      => [ undef, 'read/write' ],
 162                 XML          => [ undef, 'read/write' ],
 163                 isSecondary  => [ 0,     'read' ],
 164                 isSimple     => [ 1,     'read' ],
 165                 isCollection => [ 0,     'read' ],
 166           );
 167
 168         #_____________________________________________________________
 169         # METHODS, to operate on encapsulated class data
 170         # Is a specified object attribute accessible in a given mode
 171         sub _accessible {
 172                 my ( $self, $attr, $mode ) = @_;
 173                 $_attr_data{$attr}[1] =~ /$mode/;
 174         }
 175
 176         # Classwide default value for a specified object attribute
 177         sub _default_for {
 178                 my ( $self, $attr ) = @_;
 179                 $_attr_data{$attr}[0];
 180         }
 181
 182         # List of names of all specified object attributes
 183         sub _standard_keys {
 184                 keys %_attr_data;
 185         }
 186
 187         sub addNamespace {
 188                 my ( $self, $ns ) = @_;
 189                 return $self->{namespaces} unless $ns;
 190                 push @{ $self->{namespaces} }, $ns;
 191                 return $self->{namespaces};
 192         }
 193 }
 194
 195 sub new {
 196   my ( $caller, %args ) = @_;
 197   my $caller_is_obj = ref( $caller );
 198   return $caller if $caller_is_obj;
 199   my $class = $caller_is_obj || $caller;
 200   my $proxy;
 201   my $self = bless {}, $class;
 202   foreach my $attrname ( $self->_standard_keys ) {
 203     if ( exists $args{$attrname} ) {
 204       $self->{$attrname} = $args{$attrname};
 205     } elsif ( $caller_is_obj ) {
 206       $self->{$attrname} = $caller->{$attrname};
 207     } else {
 208       $self->{$attrname} = $self->_default_for( $attrname );
 209     }
 210   }
 211   if ( $self->XML && ref( $self->XML ) ) {
 212     return 0;
 213   } elsif ( $self->XML_DOM && !( ref( $self->XML_DOM ) =~ /XML\:\:LibXML/ ) ) {
 214     return 0;
 215   }
 216
 217   $self->createFromXML                   if ( $self->XML );
 218   $self->createFromDOM( $self->XML_DOM ) if ( $self->XML_DOM );
 219   return $self;
 220 }
 221
 222 sub createFromXML {
 223   my ( $self ) = @_;
 224   my $p        = XML::LibXML->new;
 225   my $doc      = $p->parse_string( $self->XML );
 226   my $root     = $doc->getDocumentElement;
 227   return 0 unless ( $root && ( $root->nodeName eq "Simple" ) );
 228   return $self->createFromDOM( $root );
 229 }
 230
 231 sub createFromDOM {
 232   my ( $self, $dom ) = @_;
 233   return 0 unless ( $dom && ( $dom->nodeName eq "Simple" ) );
 234   $self->namespaces( [] );         # reset!
 235   $self->articleName( "" );
 236   $self->objectType( "" );
 237   my $attr = $dom->getAttributeNode( 'articleName' );
 238   my $articleName = $attr ? $attr->getValue : "";
 239   $attr = $dom->getAttributeNode( 'lsid' );
 240   my $lsid = $attr ? $attr->getValue : "";
 241
 242   $self->articleName( $articleName )
 243     if $articleName; # it may have already been set if this Simple is part of a Collection...
 244   $self->objectLSID( $lsid) if $lsid;
 245
 246   # fork here - it may be an instantiated object (coming from a service invocation/response)
 247   # or it may be a template object as in the SimpleArticle element of a registration call
 248   # if the objectType tag exists, then it is a template object
 249   if ( @{ $dom->getElementsByTagName( "objectType" ) }[0] ) {
 250     return $self->_createTemplateArticle( $dom );
 251   } else {
 252     return $self->_createInstantiatedArticle( $dom );
 253   }
 254   # otherwise it should simpy contain an instantiated MOBY object
 255 }
 256
 257 sub _createInstantiatedArticle {
 258         my ( $self, $dom ) = @_;
 259
 260         # this will take a <Simple> node from a MOBY invocation message
 261         # and extract the object-type and namespace from the
 262         # contained data object
 263         foreach my $child ( $dom->childNodes )
 264         { # there should be only one child node, and that is the data object itself; ignore whitespace
 265                 next unless $child->nodeType == ELEMENT_NODE;
 266                 $self->objectType( $child->nodeName );
 267                 my $attr = $child->getAttributeNode( 'namespace' );
 268                 $self->addNamespace( $attr->getValue ) if $attr;
 269                 my $id = $child->getAttributeNode( 'id' );
 270                 $self->id( $id->getValue ) if $id;
 271         }
 272         return $self;
 273 }
 274
 275 sub _createTemplateArticle {
 276         my ( $self, $dom ) = @_;
 277
 278         # this will take a <Simple> node from a MOBY findServiceResponse
 279         # message and extract the objectType and namespace array
 280         # from the service signature.
 281         my $objects = $dom->getElementsByTagName( "objectType" );
 282         foreach my $child ( $objects->get_node( 1 )->getChildNodes )
 283         {    # there must be only one in a simple!  so take first element
 284                 next unless $child->nodeType == TEXT_NODE;
 285                 $self->objectType( $child->toString );
 286         }
 287         $objects = $dom->getElementsByTagName( "Namespace" );
 288         foreach ( 1 .. $objects->size() ) {
 289                 foreach my $child ( $objects->get_node( $_ )->childNodes )
 290                 {    # there must be only one in a simple!  so take element 0
 291                         next unless $child->nodeType == TEXT_NODE;
 292                         next unless $child->toString;
 293                         $self->addNamespace( $child->toString );
 294                 }
 295         }
 296         return $self;
 297 }
 298
 299 sub value {
 300         my ( $self ) = @_;
 301
 302         # ?????  what to do here ????
 303 }
 304
 305 sub AUTOLOAD {
 306   # It seems desirable that if the XML() method is called, the XML should be parsed, rather than just being
 307   no strict "refs";
 308   my ( $self, $newval ) = @_;
 309   $AUTOLOAD =~ /.*::(\w+)/;
 310   my $attr = $1;
 311   if ( $self->_accessible( $attr, 'write' ) ) {
 312     *{$AUTOLOAD} = sub {
 313       if ( defined $_[1] ) { $_[0]->{$attr} = $_[1]; }
 314       return $_[0]->{$attr};
 315     };    ### end of created subroutine
 316     ###  this is called first time only
 317     if ( defined $newval ) {
 318       $self->{$attr} = $newval;
 319     }
 320     return $self->{$attr};
 321   } elsif ( $self->_accessible( $attr, 'read' ) ) {
 322     *{$AUTOLOAD} = sub {
 323       return $_[0]->{$attr};
 324     };    ### end of created subroutine
 325     return $self->{$attr};
 326   }
 327
 328   # Must have been a mistake then...
 329   croak "No such method: $AUTOLOAD";
 330 }
 331 sub DESTROY { }
 332 1;