1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use Getopt::Long;
6use Cwd;
7use HTML::Seamstress;
8use File::Basename;
9use File::Slurp;
10use File::Spec;
11use Data::Dumper;
12use Pod::Usage;
13
14our $VERSION = 1.0;
15
16my $cmdline = join ' ', ($0, @ARGV);
17
18
19my ($base_pkg, $base_pkg_root, $cvs_add, $base_append);
20
21my $result = GetOptions (
22  'base_pkg:s'      => \$base_pkg,
23  'base_pkg_root:s' => \$base_pkg_root,
24  'cvs_add!'        => \$cvs_add,
25  'base_append:s'   => \$base_append,
26
27);
28
29$base_pkg ||= 'HTML::Seamstress::Base' ;
30
31unshift @INC, $base_pkg_root if ($base_pkg_root) ;
32
33eval "require $base_pkg";
34if ($@) {
35  pod2usage(
36    -msg     => "Could not load $base_pkg: $@",
37    -exitval => 2
38   );
39}
40
41
42my $comp_root = Cwd::realpath($base_pkg->comp_root);
43-d $comp_root or
44    die sprintf "$comp_root is not a directory... attempted to
45locate it via \$base_pkg->comp_root: %s", $base_pkg->comp_root;
46$comp_root =~ m!/$! or $comp_root = "$comp_root/";
47
48my $html_file = shift or pod2usage(
49  -msg     => 'Did not supply HTML file for packaging',
50  -exitval => 2);
51
52
53my $abs  = File::Spec->rel2abs($html_file);
54my $file_regexp = qr/[.]html?/;
55my ($name, $path, $suffix) = fileparse($abs, $file_regexp);
56my $html_pkg = html_pkg($path);
57
58
59sub _verbose
60{
61
62    print join('', @_);
63    print "\n";
64}
65
66sub _debug
67{
68
69    print join('', @_);
70    print "\n";
71}
72
73sub cvs_add {
74
75  my $file = shift;
76
77  my $syscmd = "cvs add $file ";
78  system $syscmd;
79
80}
81
82sub use_lib {
83  $base_pkg_root ? "use lib '$base_pkg_root'" : "" ;
84}
85
86
87sub relpath_to_file {
88  substr($abs, length $comp_root) ;
89}
90
91sub use_base_qw {
92
93  my $qw = $base_pkg;
94  $qw .= " $base_append" if $base_append;
95  $qw;
96
97}
98
99sub template {
100<<'EOTEMPLATE';
101package %s;
102
103# cmdline: %s
104
105use strict;
106use warnings;
107
108use base qw(Class::Prototyped HTML::Seamstress);
109
110
111%s;
112use base qw(%s);
113use vars qw($html);
114
115our $tree;
116
117#warn %s->comp_root();
118#%s
119
120
121#$html = __PACKAGE__->html(__FILE__ => 'html') ;
122$html = __FILE__;
123
124sub new {
125#  my $file = __PACKAGE__->comp_root() . '%s' ;
126  my $file = __PACKAGE__->html($html => 'html');
127
128  -e $file or die "$file does not exist. Therefore cannot load";
129
130  $tree =HTML::TreeBuilder->new;
131  $tree->store_declarations;
132  $tree->parse_file($file);
133  $tree->eof;
134
135  bless $tree, __PACKAGE__;
136}
137
138sub process {
139  my ($tree, $c, $stash) = @_;
140
141  use Data::Dumper;
142  warn "PROCESS_TREE: ", $tree->as_HTML;
143
144  # $tree->look_down(id => $_)->replace_content($stash->{$_})
145  #     for qw(name date);
146
147  $tree;
148}
149
150sub fixup {
151  my ($tree, $c, $stash) = @_;
152
153  $tree;
154}
155
156
157
158
1591;
160EOTEMPLATE
161}
162
163sub fill_template {
164  my $template = template;
165  sprintf $template,
166      $html_pkg,
167      $cmdline,
168      use_lib,
169	  use_base_qw, $base_pkg, $base_pkg,
170	      relpath_to_file
171
172}
173
174
175
176sub calc_outfile {
177  my $html_file = shift;
178
179  $html_file =~ s/$file_regexp/.pm/;
180  $html_file;
181}
182
183sub html_pkg {
184
185  my ($html_file_path) = @_;
186
187  warn "comp_root........ " . $comp_root, $/;
188  warn "html_file_path... " . $html_file_path, $/;
189  warn "html_file........ " . $html_file, $/;
190  warn "html_file sans... " . $name, $/;
191
192  my $mp = substr($html_file_path, length $comp_root) ;
193
194  $comp_root eq substr($html_file_path, 0, length $comp_root) or warn
195      "WARNING: the comp_root and html_file_path are not equal for the extent of comp_root...
196This may lead to incorrect calculations";
197
198  $mp =~ s!/!::!g;
199  $mp .= $name;
200  $mp;
201
202}
203
204my $outfile = calc_outfile $html_file;
205open O, ">$outfile" or die $!;
206print O fill_template;
207
208warn "$html_file compiled to package $html_pkg\n";
209
210cvs_add $outfile if $cvs_add;
211
212
213=head1 NAME
214
215 spkg - Create Perl packages for HTML files for HTML::Seamstress manipulation
216
217=head1 SYNOPSIS
218
219 spkg [options] html_file
220
221=head1 OPTIONS
222
223=over
224
225=item * base_pkg_root $base_pkg_root (optional)
226
227The directory to add to C<@INC> so that C<base_pkg> is found
228
229=item * base_append $base_append (optional)
230
231a string which will be appended to C<$base_pkg> to form the argument to C<use base qw( )>
232
233This is advanced stuff.
234
235=item * base_pkg $base_pkg (required)
236
237The base package containing a method C<comp_root> which returns the absolute
238path to the HTML file to be processed.
239
240=back
241
242=head1 DESCRIPTION
243
244L<Template> and L<HTML::Mason> both create objects which they configure with
245an C<INCLUDE_PATH> or C<comp_root>, respectively. Seamstress leverages Perl's
246standard include mechanism to find HTML files. As such, a C<base_pkg> with a
247method that will allow runtime C<require>s of such packages is needed.
248
249
250=cut
251