Class-Gomor-1.03000755001750001750 012455261164 13222 5ustar00gomorgomor000000000000Class-Gomor-1.03/MANIFEST000444001750001750 65612455261164 14477 0ustar00gomorgomor000000000000Build.PL Changes examples/my-class.pl lib/Class/Gomor.pm lib/Class/Gomor/Array.pm lib/Class/Gomor/Hash.pm LICENSE LICENSE.Artistic Makefile.PL MANIFEST This list of files META.json META.yml README t/01-pod-coverage.t t/01-test-pod.t t/01-use.t t/02-nocheck.t t/03-hash.t t/04-hash-nocheck.t t/04-test-kwalitee.t t/05-array.t t/06-array-nocheck.t t/07-hash-clone.t t/08-hash-fullclone.t t/09-array-clone.t t/10-array-fullclone.t Class-Gomor-1.03/README000444001750001750 104412455261164 14236 0ustar00gomorgomor000000000000Class::Gomor ============ DESCRIPTION This module is yet another class builder. This one adds parameter checking in the new() constructor, that is to check for attributes existence, and definedness. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENSE You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. Copyright (c) 2004-2015, Patrice Auffret Class-Gomor-1.03/Makefile.PL000444001750001750 55512455261164 15316 0ustar00gomorgomor000000000000# # $Id: Makefile.PL 2000 2015-01-13 18:24:09Z gomor $ # use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Class::Gomor', VERSION_FROM => 'lib/Class/Gomor.pm', LICENSE => 'artistic', ABSTRACT_FROM => 'lib/Class/Gomor.pm', AUTHOR => 'GomoR ', MIN_PERL_VERSION => '5.6.1', PREREQ_PM => { Data::Dumper => 0, }, ); Class-Gomor-1.03/Build.PL000444001750001750 71512455261164 14636 0ustar00gomorgomor000000000000# # $Id: Build.PL 2000 2015-01-13 18:24:09Z gomor $ # use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Class::Gomor', license => 'artistic', dist_author => 'GomoR ', dist_version_from => 'lib/Class/Gomor.pm', requires => { 'perl' => '5.6.1', 'Data::Dumper' => '0', }, configure_requires => { 'Module::Build' => 0, }, ); $builder->create_build_script; Class-Gomor-1.03/LICENSE000444001750001750 26512455261164 14347 0ustar00gomorgomor000000000000LICENSE This program is free software. You can redistribute it and/or modify it under the following terms: - the Perl Artistic License (in the file LICENSE.Artistic), Class-Gomor-1.03/Changes000444001750001750 116412455261164 14654 0ustar00gomorgomor000000000000Revision history for Perl extension Class::Gomor. 1.03 Tue Jan 13 19:21:45 CET 2015 - update: copyright notice - update: Kwalitee 1.02 Sat May 23 15:44:40 CEST 2009 - bugfix: a warning when used with perl 5.10 - new: test kwalitee - update: copyright notice 1.01 Mon Nov 20 18:40:40 CET 2006 - Class::Gomor::Hash: new: cgDumper() - Class::Gomor::Array: new: cgDumper() - Class::Gomor: cgClone() and cgFullClone() documented - examples: my-class.pl - test: Test::Pod, Test::Pod::Coverage 1.00 Mon May 1 15:32:04 CEST 2006 - first public release - old Class::Gomor::Hash is now obsolete Class-Gomor-1.03/META.yml000444001750001750 134612455261164 14634 0ustar00gomorgomor000000000000--- abstract: 'another class and object builder' author: - 'GomoR ' build_requires: {} configure_requires: Module::Build: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.143240' license: artistic meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Class-Gomor provides: Class::Gomor: file: lib/Class/Gomor.pm version: '1.03' Class::Gomor::Array: file: lib/Class/Gomor/Array.pm version: '1.03' Class::Gomor::Hash: file: lib/Class/Gomor/Hash.pm version: '1.03' requires: Data::Dumper: '0' perl: v5.6.1 resources: license: http://opensource.org/licenses/artistic-license.php version: '1.03' Class-Gomor-1.03/META.json000444001750001750 216612455261164 15005 0ustar00gomorgomor000000000000{ "abstract" : "another class and object builder", "author" : [ "GomoR " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.421", "license" : [ "artistic_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Class-Gomor", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0" } }, "runtime" : { "requires" : { "Data::Dumper" : "0", "perl" : "v5.6.1" } } }, "provides" : { "Class::Gomor" : { "file" : "lib/Class/Gomor.pm", "version" : "1.03" }, "Class::Gomor::Array" : { "file" : "lib/Class/Gomor/Array.pm", "version" : "1.03" }, "Class::Gomor::Hash" : { "file" : "lib/Class/Gomor/Hash.pm", "version" : "1.03" } }, "release_status" : "stable", "resources" : { "license" : [ "http://opensource.org/licenses/artistic-license.php" ] }, "version" : "1.03" } Class-Gomor-1.03/LICENSE.Artistic000444001750001750 1373412455261164 16175 0ustar00gomorgomor000000000000 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Class-Gomor-1.03/lib000755001750001750 012455261164 13770 5ustar00gomorgomor000000000000Class-Gomor-1.03/lib/Class000755001750001750 012455261164 15035 5ustar00gomorgomor000000000000Class-Gomor-1.03/lib/Class/Gomor.pm000444001750001750 1477212455261164 16646 0ustar00gomorgomor000000000000# # $Id: Gomor.pm 2000 2015-01-13 18:24:09Z gomor $ # package Class::Gomor; use strict; use warnings; our $VERSION = '1.03'; use Exporter; use base qw(Exporter); use Carp; no strict 'refs'; our $Debug = 0; our $NoCheck = 0; our @EXPORT_OK = qw($Debug $NoCheck); sub cgCheckParams { my $self = shift; my ($userParams, $accessors) = @_; for my $u (keys %$userParams) { my $valid; my $defined; for (@$accessors) { ($u eq $_) ? $valid++ : next; defined($userParams->{$u}) && do { $defined++; last }; } if (! $valid) { carp("$self: parameter is invalid: `$u'"); next; } if (! $defined) { carp("$self: parameter is undef: `$u'"); next; } } } sub cgGetIsaTree { my $self = shift; my ($classes) = @_; for (@{$self.'::ISA'}) { push @$classes, $_; $_->cgGetIsaTree($classes) if $_->can('cgGetIsaTree'); } } sub cgGetAttributes { my $self = shift; my $classes = [ $self ]; $self->cgGetIsaTree($classes); my @attributes = (); { # On perl 5.10.0, we have a warning message: # "::AS" used only once: possible typo ... no warnings; for (@$classes) { push @attributes, @{$_.'::AS'} if @{$_.'::AS'}; push @attributes, @{$_.'::AA'} if @{$_.'::AA'}; push @attributes, @{$_.'::AO'} if @{$_.'::AO'}; } } \@attributes; } sub cgClone { my $self = shift; my $class = ref($self) || $self; return bless([ @$self ], $class) if UNIVERSAL::isa($self, 'Class::Gomor::Array'); return bless({ %$self }, $class) if UNIVERSAL::isa($self, 'Class::Gomor::Hash'); $self; } sub cgFullClone { my $self = shift; my ($n) = @_; return [ map { $self->cgFullClone } 1..$n ]; } sub cgBuildAccessorsScalar { my $self = shift; my ($accessors) = @_; for my $a (@$accessors) { *{$self.'::'.$a} = sub { shift->_cgAccessorScalar($a, @_) } } } sub cgBuildAccessorsArray { my $self = shift; my ($accessors) = @_; for my $a (@{$accessors}) { *{$self.'::'.$a} = sub { shift->_cgAccessorArray($a, @_) } } } sub cgDebugPrint { my $self = shift; my ($level, $msg) = @_; return if $Debug < $level; my $class = ref($self) || $self; $class =~ s/^.*:://; $msg =~ s/^/DEBUG: $class: /gm; print STDERR $msg."\n"; } 1; =head1 NAME Class::Gomor - another class and object builder =head1 DESCRIPTION This module is yet another class builder. This one adds parameter checking in B constructor, that is to check for attributes existence, and definedness. In order to validate parameters, the module needs to find attributes, and that is the reason for declaring attributes in global variables named B<@AS>, B<@AA>, B<@AO>. They respectively state for Attributes Scalar, Attributes Array and Attributes Other. The last one is used to avoid autocreation of accessors, that is to let you declare your own ones. Attribute validation is performed by looking at classes hierarchy, by following @ISA tree inheritance. The loss in speed by validating all attributes is quite negligeable on a decent machine (Pentium IV, 2.4 GHz) with Perl 5.8.x. But if you want to avoid checking, you can do it, see below. This class is the base class for B and B, so they will inherite the following methods. =head1 GLOBAL VARIABLES =over 4 =item B<$NoCheck> Import it in your namespace like this: use Class::Gomor qw($NoCheck); If you want to disable B to improve speed once your program is frozen, you can use this variable. Set it to 1 to disable parameter checking. =item B<$Debug> Import it in your namespace like this: use Class::Gomor qw($Debug); This variable is used by the B method. =back =head1 METHODS =over 4 =item B (hash ref, array ref) The attribute checking method takes two arguments, the first is user passed attributes (as a hash reference), the second is the list of valid attributes, gathered via B method (as an array ref). A message is displayed if passed parameters are not valid. =item B (array ref) A recursive method. You pass a class in an array reference as an argument, and then the @ISA array is browsed, recursively. The array reference passed as an argument is increased with new classes, pushed into it. It returns nothing, result is stored in the array ref. =item B This method returns available attributes for caller's object class. It uses B to search recursively in class hierarchy. It then returns an array reference with all possible attributes. =item B (array ref) Accessor creation method. Takes an array reference containing all scalar attributes to create. Scalar accessors are stored in a global variable names B<@AS>. So you call this method at the beginning of your class like that: __PACKAGE__->cgBuildAccessorsScalar(\@AS); =item B (array ref) Accessor creation method. Takes an array reference containing all array attributes to create. Array accessors are stored in a global variable names B<@AA>. So you call this method at the beginning of your class like that: __PACKAGE__->cgBuildAccessorsArray(\@AA); =item B [ (scalar) ] You can clone one of your objects by calling this method. An optional parameter may be used to create multiple clones. Cloning will occure only on the first level attributes, that is, if you have attributes containing other objects, they will not be cloned. =item B [ (scalar) ] This method is the same as B, but will clone all attributes recursively, but only if they are subclassed from B. So, objects created with other modules than B or B will not be cloned. Another thing to note, there is no catch for cycling references (when you link two objects with each others). You have been warned. =item B (scalar, scalar) First argument is a debug level. It is compared with global B<$Debug>, and if it is less than it, the second argument (a message string) is displayed. This method exists because I use it, maybe you will not like it. =back =head1 SEE ALSO L, L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Class-Gomor-1.03/lib/Class/Gomor000755001750001750 012455261164 16120 5ustar00gomorgomor000000000000Class-Gomor-1.03/lib/Class/Gomor/Hash.pm000444001750001750 1172412455261164 17523 0ustar00gomorgomor000000000000# # $Id: Hash.pm 2000 2015-01-13 18:24:09Z gomor $ # package Class::Gomor::Hash; use strict; use warnings; our $VERSION = '1.03'; use Class::Gomor; use base qw(Class::Gomor); use Data::Dumper; sub new { my $self = shift; my $class = ref($self) || $self; my %h = @_; $class->cgCheckParams(\%h, $class->cgGetAttributes) unless $Class::Gomor::NoCheck; bless(\%h, $class); } # Just for compatibility with Class::Gomor::Array # And in order to make it easy to switch for one to another sub cgGetIndice { shift; shift } sub cgBuildIndices {} sub cgFullClone { my $self = shift; my ($n) = @_; return $self->SUPER::cgFullClone($n) if $n; my $class = ref($self) || $self; my %new; for my $k (keys %$self) { my $v = $self->{$k}; (ref($v) && UNIVERSAL::isa($v, 'Class::Gomor')) ? $new{$k} = $v->cgFullClone : $new{$k} = $v; } bless(\%new, $class); } sub cgDumper { Dumper(shift()) } sub _cgAccessorScalar { my ($self, $sca) = (shift, shift); @_ ? $self->{$sca} = shift : $self->{$sca}; } sub _cgAccessorArray { my ($self, $ary) = (shift, shift); @_ ? $self->{$ary} = shift : @{$self->{$ary}}; } 1; =head1 NAME Class::Gomor::Hash - class and object builder, hash version =head1 SYNPOSIS # Create a base class in BaseClass.pm package My::BaseClass; require Class::Gomor::Hash; our @ISA = qw(Class::Gomor::Hash); our @AS = qw(attribute1 attribute2); our @AA = qw(attribute3 attribute4); our @AO = qw(other); # You should initialize yourself array attributes sub new { shift->SUPER::new(attribute3 => [], attribute4 => [], @_) } # Create accessors My::BaseClass->cgBuildAccessorsScalar(\@AS); My::BaseClass->cgBuildAccessorsArray(\@AA); sub other { my $self = shift; @_ ? $self->{'other'} = [ split(/\n/, shift) ] : @{$self->{'other'}}; } 1; # Create a subclass in SubClass.pm package My::SubClass; require My::BaseClass; our @ISA = qw(My::BaseClass); our @AS = qw(subclassAttribute); My::SubClass->cgBuildAccessorsScalar(\@AS); sub new { shift->SUPER::new( attribute1 => 'val1', attribute2 => 'val2', attribute3 => [ 'val3', ], attribute4 => [ 'val4', ], other => [ 'none', ], subclassAttribute => 'subVal', ); } 1; # A program using those classes my $new = My::SubClass->new; my $val1 = $new->attribute1; my @values3 = $new->attribute3; my @otherOld = $new->other; $new->other("str1\nstr2\nstr3"); my @otherNew = $new->other; print "@otherNew\n"; $new->attribute2('newValue'); $new->attribute4([ 'newVal1', 'newVal2', ]); =head1 DESCRIPTION This class is a subclass from B. It implements objects as hash references, and inherits methods from B. =head1 GLOBAL VARIABLE See B. =head1 METHODS =over 4 =item B (hash) Object constructor. This is where user passed attributes (hash argument) are checked against valid attributes (gathered by B method). Valid attributes are those that exists (doh!), and have not an undef value. The default is to check this, you can avoid it by setting B<$NoCheck> global variable (see perldoc B). =item B This method does nothing. It only exists to make it more easy to switch between B and B. =item B (array ref) =item B (array ref) See B. =item B (scalar) This method does nearly nothing. It only returns the passed-in scalar parameter (so the syntax is the same as in B). It only exists to make it more easy to switch between B and B. =item B [ (scalar) ] You can clone one of your objects by calling this method. An optional parameter may be used to create multiple clones. Cloning will occure only on the first level attributes, that is, if you have attributes containing other objects, they will not be cloned. =item B [ (scalar) ] This method is the same as B, but will clone all attributes recursively, but only if they are subclassed from B. So, objects created with other modules than B or B will not be cloned. Another thing to note, there is no catch for cycling references (when you link two objects with each others). You have been warned. =item B Will return a string as with B Dumper method. This is less useful for hashref objects, because they already include attributes names. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Class-Gomor-1.03/lib/Class/Gomor/Array.pm000444001750001750 1335112455261164 17714 0ustar00gomorgomor000000000000# # $Id: Array.pm 2000 2015-01-13 18:24:09Z gomor $ # package Class::Gomor::Array; use strict; use warnings; our $VERSION = '1.03'; use Class::Gomor; use base qw(Class::Gomor); use Data::Dumper; no strict 'refs'; sub new { my $self = shift; my $class = ref($self) || $self; my %h = @_; $class->cgCheckParams(\%h, $class->cgGetAttributes) unless $Class::Gomor::NoCheck; my @obj; my $base = $class.'::__'; $obj[${$base.$_}] = $h{$_} for keys %h; bless(\@obj, $class); } sub cgGetIndice { my $self = shift; ${(ref($self) || $self).'::__'.shift()}; } sub cgBuildIndices { my $self = shift; my $i = 0; ${(ref($self) || $self).'::__'.$_} = $i++ for @{$self->cgGetAttributes}; } sub cgFullClone { my $self = shift; my ($n) = @_; return $self->SUPER::cgFullClone($n) if $n; my $class = ref($self) || $self; my @new; for (@$self) { (ref($_) && UNIVERSAL::isa($_, 'Class::Gomor')) ? push @new, $_->cgFullClone : push @new, $_; } bless(\@new, $class); } sub cgDumper { my $self = shift; my $class = ref($self) || $self; my %h = map { $_ => $self->[$self->cgGetIndice($_)] } @{$class->cgGetAttributes}; Dumper(\%h); } sub _cgAccessorScalar { my $self = shift; my $a = shift; @_ ? $self->[${ref($self).'::__'.$a}] = shift : $self->[${ref($self).'::__'.$a}]; } sub _cgAccessorArray { my $self = shift; my $a = shift; @_ ? $self->[${ref($self).'::__'.$a}] = shift : @{$self->[${ref($self).'::__'.$a}]}; } 1; =head1 NAME Class::Gomor::Array - class and object builder, array version =head1 SYNPOSIS # Create a base class in BaseClass.pm package My::BaseClass; require Class::Gomor::Array; our @ISA = qw(Class::Gomor::Array); our @AS = qw(attribute1 attribute2); our @AA = qw(attribute3 attribute4); our @AO = qw(other); # You should initialize yourself array attributes sub new { shift->SUPER::new(attribute3 => [], attribute4 => [], @_) } # Create indices and accessors My::BaseClass->cgBuildIndices; My::BaseClass->cgBuildAccessorsScalar(\@AS); My::BaseClass->cgBuildAccessorsArray(\@AA); sub other { my $self = shift; @_ ? $self->[$self->cgGetIndice('other')] = [ split(/\n/, shift) ] : @{$self->[$self->cgGetIndice('other')]}; } 1; # Create a subclass in SubClass.pm package My::SubClass; require My::BaseClass; our @ISA = qw(My::BaseClass); our @AS = qw(subclassAttribute); My::SubClass->cgBuildIndices; My::SubClass->cgBuildAccessorsScalar(\@AS); sub new { shift->SUPER::new( attribute1 => 'val1', attribute2 => 'val2', attribute3 => [ 'val3', ], attribute4 => [ 'val4', ], other => [ 'none', ], subclassAttribute => 'subVal', ); } 1; # A program using those classes my $new = My::SubClass->new; my $val1 = $new->attribute1; my @values3 = $new->attribute3; my @otherOld = $new->other; $new->other("str1\nstr2\nstr3"); my @otherNew = $new->other; print "@otherNew\n"; $new->attribute2('newValue'); $new->attribute4([ 'newVal1', 'newVal2', ]); =head1 DESCRIPTION This class is a subclass from B. It implements objects as array references, and inherits methods from B. =head1 GLOBAL VARIABLES See B. =head1 METHODS =over 4 =item B (hash) Object constructor. This is where user passed attributes (hash argument) are checked against valid attributes (gathered by B method). Valid attributes are those that exists (doh!), and have not an undef value. The default is to check this, you can avoid it by setting B<$NoCheck> global variable (see perldoc B). =item B You MUST call this method one time at the beginning of your classes, and all subclasses (even if you do not add new attributes). It will build the matching between object attributes and their indices inside the array object. Global variables will be created in your class, with the following format: B<$__attributeName>. =item B (array ref) =item B (array ref) See B. =item B (scalar) Returns the array indice of specified attribute passed as a parameter. You can use it in your programs to avoid calling directly the global variable giving indice information concerning requesting object, thus avoiding using `no strict 'vars';'. This method is usually used when you build your own accessors (those using attributes defined in B<@AO>). =item B [ (scalar) ] You can clone one of your objects by calling this method. An optional parameter may be used to create multiple clones. Cloning will occure only on the first level attributes, that is, if you have attributes containing other objects, they will not be cloned. =item B [ (scalar) ] This method is the same as B, but will clone all attributes recursively, but only if they are subclassed from B. So, objects created with other modules than B or B will not be cloned. Another thing to note, there is no catch for cycling references (when you link two objects with each others). You have been warned. =item B Will return a string as with B Dumper method. This is useful for debugging purposes, because an arrayref object does not include attributes names. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Class-Gomor-1.03/t000755001750001750 012455261164 13465 5ustar00gomorgomor000000000000Class-Gomor-1.03/t/04-test-kwalitee.t000444001750001750 21712455261164 16772 0ustar00gomorgomor000000000000use Test::More; eval { require Test::Kwalitee; Test::Kwalitee->import() }; plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; Class-Gomor-1.03/t/05-array.t000444001750001750 106012455261164 15344 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Array; our @ISA = qw(Class::Gomor::Array); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new( s1 => 'testS1a', a1 => [ 'testA1s' ], ); #$new->s1('testS1'); #$new->a1([ 'testA1' ]); no strict 'refs'; $new->[$new->cgGetIndice('o1')] = 'testO1'; print "@{[$new->s1]}\n"; print "@{[$new->a1]}\n"; print $new->[$new->cgGetIndice('o1')]. "\n"; ok(1); Class-Gomor-1.03/t/08-hash-fullclone.t000444001750001750 132012455261164 17134 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Hash; our @ISA = qw(Class::Gomor::Hash); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->{o1} = 'test'; my $clone = $new->cgClone; $clone->s1('test2'); print 'new: '.$new->s1. "\n"; print 'clone: '.$clone->s1. "\n"; print 'new: '.$new->a1. "\n"; print 'new: '.$new->{o1}. "\n"; my $full = $clone->s1($new); my $fullList = $full->cgFullClone(10); $clone->s1('test2'); $fullList->[2]->s1('test3'); print 'full: '.$fullList->[2]->s1."\n"; print 'clone: '.$clone->s1. "\n"; ok(1); Class-Gomor-1.03/t/01-use.t000444001750001750 16112455261164 14777 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Class::Gomor; use Class::Gomor::Hash; use Class::Gomor::Array; ok(1); Class-Gomor-1.03/t/09-array-clone.t000444001750001750 112612455261164 16451 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Array; our @ISA = qw(Class::Gomor::Array); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->[$new->cgGetIndice('o1')] = 'test'; my $clone = $new->cgClone; $clone->s1('test2'); print 'new: '.$new->s1. "\n"; print 'clone: '.$clone->s1. "\n"; print 'new: '.$new->a1. "\n"; print 'new: '.$new->[$new->cgGetIndice('o1')]. "\n"; ok(1); Class-Gomor-1.03/t/01-test-pod.t000444001750001750 23112455261164 15740 0ustar00gomorgomor000000000000eval "use Test::Pod 1.00"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod 1.00 required for testing"); } else { all_pod_files_ok(); } Class-Gomor-1.03/t/06-array-nocheck.t000444001750001750 115512455261164 16762 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Array; $Class::Gomor::NoCheck++; print $Class::Gomor::NoCheck."\n"; our @ISA = qw(Class::Gomor::Array); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new( s1 => 'testS1a', a1 => [ 'testA1s' ], ); #$new->s1('testS1'); #$new->a1([ 'testA1' ]); no strict 'refs'; $new->[$new->cgGetIndice('o1')] = 'testO1'; print "@{[$new->s1]}\n"; print "@{[$new->a1]}\n"; print $new->[$new->cgGetIndice('o1')]. "\n"; ok(1); Class-Gomor-1.03/t/01-pod-coverage.t000444001750001750 62112455261164 16557 0ustar00gomorgomor000000000000eval "use Test::Pod::Coverage tests => 3"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod::Coverage required for testing"); } else { my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' }; pod_coverage_ok("Class::Gomor", $trustparents); pod_coverage_ok("Class::Gomor::Array", $trustparents); pod_coverage_ok("Class::Gomor::Hash", $trustparents); } Class-Gomor-1.03/t/07-hash-clone.t000444001750001750 101512455261164 16251 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Hash; our @ISA = qw(Class::Gomor::Hash); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->{o1} = 'test'; my $clone = $new->cgClone; $clone->s1('test2'); print 'new: '.$new->s1. "\n"; print 'clone: '.$clone->s1. "\n"; print 'new: '.$new->a1. "\n"; print 'new: '.$new->{o1}. "\n"; ok(1); Class-Gomor-1.03/t/03-hash.t000444001750001750 63412455261164 15135 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Hash; our @ISA = qw(Class::Gomor::Hash); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->{o1} = 'test'; print $new->s1. "\n"; print $new->a1. "\n"; print $new->{o1}. "\n"; ok(1); Class-Gomor-1.03/t/04-hash-nocheck.t000444001750001750 73112455261164 16544 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Hash; $Class::Gomor::NoCheck++; print $Class::Gomor::NoCheck."\n"; our @ISA = qw(Class::Gomor::Hash); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->{o1} = 'test'; print $new->s1. "\n"; print $new->a1. "\n"; print $new->{o1}. "\n"; ok(1); Class-Gomor-1.03/t/02-nocheck.t000444001750001750 21512455261164 15616 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Class::Gomor; use Class::Gomor::Hash; use Class::Gomor::Array; $Class::Gomor::NoCheck = 1; ok(1); Class-Gomor-1.03/t/10-array-fullclone.t000444001750001750 143112455261164 17323 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } require Class::Gomor::Array; our @ISA = qw(Class::Gomor::Array); our @AS = qw(s1); our @AA = qw(a1); our @AO = qw(o1); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); __PACKAGE__->cgBuildAccessorsArray (\@AA); my $new = __PACKAGE__->new; $new->s1('test'); $new->a1([ 'test' ]); $new->[$new->cgGetIndice('o1')] = 'test'; my $clone = $new->cgClone; $clone->s1('test2'); print 'new: '.$new->s1. "\n"; print 'clone: '.$clone->s1. "\n"; print 'new: '.$new->a1. "\n"; print 'new: '.$new->[$new->cgGetIndice('o1')]. "\n"; my $full = $clone->s1($new); my $fullList = $full->cgFullClone(10); $clone->s1('test2'); $fullList->[2]->s1('test3'); print 'full: '.$fullList->[2]->s1."\n"; print 'clone: '.$clone->s1. "\n"; ok(1); Class-Gomor-1.03/examples000755001750001750 012455261164 15040 5ustar00gomorgomor000000000000Class-Gomor-1.03/examples/my-class.pl000444001750001750 264112455261164 17265 0ustar00gomorgomor000000000000# Create a base class in BaseClass.pm package My::BaseClass; require Class::Gomor::Array; our @ISA = qw(Class::Gomor::Array); our @AS = qw(attribute1 attribute2); our @AA = qw(attribute3 attribute4); our @AO = qw(other); # Create indices and accessors My::BaseClass->cgBuildIndices; My::BaseClass->cgBuildAccessorsScalar(\@AS); My::BaseClass->cgBuildAccessorsArray(\@AA); # You should initialize yourself array attributes sub new { shift->SUPER::new(attribute3 => [], attribute4 => [], @_) } sub other { my $self = shift; @_ ? $self->[$self->cgGetIndice('other')] = [ split(/\n/, shift) ] : @{$self->[$self->cgGetIndice('other')]}; } # Create a subclass in SubClass.pm package My::SubClass; our @ISA = qw(My::BaseClass); our @AS = qw(subclassAttribute); My::SubClass->cgBuildIndices; My::SubClass->cgBuildAccessorsScalar(\@AS); sub new { shift->SUPER::new( attribute1 => 'val1', attribute2 => 'val2', attribute3 => [ 'val3', ], attribute4 => [ 'val4', ], other => [ 'none', ], subclassAttribute => 'subVal', ); } # A program using those classes package main; my $new = My::SubClass->new; my $val1 = $new->attribute1; my @values3 = $new->attribute3; my @otherOld = $new->other; $new->other("str1\nstr2\nstr3"); my @otherNew = $new->other; print "@otherNew\n"; $new->attribute2('newValue'); $new->attribute4([ 'newVal1', 'newVal2', ]); print $new->cgDumper."\n";