--funroll-slideshow Code

#! /usr/bin/perl -w
# Author	: Gautam Iyer <gautam@math.uchicago.edu>
# Created	: Wed 24 Nov 2005 10:23:55 AM CST
# Modified	: Sun 02 Oct 2005 12:44:57 PM CDT
# Licence	: GNU General Programers Licence. See the file Licence for the
#		  exact licence.

package funroll::Page;

# {{{1 Dependencies / exports
use strict;
use integer;
use Carp;
use Cwd qw(abs_path);
use File::Basename;
use File::Copy;
use File::Glob qw(:glob);
use FindBin qw($RealBin);
use Term::ANSIColor qw(:constants);

# Export the match_pair function (since others will probably find it usefull)
use Exporter 'import';
our @EXPORT = qw(Dirname merge_hash copy_obj make_base_dir slurp subst_tilde);

# Set this to something to have a bunch of debugging messages printed.
my $DEBUG;

# Stack indicating lineno / filename
my (@fstack, @lstack);

# {{{1 Constructor, init and property methods
# {{{2 new(): Constructor. If @_ is non-empty, it is passed to init()
sub new {
    my $class = shift;
    my $this = {};

    # All options matching the regexp token_copy, will also be set as tokens.
    # Be sure to set this first otherwise some tokens might not be copied!
    # token_copy	=> qr/^(firstpage|lastpage|stylesheet|\w+_prefix|shared_\w+|cwd)$/
    $this->{options}	= {};
    $this->{shared}	= {};
    $this->{lists}	= {};
    $this->{tokens}	= {};

    bless( $this, $class);

    # Call init to set all other defaults, (so that tokens get copied appropriately / etc)
    $this->init( @_) if (@_);

    return $this;
}

# {{{2 init( $hashref): Merges properties from %$hashref into %$this.
sub init {
    my ($this, $href) = @_;
    croak("Arguement to init not a hash refference") if( ref($href) ne 'HASH' );

    foreach my $key (keys(%$href)) {
	if ( ref($href->{$key}) eq 'ARRAY' ) {
	    # Treat all arrays as lists, and call set_lists
	    $this->set_list( $key, $href->{$key})
	} elsif ( ref( $href->{$key} ) eq 'HASH' ) {
	    # Treat all HSHES as a token list, and call set_tokens
	    $this->set_tokens( $href->{$key} )
	} else {
	    # Everything else is an option, and call set_option
	    $this->set_option( $key, $href->{$key} )
	}
    }

    # $this->read_template() if( exists($this->{options}{template_file}) );
}

# {{{2 set_list( $listname, \@listref ): Adds a list $listname, to the list of 'lists' in $this
sub set_list {
    my $this = shift;
    if( ref($_[0]) eq 'HASH') {
	foreach my $listname (keys( %{$_[0]})) {
	    croak "Key $listname does not correspond to an array refference in set_list" 
		if( ref($_[0]{$listname} ne 'ARRAY'));

	    $this->{lists}{$listname} = copy_obj( $_[0]{$listname});
	}
    } else {
	croak "Arguement 2 to set_list is not a Array refference" if( ref( $_[1]) ne 'ARRAY');
	$this->{lists}{$_[0]} = copy_obj($_[1]);
    }
}

# {{{2 set_option( $key, $value): Add hash key $key, with value $value;
sub set_option {
    my $this = shift;
    my ($key, $value) = @_;

    $this->{options}{$key} = $value;
}

# {{{2 set_tokens ($hashref): Merges properties from %$hashref into %$this->{tokens}.
sub set_tokens {
    my ($this, $href) = @_;
    return if( ref($href) ne 'HASH' );

    foreach my $key (keys(%$href)) {
	$this->{tokens}{$key} = $href->{$key};
    }
}

# {{{2 set_shared: Add shared files
sub set_shared {
    my $this = shift;

    my ($name, $href) = @_;

    croak( "Bad arguement $href to method set_shared") unless( defined( $href) && ref($href) eq 'HASH');
    if( defined( $name)) {
	$this->{shared}{$name} = copy_obj( $href);
    } else {
	# Merge the entire given hash into $this->{shared}
	merge_hash( $this->{shared}, $href);
    }
}

