1 package OpenSRF::DomainObject::oilsScalar;
2 use base 'OpenSRF::DomainObject';
3 use OpenSRF::DomainObject;
7 OpenSRF::DomainObject::oilsScalar
11 use OpenSRF::DomainObject::oilsScalar;
13 my $text = OpenSRF::DomainObject::oilsScalar->new( 'a string or number' );
14 $text->value( 'replacement value' );
15 print "$text"; # stringify
20 if( $text ) { # boolify
24 $text->value( rand() * 1000 );
25 print 10 + $text; # numify
27 Or, using the TIE interface:
30 my $real_object = tie($scalar, 'OpenSRF::DomainObject::oilsScalar', "a string to store...");
32 $scalar = "a new string";
34 print $real_object->toString . "\n";
38 =head2 OpenSRF::DomainObject::oilsScalar->value( [$new_value] )
42 Sets or gets the value of the scalar. As above, this can be specified
43 as a build attribute as well as added to a prebuilt oilsScalar object.
49 use overload '""' => sub { return ''.$_[0]->value };
50 use overload '0+' => sub { return int($_[0]->value) };
51 use overload '<=>' => sub { return int($_[0]->value) <=> $_[1] };
52 use overload 'bool' => sub { return 1 if ($_[0]->value); return 0 };
56 $class = ref($class) || $class;
61 if ( defined $value and
62 ref $value and $value->can('base_type') and
63 UNIVERSAL::isa($value->class, __PACKAGE__) and
67 my $self = $class->SUPER::new;
69 if (ref($value) and ref($value) eq 'SCALAR') {
70 $self->value($$value);
71 tie( $$value, ref($self->upcast), $self);
73 $self->value($value) if (defined $value);
80 return CORE::shift()->new(@_);
87 if ( defined $value ) {
88 $self->removeChild($_) for ($self->childNodes);
89 if (ref($value) && $value->isa('XML::LibXML::Node')) {
90 #throw OpenSRF::EX::NotADomainObject
91 # unless ($value->nodeName =~ /^oils:domainObject/o);
92 $self->appendChild($value);
93 } elsif (defined $value) {
94 $self->appendText( ''.$value );
99 $value = $self->firstChild;
101 if ($value->nodeType == 3) {
102 return $value->textContent;
111 sub FETCH { $_[0]->value }
112 sub STORE { $_[0]->value($_[1]) }
114 package OpenSRF::DomainObject::oilsPair;
115 use base 'OpenSRF::DomainObject::oilsScalar';
119 OpenSRF::DomainObject::oilsPair
123 use OpenSRF::DomainObject::oilsPair;
125 my $pair = OpenSRF::DomainObject::oilsPair->new( 'key_for_pair' => 'a string or number' );
127 $pair->key( 'replacement key' );
128 $pair->value( 'replacement value' );
130 print "$pair"; # stringify 'value'
136 if( $pair ) { # boolify
140 $pair->value( rand() * 1000 );
142 print 10 + $pair; # numify 'value'
146 This class impliments a "named pair" object. This is the basis for
147 hash-type domain objects.
151 =head2 OpenSRF::DomainObject::oilsPair->value( [$new_value] )
155 Sets or gets the value of the pair. As above, this can be specified
156 as a build attribute as well as added to a prebuilt oilsPair object.
160 =head2 OpenSRF::DomainObject::oilsPair->key( [$new_key] )
164 Sets or gets the key of the pair. As above, this can be specified
165 as a build attribute as well as added to a prebuilt oilsPair object.
166 This must be a perlish scalar; any string or number that is valid as the
167 attribute on an XML node will work.
173 use overload '""' => sub { return ''.$_[0]->value };
174 use overload '0+' => sub { return int($_[0]->value) };
175 use overload 'bool' => sub { return 1 if ($_[0]->value); return 0 };
179 my ($key, $value) = @_;
181 my $self = $class->SUPER::new($value);
182 $self->setAttribute( key => $key);
191 $self->setAttribute( key => $key) if ($key);
192 return $self->getAttribute( 'key' );
195 package OpenSRF::DomainObjectCollection::oilsArray;
196 use base qw/OpenSRF::DomainObjectCollection Tie::Array/;
197 use OpenSRF::DomainObjectCollection;
201 OpenSRF::DomainObjectCollection::oilsArray
205 use OpenSRF::DomainObject::oilsPrimitive;
207 my $collection = OpenSRF::DomainObjectCollection::oilsArray->new( $domain_object, $another_domain_object, ...);
209 $collection->push( 'appended value' );
210 $collection->unshift( 'prepended vaule' );
211 my $first = $collection->shift;
212 my $last = $collection->pop;
216 my @values = $collection->list;
218 Or, using the TIE interface:
221 my $real_object = tie(@array, 'OpenSRF::DomainObjectCollection::oilsArray', $domain, $objects, 'to', $store);
223 or to tie an existing $collection object
226 tie(@array, 'OpenSRF::DomainObjectCollection::oilsArray', $collection);
231 tie(@array, ref($collection), $collection);
234 $array[2] = $DomainObject; # replaces 'to' (which is now an OpenSRF::DomainObject::oilsScalar) above
235 delete( $array[3] ); # removes '$store' above.
236 my $size = scalar( @array );
238 print $real_object->toString;
242 This package impliments array-like domain objects. A full tie interface
243 is also provided. If elements are passed in as strings (or numbers) they
244 are turned into oilsScalar objects. Any simple scalar or Domain Object may
245 be stored in the array.
249 =head2 OpenSRF::DomainObjectCollection::oilsArray->list()
253 Returns the array of 'OpenSRF::DomainObject's that this collection contains.
261 $class = ref($class) || $class;
264 tie @array, $class, $node;
268 # an existing DomainObjectCollection::oilsArray can now be tied
270 return CORE::shift()->new(@_);
274 my $class = CORE::shift;
275 $class = ref($class) || $class;
277 my $first = CORE::shift;
280 if ( defined $first and
281 ref $first and $first->can('base_type') and
282 UNIVERSAL::isa($first->class, __PACKAGE__) and
286 my $self = $class->SUPER::new;
289 if (ref($first) and ref($first) eq 'ARRAY') {
291 tie( @$first, ref($self->upcast), $self);
293 unshift @args, $first if (defined $first);
296 $self->STORE($self->FETCHSIZE, $_) for (@args);
301 my $self = CORE::shift;
302 my ($index, $value) = @_;
304 $value = OpenSRF::DomainObject::oilsScalar->new($value)
305 unless ( ref $value and $value->nodeName =~ /^oils:domainObject/o );
307 $self->_expand($index) unless ($self->EXISTS($index));
309 ($self->childNodes)[$index]->replaceNode( $value );
311 return $value->upcast;
315 my $self = CORE::shift;
317 $self->STORE($self->FETCHSIZE, $_) for (@values);
321 my $self = CORE::shift;
322 my $node = $self->SUPER::pop;
324 if ($node->base_type eq 'oilsScalar') {
327 return $node->upcast;
332 my $self = CORE::shift;
334 $self->insertBefore($self->firstChild, $_ ) for (reverse @values);
338 my $self = CORE::shift;
339 my $node = $self->SUPER::shift;
341 if ($node->base_type eq 'oilsScalar') {
344 return $node->upcast;
349 my $self = CORE::shift;
350 my $index = CORE::shift;
351 my $node = ($self->childNodes)[$index]->upcast;
353 if ($node->base_type eq 'oilsScalar') {
356 return $node->upcast;
361 my $self = CORE::shift;
362 scalar($self->FETCHSIZE)
366 my $self = CORE::shift;
367 my @a = $self->childNodes;
372 my $self = CORE::shift;
373 my $count = CORE::shift;
374 my $size = $self->FETCHSIZE;
375 for ($size..$count) {
376 $self->SUPER::push( new OpenSRF::DomainObject::oilsScalar );
381 my $self = CORE::shift;
382 my $count = CORE::shift;
383 my $size = $self->FETCHSIZE - 1;
385 if (defined $count and $count != $size) {
386 if ($size < $count) {
387 $self->_expand($count);
388 $size = $self->FETCHSIZE - 1;
390 while ($size > $count) {
392 $size = $self->FETCHSIZE - 1;
401 my $self = CORE::shift;
402 my $index = CORE::shift;
403 return $self->FETCHSIZE > abs($index) ? 1 : 0;
407 my $self = CORE::shift;
413 my $self = CORE::shift;
414 my $index = CORE::shift;
415 return $self->removeChild( ($self->childNodes)[$index] );
418 package OpenSRF::DomainObjectCollection::oilsHash;
419 use base qw/OpenSRF::DomainObjectCollection Tie::Hash/;
423 OpenSRF::DomainObjectCollection::oilsHash
427 use OpenSRF::DomainObject::oilsPrimitive;
429 my $collection = OpenSRF::DomainObjectCollection::oilsHash->new( key1 => $domain_object, key2 => $another_domain_object, ...);
431 $collection->set( key =>'value' );
432 my $value = $collection->find( $key );
433 my $dead_value = $collection->remove( $key );
434 my @keys = $collection->keys;
435 my @values = $collection->values;
437 Or, using the TIE interface:
440 my $real_object = tie(%hash, 'OpenSRF::DomainObjectCollection::oilsHash', domain => $objects, to => $store);
442 or to tie an existing $collection object
445 tie(%hash, 'OpenSRF::DomainObjectCollection::oilsHash', $collection);
450 tie(%hash, ref($collection), $collection);
454 my $content = $session->recv->content; # eh? EH?!?!
455 tie(my %hash, ref($content), $content);
457 $hash{domain} = $DomainObject; # replaces value for key 'domain' above
458 delete( $hash{to} ); # removes 'to => $store' above.
459 for my $key ( keys %hash ) {
463 print $real_object->toString;
467 This package impliments hash-like domain objects. A full tie interface
468 is also provided. If elements are passed in as strings (or numbers) they
469 are turned into oilsScalar objects. Any simple scalar or Domain Object may
470 be stored in the hash.
478 $class = ref($class) || $class;
481 tie %hash, $class, $node;
488 return map { $_->key } $self->childNodes;
493 return map { $_->value } $self->childNodes;
496 # an existing DomainObjectCollection::oilsHash can now be tied
498 return shift()->new(@_);
503 $class = ref($class) || $class;
507 if ( defined $first and
508 ref $first and $first->can('base_type') and
509 UNIVERSAL::isa($first->class, __PACKAGE__) and
513 my $self = $class->SUPER::new;
516 if (ref($first) and ref($first) eq 'HASH') {
518 tie( %$first, ref($self->upcast), $self);
520 unshift @args, $first if (defined $first);
523 my %arg_hash = @args;
524 while ( my ($key, $value) = each(%arg_hash) ) {
525 $self->STORE($key => $value);
536 my ($key, $value) = @_;
538 my $node = $self->find_node($key);
540 return $node->value( $value ) if (defined $node);
541 return $self->appendChild( OpenSRF::DomainObject::oilsPair->new($key => $value) );
547 my $node = find_node($self, $key);
548 return $node->value if ($node);
554 return ($self->findnodes("oils:domainObject[\@name=\"oilsPair\" and \@key=\"$key\"]", $self))[0];
560 my $node = $self->find_node($key);
561 my $value = $node->value if (defined $node);
566 my $self = CORE::shift;
567 my @a = $self->childNodes;
574 return $self->find($key);
580 return $self->find_node($key);
585 $self->removeChild for ($self->childNodes);
596 return $self->removeChild( $self->find_node($key) );
601 return $self->firstChild->key;
607 my ($prev_node) = $self->find_node($key);
608 my $last_node = $self->lastChild;
610 if ($last_node and $last_node->key eq $prev_node->key) {
613 return $prev_node->nextSibling->key;
617 package OpenSRF::DomainObject::oilsHash;
618 use base qw/OpenSRF::DomainObjectCollection::oilsHash/;
620 package OpenSRF::DomainObject::oilsArray;
621 use base qw/OpenSRF::DomainObjectCollection::oilsArray/;