|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
  
 
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate;  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::VERSION = '1.17';  | 
| 
3
 | 
22
 | 
 
 | 
 
 | 
  
22
  
 | 
 
 | 
94709
 | 
 use 5.010;  | 
| 
 
 | 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2578
 | 
    | 
| 
4
 | 
22
 | 
 
 | 
 
 | 
  
20
  
 | 
 
 | 
505
 | 
 use strict;  | 
| 
 
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
484
 | 
    | 
| 
 
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
958
 | 
    | 
| 
5
 | 
20
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
442
 | 
 use Carp;  | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
45
 | 
    | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1092
 | 
    | 
| 
6
 | 
17
 | 
 
 | 
 
 | 
  
18
  
 | 
 
 | 
201
 | 
 use warnings::register;  | 
| 
 
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
    | 
| 
 
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2156
 | 
    | 
| 
7
 | 
18
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
5853
 | 
 use Symbol qw(&delete_package);  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8981
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1383
 | 
    | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 BEGIN {  | 
| 
10
 | 
21
 | 
 
 | 
 
 | 
  
21
  
 | 
 
 | 
497
 | 
     use vars qw(@ISA @EXPORT_OK);  | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
80
 | 
    | 
| 
 
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
643
 | 
    | 
| 
11
 | 
21
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
885
 | 
     use vars qw($save $accept_refs $strict $allow_redefine $class_var $instance_var $check_params $check_code $check_default $nfi $warnings);  | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
    | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1728
 | 
    | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
13
 | 
17
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
647
 | 
     require Exporter;  | 
| 
14
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
260
 | 
     @ISA = qw(Exporter);  | 
| 
15
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
72
 | 
     @EXPORT_OK = (qw(&class &subclass &delete_class), qw($save $accept_refs $strict $allow_redefine $class_var $instance_var $check_params $check_code $check_default $nfi $warnings));  | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
17
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3077
 | 
     $accept_refs    = 1;  | 
| 
18
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
     $strict	    = 1;  | 
| 
19
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     $allow_redefine = 0;  | 
| 
20
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
139
 | 
     $class_var	    = 'class';  | 
| 
21
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
     $instance_var   = 'self';  | 
| 
22
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     $check_params   = 1;  | 
| 
23
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
354
 | 
     $check_code	    = 1;  | 
| 
24
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
39
 | 
     $check_default  = 1;  | 
| 
25
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
     $nfi	    = 0;  | 
| 
26
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1691
 | 
     $warnings	    = 1;  | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
29
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
88
 | 
 use vars qw(@_initial_values);	# Holds all initial values passed as references.  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55982
 | 
    | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my ($class_name, $class);  | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my ($class_vars, $use_packages, $excluded_methods, $param_style_spec, $default_pss);  | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %class_options;  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $cm;				# These variables are for error messages.  | 
| 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $sa_needed		 = 'must be string or array reference';  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $sh_needed		 = 'must be string or hash reference';  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $allow_redefine_for_class;  | 
| 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my ($initialize,				# These variables all hold  | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $parse_any_flags,				# references to package-local  | 
| 
43
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $set_class_type,				# subs that other packages  | 
| 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $parse_class_specification,			# shouldn't call.  | 
| 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $parse_method_specification,  | 
| 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $parse_member_specification,  | 
| 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $set_attributes,  | 
| 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class_defined,  | 
| 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $process_class,  | 
| 
50
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $store_initial_value_reference,  | 
| 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $check_for_invalid_parameter_names,  | 
| 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $constructor_parameter_passing_style,  | 
| 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $verify_class_type,  | 
| 
54
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $croak_if_duplicate_names,  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $invalid_spec_message);  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %valid_option = map(substr($_, 0, 1) eq '$' ? (substr($_,1) => 1) : (), @EXPORT_OK);  | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %class_to_ref_map = (  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     'Class::Generate::Array_Class' => 'ARRAY',  | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     'Class::Generate::Hash_Class'  => 'HASH'  | 
| 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 );  | 
| 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %warnings_keys = map(($_ => 1), qw(use no register));  | 
| 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class(%) {					# One of the three interface  | 
| 
65
 | 
54
 | 
 
 | 
 
 | 
  
54
  
 | 
  
1
  
 | 
1742
 | 
     my %params = @_;				# routines to the package.  | 
| 
66
 | 
54
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
202
 | 
     if ( defined $params{-parent} ) {		# Defines a class or a  | 
| 
67
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
 	subclass(@_);				# subclass.  | 
| 
68
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
 	return;  | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
70
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
172
 | 
     &$initialize();  | 
| 
71
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
222
 | 
     &$parse_any_flags(\%params);  | 
| 
72
 | 
48
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
164
 | 
     croak "Missing/extra arguments to class()"		if scalar(keys %params) != 1;  | 
| 
73
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
144
 | 
     ($class_name, undef) = %params;  | 
| 
74
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
366
 | 
     $cm = qq|Class "$class_name"|;  | 
| 
75
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
181
 | 
     &$verify_class_type($params{$class_name});  | 
| 
76
 | 
47
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
205
 | 
     croak "$cm: A package of this name already exists"	if ! $allow_redefine_for_class && &$class_defined($class_name);  | 
| 
77
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
220
 | 
     &$set_class_type($params{$class_name});  | 
| 
78
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
143
 | 
     &$process_class($params{$class_name});  | 
| 
79
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
80
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub subclass(%) {				# One of the three interface  | 
| 
82
 | 
15
 | 
 
 | 
 
 | 
  
16
  
 | 
  
1
  
 | 
281
 | 
     my %params = @_;				# routines to the package.  | 
| 
83
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     &$initialize();				# Defines a subclass.  | 
| 
84
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
35
 | 
     my ($p_spec, $parent);  | 
| 
85
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
72
 | 
     if ( defined ($p_spec = $params{-parent}) ) {  | 
| 
86
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
 	delete $params{-parent};  | 
| 
87
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
89
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	croak "Missing subclass parent";  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
91
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
35
 | 
     eval { $parent = Class::Generate::Array->new($p_spec) };  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
    | 
| 
92
 | 
15
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
98
 | 
     croak qq|Invalid parent specification ($sa_needed)|		if $@ || scalar($parent->values) == 0;  | 
| 
93
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     &$parse_any_flags(\%params);  | 
| 
94
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
68
 | 
     croak "Missing/extra arguments to subclass()"		if scalar(keys %params) != 1;  | 
| 
95
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54
 | 
     ($class_name, undef) = %params;  | 
| 
96
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
61
 | 
     $cm = qq|Subclass "$class_name"|;  | 
| 
97
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
85
 | 
     &$verify_class_type($params{$class_name});  | 
| 
98
 | 
15
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
91
 | 
     croak "$cm: A package of this name already exists"		if ! $allow_redefine_for_class && &$class_defined($class_name);  | 
| 
99
 | 
15
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
102
 | 
     my $assumed_type = UNIVERSAL::isa($params{$class_name}, 'ARRAY') ? 'ARRAY' : 'HASH';  | 
| 
100
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
     my $child_type = lc($assumed_type);  | 
| 
101
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
     for my $p ( $parent->values ) {  | 
| 
102
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
 	my $c = Class::Generate::Class_Holder::get($p, $assumed_type);  | 
| 
103
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
49
 | 
 	croak qq|$cm: Parent package "$p" does not exist|	if ! defined $c;  | 
| 
104
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
 	my $parent_type = lc($class_to_ref_map{ref $c});  | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak "$cm: $child_type-based class must have $child_type-based parent ($p is $parent_type-based)"  | 
| 
106
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
82
 | 
 								if ! UNIVERSAL::isa($params{$class_name}, $class_to_ref_map{ref $c});  | 
| 
107
 | 
15
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
2323
 | 
 	warnings::warn(qq{$cm: Parent class "$p" was not defined using class() or subclass(); $child_type reference assumed})  | 
| 
108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 								if warnings::enabled() && eval "! exists \$" . $p . '::{_cginfo}';  | 
| 
109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
110
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
96
 | 
     &$set_class_type($params{$class_name}, $parent);  | 
| 
111
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55
 | 
     for my $p ( $parent->values ) {  | 
| 
112
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55
 | 
 	$class->add_parents(Class::Generate::Class_Holder::get($p));  | 
| 
113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
114
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
     &$process_class($params{$class_name});  | 
| 
115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub delete_class(@) {					# One of the three interface routines  | 
| 
118
 | 
  
0
  
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
0
 | 
     for my $class ( @_ ) {				# to the package.  Deletes a class  | 
| 
119
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	next if ! eval '%' . $class . '::';		# declared using Class::Generate.  | 
| 
120
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	if ( ! eval '%' . $class . '::_cginfo' ) {  | 
| 
121
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    croak $class, ': Class was not declared using ', __PACKAGE__;  | 
| 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
123
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	delete_package($class);  | 
| 
124
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	Class::Generate::Class_Holder::remove($class);  | 
| 
125
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	my $code_checking_package = __PACKAGE__ . '::Code_Checker::check::' . $class . '::';  | 
| 
126
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	if ( eval '%' . $code_checking_package ) {  | 
| 
127
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    delete_package($code_checking_package);  | 
| 
128
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
131
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $default_pss = Class::Generate::Array->new('key_value');  | 
| 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $initialize = sub {			# Reset certain variables, and set  | 
| 
135
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     undef $class_vars;			# options to their default values.  | 
| 
136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     undef $use_packages;  | 
| 
137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     undef $excluded_methods;  | 
| 
138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $param_style_spec = $default_pss;  | 
| 
139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     %class_options = ( virtual	    => 0,  | 
| 
140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       strict	    => $strict,  | 
| 
141
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       save	    => $save,  | 
| 
142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       accept_refs  => $accept_refs,  | 
| 
143
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       class_var    => $class_var,  | 
| 
144
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       instance_var => $instance_var,  | 
| 
145
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       check_params => $check_params,  | 
| 
146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       check_code   => $check_code,  | 
| 
147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       check_default=> $check_default,  | 
| 
148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       nfi	    => $nfi,  | 
| 
149
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		       warnings	    => $warnings );  | 
| 
150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $allow_redefine_for_class = $allow_redefine;  | 
| 
151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $verify_class_type = sub {		# Ensure that the class specification  | 
| 
154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $spec = $_[0];			# is a hash or array reference.  | 
| 
155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return if UNIVERSAL::isa($spec, 'HASH') || UNIVERSAL::isa($spec, 'ARRAY');  | 
| 
156
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     croak qq|$cm: Elements must be in array or hash reference|;  | 
| 
157
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $set_class_type = sub {			# Set $class to the type (array or  | 
| 
160
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($class_spec, $parent) = @_;	# hash) appropriate to its declaration.  | 
| 
161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my @params = ($class_name, %class_options);  | 
| 
162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( UNIVERSAL::isa($class_spec, 'ARRAY') ) {  | 
| 
163
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( defined $parent ) {  | 
| 
164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    my ($parent_name, @other_array_values) = $parent->values;  | 
| 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|$cm: An array reference based subclass must have exactly one parent|  | 
| 
166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if @other_array_values;  | 
| 
167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $parent = Class::Generate::Class_Holder::get($parent_name, 'ARRAY');  | 
| 
168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    push @params, ( base_index => $parent->last + 1 );  | 
| 
169
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
170
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$class = Class::Generate::Array_Class->new(@params);  | 
| 
171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$class = Class::Generate::Hash_Class->new(@params);  | 
| 
174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
177
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $class_name_regexp	 = '[A-Za-z_]\w*(::[A-Za-z_]\w*)*';  | 
| 
178
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
179
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $parse_class_specification = sub {	# Parse the class' specification,  | 
| 
180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my %specs = @_;			# checking for errors and amalgamating  | 
| 
181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my %required;			# class data.  | 
| 
182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( defined $specs{new} ) {  | 
| 
184
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Specification for "new" must be hash reference|  | 
| 
185
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    unless UNIVERSAL::isa($specs{new}, 'HASH');  | 
| 
186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my %new_spec = %{$specs{new}};	# Modify %new_spec, not parameter passed  | 
| 
187
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my $required_items;		# to class() or subclass().  | 
| 
188
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( defined $new_spec{required} ) {  | 
| 
189
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $required_items = Class::Generate::Array->new($new_spec{required}) };  | 
| 
190
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|$cm: Invalid specification for required constructor parameters ($sa_needed)| if $@;  | 
| 
191
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    delete $new_spec{required};  | 
| 
192
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
193
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( defined $new_spec{style} ) {  | 
| 
194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $param_style_spec = Class::Generate::Array->new($new_spec{style}) };  | 
| 
195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|$cm: Invalid parameter-passing style ($sa_needed)| if $@;  | 
| 
196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    delete $new_spec{style};  | 
| 
197
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
198
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$class->constructor(Class::Generate::Constructor->new(%new_spec));  | 
| 
199
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( defined $required_items ) {  | 
| 
200
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    for ( $required_items->values ) {  | 
| 
201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ( /^\w+$/ ) {  | 
| 
202
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    croak qq|$cm: Required params list for constructor contains unknown member "$_"|  | 
| 
203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			if ! defined $specs{$_};  | 
| 
204
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    $required{$_} = 1;  | 
| 
205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
206
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		else {  | 
| 
207
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    $class->constructor->add_constraints($_);  | 
| 
208
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
209
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
212
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
213
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$class->constructor(Class::Generate::Constructor->new);  | 
| 
214
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $actual_name;  | 
| 
217
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for my $member_name ( grep $_ ne 'new', keys %specs ) {  | 
| 
218
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$actual_name = $member_name;  | 
| 
219
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$actual_name =~ s/^&//;  | 
| 
220
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Invalid member/method name "$actual_name"| unless $actual_name =~ /^[A-Za-z_]\w*$/;  | 
| 
221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: "$instance_var" is reserved|		 unless $actual_name ne $class_options{instance_var};  | 
| 
222
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( substr($member_name, 0, 1) eq '&' ) {  | 
| 
223
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    &$parse_method_specification($member_name, $actual_name, \%specs);  | 
| 
224
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
225
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
226
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    &$parse_member_specification($member_name, \%specs, \%required);  | 
| 
227
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
229
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->constructor->style(&$constructor_parameter_passing_style);  | 
| 
230
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
231
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $parse_method_specification = sub {  | 
| 
233
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($member_name, $actual_name, $specs) = @_;  | 
| 
234
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my (%spec, $method);  | 
| 
235
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     eval { %spec = %{Class::Generate::Hash->new($$specs{$member_name} || die, 'body')} };  | 
| 
237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     croak &$invalid_spec_message('method', $actual_name, 'body') if $@;  | 
| 
238
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
239
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $spec{class_method} ) {  | 
| 
240
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Method "$actual_name": A class method cannot be protected| if $spec{protected};  | 
| 
241
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$method = Class::Generate::Class_Method->new($actual_name, $spec{body});  | 
| 
242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( $spec{objects} ) {  | 
| 
243
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $method->add_objects((Class::Generate::Array->new($spec{objects}))->values) };  | 
| 
244
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|$cm: Invalid specification for objects of "$actual_name" ($sa_needed)| if $@;  | 
| 
245
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
246
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	delete $spec{objects} if exists $spec{objects};  | 
| 
247
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
248
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$method = Class::Generate::Method->new($actual_name, $spec{body});  | 
| 
250
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
251
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     delete $spec{class_method} if exists $spec{class_method};  | 
| 
252
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->user_defined_methods($actual_name, $method);  | 
| 
253
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     &$set_attributes($actual_name, $method, 'Method', 'body', \%spec);  | 
| 
254
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
255
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
256
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $parse_member_specification = sub {  | 
| 
257
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($member_name, $specs, $required) = @_;  | 
| 
258
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my (%spec, $member, %member_params);  | 
| 
259
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
260
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     eval { %spec = %{Class::Generate::Hash->new($$specs{$member_name} || die, 'type')} };  | 
| 
261
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     croak &$invalid_spec_message('member', $member_name, 'type') if $@;  | 
| 
262
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
263
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $spec{required} = 1 if $$required{$member_name};  | 
| 
264
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( exists $spec{default} ) {  | 
| 
265
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( warnings::enabled() && $class_options{check_default} ) {  | 
| 
266
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { Class::Generate::Support::verify_value($spec{default}, $spec{type}) };  | 
| 
267
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    warnings::warn(qq|$cm: Default value for "$member_name" is not correctly typed|) if $@;  | 
| 
268
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
269
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	&$store_initial_value_reference(\$spec{default}, $member_name) if ref $spec{default};  | 
| 
270
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$member_params{default} = $spec{default};  | 
| 
271
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
272
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     %member_params = map defined $spec{$_} ? ($_ => $spec{$_}) : (), qw(post pre assert);  | 
| 
273
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $spec{type} =~ m/^[\$@%]?($class_name_regexp)$/o ) {  | 
| 
274
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$member_params{base} = $1;  | 
| 
275
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
276
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( $spec{type} !~ m/^[\$\@\%]$/ ) {  | 
| 
277
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Member "$member_name": "$spec{type}" is not a valid type|;  | 
| 
278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
279
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $spec{required} && ($spec{private} || $spec{protected}) ) {  | 
| 
280
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	warnings::warn(qq|$cm: "required" attribute ignored for private/protected member "$member_name"|) if warnings::enabled();  | 
| 
281
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	delete $spec{required};  | 
| 
282
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
283
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $spec{private} && $spec{protected} ) {  | 
| 
284
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	warnings::warn(qq|$cm: Member "$member_name" declared both private and protected (protected assumed)|) if warnings::enabled();  | 
| 
285
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	delete $spec{private};  | 
| 
286
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
287
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     delete @member_params{grep ! defined $member_params{$_}, keys %member_params};  | 
| 
288
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( substr($spec{type}, 0, 1) eq '@' ) {  | 
| 
289
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$member = Class::Generate::Array_Member->new($member_name, %member_params);  | 
| 
290
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
291
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( substr($spec{type}, 0, 1) eq '%' ) {  | 
| 
292
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$member = Class::Generate::Hash_Member->new($member_name, %member_params);  | 
| 
293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
294
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
295
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$member = Class::Generate::Scalar_Member->new($member_name, %member_params);  | 
| 
296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
297
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     delete $spec{type};  | 
| 
298
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->members($member_name, $member);  | 
| 
299
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     &$set_attributes($member_name, $member, 'Member', undef, \%spec);  | 
| 
300
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
301
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
302
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $parse_any_flags = sub {  | 
| 
303
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $params = $_[0];  | 
| 
304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my %flags = map substr($_, 0, 1) eq '-' ? ($_ => $$params{$_}) : (), keys %$params;  | 
| 
305
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return if ! %flags;  | 
| 
306
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
   flag:  | 
| 
307
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     while ( my ($flag, $value) = each %flags ) {  | 
| 
308
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-use' and do {  | 
| 
309
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $use_packages = Class::Generate::Array->new($value) };  | 
| 
310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|"-use" flag $sa_needed| if $@;  | 
| 
311
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
312
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
313
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-class_vars' and do {  | 
| 
314
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $class_vars = Class::Generate::Array->new($value) };  | 
| 
315
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|"-class_vars" flag $sa_needed| if $@;  | 
| 
316
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    for my $var_spec ( grep ref($_), $class_vars->values ) {  | 
| 
317
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		croak 'Each class variable must be scalar or hash reference'  | 
| 
318
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    unless UNIVERSAL::isa($var_spec, 'HASH');  | 
| 
319
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		for my $var ( grep ref($$var_spec{$_}), keys %$var_spec ) {  | 
| 
320
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    &$store_initial_value_reference(\$$var_spec{$var}, $var);  | 
| 
321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
322
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
323
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
324
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
325
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-virtual' and do {  | 
| 
326
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class_options{virtual} = $value;  | 
| 
327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
328
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
329
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-exclude' and do {  | 
| 
330
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    eval { $excluded_methods = Class::Generate::Array->new($value) };  | 
| 
331
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|"-exclude" flag $sa_needed| if $@;  | 
| 
332
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
333
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
334
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-comment' and do {  | 
| 
335
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class_options{comment} = $value;  | 
| 
336
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
337
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
338
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$flag eq '-options' and do {  | 
| 
339
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak qq|Options must be in hash reference| unless UNIVERSAL::isa($value, 'HASH');  | 
| 
340
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    if ( exists $$value{allow_redefine} ) {  | 
| 
341
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		$allow_redefine_for_class = $$value{allow_redefine};  | 
| 
342
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		delete $$value{allow_redefine};  | 
| 
343
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
344
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  option:  | 
| 
345
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    while ( my ($o, $o_value) = each %$value ) {  | 
| 
346
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ( ! $valid_option{$o} ) {  | 
| 
347
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     warnings::warn(qq|Unknown option "$o" ignored|) if warnings::enabled();  | 
| 
348
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     next option;  | 
| 
349
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 }  | 
| 
350
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		$class_options{$o} = $o_value;  | 
| 
351
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
352
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    if ( exists $class_options{warnings} ) {  | 
| 
354
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		my $w = $class_options{warnings};  | 
| 
355
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		if ( ref $w ) {  | 
| 
356
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    croak 'Warnings must be scalar value or array reference' unless UNIVERSAL::isa($w, 'ARRAY');  | 
| 
357
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    croak 'Warnings array reference must have even number of elements' unless $#$w % 2 == 1;  | 
| 
358
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    for ( my $i = 0; $i <= $#$w; $i += 2 ) {  | 
| 
359
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			croak qq|Warnings array: Unknown key "$$w[$i]"| unless exists $warnings_keys{$$w[$i]};  | 
| 
360
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		    }  | 
| 
361
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		}  | 
| 
362
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
363
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
364
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    next flag;  | 
| 
365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	};  | 
| 
366
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	warnings::warn(qq|Unknown flag "$flag" ignored|) if warnings::enabled();  | 
| 
367
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
368
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     delete @$params{keys %flags};  | 
| 
369
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
370
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				# Set the appropriate attributes of  | 
| 
371
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $set_attributes = sub {		# a member or method w.r.t. a class.  | 
| 
372
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($name, $m, $type, $exclusion, $spec) = @_;  | 
| 
373
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for my $attr ( defined $exclusion ? grep($_ ne $exclusion, keys %$spec) : keys %$spec ) {  | 
| 
374
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( $m->can($attr) ) {  | 
| 
375
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $m->$attr($$spec{$attr});  | 
| 
376
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
377
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	elsif ( $class->can($attr) ) {  | 
| 
378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class->$attr($name, $$spec{$attr});  | 
| 
379
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
380
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
381
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    warnings::warn(qq|$cm: $type "$name": Unknown attribute "$attr"|) if warnings::enabled();  | 
| 
382
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
383
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
384
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
385
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
386
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $containing_package = __PACKAGE__ . '::';  | 
| 
387
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $initial_value_form = $containing_package . '_initial_values';  | 
| 
388
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
389
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $store_initial_value_reference = sub {		# Store initial values that are  | 
| 
390
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($default_value, $var_name) = @_;	# references in an accessible  | 
| 
391
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     push @_initial_values, $$default_value;	# place.  | 
| 
392
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $$default_value = "\$$initial_value_form" . "[$#_initial_values]";  | 
| 
393
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     warnings::warn(qq|Cannot save reference as initial value for "$var_name"|)  | 
| 
394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if $class_options{save} && warnings::enabled();  | 
| 
395
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
396
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
397
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $class_defined = sub {			# Return TRUE if the argument  | 
| 
398
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $class_name = $_[0];		# is the name of a Perl package.  | 
| 
399
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return eval '%'  . $class_name . '::';  | 
| 
400
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
401
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# Do the main work of processing a class.  | 
| 
402
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $process_class = sub {			# Parse its specification, generate a  | 
| 
403
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $class_spec = $_[0];		# form, and evaluate that form.  | 
| 
404
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my (@warnings, $errors);  | 
| 
405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     &$croak_if_duplicate_names($class_spec);  | 
| 
406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for my $var ( grep defined $class_options{$_}, qw(instance_var class_var) ) {  | 
| 
407
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Value of $var option must be an identifier (without a "\$")|  | 
| 
408
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    unless $class_options{$var} =~ /^[A-Za-z_]\w*$/;  | 
| 
409
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
410
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     &$parse_class_specification(UNIVERSAL::isa($class_spec, 'ARRAY') ? @$class_spec : %$class_spec);  | 
| 
411
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Class::Generate::Member_Names::set_element_regexps();  | 
| 
412
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->add_class_vars($class_vars->values)		    if $class_vars;  | 
| 
413
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->add_use_packages($use_packages->values)	    if $use_packages;  | 
| 
414
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->warnings($class_options{warnings})		    if $class_options{warnings};  | 
| 
415
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->check_params($class_options{check_params})	    if $class_options{check_params};  | 
| 
416
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $class->excluded_methods_regexp(join '|', map "(?:$_)", $excluded_methods->values)  | 
| 
417
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 							    if $excluded_methods;  | 
| 
418
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( warnings::enabled() && $class_options{check_code} ) {  | 
| 
419
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	Class::Generate::Code_Checker::check_user_defined_code($class, $cm, \@warnings, \$errors);  | 
| 
420
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	for my $warning ( @warnings ) {  | 
| 
421
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    warnings::warn($warning);  | 
| 
422
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
423
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	warnings::warn($errors) if $errors;  | 
| 
424
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
425
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $form = $class->form;  | 
| 
427
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $class_options{save} ) {  | 
| 
428
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my ($class_file, $ob, $cb);  | 
| 
429
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( $class_options{save} =~ /\.p[ml]$/ ) {  | 
| 
430
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class_file = $class_options{save};  | 
| 
431
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    open CLASS_FILE, ">>$class_file" or croak qq|$cm: Cannot append to "$class_file": $!|;  | 
| 
432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $ob = "{\n";	# The form is enclosed in braces to prevent  | 
| 
433
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $cb = "}\n";	# renaming duplicate "my" variables.  | 
| 
434
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
435
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
436
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class_file = $class_name . '.pm';  | 
| 
437
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $class_file =~ s|::|/|g;  | 
| 
438
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    open CLASS_FILE, ">$class_file" or croak qq|$cm: Cannot save to "$class_file": $!|;  | 
| 
439
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $ob = $cb = '';  | 
| 
440
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
441
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$form =~ s/^(my [%@\$]\w+) = ([%@]\{)?\$$initial_value_form\[\d+\]\}?;/$1;/mgo;  | 
| 
442
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	print CLASS_FILE $ob, $form, $cb, "\n1;\n";  | 
| 
443
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	close CLASS_FILE;  | 
| 
444
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
445
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     croak "$cm: Cannot continue after errors" if $errors;  | 
| 
446
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     {  | 
| 
447
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	local $SIG{__WARN__} = sub { };	# Warnings have been reported during  | 
| 
448
 | 
13
 | 
  
100
  
 | 
  
100
  
 | 
  
13
  
 | 
 
 | 
87
 | 
 	eval $form;			# user-defined code analysis.  | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
100
  
 | 
  
13
  
 | 
 
 | 
35
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
 33
  
 | 
  
13
  
 | 
 
 | 
350
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
 33
  
 | 
  
13
  
 | 
 
 | 
77
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
 33
  
 | 
  
12
  
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
 33
  
 | 
  
12
  
 | 
 
 | 
792
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
  0
  
 | 
  
12
  
 | 
 
 | 
71
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
  0
  
 | 
  
12
  
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
  0
  
 | 
  
12
  
 | 
 
 | 
496
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
  
  0
  
 | 
  
10
  
 | 
 
 | 
84
 | 
    | 
| 
 
 | 
13
 | 
  
 50
  
 | 
 
 | 
  
9
  
 | 
 
 | 
122
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
 
 | 
  
9
  
 | 
 
 | 
10470
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
9
  
 | 
 
 | 
73
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
9
  
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
1980
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
63
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
698
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
70
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
7
  
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
1
  
 | 
 
 | 
435
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
  
10
  
 | 
 
 | 
77
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
  
1
  
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
  
12
  
 | 
 
 | 
8234
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
76
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
1
  
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
1365
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
6
  
 | 
 
 | 
56
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
11
  
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
10
  
 | 
 
 | 
907
 | 
    | 
| 
 
 | 
9
 | 
  
100
  
 | 
 
 | 
  
10
  
 | 
 
 | 
47
 | 
    | 
| 
 
 | 
9
 | 
  
100
  
 | 
 
 | 
  
3
  
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
9
 | 
  
 50
  
 | 
 
 | 
  
1
  
 | 
 
 | 
377
 | 
    | 
| 
 
 | 
9
 | 
  
100
  
 | 
 
 | 
  
2
  
 | 
 
 | 
52
 | 
    | 
| 
 
 | 
9
 | 
  
 50
  
 | 
 
 | 
  
0
  
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
9
 | 
  
 50
  
 | 
 
 | 
  
10
  
 | 
 
 | 
8075
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
5
  
 | 
 
 | 
49
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
1
  
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
2
  
 | 
 
 | 
209
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
4
  
 | 
 
 | 
37
 | 
    | 
| 
 
 | 
8
 | 
  
  0
  
 | 
 
 | 
  
2
  
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
8
 | 
  
  0
  
 | 
 
 | 
  
4
  
 | 
 
 | 
1058
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
3
  
 | 
 
 | 
52
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
3
  
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
52
  
 | 
 
 | 
288
 | 
    | 
| 
 
 | 
8
 | 
  
  0
  
 | 
 
 | 
  
51
  
 | 
 
 | 
41
 | 
    | 
| 
 
 | 
8
 | 
  
  0
  
 | 
 
 | 
  
25
  
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
8
 | 
  
  0
  
 | 
 
 | 
  
23
  
 | 
 
 | 
6009
 | 
    | 
| 
 
 | 
8
 | 
  
 50
  
 | 
 
 | 
  
8
  
 | 
 
 | 
56
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
22
  
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
8
  
 | 
 
 | 
692
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
6
  
 | 
 
 | 
50
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
3
  
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
4
  
 | 
 
 | 
364
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
2
  
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
2
  
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
8
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
438
 | 
    | 
| 
 
 | 
7
 | 
  
100
  
 | 
 
 | 
  
9
  
 | 
 
 | 
35
 | 
    | 
| 
 
 | 
7
 | 
  
100
  
 | 
 
 | 
  
2
  
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
7
 | 
  
100
  
 | 
 
 | 
  
11
  
 | 
 
 | 
3003
 | 
    | 
| 
 
 | 
1
 | 
  
100
  
 | 
 
 | 
  
4
  
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
  
0
  
 | 
  
 50
  
 | 
 
 | 
  
4
  
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
1
  
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
6
  
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
10
 | 
  
100
  
 | 
 
 | 
  
3
  
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
3
 | 
  
100
  
 | 
 
 | 
  
3
  
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
11
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
3
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
11
 | 
  
 50
  
 | 
 
 | 
  
0
  
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
3
 | 
  
100
  
 | 
 
 | 
  
0
  
 | 
 
 | 
39
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
 
 | 
2
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
4
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
61
 | 
    | 
| 
 
 | 
17
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
66
 | 
    | 
| 
 
 | 
21
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
63
 | 
    | 
| 
 
 | 
21
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
 
 | 
21
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
60
 | 
    | 
| 
 
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
16
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
16
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
159
 | 
    | 
| 
 
 | 
10
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
190
 | 
    | 
| 
 
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
105
 | 
    | 
| 
 
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
2
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
1
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
1
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
6
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
6
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
6
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
6
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
6
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
 
 | 
5
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
5
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
14
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
81
 | 
    | 
| 
 
 | 
12
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
50
 | 
    | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
13
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
107
 | 
    | 
| 
 
 | 
17
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
36
 | 
    | 
| 
 
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
25
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
44
 | 
    | 
| 
 
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
 
 | 
14
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
47
 | 
    | 
| 
 
 | 
14
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
15
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
23
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
69
 | 
    | 
| 
 
 | 
23
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
59
 | 
    | 
| 
 
 | 
27
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
64
 | 
    | 
| 
 
 | 
27
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
120
 | 
    | 
| 
 
 | 
17
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
81
 | 
    | 
| 
 
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
93
 | 
    | 
| 
 
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
4
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
33
 | 
    | 
| 
 
 | 
7
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
7
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
5
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
5
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
3
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
72
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
83
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
265
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
117
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
186
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
240
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1261
 | 
    | 
| 
 
 | 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
126
 | 
    | 
| 
 
 | 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
101
 | 
    | 
| 
 
 | 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
327
 | 
    | 
| 
 
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
157
 | 
    | 
| 
 
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
198
 | 
    | 
| 
 
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
227
 | 
    | 
| 
 
 | 
36
 | 
 
 | 
 
 | 
 
 | 
 
 | 
98
 | 
    | 
| 
 
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
    | 
| 
 
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
    | 
| 
 
 | 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1231
 | 
    | 
| 
 
 | 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
171
 | 
    | 
| 
 
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
258
 | 
    | 
| 
 
 | 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
202
 | 
    | 
| 
 
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
159
 | 
    | 
| 
 
 | 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
136
 | 
    | 
| 
 
 | 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
410
 | 
    | 
| 
 
 | 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
483
 | 
    | 
| 
 
 | 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
243
 | 
    | 
| 
 
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
92
 | 
    | 
| 
 
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
253
 | 
    | 
| 
 
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
675
 | 
    | 
| 
 
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
    | 
| 
 
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
156
 | 
    | 
| 
 
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
655
 | 
    | 
| 
 
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
103
 | 
    | 
| 
 
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
    | 
| 
 
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
73
 | 
    | 
| 
 
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
68
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
80
 | 
    | 
| 
 
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
865
 | 
    | 
| 
 
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
241
 | 
    | 
| 
 
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
    | 
| 
 
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
90
 | 
    | 
| 
 
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
70
 | 
    | 
| 
 
 | 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
81
 | 
    | 
| 
 
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
    | 
| 
 
 | 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
557
 | 
    | 
| 
 
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
194
 | 
    | 
| 
 
 | 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
114
 | 
    | 
| 
 
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54
 | 
    | 
| 
 
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
60
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
162
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
116
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
80
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
45
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
49
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
329
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
220
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
112
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
265
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
504
 | 
    | 
| 
 
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
110
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
158
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
197
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
263
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
63
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
63
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
148
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
449
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( $@ ) {  | 
| 
450
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    my @lines = split("\n", $form);  | 
| 
451
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    my ($l) = ($@ =~ /(\d+)\.$/);  | 
| 
452
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $@ =~ s/\(eval \d+\) //;  | 
| 
453
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    croak "$cm: Evaluation failed (problem in ", __PACKAGE__, "?)\n",  | 
| 
454
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   $@, "\n", join("\n", @lines[$l-1 .. $l+1]), "\n";  | 
| 
455
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
456
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
457
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Class::Generate::Class_Holder::store($class);  | 
| 
458
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
459
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
460
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $constructor_parameter_passing_style = sub {	# Establish the parameter-passing style  | 
| 
461
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my ($style,					# for a class' constructor, meanwhile  | 
| 
462
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         @values,				# checking for mismatches w.r.t. the  | 
| 
463
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$parent_with_constructor,		# class' superclass. Return an  | 
| 
464
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$parent_constructor_package_name);	# appropriate style.  | 
| 
465
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( defined $class->parents ) {  | 
| 
466
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$parent_with_constructor = Class::Generate::Support::class_containing_method('new', $class);  | 
| 
467
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$parent_constructor_package_name = (ref $parent_with_constructor ? $parent_with_constructor->name : $parent_with_constructor);  | 
| 
468
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
469
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     (($style, @values) = $param_style_spec->values)[0] eq 'key_value' and do {  | 
| 
470
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	if ( defined $parent_with_constructor && ref $parent_with_constructor && index(ref $parent_with_constructor, $containing_package) == 0 ) {  | 
| 
471
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    my $invoked_constructor_style = $parent_with_constructor->constructor->style;  | 
| 
472
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    unless ( $invoked_constructor_style->isa($containing_package . 'Key_Value') ||  | 
| 
473
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     $invoked_constructor_style->isa($containing_package . 'Own') ) {  | 
| 
474
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		warnings::warn(qq{$cm: Probable mismatch calling constructor in superclass "$parent_constructor_package_name"}) if warnings::enabled();  | 
| 
475
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
476
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
477
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	return Class::Generate::Key_Value->new('params', $class->public_member_names);  | 
| 
478
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
479
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $style eq 'positional' and do {  | 
| 
480
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	&$check_for_invalid_parameter_names(@values);  | 
| 
481
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my @member_names = $class->public_member_names;  | 
| 
482
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak "$cm: Missing/extra members in style" unless $#values == $#member_names;  | 
| 
483
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
484
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	return Class::Generate::Positional->new(@values);  | 
| 
485
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
486
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $style eq 'mix' and do {  | 
| 
487
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	&$check_for_invalid_parameter_names(@values);  | 
| 
488
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my @member_names = $class->public_member_names;  | 
| 
489
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak "$cm: Extra parameters in style specifier" unless $#values <= $#member_names;  | 
| 
490
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	my %kv_members = map(($_ => 1), @member_names);  | 
| 
491
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	delete @kv_members{@values};  | 
| 
492
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	return Class::Generate::Mix->new('params', [@values], keys %kv_members);  | 
| 
493
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
494
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $style eq 'own' and do {  | 
| 
495
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	for ( my $i = 0; $i <= $#values; $i++ ) {  | 
| 
496
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    &$store_initial_value_reference(\$values[$i], $parent_constructor_package_name . '::new') if ref $values[$i];  | 
| 
497
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
498
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	return Class::Generate::Own->new([@values]);  | 
| 
499
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
500
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     croak qq|$cm: Invalid parameter passing style "$style"|;  | 
| 
501
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
502
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
503
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $check_for_invalid_parameter_names = sub {  | 
| 
504
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my @param_names = @_;  | 
| 
505
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $i = 0;  | 
| 
506
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for my $param ( @param_names ) {  | 
| 
507
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Error in new => { style => '... $param' }: $param is not a member|  | 
| 
508
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    if ! defined $class->members($param);  | 
| 
509
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak qq|$cm: Error in new => { style => '... $param' }: $param is not a public member|  | 
| 
510
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    if $class->private($param) || $class->protected($param);  | 
| 
511
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
512
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my %uses;  | 
| 
513
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for my $param ( @param_names ) {  | 
| 
514
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$uses{$param}++;  | 
| 
515
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
516
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     %uses = map(($uses{$_} > 1 ? ($_ => $uses{$_}) : ()), keys %uses);  | 
| 
517
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( %uses ) {  | 
| 
518
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak "$cm: Error in new => { style => '...' }: ", join('; ', map qq|Name "$_" used $uses{$_} times|, keys %uses);  | 
| 
519
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
520
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
521
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
522
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $croak_if_duplicate_names = sub {  | 
| 
523
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my $class_spec = $_[0];  | 
| 
524
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     my (@names, %uses);  | 
| 
525
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( UNIVERSAL::isa($class_spec, 'ARRAY') ) {  | 
| 
526
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	for ( my $i = 0; $i <= $#$class_spec; $i += 2 ) {  | 
| 
527
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    push @names, $$class_spec[$i];  | 
| 
528
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
529
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
530
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
531
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	@names = keys %$class_spec;  | 
| 
532
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
533
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     for ( @names ) {  | 
| 
534
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	$uses{substr($_, 0, 1) eq '&' ? substr($_, 1) : $_}++;  | 
| 
535
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
536
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     %uses = map(($uses{$_} > 1 ? ($_ => $uses{$_}) : ()), keys %uses);  | 
| 
537
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( %uses ) {  | 
| 
538
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	croak "$cm: ", join('; ', map qq|Name "$_" used $uses{$_} times|, keys %uses);  | 
| 
539
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
540
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
541
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
542
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $invalid_spec_message = sub {  | 
| 
543
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return sprintf qq|$cm: Invalid specification of %s "%s" ($sh_needed with "%s" key)|, @_;  | 
| 
544
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
545
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
546
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Class_Holder;	# This package encapsulates functions  | 
| 
547
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Class_Holder::VERSION = '1.17';  | 
| 
548
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
349
 | 
 use strict;				# related to storing and retrieving  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19014
 | 
    | 
| 
549
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# information on classes.  It lets classes  | 
| 
550
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# saved in files be reused transparently.  | 
| 
551
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %classes;  | 
| 
552
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
553
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub store($) {				# Given a class, store it so it's  | 
| 
554
 | 
77
 | 
 
 | 
 
 | 
  
65
  
 | 
 
 | 
190
 | 
     my $class = $_[0];			# accessible in future invocations of  | 
| 
555
 | 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
284
 | 
     $classes{$class->name} = $class;	# class() and subclass().  | 
| 
556
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
557
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
558
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Given a class name, try to return an instance of Class::Generate::Class  | 
| 
559
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# that models the class.  The instance comes from one of 3 places.  We  | 
| 
560
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# first try to get it from wherever store() puts it.  If that fails,  | 
| 
561
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# we check to see if the variable %::_cginfo exists (see  | 
| 
562
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# form(), below); if it does, we use the information it contains to  | 
| 
563
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# create an instance of Class::Generate::Class.  If %::_cginfo  | 
| 
564
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# doesn't exist, the package wasn't created by Class::Generate.  We try  | 
| 
565
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# to infer some characteristics of the class.  | 
| 
566
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub get($;$) {  | 
| 
567
 | 
47
 | 
 
 | 
 
 | 
  
34
  
 | 
 
 | 
162
 | 
     my ($class_name, $default_type) = @_;  | 
| 
568
 | 
47
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
215
 | 
     return $classes{$class_name} if exists $classes{$class_name};  | 
| 
569
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
570
 | 
15
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
345
 | 
     return undef if ! eval '%' . $class_name . '::';		# Package doesn't exist.  | 
| 
571
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
572
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
422
 | 
     my ($class, %info);  | 
| 
573
 | 
10
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
163
 | 
     if ( ! eval "exists \$" . $class_name . '::{_cginfo}' ) {	# Package exists but is  | 
| 
574
 | 
7
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
114
 | 
 	return undef if ! defined $default_type;		# not a class generated  | 
| 
575
 | 
7
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
70
 | 
 	if ( $default_type eq 'ARRAY' ) {			# by Class::Generate.  | 
| 
576
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
 	    $class = new Class::Generate::Array_Class $class_name;  | 
| 
577
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
578
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
579
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 	    $class = new Class::Generate::Hash_Class $class_name;  | 
| 
580
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
581
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	$class->constructor(new Class::Generate::Constructor);  | 
| 
582
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
 	$class->constructor->style(new Class::Generate::Own);  | 
| 
583
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
125
 | 
 	$classes{$class_name} = $class;  | 
| 
584
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
182
 | 
 	return $class;  | 
| 
585
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
586
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
587
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
     eval '%info = %' . $class_name . '::_cginfo';  | 
| 
588
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     if ( $info{base} eq 'ARRAY' ) {  | 
| 
589
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 	$class = Class::Generate::Array_Class->new($class_name, last => $info{last});  | 
| 
590
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
591
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
592
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
 	$class = Class::Generate::Hash_Class->new($class_name);  | 
| 
593
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
594
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     if ( exists $info{members} ) {		# Add members ...  | 
| 
595
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	while ( my ($name, $mem_info_ref) = each %{$info{members}} ) {  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
596
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
 	    my ($member, %mem_info);  | 
| 
597
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	    %mem_info = %$mem_info_ref;  | 
| 
598
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  DEFN: {  | 
| 
599
 | 
2
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
19
 | 
 	      $mem_info{type} eq "\$" and do { $member = Class::Generate::Scalar_Member->new($name); last DEFN };  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
600
 | 
1
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	      $mem_info{type} eq '@'  and do { $member = Class::Generate::Array_Member->new($name); last DEFN };  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
    | 
| 
601
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	      $mem_info{type} eq '%'  and do { $member = Class::Generate::Hash_Member->new($name); last DEFN };  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
602
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  }  | 
| 
603
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	    $member->base($mem_info{base}) if exists $mem_info{base};  | 
| 
604
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	    $class->members($name, $member);  | 
| 
605
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
606
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
607
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
     if ( exists $info{class_methods} ) { # Add methods...  | 
| 
608
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 	for my $name ( @{$info{class_methods}} ) {  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
609
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $class->user_defined_methods($name, Class::Generate::Class_Method->new($name));  | 
| 
610
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
611
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
612
 | 
  
0
  
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     if ( exists $info{instance_methods} ) {  | 
| 
613
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	for my $name ( @{$info{instance_methods}} ) {  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
614
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $class->user_defined_methods($name, Class::Generate::Method->new($name));  | 
| 
615
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
616
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
617
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     if ( exists $info{protected} ) {	# Set access ...  | 
| 
618
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
 	for my $protected_member ( @{$info{protected}} ) {  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
    | 
| 
619
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
87
 | 
 	    $class->protected($protected_member, 1);  | 
| 
620
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
621
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
622
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
     if ( exists $info{private} ) {  | 
| 
623
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
 	for my $private_member ( @{$info{private}} ) {  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
    | 
| 
624
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	    $class->private($private_member, 1);  | 
| 
625
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
626
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
627
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     $class->excluded_methods_regexp($info{emr})	if exists $info{emr};  | 
| 
628
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     $class->constructor(new Class::Generate::Constructor);  | 
| 
629
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
   CONSTRUCTOR_STYLE: {  | 
| 
630
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
       exists $info{kv_style} and do {  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
631
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
47
 | 
 	  $class->constructor->style(new Class::Generate::Key_Value 'params', @{$info{kv_style}});  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
    | 
| 
632
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	  last CONSTRUCTOR_STYLE;  | 
| 
633
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       };  | 
| 
634
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
       exists $info{pos_style} and do {  | 
| 
635
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	  $class->constructor->style(new Class::Generate::Positional(@{$info{pos_style}}));  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
636
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
359
 | 
 	  last CONSTRUCTOR_STYLE;  | 
| 
637
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       };  | 
| 
638
 | 
8
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
52
 | 
       exists $info{mix_style} and do {  | 
| 
639
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  $class->constructor->style(new Class::Generate::Mix('params',  | 
| 
640
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 							      [@{$info{mix_style}{keyed}}],  | 
| 
641
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
88
 | 
 							       @{$info{mix_style}{pos}}));  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
642
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	  last CONSTRUCTOR_STYLE;  | 
| 
643
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       };  | 
| 
644
 | 
2
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
48
 | 
       exists $info{own_style} and do {  | 
| 
645
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
82
 | 
 	  $class->constructor->style(new Class::Generate::Own(@{$info{own_style}}));  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
646
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	  last CONSTRUCTOR_STYLE;  | 
| 
647
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       };  | 
| 
648
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
   }  | 
| 
649
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
650
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
     $classes{$class_name} = $class;  | 
| 
651
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
124
 | 
     return $class;  | 
| 
652
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
653
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
654
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub remove($) {  | 
| 
655
 | 
3
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
27
 | 
     delete $classes{$_[0]};  | 
| 
656
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
657
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
658
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form($) {  | 
| 
659
 | 
64
 | 
 
 | 
 
 | 
  
65
  
 | 
 
 | 
151
 | 
     my $class = $_[0];  | 
| 
660
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
159
 | 
     my $form = qq|use vars qw(\%_cginfo);\n| . '%_cginfo = (';  | 
| 
661
 | 
67
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
594
 | 
     if ( $class->isa('Class::Generate::Array_Class') ) {  | 
| 
662
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
 	$form .= q|base => 'ARRAY', last => | . $class->last;  | 
| 
663
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
664
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
665
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
149
 | 
 	$form .= q|base => 'HASH'|;  | 
| 
666
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
667
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
668
 | 
64
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
181
 | 
     if ( my @members = $class->members_values ) {  | 
| 
669
 | 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
221
 | 
 	$form .= ', members => { ' . join(', ', map(member($_), @members)) . ' }';  | 
| 
670
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
671
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
159
 | 
     my (@class_methods, @instance_methods);  | 
| 
672
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
163
 | 
     for my $m ( $class->user_defined_methods_values ) {  | 
| 
673
 | 
31
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
105
 | 
 	if ( $m->isa('Class::Generate::Class_Method') ) {  | 
| 
674
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	    push @class_methods, $m->name;  | 
| 
675
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
676
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
677
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
 	    push @instance_methods, $m->name;  | 
| 
678
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
679
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
680
 | 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
236
 | 
     $form .= comma_prefixed_list_of_values('class_methods', @class_methods);  | 
| 
681
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
162
 | 
     $form .= comma_prefixed_list_of_values('instance_methods', @instance_methods);  | 
| 
682
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
122
 | 
     $form .= comma_prefixed_list_of_values('protected', do { my %p = $class->protected; keys %p });  | 
| 
 
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
167
 | 
    | 
| 
 
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
206
 | 
    | 
| 
683
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
288
 | 
     $form .= comma_prefixed_list_of_values('private',   do { my %p = $class->private; keys %p });  | 
| 
 
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
    | 
| 
 
 | 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
    | 
| 
684
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
685
 | 
62
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
165
 | 
     if ( my $emr = $class->excluded_methods_regexp ) {  | 
| 
686
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
 	$emr =~ s/\'/\\\'/g;  | 
| 
687
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
44
 | 
 	$form .= ", emr => '$emr'";  | 
| 
688
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
689
 | 
62
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
181
 | 
     if ( (my $constructor = $class->constructor) ) {  | 
| 
690
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
152
 | 
 	my $style = $constructor->style;  | 
| 
691
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       STYLE: {  | 
| 
692
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
114
 | 
 	  $style->isa('Class::Generate::Key_Value') and do {  | 
| 
 
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
366
 | 
    | 
| 
693
 | 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
132
 | 
 	      my @kpn = $style->keyed_param_names;  | 
| 
694
 | 
41
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
116
 | 
 	      if ( @kpn ) {  | 
| 
695
 | 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
 		  $form .= comma_prefixed_list_of_values('kv_style', $style->keyed_param_names);  | 
| 
696
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
697
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      else {  | 
| 
698
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 		  $form .= ', kv_style => []';  | 
| 
699
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
700
 | 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
120
 | 
 	      last STYLE;  | 
| 
701
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  };  | 
| 
702
 | 
22
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
243
 | 
 	  $style->isa('Class::Generate::Positional') and do {  | 
| 
703
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
 	      my @members =  sort { $style->order($a) <=> $style->order($b) } do { my %m = $style->order; keys %m };  | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
39
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
108
 | 
    | 
| 
704
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
46
 | 
 	      if ( @members ) {  | 
| 
705
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
 		  $form .= comma_prefixed_list_of_values('pos_style', @members);  | 
| 
706
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
707
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      else {  | 
| 
708
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 		  $form .= ', pos_style => []';  | 
| 
709
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
710
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
247
 | 
 	      last STYLE;  | 
| 
711
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  };  | 
| 
712
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
68
 | 
 	  $style->isa('Class::Generate::Mix') and do {  | 
| 
713
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
 	      my @keyed_members = $style->keyed_param_names;  | 
| 
714
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
 	      my @pos_members =  sort { $style->order($a) <=> $style->order($b) } do { my %m = $style->order; keys %m };  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
715
 | 
6
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
46
 | 
 	      if ( @keyed_members || @pos_members ) {  | 
| 
716
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
87
 | 
 		  my $km_form = list_of_values('keyed', @keyed_members);  | 
| 
717
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 		  my $pm_form = list_of_values('pos', @pos_members);  | 
| 
718
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
66
 | 
 		  $form .= ', mix_style => {' . join(', ', grep(length > 0, ($km_form, $pm_form))) . '}';  | 
| 
719
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
720
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      else {  | 
| 
721
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
 		  $form .= ', mix_style => {}';  | 
| 
722
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
723
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
93
 | 
 	      last STYLE;  | 
| 
724
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  };  | 
| 
725
 | 
6
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
30
 | 
 	  $style->isa('Class::Generate::Own') and do {  | 
| 
726
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
 	      my @super_values = $style->super_values;  | 
| 
727
 | 
5
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 	      if ( @super_values ) {  | 
| 
728
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
77
 | 
 	          for my $sv ( @super_values) {  | 
| 
729
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
 	              $sv =~ s/\'/\\\'/g;  | 
| 
730
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	          }  | 
| 
731
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 		  $form .= comma_prefixed_list_of_values('own_style', @super_values);  | 
| 
732
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
733
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      else {  | 
| 
734
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 		  $form .= ', own_style => []';  | 
| 
735
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      }  | 
| 
736
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
 	      last STYLE;  | 
| 
737
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	  };  | 
| 
738
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
       }  | 
| 
739
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
740
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
130
 | 
     $form .= ');' . "\n";  | 
| 
741
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
187
 | 
     return $form;  | 
| 
742
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
743
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
744
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member($) {  | 
| 
745
 | 
133
 | 
 
 | 
 
 | 
  
136
  
 | 
 
 | 
189
 | 
     my $member = $_[0];  | 
| 
746
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
162
 | 
     my $base;  | 
| 
747
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
209
 | 
     my $form = $member->name . ' => {';  | 
| 
748
 | 
133
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
653
 | 
     $form .= " type => '" . ($member->isa('Class::Generate::Scalar_Member') ? "\$" :  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
749
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			     $member->isa('Class::Generate::Array_Member') ? '@' : '%') . "'";  | 
| 
750
 | 
134
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
309
 | 
     if ( defined ($base = $member->base) ) {  | 
| 
751
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
 	$form .= ", base => '$base'";  | 
| 
752
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
753
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
502
 | 
     return $form . '}';  | 
| 
754
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
755
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
756
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub list_of_values($@) {  | 
| 
757
 | 
76
 | 
 
 | 
 
 | 
  
78
  
 | 
 
 | 
239
 | 
     my ($key, @list) = @_;  | 
| 
758
 | 
76
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
183
 | 
     return '' if ! @list;  | 
| 
759
 | 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
583
 | 
     return "$key => [" . join(', ', map("'$_'", @list)) . ']';  | 
| 
760
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
761
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
762
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub comma_prefixed_list_of_values($@) {  | 
| 
763
 | 
289
 | 
  
100
  
 | 
 
 | 
  
291
  
 | 
 
 | 
848
 | 
     return $#_ > 0 ? ', ' . list_of_values($_[0], @_[1..$#_]) : '';  | 
| 
764
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
765
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
766
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Member_Names;	# This package encapsulates functions  | 
| 
767
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Member_Names::VERSION = '1.17';  | 
| 
768
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
117
 | 
 use strict;				# to handle name substitution in  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21471
 | 
    | 
| 
769
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# user-defined code.  | 
| 
770
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
771
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my ($member_regexp,		    # Regexp of accessible members.  | 
| 
772
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $accessor_regexp,		    # Regexp of accessible member accessors (x_size, etc.).  | 
| 
773
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $user_defined_methods_regexp,   # Regexp of accessible user-defined instance methods.  | 
| 
774
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $nonpublic_member_regexp,	    # (For class methods) Regexp of accessors for protected and private members.  | 
| 
775
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $private_class_methods_regexp); # (Ditto) Regexp of private class methods.  | 
| 
776
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
777
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_member_regexps($;$);  | 
| 
778
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_members($;$);  | 
| 
779
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_accessor_regexps($;$);  | 
| 
780
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_user_defined_method_regexps($;$);  | 
| 
781
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_of($$;$);  | 
| 
782
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_index($$);  | 
| 
783
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
784
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub set_element_regexps() {		# Establish the regexps for  | 
| 
785
 | 
61
 | 
 
 | 
 
 | 
  
64
  
 | 
 
 | 
97
 | 
     my @names;				# name substitution.  | 
| 
786
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
787
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# First for members...  | 
| 
788
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
188
 | 
     @names = accessible_member_regexps($class);  | 
| 
789
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
188
 | 
     if ( ! @names ) {  | 
| 
790
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	undef $member_regexp;  | 
| 
791
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
792
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
793
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
289
 | 
 	$member_regexp = '(?:\b(?:my|local)\b[^=;()]+)?(' . join('|', sort { length $b <=> length $a } @names) . ')\b';  | 
| 
 
 | 
249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
522
 | 
    | 
| 
794
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
795
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
796
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Next for accessors (e.g., x_size)...  | 
| 
797
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
235
 | 
     @names = accessible_accessor_regexps($class);  | 
| 
798
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
210
 | 
     if ( ! @names ) {  | 
| 
799
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	undef $accessor_regexp;  | 
| 
800
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
801
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
802
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
217
 | 
 	$accessor_regexp = '&(' . join('|', sort { length $b <=> length $a } @names) . ')\b(?:\s*\()?';  | 
| 
 
 | 
1148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1501
 | 
    | 
| 
803
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
804
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
805
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Next for user-defined instance methods...  | 
| 
806
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
238
 | 
     @names = accessible_user_defined_method_regexps($class);  | 
| 
807
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
170
 | 
     if ( ! @names ) {  | 
| 
808
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
94
 | 
 	undef $user_defined_methods_regexp;  | 
| 
809
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
810
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
811
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
 	$user_defined_methods_regexp = '&(' . join('|', sort { length $b <=> length $a } @names) . ')\b(?:\s*\()?';  | 
| 
 
 | 
48
 | 
 
 | 
 
 | 
 
 | 
 
 | 
131
 | 
    | 
| 
812
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
813
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
814
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Next for protected and private members, and instance methods in class methods...  | 
| 
815
 | 
62
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
268
 | 
     if ( $class->class_methods ) {  | 
| 
816
 | 
2
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
9
 | 
 	@names = (map($_->accessor_names($class, $_->name), grep $class->protected($_->name) || $class->private($_->name), $class->members_values),  | 
| 
 
 | 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
817
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		  grep($class->private($_) || $class->protected($_), map($_->name, $class->instance_methods)));  | 
| 
818
 | 
3
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
11
 | 
 	if ( ! @names ) {  | 
| 
819
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
 	    undef $nonpublic_member_regexp;  | 
| 
820
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
821
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
822
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	    $nonpublic_member_regexp = join('|', sort { length $b <=> length $a } @names);  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
823
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
824
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
825
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
826
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
156
 | 
 	undef $nonpublic_member_regexp;  | 
| 
827
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
828
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
829
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Finally for private class methods invoked from class and instance methods.  | 
| 
830
 | 
61
 | 
  
 50
  
 | 
  
100
  
 | 
 
 | 
 
 | 
195
 | 
     if ( my @private_class_methods = grep $_->isa('Class::Generate::Class_Method') &&  | 
| 
831
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				          $class->private($_->name), $class->user_defined_methods ) {  | 
| 
832
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$private_class_methods_regexp = $class->name .  | 
| 
833
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					'\s*->\s*(' .  | 
| 
834
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					join('|', map $_->name, @private_class_methods) .  | 
| 
835
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					')' .  | 
| 
836
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					'(\s*\((?:\s*\))?)?';  | 
| 
837
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
838
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
839
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
127
 | 
 	undef $private_class_methods_regexp;  | 
| 
840
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
841
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
842
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
843
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub substituted($) {			# Within a code fragment, replace  | 
| 
844
 | 
46
 | 
 
 | 
 
 | 
  
47
  
 | 
 
 | 
75
 | 
     my $code = $_[0];			# member names and accessors with the  | 
| 
845
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# appropriate forms.  | 
| 
846
 | 
46
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1083
 | 
     $code =~ s/$member_regexp/member_invocation($1, $&)/eg		       if defined $member_regexp;  | 
| 
 
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
224
 | 
    | 
| 
847
 | 
46
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
701
 | 
     $code =~ s/$accessor_regexp/accessor_invocation($1, $+, $&)/eg	       if defined $accessor_regexp;  | 
| 
 
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
    | 
| 
848
 | 
46
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
471
 | 
     $code =~ s/$user_defined_methods_regexp/accessor_invocation($1, $1, $&)/eg if defined $user_defined_methods_regexp;  | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
849
 | 
46
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
118
 | 
     $code =~ s/$private_class_methods_regexp/nonpublic_method_invocation("'" . $class->name . "'", $1, $2)/eg if defined $private_class_methods_regexp;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
850
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
179
 | 
     return $code;  | 
| 
851
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
852
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				# Perform the actual substitution  | 
| 
853
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_invocation($$) {	# for member references.  | 
| 
854
 | 
91
 | 
 
 | 
 
 | 
  
92
  
 | 
 
 | 
280
 | 
     my ($member_reference, $match) = @_;  | 
| 
855
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
150
 | 
     my ($name, $type, $form, $index);  | 
| 
856
 | 
91
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1613
 | 
     return $member_reference if $match =~ /\A(?:my|local)\b[^=;()]+$member_reference$/s;  | 
| 
857
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
361
 | 
     $member_reference =~ /^(\W+)(\w+)$/;  | 
| 
858
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
     $name = $2;  | 
| 
859
 | 
91
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
198
 | 
     return $member_reference if ! defined ($index = member_index($class, $name));  | 
| 
860
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
190
 | 
     $type = $1;  | 
| 
861
 | 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
180
 | 
     $form = $class->instance_var . '->' . $index;  | 
| 
862
 | 
91
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
833
 | 
     return $type eq '$' ? $form : $type . '{' . $form . '}';  | 
| 
863
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
864
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# Perform the actual substitution for  | 
| 
865
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessor_invocation($$$) {		# accessor and user-defined method references.  | 
| 
866
 | 
33
 | 
 
 | 
 
 | 
  
34
  
 | 
 
 | 
107
 | 
     my ($accessor_name, $element_name, $match) = @_;  | 
| 
867
 | 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my $prefix = $class->instance_var . '->';  | 
| 
868
 | 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
68
 | 
     my $c = class_of($element_name, $class);  | 
| 
869
 | 
33
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
67
 | 
     if ( ! ($c->protected($element_name) || $c->private($element_name)) ) {  | 
| 
870
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
19
 | 
 	return $prefix . $accessor_name	. (substr($match, -1) eq '(' ? '(' : '');  | 
| 
871
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
872
 | 
31
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
58
 | 
     if ( $c->private($element_name) || $c->name eq $class->name ) {  | 
| 
873
 | 
25
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
89
 | 
 	return "$prefix\$$accessor_name(" if substr($match, -1) eq '(';  | 
| 
874
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
 	return "$prefix\$$accessor_name()";  | 
| 
875
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
876
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     my $form = "&{$prefix" . $class->protected_members_info_index . qq|->{'$accessor_name'}}(|;  | 
| 
877
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
     $form .= $class->instance_var . ',';  | 
| 
878
 | 
6
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
47
 | 
     return substr($match, -1) eq '(' ? $form : $form . ')';  | 
| 
879
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
880
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
881
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub substituted_in_class_method {  | 
| 
882
 | 
2
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
4
 | 
     my $method = $_[0];  | 
| 
883
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     my (@objs, $code, @private_class_methods);  | 
| 
884
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     $code = $method->body;  | 
| 
885
 | 
2
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
9
 | 
     if ( defined $nonpublic_member_regexp && (@objs = $method->objects) ) {  | 
| 
886
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	my $nonpublic_member_invocation_regexp = '(' . join('|', map(quotemeta($_), @objs)) . ')' .  | 
| 
887
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					         '\s*->\s*(' . $nonpublic_member_regexp . ')' .  | 
| 
888
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					         '(\s*\((?:\s*\))?)?';  | 
| 
889
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$code =~ s/$nonpublic_member_invocation_regexp/nonpublic_method_invocation($1, $2, $3)/ge;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
890
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
891
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     if ( defined $private_class_methods_regexp ) {  | 
| 
892
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$code =~ s/$private_class_methods_regexp/nonpublic_method_invocation("'" . $class->name . "'", $1, $2)/ge;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
893
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
894
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     return $code;  | 
| 
895
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
896
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
897
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub nonpublic_method_invocation {			 # Perform the actual  | 
| 
898
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my ($object, $nonpublic_member, $paren_matter) = @_; # substitution for  | 
| 
899
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $form = '&$' . $nonpublic_member . '(' . $object; # nonpublic method and  | 
| 
900
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     if ( defined $paren_matter ) {			 # member references.  | 
| 
901
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	if ( index($paren_matter, ')') != -1 ) {  | 
| 
902
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $form .= ')';  | 
| 
903
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
904
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
905
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $form .= ', ';  | 
| 
906
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
907
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
908
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
909
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$form .= ')';  | 
| 
910
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
911
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $form;  | 
| 
912
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
913
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
914
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_index($$) {  | 
| 
915
 | 
103
 | 
 
 | 
 
 | 
  
104
  
 | 
 
 | 
188
 | 
     my ($class, $member_name) = @_;  | 
| 
916
 | 
103
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
204
 | 
     return $class->index($member_name) if defined $class->members($member_name);  | 
| 
917
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     for my $parent ( grep ref $_, $class->parents ) {  | 
| 
918
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
 	my $index = member_index($parent, $member_name);  | 
| 
919
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
42
 | 
 	return $index if defined $index;  | 
| 
920
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
921
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return undef;  | 
| 
922
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
923
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
924
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_member_regexps($;$) {  | 
| 
925
 | 
76
 | 
 
 | 
 
 | 
  
76
  
 | 
 
 | 
189
 | 
     my ($class, $disallow_private_members) = @_;  | 
| 
926
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
145
 | 
     my @members;  | 
| 
927
 | 
76
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
167
 | 
     if ( $disallow_private_members ) {  | 
| 
928
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
 	@members = grep ! $class->private($_->name), $class->members_values;  | 
| 
929
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
930
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
931
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
237
 | 
 	@members = $class->members_values;  | 
| 
932
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
933
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
327
 | 
     return (map($_->method_regexp($class), @members),  | 
| 
934
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    map(accessible_member_regexps($_, 1), grep(ref $_, $class->parents)));  | 
| 
935
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
936
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
937
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_members($;$) {  | 
| 
938
 | 
76
 | 
 
 | 
 
 | 
  
76
  
 | 
 
 | 
227
 | 
     my ($class, $disallow_private_members) = @_;  | 
| 
939
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
131
 | 
     my @members;  | 
| 
940
 | 
76
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
172
 | 
     if ( $disallow_private_members ) {  | 
| 
941
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
47
 | 
 	@members = grep ! $class->private($_->name), $class->members_values;  | 
| 
942
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
943
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
944
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
149
 | 
 	@members = $class->members_values;  | 
| 
945
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
946
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
218
 | 
     return (@members, map(accessible_members($_, 1), grep(ref $_, $class->parents)));  | 
| 
947
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
948
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
949
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_accessor_regexps($;$) {  | 
| 
950
 | 
76
 | 
 
 | 
 
 | 
  
76
  
 | 
 
 | 
182
 | 
     my ($class, $disallow_private_members) = @_;  | 
| 
951
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
134
 | 
     my ($member_name, @accessor_names);  | 
| 
952
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
205
 | 
     for my $member ( $class->members_values ) {  | 
| 
953
 | 
166
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
405
 | 
 	next if $class->private($member_name = $member->name) && $disallow_private_members;  | 
| 
954
 | 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
447
 | 
 	for my $accessor_name ( grep $class->include_method($_), $member->accessor_names($class, $member_name) ) {  | 
| 
955
 | 
466
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3088
 | 
 	    $accessor_name =~ s/$member_name/($&)/;  | 
| 
956
 | 
466
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1183
 | 
 	    push @accessor_names, $accessor_name;  | 
| 
957
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
958
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
959
 | 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
246
 | 
     return (@accessor_names, map(accessible_accessor_regexps($_, 1), grep(ref $_, $class->parents)));  | 
| 
960
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
961
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
962
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessible_user_defined_method_regexps($;$) {  | 
| 
963
 | 
76
 | 
 
 | 
 
 | 
  
76
  
 | 
 
 | 
186
 | 
     my ($class, $disallow_private_methods) = @_;  | 
| 
964
 | 
76
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
434
 | 
     return (($disallow_private_methods ? grep ! $class->private($_), $class->user_defined_methods_keys : $class->user_defined_methods_keys),  | 
| 
965
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    map(accessible_user_defined_method_regexps($_, 1), grep(ref $_, $class->parents)));  | 
| 
966
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
967
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			# Given element E and class C, return C if E is an  | 
| 
968
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_of($$;$) {	# element of C; if not, search parents recursively.  | 
| 
969
 | 
39
 | 
 
 | 
 
 | 
  
39
  
 | 
 
 | 
69
 | 
     my ($element_name, $class, $disallow_private_members) = @_;  | 
| 
970
 | 
39
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
67
 | 
     return $class if (defined $class->members($element_name) || defined $class->user_defined_methods($element_name)) && (! $disallow_private_members || ! $class->private($element_name));  | 
| 
 
 | 
 
 | 
 
 | 
  
 66
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
 
 | 
 
 | 
 
 | 
  
 66
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
971
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     for my $parent ( grep ref $_, $class->parents ) {  | 
| 
972
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	my $c = class_of($element_name, $parent, 1);  | 
| 
973
 | 
6
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
24
 | 
 	return $c if defined $c;  | 
| 
974
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
975
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return undef;  | 
| 
976
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
977
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
978
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Code_Checker;		# This package encapsulates  | 
| 
979
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Code_Checker::VERSION = '1.17';  | 
| 
980
 | 
14
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
103
 | 
 use strict;					# checking for warnings and  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
458
 | 
    | 
| 
981
 | 
14
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
81
 | 
 use Carp;					# errors in user-defined code.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11237
 | 
    | 
| 
982
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
983
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $package_decl;  | 
| 
984
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $member_error_message = '%s, member "%s": In "%s" code: %s';  | 
| 
985
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $method_error_message = '%s, method "%s": %s';  | 
| 
986
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
987
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub create_code_checking_package($);  | 
| 
988
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub fragment_as_sub($$\@;\@);  | 
| 
989
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub collect_code_problems($$$$@);  | 
| 
990
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
991
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # Check each user-defined code fragment in $class for errors. This includes  | 
| 
992
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # pre, post, and assert code, as well as user-defined methods.  Set  | 
| 
993
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # $errors_found according to whether errors (not warnings) were found.  | 
| 
994
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub check_user_defined_code($$$$) {  | 
| 
995
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
201
 | 
     my ($class, $class_name_label, $warnings, $errors) = @_;  | 
| 
996
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
161
 | 
     my ($code, $instance_var, @valid_variables, @class_vars, $w, $e, @members, $problems_in_pre, %seen);  | 
| 
997
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
202
 | 
     create_code_checking_package $class;  | 
| 
998
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
292
 | 
     @valid_variables = map { $seen{$_->name} ? () : do { $seen{$_->name} = 1; $_->as_var } }  | 
| 
 
 | 
298
 | 
 
 | 
 
 | 
 
 | 
 
 | 
500
 | 
    | 
| 
 
 | 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
284
 | 
    | 
| 
 
 | 
165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
408
 | 
    | 
| 
999
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			     ((@members = $class->members_values),  | 
| 
1000
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			    Class::Generate::Member_Names::accessible_members($class));  | 
| 
1001
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
248
 | 
     @class_vars = $class->class_vars;  | 
| 
1002
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
209
 | 
     $instance_var = $class->instance_var;  | 
| 
1003
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
     @$warnings = ();  | 
| 
1004
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
126
 | 
     undef $$errors;  | 
| 
1005
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
153
 | 
     for my $member ( $class->constructor, @members ) {  | 
| 
1006
 | 
194
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
474
 | 
 	if ( defined ($code = $member->pre) ) {  | 
| 
1007
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $code = fragment_as_sub $code, $instance_var, @class_vars, @valid_variables;  | 
| 
1008
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    collect_code_problems $code,  | 
| 
1009
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $warnings, $errors,  | 
| 
1010
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $member_error_message, $class_name_label, $member->name, 'pre';  | 
| 
1011
 | 
  
0
  
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
0
 | 
 	    $problems_in_pre = @$warnings || $$errors;  | 
| 
1012
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1013
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Because post shares pre's scope, check post with pre prepended.  | 
| 
1014
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	# Strip newlines in pre to preserve line numbers in post.  | 
| 
1015
 | 
194
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
460
 | 
 	if ( defined ($code = $member->post) ) {  | 
| 
1016
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
 	    my $pre = $member->pre;  | 
| 
1017
 | 
13
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
48
 | 
 	    if ( defined $pre && ! $problems_in_pre ) {	# Don't report errors  | 
| 
1018
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		$pre =~ s/\n+/ /g;			# in pre again.  | 
| 
1019
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		$code = $pre . $code;  | 
| 
1020
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
1021
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
47
 | 
 	    $code = fragment_as_sub $code, $instance_var, @class_vars, @valid_variables;  | 
| 
1022
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
44
 | 
 	    collect_code_problems $code,  | 
| 
1023
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $warnings, $errors,  | 
| 
1024
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $member_error_message, $class_name_label, $member->name, 'post';  | 
| 
1025
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1026
 | 
194
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
447
 | 
 	if ( defined ($code = $member->assert) ) {  | 
| 
1027
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
 	    $code = fragment_as_sub "unless($code){die}" , $instance_var, @class_vars, @valid_variables;  | 
| 
1028
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	    collect_code_problems $code,  | 
| 
1029
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $warnings, $errors,  | 
| 
1030
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				  $member_error_message, $class_name_label, $member->name, 'assert';  | 
| 
1031
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1032
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1033
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
176
 | 
     for my $method ( $class->user_defined_methods_values ) {  | 
| 
1034
 | 
28
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
147
 | 
 	if ( $method->isa('Class::Generate::Class_Method') ) {  | 
| 
1035
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	    $code = fragment_as_sub $method->body, $class->class_var, @class_vars;  | 
| 
1036
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1037
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
1038
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
72
 | 
 	    $code = fragment_as_sub $method->body, $instance_var, @class_vars, @valid_variables;  | 
| 
1039
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1040
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
81
 | 
 	collect_code_problems $code, $warnings, $errors, $method_error_message, $class_name_label, $method->name;  | 
| 
1041
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1042
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1043
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1044
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub create_code_checking_package($) {	# Each class with user-defined code gets  | 
| 
1045
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
156
 | 
     my $class = $_[0];			# its own package in which that code is  | 
| 
1046
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# evaluated.  Create said package.  | 
| 
1047
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
218
 | 
     $package_decl = 'package ' . __PACKAGE__ . '::check::' . $class->name . ";";  | 
| 
1048
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
283
 | 
     $package_decl .= 'use strict;' if $class->strict;  | 
| 
1049
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
123
 | 
     my $packages = '';  | 
| 
1050
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
167
 | 
     if ( $class->check_params ) {  | 
| 
1051
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
124
 | 
 	$packages .= 'use Carp;';  | 
| 
1052
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
251
 | 
 	$packages .= join(';', $class->warnings_pragmas);  | 
| 
1053
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1054
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
283
 | 
     $packages .= join('', map('use ' . $_ . ';', $class->use_packages));  | 
| 
1055
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
176
 | 
     $packages .= 'use vars qw(@ISA);' if $class->parents;  | 
| 
1056
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
 
 | 
88
 | 
     eval $package_decl . $packages;  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
 
 | 
348
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
59
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
758
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
68
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
10
  
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
  
9
  
 | 
 
 | 
768
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
74
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
421
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
7
  
 | 
 
 | 
70
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
7
  
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
7
  
 | 
 
 | 
590
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
62
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
3
  
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
330
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
83
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
369
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
46
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
478
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
195
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
274
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
39
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
488
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
50
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
    | 
| 
 
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
243
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
528
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
298
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
    | 
| 
 
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
236
 | 
    | 
| 
 
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4806
 | 
    | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
367
 | 
    | 
| 
 
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
    | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
69
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
    | 
| 
1057
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1058
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# Evaluate a code fragment, passing on  | 
| 
1059
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub collect_code_problems($$$$@) {	# warnings and errors.  | 
| 
1060
 | 
46
 | 
 
 | 
 
 | 
  
46
  
 | 
 
 | 
153
 | 
     my ($code_form,  $warnings, $errors, $error_message, @params) = @_;  | 
| 
1061
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
73
 | 
     my @warnings;  | 
| 
1062
 | 
46
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
280
 | 
     local $SIG{__WARN__} = sub { push @warnings, $_[0] };  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
1063
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
142
 | 
     local $SIG{__DIE__};  | 
| 
1064
 | 
10
 | 
 
 | 
 
 | 
  
10
  
 | 
 
 | 
59
 | 
     eval $package_decl . $code_form;  | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
  
10
  
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
10
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
636
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
486
 | 
    | 
| 
 
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2840
 | 
    | 
| 
 
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
1065
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
219
 | 
     push @$warnings, map(filtered_message($error_message, $_, @params), @warnings);  | 
| 
1066
 | 
46
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
359
 | 
     $$errors .= filtered_message($error_message, $@, @params) if $@;  | 
| 
1067
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1068
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1069
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub filtered_message {				# Clean up errors and messages  | 
| 
1070
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my ($message, $error, @params) = @_;	# a little by removing the  | 
| 
1071
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $error =~ s/\(eval \d+\) //g;		# "(eval N)" forms that perl  | 
| 
1072
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return sprintf($message, @params, $error);	# inserts.  | 
| 
1073
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1074
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1075
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub fragment_as_sub($$\@;\@) {  | 
| 
1076
 | 
46
 | 
 
 | 
 
 | 
  
46
  
 | 
 
 | 
123
 | 
     my ($code, $id_var, $class_vars, $valid_vars) = @_;  | 
| 
1077
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
     my $form;  | 
| 
1078
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
130
 | 
     $form  = "sub{my $id_var;";  | 
| 
1079
 | 
46
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
127
 | 
     if ( $#$class_vars >= 0 ) {  | 
| 
1080
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
 	$form .= 'my(' . join(',', map((ref $_ ? keys %$_ : $_), @$class_vars)) . ');';  | 
| 
1081
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1082
 | 
46
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
214
 | 
     if ( $valid_vars && $#$valid_vars >= 0 ) {  | 
| 
1083
 | 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
156
 | 
 	$form .= 'my(' . join(',', @$valid_vars) . ');';  | 
| 
1084
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1085
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
157
 | 
     $form .= '{' . $code . '}};';  | 
| 
1086
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1087
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1088
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Array;		# Given a string or an ARRAY, return an  | 
| 
1089
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Array::VERSION = '1.17';  | 
| 
1090
 | 
16
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
112
 | 
 use strict;				# object that is either the ARRAY or  | 
| 
 
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
501
 | 
    | 
| 
1091
 | 
15
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
78
 | 
 use Carp;				# the string made into an ARRAY by  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2582
 | 
    | 
| 
1092
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# splitting the string on white space.  | 
| 
1093
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
1094
 | 
63
 | 
 
 | 
 
 | 
  
63
  
 | 
 
 | 
148
 | 
     my $class = shift;  | 
| 
1095
 | 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
108
 | 
     my $self;  | 
| 
1096
 | 
63
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
222
 | 
     if ( ! ref $_[0] ) {  | 
| 
 
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1097
 | 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
325
 | 
 	$self = [ split /\s+/, $_[0] ];  | 
| 
1098
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1099
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( UNIVERSAL::isa($_[0], 'ARRAY') ) {  | 
| 
1100
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 	$self = $_[0];  | 
| 
1101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1103
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	croak 'Expected string or array reference';  | 
| 
1104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1105
 | 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
179
 | 
     bless $self, $class;  | 
| 
1106
 | 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
161
 | 
     return $self;  | 
| 
1107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub values {  | 
| 
1110
 | 
125
 | 
 
 | 
 
 | 
  
125
  
 | 
 
 | 
208
 | 
     my $self = shift;  | 
| 
1111
 | 
125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
601
 | 
     return @$self;  | 
| 
1112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Hash;		# Given a string or a HASH and a key  | 
| 
1115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Hash::VERSION = '1.17';  | 
| 
1116
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
89
 | 
 use strict;				# name, return an object that is either  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
382
 | 
    | 
| 
1117
 | 
14
 | 
 
 | 
 
 | 
  
16
  
 | 
 
 | 
86
 | 
 use Carp;				# the HASH or a HASH of the form  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
39
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2253
 | 
    | 
| 
1118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# (key => string). Also, if the object  | 
| 
1119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {				# is a HASH, it *must* contain the key.  | 
| 
1120
 | 
162
 | 
 
 | 
 
 | 
  
162
  
 | 
 
 | 
264
 | 
     my $class = shift;  | 
| 
1121
 | 
162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
214
 | 
     my $self;  | 
| 
1122
 | 
162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
295
 | 
     my ($value, $key) = @_;  | 
| 
1123
 | 
162
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
325
 | 
     if ( ! ref $value ) {  | 
| 
1124
 | 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
213
 | 
 	$self = { $key => $value };  | 
| 
1125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1126
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1127
 | 
58
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
188
 | 
 	croak 'Expected string or hash reference' unless UNIVERSAL::isa($value, 'HASH');  | 
| 
1128
 | 
58
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
269
 | 
 	croak qq|Missing "$key"|		  unless exists $value->{$key};  | 
| 
1129
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
110
 | 
 	$self = $value;  | 
| 
1130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1131
 | 
161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
261
 | 
     bless $self, $class;  | 
| 
1132
 | 
161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
664
 | 
     return $self;  | 
| 
1133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1135
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Support;	# Miscellaneous support routines.  | 
| 
1136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Support::VERSION = '1.17';  | 
| 
1137
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
93
 | 
 no strict;				# Definitely NOT strict!  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3453
 | 
    | 
| 
1138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# Return the superclass of $class that  | 
| 
1139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_containing_method {		# contains the method that the form  | 
| 
1140
 | 
46
 | 
 
 | 
 
 | 
  
46
  
 | 
 
 | 
109
 | 
     my ($method, $class) = @_;		# (new $class)->$method would invoke.  | 
| 
1141
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
128
 | 
     for my $parent ( $class->parents ) {# Return undef if no such class exists.  | 
| 
1142
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
90
 | 
 	local *stab = eval ('*' . (ref $parent ? $parent->name : $parent) . '::');  | 
| 
1143
 | 
15
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
111
 | 
 	if ( exists $stab{$method} &&  | 
| 
1144
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
76
 | 
 	     do { local *method_entry = $stab{$method}; defined &method_entry } ) {  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
    | 
| 
1145
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
57
 | 
 	    return $parent;  | 
| 
1146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1147
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return class_containing_method($method, $parent);  | 
| 
1148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1149
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
76
 | 
     return undef;  | 
| 
1150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my %map = ('@' => 'ARRAY', '%' => 'HASH');  | 
| 
1153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub verify_value($$) {			# Die if a given value (ref or string)  | 
| 
1154
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
     my ($value, $type) = @_;		# is not the specified type.  | 
| 
1155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # The following code is not wrong, but it could be smarter.  | 
| 
1156
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     if ( $type =~ /^\w/ ) {  | 
| 
1157
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$map{$type} = $type;  | 
| 
1158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1160
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$type = substr $type, 0, 1;  | 
| 
1161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1162
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     return if $type eq '$';  | 
| 
1163
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     local $SIG{__WARN__} = sub {};  | 
| 
1164
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $result;  | 
| 
1165
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $result = ref $value ? $value : eval $value;  | 
| 
1166
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     die "Wrong type" if ! UNIVERSAL::isa($result, $map{$type});  | 
| 
1167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1169
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
120
 | 
 use strict;  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
264
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2218
 | 
    | 
| 
1170
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub comment_form {		# Given arbitrary text, return a form that  | 
| 
1171
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $comment = $_[0];	# is a valid Perl comment of that text.  | 
| 
1172
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     $comment =~ s/^/# /mg;  | 
| 
1173
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     $comment .= "\n" if substr($comment, -1, 1) ne "\n";  | 
| 
1174
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     return $comment;  | 
| 
1175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1177
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub my_decl_form {		# Given a non-empty set of variable names,  | 
| 
1178
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
24
 | 
     my @vars = @_;		# return a form declaring them as "my" variables.  | 
| 
1179
 | 
8
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
67
 | 
     return 'my ' . ($#vars == 0 ? $vars[0] : '(' . join(', ', @vars) . ')') . ";\n";  | 
| 
1180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Member;	# A virtual class describing class  | 
| 
1183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Member::VERSION = '1.17';  | 
| 
1184
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
101
 | 
 use strict;				# members.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
41
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22718
 | 
    | 
| 
1185
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
1187
 | 
195
 | 
 
 | 
 
 | 
  
195
  
 | 
 
 | 
322
 | 
     my $class = shift;  | 
| 
1188
 | 
195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
591
 | 
     my $self = { name => $_[0], @_[1..$#_] };  | 
| 
1189
 | 
195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
404
 | 
     bless $self, $class;  | 
| 
1190
 | 
195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
363
 | 
     return $self;  | 
| 
1191
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1192
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub name {  | 
| 
1193
 | 
3120
 | 
 
 | 
 
 | 
  
3120
  
 | 
 
 | 
3863
 | 
     my $self = shift;  | 
| 
1194
 | 
3120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7177
 | 
     return $self->{'name'};  | 
| 
1195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub default {  | 
| 
1197
 | 
228
 | 
 
 | 
 
 | 
  
228
  
 | 
 
 | 
342
 | 
     my $self = shift;  | 
| 
1198
 | 
228
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
852
 | 
     return $self->{'default'} if $#_ == -1;  | 
| 
1199
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     $self->{'default'} = $_[0];  | 
| 
1200
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base {  | 
| 
1202
 | 
879
 | 
 
 | 
 
 | 
  
879
  
 | 
 
 | 
1046
 | 
     my $self = shift;  | 
| 
1203
 | 
879
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
2782
 | 
     return $self->{'base'} if $#_ == -1;  | 
| 
1204
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'base'} = $_[0];  | 
| 
1205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1206
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub assert {  | 
| 
1207
 | 
556
 | 
 
 | 
 
 | 
  
556
  
 | 
 
 | 
769
 | 
     my $self = shift;  | 
| 
1208
 | 
556
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1731
 | 
     return $self->{'assert'} if $#_ == -1;  | 
| 
1209
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
     $self->{'assert'} = $_[0];  | 
| 
1210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub post {  | 
| 
1212
 | 
497
 | 
 
 | 
 
 | 
  
497
  
 | 
 
 | 
683
 | 
     my $self = shift;  | 
| 
1213
 | 
497
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1478
 | 
     return $self->{'post'} if $#_ == -1;  | 
| 
1214
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     $self->{'post'} = possibly_append_semicolon_to($_[0]);  | 
| 
1215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub pre {  | 
| 
1217
 | 
420
 | 
 
 | 
 
 | 
  
420
  
 | 
 
 | 
542
 | 
     my $self = shift;  | 
| 
1218
 | 
420
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1188
 | 
     return $self->{'pre'} if $#_ == -1;  | 
| 
1219
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'pre'} = possibly_append_semicolon_to($_[0]);  | 
| 
1220
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub possibly_append_semicolon_to {	# If user omits a trailing semicolon  | 
| 
1222
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
6
 | 
     my $code = $_[0];			# (or doesn't use braces), add one.  | 
| 
1223
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
22
 | 
     if ( $code !~ /[;\}]\s*\Z/s ) {  | 
| 
1224
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$code =~ s/\s*\Z/;$&/s;  | 
| 
1225
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1226
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
     return $code;  | 
| 
1227
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub comment {  | 
| 
1229
 | 
132
 | 
 
 | 
 
 | 
  
132
  
 | 
 
 | 
202
 | 
     my $self = shift;  | 
| 
1230
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
356
 | 
     return $self->{'comment'};  | 
| 
1231
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub key {  | 
| 
1233
 | 
134
 | 
 
 | 
 
 | 
  
134
  
 | 
 
 | 
194
 | 
     my $self = shift;  | 
| 
1234
 | 
134
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
544
 | 
     return $self->{'key'} if $#_ == -1;  | 
| 
1235
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     $self->{'key'} = $_[0];  | 
| 
1236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub nocopy {  | 
| 
1238
 | 
98
 | 
 
 | 
 
 | 
  
98
  
 | 
 
 | 
136
 | 
     my $self = shift;  | 
| 
1239
 | 
98
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
345
 | 
     return $self->{'nocopy'} if $#_ == -1;  | 
| 
1240
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     $self->{'nocopy'} = $_[0];  | 
| 
1241
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub assertion {					# Return a form that croaks if  | 
| 
1243
 | 
7
 | 
 
 | 
 
 | 
  
7
  
 | 
 
 | 
14
 | 
     my $self = shift;				# the member's assertion fails.  | 
| 
1244
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
     my $class = $_[0];  | 
| 
1245
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
     my $assertion = $self->{'assert'};  | 
| 
1246
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
     return undef if ! defined $assertion;  | 
| 
1247
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     my $quoted_form = $assertion;  | 
| 
1248
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
     $quoted_form =~ s/'/\\'/g;  | 
| 
1249
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
     $assertion = Class::Generate::Member_Names::substituted($assertion);  | 
| 
1250
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
     return qq|unless ( $assertion ) { croak '| . $self->name_form($class) . qq|Failed assertion: $quoted_form' }|;  | 
| 
1251
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1252
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1253
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_message {		# Encapsulate the messages for  | 
| 
1254
 | 
84
 | 
 
 | 
 
 | 
  
84
  
 | 
 
 | 
126
 | 
     my $self = shift;		# incorrect parameters.  | 
| 
1255
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
106
 | 
     my $class = $_[0];  | 
| 
1256
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
138
 | 
     my $name = $self->name;  | 
| 
1257
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
185
 | 
     my $prefix_form = q|croak '| . $class->name . '::new' . ': ';  | 
| 
1258
 | 
84
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
160
 | 
     $class->required($name) && ! $self->default and do {  | 
| 
1259
 | 
31
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
98
 | 
 	return $prefix_form . qq|Missing or invalid value for $name'| if $self->can_be_invalid;  | 
| 
1260
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
168
 | 
 	return $prefix_form . qq|Missing value for required member $name'|;  | 
| 
1261
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
1262
 | 
53
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
107
 | 
     $self->can_be_invalid and do {  | 
| 
1263
 | 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
233
 | 
 	return $prefix_form . qq|Invalid value for $name'|;  | 
| 
1264
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
1265
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1266
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1267
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_test {		# Return a form that dies if a constructor  | 
| 
1268
 | 
84
 | 
 
 | 
 
 | 
  
84
  
 | 
 
 | 
128
 | 
     my $self = shift;		# parameter is not correctly passed.  | 
| 
1269
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
418
 | 
     my $class  = $_[0];  | 
| 
1270
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
189
 | 
     my $name	 = $self->name;  | 
| 
1271
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
190
 | 
     my $param	 = $class->constructor->style->ref($name);  | 
| 
1272
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
224
 | 
     my $exists	 = $class->constructor->style->existence_test($name) . ' ' . $param;  | 
| 
1273
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1274
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
184
 | 
     my $form = '';  | 
| 
1275
 | 
84
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
196
 | 
     if ( $class->required($name) && ! $self->default ) {  | 
| 
 
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1276
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
112
 | 
 	$form .= $self->param_message($class) . ' unless ' . $exists;  | 
| 
1277
 | 
31
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
84
 | 
 	$form .= ' && ' . $self->valid_value_form($param) if $self->can_be_invalid;  | 
| 
1278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1279
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( $self->can_be_invalid ) {  | 
| 
1280
 | 
53
 | 
 
 | 
 
 | 
 
 | 
 
 | 
144
 | 
 	$form .= $self->param_message($class) . ' unless ! ' . $exists . ' || ' . $self->valid_value_form($param);  | 
| 
1281
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1282
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
363
 | 
     return $form . ';';  | 
| 
1283
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1284
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1285
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form {				# Return a form for a member and all  | 
| 
1286
 | 
132
 | 
 
 | 
 
 | 
  
132
  
 | 
 
 | 
206
 | 
     my $self = shift;			# its relevant associated accessors.  | 
| 
1287
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
188
 | 
     my $class = $_[0];  | 
| 
1288
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
202
 | 
     my ($element, $exists, $lvalue, $values, $form, $body, $member_name);  | 
| 
1289
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
232
 | 
     $element = $class->instance_var . '->' . $class->index($member_name = $self->name);  | 
| 
1290
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
329
 | 
     $exists  = $class->existence_test . ' ' . $element;  | 
| 
1291
 | 
132
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
626
 | 
     $lvalue  = $self->lvalue('$_[0]')					if $self->can('lvalue');  | 
| 
1292
 | 
132
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
463
 | 
     $values  = $self->values('$_[0]')					if $self->can('values');  | 
| 
1293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1294
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
202
 | 
     $form = '';  | 
| 
1295
 | 
132
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
372
 | 
     $form .= Class::Generate::Support::comment_form($self->comment)	if defined $self->comment;  | 
| 
1296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1297
 | 
132
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
278
 | 
     if ( $class->include_method($member_name) ) {  | 
| 
1298
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
207
 | 
 	$body = '';  | 
| 
1299
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
405
 | 
 	for my $param_form ( $self->member_forms($class) ) {  | 
| 
1300
 | 
299
 | 
 
 | 
 
 | 
 
 | 
 
 | 
860
 | 
 	    $body .= $self->$param_form($class, $element, $exists, $lvalue, $values);  | 
| 
1301
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1302
 | 
132
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
293
 | 
 	$body .= '    ' . $self->param_count_error_form($class) . ";\n" if $class->check_params;  | 
| 
1303
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
361
 | 
 	$form .= $class->sub_form($member_name, $member_name, $body);  | 
| 
1304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1305
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
358
 | 
     for my $a ( grep $_ ne $member_name, $self->accessor_names($class, $member_name) ) {  | 
| 
1306
 | 
268
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
4248
 | 
 	$a =~ s/^([a-z]+)_$member_name$/$1_form/ || $a =~ s/^${member_name}_([a-z]+)$/$1_form/;  | 
| 
1307
 | 
268
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1045
 | 
 	$form .= $self->$a($class, $element, $member_name, $exists);  | 
| 
1308
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1309
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
656
 | 
     return $form;  | 
| 
1310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1311
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1312
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub invalid_value_assignment_message {	# Return a form that dies, reporting  | 
| 
1313
 | 
78
 | 
 
 | 
 
 | 
  
78
  
 | 
 
 | 
98
 | 
     my $self = shift;			# a parameter that's not of the  | 
| 
1314
 | 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
107
 | 
     my $class = $_[0];			# correct type for its element.  | 
| 
1315
 | 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
184
 | 
     return 'croak \'' . $self->name_form($class) . 'Invalid parameter value (expected ' . $self->expected_type_form . ')\'';  | 
| 
1316
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1317
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub valid_value_test_form {		# Return a form that dies unless  | 
| 
1318
 | 
63
 | 
 
 | 
 
 | 
  
63
  
 | 
 
 | 
104
 | 
     my $self = shift;			# a value is of the correct type  | 
| 
1319
 | 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
78
 | 
     my $class = shift;			# for the member.  | 
| 
1320
 | 
63
 | 
 
 | 
 
 | 
 
 | 
 
 | 
160
 | 
     return $self->invalid_value_assignment_message($class) . ' unless ' . $self->valid_value_form(@_) . ';';  | 
| 
1321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1322
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_must_be_checked {  | 
| 
1323
 | 
118
 | 
 
 | 
 
 | 
  
118
  
 | 
 
 | 
182
 | 
     my $self = shift;  | 
| 
1324
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
152
 | 
     my $class = $_[0];  | 
| 
1325
 | 
118
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
219
 | 
     return ($class->required($self->name) && ! defined $self->default) || $self->can_be_invalid;  | 
| 
1326
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1328
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub maybe_guarded {			# If parameter checking is enabled, guard a  | 
| 
1329
 | 
106
 | 
 
 | 
 
 | 
  
106
  
 | 
 
 | 
149
 | 
     my $self = shift;			# form to check against a parameter  | 
| 
1330
 | 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
208
 | 
     my ($form, $param_no, $class) = @_;	# count. In any case, format the form  | 
| 
1331
 | 
106
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
178
 | 
     if ( $class->check_params ) {	# a little.  | 
| 
1332
 | 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
541
 | 
 	$form =~ s/^/\t/mg;  | 
| 
1333
 | 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
417
 | 
 	return "    \$#_ == $param_no\tand do {\n$form    };\n";  | 
| 
1334
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1335
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1336
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$form =~ s/^/    /mg;  | 
| 
1337
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return $form;  | 
| 
1338
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1339
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1340
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1341
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessor_names {  | 
| 
1342
 | 
315
 | 
 
 | 
 
 | 
  
315
  
 | 
 
 | 
451
 | 
     my $self = shift;  | 
| 
1343
 | 
315
 | 
 
 | 
 
 | 
 
 | 
 
 | 
469
 | 
     my ($class, $name) = @_;  | 
| 
1344
 | 
315
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
638
 | 
     return ! ($class->readonly($name) || $class->required($name)) ? ("undef_$name") : ();  | 
| 
1345
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1346
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1347
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub undef_form {			# Return the form to undefine  | 
| 
1348
 | 
88
 | 
 
 | 
 
 | 
  
88
  
 | 
 
 | 
150
 | 
     my $self = shift;			# a member.  | 
| 
1349
 | 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
214
 | 
     my ($class, $element, $member_name) = @_[0..2];  | 
| 
1350
 | 
88
 | 
 
 | 
 
 | 
 
 | 
 
 | 
231
 | 
     return $class->sub_form($member_name, 'undef_' . $member_name, '    ' . $class->undef_form . " $element;\n");  | 
| 
1351
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1352
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_count_error_form {	# Return a form that standardizes  | 
| 
1354
 | 
132
 | 
 
 | 
 
 | 
  
132
  
 | 
 
 | 
239
 | 
     my $self = shift;		# the message for dieing because  | 
| 
1355
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
     my $class = $_[0];		# of an incorrect parameter count.  | 
| 
1356
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
327
 | 
     return q|croak '| . $self->name_form($class) . q|Invalid number of parameters (', ($#_+1), ')'|;  | 
| 
1357
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1358
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1359
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub name_form {			# Standardize a method name  | 
| 
1360
 | 
310
 | 
 
 | 
 
 | 
  
310
  
 | 
 
 | 
401
 | 
     my $self = shift;		# for error messages.  | 
| 
1361
 | 
310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
376
 | 
     my $class = $_[0];  | 
| 
1362
 | 
310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
507
 | 
     return $class->name . '::' . $self->name . ': ';  | 
| 
1363
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1364
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_assignment_form {	# Return a form that assigns a parameter  | 
| 
1366
 | 
118
 | 
 
 | 
 
 | 
  
118
  
 | 
 
 | 
176
 | 
     my $self = shift;		# value to the member.  | 
| 
1367
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
217
 | 
     my ($class, $style) = @_;  | 
| 
1368
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
195
 | 
     my ($name, $element, $param, $default, $exists);  | 
| 
1369
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
202
 | 
     $name     = $self->name;  | 
| 
1370
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
240
 | 
     $element  = $class->instance_var . '->' . $class->index($name);  | 
| 
1371
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
271
 | 
     $param    = $style->ref($name);  | 
| 
1372
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
279
 | 
     $default  = $self->default;  | 
| 
1373
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
240
 | 
     $exists   = $style->existence_test($name) . ' ' . $param;  | 
| 
1374
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
232
 | 
     my $form = "    $element = ";  | 
| 
1375
 | 
118
 | 
  
 50
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
357
 | 
     if ( defined $default ) {  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1376
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$form .= "$exists ? $param : $default";  | 
| 
1377
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( $class->check_params && $class->required($name) ) {  | 
| 
1379
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
73
 | 
 	$form .= $param;  | 
| 
1380
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1381
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1382
 | 
87
 | 
 
 | 
 
 | 
 
 | 
 
 | 
164
 | 
 	$form .= "$param if $exists";  | 
| 
1383
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1384
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
379
 | 
     return $form . ";\n";  | 
| 
1385
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1386
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1387
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub default_assignment_form {	# Return a form that assigns a default value  | 
| 
1388
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $self = shift;		# to a member.  | 
| 
1389
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     my $class = $_[0];  | 
| 
1390
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     my $element;  | 
| 
1391
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     $element  = $class->instance_var . '->' . $class->index($self->name);  | 
| 
1392
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     return "    $element = " . $self->default . ";\n";  | 
| 
1393
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1395
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Scalar_Member;		# A Member subclass for  | 
| 
1396
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Scalar_Member::VERSION = '1.17';  | 
| 
1397
 | 
14
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
110
 | 
 use strict;					# scalar class members.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1226
 | 
    | 
| 
1398
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
94
 | 
 use vars qw(@ISA);				# accessor accepts 0 or 1 parameters.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
50
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9270
 | 
    | 
| 
1399
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Member);  | 
| 
1400
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1401
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_forms {  | 
| 
1402
 | 
71
 | 
 
 | 
 
 | 
  
71
  
 | 
 
 | 
120
 | 
     my $self = shift;  | 
| 
1403
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
108
 | 
     my $class = $_[0];  | 
| 
1404
 | 
71
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
163
 | 
     return $class->readonly($self->name) ? 'no_params' : ('no_params', 'one_param');  | 
| 
1405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub no_params {  | 
| 
1407
 | 
71
 | 
 
 | 
 
 | 
  
71
  
 | 
 
 | 
121
 | 
     my $self = shift;  | 
| 
1408
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
161
 | 
     my ($class, $element) = @_;  | 
| 
1409
 | 
71
 | 
  
 50
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
166
 | 
     if ( $class->readonly($self->name) && ! $class->check_params ) {  | 
| 
1410
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return "    return $element;\n";  | 
| 
1411
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1412
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
242
 | 
     return "    \$#_ == -1\tand do { return $element };\n";  | 
| 
1413
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1414
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub one_param {  | 
| 
1415
 | 
47
 | 
 
 | 
 
 | 
  
47
  
 | 
 
 | 
66
 | 
     my $self = shift;  | 
| 
1416
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
86
 | 
     my ($class, $element) = @_;  | 
| 
1417
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
     my $form = '';  | 
| 
1418
 | 
47
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
95
 | 
     $form .= Class::Generate::Member_Names::substituted($self->pre)    if defined $self->pre;  | 
| 
1419
 | 
47
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
101
 | 
     $form .= $self->valid_value_test_form($class, '$_[0]') . "\n"      if $class->check_params && defined $self->base;  | 
| 
1420
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
114
 | 
     $form .= "$element = \$_[0];\n";  | 
| 
1421
 | 
47
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
93
 | 
     $form .= Class::Generate::Member_Names::substituted($self->post)   if defined $self->post;  | 
| 
1422
 | 
47
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
140
 | 
     $form .= $self->assertion($class) . "\n"			       if defined $class->check_params && defined $self->assert;  | 
| 
1423
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
121
 | 
     $form .= "return;\n";  | 
| 
1424
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     return $self->maybe_guarded($form, 0, $class);  | 
| 
1425
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1427
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub valid_value_form {			# Return a form that tests if  | 
| 
1428
 | 
12
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
13
 | 
     my $self = shift;			# a ref is of the correct  | 
| 
1429
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
     my ($param) = @_;			# base type.  | 
| 
1430
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     return qq|UNIVERSAL::isa($param, '| . $self->base . qq|')|;  | 
| 
1431
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1433
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub can_be_invalid {			# Validity for a scalar member  | 
| 
1434
 | 
102
 | 
 
 | 
 
 | 
  
102
  
 | 
 
 | 
159
 | 
     my $self = shift;			# is testable only if the member  | 
| 
1435
 | 
102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
197
 | 
     return defined $self->base;		# is supposed to be a class.  | 
| 
1436
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1437
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1438
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub as_var {  | 
| 
1439
 | 
99
 | 
 
 | 
 
 | 
  
99
  
 | 
 
 | 
157
 | 
     my $self = shift;  | 
| 
1440
 | 
99
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
     return '$' . $self->name;  | 
| 
1441
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1442
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1443
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub method_regexp {  | 
| 
1444
 | 
99
 | 
 
 | 
 
 | 
  
99
  
 | 
 
 | 
226
 | 
     my $self = shift;  | 
| 
1445
 | 
99
 | 
 
 | 
 
 | 
 
 | 
 
 | 
153
 | 
     my $class = $_[0];  | 
| 
1446
 | 
99
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
279
 | 
     return $class->include_method($self->name) ? ('\$' . $self->name) : ();  | 
| 
1447
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1448
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessor_names {  | 
| 
1449
 | 
175
 | 
 
 | 
 
 | 
  
175
  
 | 
 
 | 
294
 | 
     my $self = shift;  | 
| 
1450
 | 
175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
341
 | 
     my ($class, $name) = @_;  | 
| 
1451
 | 
175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
542
 | 
     return grep $class->include_method($_), ($name, $self->SUPER::accessor_names($class, $name));  | 
| 
1452
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1453
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub expected_type_form {  | 
| 
1454
 | 
6
 | 
 
 | 
 
 | 
  
6
  
 | 
 
 | 
9
 | 
     my $self = shift;  | 
| 
1455
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     return $self->base;  | 
| 
1456
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1457
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1458
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub copy_form {  | 
| 
1459
 | 
37
 | 
 
 | 
 
 | 
  
37
  
 | 
 
 | 
71
 | 
     my $self = shift;  | 
| 
1460
 | 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
     my ($from, $to) = @_;  | 
| 
1461
 | 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
103
 | 
     my $form = "    $to = $from";  | 
| 
1462
 | 
37
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     if ( ! $self->nocopy ) {  | 
| 
1463
 | 
37
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
84
 | 
 	$form .= '->copy' if $self->base;  | 
| 
1464
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1465
 | 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
122
 | 
     $form .= " if defined $from;\n";  | 
| 
1466
 | 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
126
 | 
     return $form;  | 
| 
1467
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1468
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1469
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub equals {  | 
| 
1470
 | 
70
 | 
 
 | 
 
 | 
  
70
  
 | 
 
 | 
137
 | 
     my $self = shift;  | 
| 
1471
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     my ($index, $existence_test) = @_;  | 
| 
1472
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
218
 | 
     my ($sr, $or) = ('$self->' . $index, '$o->' . $index);  | 
| 
1473
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
360
 | 
     my $form = "    return undef if $existence_test $sr ^ $existence_test $or;\n" .  | 
| 
1474
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "    if ( $existence_test $sr ) { return undef unless $sr";  | 
| 
1475
 | 
70
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
166
 | 
     if ( $self->base ) {  | 
| 
1476
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	$form .= "->equals($or)";  | 
| 
1477
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1478
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1479
 | 
65
 | 
 
 | 
 
 | 
 
 | 
 
 | 
143
 | 
 	$form .= " eq $or";  | 
| 
1480
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1481
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
398
 | 
     return $form . " }\n";  | 
| 
1482
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1483
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1484
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::List_Member;		# A Member subclass for list  | 
| 
1485
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::List_Member::VERSION = '1.17';  | 
| 
1486
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
112
 | 
 use strict;					# (array and hash) members.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
587
 | 
    | 
| 
1487
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
84
 | 
 use vars qw(@ISA);				# accessor accepts 0-2 parameters.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10862
 | 
    | 
| 
1488
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Member);  | 
| 
1489
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1490
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_forms {  | 
| 
1491
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
85
 | 
     my $self = shift;  | 
| 
1492
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
79
 | 
     my $class = $_[0];  | 
| 
1493
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     return $class->readonly($self->name) ? ('no_params', 'one_param') : ('no_params', 'one_param', 'two_params');  | 
| 
1494
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1495
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub no_params {  | 
| 
1496
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
86
 | 
     my $self = shift;  | 
| 
1497
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
135
 | 
     my ($class, $element, $exists, $lvalue, $values) = @_;  | 
| 
1498
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
175
 | 
     return "    \$#_ == -1\tand do { return $exists ? " . $self->whole_lvalue($element) . " : () };\n";  | 
| 
1499
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1500
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub one_param {  | 
| 
1501
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
83
 | 
     my $self = shift;  | 
| 
1502
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
116
 | 
     my ($class, $element, $exists, $lvalue, $values) = @_;  | 
| 
1503
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
100
 | 
     my $form;  | 
| 
1504
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
147
 | 
     if ( $class->accept_refs ) {  | 
| 
1505
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
195
 | 
 	$form  = "    \$#_ == 0\tand do {\n" .  | 
| 
1506
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 "\t" . "return ($exists ? ${element}->$lvalue : undef)	if ! ref \$_[0];\n";  | 
| 
1507
 | 
59
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
114
 | 
 	if ( $class->check_params && $class->readonly($self->name) ) {  | 
| 
1508
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
 	    $form .= "croak '" . $self->name_form($class) . "Member is read-only';\n";  | 
| 
1509
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1510
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
1511
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
119
 | 
 	    $form .= "\t" . Class::Generate::Member_Names::substituted($self->pre)  if defined $self->pre;  | 
| 
1512
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
104
 | 
 	    $form .= "\t" . $self->valid_value_test_form($class, '$_[0]')  . "\n"   if $class->check_params;  | 
| 
1513
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
134
 | 
 	    $form .= "\t" . $self->whole_lvalue($element) . ' = ' . $self->whole_lvalue('$_[0]') . ";\n";  | 
| 
1514
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
142
 | 
 	    $form .= "\t" . Class::Generate::Member_Names::substituted($self->post) if defined $self->post;  | 
| 
1515
 | 
57
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
107
 | 
 	    $form .= "\t" . $self->assertion($class) . "\n"			    if defined $class->check_params && defined $self->assert;  | 
| 
1516
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
107
 | 
 	    $form .= "\t" . "return;\n";  | 
| 
1517
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1518
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
92
 | 
 	$form .= "    };\n";  | 
| 
1519
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1520
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1521
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	$form  = "    \$#_ == 0\tand do { return $exists ? ${element}->$lvalue : undef };\n"  | 
| 
1522
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1523
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     return $form;  | 
| 
1524
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1525
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub two_params {  | 
| 
1526
 | 
59
 | 
 
 | 
 
 | 
  
59
  
 | 
 
 | 
90
 | 
     my $self = shift;  | 
| 
1527
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
119
 | 
     my ($class, $element, $exists, $lvalue, $values) = @_;  | 
| 
1528
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
102
 | 
     my $form = '';  | 
| 
1529
 | 
59
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
121
 | 
     $form .= Class::Generate::Member_Names::substituted($self->pre)		if defined $self->pre;  | 
| 
1530
 | 
59
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
110
 | 
     $form .= $self->valid_element_test($class, '$_[1]') . "\n"			if $class->check_params && defined $self->base;  | 
| 
1531
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
154
 | 
     $form .= "${element}->$lvalue = \$_[1];\n";  | 
| 
1532
 | 
59
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
102
 | 
     $form .= Class::Generate::Member_Names::substituted($self->post)		if defined $self->post;  | 
| 
1533
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
88
 | 
     $form .= "return;\n";  | 
| 
1534
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
165
 | 
     return $self->maybe_guarded($form, 1, $class);  | 
| 
1535
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1536
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1537
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub valid_value_form {			# Return a form that tests if a  | 
| 
1538
 | 
110
 | 
 
 | 
 
 | 
  
110
  
 | 
 
 | 
145
 | 
     my $self = shift;			# parameter is a correct list reference  | 
| 
1539
 | 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
     my $param = $_[0];			# and (if relevant) if all of its  | 
| 
1540
 | 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
168
 | 
     my $base = $self->base;		# elements have the correct base type.  | 
| 
1541
 | 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
499
 | 
     ref($self) =~ /::(\w+)_Member$/;  | 
| 
1542
 | 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
369
 | 
     my $form = "UNIVERSAL::isa($param, '" . uc($1) . "')";  | 
| 
1543
 | 
110
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
212
 | 
     if ( defined $base ) {  | 
| 
1544
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55
 | 
 	$form .= qq| && ! grep ! (defined \$_ && UNIVERSAL::isa(\$_, '$base')), | . $self->values($param);  | 
| 
1545
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1546
 | 
110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
321
 | 
     return $form;  | 
| 
1547
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1548
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1549
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub valid_element_test {		# Return a form that dies unless an  | 
| 
1550
 | 
10
 | 
 
 | 
 
 | 
  
10
  
 | 
 
 | 
14
 | 
     my $self = shift;			# element has the correct base type.  | 
| 
1551
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
     my ($class, $param) = @_;  | 
| 
1552
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
     return $self->invalid_value_assignment_message($class) .  | 
| 
1553
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	qq| unless UNIVERSAL::isa($param, '| . $self->base . q|');|;  | 
| 
1554
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1555
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1556
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub valid_elements_test {		# Return a form that dies unless all  | 
| 
1557
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
10
 | 
     my $self = shift;			# elements of a list are validly typed.  | 
| 
1558
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     my ($class, $values) = @_;  | 
| 
1559
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     my $base = $self->base;  | 
| 
1560
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     return $self->invalid_value_assignment_message($class) .  | 
| 
1561
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   q| unless ! grep ! UNIVERSAL::isa($_, '| . $self->base . qq|'), $values;|;  | 
| 
1562
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1563
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1564
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub can_be_invalid {		# A value for a list member can  | 
| 
1565
 | 
153
 | 
 
 | 
 
 | 
  
153
  
 | 
 
 | 
424
 | 
     return 1;			# always be invalid: the wrong  | 
| 
1566
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }				# type of list can be given.  | 
| 
1567
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1568
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Array_Member;		# A List subclass for array  | 
| 
1569
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Array_Member::VERSION = '1.17';  | 
| 
1570
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
108
 | 
 use strict;					# members.  Provides the  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
481
 | 
    | 
| 
1571
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
83
 | 
 use vars qw(@ISA);				# of accessing array members.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10297
 | 
    | 
| 
1572
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::List_Member);  | 
| 
1573
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1574
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub lvalue {  | 
| 
1575
 | 
31
 | 
 
 | 
 
 | 
  
31
  
 | 
 
 | 
52
 | 
     my $self = shift;  | 
| 
1576
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
     return '[' . $_[0] . ']';  | 
| 
1577
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1578
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1579
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub whole_lvalue {  | 
| 
1580
 | 
89
 | 
 
 | 
 
 | 
  
89
  
 | 
 
 | 
108
 | 
     my $self = shift;  | 
| 
1581
 | 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
246
 | 
     return '@{' . $_[0] . '}';  | 
| 
1582
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1583
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1584
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub values {  | 
| 
1585
 | 
41
 | 
 
 | 
 
 | 
  
41
  
 | 
 
 | 
89
 | 
     my $self = shift;  | 
| 
1586
 | 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     return '@{' . $_[0] . '}';  | 
| 
1587
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1588
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1589
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub size_form {  | 
| 
1590
 | 
31
 | 
 
 | 
 
 | 
  
31
  
 | 
 
 | 
57
 | 
     my $self = shift;  | 
| 
1591
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
121
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1592
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
158
 | 
     return $class->sub_form($member_name, $member_name . '_size', "    return $exists ? \$#{$element} : -1;\n");  | 
| 
1593
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1594
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1595
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub last_form {  | 
| 
1596
 | 
31
 | 
 
 | 
 
 | 
  
31
  
 | 
 
 | 
50
 | 
     my $self = shift;  | 
| 
1597
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
70
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1598
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
149
 | 
     return $class->sub_form($member_name, 'last_' . $member_name, "    return $exists ? $element" . "[\$#{$element}] : undef;\n");  | 
| 
1599
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1600
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1601
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_form {  | 
| 
1602
 | 
30
 | 
 
 | 
 
 | 
  
30
  
 | 
 
 | 
53
 | 
     my $self = shift;  | 
| 
1603
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1604
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
     my $body = '';  | 
| 
1605
 | 
30
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
69
 | 
     $body .=  '    ' . $self->valid_elements_test($class, '@_') . "\n"	    if $class->check_params && defined $self->base;  | 
| 
1606
 | 
30
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
77
 | 
     $body .=	   Class::Generate::Member_Names::substituted($self->pre)   if defined $self->pre;  | 
| 
1607
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
99
 | 
     $body .=  '    push @{' . $element . '}, @_;' . "\n";  | 
| 
1608
 | 
30
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
56
 | 
     $body .=	   Class::Generate::Member_Names::substituted($self->post)  if defined $self->post;  | 
| 
1609
 | 
30
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
63
 | 
     $body .=  '    ' . $self->assertion($class) . "\n"			    if defined $class->check_params && defined $self->assert;  | 
| 
1610
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
187
 | 
     return $class->sub_form($member_name, 'add_' . $member_name, $body);  | 
| 
1611
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1612
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1613
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub as_var {  | 
| 
1614
 | 
34
 | 
 
 | 
 
 | 
  
34
  
 | 
 
 | 
59
 | 
     my $self = shift;  | 
| 
1615
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
66
 | 
     return '@' . $self->name;  | 
| 
1616
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1617
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1618
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub method_regexp {  | 
| 
1619
 | 
34
 | 
 
 | 
 
 | 
  
34
  
 | 
 
 | 
83
 | 
     my $self = shift;  | 
| 
1620
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
51
 | 
     my $class = $_[0];  | 
| 
1621
 | 
34
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
81
 | 
     return $class->include_method($self->name) ? ('@' . $self->name, '\$#?' . $self->name) : ();  | 
| 
1622
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1623
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessor_names {  | 
| 
1624
 | 
72
 | 
 
 | 
 
 | 
  
72
  
 | 
 
 | 
97
 | 
     my $self = shift;  | 
| 
1625
 | 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
121
 | 
     my ($class, $name) = @_;  | 
| 
1626
 | 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
261
 | 
     my @names = ($name, "${name}_size", "last_$name", $self->SUPER::accessor_names($class, $name));  | 
| 
1627
 | 
72
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
166
 | 
     push @names, "add_$name" if ! $class->readonly($name);  | 
| 
1628
 | 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
191
 | 
     return grep $class->include_method($_), @names;  | 
| 
1629
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1630
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub expected_type_form {  | 
| 
1631
 | 
39
 | 
 
 | 
 
 | 
  
39
  
 | 
 
 | 
59
 | 
     my $self = shift;  | 
| 
1632
 | 
39
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
112
 | 
     if ( defined $self->base ) {  | 
| 
1633
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
 	return 'reference to array of ' . $self->base;  | 
| 
1634
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1635
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1636
 | 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
113
 | 
 	return 'array reference';  | 
| 
1637
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1638
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1639
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1640
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub copy_form {  | 
| 
1641
 | 
30
 | 
 
 | 
 
 | 
  
30
  
 | 
 
 | 
55
 | 
     my $self = shift;  | 
| 
1642
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
66
 | 
     my ($from, $to) = @_;  | 
| 
1643
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my $form = "    $to = ";  | 
| 
1644
 | 
30
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
87
 | 
     if ( ! $self->nocopy ) {  | 
| 
1645
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
 	$form .= '[ ';  | 
| 
1646
 | 
29
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
70
 | 
 	$form .= 'map defined $_ ? $_->copy : undef, ' if $self->base;  | 
| 
1647
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
79
 | 
 	$form .= "\@{$from} ]";  | 
| 
1648
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1649
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1650
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
 	$form .= $from;  | 
| 
1651
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1652
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
68
 | 
     $form .= " if defined $from;\n";  | 
| 
1653
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
88
 | 
     return $form;  | 
| 
1654
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1655
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1656
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub equals {  | 
| 
1657
 | 
27
 | 
 
 | 
 
 | 
  
27
  
 | 
 
 | 
47
 | 
     my $self = shift;  | 
| 
1658
 | 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
     my ($index, $existence_test) = @_;  | 
| 
1659
 | 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
83
 | 
     my ($sr, $or) = ('$self->' . $index, '$o->' . $index);  | 
| 
1660
 | 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
238
 | 
     my $form = "    return undef if $existence_test($sr) ^ $existence_test($or);\n" .  | 
| 
1661
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "    if ( $existence_test $sr ) {\n" .  | 
| 
1662
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "	return undef unless (\$ub = \$#{$sr}) == \$#{$or};\n" .  | 
| 
1663
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "	for ( my \$i = 0; \$i <= \$ub; \$i++ ) {\n" .  | 
| 
1664
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "	    return undef unless $sr" . '[$i]';  | 
| 
1665
 | 
27
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
61
 | 
     if ( $self->base ) {  | 
| 
1666
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 	$form .= '->equals(' . $or . '[$i])';  | 
| 
1667
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1668
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1669
 | 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
64
 | 
 	$form .= ' eq ' . $or . '[$i]';  | 
| 
1670
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1671
 | 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
165
 | 
     return $form . ";\n\t}\n    }\n";  | 
| 
1672
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1673
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1674
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Hash_Member;		# A List subclass for Hash  | 
| 
1675
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Hash_Member::VERSION = '1.17';  | 
| 
1676
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
95
 | 
 use strict;					# members.  Provides the n_keys  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
444
 | 
    | 
| 
1677
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
75
 | 
 use vars qw(@ISA);				# specifics of accessing  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9877
 | 
    | 
| 
1678
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::List_Member);	# hash members.  | 
| 
1679
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1680
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub lvalue {  | 
| 
1681
 | 
30
 | 
 
 | 
 
 | 
  
30
  
 | 
 
 | 
55
 | 
     my $self = shift;  | 
| 
1682
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
77
 | 
     return '{' . $_[0] . '}';  | 
| 
1683
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1684
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub whole_lvalue {  | 
| 
1685
 | 
86
 | 
 
 | 
 
 | 
  
86
  
 | 
 
 | 
105
 | 
     my $self = shift;  | 
| 
1686
 | 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
218
 | 
     return '%{' . $_[0] . '}';  | 
| 
1687
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1688
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub values {  | 
| 
1689
 | 
40
 | 
 
 | 
 
 | 
  
40
  
 | 
 
 | 
127
 | 
     my $self = shift;  | 
| 
1690
 | 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
99
 | 
     return 'values %{' . $_[0] . '}';  | 
| 
1691
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1692
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1693
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub delete_form {  | 
| 
1694
 | 
29
 | 
 
 | 
 
 | 
  
29
  
 | 
 
 | 
52
 | 
     my $self = shift;  | 
| 
1695
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
80
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1696
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
121
 | 
     return $class->sub_form($member_name, 'delete_' . $member_name, "    delete \@{$element}{\@_} if $exists;\n");  | 
| 
1697
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1698
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1699
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub keys_form {  | 
| 
1700
 | 
29
 | 
 
 | 
 
 | 
  
29
  
 | 
 
 | 
58
 | 
     my $self = shift;  | 
| 
1701
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
81
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1702
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     return $class->sub_form($member_name, $member_name . '_keys', "    return $exists ? keys \%{$element} : ();\n");  | 
| 
1703
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1704
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub values_form {  | 
| 
1705
 | 
30
 | 
 
 | 
 
 | 
  
30
  
 | 
 
 | 
62
 | 
     my $self = shift;  | 
| 
1706
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
66
 | 
     my ($class, $element, $member_name, $exists) = @_;  | 
| 
1707
 | 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
139
 | 
     return $class->sub_form($member_name, $member_name . '_values', "    return $exists ? values \%{$element} : ();\n");  | 
| 
1708
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1709
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1710
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub as_var {  | 
| 
1711
 | 
32
 | 
 
 | 
 
 | 
  
32
  
 | 
 
 | 
50
 | 
     my $self = shift;  | 
| 
1712
 | 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
57
 | 
     return '%' . $self->name;  | 
| 
1713
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1714
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1715
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub method_regexp {  | 
| 
1716
 | 
32
 | 
 
 | 
 
 | 
  
32
  
 | 
 
 | 
73
 | 
     my $self = shift;  | 
| 
1717
 | 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
52
 | 
     my $class = $_[0];  | 
| 
1718
 | 
32
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
88
 | 
     return $class->include_method($self->name) ? ('[%$]' . $self->name) : ();  | 
| 
1719
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1720
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accessor_names {  | 
| 
1721
 | 
68
 | 
 
 | 
 
 | 
  
68
  
 | 
 
 | 
104
 | 
     my $self = shift;  | 
| 
1722
 | 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
127
 | 
     my ($class, $name) = @_;  | 
| 
1723
 | 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
243
 | 
     my @names = ($name, "${name}_keys", "${name}_values", $self->SUPER::accessor_names($class, $name));  | 
| 
1724
 | 
68
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
158
 | 
     push @names, "delete_$name" if ! $class->readonly($name);  | 
| 
1725
 | 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
181
 | 
     return grep $class->include_method($_), @names;  | 
| 
1726
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1727
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub expected_type_form {  | 
| 
1728
 | 
33
 | 
 
 | 
 
 | 
  
33
  
 | 
 
 | 
48
 | 
     my $self = shift;  | 
| 
1729
 | 
33
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     if ( defined $self->base ) {  | 
| 
1730
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
 	return 'reference to hash of ' . $self->base;  | 
| 
1731
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1732
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1733
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
101
 | 
 	return 'hash reference';  | 
| 
1734
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1735
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1736
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1737
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub copy_form {  | 
| 
1738
 | 
29
 | 
 
 | 
 
 | 
  
29
  
 | 
 
 | 
59
 | 
     my $self = shift;  | 
| 
1739
 | 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     my ($from, $to) = @_;  | 
| 
1740
 | 
29
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
126
 | 
     if ( ! $self->nocopy ) {  | 
| 
1741
 | 
28
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
60
 | 
 	if ( $self->base ) {  | 
| 
1742
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
 	    return "    if ( defined $from ) {\n" .  | 
| 
1743
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	           "\t$to = {};\n" .  | 
| 
1744
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   "\twhile ( my (\$key, \$value) = each \%{$from} ) {\n" .  | 
| 
1745
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   "\t    $to" . '->{$key} = defined $value ? $value->copy : undef;' . "\n" .  | 
| 
1746
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   "\t}\n" .  | 
| 
1747
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   "    }\n";  | 
| 
1748
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1749
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
1750
 | 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
121
 | 
 	    return "    $to = { \%{$from} } if defined $from;\n";  | 
| 
1751
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1752
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1753
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1754
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
 	return "    $to = $from if defined $from;\n";  | 
| 
1755
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1756
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1757
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1758
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub equals {  | 
| 
1759
 | 
25
 | 
 
 | 
 
 | 
  
25
  
 | 
 
 | 
45
 | 
     my $self = shift;  | 
| 
1760
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54
 | 
     my ($index, $existence_test) = @_;  | 
| 
1761
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     my ($sr, $or) = ('$self->' . $index, '$o->' . $index);  | 
| 
1762
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
226
 | 
     my $form = "    return undef if $existence_test $sr ^ $existence_test $or;\n" .  | 
| 
1763
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "    if ( $existence_test $sr ) {\n" .  | 
| 
1764
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       '	@self_keys = keys %{' . $sr . '};' . "\n" .  | 
| 
1765
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       '	return undef unless $#self_keys == scalar(keys %{' . $or . '}) - 1;' . "\n" .  | 
| 
1766
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       '	for my $k ( @self_keys ) {' . "\n" .  | 
| 
1767
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       "	    return undef unless exists $or" . '{$k};' . "\n" .  | 
| 
1768
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       '	    return undef if ($self_value_defined = defined ' . $sr . '{$k}) ^ defined ' . $or . '{$k};' . "\n" .  | 
| 
1769
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	       '	    if ( $self_value_defined ) { return undef unless ';  | 
| 
1770
 | 
25
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
55
 | 
     if ( $self->base ) {  | 
| 
1771
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
 	$form .= $sr . '{$k}->equals(' . $or . '{$k})';  | 
| 
1772
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1773
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1774
 | 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
85
 | 
 	$form .= $sr . '{$k} eq ' . $or . '{$k}';  | 
| 
1775
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1776
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     $form .= " }\n\t}\n    }\n";  | 
| 
1777
 | 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
90
 | 
     return $form;  | 
| 
1778
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1779
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1780
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Constructor;	# The constructor is treated as a  | 
| 
1781
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Constructor::VERSION = '1.17';  | 
| 
1782
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
91
 | 
 use strict;				# special type of member.  It includes  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
571
 | 
    | 
| 
1783
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
80
 | 
 use vars qw(@ISA);			# constraints on required members.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
35
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15888
 | 
    | 
| 
1784
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Member);  | 
| 
1785
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1786
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
1787
 | 
62
 | 
 
 | 
 
 | 
  
62
  
 | 
 
 | 
141
 | 
     my $class = shift;  | 
| 
1788
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
299
 | 
     my $self = $class->SUPER::new('new', @_);  | 
| 
1789
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
249
 | 
     return $self;  | 
| 
1790
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1791
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub style {  | 
| 
1792
 | 
358
 | 
 
 | 
 
 | 
  
358
  
 | 
 
 | 
481
 | 
     my $self = shift;  | 
| 
1793
 | 
358
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
944
 | 
     return $self->{'style'} if $#_ == -1;  | 
| 
1794
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
232
 | 
     $self->{'style'} = $_[0];  | 
| 
1795
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1796
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub constraints {  | 
| 
1797
 | 
52
 | 
 
 | 
 
 | 
  
52
  
 | 
 
 | 
92
 | 
     my $self = shift;  | 
| 
1798
 | 
52
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
288
 | 
     return exists $self->{'constraints'} ? @{$self->{'constraints'}} : () if $#_ == -1;  | 
| 
 
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
1799
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'constraints'} ? $self->{'constraints'}->[$_[0]] : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1800
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'constraints'}->[$_[0]] = $_[1];  | 
| 
1801
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1802
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_constraints {  | 
| 
1803
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $self = shift;  | 
| 
1804
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     push @{$self->{'constraints'}}, @_;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
1805
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1806
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub constraints_size {  | 
| 
1807
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my $self = shift;  | 
| 
1808
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'constraints'} ? $#{$self->{'constraints'}} : -1;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
1809
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1810
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub constraint_form {  | 
| 
1811
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $self = shift;  | 
| 
1812
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     my ($class, $style, $constraint) = @_;  | 
| 
1813
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     my $param_given = $constraint;  | 
| 
1814
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     $param_given =~ s/\w+/$style->existence_test($&) . ' ' . $style->ref($&)/eg;  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
1815
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     $constraint =~ s/'/\\'/g;  | 
| 
1816
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     return q|croak '| . $self->name_form($class) . qq|Parameter constraint "$constraint" failed' unless $param_given;|;  | 
| 
1817
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1818
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub param_tests_form {  | 
| 
1819
 | 
57
 | 
 
 | 
 
 | 
  
57
  
 | 
 
 | 
94
 | 
     my $self = shift;  | 
| 
1820
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     my ($class, $style) = @_;  | 
| 
1821
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
122
 | 
     my $form = '';  | 
| 
1822
 | 
57
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
127
 | 
     if ( ! $class->parents && $style->can('params_check_form') ) {  | 
| 
1823
 | 
45
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
 	$form .= $style->params_check_form($class, $self);  | 
| 
1824
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1825
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
345
 | 
     if ( ! $style->isa('Class::Generate::Own') ) {  | 
| 
1826
 | 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
 	my @public_members = map $class->members($_), $class->public_member_names;  | 
| 
1827
 | 
52
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
282
 | 
 	for my $param_test ( map $_->param_must_be_checked($class) ? $_->param_test($class) : (), @public_members ) {  | 
| 
1828
 | 
84
 | 
 
 | 
 
 | 
 
 | 
 
 | 
229
 | 
 	    $form .= '    ' . $param_test . "\n";  | 
| 
1829
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1830
 | 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
206
 | 
 	for my $constraint ( $self->constraints ) {  | 
| 
1831
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 	    $form .= '    ' . $self->constraint_form($class, $style, $constraint) . "\n";  | 
| 
1832
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1833
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1834
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
173
 | 
     return $form;  | 
| 
1835
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1836
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub assertions_form {  | 
| 
1837
 | 
57
 | 
 
 | 
 
 | 
  
57
  
 | 
 
 | 
100
 | 
     my $self = shift;  | 
| 
1838
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
93
 | 
     my $class = $_[0];  | 
| 
1839
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
99
 | 
     my $form = '';  | 
| 
1840
 | 
57
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
127
 | 
     $form .= '    ' . $self->assertion($class) . "\n"	     if defined $class->check_params && defined $self->assert;  | 
| 
1841
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
163
 | 
     for my $member ( grep defined $_->assert, $class->members_values ) {  | 
| 
1842
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
 	$form .= '    ' . $member->assertion($class) . "\n";  | 
| 
1843
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1844
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
148
 | 
     return $form;  | 
| 
1845
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1846
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form {  | 
| 
1847
 | 
57
 | 
 
 | 
 
 | 
  
57
  
 | 
 
 | 
115
 | 
     my $self = shift;  | 
| 
1848
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     my $class = $_[0];  | 
| 
1849
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
155
 | 
     my $style = $self->style;  | 
| 
1850
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
146
 | 
     my ($iv, $cv) = ($class->instance_var, $class->class_var);  | 
| 
1851
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
108
 | 
     my $form;  | 
| 
1852
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
264
 | 
     $form  = "sub new {\n" .  | 
| 
1853
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	     "    my $cv = " .  | 
| 
1854
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 ($class->nfi ? 'do { my $proto = shift; ref $proto || $proto }' : 'shift') .  | 
| 
1855
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 ";\n";  | 
| 
1856
 | 
57
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
173
 | 
     if ( $class->check_params && $class->virtual ) {  | 
| 
1857
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
 	$form .= q|    croak '| . $self->name_form($class) . q|Virtual class' unless $class ne '| . $class->name . qq|';\n|;  | 
| 
1858
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1859
 | 
57
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
189
 | 
     $form .= $style->init_form($class, $self)		if ! $class->can_assign_all_params &&  | 
| 
1860
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 							   $style->can('init_form');  | 
| 
1861
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
151
 | 
     $form .= $self->param_tests_form($class, $style)	if $class->check_params;  | 
| 
1862
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
159
 | 
     if ( defined $class->parents ) {  | 
| 
1863
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
 	$form .=  $style->self_from_super_form($class);  | 
| 
1864
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1865
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
1866
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
204
 | 
 	$form .= '    my ' . $iv . ' = ' . $class->base . ";\n" .  | 
| 
1867
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 '    bless ' . $iv . ', ' . $cv . ";\n";  | 
| 
1868
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1869
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
157
 | 
     if ( ! $class->can_assign_all_params ) {  | 
| 
1870
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
363
 | 
 	$form .= $class->size_establishment($iv)	if $class->can('size_establishment');  | 
| 
1871
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
281
 | 
 	if ( ! $style->isa('Class::Generate::Own') ) {  | 
| 
1872
 | 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
136
 | 
 	    for my $name ( $class->public_member_names ) {  | 
| 
1873
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
253
 | 
 		$form .= $class->members($name)->param_assignment_form($class, $style);  | 
| 
1874
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
1875
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
1876
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1877
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
249
 | 
     $form .= $class->protected_members_info_form;  | 
| 
1878
 | 
57
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
162
 | 
     for my $member ( grep(($style->isa('Class::Generate::Own') || $class->protected($_->name) || $class->private($_->name)) &&  | 
| 
1879
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  defined $_->default, $class->members_values) ) {  | 
| 
1880
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
 	$form .= $member->default_assignment_form($class);  | 
| 
1881
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
1882
 | 
57
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
164
 | 
     $form .= Class::Generate::Member_Names::substituted($self->post) if defined $self->post;  | 
| 
1883
 | 
57
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
148
 | 
     $form .= $self->assertions_form($class)		if $class->check_params;  | 
| 
1884
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
177
 | 
     $form .= '    return ' . $iv . ";\n" .  | 
| 
1885
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	     "}\n";  | 
| 
1886
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
260
 | 
     return $form;  | 
| 
1887
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1888
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1889
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Method;	# A user-defined method,  | 
| 
1890
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Method::VERSION = '1.17';  | 
| 
1891
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# with a name and body.  | 
| 
1892
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
1893
 | 
28
 | 
 
 | 
 
 | 
  
28
  
 | 
 
 | 
51
 | 
     my $class = shift;  | 
| 
1894
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
     my $self = { name => $_[0], body => $_[1] };  | 
| 
1895
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     bless $self, $class;  | 
| 
1896
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
54
 | 
     return $self;  | 
| 
1897
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1898
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1899
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub name {  | 
| 
1900
 | 
139
 | 
 
 | 
 
 | 
  
139
  
 | 
 
 | 
181
 | 
     my $self = shift;  | 
| 
1901
 | 
139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
326
 | 
     return $self->{'name'};  | 
| 
1902
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1903
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1904
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub body {  | 
| 
1905
 | 
77
 | 
 
 | 
 
 | 
  
77
  
 | 
 
 | 
106
 | 
     my $self = shift;  | 
| 
1906
 | 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
226
 | 
     return $self->{'body'};  | 
| 
1907
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1908
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1909
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub comment {  | 
| 
1910
 | 
26
 | 
 
 | 
 
 | 
  
26
  
 | 
 
 | 
37
 | 
     my $self = shift;  | 
| 
1911
 | 
26
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
110
 | 
     return $self->{'comment'} if $#_ == -1;  | 
| 
1912
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'comment'} = $_[0];  | 
| 
1913
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1914
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1915
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form {  | 
| 
1916
 | 
26
 | 
 
 | 
 
 | 
  
26
  
 | 
 
 | 
44
 | 
     my $self = shift;  | 
| 
1917
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
     my $class = $_[0];  | 
| 
1918
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
44
 | 
     my $form = '';  | 
| 
1919
 | 
26
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
69
 | 
     $form .= Class::Generate::Support::comment_form($self->comment) if defined $self->comment;  | 
| 
1920
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
     $form .= $class->sub_form($self->name, $self->name, Class::Generate::Member_Names::substituted($self->body));  | 
| 
1921
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
100
 | 
     return $form;  | 
| 
1922
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1923
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1924
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Class_Method;	# A user-defined class method,  | 
| 
1925
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Class_Method::VERSION = '1.17';  | 
| 
1926
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
107
 | 
 use strict;				# which may specify objects  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1843
 | 
    | 
| 
1927
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
83
 | 
 use vars qw(@ISA);			# of the class used within its  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3081
 | 
    | 
| 
1928
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Method);	# body.  | 
| 
1929
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1930
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub objects {  | 
| 
1931
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
     my $self = shift;  | 
| 
1932
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
7
 | 
     return exists $self->{'objects'} ? @{$self->{'objects'}} : ()	   if $#_ == -1;  | 
| 
 
 | 
  
0
  
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
1933
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'objects'} ? $self->{'objects'}->[$_[0]] : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1934
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'objects'}->[$_[0]] = $_[1];  | 
| 
1935
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1936
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_objects {  | 
| 
1937
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my $self = shift;  | 
| 
1938
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     push @{$self->{'objects'}}, @_;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
1939
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1940
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1941
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form {  | 
| 
1942
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
4
 | 
     my $self = shift;  | 
| 
1943
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     my $class = $_[0];  | 
| 
1944
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     return $class->class_sub_form($self->name, Class::Generate::Member_Names::substituted_in_class_method($self));  | 
| 
1945
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1946
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1947
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Class;			# A virtual class describing  | 
| 
1948
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Class::VERSION = '1.17';  | 
| 
1949
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
112
 | 
 use strict;					# a user-specified class.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
50104
 | 
    | 
| 
1950
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1951
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
1952
 | 
62
 | 
 
 | 
 
 | 
  
62
  
 | 
 
 | 
134
 | 
     my $class = shift;  | 
| 
1953
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
391
 | 
     my $self = { name => shift, @_ };  | 
| 
1954
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
     bless $self, $class;  | 
| 
1955
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
179
 | 
     return $self;  | 
| 
1956
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1957
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1958
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub name {  | 
| 
1959
 | 
684
 | 
 
 | 
 
 | 
  
684
  
 | 
 
 | 
878
 | 
     my $self = shift;  | 
| 
1960
 | 
684
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2704
 | 
     return $self->{'name'};  | 
| 
1961
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1962
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub parents {  | 
| 
1963
 | 
815
 | 
 
 | 
 
 | 
  
815
  
 | 
 
 | 
1125
 | 
     my $self = shift;  | 
| 
1964
 | 
815
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
3144
 | 
     return exists $self->{'parents'} ? @{$self->{'parents'}} : ()	   if $#_ == -1;  | 
| 
 
 | 
213
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
1075
 | 
    | 
| 
1965
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'parents'} ? $self->{'parents'}->[$_[0]] : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1966
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'parents'}->[$_[0]] = $_[1];  | 
| 
1967
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1968
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_parents {  | 
| 
1969
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
40
 | 
     my $self = shift;  | 
| 
1970
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
     push @{$self->{'parents'}}, @_;  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
    | 
| 
1971
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1972
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub members {  | 
| 
1973
 | 
725
 | 
 
 | 
 
 | 
  
725
  
 | 
 
 | 
936
 | 
     my $self = shift;  | 
| 
1974
 | 
725
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1494
 | 
     return exists $self->{'members'} ? %{$self->{'members'}} : ()	   if $#_ == -1;  | 
| 
 
 | 
52
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
319
 | 
    | 
| 
1975
 | 
664
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
2486
 | 
     return exists $self->{'members'} ? $self->{'members'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1976
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
313
 | 
     $self->{'members'}->{$_[0]} = $_[1];  | 
| 
1977
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1978
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub members_keys {  | 
| 
1979
 | 
490
 | 
 
 | 
 
 | 
  
490
  
 | 
 
 | 
611
 | 
     my $self = shift;  | 
| 
1980
 | 
490
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
911
 | 
     return exists $self->{'members'} ? keys %{$self->{'members'}} : ();  | 
| 
 
 | 
434
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1493
 | 
    | 
| 
1981
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1982
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub members_values {  | 
| 
1983
 | 
653
 | 
 
 | 
 
 | 
  
653
  
 | 
 
 | 
883
 | 
     my $self = shift;  | 
| 
1984
 | 
653
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1212
 | 
     return exists $self->{'members'} ? values %{$self->{'members'}} : ();  | 
| 
 
 | 
574
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2134
 | 
    | 
| 
1985
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1986
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub user_defined_methods {  | 
| 
1987
 | 
161
 | 
 
 | 
 
 | 
  
161
  
 | 
 
 | 
263
 | 
     my $self = shift;  | 
| 
1988
 | 
161
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
572
 | 
     return exists $self->{'udm'} ? %{$self->{'udm'}} : ()	   if $#_ == -1;  | 
| 
 
 | 
13
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
186
 | 
    | 
| 
1989
 | 
100
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
653
 | 
     return exists $self->{'udm'} ? $self->{'udm'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
1990
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     $self->{'udm'}->{$_[0]} = $_[1];  | 
| 
1991
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1992
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub user_defined_methods_keys {  | 
| 
1993
 | 
200
 | 
 
 | 
 
 | 
  
200
  
 | 
 
 | 
320
 | 
     my $self = shift;  | 
| 
1994
 | 
200
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
591
 | 
     return exists $self->{'udm'} ? keys %{$self->{'udm'}} : ();  | 
| 
 
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
229
 | 
    | 
| 
1995
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
1996
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub user_defined_methods_values {  | 
| 
1997
 | 
311
 | 
 
 | 
 
 | 
  
311
  
 | 
 
 | 
441
 | 
     my $self = shift;  | 
| 
1998
 | 
311
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
872
 | 
     return exists $self->{'udm'} ? values %{$self->{'udm'}} : ();  | 
| 
 
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
395
 | 
    | 
| 
1999
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2000
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_vars {  | 
| 
2001
 | 
123
 | 
 
 | 
 
 | 
  
123
  
 | 
 
 | 
210
 | 
     my $self = shift;  | 
| 
2002
 | 
123
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
476
 | 
     return exists $self->{'class_vars'} ? @{$self->{'class_vars'}} : ()		 if $#_ == -1;  | 
| 
 
 | 
3
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
2003
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'class_vars'} ? $self->{'class_vars'}->[$_[0]] : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2004
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'class_vars'}->[$_[0]] = $_[1];  | 
| 
2005
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2006
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_class_vars {  | 
| 
2007
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
     my $self = shift;  | 
| 
2008
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     push @{$self->{'class_vars'}}, @_;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
    | 
| 
2009
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2010
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub use_packages {  | 
| 
2011
 | 
126
 | 
 
 | 
 
 | 
  
126
  
 | 
 
 | 
215
 | 
     my $self = shift;  | 
| 
2012
 | 
126
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
540
 | 
     return exists $self->{'use_packages'} ? @{$self->{'use_packages'}} : ()	     if $#_ == -1;  | 
| 
 
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
108
 | 
    | 
| 
2013
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return exists $self->{'use_packages'} ? $self->{'use_packages'}->[$_[0]] : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2014
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'use_packages'}->[$_[0]] = $_[1];  | 
| 
2015
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2016
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub add_use_packages {  | 
| 
2017
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
7
 | 
     my $self = shift;  | 
| 
2018
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     push @{$self->{'use_packages'}}, @_;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
    | 
| 
2019
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2020
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub excluded_methods_regexp {  | 
| 
2021
 | 
1843
 | 
 
 | 
 
 | 
  
1843
  
 | 
 
 | 
1958
 | 
     my $self = shift;  | 
| 
2022
 | 
1843
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
3770
 | 
     return $self->{'em'} if $#_ == -1;  | 
| 
2023
 | 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
     $self->{'em'} = $_[0];  | 
| 
2024
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2025
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub private {  | 
| 
2026
 | 
2244
 | 
 
 | 
 
 | 
  
2244
  
 | 
 
 | 
2814
 | 
     my $self = shift;  | 
| 
2027
 | 
2244
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
3979
 | 
     return exists $self->{'private'} ? %{$self->{'private'}} : ()	   if $#_ == -1;  | 
| 
 
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
2028
 | 
2183
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
7924
 | 
     return exists $self->{'private'} ? $self->{'private'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2029
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
     $self->{'private'}->{$_[0]} = $_[1];  | 
| 
2030
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2031
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected {  | 
| 
2032
 | 
1675
 | 
 
 | 
 
 | 
  
1675
  
 | 
 
 | 
2104
 | 
     my $self = shift;  | 
| 
2033
 | 
1675
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
2750
 | 
     return exists $self->{'protected'} ? %{$self->{'protected'}} : ()	       if $#_ == -1;  | 
| 
 
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
17
 | 
    | 
| 
2034
 | 
1614
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
5563
 | 
     return exists $self->{'protected'} ? $self->{'protected'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2035
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
     $self->{'protected'}->{$_[0]} = $_[1];  | 
| 
2036
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2037
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub required {  | 
| 
2038
 | 
681
 | 
 
 | 
 
 | 
  
681
  
 | 
 
 | 
908
 | 
     my $self = shift;  | 
| 
2039
 | 
681
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
1133
 | 
     return exists $self->{'required'} ? %{$self->{'required'}} : ()	     if $#_ == -1;  | 
| 
 
 | 
  
0
  
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
2040
 | 
681
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
2973
 | 
     return exists $self->{'required'} ? $self->{'required'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2041
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
183
 | 
     $self->{'required'}->{$_[0]} = $_[1];  | 
| 
2042
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2043
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub readonly {  | 
| 
2044
 | 
743
 | 
 
 | 
 
 | 
  
743
  
 | 
 
 | 
936
 | 
     my $self = shift;  | 
| 
2045
 | 
743
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
1302
 | 
     return exists $self->{'readonly'} ? %{$self->{'readonly'}} : ()	     if $#_ == -1;  | 
| 
 
 | 
  
0
  
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
2046
 | 
743
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
3069
 | 
     return exists $self->{'readonly'} ? $self->{'readonly'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2047
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
136
 | 
     $self->{'readonly'}->{$_[0]} = $_[1];  | 
| 
2048
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2049
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub constructor {  | 
| 
2050
 | 
491
 | 
 
 | 
 
 | 
  
491
  
 | 
 
 | 
655
 | 
     my $self = shift;  | 
| 
2051
 | 
491
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1523
 | 
     return $self->{'constructor'} if $#_ == -1;  | 
| 
2052
 | 
62
 | 
 
 | 
 
 | 
 
 | 
 
 | 
180
 | 
     $self->{'constructor'} = $_[0];  | 
| 
2053
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2054
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub virtual {  | 
| 
2055
 | 
66
 | 
 
 | 
 
 | 
  
66
  
 | 
 
 | 
122
 | 
     my $self = shift;  | 
| 
2056
 | 
66
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
347
 | 
     return $self->{'virtual'} if $#_ == -1;  | 
| 
2057
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'virtual'} = $_[0];  | 
| 
2058
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2059
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub comment {  | 
| 
2060
 | 
62
 | 
 
 | 
 
 | 
  
62
  
 | 
 
 | 
124
 | 
     my $self = shift;  | 
| 
2061
 | 
62
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
307
 | 
     return $self->{'comment'} if $#_ == -1;  | 
| 
2062
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'comment'} = $_[0];  | 
| 
2063
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2064
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub accept_refs {  | 
| 
2065
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
85
 | 
     my $self = shift;  | 
| 
2066
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
132
 | 
     return $self->{'accept_refs'};  | 
| 
2067
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2068
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub strict {  | 
| 
2069
 | 
122
 | 
 
 | 
 
 | 
  
122
  
 | 
 
 | 
192
 | 
     my $self = shift;  | 
| 
2070
 | 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
400
 | 
     return $self->{'strict'};  | 
| 
2071
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2072
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub nfi {  | 
| 
2073
 | 
57
 | 
 
 | 
 
 | 
  
57
  
 | 
 
 | 
127
 | 
     my $self = shift;  | 
| 
2074
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
225
 | 
     return $self->{'nfi'};  | 
| 
2075
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2076
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub warnings {  | 
| 
2077
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
113
 | 
     my $self = shift;  | 
| 
2078
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
181
 | 
     return $self->{'warnings'} if $#_ == -1;  | 
| 
2079
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
186
 | 
     $self->{'warnings'} = $_[0];  | 
| 
2080
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2081
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub check_params {  | 
| 
2082
 | 
1318
 | 
 
 | 
 
 | 
  
1318
  
 | 
 
 | 
1570
 | 
     my $self = shift;  | 
| 
2083
 | 
1318
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
5764
 | 
     return $self->{'check_params'} if $#_ == -1;  | 
| 
2084
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
     $self->{'check_params'} = $_[0];  | 
| 
2085
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2086
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub instance_methods {  | 
| 
2087
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
5
 | 
     my $self = shift;  | 
| 
2088
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     return grep ! $_->isa('Class::Generate::Class_Method'), $self->user_defined_methods_values;  | 
| 
2089
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2090
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_methods {  | 
| 
2091
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
105
 | 
     my $self = shift;  | 
| 
2092
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
220
 | 
     return grep $_->isa('Class::Generate::Class_Method'), $self->user_defined_methods_values;  | 
| 
2093
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2094
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub include_method {  | 
| 
2095
 | 
1714
 | 
 
 | 
 
 | 
  
1714
  
 | 
 
 | 
2092
 | 
     my $self = shift;  | 
| 
2096
 | 
1714
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1938
 | 
     my $method_name = $_[0];  | 
| 
2097
 | 
1714
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2325
 | 
     my $r = $self->excluded_methods_regexp;  | 
| 
2098
 | 
1714
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
5429
 | 
     return ! defined $r || $method_name !~ m/$r/;  | 
| 
2099
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub member_methods_form {	# Return a form containing methods for all  | 
| 
2101
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
107
 | 
     my $self = shift;		# non-private members in the class, plus  | 
| 
2102
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
122
 | 
     my $form = '';		# private members used in class methods.  | 
| 
2103
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
193
 | 
     for my $element ( $self->public_member_names, $self->protected_member_names, $self->private_members_used_in_user_defined_code ) {  | 
| 
2104
 | 
132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
304
 | 
 	$form .= $self->members($element)->form($self);  | 
| 
2105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2106
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
218
 | 
     $form .= "\n" if $form ne '';  | 
| 
2107
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
303
 | 
     return $form;  | 
| 
2108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub user_defined_methods_form {		# Return a form containing all  | 
| 
2111
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
109
 | 
     my $self = shift;			# user-defined methods.  | 
| 
2112
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
159
 | 
     my $form = join('', map($_->form($self), $self->user_defined_methods_values));  | 
| 
2113
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
275
 | 
     return length $form > 0 ? $form . "\n" : '';  | 
| 
2114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub warnings_pragmas {			# Return an array containing the  | 
| 
2117
 | 
122
 | 
 
 | 
 
 | 
  
122
  
 | 
 
 | 
180
 | 
     my $self = shift;			# warnings pragmas for the class.  | 
| 
2118
 | 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
231
 | 
     my $w = $self->{'warnings'};  | 
| 
2119
 | 
122
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
296
 | 
     return ()			if ! defined $w;  | 
| 
2120
 | 
122
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
237
 | 
     return ('no warnings;')	if ! $w;  | 
| 
2121
 | 
122
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
837
 | 
     return ('use warnings;')	if $w =~ /^\d+$/;  | 
| 
2122
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return ("use warnings $w;") if ! ref $w;  | 
| 
2123
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2124
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my @pragmas;  | 
| 
2125
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     for ( my $i = 0; $i <= $#$w; $i += 2 ) {  | 
| 
2126
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	my ($key, $value) = ($$w[$i], $$w[$i+1]);  | 
| 
2127
 | 
  
0
  
 | 
  
  0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
0
 | 
 	if ( $key eq 'register' ) {  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2128
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    push @pragmas, 'use warnings::register;' if $value;  | 
| 
2129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	elsif ( defined $value && $value ) {  | 
| 
2131
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    if ( $value =~ /^\d+$/ ) {  | 
| 
2132
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		push @pragmas, $key . ' warnings;';  | 
| 
2133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
2134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    else {  | 
| 
2135
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		push @pragmas, $key . ' warnings ' . $value . ';';  | 
| 
2136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }  | 
| 
2137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2139
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return @pragmas;  | 
| 
2140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2141
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub warnings_form {			# Return a form representing the  | 
| 
2143
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
100
 | 
     my $self = shift;			# warnings pragmas for a class.  | 
| 
2144
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
     my @warnings_pragmas = $self->warnings_pragmas;  | 
| 
2145
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
309
 | 
     return @warnings_pragmas ? join("\n", @warnings_pragmas) . "\n" : '';  | 
| 
2146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub form {				# Return a form representing  | 
| 
2149
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
118
 | 
     my $self = shift;			# a class.  | 
| 
2150
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
89
 | 
     my $form;  | 
| 
2151
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
151
 | 
     $form  = 'package ' . $self->name . ";\n";  | 
| 
2152
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
156
 | 
     $form .= "use strict;\n"						     if $self->strict;  | 
| 
2153
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
167
 | 
     $form .= join("\n", map("use $_;", $self->use_packages)) . "\n"	     if $self->use_packages;  | 
| 
2154
 | 
61
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
233
 | 
     $form .= "use Carp;\n"						     if defined $self->{'check_params'};  | 
| 
2155
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
214
 | 
     $form .= $self->warnings_form;  | 
| 
2156
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
236
 | 
     $form .= Class::Generate::Class_Holder::form($self);  | 
| 
2157
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
176
 | 
     $form .= "\n";  | 
| 
2158
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
265
 | 
     $form .= Class::Generate::Support::comment_form($self->comment)	     if defined $self->comment;  | 
| 
2159
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
158
 | 
     $form .= $self->isa_decl_form					     if $self->parents;  | 
| 
2160
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
189
 | 
     $form .= $self->private_methods_decl_form				     if grep $self->private($_), $self->user_defined_methods_keys;  | 
| 
2161
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
249
 | 
     $form .= $self->private_members_decl_form				     if $self->private_members_used_in_user_defined_code;  | 
| 
2162
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
183
 | 
     $form .= $self->protected_methods_decl_form				     if grep $self->protected($_), $self->user_defined_methods_keys;  | 
| 
2163
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
157
 | 
     $form .= $self->protected_members_decl_form				     if grep $self->protected($_), $self->members_keys;  | 
| 
2164
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
186
 | 
     $form .= join("\n", map(class_var_form($_), $self->class_vars)) . "\n\n" if $self->class_vars;  | 
| 
2165
 | 
61
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
223
 | 
     $form .= $self->constructor->form($self)				     if $self->needs_constructor;  | 
| 
2166
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
264
 | 
     $form .= $self->member_methods_form;  | 
| 
2167
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
275
 | 
     $form .= $self->user_defined_methods_form;  | 
| 
2168
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
165
 | 
     my $emr = $self->excluded_methods_regexp;  | 
| 
2169
 | 
61
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
440
 | 
     $form .= $self->copy_form		if ! defined $emr || 'copy' !~ m/$emr/;  | 
| 
2170
 | 
61
 | 
  
 50
  
 | 
  
100
  
 | 
 
 | 
 
 | 
423
 | 
     $form .= $self->equals_form		if (! defined $emr || 'equals' !~ m/$emr/) &&  | 
| 
 
 | 
 
 | 
 
 | 
  
 66
  
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					   ! defined $self->user_defined_methods('equals');  | 
| 
2172
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
228
 | 
     return $form;  | 
| 
2173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_var_form {			# Return a form for declaring a class  | 
| 
2176
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $var_spec = $_[0];		# variable.  Account for an initial value.  | 
| 
2177
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     return "my $var_spec;" if ! ref $var_spec;  | 
| 
2178
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return map { my $value = $$var_spec{$_};  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
2179
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 		 "my $_ = " . (ref $value ? substr($_, 0, 1) . "{$value}" : $value) . ';'  | 
| 
2180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 } keys %$var_spec;  | 
| 
2181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub isa_decl_form {  | 
| 
2184
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
43
 | 
     my $self = shift;  | 
| 
2185
 | 
15
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
52
 | 
     my @parent_names = map ! ref $_ ? $_ : $_->name, $self->parents;  | 
| 
2186
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     return "use vars qw(\@ISA);\n" .  | 
| 
2187
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   '@ISA = qw(' . join(' ', @parent_names) . ");\n";  | 
| 
2188
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2189
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2190
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub sub_form {				# Return a declaration for a sub, as an  | 
| 
2191
 | 
426
 | 
 
 | 
 
 | 
  
426
  
 | 
 
 | 
553
 | 
     my $self = shift;			# assignment to a variable if not public.  | 
| 
2192
 | 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
724
 | 
     my ($element_name, $sub_name, $body) = @_;  | 
| 
2193
 | 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
504
 | 
     my ($form, $not_public);  | 
| 
2194
 | 
426
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
708
 | 
     $not_public = $self->private($element_name) || $self->protected($element_name);  | 
| 
2195
 | 
426
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
1109
 | 
     $form = ($not_public ? "\$$sub_name = sub" : "sub $sub_name") . " {\n" .  | 
| 
2196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             '    my ' . $self->instance_var . " = shift;\n" .  | 
| 
2197
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $body .  | 
| 
2198
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    '}';  | 
| 
2199
 | 
426
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
795
 | 
     $form .= ';' if $not_public;  | 
| 
2200
 | 
426
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1437
 | 
     return $form . "\n";  | 
| 
2201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2202
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_sub_form {			# Ditto, but for a class method.  | 
| 
2204
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
4
 | 
     my $self = shift;  | 
| 
2205
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     my ($method_name, $body) = @_;  | 
| 
2206
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     my ($form, $not_public);  | 
| 
2207
 | 
2
 | 
 
 | 
  
 33
  
 | 
 
 | 
 
 | 
5
 | 
     $not_public = $self->private($method_name) || $self->protected($method_name);  | 
| 
2208
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     $form = ($not_public ? "\$$method_name = sub" : "sub $method_name") . " {\n" .  | 
| 
2209
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    '    my ' . $self->class_var . " = shift;\n" .  | 
| 
2210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    $body .  | 
| 
2211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    '}';  | 
| 
2212
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     $form .= ';' if $not_public;  | 
| 
2213
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     return $form . "\n";  | 
| 
2214
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub private_methods_decl_form {		# Private methods are implemented as CODE refs.  | 
| 
2217
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
2
 | 
     my $self = shift;			# Return a form declaring the variables to hold them.  | 
| 
2218
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     my @private_methods = grep $self->private($_), $self->user_defined_methods_keys;  | 
| 
2219
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     return Class::Generate::Support::my_decl_form(map "\$$_", @private_methods);  | 
| 
2220
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2222
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub private_members_used_in_user_defined_code {	# Return the names of all private  | 
| 
2223
 | 
124
 | 
 
 | 
 
 | 
  
124
  
 | 
 
 | 
219
 | 
     my $self = shift;				# members that appear in user-defined code.  | 
| 
2224
 | 
124
 | 
 
 | 
 
 | 
 
 | 
 
 | 
264
 | 
     my @private_members = grep $self->private($_), $self->members_keys;  | 
| 
2225
 | 
124
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
394
 | 
     return () if ! @private_members;  | 
| 
2226
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
     my $member_regexp = join '|', @private_members;  | 
| 
2227
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     my %private_members;  | 
| 
2228
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
     for my $code ( map($_->body, $self->user_defined_methods_values),  | 
| 
2229
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		   grep(defined $_, (map(($_->pre, $_->post, $_->assert), $self->members_values),  | 
| 
2230
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				     map(($_->post, $_->assert), $self->constructor))) ) {  | 
| 
2231
 | 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
 	while ( $code =~ /($member_regexp)/g ) {  | 
| 
2232
 | 
66
 | 
 
 | 
 
 | 
 
 | 
 
 | 
209
 | 
 	    $private_members{$1}++;  | 
| 
2233
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2234
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2235
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
     return keys %private_members;  | 
| 
2236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2238
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub nonpublic_members_decl_form {  | 
| 
2239
 | 
6
 | 
 
 | 
 
 | 
  
6
  
 | 
 
 | 
14
 | 
     my $self = shift;  | 
| 
2240
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     my @members = @_;  | 
| 
2241
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
     my @accessor_names = map($_->accessor_names($self, $_->name), @members);  | 
| 
2242
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
57
 | 
     return Class::Generate::Support::my_decl_form(map "\$$_", @accessor_names);  | 
| 
2243
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2244
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2245
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub private_members_decl_form {  | 
| 
2246
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
13
 | 
     my $self = shift;  | 
| 
2247
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     return $self->nonpublic_members_decl_form(map $self->members($_), $self->private_members_used_in_user_defined_code);  | 
| 
2248
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2250
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_methods_decl_form {  | 
| 
2251
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
5
 | 
     my $self = shift;  | 
| 
2252
 | 
1
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     return Class::Generate::Support::my_decl_form(map $self->protected($_) ? "\$$_" : (), $self->user_defined_methods_keys);  | 
| 
2253
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2254
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_members_decl_form {  | 
| 
2255
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
9
 | 
     my $self = shift;  | 
| 
2256
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     return $self->nonpublic_members_decl_form(grep $self->protected($_->name), $self->members_values);  | 
| 
2257
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2258
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_members_info_form {  | 
| 
2259
 | 
57
 | 
 
 | 
 
 | 
  
57
  
 | 
 
 | 
100
 | 
     my $self = shift;  | 
| 
2260
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
     my @protected_members = grep $self->protected($_->name), $self->members_values;  | 
| 
2261
 | 
57
 | 
 
 | 
 
 | 
 
 | 
 
 | 
150
 | 
     my @protected_methods = grep $self->protected($_->name), $self->user_defined_methods_values;  | 
| 
2262
 | 
57
 | 
  
100
  
 | 
  
 66
  
 | 
 
 | 
 
 | 
328
 | 
     return '' if ! (@protected_members || @protected_methods);  | 
| 
2263
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
     my $info_index_lvalue = $self->instance_var . '->' . $self->protected_members_info_index;  | 
| 
2264
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     my @protected_element_names = (map($_->accessor_names($class, $_->name), @protected_members),  | 
| 
2265
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				   map($_->name, @protected_methods));  | 
| 
2266
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     if ( $self->parents ) {  | 
| 
2267
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	my $form = '';  | 
| 
2268
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	for my $element_name ( @protected_element_names ) {  | 
| 
2269
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	    $form .= "    ${info_index_lvalue}->{'$element_name'} = \$$element_name;\n";  | 
| 
2270
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2271
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return $form;  | 
| 
2272
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2273
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
2274
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
55
 | 
 	return "    $info_index_lvalue = { " . join(', ', map "$_ => \$$_", @protected_element_names) . " };\n";  | 
| 
2275
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2276
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2277
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub copy_form {  | 
| 
2279
 | 
59
 | 
 
 | 
 
 | 
  
59
  
 | 
 
 | 
137
 | 
     my $self = shift;  | 
| 
2280
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
119
 | 
     my ($form, @members, $has_parents);  | 
| 
2281
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
145
 | 
     @members = $self->members_values;  | 
| 
2282
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
147
 | 
     $has_parents = defined $self->parents;  | 
| 
2283
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
136
 | 
     $form = "sub copy {\n" .  | 
| 
2284
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    "    my \$self = shift;\n" .  | 
| 
2285
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    "    my \$copy;\n";  | 
| 
2286
 | 
59
 | 
  
100
  
 | 
  
100
  
 | 
 
 | 
 
 | 
94
 | 
     if ( ! (do { my $has_complex_mems;  | 
| 
2287
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 for my $m ( @members ) {  | 
| 
2288
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     if ( $m->isa('Class::Generate::List_Member') || defined $m->base ) {  | 
| 
2289
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			 $has_complex_mems = 1;  | 
| 
2290
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			 last;  | 
| 
2291
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     }  | 
| 
2292
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 }  | 
| 
2293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 $has_complex_mems  | 
| 
2294
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    } || $has_parents) ) {  | 
| 
2295
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
 	$form .= '    $copy = ' . $self->wholesale_copy . ";\n";  | 
| 
2296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2297
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
2298
 | 
39
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
180
 | 
 	$form .= '    $copy = ' . ($has_parents ? '$self->SUPER::copy' : $self->empty_form) . ";\n";  | 
| 
2299
 | 
39
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
248
 | 
 	$form .= $self->size_establishment('$copy')	if $self->can('size_establishment');  | 
| 
2300
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
100
 | 
 	for my $m ( @members ) {  | 
| 
2301
 | 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
200
 | 
 	    my $index = $self->index($m->name);  | 
| 
2302
 | 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
398
 | 
 	    $form .= $m->copy_form('$self->' . $index, '$copy->' . $index);  | 
| 
2303
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2305
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
148
 | 
     $form .= "    bless \$copy, ref \$self;\n" .  | 
| 
2306
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	     "    return \$copy;\n" .  | 
| 
2307
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	     "}\n";  | 
| 
2308
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
332
 | 
     return $form;  | 
| 
2309
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2311
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub equals_form {  | 
| 
2312
 | 
59
 | 
 
 | 
 
 | 
  
59
  
 | 
 
 | 
158
 | 
     my $self = shift;  | 
| 
2313
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
135
 | 
     my ($form, @parents, @members, $existence_test, @local_vars, @key_members);  | 
| 
2314
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
175
 | 
     @parents = $self->parents;  | 
| 
2315
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
160
 | 
     @members = $self->members_values;  | 
| 
2316
 | 
59
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
280
 | 
     if ( @key_members = grep $_->key, @members ) {  | 
| 
2317
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
 	@members = @key_members;  | 
| 
2318
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2319
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
151
 | 
     $existence_test = $self->existence_test;  | 
| 
2320
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
135
 | 
     $form = "sub equals {\n" .  | 
| 
2321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    "    my \$self = shift;\n" .  | 
| 
2322
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    "    my \$o = \$_[0];\n";  | 
| 
2323
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
191
 | 
     for my $m ( @members ) {  | 
| 
2324
 | 
51
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
314
 | 
 	if ( $m->isa('Class::Generate::Hash_Member'), @members ) {  | 
| 
2325
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
137
 | 
 	    push @local_vars, qw($self_value_defined @self_keys);  | 
| 
2326
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
101
 | 
 	    last;  | 
| 
2327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2328
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2329
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
128
 | 
     for my $m ( @members ) {  | 
| 
2330
 | 
51
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
252
 | 
 	if ( $m->isa('Class::Generate::Array_Member'), @members ) {  | 
| 
2331
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
118
 | 
 	    push @local_vars, qw($ub);  | 
| 
2332
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
76
 | 
 	    last;  | 
| 
2333
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2334
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2335
 | 
59
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
158
 | 
     if ( @local_vars ) {  | 
| 
2336
 | 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
227
 | 
 	$form .= '    my (' . join(', ', @local_vars) . ");\n";  | 
| 
2337
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2338
 | 
59
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
173
 | 
     if ( @parents ) {  | 
| 
2339
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
42
 | 
 	$form .= "    return undef unless \$self->SUPER::equals(\$o);\n";  | 
| 
2340
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2341
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
225
 | 
     $form .= join("\n", map $_->equals($self->index($_->name), $existence_test), @members) .  | 
| 
2342
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	"    return 1;\n" .  | 
| 
2343
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	"}\n";  | 
| 
2344
 | 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
312
 | 
     return $form;  | 
| 
2345
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2346
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2347
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub all_members_required {  | 
| 
2348
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my $self = shift;  | 
| 
2349
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     for my $m ( $self->members_keys ) {  | 
| 
2350
 | 
  
0
  
 | 
  
  0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
0
 | 
 	return 0 if ! ($self->private($m) || $self->required($m));  | 
| 
2351
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2352
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return 1;  | 
| 
2353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2354
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub private_member_names {  | 
| 
2355
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     my $self = shift;  | 
| 
2356
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return grep $self->private($_), $self->members_keys;  | 
| 
2357
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2358
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_member_names {  | 
| 
2359
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
132
 | 
     my $self = shift;  | 
| 
2360
 | 
61
 | 
 
 | 
 
 | 
 
 | 
 
 | 
133
 | 
     return grep $self->protected($_), $self->members_keys;  | 
| 
2361
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2362
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub public_member_names {  | 
| 
2363
 | 
244
 | 
 
 | 
 
 | 
  
244
  
 | 
 
 | 
367
 | 
     my $self = shift;  | 
| 
2364
 | 
244
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
476
 | 
     return grep ! ($self->private($_) || $self->protected($_)), $self->members_keys;  | 
| 
2365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2366
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2367
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub class_var {  | 
| 
2368
 | 
72
 | 
 
 | 
 
 | 
  
72
  
 | 
 
 | 
129
 | 
     my $self = shift;  | 
| 
2369
 | 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
261
 | 
     return '$' . $self->{'class_var'};  | 
| 
2370
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2371
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub instance_var {  | 
| 
2372
 | 
940
 | 
 
 | 
 
 | 
  
940
  
 | 
 
 | 
1172
 | 
     my $self = shift;  | 
| 
2373
 | 
940
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2589
 | 
     return '$' . $self->{'instance_var'};  | 
| 
2374
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2375
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub needs_constructor {  | 
| 
2376
 | 
61
 | 
 
 | 
 
 | 
  
61
  
 | 
 
 | 
110
 | 
     my $self = shift;  | 
| 
2377
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return (defined $self->members ||  | 
| 
2378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    ($self->virtual && $self->check_params) ||  | 
| 
2379
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    ! $self->parents ||  | 
| 
2380
 | 
61
 | 
 
 | 
  
 66
  
 | 
 
 | 
 
 | 
161
 | 
 	    do {  | 
| 
2381
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		my $c = $self->constructor;  | 
| 
2382
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		(defined $c->post ||  | 
| 
2383
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 defined $c->assert ||  | 
| 
2384
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 $c->style->isa('Class::Generate::Own'))  | 
| 
2385
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		});  | 
| 
2386
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2387
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2388
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Array_Class;		# A subclass of Class defining  | 
| 
2389
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Array_Class::VERSION = '1.17';  | 
| 
2390
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
3350
 | 
 use strict;					# array-based classes.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
35
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
429
 | 
    | 
| 
2391
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
76
 | 
 use vars qw(@ISA);  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3256
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12522
 | 
    | 
| 
2392
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Class);  | 
| 
2393
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2395
 | 
20
 | 
 
 | 
 
 | 
  
20
  
 | 
 
 | 
36
 | 
     my $class = shift;  | 
| 
2396
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
36
 | 
     my $name = shift;  | 
| 
2397
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
98
 | 
     my %params = @_;  | 
| 
2398
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
93
 | 
     my %super_params = %params;  | 
| 
2399
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
61
 | 
     delete @super_params{qw(base_index member_index)};  | 
| 
2400
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
120
 | 
     my $self = $class->SUPER::new($name, %super_params);  | 
| 
2401
 | 
20
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
92
 | 
     $self->{'base_index'} = defined $params{'base_index'} ? $params{'base_index'} : 1;  | 
| 
2402
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     $self->{'next_index'} = $self->base_index - 1;  | 
| 
2403
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
97
 | 
     return $self;  | 
| 
2404
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base_index {  | 
| 
2407
 | 
20
 | 
 
 | 
 
 | 
  
20
  
 | 
 
 | 
29
 | 
     my $self = shift;  | 
| 
2408
 | 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
48
 | 
     return $self->{'base_index'};  | 
| 
2409
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2410
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base {  | 
| 
2411
 | 
17
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
23
 | 
     my $self = shift;  | 
| 
2412
 | 
17
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
57
 | 
     return '[]' if ! $self->can_assign_all_params;  | 
| 
2413
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my @sorted_members = sort { $$self{member_index}{$a} <=> $$self{member_index}{$b} } $self->members_keys;  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
2414
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my %param_indices  = map(($_, $self->constructor->style->order($_)), $self->members_keys);  | 
| 
2415
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     for ( my $i = 0; $i <= $#sorted_members; $i++ ) {  | 
| 
2416
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	next if $param_indices{$sorted_members[$i]} == $i;  | 
| 
2417
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return '[ undef, ' . join(', ', map { '$_[' . $param_indices{$_} . ']' } @sorted_members) . ' ]';  | 
| 
 
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
    | 
| 
2418
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2419
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return '[ undef, @_ ]';  | 
| 
2420
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2421
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base_type {  | 
| 
2422
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     return 'ARRAY';  | 
| 
2423
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2424
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub members {  | 
| 
2425
 | 
158
 | 
 
 | 
 
 | 
  
158
  
 | 
 
 | 
193
 | 
     my $self = shift;  | 
| 
2426
 | 
158
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
327
 | 
     return $self->SUPER::members(@_) if $#_ != 1;  | 
| 
2427
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
95
 | 
     $self->SUPER::members(@_);  | 
| 
2428
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
41
 | 
     my $overridden_class;  | 
| 
2429
 | 
31
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
67
 | 
     if ( defined ($overridden_class = Class::Generate::Support::class_containing_method($_[0], $self)) ) {  | 
| 
2430
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$self->{'member_index'}{$_[0]} = $overridden_class->{'member_index'}->{$_[0]};  | 
| 
2431
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
2433
 | 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
73
 | 
 	$self->{'member_index'}{$_[0]} = ++$self->{'next_index'};  | 
| 
2434
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2435
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2436
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub index {  | 
| 
2437
 | 
122
 | 
 
 | 
 
 | 
  
122
  
 | 
 
 | 
137
 | 
     my $self = shift;  | 
| 
2438
 | 
122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
287
 | 
     return '[' . $self->{'member_index'}{$_[0]} . ']';  | 
| 
2439
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2440
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub last {  | 
| 
2441
 | 
47
 | 
 
 | 
 
 | 
  
47
  
 | 
 
 | 
68
 | 
     my $self = shift;  | 
| 
2442
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
134
 | 
     return $self->{'next_index'};  | 
| 
2443
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2444
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub existence_test {  | 
| 
2445
 | 
47
 | 
 
 | 
 
 | 
  
47
  
 | 
 
 | 
63
 | 
     my $self = shift;  | 
| 
2446
 | 
47
 | 
 
 | 
 
 | 
 
 | 
 
 | 
79
 | 
     return 'defined';  | 
| 
2447
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2448
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2449
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub size_establishment {  | 
| 
2450
 | 
26
 | 
 
 | 
 
 | 
  
26
  
 | 
 
 | 
45
 | 
     my $self = shift;  | 
| 
2451
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
44
 | 
     my $instance_var = $_[0];  | 
| 
2452
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
62
 | 
     return '    $#' . $instance_var . ' = ' . $self->last . ";\n";  | 
| 
2453
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2454
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub can_assign_all_params {  | 
| 
2455
 | 
51
 | 
 
 | 
 
 | 
  
51
  
 | 
 
 | 
63
 | 
     my $self = shift;  | 
| 
2456
 | 
51
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
71
 | 
     return ! $self->check_params &&  | 
| 
2457
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   $self->all_members_required &&  | 
| 
2458
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   $self->constructor->style->isa('Class::Generate::Positional') &&  | 
| 
2459
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   ! defined $self->parents;  | 
| 
2460
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2461
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub undef_form {  | 
| 
2462
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
50
 | 
     return 'undef';  | 
| 
2463
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2464
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub wholesale_copy {  | 
| 
2465
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
23
 | 
     return '[ @$self ]';  | 
| 
2466
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2467
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub empty_form {  | 
| 
2468
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
 
 | 
24
 | 
     return '[]';  | 
| 
2469
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2470
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_members_info_index {  | 
| 
2471
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
     return q|[0]|;  | 
| 
2472
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2473
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2474
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Hash_Class;		# A subclass of Class defining  | 
| 
2475
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Hash_Class::VERSION = '1.17';  | 
| 
2476
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
1559
 | 
 use vars qw(@ISA);				# hash-based classes.  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1547
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4524
 | 
    | 
| 
2477
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Class);  | 
| 
2478
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2479
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub index {  | 
| 
2480
 | 
438
 | 
 
 | 
 
 | 
  
438
  
 | 
 
 | 
617
 | 
     my $self = shift;  | 
| 
2481
 | 
438
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
791
 | 
     return "{'" . ($self->private($_[0]) ? '*' . $self->name . '_' . $_[0] : $_[0]) . "'}";  | 
| 
2482
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2483
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base {  | 
| 
2484
 | 
29
 | 
 
 | 
 
 | 
  
29
  
 | 
 
 | 
50
 | 
     my $self = shift;  | 
| 
2485
 | 
29
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
71
 | 
     return '{}' if ! $self->can_assign_all_params;  | 
| 
2486
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $style = $self->constructor->style;  | 
| 
2487
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return '{ @_ }' if $style->isa('Class::Generate::Key_Value');  | 
| 
2488
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my %order = $style->order;  | 
| 
2489
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     my $form = '{ ' . join(', ', map("$_ => \$_[$order{$_}]", keys %order));  | 
| 
2490
 | 
  
0
  
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     if ( $style->isa('Class::Generate::Mix') ) {  | 
| 
2491
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	$form .= ', @_[' . $style->pcount . '..$#_]';  | 
| 
2492
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2493
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     return $form . ' }';  | 
| 
2494
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2495
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub base_type {  | 
| 
2496
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     return 'HASH';  | 
| 
2497
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2498
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub existence_test {  | 
| 
2499
 | 
144
 | 
 
 | 
 
 | 
  
144
  
 | 
 
 | 
335
 | 
     return 'exists';  | 
| 
2500
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2501
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub can_assign_all_params {  | 
| 
2502
 | 
109
 | 
 
 | 
 
 | 
  
109
  
 | 
 
 | 
158
 | 
     my $self = shift;  | 
| 
2503
 | 
109
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
196
 | 
     return ! $self->check_params &&  | 
| 
2504
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   $self->all_members_required &&  | 
| 
2505
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   ! $self->constructor->style->isa('Class::Generate::Own') &&  | 
| 
2506
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   ! defined $self->parents;  | 
| 
2507
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2508
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub undef_form {  | 
| 
2509
 | 
73
 | 
 
 | 
 
 | 
  
73
  
 | 
 
 | 
233
 | 
     return 'delete';  | 
| 
2510
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2511
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub wholesale_copy {  | 
| 
2512
 | 
12
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
50
 | 
     return '{ %$self }';  | 
| 
2513
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2514
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub empty_form {  | 
| 
2515
 | 
17
 | 
 
 | 
 
 | 
  
17
  
 | 
 
 | 
59
 | 
     return '{}';  | 
| 
2516
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2517
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub protected_members_info_index {  | 
| 
2518
 | 
9
 | 
 
 | 
 
 | 
  
9
  
 | 
 
 | 
31
 | 
     return q|{'*protected*'}|;  | 
| 
2519
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2520
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2521
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Param_Style;		# A virtual class encompassing  | 
| 
2522
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Param_Style::VERSION = '1.17';  | 
| 
2523
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
93
 | 
 use strict;					# parameter-passing styles for  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3532
 | 
    | 
| 
2524
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2525
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2526
 | 
71
 | 
 
 | 
 
 | 
  
71
  
 | 
 
 | 
138
 | 
     my $class = shift;  | 
| 
2527
 | 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
192
 | 
     return bless {}, $class;  | 
| 
2528
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2529
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub keyed_param_names {  | 
| 
2530
 | 
  
0
  
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     return ();  | 
| 
2531
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2532
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2533
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub delete_self_members_form {  | 
| 
2534
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
3
 | 
     shift;  | 
| 
2535
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     my @self_members = @_;  | 
| 
2536
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     if ( $#self_members == 0 ) {  | 
| 
 
 | 
 
 | 
  
  0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2537
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
 	return q|delete $super_params{'| . $self_members[0] . q|'};|;  | 
| 
2538
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2539
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     elsif ( $#self_members > 0 ) {  | 
| 
2540
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
 	return q|delete @super_params{qw(| . join(' ', @self_members) . q|)};|;  | 
| 
2541
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2542
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2543
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2544
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub odd_params_check_form {  | 
| 
2545
 | 
42
 | 
 
 | 
 
 | 
  
42
  
 | 
 
 | 
74
 | 
     my $self = shift;  | 
| 
2546
 | 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
89
 | 
     my ($class, $constructor) = @_;  | 
| 
2547
 | 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
190
 | 
     return q|    croak '| . $constructor->name_form($class) . q|Odd number of parameters' if | .  | 
| 
2548
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			$self->odd_params_test($class) . ";\n";  | 
| 
2549
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2550
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2551
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub my_decl_form {  | 
| 
2552
 | 
11
 | 
 
 | 
 
 | 
  
11
  
 | 
 
 | 
30
 | 
     my $self = shift;  | 
| 
2553
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
     my $class = $_[0];  | 
| 
2554
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
     return '    my ' . $class->instance_var . ' = ' . $class->class_var . '->SUPER::new';  | 
| 
2555
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2556
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2557
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Key_Value;		# The key/value parameter-  | 
| 
2558
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Key_Value::VERSION = '1.17';  | 
| 
2559
 | 
15
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
96
 | 
 use strict;					# passing style.  It adds  | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
40
 | 
    | 
| 
 
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2611
 | 
    | 
| 
2560
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
72
 | 
 use vars qw(@ISA);				# the name of the variable  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
29
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6291
 | 
    | 
| 
2561
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Param_Style);	# that holds the parameters.  | 
| 
2562
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2563
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2564
 | 
46
 | 
 
 | 
 
 | 
  
46
  
 | 
 
 | 
91
 | 
     my $class = shift;  | 
| 
2565
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
178
 | 
     my $self = $class->SUPER::new;  | 
| 
2566
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
141
 | 
     $self->{'holder'} = $_[0];  | 
| 
2567
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
190
 | 
     $self->{'keyed_param_names'} = [@_[1..$#_]];  | 
| 
2568
 | 
46
 | 
 
 | 
 
 | 
 
 | 
 
 | 
237
 | 
     return $self;  | 
| 
2569
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2570
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2571
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub holder {  | 
| 
2572
 | 
176
 | 
 
 | 
 
 | 
  
176
  
 | 
 
 | 
205
 | 
     my $self = shift;  | 
| 
2573
 | 
176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
427
 | 
     return $self->{'holder'};  | 
| 
2574
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2575
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub ref {  | 
| 
2576
 | 
176
 | 
 
 | 
 
 | 
  
176
  
 | 
 
 | 
202
 | 
     my $self = shift;  | 
| 
2577
 | 
176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
334
 | 
     return '$' . $self->holder . "{'" . $_[0] . "'}";  | 
| 
2578
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2579
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub keyed_param_names {  | 
| 
2580
 | 
118
 | 
 
 | 
 
 | 
  
118
  
 | 
 
 | 
170
 | 
     my $self = shift;  | 
| 
2581
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
138
 | 
     return @{$self->{'keyed_param_names'}};  | 
| 
 
 | 
118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
304
 | 
    | 
| 
2582
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2583
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub existence_test {  | 
| 
2584
 | 
176
 | 
 
 | 
 
 | 
  
176
  
 | 
 
 | 
338
 | 
     return 'exists';  | 
| 
2585
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2586
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub init_form {  | 
| 
2587
 | 
38
 | 
 
 | 
 
 | 
  
38
  
 | 
 
 | 
81
 | 
     my $self = shift;  | 
| 
2588
 | 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
117
 | 
     my ($class, $constructor) = @_;  | 
| 
2589
 | 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
66
 | 
     my ($form, $cn);  | 
| 
2590
 | 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
58
 | 
     $form = '';  | 
| 
2591
 | 
38
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     $form .= $self->odd_params_check_form($class, $constructor) if $class->check_params;  | 
| 
2592
 | 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
84
 | 
     $form .= "    my \%params = \@_;\n";  | 
| 
2593
 | 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
     return $form;  | 
| 
2594
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2595
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub odd_params_test {  | 
| 
2596
 | 
38
 | 
 
 | 
 
 | 
  
38
  
 | 
 
 | 
120
 | 
     return '$#_%2 == 0';  | 
| 
2597
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2598
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub self_from_super_form {  | 
| 
2599
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
4
 | 
     my $self = shift;  | 
| 
2600
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     my $class = $_[0];  | 
| 
2601
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     return '    my %super_params = %params;' . "\n" .  | 
| 
2602
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   '    ' . $self->delete_self_members_form($class->public_member_names) . "\n" .  | 
| 
2603
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   $self->my_decl_form($class) . "(\%super_params);\n";  | 
| 
2604
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2605
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub params_check_form {  | 
| 
2606
 | 
39
 | 
 
 | 
 
 | 
  
39
  
 | 
 
 | 
68
 | 
     my $self = shift;  | 
| 
2607
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
89
 | 
     my ($class, $constructor) = @_;  | 
| 
2608
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
74
 | 
     my ($cn, @valid_names, $form);  | 
| 
2609
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
106
 | 
     @valid_names = $self->keyed_param_names;  | 
| 
2610
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
107
 | 
     $cn = $constructor->name_form($class);  | 
| 
2611
 | 
39
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
111
 | 
     if ( ! @valid_names ) {  | 
| 
2612
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
 	$form = "    croak '$cn', join(', ', keys %params), ': Not a member' if keys \%params;\n";  | 
| 
2613
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2614
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     else {  | 
| 
2615
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
 	$form =	"    {\n";  | 
| 
2616
 | 
34
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
88
 | 
 	if ( $#valid_names == 0 ) {  | 
| 
2617
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
 	    $form .= "\tmy \@unknown_params = grep \$_ ne '$valid_names[0]', keys \%params;\n";  | 
| 
2618
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2619
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	else {  | 
| 
2620
 | 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
194
 | 
 	    $form .= "\tmy %valid_param = (" . join(', ', map("'$_' => 1", @valid_names)) . ");\n" .  | 
| 
2621
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		     "\tmy \@unknown_params = grep ! defined \$valid_param{\$_}, keys \%params;\n";  | 
| 
2622
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
2623
 | 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
140
 | 
 	$form .= "\tcroak '$cn', join(', ', \@unknown_params), ': Not a member' if \@unknown_params;\n" .  | 
| 
2624
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 "    }\n";  | 
| 
2625
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2626
 | 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
104
 | 
     return $form;  | 
| 
2627
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2628
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2629
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Positional;		# The positional parameter-  | 
| 
2630
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Positional::VERSION = '1.17';  | 
| 
2631
 | 
14
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
95
 | 
 use strict;					# passing style.  It adds  | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
33
 | 
    | 
| 
 
 | 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
397
 | 
    | 
| 
2632
 | 
13
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
71
 | 
 use vars qw(@ISA);				# an ordering of parameters.  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5298
 | 
    | 
| 
2633
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Param_Style);  | 
| 
2634
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2635
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2636
 | 
15
 | 
 
 | 
 
 | 
  
15
  
 | 
 
 | 
36
 | 
     my $class = shift;  | 
| 
2637
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
104
 | 
     my $self = $class->SUPER::new;  | 
| 
2638
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
71
 | 
     for ( my $i = 0; $i <= $#_; $i++ ) {  | 
| 
2639
 | 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
112
 | 
 	$self->{'order'}->{$_[$i]} = $i;  | 
| 
2640
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2641
 | 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
149
 | 
     return $self;  | 
| 
2642
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2643
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub order {  | 
| 
2644
 | 
27
 | 
 
 | 
 
 | 
  
27
  
 | 
 
 | 
53
 | 
     my $self = shift;  | 
| 
2645
 | 
27
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
144
 | 
     return exists $self->{'order'} ? %{$self->{'order'}} : () if $#_ == -1;  | 
| 
 
 | 
12
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
77
 | 
    | 
| 
2646
 | 
12
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
65
 | 
     return exists $self->{'order'} ? $self->{'order'}->{$_[0]} : undef if $#_ == 0;  | 
| 
 
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2647
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'order'}->{$_[0]} = $_[1];  | 
| 
2648
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2649
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub ref {  | 
| 
2650
 | 
28
 | 
 
 | 
 
 | 
  
28
  
 | 
 
 | 
55
 | 
     my $self = shift;  | 
| 
2651
 | 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
109
 | 
     return '$_[' . $self->{'order'}->{$_[0]} . ']';  | 
| 
2652
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2653
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub existence_test {  | 
| 
2654
 | 
28
 | 
 
 | 
 
 | 
  
28
  
 | 
 
 | 
91
 | 
     return 'defined';  | 
| 
2655
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2656
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub self_from_super_form {  | 
| 
2657
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
9
 | 
     my $self = shift;  | 
| 
2658
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     my $class = $_[0];  | 
| 
2659
 | 
4
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
13
 | 
     my $lb = scalar($class->public_member_names) || 0;  | 
| 
2660
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
59
 | 
     return '    my @super_params = @_[' . $lb . '..$#_];' . "\n" .  | 
| 
2661
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	   $self->my_decl_form($class) . "(\@super_params);\n";  | 
| 
2662
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2663
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub params_check_form {  | 
| 
2664
 | 
6
 | 
 
 | 
 
 | 
  
6
  
 | 
 
 | 
11
 | 
     my $self = shift;  | 
| 
2665
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
18
 | 
     my ($class, $constructor) = @_;  | 
| 
2666
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
53
 | 
     my $cn = $constructor->name_form($class);  | 
| 
2667
 | 
6
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
16
 | 
     my $max_params = scalar($class->public_member_names) || 0;  | 
| 
2668
 | 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
50
 | 
     return qq|    croak '$cn| . qq|Only $max_params parameter(s) allowed (', \$#_+1, ' given)'| .  | 
| 
2669
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		      " unless \$#_ < $max_params;\n";  | 
| 
2670
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2671
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2672
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Mix;			# The mix parameter-passing  | 
| 
2673
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Mix::VERSION = '1.17';  | 
| 
2674
 | 
13
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
79
 | 
 use strict;					# style.  It combines key/value  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
332
 | 
    | 
| 
2675
 | 
13
 | 
 
 | 
 
 | 
  
14
  
 | 
 
 | 
60
 | 
 use vars qw(@ISA);				# and positional.  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10643
 | 
    | 
| 
2676
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Param_Style);  | 
| 
2677
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2678
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2679
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
13
 | 
     my $class = shift;  | 
| 
2680
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
     my $self = $class->SUPER::new;  | 
| 
2681
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     $self->{'pp'} = Class::Generate::Positional->new(@{$_[1]});  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
    | 
| 
2682
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
     $self->{'kv'} = Class::Generate::Key_Value->new($_[0], @_[2..$#_]);  | 
| 
2683
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
     $self->{'pnames'} = { map( ($_ => 1), @{$_[1]}) };  | 
| 
 
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
    | 
| 
2684
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
     return $self;  | 
| 
2685
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2686
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2687
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub keyed_param_names {  | 
| 
2688
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
13
 | 
     my $self = shift;  | 
| 
2689
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     return $self->{'kv'}->keyed_param_names;  | 
| 
2690
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2691
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub order {  | 
| 
2692
 | 
7
 | 
 
 | 
 
 | 
  
7
  
 | 
 
 | 
19
 | 
     my $self = shift;  | 
| 
2693
 | 
7
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
54
 | 
     return $self->{'pp'}->order(@_) if $#_ <= 0;  | 
| 
2694
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'pp'}->order(@_);  | 
| 
2695
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
     $self->{'pnames'}{$_[0]} = 1;  | 
| 
2696
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2697
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub ref {  | 
| 
2698
 | 
20
 | 
 
 | 
 
 | 
  
20
  
 | 
 
 | 
36
 | 
     my $self = shift;  | 
| 
2699
 | 
20
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
90
 | 
     return $self->{'pnames'}->{$_[0]} ? $self->{'pp'}->ref($_[0]) : $self->{'kv'}->ref($_[0]);  | 
| 
2700
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2701
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub existence_test {  | 
| 
2702
 | 
20
 | 
 
 | 
 
 | 
  
20
  
 | 
 
 | 
37
 | 
     my $self = shift;  | 
| 
2703
 | 
20
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
74
 | 
     return $self->{'pnames'}->{$_[0]} ? $self->{'pp'}->existence_test : $self->{'kv'}->existence_test;  | 
| 
2704
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2705
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub pcount {  | 
| 
2706
 | 
22
 | 
 
 | 
 
 | 
  
22
  
 | 
 
 | 
35
 | 
     my $self = shift;  | 
| 
2707
 | 
22
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
52
 | 
     return exists $self->{'pnames'} ? scalar(keys %{$self->{'pnames'}}) : 0;  | 
| 
 
 | 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
90
 | 
    | 
| 
2708
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2709
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub init_form {  | 
| 
2710
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
115
 | 
     my $self = shift;  | 
| 
2711
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
16
 | 
     my ($class, $constructor) = @_;  | 
| 
2712
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
25
 | 
     my ($form, $m) = ('', $self->max_possible_params($class));  | 
| 
2713
 | 
4
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
16
 | 
     $form .= $self->odd_params_check_form($class, $constructor, $self->pcount, $m) if $class->check_params;  | 
| 
2714
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     $form .= '    my %params = ' . $self->kv_params_form($m) . ";\n";  | 
| 
2715
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
17
 | 
     return $form;  | 
| 
2716
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2717
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub odd_params_test {  | 
| 
2718
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
11
 | 
     my $self = shift;  | 
| 
2719
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     my $class = $_[0];  | 
| 
2720
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
     my ($p, $test);  | 
| 
2721
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
     $p = $self->pcount;  | 
| 
2722
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     $test = '$#_>=' . $p;  | 
| 
2723
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
15
 | 
     $test .= ' && $#_<=' . $self->max_possible_params($class) if $class->parents;  | 
| 
2724
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
25
 | 
     $test .= ' && $#_%2 == ' . ($p%2 == 0 ? '0' : '1');  | 
| 
2725
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
     return $test;  | 
| 
2726
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2727
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub self_from_super_form {  | 
| 
2728
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
6
 | 
     my $self = shift;  | 
| 
2729
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     my $class = $_[0];  | 
| 
2730
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     my @positional_members = keys %{$self->{'pnames'}};  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
    | 
| 
2731
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
22
 | 
     my %self_members = map { ($_ => 1) } $class->public_member_names;  | 
| 
 
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
11
 | 
    | 
| 
2732
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     delete @self_members{@positional_members};  | 
| 
2733
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
     my $m = $self->max_possible_params($class);  | 
| 
2734
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
15
 | 
     return $self->my_decl_form($class) . '(@_[' . ($m+1) . '..$#_]);' . "\n";  | 
| 
2735
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2736
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub max_possible_params {  | 
| 
2737
 | 
10
 | 
 
 | 
 
 | 
  
10
  
 | 
 
 | 
77
 | 
     my $self = shift;  | 
| 
2738
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
     my $class = $_[0];  | 
| 
2739
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
43
 | 
     my $p = $self->pcount;  | 
| 
2740
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
30
 | 
     return $p + 2*(scalar($class->public_member_names) - $p) - 1;  | 
| 
2741
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2742
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub params_check_form {  | 
| 
2743
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
6
 | 
     my $self = shift;  | 
| 
2744
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
     my ($class, $constructor) = @_;  | 
| 
2745
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
     my ($form, $cn);  | 
| 
2746
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     $cn = $constructor->name_form($class);  | 
| 
2747
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
     $form = $self->{'kv'}->params_check_form(@_);  | 
| 
2748
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     my $max_params = $self->max_possible_params($class) + 1;  | 
| 
2749
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     $form .= qq|    croak '$cn| . qq|Only $max_params parameter(s) allowed (', \$#_+1, ' given)'| .  | 
| 
2750
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			" unless \$#_ < $max_params;\n";  | 
| 
2751
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     return $form;  | 
| 
2752
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2753
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2754
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub kv_params_form {  | 
| 
2755
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
11
 | 
     my $self = shift;  | 
| 
2756
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     my $max_params = $_[0];  | 
| 
2757
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     return '@_[' . $self->pcount . "..(\$#_ < $max_params ? \$#_ : $max_params)]";  | 
| 
2758
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2759
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2760
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Class::Generate::Own;			# The "own" parameter-passing  | 
| 
2761
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $Class::Generate::Own::VERSION = '1.17';  | 
| 
2762
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
 
 | 
86
 | 
 use strict;					# style.  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
26
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
315
 | 
    | 
| 
2763
 | 
13
 | 
 
 | 
 
 | 
  
13
  
 | 
 
 | 
76
 | 
 use vars qw(@ISA);  | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6561
 | 
    | 
| 
2764
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 @ISA = qw(Class::Generate::Param_Style);  | 
| 
2765
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2766
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
2767
 | 
5
 | 
 
 | 
 
 | 
  
5
  
 | 
 
 | 
9
 | 
     my $class = shift;  | 
| 
2768
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
23
 | 
     my $self = $class->SUPER::new;  | 
| 
2769
 | 
5
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     $self->{'super_values'} = $_[0] if defined $_[0];  | 
| 
2770
 | 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
     return $self;  | 
| 
2771
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2772
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2773
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub super_values {  | 
| 
2774
 | 
9
 | 
 
 | 
 
 | 
  
9
  
 | 
 
 | 
14
 | 
     my $self = shift;  | 
| 
2775
 | 
9
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     return defined $self->{'super_values'} ? @{$self->{'super_values'}} : ();  | 
| 
 
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
38
 | 
    | 
| 
2776
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2777
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2778
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub can_assign_all_params {  | 
| 
2779
 | 
0
 | 
 
 | 
 
 | 
  
0
  
 | 
 
 | 
0
 | 
     return 0;  | 
| 
2780
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2781
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2782
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub self_from_super_form {  | 
| 
2783
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
5
 | 
     my $self = shift;  | 
| 
2784
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
     my $class = $_[0];  | 
| 
2785
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
     my ($form, @sv);  | 
| 
2786
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
19
 | 
     $form = $self->my_decl_form($class);  | 
| 
2787
 | 
4
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     if ( @sv = $self->super_values ) {  | 
| 
2788
 | 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
14
 | 
 	$form .= '(' . join(',', @sv) . ')';  | 
| 
2789
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
2790
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
     $form .= ";\n";  | 
| 
2791
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
     return $form;  | 
| 
2792
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
2793
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2794
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
2795
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2796
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =pod  | 
| 
2797
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2798
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =encoding UTF-8  | 
| 
2799
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2800
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 NAME  | 
| 
2801
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2802
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Class::Generate - Generate Perl class hierarchies  | 
| 
2803
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2804
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 VERSION  | 
| 
2805
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2806
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 version 1.17  | 
| 
2807
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2808
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 SYNOPSIS  | 
| 
2809
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2810
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  use Class::Generate qw(class subclass delete_class);  | 
| 
2811
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2812
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # Declare class Class_Name, with the following types of members:  | 
| 
2813
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  class  | 
| 
2814
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
      Class_Name => [  | 
| 
2815
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
          s => '$',			# scalar  | 
| 
2816
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	 a => '@',			# array  | 
| 
2817
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	 h => '%',			# hash  | 
| 
2818
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	 c => 'Class',			# Class  | 
| 
2819
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	 c_a => '@Class',		# array of Class  | 
| 
2820
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	 c_h => '%Class',		# hash of Class  | 
| 
2821
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
          '&m' => 'body',		# method  | 
| 
2822
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
      ];  | 
| 
2823
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2824
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # Allocate an instance of class_name, with members initialized to the  | 
| 
2825
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  # given values (pass arrays and hashes using references).  | 
| 
2826
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj = Class_Name->new ( s => scalar,  | 
| 
2827
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  a => [ values ],  | 
| 
2828
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  h => { key1 => v1, ... },  | 
| 
2829
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  c => Class->new,  | 
| 
2830
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  c_a => [ Class->new, ... ],  | 
| 
2831
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			  c_h => [ key1 => Class->new, ... ] );  | 
| 
2832
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2833
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# Scalar type accessor:  | 
| 
2834
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->s($value);			# Assign $value to member s.  | 
| 
2835
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $member_value = $obj->s;		# Access member's value.  | 
| 
2836
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2837
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# (Class) Array type accessor:  | 
| 
2838
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->a([value1, value2, ...]);	# Assign whole array to member.  | 
| 
2839
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->a(2, $value);			# Assign $value to array member 2.  | 
| 
2840
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->add_a($value);			# Append $value to end of array.  | 
| 
2841
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  @a = $obj->a;				# Access whole array.  | 
| 
2842
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $ary_member_value = $obj->a(2);	# Access array member 2.  | 
| 
2843
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $s = $obj->a_size;			# Return size of array.  | 
| 
2844
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $value = $obj->last_a;			# Return last element of array.  | 
| 
2845
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2846
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		# (Class) Hash type accessor:  | 
| 
2847
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->h({ k_1=>v1, ..., k_n=>v_n })	# Assign whole hash to member.  | 
| 
2848
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->h($key, $value);			# Assign $value to hash member $key.  | 
| 
2849
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  %hash = $obj->h;			# Access whole hash.  | 
| 
2850
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $hash_member_value = $obj->h($key);	# Access hash member value $key.  | 
| 
2851
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $obj->delete_h($key);			# Delete slot occupied by $key.  | 
| 
2852
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  @keys = $obj->h_keys;			# Access keys of member h.  | 
| 
2853
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  @values = $obj->h_values;		# Access values of member h.  | 
| 
2854
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2855
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  $another = $obj->copy;			# Copy an object.  | 
| 
2856
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  if ( $obj->equals($another) ) { ... }	# Test equality.  | 
| 
2857
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2858
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
  subclass s  => [  ], -parent => 'class_name';  | 
| 
2859
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2860
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 DESCRIPTION  | 
| 
2861
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2862
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C package exports functions that take as arguments  | 
| 
2863
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a class specification and create from these specifications a Perl 5 class.  | 
| 
2864
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The specification language allows many object-oriented constructs:  | 
| 
2865
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 typed members, inheritance, private members, required members,  | 
| 
2866
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 default values, object methods, class methods, class variables, and more.  | 
| 
2867
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2868
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 CPAN contains similar packages.  | 
| 
2869
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Why another?  | 
| 
2870
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Because object-oriented programming,  | 
| 
2871
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 especially in a dynamic language like Perl,  | 
| 
2872
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 is a complicated endeavor.  | 
| 
2873
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I wanted a package that would work very hard to catch the errors you  | 
| 
2874
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (well, I anyway) commonly make.  | 
| 
2875
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I wanted a package that could help me  | 
| 
2876
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 enforce the contract of object-oriented programming.  | 
| 
2877
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 I also wanted it to get out of my way when I asked.  | 
| 
2878
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2879
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 VERSION  | 
| 
2880
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2881
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 version 1.17  | 
| 
2882
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2883
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 THE CLASS FUNCTION  | 
| 
2884
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2885
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You create classes by invoking the C function.  | 
| 
2886
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C function has two forms:  | 
| 
2887
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2888
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Class_Name => [ specification ];	# Objects are array-based.  | 
| 
2889
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Class_Name => { specification };	# Objects are hash-based.  | 
| 
2890
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2891
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The result is a Perl 5 class, in a package C.  | 
| 
2892
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This package must not exist when C is invoked.  | 
| 
2893
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2894
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 An array-based object is faster and smaller.  | 
| 
2895
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A hash-based object is more flexible.  | 
| 
2896
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Subsequent sections explain where and why flexibility matters.  | 
| 
2897
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2898
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The specification consists of zero or more name/value pairs.  | 
| 
2899
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Each pair declares one member of the class,  | 
| 
2900
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 with the given name, and with attributes specified by the given value.  | 
| 
2901
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2902
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 MEMBER TYPES  | 
| 
2903
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2904
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 In the simplest name/value form,  | 
| 
2905
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the value you give is a string that defines the member's type.  | 
| 
2906
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A C<'$'> denotes a scalar member type.  | 
| 
2907
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A C<'@'> denotes an array type.  | 
| 
2908
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A C<'%'> denotes a hash type.  | 
| 
2909
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Thus:  | 
| 
2910
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2911
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => '$', age => '$' ];  | 
| 
2912
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2913
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 creates a class named C with two scalar members,  | 
| 
2914
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C and C.  | 
| 
2915
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2916
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the type is followed by an identifier,  | 
| 
2917
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the identifier is assumed to be a class name,  | 
| 
2918
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and the member is restricted to a blessed reference of the class  | 
| 
2919
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (or one of its subclasses),  | 
| 
2920
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 an array whose elements are blessed references of the class,  | 
| 
2921
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 or a hash whose keys are strings  | 
| 
2922
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and whose values are blessed references of the class.  | 
| 
2923
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For scalars, the C<$> may be omitted;  | 
| 
2924
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 i.e., C and C<$Class_Name> are equivalent.  | 
| 
2925
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The class need not be declared using the C package.  | 
| 
2926
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2927
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 CREATING INSTANCES  | 
| 
2928
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2929
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Each class that you generate has a constructor named C.  | 
| 
2930
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Invoking the constructor creates an instance of the class.  | 
| 
2931
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You may provide C with parameters to set the values of members:  | 
| 
2932
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2933
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => '$', age => '$' ];  | 
| 
2934
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new;			# Neither name nor age is defined.  | 
| 
2935
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $q = Person->new( name => 'Jim' );	# Only name is defined.  | 
| 
2936
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $r = Person->new( age => 32 );	# Only age is defined.  | 
| 
2937
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2938
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 ACCESSOR METHODS  | 
| 
2939
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2940
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A class has a standard set of accessor methods for each member you specify.  | 
| 
2941
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The accessor methods depend on a member's type.  | 
| 
2942
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2943
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Scalar (name => '$', name => 'Class_Name', or name => '$Class_Name')  | 
| 
2944
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2945
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The member is a scalar.  | 
| 
2946
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The member has a single method C.  | 
| 
2947
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If called with no arguments, it returns the member's current value.  | 
| 
2948
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If called with arguments, it sets the member to the first value:  | 
| 
2949
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2950
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new;  | 
| 
2951
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->age(32);		# Sets age member to 32.  | 
| 
2952
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->age;		# Prints 32.  | 
| 
2953
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2954
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C form is used, the member must be a reference blessed  | 
| 
2955
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 to the named class or to one of its subclasses.  | 
| 
2956
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The method will C (see L) if the argument is not  | 
| 
2957
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a blessed reference to an instance of C or one of its subclasses.  | 
| 
2958
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2959
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [  | 
| 
2960
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	name => '$',  | 
| 
2961
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	spouse => 'Person'	# Works, even though Person  | 
| 
2962
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];				# isn't yet defined.  | 
| 
2963
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new(name => 'Simon Bar-Sinister');  | 
| 
2964
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $q = Person->new(name => 'Polly Purebred');  | 
| 
2965
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $r = Person->new(name => 'Underdog');  | 
| 
2966
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $r->spouse($q);				# Underdog marries Polly.  | 
| 
2967
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $r->spouse->name;			# Prints 'Polly Purebred'.  | 
| 
2968
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print "He's married" if defined $p->spouse;	# Prints nothing.  | 
| 
2969
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->spouse('Natasha Fatale');		# Croaks.  | 
| 
2970
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2971
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Array (name => '@' or name => '@Class')  | 
| 
2972
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2973
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The member is an array.  | 
| 
2974
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C<@Class> form is used, all members of the array must be  | 
| 
2975
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 a blessed reference to C or one of its subclasses.  | 
| 
2976
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 An array member has four associated methods:  | 
| 
2977
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2978
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
2979
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2980
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
2981
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2982
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With no argument, C returns the member's whole array.  | 
| 
2983
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2984
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With one argument, C's behavior depends on  | 
| 
2985
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 whether the argument is an array reference.  | 
| 
2986
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If it is not, then the argument must be an integer I,  | 
| 
2987
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and C returns element I of the member.  | 
| 
2988
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If no such element exists, C returns C.  | 
| 
2989
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the argument is an array reference,  | 
| 
2990
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it is cast into an array and assigned to the member.  | 
| 
2991
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2992
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With two arguments, the first argument must be an integer I.  | 
| 
2993
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The second argument is assigned to element I of the member.  | 
| 
2994
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2995
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
2996
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2997
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This method appends its arguments to the member's array.  | 
| 
2998
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
2999
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3000
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3001
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This method returns the index of the last element in the array.  | 
| 
3002
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3003
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3004
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3005
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This method returns the last element of C,  | 
| 
3006
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 or C if C has no elements.  | 
| 
3007
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It's a shorthand for C<$o-Earray_mem($o-Earray_mem_size)>.  | 
| 
3008
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3009
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
3010
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3011
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For example:  | 
| 
3012
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3013
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => '$', kids => '@Person' ];  | 
| 
3014
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new;  | 
| 
3015
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->add_kids(Person->new(name => 'Heckle'),  | 
| 
3016
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 Person->new(name => 'Jeckle'));  | 
| 
3017
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->kids_size;	# Prints 1.  | 
| 
3018
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->kids([Person->new(name => 'Bugs Bunny'),  | 
| 
3019
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	      Person->new(name => 'Daffy Duck')]);  | 
| 
3020
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->add_kids(Person->new(name => 'Yosemite Sam'),  | 
| 
3021
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 Person->new(name => 'Porky Pig'));  | 
| 
3022
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->kids_size;	# Prints 3.  | 
| 
3023
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->kids(2, Person->new(name => 'Elmer Fudd'));  | 
| 
3024
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->kids(2)->name;	# Prints 'Elmer Fudd'.  | 
| 
3025
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     @kids = $p->kids;		# Get all the kids.  | 
| 
3026
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->kids($p->kids_size)->name; # Prints 'Porky Pig'.  | 
| 
3027
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->last_kids->name;	   # So does this.  | 
| 
3028
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3029
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Hash (name => '%' or name => '%Class')  | 
| 
3030
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3031
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The member is a hash.  | 
| 
3032
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C<%Class> form is used, all values in the hash  | 
| 
3033
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 must be a blessed reference to C or one of its subclasses.  | 
| 
3034
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A hash member has four associated methods:  | 
| 
3035
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3036
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
3037
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3038
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3039
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3040
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With no arguments, C returns the member's whole hash.  | 
| 
3041
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3042
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With one argument that is a hash reference,  | 
| 
3043
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member's value becomes the key/value pairs in that reference.  | 
| 
3044
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With one argument that is a string,  | 
| 
3045
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the element of the hash keyed by that string is returned.  | 
| 
3046
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If no such element exists, C returns C.  | 
| 
3047
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3048
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 With two arguments, the second argument is assigned to the hash,  | 
| 
3049
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 keyed by the string representation of the first argument.  | 
| 
3050
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3051
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3052
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3053
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C method returns all keys associated with the member.  | 
| 
3054
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3055
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3056
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3057
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C method returns all values associated with the member.  | 
| 
3058
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3059
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item C  | 
| 
3060
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3061
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C method takes one or more arguments.  | 
| 
3062
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It deletes from C's hash all elements matching the arguments.  | 
| 
3063
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3064
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
3065
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3066
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For example:  | 
| 
3067
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3068
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => '$', kids => '%Kid_Info' ];  | 
| 
3069
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Kid_Info => [  | 
| 
3070
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	grade  => '$',  | 
| 
3071
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	skills => '@'  | 
| 
3072
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
3073
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $f = new Person(  | 
| 
3074
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	name => 'Fred Flintstone',  | 
| 
3075
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	kids => { Pebbles => new Kid_Info(grade => 1,  | 
| 
3076
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 				          skills => ['Programs VCR']) }  | 
| 
3077
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     );  | 
| 
3078
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $f->kids('Pebbles')->grade;	# Prints 1.  | 
| 
3079
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $b = new Kid_Info;  | 
| 
3080
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $b->grade('Kindergarten');  | 
| 
3081
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $b->skills(['Knows Perl', 'Phreaks']);  | 
| 
3082
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $f->kids('BamBam', $b);  | 
| 
3083
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print join ', ', $f->kids_keys;	# Prints "Pebbles, BamBam",  | 
| 
3084
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 					# though maybe not in that order.  | 
| 
3085
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3086
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 COMMON METHODS  | 
| 
3087
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3088
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 All members also have a method C.  | 
| 
3089
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This method undefines a member C.  | 
| 
3090
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3091
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 OBJECT INSTANCE METHODS  | 
| 
3092
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3093
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C also generates methods  | 
| 
3094
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 that you can invoke on an object instance.  | 
| 
3095
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 These are as follows:  | 
| 
3096
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3097
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Copy  | 
| 
3098
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3099
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Use the C method to copy the value of an object.  | 
| 
3100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The expression:  | 
| 
3101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = $o->copy;  | 
| 
3103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 assigns to C<$p> a copy of C<$o>.  | 
| 
3105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Members of C<$o> that are classes (or arrays or hashes of classes)  | 
| 
3106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 are copied using their own C method.  | 
| 
3107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head2 Equals  | 
| 
3109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3110
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Use the C method to test the equality of two object instances:  | 
| 
3111
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3112
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     if ( $o1->equals($o2) ) { ... }  | 
| 
3113
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3114
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The two object instances are equal if  | 
| 
3115
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 members that have values in C<$o1> have equal values in C<$o2>, and vice versa.  | 
| 
3116
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Equality is tested as you would expect:  | 
| 
3117
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 two scalar members are equal if they have the same value;  | 
| 
3118
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 two array members are equal if they have the same elements;  | 
| 
3119
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 two hash members are equal if they have the same key/value pairs.  | 
| 
3120
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3121
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If a member's value is restricted to a class,  | 
| 
3122
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 then equality is tested using that class' C method.  | 
| 
3123
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Otherwise, it is tested using the C operator.  | 
| 
3124
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3125
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 By default, all members participate in the equality test.  | 
| 
3126
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If one or more members possess true values for the C attribute,  | 
| 
3127
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 then only those members participate in the equality test.  | 
| 
3128
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3129
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You can override this definition of equality.  | 
| 
3130
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 See L.  | 
| 
3131
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3132
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 ADVANCED MEMBER SPECIFICATIONS  | 
| 
3133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3134
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 As shown, you specify each member as a Cvalue> pair.  | 
| 
3135
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C is a string, it specifies the member's type.  | 
| 
3136
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value may also be a hash reference.  | 
| 
3137
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You use hash references to specify additional member attributes.  | 
| 
3138
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The following is a complete list of the attributes you may specify for a member:  | 
| 
3139
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3140
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
3141
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3142
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item type=>string  | 
| 
3143
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3144
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If you use a hash reference for a member's value,  | 
| 
3145
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 you I use the C attribute to specify its type:  | 
| 
3146
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3147
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     scalar_member => { type => '$' }  | 
| 
3148
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3149
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item required=>boolean  | 
| 
3150
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3151
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C attribute is true,  | 
| 
3152
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member must be passed each time the class' constructor is invoked:  | 
| 
3153
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3154
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => { type => '$', required => 1 } ];  | 
| 
3155
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Person->new ( name => 'Wilma' );	# Valid  | 
| 
3156
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Person->new;			# Invalid  | 
| 
3157
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3158
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Also, you may not call C for the member.  | 
| 
3159
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3160
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item default=>value  | 
| 
3161
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3162
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C attribute provides a default value for a member  | 
| 
3163
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 if none is passed to the constructor:  | 
| 
3164
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3165
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ name => '$',  | 
| 
3166
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		      job => { type => '$',  | 
| 
3167
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			       default => "'Perl programmer'" } ];  | 
| 
3168
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new(name => 'Larry');  | 
| 
3169
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->job;		# Prints 'Perl programmer'.  | 
| 
3170
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $q = Person->new(name => 'Bjourne', job => 'C++ programmer');  | 
| 
3171
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $q->job;		# Unprintable.  | 
| 
3172
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3173
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value is treated as a string that is evaluated  | 
| 
3174
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 when the constructor is invoked.  | 
| 
3175
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3176
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For array members, use a string that looks like a Perl expression  | 
| 
3177
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 that evaluates to an array reference:  | 
| 
3178
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3179
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => {  | 
| 
3180
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	name => '$',  | 
| 
3181
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	lucky_numbers => { type => '@', default => '[42, 17]' }  | 
| 
3182
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
3183
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Silly => {  | 
| 
3184
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	UIDs => {		# Default value is all UIDs  | 
| 
3185
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    type => '@',	# currently in /etc/passwd.  | 
| 
3186
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    default => 'do {  | 
| 
3187
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		local $/ = undef;  | 
| 
3188
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		open PASSWD, "/etc/passwd";  | 
| 
3189
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[ map {(split(/:/))[2]} split /\n/,  ]  | 
| 
3190
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	    }'  | 
| 
3191
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	}  | 
| 
3192
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
3193
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3194
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Specify hash members analogously.  | 
| 
3195
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3196
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value is evaluated each time the constructor is invoked.  | 
| 
3197
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 In C, the default value for C can change between invocations.  | 
| 
3198
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the default value is a reference rather than a string,  | 
| 
3199
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 it is not re-evaluated.  | 
| 
3200
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 In the following, default values for C and C  | 
| 
3201
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 are based on the members of C<@default_value>  | 
| 
3202
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 each time Cnew> is invoked,  | 
| 
3203
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 whereas C's default value is set when the C function is invoked  | 
| 
3204
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 to define C:  | 
| 
3205
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3206
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     @default_value = (1, 2, 3);  | 
| 
3207
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $var_name = '@' . __PACKAGE__ . '::default_value';  | 
| 
3208
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Example => {  | 
| 
3209
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         e1 => { type => '@', default => "[$var_name]" },  | 
| 
3210
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	e2 => { type => '@', default => \@default_value },  | 
| 
3211
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	e3 => { type => '@', default => [ @default_value ] }  | 
| 
3212
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
3213
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Example->new;	# e1, e2, and e3 are all identical.  | 
| 
3214
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     @default_value = (10, 20, 30);  | 
| 
3215
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     Example->new;	# Now only e3 is (1, 2, 3).  | 
| 
3216
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3217
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 There are two more things to know about default values that are strings.  | 
| 
3218
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 First, if a member is typed,  | 
| 
3219
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the C function evaluates its (string-based)  | 
| 
3220
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 default value to ensure that it  | 
| 
3221
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 is of the correct type for the member.  | 
| 
3222
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Be aware of this if your default value has side effects  | 
| 
3223
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (and see L).  | 
| 
3224
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3225
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Second, the context of the default value is the C method  | 
| 
3226
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 of the package generated to implement your class.  | 
| 
3227
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 That's why C in C, above,  | 
| 
3228
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 needs the name of the current package in its default value.  | 
| 
3229
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3230
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item post=>code  | 
| 
3231
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3232
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value of this attribute is a string of Perl code.  | 
| 
3233
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It is executed immediately after the member's value is modified through its accessor.  | 
| 
3234
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Within C code, you can refer to members as if they were Perl identifiers.  | 
| 
3235
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For instance:  | 
| 
3236
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3237
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [ age => { type => '$',  | 
| 
3238
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 			       post => '$age *= 2;' } ];  | 
| 
3239
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = Person->new(age => 30);  | 
| 
3240
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->age;	# Prints 30.  | 
| 
3241
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p->age(15);  | 
| 
3242
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     print $p->age;	# Prints 30 again.  | 
| 
3243
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3244
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The trailing semicolon used to be required, but everyone forgot it.  | 
| 
3245
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 As of version 1.06 it's optional:  | 
| 
3246
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 C<'$age*=2'> is accepted and equivalent to C<'$age*=2;'>  | 
| 
3247
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (but see L<"BUGS">).  | 
| 
3248
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3249
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You reference array and hash members as usual  | 
| 
3250
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (except for testing for definition; see L<"BUGS">).  | 
| 
3251
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You can reference individual elements, or the whole list:  | 
| 
3252
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3253
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Foo => [  | 
| 
3254
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	m1 => { type => '@', post => '$m1[$#m1/2] = $m2{xxx};' },  | 
| 
3255
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	m2 => { type => '%', post => '@m1 = keys %m2;' }  | 
| 
3256
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
3257
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3258
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You can also invoke accessors.  | 
| 
3259
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Prefix them with a C<&>:  | 
| 
3260
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3261
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Bar => [  | 
| 
3262
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	m1 => { type => '@', post => '&undef_m1;' },  | 
| 
3263
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	m2 => { type => '%', post => '@m1 = &m2_keys;' }  | 
| 
3264
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
3265
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $o = new Bar;  | 
| 
3266
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $o->m1([1, 2, 3]);		# m1 is still undefined.  | 
| 
3267
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $o->m2({a => 1, b => 2});	# Now m1 is qw(a b).  | 
| 
3268
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3269
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item pre=>code  | 
| 
3270
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3271
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C key is similar to the C key,   | 
| 
3272
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 but it is executed just before an member is changed.  | 
| 
3273
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 It is I executed if the member is only accessed.  | 
| 
3274
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C and C code have the same scope,   | 
| 
3275
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 which lets you share variables.  | 
| 
3276
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For instance:  | 
| 
3277
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3278
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Foo => [  | 
| 
3279
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	mem => { type => '$', pre => 'my $v = $mem;', post => 'return $v;' }  | 
| 
3280
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     ];  | 
| 
3281
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $o = new Foo;  | 
| 
3282
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $p = $o->mem(1);	# Sets $p to undef.  | 
| 
3283
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $q = $o->mem(2);	# Sets $q to 1.  | 
| 
3284
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3285
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 is a way to return the previous value of C any time it's modified  | 
| 
3286
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (but see L<"NOTES">).  | 
| 
3287
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3288
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item assert=>expression  | 
| 
3289
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3290
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The value of this key should be a Perl expression  | 
| 
3291
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 that evaluates to true or false.  | 
| 
3292
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Use member names in the expression, as with C.  | 
| 
3293
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The expression will be tested any time  | 
| 
3294
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member is modified through its accessors.  | 
| 
3295
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Your code will C if the expression evaluates to false.  | 
| 
3296
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For instance,  | 
| 
3297
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3298
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => [  | 
| 
3299
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	name => '$',  | 
| 
3300
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	age => { type => '$',  | 
| 
3301
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		 assert => '$age =~ /^\d+$/ && $age < 200' } ];  | 
| 
3302
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3303
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 ensures the age is reasonable.  | 
| 
3304
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3305
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The assertion is executed after any C code associated with the member.  | 
| 
3306
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3307
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item private=>boolean  | 
| 
3308
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3309
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C attribute is true,  | 
| 
3310
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member cannot be accessed outside the class;  | 
| 
3311
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 that is, it has no accessor functions that can be called  | 
| 
3312
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 outside the scope of the package defined by C.  | 
| 
3313
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A private member can, however, be accessed in C, C, and C   | 
| 
3314
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 code of other members of the class.  | 
| 
3315
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3316
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item protected=>boolean  | 
| 
3317
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3318
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If the C attribute is true,  | 
| 
3319
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member cannot be accessed outside the class or any of its subclasses.  | 
| 
3320
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 A protected member can, however, be accessed in C, C, and C   | 
| 
3321
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 code of other members of the class or its subclasses.  | 
| 
3322
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3323
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item readonly=>boolean  | 
| 
3324
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3325
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If this attribute is true, then the member cannot be modified  | 
| 
3326
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 through its accessors.  | 
| 
3327
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Users can set the member only by using the class constructor.  | 
| 
3328
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The member's accessor that is its name can retrieve but not set the member.  | 
| 
3329
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The CI accessor is not defined for the member,  | 
| 
3330
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 nor are other accessors that might modify the member.  | 
| 
3331
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (Code in C can set it, however.)  | 
| 
3332
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3333
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item key=>boolean  | 
| 
3334
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3335
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If this attribute is true, then the member participates in equality tests.  | 
| 
3336
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 See L<"Equals">.  | 
| 
3337
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3338
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item nocopy=>value  | 
| 
3339
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3340
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C attribute gives you some per-member control  | 
| 
3341
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 over how the C method.  | 
| 
3342
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If C is false (the default),  | 
| 
3343
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the original's value is copied as described in L<"Copy">.  | 
| 
3344
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If C is true,  | 
| 
3345
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the original's value is assigned rather than copied;  | 
| 
3346
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 in other words, the copy and the original will have the same value  | 
| 
3347
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 if the original's value is a reference.  | 
| 
3348
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3349
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =back  | 
| 
3350
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3351
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =head1 AFFECTING THE CONSTRUCTOR  | 
| 
3352
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3353
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 You may include a C attribute in the specification to affect the constructor.  | 
| 
3354
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Its value must be a hash reference.  | 
| 
3355
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Its attributes are:  | 
| 
3356
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3357
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =over 4  | 
| 
3358
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3359
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item required=>list of constraints  | 
| 
3360
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3361
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This is another (and more general) way to require that  | 
| 
3362
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 parameters be passed to the constructor.  | 
| 
3363
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Its value is a reference to an array of constraints.  | 
| 
3364
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Each constraint is a string that must be an expression  | 
| 
3365
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 composed of Perl logical operators and member names.  | 
| 
3366
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 For example:  | 
| 
3367
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3368
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     class Person => {  | 
| 
3369
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	name   => '$',  | 
| 
3370
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         age    => '$',  | 
| 
3371
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	height => '$',  | 
| 
3372
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	weight => '$',  | 
| 
3373
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	new => { required => ['name', 'height^weight'] }  | 
| 
3374
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     };  | 
| 
3375
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3376
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 requires member C, and exactly one of C or C.  | 
| 
3377
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Note that the names are I prefixed with C<$>, C<@>, or C<%>.  | 
| 
3378
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3379
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Specifying a list of constraints as an array reference can be clunky.  | 
| 
3380
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C function also lets you specify the list as a string,  | 
| 
3381
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 with individual constraints separated by spaces.  | 
| 
3382
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The following two strings are equivalent to the above C attribute:  | 
| 
3383
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3384
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     'name height^weight'  | 
| 
3385
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     'name&(height^weight)'  | 
| 
3386
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3387
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 However, C<'name & (height ^ weight)'> would not work.  | 
| 
3388
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C function interprets it as a five-member list,  | 
| 
3389
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 four members of which are not valid expressions.  | 
| 
3390
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3391
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This equivalence between a reference to array of strings  | 
| 
3392
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 and a string of space-separated items is used throughout C.  | 
| 
3393
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Use whichever form works best for you.  | 
| 
3394
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3395
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item post=>string of code  | 
| 
3396
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3397
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C key is similar to the C key for members.  | 
| 
3398
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Its value is code that is inserted into the constructor  | 
| 
3399
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 after parameter values have been assigned to members.  | 
| 
3400
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C function performs variable substitution.  | 
| 
3401
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3402
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C key is I recognized in C.   | 
| 
3403
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3404
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item assert=>expression  | 
| 
3405
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3406
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C key's value is inserted  | 
| 
3407
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 just after the C key's value (if any).  | 
| 
3408
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 Assertions for members are inserted after the constructor's assertion.  | 
| 
3409
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3410
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item comment=>string  | 
| 
3411
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3412
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 This attribute's value can be any string.  | 
| 
3413
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 If you save the class to a file  | 
| 
3414
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 (see L),  | 
| 
3415
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the string is included as a comment just before  | 
| 
3416
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 the member's methods.  | 
| 
3417
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3418
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 =item style=>style definition  | 
| 
3419
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3420
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 The C |