File Coverage

blib/lib/HTML/DWT.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package HTML::DWT;
#############################################################
#  Version 2.08
#
#  Copyright (c) 2002 by S.D. Campbell
#
#  Created 03 March 2000; Revised 04 March  2002 by SDC
#
#  A perl module designed to parse a simple HTML template file
#  generated by Macromedia Dreamweaver and replace fields in the
#  template with values from a CGI script.
#
#############################################################
#  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., 675 Mass Ave, Cambridge, MA 02139, USA.
#############################################################

use Exporter;
use Carp;
use File::Find;
use File::Basename;
use XML::Simple;

@ISA = qw(Exporter);
@EXPORT = qw(fillTemplate fill export);
@EXPORT_OK = qw(output param query clear_params);
%EXPORT_TAGS = (
	Template => [qw(output param query clear_params)],
	);

use strict;
use vars qw($errmsg $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
	    $NOTICE %DWT_FIELDS %DWT_VALUES $fname $filepath @search);

$VERSION = '2.08';

$NOTICE = "\n\t\t\n";
$NOTICE .= "\t\n";
$NOTICE .= "\t\n";
$NOTICE .= "\t\n";
$NOTICE .= "\n";

%DWT_FIELDS = ();
%DWT_VALUES = ();

$errmsg = "";
$fname = '';
$filepath = '';
@search = ();

#############################################################
# new
#
#  The constructor for the class.  Requires a HTML Template
#  filename.  Returns a reference to the new object or undef
#  on error.  Errors can be retrieved from $HTML:DWT:errmsg.

sub new {
    my $class = shift;
    my %params = @_;


    my $self = {};

    if (!$params{filename}){
	$params{filename} = $_[0];
    }

    $$self{filename} = $params{filename};
    $$self{option} = $params{option};
    $$self{template} = '';
    $$self{filter} = $params{filter};

    if (exists($params{case_sensitive})){
    	$$self{case_sensitive} = $params{case_sensitive};
    } else {
    	$$self{case_sensitive} = 0;
    }

    if (exists($params{no_includes})){
    	$$self{no_includes} = $params{no_includes};
    } else {
    	$$self{no_includes} = 0;
    }

    if (exists($params{associate})){
	if (ref($params{associate}) ne 'ARRAY') {
    		$$self{associate} = [ $params{associate} ];
    	}
    	$$self{associate} = $params{associate};
    } else {
	$$self{associate} = undef;
    }

	if (exists($params{xml})){
    		$$self{xml} = $params{xml};
    } else {
	$$self{xml} = undef;
    }


    if (exists($params{path})){
	if (ref($params{path}) ne 'ARRAY') {
    		$$self{path} = [ $params{path} ];
    	}
    	$$self{path} = $params{path};
    } else {
	$$self{path} = './';
    }

    foreach my $path ($$self{path}){
    	push @search, $path;
    }

    if ($ENV{'HTML_TEMPLATE_ROOT'}) {
    	my $temproot = $ENV{'HTML_TEMPLATE_ROOT'};
	push @search, $temproot;
    }

    if ($ENV{'DOCUMENT_ROOT'}) {
    	my $docroot = $ENV{'DOCUMENT_ROOT'};
	push @search, $docroot;
    }


    if (substr($$self{filename}, 0, 1) ne '/') {
    	$fname = $$self{filename};
	foreach my $dir (@search){
	    	find(\&_wanted, $dir);
	}
	if (!$filepath) {
		$filepath = $$self{filename};
	}
    } elsif (substr($$self{filename}, 0, 10) eq '/Templates') {
    	my ($name, $path, $suffix) = fileparse($$self{filename}, '\.dwt');
	$fname = $name . $suffix;
	foreach my $dir (@search){
	    	find(\&_wanted, $dir);
	}
	if (!$filepath) {
		$filepath = $$self{filename};
	}
    } else {
    	$filepath = $$self{filename};
    }

    unless(open(TEMPLATE_FILE, $filepath)){
	$errmsg = "HTML::DWT--Template File $filepath not opened: $!\n";
	return undef;
    }

    while(){
	$$self{template} .= $_;
    }

    $$self{html} = $$self{template};
    $$self{html} =~ s//_beginTemplate($$self{filename})/ie;
    $$self{html} =~ s/<\/html>/_endTemplate()/ie;
    $$self{html} =~ s/?/_quoteReplace($1)/ieg;

    bless $self, $class;

	if (exists($$self{associate}) || exists($$self{xml})){
		$self->_load();
	}

    return $self;
}

