#!/usr/bin/perl

use warnings;
use strict;

# Tom Moertel <tom@moertel.com> 2004-10-11

# here are some fake pages

my @book_pages = (

   { page_type => 'front_matter',
     content   => "This is the copyright page (::PAGENUM::).\n"
                . "::COPYRIGHT::\n"
                . "::PRINTING::\n" },

   { page_type => 'body',
     content   => "This is a body page (::PAGENUM::).\n" },

   { page_type => 'index', 
     content   => "This an index page (::PAGENUM::).\n" },
);


# sample code that shows how to build
# an engine from spec and use it

my $page_number = 1;
my $page_engine = make_regex_engine_from_spec(\*DATA);
for my $page (@book_pages) {
    print $page_engine->(@$page{'content','page_type'}), "\n";
    $page_number++;
}

sub roman_numeral {
    my $index = shift;
    return (qw/0 i ii iii iv v ... /)[$index] || "?";
}

# the following code generates the worker code from the spec

sub make_regex_engine_from_spec
{
    my $fh = shift;
    my %sections;
    my $label;

    # read in spec

    while (<$fh>) {
        chomp;
        next unless /\S/; # skip blanks
        if (/^(\w+):/) {
            $label = $1;
        }
        else {
            die "syntax error: need a section label\n"
                unless $label;
            push @{$sections{$label}}, $_;
        }
    }

    # compile spec into code
    
    my $interpret = sub {
        local $_ = shift;
        if ( /^ \s* \+ (\w+) /x ) {
            if ($sections{$1}) {
                return '$sections{'.$1.'}->();';
            }
            die "there is no section named '$1'";
        }
        return $_;
    };

    while (($label, my $section) = each %sections) {
        my $generated_code =
            join "\n", 'sub {', 
                (map $interpret->($_), @$section), "}\n";
        # uncomment below line to see generated code
        # print STDERR "$label => $generated_code\n";
        $sections{$label} = eval $generated_code
            or die "couldn't eval section $label: $@";
    }

    # return processor engine that embodies compiled spec

    return sub {
        # args: page content, page type
        (local $_, my $page_type) = @_;
        my $processor = $sections{$page_type};
        $processor->() if $processor;
        return $_;
    }
}


# our spec follows

__DATA__
body:
    +all_pages

front_matter:
    s/::PAGENUM::/roman_numeral($page_number)/eg;
    s/::COPYRIGHT::/Copyright 2004 blah, blah/g;
    s/::PRINTING::/1st printing, Blah Blah Press/g;
    +all_pages

index:
    +all_pages

all_pages:
    s/::PAGENUM::/$page_number/eg;