Author: dylan
Date: 2004-12-28 19:12:12 -0500 (Tue, 28 Dec 2004)
New Revision: 440
Added:
trunk/web/bin/fixhtml
trunk/web/bin/tt
Modified:
trunk/web/Makefile
trunk/web/clients/index.thtml
Log:
Works, almost.
Modified: trunk/web/Makefile
===================================================================
--- trunk/web/Makefile 2004-12-28 23:06:38 UTC (rev 439)
+++ trunk/web/Makefile 2004-12-29 00:12:12 UTC (rev 440)
@@ -1,12 +1,18 @@
-GDEPENDS = inc/init inc/config
+T = templates
+GDEPENDS = $T/init $T/config
PERL5LIB = ./lib
-TTFLAGS = -I inc -P init -P config
+TTFLAGS = -I $T -P init -P config
+FIXFLAGS = -vR
+RSYNCFLAGS = -vaz --exclude '.svn'
+TIDYFLAGS = -q
+
TT = ./bin/tt
FIX = ./bin/fixhtml
+RSYNC = rsync
TIDY = tidy
VALIDATE = validate
@@ -30,7 +36,6 @@
upload:
echo "TODO"
-
clean:
rm -vf $(targets)
@@ -38,18 +43,19 @@
validate $(html)
-%.tmp: %.thtml $(DEPENDS) $(GDEPENDS)
+%.tmp: %.thtml
@echo "TT $<"
@$(TT) $(TTFLAGS) $< > $@
+ @echo "FIX $@"
+ @$(FIX) $(FIXFLAGS) $@
+
-
%.html: %.tmp
- @echo "TIDY $<"
- @$(TIDY) -q $< > $@
- @echo "FIX $@"
- @$(FIX) -R $@
+ @echo "TIDY $@"
+ @$(TIDY) $(TIDYFLAGS) $< > $@
+
%.css: %.tcss $(GDEPENDS)
@echo "TT $<"
@$(TT) $(TTFLAGS) $< > $@
Added: trunk/web/bin/fixhtml
===================================================================
--- trunk/web/bin/fixhtml 2004-12-28 23:06:38 UTC (rev 439)
+++ trunk/web/bin/fixhtml 2004-12-29 00:12:12 UTC (rev 440)
@@ -0,0 +1,201 @@
+#!/usr/bin/perl
+# FiXHTML.pl - does various things to XHTML files.
+# Copyright (C) 2003 Dylan William Hardison.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+use strict;
+use warnings;
+use File::Spec;
+use File::Basename;
+use Getopt::Long;
+use XML::DOM;
+use Image::Size;
+use Fatal qw(:void open close);
+Getopt::Long::Configure('gnu_getopt');
+
+my $parser = new XML::DOM::Parser;
+my %opt = (
+ verbose => 0,
+ root => '/',
+ pattern => '/',
+ base => '.',
+ relative => 0,
+ extension => 1,
+);
+
+GetOptions(\%opt,
+ 'root|r=s',
+ 'base|b=s',
+ 'pattern|p=s',
+ 'relative|R',
+ 'verbose|v+',
+ 'extension|ext!',
+);
+
+foreach my $file (@ARGV) {
+ die "$file is an absolute path!" if
File::Spec->file_name_is_absolute($file);
+
+ warn "Parsing $file.\n" if $opt{verbose} > 0;
+
+ my $in;
+ open $in, $file;
+ undef $/;
+ $_ = readline $in;
+ close $in;
+
+ if (s/<!--\s*?fix:\s*?(.+)\s*?:\s*?-->//) {
+ my %o = split(/\s*[,=]\s*/, $1);
+ foreach my $k (keys %o) {
+ $opt{$k} = $o{$k};
+ }
+ if (not $opt{root}) {
+ $opt{root}='';
+ }
+ }
+ s{//<!\[CDATA\[\n}{<!--\n}sg;
+ s{//\]\]>\n}{// -->}sg;
+
+ my $doc = $parser->parse($_);
+
+ warn "Fixing <a> tags.\n" if $opt{verbose} > 0;
+ foreach my $tag ($doc->getElementsByTagName('a', 1)) {
+ fix_href($tag, $file);
+ }
+
+ warn "Fixing <link> tags.\n" if $opt{verbose} > 0;
+ foreach my $tag ($doc->getElementsByTagName('link', 1)) {
+ fix_href($tag, $file);
+ }
+
+ warn "Fixing <img> tags.\n" if $opt{verbose} > 0;
+ foreach my $tag ($doc->getElementsByTagName('img', 1)) {
+ fix_img($tag, $file);
+ }
+
+ warn "Fixing <script> tags.\n" if $opt{verbose} > 0;
+ foreach my $tag ($doc->getElementsByTagName('script', 1)) {
+ fix_script($tag, $file);
+ }
+
+ open my $fh, ">$file" or die "Can't open $file for writing: $!";
+ print $fh $doc->toString, "\n";
+ close $fh;
+}
+
+
+sub fix_href {
+ my ($tag, $file) = @_;
+
+ if (my $href = $tag->getAttribute('href')) {
+ $href = rewrite_url($href, $file);
+ $tag->setAttribute(href => $href);
+ }
+}
+
+sub fix_script {
+ my ($tag, $file) = @_;
+
+ if (my $src = $tag->getAttribute('src')) {
+ $src = rewrite_url($src, $file);
+ $tag->setAttribute(src => $src);
+ }
+}
+
+sub fix_img {
+ my ($tag, $file) = @_;
+
+ my ($width, $height) = ($tag->getAttribute('width'),
$tag->getAttribute('height'));
+ my $src = $tag->getAttribute('src');
+ $tag->setAttribute(src => rewrite_url($src, $file));
+
+ unless ($width and $height) {
+ my $imgfile = get_file_from_src($src, $file);
+ if ($imgfile) {
+ my ($w,$h) = imgsize($imgfile);
+ $tag->setAttribute(width => $w);
+ $tag->setAttribute(height => $h);
+ }
+ }
+}
+sub rewrite_url {
+ my ($url, $file) = @_;
+
+ if (not $opt{relative}) {
+ $url =~ s!^$opt{pattern}!$opt{root}!;
+ return $url;
+ } else {
+ # ignore
+ return $url unless $url =~ m!^/!;
+ my $dirs;
+ (undef, $dirs, undef) = File::Spec::Unix->splitpath($file);
+ my $ret;
+ if ($url eq "/$dirs") {
+ $ret = '.';
+ } else {
+ $ret = File::Spec::Unix->abs2rel($url, "/$dirs");
+ }
+ if ($opt{verbose}) {
+ print STDERR "f($url. /$dirs) == $ret\n";
+ }
+ if (not ref) {
+ $ret = "#";
+ }
+ return $ret;
+ }
+
+}
+
+sub get_file_from_src {
+ my ($src, $page) = @_;
+ return undef if $src =~ m!^(https?|ftp|mailto|news):!;
+
+ my $file = do {
+ if ($src =~ m!^/!s) {
+ my $file = '.' . $src;
+ if (not -e $file) {
+ (glob("$file.*"))[0] || $file;
+ } else {
+ $file;
+ }
+ } else {
+ File::Spec->abs2rel(
+ File::Spec->catfile(dirname(File::Spec->rel2abs($page)),
$src));
+ }
+ };
+ if (not $opt{ext}) {
+ $file =~ s/\.\w+$//;
+ }
+
+ return $file;
+}
+
+
+BEGIN {
+ XML::DOM::setTagCompression( sub {
+ my ($tag, $elem) = @_;
+
+ # Print empty br, hr and img tags like this: <br />
+ return 2 if $tag =~ /^(br|hr|img|meta|link)$/;
+
+ # Print other empty tags like this: <empty></empty>
+ return 1;
+ }
+ );
+}
+
+__END__
+=head1 NAME
+
+TODO
Property changes on: trunk/web/bin/fixhtml
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/web/bin/tt
===================================================================
--- trunk/web/bin/tt 2004-12-28 23:06:38 UTC (rev 439)
+++ trunk/web/bin/tt 2004-12-29 00:12:12 UTC (rev 440)
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+ if 0; # not running under some shell
+use strict;
+use warnings;
+use Template;
+use Getopt::Long 'GetOptions';
+
+my %opt = (
+ help => 0,
+ define => { },
+ 'pre-process' => [],
+ 'include' => ['.'],
+);
+
+Getopt::Long::Configure('gnu_getopt');
+GetOptions(\%opt,
+ 'help|h',
+ 'define|d|D=s',
+ 'include|I=s@',
+ 'pre-process|P=s@',
+);
+
+printhelp() if $opt{help};
+
+my $template = new Template(
+ {
+ ABSOLUTE => 1,
+ RELATIVE => 1,
+ INCLUDE_PATH => $opt{include},
+ PRE_PROCESS => $opt{'pre-process'},
+ POST_CHOMP => 1,
+ TRIM => 1,
+ EVAL_PERL => 1,
+ INTERPOLATE => 1,
+ },
+);
+
+my @files = @ARGV;
+
+unless (@files) {
+ push @files, '-';
+}
+foreach my $file (@files) {
+ if ($file eq '-') {
+ $file = \*STDIN;
+ }
+
+ $template->process($file, $opt{define})
+ or die $template->error();
+}
+
+sub printhelp {
+ print <<HELP;
+Usage: tpage [options] [files]
+
+Options:
+ --help (-h) : display this message.
+ --define var=val (-d,-D) : define template "var" to "value".
+ --include=path (-I) : append "path" to the TT include path.
+ --pre-process=file (-P) : append "file" to the list of preprocessed files.
+HELP
+
+ exit 0;
+}
Property changes on: trunk/web/bin/tt
___________________________________________________________________
Name: svn:executable
+ *
Modified: trunk/web/clients/index.thtml
===================================================================
--- trunk/web/clients/index.thtml 2004-12-28 23:06:38 UTC (rev 439)
+++ trunk/web/clients/index.thtml 2004-12-29 00:12:12 UTC (rev 440)
@@ -1,7 +1,7 @@
[% META
title = 'Haver Clients'
author = 'Dylan Hardison'
- date = '2004-05-31'
+ date = '2004-12-28'
%]
[% WRAPPER "page" %]