# {{{2 clean_values( $opt_href): Delete all options, tokens and shared files called undef.
# If $opt_href is supplied, then those are treated as "default" options to be merged in if undefined.
sub clean_values {
    my $this = shift;

    # Delete all options / tokens / shared attributes called undef
    foreach my $href ($this->{options}, $this->{tokens}, values( %{$this->{shared}}) ) {
	foreach my $key (keys(%$href)) {
	    delete $href->{$key} if( !defined( $href->{$key}) || $href->{$key} eq "undef");
	    # $href={} unless( ref( $href) eq 'HASH')
	}
    }

    # Delete all shared files where the name is undefined
    foreach my $sfile (keys( %{$this->{shared}})) {
	delete $this->{shared}{$sfile} unless( exists( $this->{shared}{$sfile}{name}));
    }

    # Merge default options in if specified. (If $_[0] is not a href, then merge_hash will croak).
    merge_hash( $this->{options}, $_[0], 1) if( defined( $_[0]));
}

# {{{1 File IO methods
# {{{2 resolve_outfile( $name, $+prefix)
sub resolve_outfile {
    my $this = shift;
    my ($name, $prefix, $default) = @_;

    confess("No filename") unless( defined( $name));

    # Prepend default if no prefix is specified
    $name = $default . $name if( defined( $default) && $name !~ m{^[+-./~]});

    # Honour cwd
    $name =~ s/^\+/$prefix/ if( defined( $prefix));
    $name =~ s/^\-/$this->{options}{output_dir}/;
    $name =~ s/^\.\//$this->{options}{cwd}\//
	    if( exists( $this->{options}{cwd}) && $this->{options}{cwd} ne '' );
    # $name =~ s/^\=/$RealBin/;

    return subst_tilde( $name);
}

# {{{2 resolve_infile( $name, $+prefix)
sub resolve_infile {
    my $this = shift;
    my ($name, $prefix, $default) = @_;

    confess("No filename") unless( defined( $name));
    
    # Prepend default if no prefix is specified
    $name = $default . $name if( defined( $default) && $name !~ m{^[+=./~]});

    # Source files starting with + / =
    $name =~ s/^\+/$prefix/ if( defined( $prefix));
    # $name =~ s/^\-/$this->{options}{include_dir}/;
    $name =~ s/^\=/$this->{options}{base_dir}/;
    $name =~ s/^\.\//$this->{options}{cwd}\//
	    if( exists( $this->{options}{cwd}) && $this->{options}{cwd} ne '' );

    return subst_tilde( $name);
}

# {{{2 pagename($n): Return the pagename of the $n'th page.
sub pagename {
    my ($this, $n) = @_;
    my $pagename;

    return "" unless( exists( $this->{options}{pagename}) && $this->{options}{pagename} ne '');

    ($pagename = $this->{options}{pagename}) =~ s/&pageno(;|\b)/$n/g;
    return $this->funroll_loops( $pagename, "Option pagename");
}

# {{{2 read_template( $template_file): Read file $template_file (or $this->{options}{template_file}) and return the result
sub read_template {
    my $this = shift;
    my $filename;

    $this->{options}{template_file} = shift if(@_);
    confess( "read_template() called with no template_file specified.")
	    unless( exists( $this->{options}{template_file}));

    $filename = $this->resolve_infile( $this->{options}{template_file}, $this->{options}{templates_dir});
    return slurp( $filename);
}

