r10263 - in /branches/upstream/libobject-multitype-perl: ./ current/ current/Changes current/MANIFEST current/Makefile.PL current/MultiType.pm current/README current/test.pl
vdanjean at users.alioth.debian.org
vdanjean at users.alioth.debian.org
Sat Dec 1 12:10:13 UTC 2007
Author: vdanjean
Date: Sat Dec 1 12:10:13 2007
New Revision: 10263
URL: http://svn.debian.org/wsvn/?sc=1&rev=10263
Log:
[svn-inject] Installing original source of libobject-multitype-perl
Added:
branches/upstream/libobject-multitype-perl/
branches/upstream/libobject-multitype-perl/current/
branches/upstream/libobject-multitype-perl/current/Changes
branches/upstream/libobject-multitype-perl/current/MANIFEST
branches/upstream/libobject-multitype-perl/current/Makefile.PL
branches/upstream/libobject-multitype-perl/current/MultiType.pm
branches/upstream/libobject-multitype-perl/current/README
branches/upstream/libobject-multitype-perl/current/test.pl
Added: branches/upstream/libobject-multitype-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/Changes?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/Changes (added)
+++ branches/upstream/libobject-multitype-perl/current/Changes Sat Dec 1 12:10:13 2007
@@ -1,0 +1,19 @@
+Revision history for Perl extension Object::MultiType.
+
+0.05 2004-12-20
+ - Fixed minor mistake on hash value of saver.
+
+0.04 2004-01-16
+ - Tied hashes will alwasy return TRUE for: if( %hash ) now.
+
+0.03 Oct 10 2003
+ - Fixed bug with overload ++ and --.
+
+0.02 Sat Jun 3 2:54:05 2003
+ - Added support for booleans.
+
+0.01 Sat May 10 00:37:05 2003
+ - First release!
+ - original version; created by h2xs 1.21 with options
+ -X -A -n Object::MultiType
+
Added: branches/upstream/libobject-multitype-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/MANIFEST?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/MANIFEST (added)
+++ branches/upstream/libobject-multitype-perl/current/MANIFEST Sat Dec 1 12:10:13 2007
@@ -1,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+MultiType.pm
+README
+test.pl
Added: branches/upstream/libobject-multitype-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/Makefile.PL?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/Makefile.PL (added)
+++ branches/upstream/libobject-multitype-perl/current/Makefile.PL Sat Dec 1 12:10:13 2007
@@ -1,0 +1,19 @@
+###############
+# MAKEFILE.PL #
+###############
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Object::MultiType' ,
+ 'VERSION_FROM' => 'MultiType.pm' ,
+ 'PREREQ_PM' => {} ,
+ ($] >= 5.005 ?
+ ( ABSTRACT_FROM => 'MultiType.pm',
+ AUTHOR => 'Graciliano M. P. <gm at virtuasites.com.br>'
+ ) : ()
+ ),
+);
+
+1;
+
Added: branches/upstream/libobject-multitype-perl/current/MultiType.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/MultiType.pm?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/MultiType.pm (added)
+++ branches/upstream/libobject-multitype-perl/current/MultiType.pm Sat Dec 1 12:10:13 2007
@@ -1,0 +1,765 @@
+#############################################################################
+## Name: MultiType.pm
+## Purpose: Object::MultiType
+## Author: Graciliano M. P.
+## Modified by:
+## Created: 10/05/2003
+## RCS-ID:
+## Copyright: (c) 2003 Graciliano M. P.
+## Licence: This program is free software; you can redistribute it and/or
+## modify it under the same terms as Perl itself
+#############################################################################
+
+package Object::MultiType;
+use 5.006 ;
+use strict qw(vars) ;
+our $VERSION = '0.05';
+
+no warnings ;
+
+ use overload (
+ 'bool' => '_OVER_bool' ,
+ '""' => '_OVER_string' ,
+ '=' => '_OVER_copy' ,
+ '+' => '_OVER_inc' ,
+ '-' => '_OVER_deinc' ,
+ '0+' => '_OVER_copy' ,
+ '@{}' => '_OVER_get_array' ,
+ '%{}' => '_OVER_get_hash' ,
+ '&{}' => '_OVER_get_code' ,
+ '*{}' => '_OVER_get_glob' ,
+ 'fallback' => 1 ,
+ ) ;
+
+sub is_saver { 0 ;}
+
+#######
+# NEW #
+#######
+
+sub new {
+ my $class = shift ;
+ my (%args) = @_ ;
+
+ my $saver = Object::MultiType::Saver->new( $args{nodefault} ) ;
+ my $this = \$saver ;
+ bless($this,$class) ;
+
+ if (!defined $args{boolsub} && defined $args{boolcode} ) { $args{boolsub} = $args{boolcode} ;}
+
+ if ( exists $args{bool} ) { $saver->set_bool($args{bool}) ;}
+ elsif ( $args{boolsub} ) {
+ my $sub = $args{boolsub} ;
+ $saver->set_bool(\$sub) ;
+ }
+
+ if (!defined $args{scalarsub} && defined $args{scalarcode} ) { $args{scalarsub} = $args{scalarcode} ;}
+
+ if ( defined $args{scalar} ) { $saver->set_scalar($args{scalar}) ;}
+ elsif ( $args{scalarsub} ) {
+ my $sub = $args{scalarsub} ;
+ $saver->set_scalar(\$sub) ;
+ }
+
+ if ( ref $args{array} eq 'ARRAY' ) { $saver->set_array($args{array}) ;}
+ elsif ( $args{tiearray} ) {
+ if ( $args{tieonuse} ) { $saver->{TIEONUSE}{a} = $args{tiearray} ;}
+ else {
+ my @array ; tie(@array,$args{tiearray},$$this) ;
+ $saver->set_array(\@array) ;
+ }
+ }
+
+ if ( ref $args{hash} eq 'HASH' ) { $saver->set_hash($args{hash}) ;}
+ elsif ( $args{tiehash} ) {
+ if ( $args{tieonuse} ) { $saver->{TIEONUSE}{h} = $args{tiehash} ;}
+ else {
+ my %hash = 1 ; tie(%hash,$args{tiehash},$$this) ;
+ $saver->set_hash(\%hash) ;
+ }
+ }
+
+ if ( ref $args{code} eq 'CODE' ) { $saver->set_code( $args{code} ) ;}
+
+ if ( $args{tiehandle} ) {
+ if (!$args{glob}) { local(*NULL) ; $args{glob} = \*NULL ;}
+
+ if ( $args{tieonuse} ) { $saver->{TIEONUSE}{g} = $args{tiehandle} ;}
+ else { tie($args{glob} , $args{tiehandle} , $$this) ;}
+ }
+
+ if ( ref $args{glob} eq 'GLOB' ) { $saver->set_glob( $args{glob} ) ;}
+
+ return( $this ) ;
+}
+
+##############
+# _OVER_BOOL #
+##############
+
+sub _OVER_bool {
+ my $this = shift ;
+
+ if ( !exists $$this->{b} ) {
+ return $this->_OVER_string ;
+ }
+
+ my $bool = $$this->bool ;
+
+ if (ref($bool) && ref($$bool) eq 'CODE') {
+ my $sub = $$bool ;
+ return &$sub($this) ;
+ }
+
+ if (ref($bool) eq 'SCALAR') { return( $$bool ) ;}
+
+ return( $bool ) ;
+}
+
+##########
+# STRING #
+##########
+
+sub _OVER_string {
+ my $this = shift ;
+ my $scalar = $$this->scalar ;
+
+ if (ref($$scalar) eq 'CODE') {
+ my $sub = $$scalar ;
+ return &$sub($this) ;
+ }
+ else { return( $$scalar ) ;}
+}
+
+#############
+# _OVER_INC #
+#############
+
+sub _OVER_inc {
+ my $this = shift ;
+ my $scalar = $$this->scalar ;
+
+ my $n ;
+ if (ref($$scalar) eq 'CODE') {
+ my $sub = $$scalar ;
+ $n = &$sub($this) ;
+ }
+ else { $n = substr($$scalar , 0 ) ;}
+
+ $n += $_[0] ;
+ return $n ;
+}
+
+###############
+# _OVER_DEINC #
+###############
+
+sub _OVER_deinc {
+ my $this = shift ;
+ my $scalar = $$this->scalar ;
+
+ my $n ;
+ if (ref($$scalar) eq 'CODE') {
+ my $sub = $$scalar ;
+ $n = &$sub($this) ;
+ }
+ else { $n = substr($$scalar , 0 ) ;}
+
+ $n -= $_[0] ;
+ return $n ;
+}
+
+##############
+# _OVER_COPY #
+##############
+
+sub _OVER_copy {
+ my $this = shift ;
+ my $scalar = $$this->scalar ;
+
+ if (ref($$scalar) eq 'CODE') {
+ my $sub = $$scalar ;
+ return &$sub($this) ;
+ }
+ else { return( substr($$scalar , 0 ) ) ;}
+}
+
+#############
+# GET_ARRAY #
+#############
+
+sub _OVER_get_array {
+ my $this = shift ;
+
+ if ( $$this->{TIEONUSE}{a} ) {
+ my @array ; tie(@array, $$this->{TIEONUSE}{a} , $$this) ;
+ $$this->set_array(\@array) ;
+ $$this->{TIEONUSE}{a} = undef ;
+ }
+
+ return( $$this->array ) ;
+}
+
+############
+# GET_HASH #
+############
+
+sub _OVER_get_hash {
+ my $this = shift ;
+
+ if ( $$this->{TIEONUSE}{h} ) {
+ my %hash = 1 ; tie(%hash, $$this->{TIEONUSE}{h} ,$$this) ;
+ $$this->set_hash(\%hash) ;
+ $$this->{TIEONUSE}{h} = undef ;
+ }
+
+ return( $$this->hash ) ;
+}
+
+##################
+# _OVER_GET_CODE #
+##################
+
+sub _OVER_get_code {
+ my $this = shift ;
+
+ if ( !$$this->{SUBCODE} ) {
+ $$this->{SUBCODE}{self} = undef ;
+
+ my $sub = $$this->code ;
+ my $ref = $$this->{SUBCODE} ;
+
+ $$this->{SUBCODE}{sub} = sub {
+ if (wantarray) {
+ my @ret = &$sub( $$ref{self} , @_) ;
+ $$ref{self} = undef ;
+ return( @ret ) ;
+ }
+ else {
+ my $ret = &$sub( $$ref{self} , @_) ;
+ $$ref{self} = undef ;
+ return( $ret ) ;
+ }
+ };
+
+ }
+
+ $$this->{SUBCODE}{self} = $this ;
+ return( $$this->{SUBCODE}{sub} ) ;
+}
+
+##################
+# _OVER_GET_GLOB #
+##################
+
+sub _OVER_get_glob {
+ my $this = shift ;
+
+ if ( $$this->{TIEONUSE}{g} ) {
+ tie($$this->glob , $$this->{TIEONUSE}{g} , $$this) ;
+ $$this->{TIEONUSE}{g} = undef ;
+ }
+
+ return( $$this->glob ) ;
+}
+
+###########
+# DESTROY #
+###########
+
+sub DESTROY {
+ my $this = shift ;
+ $$this->clean ;
+}
+
+############################
+# OBJECT::MULTITYPE::SAVER #
+############################
+
+package Object::MultiType::Saver ;
+
+use strict qw(vars) ;
+
+sub is_saver { 1 ;}
+
+sub new {
+ my $class = shift ;
+ my ( $nodefault ) = @_ ;
+
+ my $this ;
+
+ if ($nodefault) { $this = {} ;}
+ else {
+ local(*NULL);
+ $this = {
+ s => \'' ,
+ a => [] ,
+ h => {} ,
+ c => sub{} ,
+ g => \*NULL ,
+ } ;
+ }
+
+ bless($this,$class);
+ return( $this ) ;
+}
+
+sub bool { return( $_[0]->{b} ) ;}
+sub scalar { return( $_[0]->{s} ) ;}
+sub array { return( $_[0]->{a} ) ;}
+sub hash { return( $_[0]->{h} ) ;}
+sub code { return( $_[0]->{c} ) ;}
+sub glob { return( $_[0]->{g} ) ;}
+
+sub set_bool { $_[0]->{b} = $_[1] ;}
+
+sub set_scalar {
+ if ($#_ == 0) { $_[0]->{s} = undef ;}
+ elsif (ref($_[1]) ne 'SCALAR' && ref($_[1]) ne 'REF') { $_[0]->{s} = \$_[1] ;}
+ else { $_[0]->{s} = $_[1] ;}
+}
+
+sub set_array { $_[0]->{a} = $_[1] ;}
+sub set_hash { $_[0]->{h} = $_[1] ;}
+sub set_code { $_[0]->{c} = $_[1] ;}
+sub set_glob { $_[0]->{g} = $_[1] ;}
+
+sub clean {
+ my $this = shift ;
+ $this->set_bool() ;
+ $this->set_scalar() ;
+ $this->set_array() ;
+ $this->set_hash() ;
+ $this->set_code() ;
+ $this->set_glob() ;
+}
+
+sub DESTROY { &clean ;}
+
+#######
+# END #
+#######
+
+1;
+__END__
+
+=head1 NAME
+
+Object::MultiType - Perl Objects as Hash, Array, Scalar, Code and Glob at the same time.
+
+=head1 SYNOPSIS
+
+ use Object::MultiType ;
+
+ my $scalar = 'abc' ;
+ my @array = qw(x y z);
+ my %hash = (A => 1 , B => 2) ;
+
+ my $obj = Object::MultiType->new(
+ scalar => \$scalar ,
+ array => \@array ,
+ hash => \%hash ,
+ code => sub{ return("I'm a sub ref!") ; }
+ glob => \*STDOUT ,
+ ) ;
+
+ print "Me as scalar: $obj\n" ;
+
+ my $array_1 = $obj->[1] ;
+ print "$array_1\n" ;
+
+ my $hash_B = $obj->{B} ;
+ print "$hash_B\n" ;
+
+ my $hash = $$obj->hash ;
+ foreach my $Key (sort keys %$hash ) {
+ print "$Key = $$hash{$Key}\n" ;
+ }
+
+ &$obj(args) ;
+
+=head1 DESCRIPTION
+
+This module return an object that works like a Hash, Array, Scalar, Code and Glob object at the same time.
+
+The usual way is to call it from your module at new():
+
+ package FOO ;
+
+ use Object::MultiType ;
+ use vars qw(@ISA) ;
+ @ISA = qw(Object::MultiType) ; ## Is good to 'Object::MultiType' be the last in @ISA!
+
+ sub new {
+ my $class = shift ;
+ my $this = Object::MultiType->new() ;
+ bless($this,$class) ;
+ }
+
+=head1 METHODS
+
+** See the methods of the L<Saver|/SAVER> too.
+
+=head2 new
+
+B<Arguments>:
+
+=over 10
+
+=item bool
+
+The I<boolean> reference. Default: undef
+
+=item boolcode|boolsub
+
+Set the sub/function (CODE reference) that will return/generate the I<boolean> value.
+
+=item scalar
+
+The SCALAR reference. If not sent a null SCALAR will be created.
+
+=item scalarcode|scalarsub
+
+Set the sub/function (CODE reference) that will return/generate the scalar data of the object.
+
+=item array
+
+The ARRAY reference. If not sent a null ARRAY will be created.
+
+=item hash
+
+The HASH reference. If not sent a null HASH will be created.
+
+=item code
+
+The CODE reference. If not sent a null sub{} will be created.
+
+With this your object can be used as a sub reference:
+
+ my $multi = Object::MultiType->new( code => sub { print "Args: @_\n" ;} ) ;
+ &$multi();
+
+Note that the first argument sent to the SUB is the object ($multi).
+
+=item glob
+
+The GLOB (HANDLE) reference. If not sent a null GLOB will be created.
+
+** Note that you can't use the default (null) GLOB created when you don't paste this argument!
+Since all the objects will share it, and was there just to avoid erros!
+
+=item tiearray
+
+Package name to create a TIEARRAY. The argument $$this is sent to tie().
+
+tie() is called as:
+
+ tie(@array,$args{tiearray},$$this) ;
+
+Note that is hard to implement the tie methods for PUSH, POP, SHIFT, UNSHIFT, SPLICE...
+Unless you make just an alias to another array through the tie methods.
+
+** See B<tiehash> too.
+
+=item tiehash
+
+Package name to create a TIEHASH. The argument $$this is sent to tie().
+
+tie() is called as:
+
+ tie(%hash,$args{tiehash},$$this) ;
+
+** $$this (the Saver) is sent, and not $this, to avoid the break of DESTROY (auto reference).
+
+** $$this is a reference to the Saver object that save the SCALAR, ARRAY, HASH, CODE and GLOB.
+
+ sub TIEHASH {
+ my $class = shift ;
+ my $multi = shift ; ## $$this
+
+ my $scalarref = $multi->scalar ; ## \${*$multi}
+ my $arrayref = $multi->array ; ## \@{*$multi}
+ my $hashref = $multi->hash ; ## \%{*$multi}
+
+ my $this = { s => $scalarref , a => $arrayref , h => $hashref } ;
+ bless($this,$class) ;
+ }
+
+=item tiehandle
+
+Make the object works like a tied glob (TIEHANDLE).
+
+If used with I<glob> will tie() it. If I<glob> is not sent a NULL GLOB is used:
+
+ my $multi = Object::MultiType->new(
+ glob => \*MYOUT , ## 'glob' is Optional.
+ tiehandle => 'TieHandlePack' ,
+ ) ;
+
+=item tieonuse
+
+The reference is only tied when it's used! So, the HASH, ARRAY or GLOB (handle)
+are only tied if/when they are accessed.
+
+=item nodefault
+
+If set to true tell to not create the default references inside the Saver, and it
+will have only the references paste (scalar, array, hash, code, glob).
+
+** This is good to save memory.
+
+=back
+
+=head2 is_saver
+
+Return 0. Good to see if what you have is the Saver or the MultiType object.
+
+=head1 SAVER
+
+The MultiType object has a Saver object (L<Object::MultiType::Saver|/Object::MultiType::Saver>),
+that save all the different data type (references). This saver can be accessed from the main object:
+
+ my $multi = Object::MultiType->new() ;
+
+ my $saver = $$multi ;
+ print $saver->scalar ;
+
+B<If you want to save attributes in your Object and you use I<tiehash>, you can't set attributes directly in the MultiType object>!:
+
+ sub new {
+ my $class = shift ;
+ my $this = Object::MultiType->new(tiehash => 'TieHashPack') ;
+
+ ## Dont do that! This will call the STORE() at TIEHASH, and not save it in the object:
+ $this->{flagx} = 1 ;
+
+ bless($this,$class) ;
+ }
+
+So, if you use tiehash and want to save attributes (outside tie) use that:
+
+ ## This save the attribute inside the Saver:
+ $$this->{flagx} = 1 ;
+
+Note that this set an attribute in the saver, and it has their own attributes!
+
+ ## $saver = $$this ;
+
+ $saver->{s} ## the sacalar ref.
+ $saver->{a} ## the array ref.
+ $saver->{h} ## the hash ref.
+ $saver->{c} ## the code ref.
+ $saver->{g} ## the glob ref.
+
+** See I<"Direct access to the data types">.
+
+=head1 DESTROY
+
+When the object is DESTROIED, the Saver inside it is cleanned, so the tied objects can be DESTROIED automatically too.
+
+=head1 Direct access to the data types
+
+To access directly the reference of the different data types (SCALAR, ARRAY, HASH, CODE & GLOB) use:
+
+ my $multi = Object::MultiType->new() ;
+
+ my $saver = $$multi ;
+
+ my $scalarref = $saver->scalar ; ## $saver->{s}
+ my $arrayref = $saver->array ; ## $saver->{a}
+ my $hashref = $saver->hash ; ## $saver->{h}
+ my $coderef = $saver->code ; ## $saver->{c}
+ my $globeref = $saver->glob ; ## $saver->{g}
+
+ ## You can access the Saver directly from the main object:
+ $$multi->hash ;
+
+Setting the data:
+
+ $saver->set_bool( 1 ) ;
+ $saver->set_scalar( 'xyz' ) ;
+ $saver->set_array( [qw(x y z)] ) ;
+ $saver->set_hash( {X => 1} ) ;
+ $saver->set_code( sub{ print "XYZ\n" ; } ) ;
+ $saver->set_glob( \*STDOUT ) ;
+
+=head1 As SCALAR
+
+You can use it as SCALAR when you put it inside quotes or make a copy of it:
+
+ my $multi = Object::MultiType->new( scalar => 'Foo' ) ;
+
+ ## Quote:
+ print "Me as scalar: $multi\n" ;
+
+ ## Copy:
+ my $str = $multi ;
+ $str .= '_x' ; ## Copy made when you change it! Until that $str works like $multi.
+ print "$str\n" ;
+
+using the argument B<scalarsub> you can use a function that will generate the scalar data,
+in the place of a reference to a SCALAR:
+
+ my $multi = Object::MultiType->new(scalarsub => sub{ return 'generated data' ;} ) ;
+
+ print "My scalar have $multi!\n" ;
+
+=head1 As ARRAY
+
+You can use it as ARRAY directly from the object:
+
+ my $multi = Object::MultiType->new( array => [qw(FOO BAR)] ) ;
+ my $array_0 = $multi->[0] ;
+ $multi->[1] = 'foo' ;
+
+=head1 As HASH
+
+You can use it as HASH directly from the object:
+
+ my $multi = Object::MultiType->new( hash => {key => 'foo'} ) ;
+ my $k = $multi->{key} ;
+ $multi->{foo} = 'bar' ;
+
+=head1 With TIE
+
+To use your ARRAY and HASH part tied, you can paste the reference already tied of the HASH or ARRAY,
+or use the arguments tiehash and tiearray at L<new()|/new>:
+
+ ## Using the reference:
+ my %hash ;
+ tie(%hash,'TieHash') ;
+ my $multi = Object::MultiType->new(hash => \%hash) ;
+
+ ## Or using directly the argument:
+ my $multi = Object::MultiType->new(tiehash => 'TieHashPack') ;
+
+Note that using tiehash or tiearray is better, since your tied HASH or ARRAY can see the object Saver and
+the other data type of it. B<See the method L<new()|/new> and their arguments>.
+
+Here's an example of a TieHash package that is called from Object::MultiType->new():
+
+ ## The call inside Object::MultiType->new():
+ tie(%hash,$args{tiehash},$$this) ;
+
+ ## The package:
+ package TieHash ;
+
+ sub TIEHASH {
+ my $class = shift ;
+ my $Saver = shift ; ## Object::MultiType paste as $$this (only the Saver) to avoid break of DESTROY!
+ ## $this = Object::MultiType >> $$this = Object::MultiType::Saver
+
+ my $scalarref = $Saver->scalar ;
+ my $arrayref = $Saver->array ;
+
+ ## Note that $Saver->hash will return the tied hash, and is not needed here!
+ ## my $hashref = $Saver->hash ;
+
+ ## Saving the references inside the TIE object:
+ my $this = { scalar => $scalarref , array => $arrayref , hash => {} } ;
+
+ bless($this,$class) ;
+ }
+
+ sub FETCH { my $this = shift ; return( 'key' ) ;}
+
+ sub NEXTKEY { my $this = shift ; return( 'key' ) ;}
+
+ sub STORE { my $this = shift ; $this->{hash}{$_[0]} = $_[1] }
+
+ sub DELETE { my $this = shift ; delete $this->{hash}{$_[0]} }
+
+ sub CLEAR { my $this = shift ; $this->{hash} = {} ;}
+
+ sub EXISTS { my $this = shift ; defined $this->{hash}{$_[0]} ;}
+
+ sub FIRSTKEY { my $this = shift ; (sort keys %{$this->{hash}} )[0] }
+
+ sub DESTROY {}
+
+B<Using tiehash, you need to save the attributes in the Saver, or you call the tie()>.
+
+ $$this->{flagx} = 1 ;
+
+=head1 Object::MultiType::Saver
+
+This is a litte package where the Saver objects are created.
+It will save the data types (SCALAR, ARRAY, HASH, CODE & GLOB) of the main objects (Object::MultiType).
+
+B<METHODS:>
+
+=head2 is_saver
+
+Return 1. Good to see if what you have is the Saver or the MultiType object.
+
+=head2 bool
+
+Return the BOOL reference inside the Saver.
+
+=head2 scalar
+
+Return the SCALAR reference inside the Saver.
+
+=head2 array
+
+Return the ARRAY reference inside the Saver.
+
+=head2 hash
+
+Return the HASH reference inside the Saver.
+
+=head2 code
+
+Return the CODE/sub reference inside the Saver.
+
+=head2 glob
+
+Return the GLOB/HANDLE reference inside the Saver.
+
+=head2 set_bool
+
+Set the boolean reference inside the Saver.
+
+=head2 set_scalar
+
+Set the SCALAR reference inside the Saver.
+
+=head2 set_array
+
+Set the ARRAY reference inside the Saver.
+
+=head2 set_hash
+
+Set the HASH reference inside the Saver.
+
+=head2 set_code
+
+Set the CODE/sub reference inside the Saver.
+
+=head2 set_glob
+
+Set the GLOB/HANDLE reference inside the Saver.
+
+=head2 clean
+
+Clean all the references saved in the Saver.
+
+=head1 SEE ALSO
+
+L<overload>, L<perltie>, L<Scalar::Util>.
+
+This module/class was created for L<XML::Smart>.
+
+=head1 AUTHOR
+
+Graciliano M. P. <gm at virtuasites.com.br>
+
+I will appreciate any type of feedback (include your opinions and/or suggestions). ;-P
+
+=head1 COPYRIGHT
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+
Added: branches/upstream/libobject-multitype-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/README?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/README (added)
+++ branches/upstream/libobject-multitype-perl/current/README Sat Dec 1 12:10:13 2007
@@ -1,0 +1,40 @@
+#####################
+# Object::MultiType #
+#####################
+
+Perl Objects as Hash, Array and Scalar at the same time.
+
+###############
+# DESCRIPTION #
+###############
+
+This module return an object that works like a Hash, Array and Scalar object at the same time.
+
+** See POD for documentation.
+
+################
+# INSTALLATION #
+################
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+##########
+# AUTHOR #
+##########
+
+Graciliano M. P. <gm at virtuasites.com.br>
+
+I will appreciate any type of feedback (include your opinions and/or suggestions). ;-P
+
+#############
+# COPYRIGHT #
+#############
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+
Added: branches/upstream/libobject-multitype-perl/current/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libobject-multitype-perl/current/test.pl?rev=10263&op=file
==============================================================================
--- branches/upstream/libobject-multitype-perl/current/test.pl (added)
+++ branches/upstream/libobject-multitype-perl/current/test.pl Sat Dec 1 12:10:13 2007
@@ -1,0 +1,162 @@
+#########################
+
+use Test;
+BEGIN { plan tests => 21 } ;
+use Object::MultiType ;
+
+#########################
+{
+
+ my $obj = Object::MultiType->new(
+ code => sub { return ${$_[0]} } ,
+ ) ;
+
+ my $saver = &$obj(args) ;
+
+ ok( eval { $saver->is_saver } ) ;
+
+ my $self = scalar(${$$obj->{SUBCODE}{self}}) ;
+
+ ok($self,undef) ;
+
+}
+#########################
+{
+ my $scalar = 'abc' ;
+ my @array = qw(x y z);
+ my %hash = (A => 1 , B => 2) ;
+
+ my $obj = Object::MultiType->new(
+ scalar => \$scalar ,
+ array => \@array ,
+ hash => \%hash ,
+ ) ;
+
+ my $str = sprintf('%s',$obj) ;
+ ok($str,'abc');
+
+ my $cp = $obj ;
+ $cp .= '_x' ;
+ ok($cp,'abc_x');
+
+ my $array_1 = $obj->[1] ;
+ ok($array_1,'y');
+
+ my $hash_B = $obj->{B} ;
+ ok($hash_B,'2');
+
+ my $obj2 = Object::MultiType->new(
+ scalarsub => sub { return 'GENDATA' } ,
+ ) ;
+
+ my $str2 = sprintf('%s',$obj2) ;
+ ok($str2,'GENDATA');
+
+}
+#########################
+{
+ my $obj0 = Object::MultiType->new(scalar => 'obj0') ;
+ my $obj1 = Object::MultiType->new(scalar => \'obj1') ;
+ my $obj2 = Object::MultiType->new(scalar => \'obj2') ;
+
+ ok( sprintf('%s',$obj0) ,'obj0');
+ ok( sprintf('%s',$obj1) ,'obj1');
+ ok( sprintf('%s',$obj2) ,'obj2');
+}
+#########################
+{
+
+ my $data ;
+
+ local(*OUT) ;
+ tie(*OUT , 'TestTieHandle' , \$data ) ;
+
+ my $obj = Object::MultiType->new( glob => \*OUT ) ;
+ print $obj "GLOB ref OK!\n" ;
+
+ ok($data,"GLOB ref OK!\n");
+
+}
+#########################
+{
+
+ my $obj = Object::MultiType->new( bool => 1 ) ;
+ if ( $obj ) { ok(1,1) ;}
+ else { ok(1,0) ;}
+
+ my $obj = Object::MultiType->new( bool => 0 ) ;
+ if ( !$obj ) { ok(1) ;}
+ else { ok(0,1) ;}
+
+ my $bool_ref = 1 ;
+ my $obj = Object::MultiType->new( bool => \$bool_ref ) ;
+ if ( $obj ) { ok(1) ;}
+ else { ok(0,1) ;}
+
+ my $bool_ref = 1 ;
+ my $c ;
+
+ my $obj = Object::MultiType->new( boolsub => sub { $c++ ; return $bool_ref } ) ;
+ if ( $obj ) { ok(1) ;}
+ else { ok(1,0) ;}
+
+ $bool_ref = 0 ;
+ if ( !$obj ) { ok(1) ;}
+ else { ok(0,1) ;}
+
+ ok($c,2) ;
+
+ my $obj = Object::MultiType->new( scalar => 'a' ) ;
+ if ( $obj ) { ok(1,1) ;}
+ else { ok(1,0) ;}
+
+ ok($obj,'a') ;
+
+ my $obj = Object::MultiType->new( scalar => '0' ) ;
+ if ( !$obj ) { ok(1) ;}
+ else { ok(0,1) ;}
+
+ ok($obj,0) ;
+
+}
+#########################
+{
+
+ my $scalar = 100 ;
+
+ my $obj = Object::MultiType->new( scalar => \$scalar ) ;
+ my $n = ++$obj ;
+ ok($n , 101) ;
+
+ my $obj = Object::MultiType->new( scalar => \$scalar ) ;
+ my $n = --$obj ;
+ ok($n , 99) ;
+
+ my $obj = Object::MultiType->new( scalar => \$scalar ) ;
+ my $n = $obj++ ;
+ ok($n , 100) ;
+ ok($obj , 101) ;
+
+ my $obj = Object::MultiType->new( scalar => \$scalar ) ;
+ my $n = $obj-- ;
+ ok($n , 100) ;
+ ok($obj , 99) ;
+
+}
+
+#########################
+
+
+package TestTieHandle ;
+
+sub TIEHANDLE {
+ bless({ data => $_[1] },__PACKAGE__) ;
+}
+
+sub PRINT {
+ my $this = shift ;
+ ${$this->{data}} .= join("", (@_[0..$#_])) ;
+}
+
+#########################
+
More information about the Pkg-perl-cvs-commits
mailing list