File Coverage

blib/lib/Rose/HTML/Objects.pm
Criterion Covered Total %
statement 694 707 98.1
branch 64 84 76.1
condition 12 17 70.5
subroutine 191 201 95.0
pod 1 4 25.0
total 962 1013 94.9


line stmt bran cond sub pod time code
1             package Rose::HTML::Objects;
2              
3 1     1   1035 use strict;
  1         2  
  1         38  
4              
5 1     1   6 use Carp;
  1         2  
  1         59  
6 1     1   5 use File::Spec();
  1         2  
  1         23  
7 1     1   6 use File::Path();
  1         2  
  1         13  
8 1     1   6 use File::Basename();
  1         2  
  1         1214  
9              
10             our $VERSION = '0.626';
11              
12             our $Debug = 0;
13              
14             sub make_private_library
15             {
16 3     3 1 1722 my($class) = shift;
17              
18 3         16 my %args = @_;
19              
20 3         18 my($packages, $perl) =
21             Rose::HTML::Objects->private_library_perl(@_);
22              
23 3 50       18 my $debug = exists $args{'debug'} ? $args{'debug'} : $Debug;
24              
25 3 100       12 if($args{'in_memory'})
26             {
27 2         10 foreach my $pkg (@$packages)
28             {
29 149         420 my $code = $perl->{$pkg};
30 149 50       382 $debug > 2 && warn $code, "\n";
31              
32 149         201 my $error;
33              
34             TRY:
35             {
36 149         224 local $@;
  149         223  
37 1     1   7 eval $code;
  1     1   2  
  1     1   30  
  1     1   6  
  1     1   3  
  1     1   549  
  1     1   7  
  1     1   3  
  1     1   102  
  1     1   8  
  1     1   2  
  1     1   96  
  1     1   8  
  1     1   2  
  1     1   27  
  1     1   5  
  1     1   3  
  1     1   12  
  1     1   8  
  1     1   4  
  1     1   125  
  1     1   10  
  1     1   8  
  1     1   4  
  1     1   46  
  1     1   15  
  1     1   3  
  1     1   7  
  1     1   10  
  1     1   2  
  1     1   176  
  1     1   11  
  1     1   9  
  1     1   3  
  1     1   44  
  1     1   7  
  1     1   4  
  1     1   193  
  1     1   8  
  1     1   3  
  1     1   36  
  1     1   7  
  1     1   2  
  1     1   178  
  1     1   8  
  1     1   3  
  1     1   70  
  1     1   7  
  1     1   3  
  1     1   243  
  1     1   8  
  1     1   3  
  1     1   45  
  1     1   7  
  1     1   2  
  1     1   30  
  1     1   6  
  1     1   3  
  1     1   79  
  1     1   7  
  1     1   3  
  1     1   42  
  1     1   8  
  1     1   3  
  1     1   27  
  1     1   7  
  1     1   2  
  1     1   31  
  1     1   8  
  1     1   2  
  1     1   37  
  1     1   7  
  1     1   2  
  1     1   27  
  1     1   6  
  1     1   3  
  1     1   36  
  1     1   7  
  1     1   4  
  1     1   29  
  1     1   7  
  1     1   2  
  1     1   38  
  1     1   7  
  1     1   3  
  1     1   28  
  1     1   6  
  1     1   3  
  1     1   38  
  1     1   6  
  1     1   3  
  1     1   29  
  1     1   7  
  1     1   2  
  1     1   40  
  1     1   7  
  1     1   2  
  1     1   37  
  1     1   8  
  1     1   2  
  1     1   40  
  1     1   7  
  1     1   3  
  1     1   34  
  1     1   6  
  1     1   2  
  1     1   30  
  1     1   7  
  1     1   2  
  1     1   29  
  1     1   7  
  1     1   2  
  1     1   36  
  1     1   6  
  1     1   3  
  1     1   27  
  1     1   7  
  1     1   3  
  1     1   26  
  1     1   9  
  1     1   2  
  1     1   29  
  1     1   7  
  1     1   2  
  1     1   38  
  1     1   6  
  1     1   3  
  1     1   28  
  1     1   7  
  1     1   2  
  1     1   39  
  1     1   7  
  1     1   2  
  1     1   28  
  1     1   6  
  1     1   3  
  1     1   36  
  1     1   8  
  1     1   2  
  1     1   28  
  1     1   7  
  1     1   1  
  1     1   38  
  1     1   7  
  1     1   2  
  1     1   27  
  1     1   7  
  1     1   2  
  1     1   39  
  1     1   7  
  1     1   3  
  1     1   28  
  1     1   8  
  1     1   2  
  1     1   28  
  1     1   7  
  1     1   3  
  1     1   27  
  1     1   6  
  1     1   2  
  1     1   25  
  1     1   7  
  1     1   2  
  1     1   27  
  1     1   8  
  1     1   2  
  1     1   38  
  1     1   7  
  1     1   3  
  1     1   38  
  1     0   7  
  1     1   2  
  1     0   27  
  1     0   6  
  1     0   2  
  1     0   37  
  1     1   7  
  1     0   2  
  1     1   37  
  1     0   7  
  1     0   2  
  1     0   26  
  1     1   6  
  1     0   3  
  1     1   28  
  1         6  
  1         2  
  1         37  
  1         13  
  1         4  
  1         30  
  1         7  
  1         2  
  1         29  
  1         6  
  1         2  
  1         38  
  1         7  
  1         2  
  1         36  
  1         50  
  1         3  
  1         54  
  1         6  
  1         3  
  1         28  
  1         7  
  1         2  
  1         26  
  1         7  
  1         2  
  1         38  
  1         7  
  1         3  
  1         27  
  1         7  
  1         3  
  1         28  
  1         7  
  1         2  
  1         27  
  1         7  
  1         2  
  1         38  
  1         6  
  1         3  
  1         27  
  1         7  
  1         3  
  1         41  
  1         14  
  1         5  
  1         32  
  1         7  
  1         2  
  1         28  
  1         6  
  1         2  
  1         26  
  1         6  
  1         10  
  1         41  
  1         6  
  1         2  
  1         28  
  1         6  
  1         2  
  1         36  
  1         7  
  1         3  
  1         26  
  1         13  
  1         7  
  1         36  
  1         8  
  1         7  
  1         554  
  1         11  
  1         5  
  1         30  
  1         11  
  1         3  
  1         133  
  1         7  
  1         2  
  1         35  
  1         12  
  1         7  
  1         16  
  1         13  
  1         6  
  1         132  
  1         23  
  1         8  
  1         2  
  1         46  
  1         13  
  1         3  
  1         5  
  1         7  
  1         2  
  1         124  
  1         15  
  1         12  
  1         4  
  1         37  
  1         8  
  1         3  
  1         134  
  1         7  
  1         8  
  1         33  
  1         6  
  1         2  
  1         159  
  1         7  
  1         2  
  1         219  
  1         14  
  1         2  
  1         36  
  1         8  
  1         8  
  1         51  
  1         7  
  1         2  
  1         30  
  1         7  
  1         7  
  1         45  
  1         7  
  1         2  
  1         38  
  1         7  
  1         7  
  1         35  
  1         7  
  1         3  
  1         36  
  1         13  
  1         2  
  1         44  
  1         7  
  1         2  
  1         27  
  1         13  
  1         3  
  1         29  
  1         7  
  1         2  
  1         36  
  1         6  
  1         3  
  1         35  
  1         6  
  1         7  
  1         42  
  1         7  
  1         3  
  1         28  
  1         6  
  1         3  
  1         38  
  1         6  
  1         8  
  1         32  
  1         7  
  1         2  
  1         51  
  1         8  
  1         2  
  1         38  
  1         6  
  1         3  
  1         35  
  1         6  
  1         3  
  1         28  
  1         6  
  1         3  
  1         41  
  1         6  
  1         8  
  1         67  
  1         6  
  1         2  
  1         29  
  1         7  
  1         2  
  1         35  
  1         7  
  1         2  
  1         41  
  1         7  
  1         3  
  1         35  
  1         8  
  1         7  
  1         43  
  1         6  
  1         3  
  1         26  
  1         7  
  1         4  
  1         42  
  1         6  
  1         2  
  1         37  
  1         6  
  1         3  
  1         38  
  1         6  
  1         11  
  1         35  
  1         6  
  1         2  
  1         26  
  1         6  
  1         3  
  1         26  
  1         6  
  1         3  
  1         27  
  1         6  
  1         2  
  1         26  
  1         7  
  1         3  
  1         47  
  1         12  
  1         3  
  1         42  
  1         6  
  1         3  
  1         25  
  1         7  
  1         3  
  1         26  
  1         7  
  1         3  
  1         28  
  1         12  
  1         3  
  1         28  
  1         7  
  1         2  
  1         31  
  1         6  
  1         2  
  1         25  
  1         7  
  1         2  
  1         25  
  1         7  
  1         2  
  1         45  
  1         7  
  1         2  
  1         27  
  1         7  
  1         2  
  1         35  
  1         7  
  1         3  
  1         36  
  1         6  
  1         2  
  1         33  
  1         13  
  1         2  
  1         32  
  1         6  
  1         2  
  1         27  
  1         6  
  1         3  
  1         35  
  1         8  
  1         4  
  1         26  
  1         7  
  1         2  
  1         29  
  1         6  
  1         2  
  1         27  
  1         6  
  1         2  
  1         24  
  1         8  
  1         2  
  1         36  
  1         6  
  1         3  
  1         36  
  1         7  
  1         2  
  1         38  
  1         7  
  1         2  
  1         752  
  1         6  
  1         2  
  1         29  
  1         6  
  1         3  
  1         28  
  1         7  
  1         2  
  1         28  
  1         6  
  1         2  
  1         26  
  1         8  
  1         2  
  1         25  
  1         6  
  1         2  
  1         26  
  1         6  
  1         2  
  1         25  
  149         10641  
  0         0  
  1         9  
  0         0  
  0         0  
  0         0  
  0         0  
  1         7  
  1         9  
  0         0  
  1         50  
  0         0  
  0         0  
  0         0  
  1         50  
  0         0  
  1         35  
38 149         463 $error = $@;
39             }
40              
41 149 50       544 die "Could not eval $pkg - $error" if($error);
42             }
43             }
44             else
45             {
46 1 50       7 my $dir = $args{'modules_dir'} or croak "Missing modules_dir parameter";
47 1 50       50 mkdir($dir) unless(-d $dir);
48 1 50       18 croak "Could not create modules_dir '$dir' - $!" unless(-d $dir);
49              
50 1         5 foreach my $pkg (@$packages)
51             {
52 75         359 my @file_parts = split('::', $pkg);
53 75         194 $file_parts[-1] .= '.pm';
54 75         974 my $file = File::Spec->catfile($dir, @file_parts);
55              
56 75         2868 my $file_dir = File::Basename::dirname($file);
57              
58 75         4041 File::Path::mkpath($file_dir); # spews errors to STDERR
59 75 50       1168 croak "Could not make directory '$file_dir'" unless(-d $file_dir);
60              
61 75 50 66     1517 if(-e $file && !$args{'overwrite'})
62             {
63 0 0       0 $debug && warn "Refusing to overwrite '$file'";
64 0         0 next;
65             }
66              
67 75 50       12909 open(my $fh, '>', $file) or croak "Could not create '$file' - $!";
68 75         612 print $fh $perl->{$pkg};
69 75 50       3470 close($fh) or croak "Could not write '$file' - $!";
70              
71 75 50       643 $debug > 2 && warn $perl->{$pkg}, "\n";
72             }
73             }
74              
75 3 100       150 return wantarray ? @$packages : $packages;
76             }
77              
78             sub private_library_perl
79             {
80 3     3 0 13 my($class, %args) = @_;
81              
82 3         9 my $rename = $args{'rename'};
83 3         7 my $prefix = $args{'prefix'};
84 3   50     21 my $trim_prefix = $args{'trim_prefix'} || 'Rose::';
85 3   100     14 my $in_memory = $args{'in_memory'} || 0;
86              
87 3         29 my $prefix_regex = qr(^$trim_prefix);
88              
89             $rename ||= sub
90             {
91 295     295   461 my($name) = shift;
92 295         1655 $name =~ s/$prefix_regex/$prefix/;
93 295         766 return $name;
94 3   100     25 };
95              
96 3         5 my $save_rename = $rename;
97              
98             $rename = sub
99             {
100 443     443   708 my $name = shift;
101 443         691 local $_ = $name;
102 443         799 my $new_name = $save_rename->($name);
103              
104 443 50 33     1797 if($_ ne $name && (!$new_name || $new_name == 1))
      66        
105             {
106 148         336 return $_;
107             }
108              
109 295         573 return $new_name;
110 3         13 };
111              
112 3         16 my $class_filter = $args{'class_filter'};
113              
114 3         8 my(%perl, %isa, @packages);
115              
116 3         765 require Rose::HTML::Object;
117              
118 3         19 my $base_object_type = Rose::HTML::Object->object_type_classes;
119 3         703 my %base_type_object = reverse %$base_object_type;
120              
121 3         13 my %object_type;
122              
123 3         7 my $max_type_len = 0;
124              
125 3         19 while(my($type, $base_class) = each(%$base_object_type))
126             {
127 201         305 $object_type{$type} = $rename->($base_class);
128 201 100       624 $max_type_len = length($type) if(length($type) > $max_type_len);
129             }
130              
131 3         16 my $object_map_perl =<<"EOF";
132             __PACKAGE__->object_type_classes
133             (
134             EOF
135              
136 3         97 foreach my $type (sort keys %object_type)
137             {
138 201         293 my $class = $object_type{$type};
139 201         529 $object_map_perl .= sprintf(" %-*s => '$class',\n", $max_type_len + 2, qq('$type'));
140             }
141              
142 3         25 $object_map_perl .=<<"EOF";
143             );
144             EOF
145              
146 3         10 my $object_package = $rename->('Rose::HTML::Object');
147 3         13 my $message_package = $rename->('Rose::HTML::Object::Message::Localized');
148 3         12 my $messages_package = $rename->('Rose::HTML::Object::Messages');
149 3         12 my $error_package = $rename->('Rose::HTML::Object::Error');
150 3         11 my $errors_package = $rename->('Rose::HTML::Object::Errors');
151 3         36 my $localizer_package = $rename->('Rose::HTML::Object::Message::Localizer');
152 3         12 my $custom_package = $rename->('Rose::HTML::Object::Custom');
153              
154 3         9 my $load_message_and_errors_perl = '';
155              
156 3 100       10 unless($in_memory)
157             {
158 1         7 $load_message_and_errors_perl=<<"EOF";
159             use $error_package;
160             use $errors_package();
161             use $message_package;
162             use $messages_package();
163             EOF
164             }
165              
166 3         11 my $std_messages=<<"EOF";
167             # Import the standard set of message ids
168             use Rose::HTML::Object::Messages qw(:all);
169             EOF
170              
171 3         6 my $std_errors=<<"EOF";
172             # Import the standard set of error ids
173             use Rose::HTML::Object::Errors qw(:all);
174             EOF
175              
176             my %code =
177             (
178             $message_package =><<"EOF",
179             sub generic_object_class { '$object_package' }
180             EOF
181              
182             $messages_package =>
183             {
184             filter => sub
185             {
186 3     3   37 s/^(use base.+)/$std_messages$1/m;
187             },
188              
189             code =><<"EOF",
190             ##
191             ## Define your new message ids below
192             ##
193              
194             # Message ids from 0 to 29,999 are reserved for built-in messages. Negative
195             # message ids are reserved for internal use. Please use message ids 30,000
196             # or higher for your messages. Suggested message id ranges and naming
197             # conventions for various message types are shown below.
198              
199             # Field labels
200              
201             #use constant FIELD_LABEL_LOGIN_NAME => 100_000;
202             #use constant FIELD_LABEL_PASSWORD => 100_001;
203             #...
204              
205             # Field error messages
206              
207             #use constant FIELD_ERROR_PASSWORD_TOO_SHORT => 101_000;
208             #use constant FIELD_ERROR_USERNAME_INVALID => 101_001;
209             #...
210              
211             # Generic messages
212              
213             #use constant LOGIN_NO_SUCH_USER => 200_000;
214             #use constant LOGIN_USER_EXISTS_ERROR => 200_001;
215             #...
216              
217             ### %CODE% ###
218              
219             # This line must be below all the "use constant ..." declarations
220             BEGIN { __PACKAGE__->add_messages }
221             EOF
222             },
223              
224             $error_package =><<"EOF",
225             sub generic_object_class { '$object_package' }
226             EOF
227              
228             $errors_package =>
229             {
230             filter => sub
231             {
232 3     3   35 s/^(use base.+)/$std_errors$1/m;
233             },
234              
235 3         51 code =><<"EOF",
236             ##
237             ## Define your new error ids below
238             ##
239              
240             # Error ids from 0 to 29,999 are reserved for built-in errors. Negative
241             # error ids are reserved for internal use. Please use error ids 30,000
242             # or higher for your errors. Suggested error id ranges and naming
243             # conventions for various error types are shown below.
244              
245             # Field errors
246              
247             #use constant FIELD_ERROR_PASSWORD_TOO_SHORT => 101_000;
248             #use constant FIELD_ERROR_USERNAME_INVALID => 101_001;
249             #...
250              
251             # Generic errors
252              
253             #use constant LOGIN_NO_SUCH_USER => 200_000;
254             #use constant LOGIN_USER_EXISTS_ERROR => 200_001;
255             #...
256              
257             ### %CODE% ###
258              
259             # This line must be below all the "use constant ..." declarations
260             BEGIN { __PACKAGE__->add_errors }
261             EOF
262             },
263              
264             $localizer_package =><<"EOF",
265             $load_message_and_errors_perl
266             sub init_message_class { '$message_package' }
267             sub init_messages_class { '$messages_package' }
268             sub init_error_class { '$error_package' }
269             sub init_errors_class { '$errors_package' }
270             EOF
271              
272             $custom_package =><<"EOF",
273 3 100       21 @{[ $in_memory ? "Rose::HTML::Object->import(':customize');" : "use Rose::HTML::Object qw(:customize);" ]}
274 3 100       84 @{[ $in_memory ? '' : "\nuse $localizer_package;\n" ]}
275             __PACKAGE__->default_localizer($localizer_package->new);
276              
277             $object_map_perl
278             EOF
279              
280             $object_package =><<"EOF",
281             sub generic_object_class { '$object_package' }
282             EOF
283             );
284              
285             #
286             # Rose::HTML::Object
287             #
288              
289 3         28 require Rose::HTML::Object;
290              
291 3         25 foreach my $base_class (qw(Rose::HTML::Object))
292             {
293 3         9 my $package = $rename->($base_class);
294              
295 3         10 push(@packages, $package);
296              
297 3 100       15 if($args{'in_memory'})
298             {
299             # Prevent "Base class package "..." is empty" errors from base.pm
300 1     1   8 no strict 'refs';
  1         2  
  1         731  
301 2         12 ${"${custom_package}::VERSION"} = $Rose::HTML::Object::VERSION;
  2         29  
302              
303             # XXX" Don't need to do this
304             #(my $path = $custom_package) =~ s{::}{/}g;
305             #$INC{"$path.pm"} = 123;
306             }
307              
308 3         11 $isa{$package} = [ $custom_package, $base_class ];
309              
310             $perl{$package} = $class->subclass_perl(package => $package,
311             isa => $isa{$package},
312             in_memory => 0,
313             default_code => \%code,
314             code => $args{'code'},
315 3         37 code_filter => $args{'code_filter'});
316             }
317              
318             #
319             # Rose::HTML::Object::Errors
320             # Rose::HTML::Object::Messages
321             # Rose::HTML::Object::Message::Localizer
322             #
323              
324 3         21 require Rose::HTML::Object::Errors;
325 3         15 require Rose::HTML::Object::Messages;
326 3         14 require Rose::HTML::Object::Message::Localizer;
327              
328 3         12 foreach my $base_class (qw(Rose::HTML::Object::Error
329             Rose::HTML::Object::Errors
330             Rose::HTML::Object::Messages
331             Rose::HTML::Object::Message::Localized
332             Rose::HTML::Object::Message::Localizer))
333             {
334 15         34 my $package = $rename->($base_class);
335              
336 15         33 push(@packages, $package);
337              
338 15         34 $isa{$package} = $base_class;
339              
340             $perl{$package} = $class->subclass_perl(package => $package,
341             isa => $isa{$package},
342             in_memory => 0,
343             default_code => \%code,
344             code => $args{'code'},
345 15         60 code_filter => $args{'code_filter'});
346             }
347              
348             #
349             # Rose::HTML::Object::Customized
350             #
351              
352             $perl{$custom_package} =
353             $class->subclass_perl(package => $custom_package,
354             in_memory => $in_memory,
355             default_code => \%code,
356             code => $args{'code'},
357 3         13 code_filter => $args{'code_filter'});
358              
359 3         15 push(@packages, $custom_package);
360              
361             #
362             # All other classes
363             #
364              
365 3         94 foreach my $base_class (sort values %$base_object_type, 'Rose::HTML::Form::Field')
366             {
367 204 100       445 if($class_filter)
368             {
369 68         103 local $_ = $base_class;
370 68 100       145 next unless($class_filter->($base_class));
371             }
372              
373 203 100       773 if($in_memory)
374             {
375 135         210 my $error;
376              
377             TRY:
378             {
379 135         186 local $@;
  135         178  
380 135         7238 eval "require $base_class";
381 135         510 $error = $@;
382             }
383              
384 135 50       360 croak "Could not load '$base_class' - $error" if($error);
385             }
386              
387 203         478 my $package = $rename->($base_class);
388              
389 203         394 push(@packages, $package);
390              
391 203 100       536 unless($isa{$package})
392             {
393             $isa{$package} =
394             [
395             $custom_package,
396 125 50       546 $base_type_object{$package} ? $rename->($base_class) : $base_class,
397             ];
398             }
399              
400             $perl{$package} = $class->subclass_perl(package => $package,
401             isa => $isa{$package},
402             in_memory => $in_memory,
403             code => $args{'code'},
404 203         808 code_filter => $args{'code_filter'});
405             }
406              
407 3 50       444 return wantarray ? (\@packages, \%perl) : \%perl;
408             }
409              
410             sub isa_perl
411             {
412 221     221 0 680 my($class, %args) = @_;
413              
414 221 50       494 my $isa = $args{'isa'} or Carp::confess "Missing 'isa' parameter";
415 221 100       461 $isa = [ $isa ] unless(ref $isa eq 'ARRAY');
416              
417 221 100       393 if($args{'in_memory'})
418             {
419 135         794 return 'our @ISA = qw(' . join(' ', @$isa) . ");";
420             }
421             else
422             {
423 86         413 return 'use base qw(' . join(' ', @$isa) . ");";
424             }
425             }
426              
427             our $Perl;
428              
429             sub subclass_perl
430             {
431 224     224 0 1014 my($class, %args) = @_;
432              
433 224 50       524 my $package = $args{'package'} or Carp::confess "Missing 'package' parameter";
434 224         338 my $isa = $args{'isa'};
435 224 100       553 $isa = [ $isa ] unless(ref $isa eq 'ARRAY');
436              
437 224         331 my $filter = $args{'code_filter'};
438              
439 224         351 my($code, @code, @default_code);
440              
441 224         395 foreach my $param (qw(default_code code))
442             {
443 448   100     1156 my $arg = $args{$param} || '';
444              
445 448 100       863 if(ref $arg eq 'HASH')
446             {
447 170         288 $arg = $arg->{$package};
448             }
449              
450 1     1   8 no warnings 'uninitialized';
  1         2  
  1         480  
451 448 100       801 if(ref $arg eq 'HASH')
452             {
453 7 100       17 if(my $existing_filter = $filter)
454             {
455 3         7 my $new_filter = $arg->{'filter'};
456             $filter = sub
457             {
458 3     3   14 $existing_filter->(@_);
459 3         19 $new_filter->(@_);
460 3         16 };
461             }
462             else
463             {
464 4         9 $filter = $arg->{'filter'};
465             }
466              
467 7         14 $arg = $arg->{'code'};
468             }
469              
470 448 50       705 if(ref $arg eq 'CODE')
471             {
472 0         0 $code = $arg->($package, $isa);
473             }
474             else
475             {
476 448         631 $code = $arg;
477             }
478              
479 448 100       683 if($code)
480             {
481 27         51 for($code)
482             {
483 27         158 s/^\n*/\n/;
484 27         2295 s/\n*\z/\n/;
485             }
486             }
487             else
488             {
489 421         582 $code = '';
490             }
491              
492 448 100       938 if($code)
493             {
494 27 100       50 if($param eq 'code')
495             {
496 6         17 push(@code, $code);
497             }
498             else
499             {
500 21         82 push(@default_code, $code);
501             }
502             }
503             }
504              
505 224         357 foreach my $default_code (@default_code)
506             {
507 21 100       76 if($default_code =~ /\n### %CODE% ###\n/)
508             {
509 6         30 $default_code =~ s/\n### %CODE% ###\n/join('', @code)/me;
  6         25  
510 6         15 undef @code; # Attempt to reclaim memory
511 6         14 undef $code; # Attempt to reclaim memory
512             }
513             }
514              
515 224         332 local $Perl;
516              
517 224         456 $Perl=<<"EOF";
518             package $package;
519              
520             use strict;
521 224 100       1125 @{[ $args{'isa'} ? "\n" . $class->isa_perl(%args) . "\n" : '' ]}@{[ join('', @default_code, @code) ]}
  224         770  
522             1;
523             EOF
524              
525 224 100       592 if($filter)
526             {
527 78         188 local *_ = *Perl;
528 78         224 $filter->(\$Perl);
529             }
530              
531 224         1187 return $Perl;
532             }
533              
534             1;
535              
536             __END__
537              
538             =head1 NAME
539              
540             Rose::HTML::Objects - Object-oriented interfaces for HTML.
541              
542             =head1 SYNOPSIS
543              
544             #
545             # HTML form/field abstraction
546             #
547              
548             use Rose::HTML::Form;
549              
550             $form = Rose::HTML::Form->new(action => '/foo',
551             method => 'post');
552              
553             $form->add_fields
554             (
555             name => { type => 'text', size => 20, required => 1 },
556             height => { type => 'text', size => 5, maxlength => 5 },
557             bday => { type => 'datetime' },
558             );
559              
560             $form->params(name => 'John', height => '6ft', bday => '01/24/1984');
561              
562             $form->init_fields();
563              
564             $bday = $form->field('bday')->internal_value; # DateTime object
565              
566             print $bday->strftime('%A'); # Tuesday
567              
568             print $form->field('bday')->html;
569              
570             #
571             # Generic HTML objects
572             #
573              
574             $obj = Rose::HTML::Object->new('p');
575              
576             $obj->push_child('hello'); # text node
577             $obj->add_child(' '); # text node
578              
579             # Add two children: HTML object with text node child
580             $obj->add_children(
581             Rose::HTML::Object->new(element => 'b',
582             children => [ 'world' ]));
583              
584             # Serialize to HTML
585             print $obj->html; # prints: <p>hello <b>world</b></p>
586              
587             =head1 DESCRIPTION
588              
589             L<Rose::HTML::Objects> is a framework for creating a reusable set of HTML widgets as mutable Perl objects that can be serialized to HTML or XHTML for display purposes.
590              
591             The L<Rose::HTML::Object> class may be used directly to represent a generic tag with an explicitly set L<element|Rose::HTML::Object/element> name and arbitrary L<attributes|Rose::HTML::Object/html_attr>. There are also methods for L<parentE<sol>child manipulation|Rose::HTML::Object/HIERARCHY>.
592              
593             Though such generic usage is possible, this family of modules is primarily intended as a framework for creating a resuable set of L<form|Rose::HTML::Form> and L<field|Rose::HTML::Form::Field> widgets. On the Perl side, these objects are treated as abstract entities that can be fed input and will produce output in the form that is most convenient for the programmer (e.g., pass a L<DateTime> object to a date picker field to initialize it, and get a L<DateTime> object back from the field when asking for its value).
594              
595             Fields may be simple (one standard HTML form field per Perl field object) or L<compound|Rose::HTML::Form::Field::Compound> (a field object that serializes to an arbitrary number of HTML tags, but can be addressed as a single logical field internally). Likewise, forms themselves can be L<nested|Rose::HTML::Form/"NESTED FORMS">.
596              
597             Each L<field|Rose::HTML::Form::Field> has its own customizable validation, input filter, output filter, internal value (a plain value or a Perl object, whichever is most convenient), output value (the value shown when the field is redisplayed), label, associated error, and any other metadata deemed necessary. Each field can also be serialized to the L<equivalent|Rose::HTML::Form::Field/html_hidden_fields> set of (X)HTML "hidden" fields.
598              
599             L<Forms|Rose::HTML::Form> are expected to be initialized with and return an object or list of objects that the form represents. For example, a registration form could be initialized with and return a C<UserAccount> object.
600              
601             All labels, errors, and messages used in the bundled form and field widgets are localized in several languages, and you may add your own localized messages and errors using the provided L<localization framework|/LOCALIZATION>.
602              
603             Users are encouraged to L<create their own libraries|/"PRIVATE LIBRARIES"> of reusable form and field widgets for use on their site. The expectation is that the same kind of field appears in multiple places in any large web application (e.g., username fields, password fields, address forms, etc.) Each field encapsulates a set of values (e.g., options in a pop-up menu), labels, validation constraints, filters, and error messages. Similarly, each form encapsulates a set of fields along with any inter-field validation, error messages, and init-with/object-from methods. Nesting forms and fields preserves this delegation of responsibility, with each higher level having access to its children to perform inter-form/field tasks.
604              
605             =head1 PRIVATE LIBRARIES
606              
607             The classes that make up the L<Rose::HTML::Objects> distribution can be used as-is to build forms, fields, and other HTML objects. The provided classes may also be subclassed to change their behavior. When subclassing, however, the interconnected nature of these classes may present some surprises. For example, consider the case of subclassing the L<Rose::HTML::Form::Field::Option> class that represents a single option in a L<select box|Rose::HTML::Form::Field::SelectBox> or L<pop-up menu|Rose::HTML::Form::Field::PopUpMenu>.
608              
609             package My::HTML::Form::Field::Option;
610              
611             use base 'Rose::HTML::Form::Field::Option';
612              
613             sub bark
614             {
615             print "woof!\n";
616             }
617              
618             Now all your options can bark like a dog.
619              
620             $option = My::HTML::Form::Field::Option->new;
621             $option->bark; # woof!
622              
623             This seems great until you make your first select box or pop-up menu, pull out an option object, and ask it to bark.
624              
625             $color =
626             Rose::HTML::Form::Field::PopUpMenu->new(
627             name => 'color',
628             options => [ 'red', 'green', 'blue' ]);
629              
630             $option = $color->option('red');
631              
632             $option->bark; # BOOM: fatal error, no such method!
633              
634             What you'll get is an error message like this: "Can't locate object method 'bark' via package 'Rose::HTML::Form::Field::Option' - ..." That's because C<$option> is a plain old L<Rose::HTML::Form::Field::Option> object and not one of your new C<My::HTML::Form::Field::Option> objects that can C<bark()>.
635              
636             This is an example of the aforementioned interconnected nature of HTML objects: L<pop-up menus|Rose::HTML::Form::Field::PopUpMenu> and L<select boxes|Rose::HTML::Form::Field::SelectBox> contain L<options|Rose::HTML::Form::Field::Option>; L<radio button groups|Rose::HTML::Form::Field::RadioButtonGroup> contain L<radio buttons|Rose::HTML::Form::Field::RadioButton>; L<checkbox groups|Rose::HTML::Form::Field::CheckboxGroup> contain L<checkboxes|Rose::HTML::Form::Field::Checkbox>; L<forms|Rose::HTML::Form> contain all of the above; and so on. What to do?
637              
638             Well, one solution is to convince all the C<Rose::HTML::*> classes that might contain option objects to use your new C<My::HTML::Form::Field::Option> subclass instead of the standard L<Rose::HTML::Form::Field::Option> class. But globally altering the behavior of the standard C<Rose::HTML::*> classes is an extremely bad idea. To understand why, imagine that you did so and then tried to incorporate some other code that also uses C<Rose::HTML::*> classes. That other code certainly doesn't expect the changes you've made. It expects the documented behavior for all the classes it's using, and rightfully so.
639              
640             That's the problem with making class-wide alterations: every piece of code using those classes will see your changes. It's "anti-social behavior" in the context of code sharing and reuse.
641              
642             The solution is to subclass not just the single class whose behavior is to be altered, but rather to create an entirely separate namespace for a full hierarchy of classes within which you can make your changes in isolation. This is called a "private library," and the L<Rose::HTML::Objects> class contains methods for creating one, either dynamically in memory, or on disk in the form of actial C<*.pm> Perl module files.
643              
644             Let's try the example above again, but this time using a private library. We will use the the L<make_private_library|/make_private_library> class method to do this. The reference documentation for this method appears below, but you should get a good idea of its functionality by reading the usage examples here.
645              
646             First, let's create an in-memory private library to contain our changes. The L<make_private_library|/make_private_library> method accepts a hash of class name/code pairs containing customizations to be incorporated into one or more of the classes in the newly created private library. Let's use the C<My::> prefix for our private library. Here's a hash containing just our custom code:
647              
648             %code =
649             (
650             'My::HTML::Form::Field::Option' => <<'EOF',
651             sub bark
652             {
653             print "woof!\n";
654             }
655             EOF
656             );
657              
658             Note that the code is provided as a string, not a code reference. Be sure to use the appropriate quoting mechanism (a single-quoted "here document" in this case) to protect your code from unintended variable interpolation.
659              
660             Next, we'll create the private library in memory:
661              
662             Rose::HTML::Objects->make_private_library(in_memory => 1,
663             prefix => 'My::',
664             code => \%code);
665              
666             Now we have a full hierarchy of C<My::>-prefixed classes, one for each public C<Rose::> class in the L<Rose::HTML::Objects> distribution. Let's try the problematic code from earlier, this time using one of our new classes.
667              
668             $color =
669             My::HTML::Form::Field::PopUpMenu->new(
670             name => 'color',
671             options => [ 'red', 'green', 'blue' ]);
672              
673             $option = $color->option('red');
674              
675             $option->bark; # woof!
676              
677             Success! Of course, this dynamic in-memory class creation is relatively heavyweight. It necessarily has to have all the classes in memory. Creating a private library on disk allows you to load only the classes you need. It also provides an easier means of making your customizations persistent. Editing the actual C<*.pm> files on disk means that your changes can be tracked on a per-file basis by your version control system, and so on. We can still use the C<%code> hash from the in-memory example to "seed" the classes; the L<make_private_library|/make_private_library> method will insert our custom code into the initial C<*.pm> files it generates.
678              
679             To create a private library on disk, we need to provide a path to the directory where the generated files will be placed. The appropriate directory hierarchy will be created below it (e.g., the path to the C<My::HTML::Form> Perl module file will be C<My/HTML/Form.pm>, starting beneath the specified C<modules_dir>). Let's do it:
680              
681             Rose::HTML::Objects->make_private_library(
682             modules_dir => '/home/john/lib',
683             prefix => 'My::',
684             code => \%code);
685              
686             To actually use the generated modules, we must, well, C<use> (or C<require>) them. We must also make sure the specified C<modules_dir> is in our L<@INC|perlvar/@INC> path. Example:
687              
688             use lib '/home/john/lib';
689              
690             use My::HTML::Form::Field::PopUpMenu;
691              
692             $color =
693             My::HTML::Form::Field::PopUpMenu->new(
694             name => 'color',
695             options => [ 'red', 'green', 'blue' ]);
696              
697             $option = $color->option('red');
698              
699             $option->bark; # woof!
700              
701             And it works. Note that if the call to L<make_private_library|/make_private_library> that creates the Perl module files on disk was in the same file as the code above, the C<My::HTML::Form::Field::PopUpMenu> class would have to be C<require>d rather than C<use>d. (All C<use> statements are evaluated at compile time, but the C<My::HTML::Form::Field::PopUpMenu> class is not created until the L<make_private_library|/make_private_library> call is executed, which happens at runtime in this example.)
702              
703             One final example. Suppose you want to add or override a method in I<all> HTML object classes within your private library. To facilitate this, the L<make_private_library|/make_private_library> method will create a mix-in class which will be placed at the front of the inheritence chain (i.e., the first item in the C<@ISA> array) of all generated subclasses. Given a prefix of C<My::> as in the example above, this custom class will be called C<My::HTML::Object::Custom>. It comes pre-populated with an initial set of private-library-wide information such as the L<object_type_class mapping|Rose::HTML::Object/object_type_classes> and the L<default_localizer|Rose::HTML::Object/default_localizer> (all of which will be populated with your C<My::*> subclasses, naturally). Simply add your own methods to this module:
704              
705             package My::HTML::Object::Custom;
706             ...
707             sub chirp
708             {
709             print "tweet!\n";
710             }
711              
712             Now the C<chirp()> method will appear in all other HTML object classes in your private library.
713              
714             # It's everwhere!
715             My::HTML::Link->can('chirp'); # true
716             My::HTML::Form::Field::Date->can('chirp'); # true
717             My::HTML::Form::Field::CheckboxGroup->can('chirp'); # true
718             ...
719              
720             I hope this demonstrates the motivation for and utility of private libraries. Please see the L<make_private_library|/make_private_library> documentation for a more information on this method.
721              
722             =head1 LOCALIZATION
723              
724             There are several components of L<Rose::HTML::Object>'s localization system: the L<message|Rose::HTML::Object::Message::Localized> and L<error|Rose::HTML::Object::Error> objects, the classes that L<manage|Rose::HTML::Object::Messages> L<them|Rose::HTML::Object::Errors>, and of course the L<localizer|Rose::HTML::Object::Message::Localizer> itself. Using a L<private library|/"PRIVATE LIBRARIES">, you get your own private subclasses of all of these. This is extremely important for several reasons, and you should definitely read the L<PRIVATE LIBRARIES|/"PRIVATE LIBRARIES"> section above before continuing.
725              
726             The most important actor in the localization process is, predictably, the L<localizer|Rose::HTML::Object::Message::Localizer>, and the most important aspect of the localizer is the way in which it's accessed.
727              
728             The general approach is that each object that is or contains something that needs to be localized has a C<localizer()> method through which it accesses its L<localizer|Rose::HTML::Object::Message::Localizer> object. These methods check for a local localizer object attribute, and if one is not found, the method looks "up the chain" until it finds one. The chain may include parent objects or class hierarchies. Eventually, the assumption is that a localizer will be found and returned.
729              
730             In the most granular case, this allows each localized object to have its own individual localizer. In the more common (and default) case, there is a single localizer object camped out at some higher point in the chain of lookups, and this localizer serves all objects.
731              
732             The default localizer class, L<Rose::HTML::Object::Message::Localizer>, reads localized message text from the C<__DATA__> sections of the Perl module files that make up the L<Rose::HTML::Objects> distribution. This is done mostly because it's the most convenient way to include the "built-in" localized message text in this CPAN module distribution. (See the L<Rose::HTML::Object::Message::Localizer> documentation for more information.) Localized message text is stored in memory within the localizer object itself.
733              
734             You can change both the source and storage of localized message text by creating your own localizer subclass. The key, of course, is to ensure that your localizer subclass is used instead the default localizer class by all objects. Thankfully, the creation of a L<private library|/"PRIVATE LIBRARIES"> takes care of that, both creating a localizer subclass and ensuring that it is accessible everywhere.
735              
736             Here's a simple example of a customized localizer that overrides just one method, L<get_localized_message_text|Rose::HTML::Object::Message::Localizer/get_localized_message_text>, to add three stars C<***> around the built-in message text.
737              
738             sub get_localized_message_text
739             {
740             my($self) = shift;
741              
742             # Get message text using the default mechanism
743             my $text = $self->SUPER::get_localized_message_text(@_);
744              
745             # Bail out early if no text is defined
746             return $text unless(defined $text);
747              
748             # Surround the text with stars and return it
749             return "*** $text ***";
750             }
751              
752             This is a silly example, obviously, but it does demonstrate how easy it is to alter the default behavior. A more useful example might be to look elsewhere for a message first, then fall back to the default mechanism. This requires actually unpacking the method arguments (as opposed to simply passing them on to the superclass call in the example above), but is otherwise not much more complex:
753              
754             sub get_localized_message_text
755             {
756             my($self) = shift;
757              
758             my %args = @_;
759              
760             my $id = $args{'id'};
761             my $name = $args{'name'};
762             my $locale = $args{'locale'};
763             my $variant = $args{'variant'};
764              
765             # Look elsewhere for this localized text: in a database, pull
766             # from a server, an XML file, whatever.
767             $text = ...
768              
769             return $text if($defined $text); #
770              
771             # Fall back to the default mechanism
772             return $self->SUPER::get_localized_message_text(@_);
773             }
774              
775             By overriding this and othr methods in the L<Rose::HTML::Object::Message::Localizer> class, your localizer subclass could choose to entirely ignore the default mechanism for localized text storage and retrieval.
776              
777             Here's an example of a new L<field|Rose::HTML::Form::Field> subclass that uses localized messages and errors. It will use the default localized text mechanism to the sake of simplicity (i.e., text stored in C<__DATA__> sections of Perl modules). It's a "nickname" field intended to be used as part of a localized form that asks for user information. For the sake of demonstrating validation, let's say we've decided that nicknames may not contain space characters.
778              
779             The first step is to define our L<message|Rose::HTML::Object::Messages> and L<error|Rose::HTML::Object::Errors> ids. These should be added to the generated C<My::HTML::Object::Messages> and C<My::HTML::Object::Errors> classes, respectively. You can do this during private library generation by adding to the C<code> hash passed to the L<make_private_library|/make_private_library> call, or by editing the generated files on disk. (The relevant sections are indicated with comments that L<make_private_library|/make_private_library> will place in the generated C<*.pm> files.) First, the message ids:
780              
781             package My::HTML::Object::Messages;
782             ...
783             # Field labels
784             use constant FIELD_LABEL_NICKNAME => 100_000;
785             ...
786              
787             # Field errors
788             use constant FIELD_ERROR_BAD_NICKNAME => 101_000;
789             ...
790              
791             Now the error ids. Note that the error and message id numbers for each error message (just C<FIELD_ERROR_BAD_NICKNAME> in this case) should be the same in order to take advantage of the default behavior of the L<message_for_error_id|Rose::HTML::Object/message_for_error_id> method.
792              
793             package My::HTML::Object::Errors;
794             ...
795             # Field errors
796             use constant FIELD_ERROR_BAD_NICKNAME => 101_000;
797             ...
798              
799             Finally, the nickname field class itself. Note that it inherits from and uses classes from our private library, not from C<Rose::>.
800              
801             package My::HTML::Form::Field::Nickname;
802              
803             # Import message and error ids. Note that just the error id for
804             # FIELD_LABEL_NICKNAME is imported, not the message id. That's
805             # because we're using it as an error id below, passing it as an
806             # argument to the error_id() method.
807             use My::HTML::Object::Messages qw(FIELD_LABEL_NICKNAME);
808             use My::HTML::Object::Errors qw(FIELD_ERROR_BAD_NICKNAME);
809              
810             # Inherit from our private library version of a text field
811             use base qw(My::HTML::Form::Field::Text);
812              
813             sub init
814             {
815             my($self) = shift;
816              
817             # Set the default label before calling through to the superclass
818             $self->label_id(FIELD_LABEL_NICKNAME);
819              
820             $self->SUPER::init(@_);
821             }
822              
823             sub validate
824             {
825             my($self) = shift;
826              
827             # Do the default validation first
828             my $ret = $self->SUPER::validate(@_);
829             return $ret unless($ret);
830              
831             #
832             # Do our custom validation
833             #
834              
835             my $nick = $self->internal_value;
836              
837             # Nicknames may not contain space characters
838             if($nick =~ /\s/)
839             {
840             # Remember, the error_label falls back to the label if no
841             # explicit error_label is set. (And we set a default
842             # label_id in init() above.)
843             my $label = $self->error_label;
844              
845             # Pass the (also localized!) label as a parameter to this error.
846             # See the actual localized text in the __DATA__ section below.
847             $self->error_id(FIELD_ERROR_BAD_NICKNAME, { label => $label });
848             return 0;
849             }
850              
851             return 1;
852             }
853              
854             # Standard technique for conditionally loading all localized message
855             # text from the __DATA__ section below using the default localizer.
856             # (Alternately, you could remove the conditional and always load all
857             # the localized message text when this module is loaded.)
858             if(__PACKAGE__->localizer->auto_load_messages)
859             {
860             __PACKAGE__->localizer->load_all_messages;
861             }
862              
863             1;
864              
865             __DATA__
866              
867             [% LOCALE en %]
868              
869             FIELD_LABEL_NICKNAME = "Nickname"
870             FIELD_ERROR_BAD_NICKNAME = "[label] may not contain space characters."
871              
872             [% LOCALE fr %]
873              
874             FIELD_LABEL_NICKNAME = "Surnom"
875             FIELD_ERROR_BAD_NICKNAME = "[label] mai de ne pas contenir des espaces."
876              
877             (Sorry for the bad French translations. Corrections welcome!)
878              
879             Finally, let's map the new nickname field class to its own field type name:
880              
881             package My::HTML::Form;
882             ...
883             # Add new field type class mappings
884             __PACKAGE__->add_field_type_classes
885             (
886             nickname => 'My::HTML::Form::Field::Nickname',
887             ...
888             );
889              
890             Here it is in action:
891              
892             $field = My::HTML::Form::Field::Nickname->new(name => 'nick');
893             $field->input_value('bad nickname');
894             $field->validate;
895              
896             print $field->error; # "Nickname may not contain space characters."
897              
898             $field->locale('fr');
899              
900             print $field->error; # "Surnom mai de ne pas contenir des espaces."
901              
902             Of course, you'll rarely instantiate a field in isolation. It will usually be part of a L<form|Rose::HTML::Form>. Similarly, you will rarely set the L<locale|Rose::HTML::Object/locale> of a field directly. Instead, you will set the locale of the entire form and let the fields use that locale, accessed through the delegation chain searched when the L<locale|Rose::HTML::Object/locale> method is called on a field object. Example:
903              
904             $form = My::HTML::Form->new;
905             $form->add_fields(nick => { type => 'nickname' });
906              
907             $form->params(nick => 'bad nickname');
908             $form->validate;
909              
910             # "Nickname may not contain space characters."
911             print $form->field('nick')->error;
912              
913             $form->locale('fr');
914              
915             # "Surnom mai de ne pas contenir des espaces."
916             print $form->field('nick')->error;
917              
918             Or you could set the locale on the localizer itself for a similar effect.
919              
920             Also note the use of the label within the "bad nickname" error message. In general, incorporating (independently set, remember) labels into messages like this tends to lead to translation issues. (Is the label masculine? Feminine? Singular? Dual? Plural? Etc.) I've done so here to demonstrate that one localized message can be incorporated into another localized message, with both dynamically matching their locales based on the locale set higher up in the object hierarchy.
921              
922             =head1 CLASS METHODS
923              
924             =over 4
925              
926             =item B<make_private_library PARAMS>
927              
928             Create a comprehensive collection of C<Rose::HTML::*> subclasses, either in memory or as C<*.pm> files on disk, in order to provide a convenient and isolated location for your customizations. Please read the L<private libraries|/"PRIVATE LIBRARIES"> section above for more information.
929              
930             Valid PARAMS name/value pairs are:
931              
932             =over 4
933              
934             =item B<class_filter CODEREF>
935              
936             A reference to a subroutine that takes a C<Rose::HTML::*> class name as its argument and returns true if a subclass should be created for this class, false otherwise. The class name will also be available in C<$_>. If this parameter is omitted, all classes are subclassed.
937              
938             =item B<code HASHREF>
939              
940             A reference to a hash containing code to be added to subclasses. The keys of the hash are the subclass class names (i.e., the names I<after> the application of the C<rename> code or the C<trim_prefix>/C<prefix> processing).
941              
942             The value for each key may be either a string containing Perl code or a reference to a hash containing a C<code> key whose value is a string containing Perl code and a C<filter> key whose value is a reference to a subroutine used to filter the code.
943              
944             The C<filter> subroutine will be passed a reference to a scalar containing the full Perl code for a subclass and is expected to modify it directly. The Perl code will also be available in C<$_>. Example:
945              
946             code =>
947             {
948             'My::HTML::Object' => <<'EOF', # code string argument
949             sub my_method
950             {
951             # ...
952             }
953             EOF
954             'My::HTML::Form' =>
955             {
956             filter => sub { s/__FOO__//g },
957             code => <<'EOF',
958             sub my_other_method__FOO__
959             {
960             # ...
961             }
962             EOF
963             },
964             },
965              
966             This will create C<my_method()> in the C<My::HTML::Object> class and, with the C<__FOO__> removed, C<my_other_method()> will be created in the C<My::HTML::Form> class.
967              
968             Note that the use of this parameter is optional. You can always add your code to the Perl module files after they've been generated, or add your code directly into memory after the classes have been created C<in_memory>.
969              
970             =item B<code_filter CODEREF>
971              
972             A reference to a subroutine used to filter the Perl code for all generated subclasses. This filter will run before any subclass-specific C<filter> (see the C<code> parameter above for an explanation). This subroutine will be passed a reference to a scalar containing the Perl code and is expected to modify it directly. The Perl code will also be available in C<$_>.
973              
974             =item B<debug INT>
975              
976             Print debugging output to STDERR if INT is creater than 0. Higher numbers produce more output. The maximum useful value is 3.
977              
978             =item B<in_memory BOOL>
979              
980             If true, the classes that make up the private library will be compiled in memory. If false (the default), then a C<modules_dir> must be provided.
981              
982             =item B<modules_dir PATH>
983              
984             The path to the directory under which all C<*.pm> Perl module files will be created. The modules will be created in the expected tree structure. For example, the C<My::HTML::Object> class will be in the file C<My/HTML/Object.pm> beneath the C<modules_dir> PATH. This parameter is ignored if the C<in_memory> parameter is passed.
985              
986             =item B<overwrite BOOL>
987              
988             If true, overwrite any existing files that are located at the same paths as files created by this method call. This option is not applicable if the C<in_memory> parameter is passed.
989              
990             =item B<prefix STRING>
991              
992             The class name prefix with which to replace the C<trim_prefix> in all subclass class names. For example, a C<prefix> value of C<My::> combined with the (default) C<trim_prefix> of C<Rose::> would take a class named C<Rose::HTML::Whatever> and produce a subclass named C<My::HTML::Whatever>. You must pass this parameter or the C<rename> parameter.
993              
994             =item B<rename CODEREF>
995              
996             A reference to a subroutine that takes a C<Rose::HTML::*> class name as its argument and returns an appropriate subclass name. The name argument is also available in the C<$_> variable, enabling code like this:
997              
998             rename => sub { s/^Rose::/Foo::/ },
999              
1000             You must pass this parameter or the C<prefix> parameter.
1001              
1002             =item B<trim_prefix STRING>
1003              
1004             The prefix string to be removed from each C<Rose::HTML::*> class name. This parameter is only relevant when the C<prefix> parameter is passed (and the C<rename> parameter is not). Defaults to C<Rose::> if this parameter is not passed.
1005              
1006             =back
1007              
1008             =back
1009              
1010             =head1 DEVELOPMENT POLICY
1011              
1012             The L<Rose development policy|Rose/"DEVELOPMENT POLICY"> applies to this, and all C<Rose::*> modules. Please install L<Rose> from CPAN and then run C<perldoc Rose> for more information.
1013              
1014             =head1 SUPPORT
1015              
1016             Any L<Rose::HTML::Objects> questions or problems can be posted to the L<Rose::HTML::Objects> mailing list. To subscribe to the list or search the archives, go here:
1017              
1018             L<http://groups.google.com/group/rose-html-objects>
1019              
1020             Although the mailing list is the preferred support mechanism, you can also email the author (see below) or file bugs using the CPAN bug tracking system:
1021              
1022             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-HTML-Objects>
1023              
1024             There's also a wiki and other resources linked from the Rose project home page:
1025              
1026             L<http://rosecode.org>
1027              
1028             =head1 CONTRIBUTORS
1029              
1030             Tom Heady, Cees Hek, Kevin McGrath, Denis Moskowitz, RJBS, Jacques Supcik, Uwe Voelker
1031              
1032             =head1 AUTHOR
1033              
1034             John C. Siracusa (siracusa@gmail.com)
1035              
1036             =head1 LICENSE
1037              
1038             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.