# {{{2 write_page( $pageno, $page): Write page $page with page number $pageno
sub write_page {
    my $this = shift;
    my ($pageno, $page) = @_;
    my $pagename = $this->pagename( $pageno);

    if( exists( $this->{options}{filter})) {
	# Write to a temp file
	open( TMPFILE, ">/tmp/tmpfile.fuss") or quit( "Unable to write to /tmp/tmpfile.fuss\n");
	print TMPFILE $page;
	close( TMPFILE);

	# Filter it through $this->{options}{filter}
	my $pipe_cmd = $this->{options}{filter};
	$pipe_cmd =~ s{(?<!\\)\%[fs]\b}{/tmp/tmpfile.fuss}g;
	$page = slurp( "$pipe_cmd|");
    }
	
    if( $pagename) {
	die( BOLD, RED, "Error. You must specify 'output_dir' unless 'pagename' is blank. Use './' for the current directory", RESET, "\n")
	    if( $this->{options}{output_dir} eq "");

	my $filename = $this->resolve_outfile( $pagename, $this->{options}{output_dir});

	print STDERR "Writing file" if( $pageno == $this->{tokens}{firstpage});
	make_base_dir( $filename);
	print STDERR GREEN, " $pagename", RESET;

	open( TEMPLATE, ">$filename") || quit( "Unable to open $filename for output.");
	print TEMPLATE $page;
	close TEMPLATE;

	print STDERR ".\n" if( $pageno == $this->{tokens}{lastpage});
    } else {
	# No pagename found, just dump to stdout
	print STDERR CYAN, $page, RESET;
    }
}

# {{{2 copy_shared(): Copy the shared files over.
sub copy_shared {
    my $this = shift;
    my ($src, $dest, $file);

    if( exists( $this->{options}{copy_shared} )) {
	print STDERR "Copying shared file ";
	foreach $file (keys %{$this->{shared}}) {
	    next if( exists( $this->{shared}{$file}{nocopy}));

	    # Get source filename
	    if( exists( $this->{shared}{$file}{src})) {
		$src = $this->{shared}{$file}{src};
	    } elsif( exists( $this->{shared}{$file}{name}) ) {
		$src = '+' . $this->{shared}{$file}{name};
	    } else {
		quit( "Shared file $file has no associated filename");
	    }

	    # Get filename
	    if( exists( $this->{shared}{$file}{dest})) {
		$dest = $this->{shared}{$file}{dest};
	    } elsif( exists( $this->{shared}{$file}{name}) ) {
		$dest = '+' . $this->{shared}{$file}{name};
	    } else {
		quit( "Shared file $file has no associated filename");
	    }

	    $dest = $this->resolve_outfile( $dest, $this->{options}{shared_outdir});
	    $src = $this->resolve_infile( $src, $this->{options}{shared_indir});

	    no integer; # Required for the file test operators
	    if( -r $src ) {
		if( -e $dest && ( -M $dest <= -M $src) ) {
		    print STDERR YELLOW, "$dest ", RESET;
		} else {
		    print STDERR (make_base_dir( $dest) && copy($src, $dest) ? GREEN : RED), "$dest ", RESET;
		}
	    } else {
		print STDERR  BOLD, RED, "$src ", RESET;
	    }
	}
	print STDERR ".\n";
    }
}

# {{{1 Page processing methods
# {{{2 get_listitem( $listname, $indexexpr, $key): Evaluates $indexexpr. Then gets $this->{lists}{$listname}[$indexexpr]{$key}
sub get_listitem {
    my ($this, $listname, $indexexpr, $key) = @_;

    my $index = $this->funroll_eval( $indexexpr);

    return ( $index < scalar(@{$this->{lists}{$listname}}) && exists( $this->{lists}{$listname}[$index]{$key} ) )
	? $this->{lists}{$listname}[$index]{$key}
	: "";
}

# {{{2 strip_prefix( $filename): Strips prefix from $filename
sub strip_prefix {
    my ($this, $filename) = @_;

    $filename =~ s/^\+|-|\.\/|=//;
    return $filename;
}

# {{{2 get_statement( $template) [NEEDS LVALUE]
sub get_statement {
    my $this = shift;
    my $template = \$_[0];

    return unless $$template =~ m/$this->{options}{statements}/g;
    my $statement = $&;

    my $head = substr( $$template, 0, pos( $$template) - length( $statement));

    # Let's cound the lineno
    countlines( substr( $$template, 0, pos( $$template)));
    $$template = substr($$template, pos( $$template));
    return ( $head, $statement);
}