#############################################################
# clear_params
#
#  A subroutine which clears the values of all template
#  parameters.

sub clear_params {
    my $self = shift;
    foreach my $key (keys %DWT_VALUES){
		$DWT_VALUES{$key} = undef;
	}
}


#############################################################
# fill
#
#  A subroutine for parsing and replacing key values in an
#  HTML Template.  Takes a reference to a hash containing the
#  key/value pairs.  Returns the parsed HTML.  Calls param()
#  for actual substitution as of version 2.05.

sub fill {
    my $self = shift;
    my $cont = shift;

    $self->param(%$cont);
    return $self->output();
}

#############################################################
# fillTemplate
#
#  Calls fill() for backwards compatibility with earlier versions.

sub fillTemplate {

    my $self = shift;
    my $cont = shift;

    $self->fill($cont);

}

#############################################################
# output
#
#  Returns the substituted HTML as generated by fill() or
#  param().  For compatibility with HTML::Template.

sub output {
    my $self = shift;
	my %params = @_;

    if ($$self{case_sensitive} == 1){
    	foreach my $key (keys %DWT_VALUES) {
		$$self{html}=~s/?(.*?)/_keyReplace($DWT_VALUES{$key},$1)/egs;
    	}
    } else {
    	foreach my $key (keys %DWT_VALUES) {
		$$self{html}=~s/?(.*?)/_keyReplace($DWT_VALUES{$key},$1)/iegs;
    	}
    }

    if($$self{no_includes} == 0) {
       	$$self{html} =~ s/?/_lbiquoteReplace($1)/ieg;
    	$$self{html} =~ s/?(.*?)/_lbiInclude($1)/iegs;
    }

    if ($params{'print_to'}){
		my $print_to = $params{'print_to'};
	    print $print_to $$self{html};
		return undef;
	} else {
    	return $$self{html};
	}
}

#############################################################
# param
#
#  Take a hash of one or more key/value pairs and substitutes
#  the HTML value in the key's spot in the template.  For
#  compatibility with HTML::Template.

sub param {

    my $self = shift;

    if (scalar(@_) == 0) {
    	return keys %DWT_FIELDS;
    } elsif (scalar(@_) == 1){
    	my $field = shift;
    	return $DWT_VALUES{$field};
    } else {
		my %params = @_;
    	foreach my $key (keys %params) {
		if ($key eq 'doctitle' && !($params{$key}=~/^\s*(.*?)<\/title>/is)){
 </td>
</tr>

<tr>
<td  class="h" >
<a name="279">279</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 		    $DWT_VALUES{'doctitle'} = "<title>" . $params{$key} . "";
		} else {
		    $DWT_VALUES{$key} = $params{$key};
		}
	}
    }

}

#############################################################
# query
#
#  Allows for querying of template parameters.  For
#  compatibility with HTML::Template.

sub query {

    my $self = shift;

    if (scalar(@_) == 0) {
    	return keys %DWT_FIELDS;
    } elsif (scalar(@_) == 1){
    	my $field = shift;
    	return $DWT_FIELDS{$field};
    } else {
    	my %params = @_;
		my $cmd = shift;
		my $field = shift;

		if ($cmd eq 'name') {
			return $DWT_FIELDS{$field};
		} else {
			return undef;
		}
    }

}

#############################################################
# export
#
#  Allows for export of field values to Dreamweaver XML format
#  or another standardized XML format (see Dreamweaver 4
#  documents for more details).

sub export {

    my $self = shift;
    my %params = @_;
    my $type = $params{'type'};
    my $output = $params{'output'};
	my $print_to = $params{'print_to'};
    my $xmlcont = '';
    my $filename = '';

    $self->output();

	if (!$output) {
		$output = 'xml';
	}

    if ($type eq 'er') {
    	$xmlcont = _xmler($$self{filename});
    } else {
    	$xmlcont = _xmldw($$self{filename});
    }

    if ($output eq 'file') {
    	my $filename = $params{'filename'};
		unless(open(XML_FILE,">$filename")) {
			$errmsg = "HTML::DWT--XML File $filename not opened: $!\n";
			return undef;
		}
		print XML_FILE $xmlcont;
		close(XML_FILE);
		return $filename;
    } elsif ($output eq 'FH') {
		print $print_to "Content-type: text/xml\n\n" . $xmlcont;
		return undef;
	} else {
        return $xmlcont;
    }

}

