File Coverage

gen/attr-PerlBean_Attribute_Factory.pl
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1 1     1   4 use strict;
  1         2  
  1         159  
2              
3             push(@::bean_desc, {
4             bean_opt => {
5             abstract => 'C object factory',
6             package => 'PerlBean::Attribute::Factory',
7             use_perl_version => 5.005,
8             description => <
9             C objects create instances of C objects.
10             EOF
11             short_description => 'factory package to generate C objects',
12             synopsis => &get_syn(),
13             },
14             attr_opt => [
15             ],
16             meth_opt => [
17             {
18             method_name => 'create_attribute',
19             parameter_description => 'OPT_HASH_REF',
20             description => <
21             Returns C objects based on C. C is a hash reference used to pass initialization options. The selected subclass of C is initialized using C. On error an exception C is thrown.
22              
23             Options for C used by this method may include:
24              
25             =over
26              
27             =item associative
28              
29             Boolean flag. States that the returned attribute must be unique, associative C. Defaults to B<0>. Only makes sense if C is B and B is true.
30              
31             =item method_key
32              
33             Boolean flag. States that the returned attribute must be unique, associative C. Defaults to B<0>. Only makes sense if C is B and B is true.
34              
35             =item ordered
36              
37             Boolean flag. States that the returned attribute must be an ordered list. Defaults to B<0>. Only makes sense if C is B.
38              
39             =item type
40              
41             If C is B a C, on B a C and on B a C is returned. Defaults to B<'SINGLE'>. B B has precedence over B and B.
42              
43             =item unique
44              
45             Boolean flag. States that the items in the C attribute must be unique. Defaults to B<0>. Only makes sense if C is B.
46              
47             =back
48              
49             Options for C passed to package B> may include:
50              
51             =over
52              
53             =item B>
54              
55             Passed to L.
56              
57             =item B>
58              
59             Passed to L. Defaults to B<'Error::Simple'>.
60              
61             =item B>
62              
63             Passed to L. Defaults to B<0>.
64              
65             =item B>
66              
67             Passed to L.
68              
69             =item B>
70              
71             Passed to L. Mandatory option.
72              
73             =item B>
74              
75             Passed to L.
76              
77             =item B>
78              
79             Passed to L.
80              
81             =back
82              
83             Options for C passed to package B> may include:
84              
85             =over
86              
87             =item B>
88              
89             Passed to L. Defaults to B<1>.
90              
91             =item B>
92              
93             Passed to L. Must be an C reference.
94              
95             =item B>
96              
97             Passed to L. Must be an C reference.
98              
99             =item B>
100              
101             Passed to L. Must be an C reference.
102              
103             =item B>
104              
105             Passed to L. Must be an C reference.
106              
107             =back
108             EOF
109             body => <
110             my \$self = shift;
111             my \$opt = shift || {};
112              
113             # Switch attribute type
114             if ( ! defined(\$opt->{type} ) || \$opt->{type} eq 'SINGLE') {
115             require PerlBean::Attribute::Single;
116             return( PerlBean::Attribute::Single->new(\$opt) );
117             }
118             elsif ( \$opt->{type} eq 'BOOLEAN' ) {
119             require PerlBean::Attribute::Boolean;
120             return( PerlBean::Attribute::Boolean->new(\$opt) );
121             }
122             elsif ( \$opt->{type} eq 'MULTI' ) {
123             if ( \$opt->{unique} ) {
124             if ( \$opt->{ordered} ) {
125             require PerlBean::Attribute::Multi::Unique::Ordered;
126             return( PerlBean::Attribute::Multi::Unique::Ordered->new(\$opt) );
127             }
128             elsif ( \$opt->{associative} ) {
129             if ( \$opt->{method_key} ) {
130             require PerlBean::Attribute::Multi::Unique::Associative::MethodKey;
131             return( PerlBean::Attribute::Multi::Unique::Associative::MethodKey->new(\$opt) );
132             }
133             else {
134             require PerlBean::Attribute::Multi::Unique::Associative;
135             return( PerlBean::Attribute::Multi::Unique::Associative->new(\$opt) );
136             }
137             }
138             else {
139             require PerlBean::Attribute::Multi::Unique;
140             return( PerlBean::Attribute::Multi::Unique->new(\$opt) );
141             }
142             }
143             else {
144             require PerlBean::Attribute::Multi::Ordered;
145             return( PerlBean::Attribute::Multi::Ordered->new(\$opt) );
146             }
147             }
148             else {
149             throw Error::Simple("ERROR: PerlBean::Attribute::Factory::attribute, option 'type' must be one of 'BOOLEAN', 'SINGLE' or 'MULTI' and NOT '\$opt->{type}'.");
150             }
151             EOF
152             },
153             ],
154             } );
155              
156             sub get_syn {
157 1     1   5 use IO::File;
  1         1  
  1         207  
158             my $fh = IO::File->new('< syn-PerlBean_Attribute_Factory.pl');
159             $fh = IO::File->new('< gen/syn-PerlBean_Attribute_Factory.pl') if (! defined($fh));
160             my $syn = '';
161             my $prev_line = $fh->getline ();
162             while (my $line = $fh->getline ()) {
163             $syn .= ' ' . $prev_line;
164             $prev_line = $line;
165             }
166             return($syn);
167             }
168              
169             1;