# {{{2 get_elseif( $template)
sub get_elseif  {
    my $this = shift;
    my ($template, $prev_expr) = @_;
    my $expr;

    my $level = 1;

    while( $template =~ m/$this->{options}{if_regexps}/g ) {
	$expr = $&;
	if	( $expr =~ $this->{options}{if_statement})	{$level++}
	elsif	( $expr =~ $this->{options}{endif_statement})	{$level--};

	if( $level == 0 || ($expr =~ qr/$this->{options}{else_statement}|$this->{options}{elsif_statement}/ && $level == 1)) {
	    return (pos( $template), $expr)
	}
    }

    quit("No matching endif / elsif", $prev_expr);
}

# {{{2 get_end( $template, $open, $close): Gets the position and text of the end loop / paranthesis delimiter.
sub get_end {
    my $this = shift;
    my ($template, $open, $close, $open_expr) = @_;
    my $expr;

    my $level;

     #Assume that there has already been an opening delim before the start of the loop
    for( $level = 1; $level && ( $template =~ m/$open|$close/g);) {
	$expr = $&;
	$level += ( $expr =~ $open ? 1 : -1);
    }

    quit( "Unmatched expression", $open_expr) if( $level);
    return (pos( $template), substr( $template, 0, pos( $template) - length( $expr) ) );
}

