#!/usr/bin/perl use strict; use warnings; use Getopt::Long; use Cwd; use HTML::Seamstress; use File::Basename; use File::Slurp; use File::Spec; use Data::Dumper; use Pod::Usage; our $VERSION = 1.0; my ($base_pkg, $base_pkg_root); my $result = GetOptions ( 'base_pkg=s' => \$base_pkg, 'base_pkg_root=s' => \$base_pkg_root ); $base_pkg or pod2usage( -msg => "base_pkg is a required option", -exitval => 1 ); unshift @INC, $base_pkg_root if ($base_pkg_root) ; eval "require $base_pkg"; if ($@) { pod2usage( -msg => "Could not load $base_pkg: $@", -exitval => 2 ); } my $html_file = shift or pod2usage( -msg => 'Did not supply HTML file for packaging', -exitval => 2); #$html_file = basename $html_file; my $abs = File::Spec->rel2abs($html_file); my $file_regexp = qr/[.]html?/; my ($name, $path, $suffix) = fileparse($abs, $file_regexp); my $html_pkg = html_pkg($path); sub _verbose { print join('', @_); print "\n"; } sub _debug { print join('', @_); print "\n"; } sub use_lib { $base_pkg_root ? "use lib '$base_pkg_root'" : "" ; } sub relpath_to_file { substr($abs, length $base_pkg->comp_root) ; } sub template { <<'EOTEMPLATE'; package %s; # $html_pkg use strict; use warnings; %s; # use_lib use base qw(%s); # $base_pkg our $tree; #warn %s->comp_root(); # $base_pkg sub new { $tree = HTML::Seamstress->new_from_file( # $base_pkg relpath_to_file %s->comp_root() .'%s' ); $tree; } 1; EOTEMPLATE } sub fill_template { my $template = template; sprintf $template, $html_pkg, use_lib, $base_pkg, $base_pkg, $base_pkg, relpath_to_file } sub calc_outfile { my $html_file = shift; $html_file =~ s/$file_regexp/.pm/; $html_file; } sub html_pkg { my ($html_file_path) = @_; warn "comp_root........ " . $base_pkg->comp_root, $/; warn "html_file_path... " . $html_file_path, $/; warn "html_file........ " . $html_file, $/; warn "html_file sans... " . $name, $/; my $mp = substr($html_file_path, length $base_pkg->comp_root) ; $mp =~ s!/!::!g; $mp .= $name; $mp; } my $outfile = calc_outfile $html_file; open O, ">$outfile" or die $!; print O fill_template; warn "$html_file compiled to $html_pkg.\n"; =head1 NAME spkg - Create Perl packages for HTML files for HTML::Seamstress manipulation =head1 SYNOPSIS spkg [options] html_file =head1 OPTIONS =over =item * base_pkg_root $base_pkg_root The directory to add to C<@INC> so that C is found =item * base_pkg $base_pkg The base package containing a method comp_root which returns the absolute path to the HTML file to be processed. This package must be on C<@INC> and it's up to you to put it there :) Most commonly, you will have a directory layout like this: /home/metaperl/perl/src/seamstress/ctb: total 92 drwxr-xr-x 5 metaperl metaperl 4096 Oct 31 03:46 . drwxr-xr-x 10 metaperl metaperl 4096 Sep 22 01:52 .. drwxr-xr-x 4 metaperl metaperl 4096 Oct 31 03:45 HTML drwxr-xr-x 4 metaperl metaperl 4096 Sep 21 00:33 html /home/metaperl/perl/src/seamstress/ctb/HTML: total 16 drwxr-xr-x 4 metaperl metaperl 4096 Oct 31 03:45 . drwxr-xr-x 5 metaperl metaperl 4096 Oct 31 03:46 .. drwxr-xr-x 3 metaperl metaperl 4096 Oct 31 03:45 Seamstress /home/metaperl/perl/src/seamstress/ctb/HTML/Seamstress: total 20 drwxr-xr-x 3 metaperl metaperl 4096 Oct 31 03:45 . drwxr-xr-x 4 metaperl metaperl 4096 Oct 31 03:45 .. -rw-r--r-- 1 metaperl metaperl 95 Oct 31 03:17 Base.pm /home/metaperl/perl/src/seamstress/ctb/html: total 32 drwxr-xr-x 4 metaperl metaperl 4096 Sep 21 00:33 . drwxr-xr-x 5 metaperl metaperl 4096 Oct 31 03:46 .. -rw-r--r-- 1 metaperl metaperl 246 Sep 21 00:30 hello_world.html -rw-r--r-- 1 metaperl metaperl 818 Sep 21 00:30 hello_world.pm and you will call spkg like this: spkg --base HTML::Seamstress::Base html/hello_world.html Thus creating C which you can use in your Perl programs by simply typing: require html::hello_world; html::hello_world->new; creating an HTML::TreeBuilder style tree for processing. =back =head1 DESCRIPTION L