File Coverage

blib/lib/Class/Gomor/Hash.pm
Criterion Covered Total %
statement 34 38 89.4
branch 9 10 90.0
condition 4 9 44.4
subroutine 9 12 75.0
pod 5 5 100.0
total 61 74 82.4


line stmt bran cond sub pod time code
1             #
2             # $Id: Hash.pm 2000 2015-01-13 18:24:09Z gomor $
3             #
4             package Class::Gomor::Hash;
5 6     6   3114 use strict; use warnings;
  6     6   32  
  6         222  
  6         27  
  6         9  
  6         327  
6              
7             our $VERSION = '1.03';
8              
9 6     6   1573 use Class::Gomor;
  6         10  
  6         294  
10 6     6   31 use base qw(Class::Gomor);
  6         9  
  6         463  
11              
12 6     6   4178 use Data::Dumper;
  6         46008  
  6         2334  
13              
14             sub new {
15 4     4 1 18 my $self = shift;
16 4   33     26 my $class = ref($self) || $self;
17 4         10 my %h = @_;
18 4 100       24 $class->cgCheckParams(\%h, $class->cgGetAttributes)
19             unless $Class::Gomor::NoCheck;
20 4         25 bless(\%h, $class);
21             }
22              
23             # Just for compatibility with Class::Gomor::Array
24             # And in order to make it easy to switch for one to another
25 0     0 1 0 sub cgGetIndice { shift; shift }
  0         0  
26 0     0 1 0 sub cgBuildIndices {}
27              
28             sub cgFullClone {
29 11     11 1 14 my $self = shift;
30 11         8 my ($n) = @_;
31 11 100       19 return $self->SUPER::cgFullClone($n) if $n;
32 10   33     15 my $class = ref($self) || $self;
33 10         7 my %new;
34 10         17 for my $k (keys %$self) {
35 30         20 my $v = $self->{$k};
36 30 50 66     80 (ref($v) && UNIVERSAL::isa($v, 'Class::Gomor'))
37             ? $new{$k} = $v->cgFullClone
38             : $new{$k} = $v;
39             }
40 10         24 bless(\%new, $class);
41             }
42              
43 0     0 1 0 sub cgDumper { Dumper(shift()) }
44              
45             sub _cgAccessorScalar {
46 17     17   19 my ($self, $sca) = (shift, shift);
47 17 100       1419 @_ ? $self->{$sca} = shift
48             : $self->{$sca};
49             }
50              
51             sub _cgAccessorArray {
52 8     8   24 my ($self, $ary) = (shift, shift);
53 4         358 @_ ? $self->{$ary} = shift
54 8 100       20 : @{$self->{$ary}};
55             }
56              
57             1;
58              
59             =head1 NAME
60              
61             Class::Gomor::Hash - class and object builder, hash version
62              
63             =head1 SYNPOSIS
64              
65             # Create a base class in BaseClass.pm
66             package My::BaseClass;
67              
68             require Class::Gomor::Hash;
69             our @ISA = qw(Class::Gomor::Hash);
70              
71             our @AS = qw(attribute1 attribute2);
72             our @AA = qw(attribute3 attribute4);
73             our @AO = qw(other);
74              
75             # You should initialize yourself array attributes
76             sub new { shift->SUPER::new(attribute3 => [], attribute4 => [], @_) }
77              
78             # Create accessors
79             My::BaseClass->cgBuildAccessorsScalar(\@AS);
80             My::BaseClass->cgBuildAccessorsArray(\@AA);
81              
82             sub other {
83             my $self = shift;
84             @_ ? $self->{'other'} = [ split(/\n/, shift) ]
85             : @{$self->{'other'}};
86             }
87              
88             1;
89              
90             # Create a subclass in SubClass.pm
91             package My::SubClass;
92              
93             require My::BaseClass;
94             our @ISA = qw(My::BaseClass);
95              
96             our @AS = qw(subclassAttribute);
97              
98             My::SubClass->cgBuildAccessorsScalar(\@AS);
99              
100             sub new {
101             shift->SUPER::new(
102             attribute1 => 'val1',
103             attribute2 => 'val2',
104             attribute3 => [ 'val3', ],
105             attribute4 => [ 'val4', ],
106             other => [ 'none', ],
107             subclassAttribute => 'subVal',
108             );
109             }
110              
111             1;
112              
113             # A program using those classes
114              
115             my $new = My::SubClass->new;
116              
117             my $val1 = $new->attribute1;
118             my @values3 = $new->attribute3;
119             my @otherOld = $new->other;
120              
121             $new->other("str1\nstr2\nstr3");
122             my @otherNew = $new->other;
123             print "@otherNew\n";
124              
125             $new->attribute2('newValue');
126             $new->attribute4([ 'newVal1', 'newVal2', ]);
127              
128             =head1 DESCRIPTION
129              
130             This class is a subclass from B. It implements objects as hash references, and inherits methods from B.
131              
132             =head1 GLOBAL VARIABLE
133              
134             See B.
135              
136             =head1 METHODS
137              
138             =over 4
139              
140             =item B (hash)
141              
142             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).
143              
144             =item B
145              
146             This method does nothing. It only exists to make it more easy to switch between B and B.
147              
148             =item B (array ref)
149              
150             =item B (array ref)
151              
152             See B.
153              
154             =item B (scalar)
155              
156             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.
157              
158             =item B [ (scalar) ]
159              
160             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.
161              
162             =item B [ (scalar) ]
163              
164             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.
165              
166             Another thing to note, there is no catch for cycling references (when you link two objects with each others). You have been warned.
167              
168             =item B
169              
170             Will return a string as with B Dumper method. This is less useful for hashref objects, because they already include attributes names.
171              
172             =back
173              
174             =head1 SEE ALSO
175              
176             L
177              
178             =head1 AUTHOR
179            
180             Patrice EGomoRE Auffret
181            
182             =head1 COPYRIGHT AND LICENSE
183            
184             Copyright (c) 2004-2015, Patrice EGomoRE Auffret
185              
186             You may distribute this module under the terms of the Artistic license.
187             See LICENSE.Artistic file in the source distribution archive.
188              
189             =cut