# {{{2 funroll_eval( $expr): Evaluates $expr, and dies on failure. Returns the result
sub funroll_eval {
    my ($this, $expr, $statement) = @_;

    confess( "Empty stack") if( defined( $statement) && @lstack == 0);
    push( @lstack, $lstack[$#lstack] - ($statement =~ s/\n[ \t]*\z//g)) if( defined( $statement));

    my $result = eval( $this->funroll_vars($expr));
    quit( 'Error evaluating expression', $expr) if( $@);

    # croak "Error: Expression '$expr' failed to evaluate. Perl reported '$@'" if $@;
    # print STDERR RED, "Expression '$expr', evaluates to '$result'\n", RESET if( defined( $DEBUG));

    pop( @lstack) if( defined( $statement));
    return $result;
}

# {{{2 funroll_vars( $expr): Substutites globals and returns result.
sub funroll_vars {
    my ($this, $expr) = @_;
    my $tokens;

    # Shared files (precedence over tokens)
    if( keys( %{$this->{shared}} )) {
	my $shared = join( '|', keys %{$this->{shared}} );
	$expr =~ s/&($shared)\{(\w+)\}/exists($this->{shared}{$1}{$2})
	    ? $this->strip_prefix( $this->{shared}{$1}{$2}) : ""/xeg;
	$expr =~ s/&($shared)(;|\b)/exists($this->{shared}{$1}{name})
	    ? $this->strip_prefix( $this->{shared}{$1}{name}) : ""/xeg;
    }

    # Substute global tokens
    $tokens = join( '|', keys %{$this->{tokens}} );
    $expr =~ s/&($tokens)(?:;|\b)/$this->{tokens}{$1}/g;
    $expr =~ s/&\?(\w+)(?:;|\b)/exists( $this->{tokens}{$1}) || exists( $this->{shared}{$1}) ? 1 : 0/eg;

    # Lists
    if( keys( %{$this->{lists}})) {
	my $lists  = join( '|', keys %{$this->{lists}}  );
	# $expr =~ s/&#($lists)(?:;|\b)/scalar( @{$this->{lists}{$1}} )/eg;
	$expr =~ s/&($lists)\[(.+?)\]\{(\w+)\}/$this->get_listitem( $1, $2, $3)/eg;
    }
    $expr =~ s/&#(\w+)(?:;|\b)/exists( $this->{lists}{$1}) ? scalar( @{$this->{lists}{$1}}) : 0 /eg;
    $expr =~ s/&\?#(\w+)(?:;|\b)/exists( $this->{lists}{$1}) ? 1 : 0/eg;

    # Pagename
    $expr =~ s/&pagename{(.+?)}/$this->strip_prefix( $this->pagename( $this->funroll_eval($1)))/eg;

    # Substute global options (lowest priority)
    # $tokens = join( '|', keys %{$this->{options}} );
    # $expr =~ s/&($tokens)(?:;|\b)/$this->{options}{$1}/g;
    # $expr =~ s/&\?(\w+)(?:;|\b)/exists( $this->{options}{$1}) ? 1 : 0/eg;

    # Spacing stuff
    $expr =~ s/&\\\s+//g;
    $expr =~ s/&sp(?:ace)?(?:;|\b)//g;

    # Literal tokens
    $expr =~ s/&literal{(.+?)}/&$1/g;

    # TODO: Local variables
    return $expr;
}

# {{{2 funroll_loops( $template)
sub funroll_loops {
    my $this = shift;
    my ($template, $filename, $line) = @_;
    my ($head, $output);

    if( defined( $filename)) {
	push( @fstack, $filename);
	push( @lstack, defined( $line) ? $line : 1);
    }
    confess( "Empty filestack") unless( @fstack && @lstack);

    # print STDERR $template;
    $output = "";
    while( ($head, $_) = $this->get_statement( $template) ) {
	$output .= $head;

	SWITCH: {
	    # {{{3 Eval
	    /^$this->{options}{eval_statement}$/ && do {
		my $expr = $1;

		$output .= $this->funroll_eval( $expr, $_);
		last SWITCH;
	    };

	    # {{{3 Include
	    /^$this->{options}{include_statement}$/ && do {
		my $infile = $1;
		my $infile_name = $this->resolve_infile( $infile, $this->{options}{templates_dir},
			Dirname($fstack[$#fstack]));

		$output .= $this->funroll_loops( slurp( $infile_name, $_), $infile);
		last SWITCH;
	    };

	    # {{{3 If statements.
	    /^$this->{options}{if_statement}$/	&& do {
		my $result = "";
		my $condition = $this->funroll_eval( $1, $_);
		my ($pos, $expr) = $this->get_elseif( $template, $_);
		# print STDERR RED, "Condition ", $condition ? "True" : "False", RESET, "\n";
		# $statement = $_ . $template;

		# print STDERR "Pos: $pos, Expr: $expr\n";

		IFLOOP: {
		    if( $condition) {
			# Put the true part in $output
			$result = substr( $template, 0, $pos - length( $expr));
			last IFLOOP;
		    } else {
			# Get rid of the true part.
			countlines( substr( $template, 0, $pos));
			$template = substr( $template, $pos);

			# Process elseif's
			while( $expr =~ $this->{options}{elsif_statement} ) {
			    $condition = $this->funroll_eval( $1, $expr);
			    ($pos, $expr) = $this->get_elseif( $template, $expr);

			    if( $condition) {
				$result = substr( $template, 0, $pos - length( $expr));
				last IFLOOP;
			    }
			    countlines( substr( $template, 0, $pos));
			    $template = substr( $template, $pos);
			}

			# The If and all elseif's are false, process Else.
			if( $expr =~ $this->{options}{else_statement}) {
			    ($pos, $expr) = $this->get_elseif( $template, $expr);
			    quit( "No endif for", $expr) unless( $expr =~ $this->{options}{endif_statement});

			    $result = substr( $template, 0, $pos - length( $expr));
			    last IFLOOP;
			}
		    }
		    # All conditions are false. Get out of here
		    last SWITCH;
		} # End IFLOOP

		# Some clause was true. True part in $result + trailing garbage in $template
		# Evaluate $result and add it to $output
		$output .= $this->funroll_loops( $result, $fstack[$#fstack], $lstack[$#lstack]);

		# Remove trailing garbage in $template
		until( $expr =~ $this->{options}{endif_statement} ) {
		    countlines( substr( $template, 0, $pos));
		    $template = substr( $template, $pos);
		    ($pos, $expr) = $this->get_elseif( $template, $expr);
		}
		countlines( substr( $template, 0, $pos));
		$template = substr( $template, $pos);

		last SWITCH;
	    };

	    # {{{3 For loops
	    /^$this->{options}{for_statement}$/	&& do {
		my ($pos, $expr, $looptext, $iter);
		my ($id, $start, $end, $step) = split( /\s*,\s*/, $1);

		quit( "Syntax error:",  $_)
		    unless( defined($start) && defined($end) && $start ne '' && $end ne '');

		$start	= $this->funroll_eval( $start, $_);
		$end	= $this->funroll_eval( $end, $_);
		if( defined( $step) && $step ne '') {
		    $step = $this->funroll_eval( $step, $_);
		} else {
		    $step = 1;
		}

		($pos, $expr) = $this->get_end(
		    $template, $this->{options}{for_statement}, $this->{options}{endfor_statement}, $_);

		# print STDERR RED, "Inner loop:\n", RESET, $expr;
		for(my $idx = $start; $idx < $end; $idx+=$step) {
		    ($iter = $expr) =~ s/&$id(?:;|\b)/$idx/g;
		    $output .= $this->funroll_loops( $iter, $fstack[$#fstack], $lstack[$#lstack]);
		}

		countlines( substr( $template, 0, $pos));
		$template = substr( $template, $pos);

		last SWITCH;
	    };
	    #}}}3

	    chomp ($_);
	    quit("Unexpected", $_);
	}
    }
    $output .= $template;

    # Clean up file / line stack
    if( defined( $filename)) {
	pop( @fstack);
	pop( @lstack);
    }

    return $this->funroll_vars( $output);
}

# {{{2 funroll_page( $template): Unrolls $template into pages
sub funroll_page {
    my $this = shift;
    my ($template, $page);
    my $pageno;

    my %default_options = (
	# Output directories.
	output_dir	=> "",	# Where output files go
	shared_outdir	=> "-",	# Where to place shared output files by default.
	# input_dir	=> "",	# Where images / other input files should be
	# img_outdir

	cwd		=> "",

	base_dir	=> "$RealBin/",	# Replacement for =. Base dir of the program
	templates_dir	=> "=templates/",	# Where template files are found
	# include_dir	=> "=include/",	# Where to look if any default input file is not found (unnecessary)
	shared_indir	=> "=shared/",	# Where to look for shared input files.

	# Regexps for statements in the template file.
	# Loop delimiters
	for_statement	=> qr/[ \t]*&for\s*(.+?)\s*&;\n*/m, # First subexpression contains args
    	endfor_statement=> qr/[ \t]*&endfor(?:;|\b)\n*/m,
    	loop_arg_sep	=> qr/\s*,\s*/,				 # Loop argument seperator.

	# If / elseif / endif regexps
	if_statement	=> qr/[ \t]*&if\s+(.*?)&;\n*/m,
	elsif_statement => qr/[ \t]*&elsif\s+(.*?)&;\n*/m,
	else_statement	=> qr/[ \t]*&else(?:;|\b)\n*/m,
	endif_statement => qr/[ \t]*&endif(?:;|\b)\n*/m,

	# Eval expressions
    	eval_statement	=> qr/[ \t]*&eval\s+(.*?)&;\n*/m,	# First subexpression contains expression.

	# Include statement
	include_statement => qr/[ \t]*&include\s+(.*?)\s*(?:&;|\n|$)/m,

    );

    # Initialise statements
    my $regexp = join( '|', @default_options{qw(
	    for_statement endfor_statement eval_statement include_statement
	    if_statement elsif_statement else_statement endif_statement
	)});
    $default_options{statements} = qr/$regexp/o;

    # Initialise if regexps
    $regexp = join( '|', @default_options{qw( if_statement elsif_statement else_statement endif_statement)});
    $default_options{if_regexps} = qr/$regexp/o;

    # Now setup default tokens
    my %default_tokens = (
	title		=> "fuss (funroll-slideshow): Slide show Creator",
	subtitle	=> "Create slideshows by unrolling html loops.",

	# Default page numbers
	firstpage	=> 1,
	lastpage	=> 1
    );

    # Merge in the defaults
    merge_hash( $this->{tokens}, \%default_tokens, 1);
    merge_hash( $this->{options}, \%default_options, 1);
    $this->clean_values();
    # print join( ",", keys( %{$this->{tokens}})), "\n";

    # print STDERR "Unrolling page .. \n";
    # Read the template from @_ or $this->{options}{template_file}
    if (@_) {
	$template = @_;
    } elsif( exists( $this->{options}{template_file})) {
	$template = $this->read_template( $this->{options}{template_file});
    } else {
	confess( "funroll-slideshow error: No template specified to unroll");
    }

    # Set first / last page (if undefined). [Done in constructor, don't need anymore]
    # $this->{tokens}{firstpage} = 1 unless( exists( $this->{tokens}{firstpage} ));
    # $this->{tokens}{lastpage}  = $this->{options}{firstpage} unless( exists( $this->{tokens}{lastpage}) );

    # print STDERR "First page: $this->{options}{firstpage}, Last page: $this->{options}{lastpage}\n";
    $this->{tokens}{firstpage} = $this->funroll_loops( $this->{tokens}{firstpage}, "First page expression");
    $this->{tokens}{lastpage}  = $this->funroll_loops( $this->{tokens}{lastpage}, "Last page expression");

    # funroll-page:
    for( $pageno = $this->{tokens}{firstpage}; $pageno <= $this->{tokens}{lastpage}; $pageno++) {
	# Set the pageno
	$this->{tokens}{pageno} = $pageno;
	# ($page = $template) =~ s/&pageno(?:;|\b)/$pageno/g;

	$page = $this->funroll_loops( $template, $this->{options}{template_file});

	# All done.
	$this->write_page( $pageno, $page);
    }

    # Copy shared files over
    $this->copy_shared();
}

# {{{1 Local functions (non-methods)
# {{{2 countlines( $head): counts the number of lines in $head, and adds it to the current line number
sub countlines {
    my $head = shift;

    my $line = pop( @lstack);
    confess( "Oops empty stack") unless( defined( $line));
    $line += ($head =~ tr/\n/\n/);
    push(@lstack, $line);
}

# {{{2 quit( $message, $expr): Dies with message. If expr is give, prints line no + expr.
sub quit {
    my( $message, $expr) = @_;
    my $line;

    $message =~ s/\s+\z//;
    confess( "Stack error") if( defined($expr) && (@fstack == 0 || @lstack == 0));

    if( defined( $expr)) {
	$line = pop( @lstack);
	$line -= ($expr =~ s/\n[ \t]*\z//g);
	$expr =~ s/[ \t]+\z//;
	$expr =~ s/^(.*\n)?\s*//s;
	$message .= " $expr in " . pop( @fstack) . ", line $line" if( defined( $expr));
    }

    die( BOLD . RED . $message . RESET . "\n");
}

# {{{1 Global (exported) functions
# {{{2 match_pair( $string, $open, $close): Finds the outermost $open...$close pair. OBSOLETE
# Returns () if unsuccessfull, otherwise a list containing (
# 	index of opening delimiter in $string,
# 	length of match (including delims),
# 	The value of the first subexpression in $open (or "" if none exists)
# 	The actual text between $open and $close )
sub match_pair {
    # Open and close are regexps (with qr//)
    my ($template, $open, $close) = @_;
    my $closeDelim;

    if ($template =~ m/$open/g) {
	my $loopStart	= pos($template);		# Start of actual loop text (no delims)
	my $matchStart	= $loopStart - length($&);	# Start of matched text
	my $loop_args	= (defined($1) ? $1 : "");	# First captured parenthesis
	my $level;

	for( $level=1; $level && ($template =~ m/$open|$close/gc); ) {
	    $level += ( ($closeDelim = $&) =~ $open ? 1 : -1)
	}

	return $level == 0 ? (
	    $matchStart,	# Start of loop text (with delims)
	    pos($template) - $matchStart,	# Lenght of matched text (with delims)
	    $loop_args,				# Value of first captured paren in the open delim
	    substr( $template, $loopStart, pos($template) - $loopStart - length($closeDelim)) # Actual loop text
	) : ();
    } else {
	return ();
    }
}

# {{{2 merge_hash( $myref, $newref, $default): Merges tokens from %$newref into %$myref
# Undef values are NOT merged. For object refferences, the underlying object is copied.
sub merge_hash {
    my ($myhref, $newhref, $default) = @_;

    croak "Not a hash refferece in function merge_hash"
	unless( defined( $myhref) && defined($newhref) && ref($newhref) eq 'HASH' && ref($myhref) eq 'HASH');

    foreach my $key (keys( %$newhref)) {
	next if( ( defined( $default) && exists( $myhref->{$key}) )
		    || !defined( $newhref->{$key}) );

	$myhref->{$key} = copy_obj( $newhref->{$key});
    }
}

# {{{2 copy_obj( $ref) : Returns a copy of the object pointed to by $ref. Returns $ref if $ref is a scalar.
sub copy_obj {
    my $src_ref = shift;
    my $new_ref;

    # croak "Arguement to copy_obj is not a refference" unless( defined($src_ref) && ref($src_ref));

    if( ref( $src_ref) eq 'HASH') {
	$new_ref = {};
	foreach my $key (keys( %$src_ref)) {
	    $new_ref->{$key} = copy_obj( $src_ref->{$key});
	}
    } elsif( ref( $src_ref) eq 'ARRAY') {
	$new_ref = [];
	for(my $i=0; $i < scalar( @$src_ref); $i++) {
	    $new_ref->[$i] = copy_obj( $src_ref->[$i]) if( defined( $src_ref->[$i]));
	}
    } elsif( ref( $src_ref) eq 'Regexp' ) {
	# Regexps can "just be copied" :)
	$new_ref = $src_ref;
    } elsif( ref( $src_ref) ) {
	# src_ref points to a random object. It had better provide a method to copy itself...
	$new_ref = $src_ref->copy();
    } else {
	# Is a scalar. Just return the copy.
	$new_ref = $src_ref;
    }

    return $new_ref;
}

# {{{2 make_base_dir(): get the basename of the file and make the directory.
sub make_base_dir {
    my $file = shift;

    my $dir = dirname($file);
    if( -d $dir) {
	return 1;
    } elsif( make_base_dir( $dir) && mkdir( $dir)) {
	print STDERR GREEN, "$dir ", RESET;
	return 1;
    } else {
	print STDERR BOLD, RED, "$dir ", RESET;
	return 0;
    }
}

# {{{2 slurp( $filename): Return contents of file $filename
sub slurp {
    my ($name, $expr) = @_;
    my ($filename, $text);
    local $SIG{PIPE} = sub { quit( "Pipe error: $!") };

    $filename = ( substr( $name, -1) eq '|') ? $name : "<$name";
    open( TEMPLATE, $filename) or quit( "$name: $!.", $expr);
    $text = join( '', <TEMPLATE>);
    close TEMPLATE;

    return $text;
}

# {{{2 Dirname( $filename): Return the dir name of $filename (with correct prefix)
sub Dirname {
    my $filename = shift;
    my $dir;

    if( $filename =~ m/^[+-=]/) {
	$dir = dirname( substr( $filename, 1));
	return substr( $filename, 0, 1) . ( $dir eq '.' ? '' : $dir) . '/';
    } else {
	$dir = dirname( $filename);
	return ($dir eq '.' ? '' : "$dir/");
    }
}

# {{{2 subst_tilde( $filename): Substitute ~user etc and return the filename
sub subst_tilde {
    my $filename = shift;

    if( $filename =~ m{^~\w*(?=/|$)} ) {
	my $homedir = bsd_glob( $&, GLOB_TILDE | GLOB_ERR);

	die("Unable to find directory $&") if(GLOB_ERROR);
	$filename =~ s//$homedir/;
    }

    return $filename;
}

# }}}1

1; # So the require / use succeeds