Object.pm revision c227543f6890bd6f2054360ec1820bfef8132431
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele# Copyright (c) 2002, 2008, Oracle and/or its affiliates. All rights reserved.
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen# Object.pm contains perl code for exacct object manipulation.
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenrequire 5.8.4;
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabeleuse strict;
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabeleuse warnings;
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenpackage Sun::Solaris::Exacct::Object;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenour $VERSION = '1.3';
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse XSLoader;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenXSLoader::load(__PACKAGE__, $VERSION);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenour (@EXPORT_OK, %EXPORT_TAGS, @_Constants);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen@EXPORT_OK = @_Constants;
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele%EXPORT_TAGS = (CONSTANTS => \@_Constants, ALL => \@EXPORT_OK);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse base qw(Exporter);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse Sun::Solaris::Exacct::Catalog qw(:CONSTANTS);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen# Class methods
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele# Dump an exacct object to the specified filehandle, or STDOUT by default.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabelesub dump
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen # Fettle parameters.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my ($class, $obj, $fh, $indent) = @_;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $fh ||= \*STDOUT;
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele $indent ||= 0;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $istr = ' ' x $indent;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele # Check for undef values.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen if (! defined($obj)) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen print $fh ($istr, "UNDEFINED_VALUE\n");
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen # Deal with items.
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele my @cat = $obj->catalog()->value();
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen if ($obj->type() == &EO_ITEM) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen printf $fh ("%sITEM\n%s Catalog = %s|%s|%s\n",
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $istr, $istr, @cat);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $indent++;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $val = $obj->value();
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen # Recursively dump nested objects.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen if (ref($val)) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $class->dump($val, $fh, $indent);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen # Just print out items.
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele } else {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $val = unpack('H*', $val) if ($cat[0] == &EXT_RAW);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen printf $fh ("%s Value = %s\n", $istr, $val);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen # Deal with groups.
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele } else {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen printf $fh ("%sGROUP\n%s Catalog = %s|%s|%s\n",
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $istr, $istr, @cat);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $indent++;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen foreach my $val ($obj->value()) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $class->dump($val, $fh, $indent);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen printf $fh ("%sENDGROUP\n", $istr);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen# Item subclass - establish inheritance.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenpackage Sun::Solaris::Exacct::Object::Item;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse base qw(Sun::Solaris::Exacct::Object);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen# Group subclass - establish inheritance.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenpackage Sun::Solaris::Exacct::Object::Group;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse base qw(Sun::Solaris::Exacct::Object);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele# Tied array used for holding a group's items.
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenpackage Sun::Solaris::Exacct::Object::_Array;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowenuse Carp;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele# Check the passed list of arguments are derived from ::Object
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub check_args
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my @duff;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen foreach my $i (@_) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen push(@duff, $i)
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen if (! UNIVERSAL::isa($i, 'Sun::Solaris::Exacct::Object'));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen if (@duff) {
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen local $Carp::CarpLevel = 2;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen croak('"', join('", "', @duff), @duff == 1 ? '" is' : '" are',
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen ' not of type Sun::Solaris::Exacct::Object');
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen }
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele# Tied hash access methods
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele#
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub TIEARRAY
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return(bless([], $_[0]));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub FETCHSIZE
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return(scalar(@{$_[0]}));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub STORESIZE
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $#{$_[0]} = $_[1] - 1;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub STORE
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen check_args($_[2]);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return($_[0]->[$_[1]] = copy_xs_ea_objects($_[2]));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub FETCH
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return($_[0]->[$_[1]]);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabelesub CLEAR
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele @{$_[0]} = ();
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabelesub POP
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele{
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele return(pop(@{$_[0]}));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub PUSH
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $a = shift(@_);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen check_args(@_);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen push(@$a, copy_xs_ea_objects(@_));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub SHIFT
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele return(shift(@{$_[0]}));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabelesub UNSHIFT
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $a = shift(@_);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen check_args($_[2]);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return(unshift(@$a, copy_xs_ea_objects(@_)));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub EXISTS
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return(exists($_[0]->[$_[1]]));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub DELETE
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen return(delete($_[0]->[$_[1]]));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub EXTEND
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele{
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowensub SPLICE
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen{
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele my $a = shift(@_);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $sz = scalar(@$a);
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $off = @_ ? shift(@_) : 0;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen $off += $sz if $off < 0;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen my $len = @_ ? shift : $sz - $off;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen check_args(@_);
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele return(splice(@$a, $off, $len, copy_xs_ea_objects(@_)));
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen}
d5082de325fb6351c6bd34d28df0b43ec5a8ac90erikabele
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen1;
47bbfaa3a2ea0afb775a3aa3e7dbf8a71ea1b966rbowen