#############################################################
# _keyReplace
#
#  An internal subroutine that does the actual key/value
#  replacement.  Takes the contents scalar and returns a
#  HTML string.

sub _keyReplace {
    my $cont = shift;
    my $key = shift;

    return "\n" . $cont . "\n\n";
}

#############################################################
# _beginTemplate
#
#  Returns the begin template string and file name back into
#  the parsed HTML.

sub _beginTemplate {
    my $filename = shift;
    return "\n\n" . $NOTICE;
}

#############################################################
# _endTemplate
#
#  Returns the end template string back into the parsed HTML.

sub _endTemplate {
    return "\n";
}

#############################################################
# _quoteReplace
#
#  An internal subroutine that removes quotes from around
#  the editable region name (fixes recursive loop bug).
#  As of version 2.06 also builds %DWT_FIELDS and %DWT_VALUES

sub _quoteReplace {
    my $key = shift;
    $DWT_FIELDS{$key} = 'VAR';
    $DWT_VALUES{$key} = undef;

    return "";
}

#############################################################
# _lbiquoteReplace
#
#  An internal subroutine that removes quotes from around
#  the library file name

sub _lbiquoteReplace {
    my $key = shift;

    return "";
}

#############################################################
# _lbiInclude
#
#  An internal subroutine that opens a Dreamweaver .lbi file
#  and returns its contents.

sub _lbiInclude {
    my $file = shift;

    if (substr($file, 0, 1) ne '/') {
    	$fname = $file;
	foreach my $dir (@search){
	    	find(\&_wanted, $dir);
	}
	if (!$filepath) {
		$filepath = $file;
	}
    } elsif (substr($file, 0, 8) eq '/Library') {
    	my ($name, $path, $suffix) = fileparse($file, '\.lbi');
	$fname = $name . $suffix;
	foreach my $dir (@search){
	    	find(\&_wanted, $dir);
	}
	if (!$filepath) {
		$filepath = $file;
	}
    } else {
    	$filepath = $file;
    }


    my $lbi = "\n";

    unless(open(LBI_FILE, $filepath)){
	$errmsg = "HTML::DWT--Included Library File $filepath not opened: $!\n";
	return $errmsg;
    }

    while(){
	$lbi .= $_;
    }

    $lbi .= "\n";

    return $lbi;
}


#############################################################
# _xmldw
#
#  An internal subroutine that generates a Dreamweaver XML
#  document for export.

sub _xmldw {
    my $filename = shift;
    my $xmlcont = "\n\n";

    foreach my $key (sort keys %DWT_FIELDS){
    	$xmlcont .= "\n";
    }

    $xmlcont .= "\n";

    return $xmlcont;
}

#############################################################
# _xmler
#
#  An internal subroutine that generates a XML export document

sub _xmler {
    my $filename = shift;
    my ($name, $path, $suffix) = fileparse($filename, '\.dwt');

    my $xmlcont = "\n<$name template=\"$filename\">\n";

    foreach my $key (keys %DWT_VALUES){
    	$xmlcont .= "<$key>";
    }

    $xmlcont .= "";

    return $xmlcont;
}

#############################################################
# _wanted
#
#  Finds the path to a file if it exists.

sub _wanted {

    /$fname$/ or return;
    $filepath = $File::Find::name;

}

#############################################################
# _load
#
#  Loads the parameters from external sources

sub _load {

    my $self = shift;

    if ($$self{associate}){
       	foreach my $query ($$self{associate}){
			foreach my $param ($query->param) {
				$self->param($param => $query->param($param));
   			}
    	}
    }

	if ($$self{xml}) {
		my $xs = new XML::Simple(keeproot => 1);
		my $ref = $xs->XMLin($$self{xml});
		my $items = $ref->{templateItems}->{item};
		foreach my $item (keys %$items){
			$self->param($item => $ref->{templateItems}->{item}->{$item}->{content});
		}

	}

}


1;
__END__