[Chapter 17] 17.4 Jeeves Implementation
Author: Sriram Srinivasan
Date: 1999-07-02T01:39:49Z

#

| Chapter 17 Template-Driven Code Generation |

## 17.4 Jeeves Implementation

In the following pages, we implement all the components of the Jeeves framework. You may find it helpful to run `jeeves` for a sample problem and have a copy of the output handy.

### 17.4.1 AST Module

The AST module is a very simple library, so we will look at only a few of the more interesting procedures below.

An AST node is a container of properties, so a hash table suits the job perfectly. Each node is given a name for ease of debugging:

    package Ast;
    use strict;
    sub new {
        my ($pkg, $name) = @_;
        bless {'ast_node_name' => $name}, $pkg;
    }

`new`, `add_prop`, and `add_prop_list` are used by all specification parsers to create AST objects:

    sub add_prop {
        my ($node, $prop_name, $prop_value) = @_;
        $node->{$prop_name} = $prop_value;
    }
    sub add_prop_list {
        my ($node, $prop_name, $node_ref) = @_;
        if (! exists $node->{$prop_name}) {
            $node->{$prop_name} = [];
        }
        push (@{$node->{$prop_name}}, $node_ref);
    }

`add_prop` simply adds a name-value pair to the AST object. `add_prop_list` creates a list-valued property. The property value is an anonymous array that contains references to other AST nodes. You can have your own list-valued properties, but you should never use them as an argument to `@foreach` because it assumes that the elements of that list are AST nodes.

    my @saved_values_stack;
    sub visit {
        no strict 'refs';
        my $node = shift;
        package main;
        my ($var, $val, $old_val, %saved_values);
        while (($var,$val) = each %{$node}) {
            if (defined ($old_val = $$var)) {
               $saved_values{$var} = $old_val;
            }
            $$var = $val;
        }
        push (@saved_values_stack, \%saved_values);
    }

The `visit` and `bye` methods are used by the intermediate Perl file. `$node` is the node being visited, so `%$node` is the corresponding hash table. `$var` is a property name such as `class_name`, so to check whether a variable such as `$class_name` already exists, we use symbolic references: `if` `defined($$var`). All such variables that existed before are squirreled away into a hash table (`%saved_values`), which is then pushed into a stack. This stack represents collections of such saved values.

    sub bye {
        my $rh_saved_values = pop(@saved_values_stack);
        no strict 'refs';
        package main;
        my ($var,$val);
        while (($var,$val) = each %$rh_saved_values) {
            $$var = $val;
        }
    }

`bye()` simply pops this stack and restores the global variables to their former values. Incidentally, since `use` `strict` doesn't encourage symbolic references, we have to explicitly turn it off for a short while with `no` `strict` `'refs'`.

### 17.4.2 Template Parser

The template parser supports the directives in Table 17.1.

Table 17.1: Directives Recognized by Jeeves
Directive | Description
--- | ---
    @//
| Comment. This line is not output
    @foreach var [condition]
    @end
| This loops through each element of `var` (it is assumed that `var` is an array) and executes the body if the (optional) condition is true. Conditions are simply pieces of embedded Perl code and can be used like this:
    @FOREACH attr_list ($className eq "Test")
    @if @elsif @else @end
| Translates directly to Perl's `if` statement.
    @openfile filename
                  [options]
| All statements following this line are simply sent to this file until another `@OPENFILE` is encountered. Options are: `-append`: open the file in append mode `-no_overwrite`: do not overwrite the file if it already exists `-only_if_different`: overwrites the file only if it is different. Useful in a `make` environment, where you don't want to unnecessarily touch files.
    @perl
| For embedding Perl code, provided as an escape to a higher power.
    @perl $user_name = $ENV{USER};
    @perl print $user_name;

The following template parser code simply translates all template directives to corresponding pieces of Perl code in the intermediate files. Explanations follow each subroutine definition.

    package TemplateParser;
    use strict;

    sub parse {
        # Args : template file, intermediate perl file
        my ($pkg,$template_file, $inter_file) = @_;
        unless (open (T, $template_file)) {
            warn "$template_file : $@";
            return 1;
        }
        open (I, "> $inter_file") ||
            die "Error opening intermediate file $inter_file : $@";

        emit_opening_stmts($template_file);
        my $line;
        while (defined($line = <T>)) {
            if ($line !~ /^\s*\@/) { # Is it a command?
                emit_text($line);
                next;
            }
            if ($line =~ /^\s*\@OPENFILE\s*(.*)\s*$/i) {
                emit_open_file ($1);
            } elsif ($line =~ /^\s*\@FOREACH\s*(\w*)\s*(.*)\s*/i) {
                emit_loop_begin ($1,$2);
            } elsif ($line =~ /^\s*\@END/i) {
                emit_loop_end();
            } elsif ($line =~ /^\s*\@PERL(.*)/i) {
                emit_perl("$1\n");
            };
        }
        emit_closing_stmts();

        close(I);
        return 0;
    }

TemplateParser::parse is called by the driver, with the name of the template file. For every line in the template, it checks to see whether that line is a command or ordinary text and calls the appropriate "emit" routine. All emitted code is shown in italics.

    sub emit_opening_stmts {
        my $template_file = shift;
        emit("# Created automatically from $template_file");
        emit(<<'_EOC_');
    use Ast;
    use JeevesUtil;

    $tmp_file = "jeeves.tmp";
    sub open_file;
    if (! (defined ($ROOT) && $ROOT)) {
        die "ROOT not defined \n";
    }

    $file = "> -";   # Assumes STDOUT, unless @OPENFILE changes it.
    open (F, $file) || die $@;
    $code = "";
    $ROOT->visit();
    _EOC_
    }

All pieces of code that go into the intermediate file (emitted) are shown in italics. Perl's "here document" feature is used extensively because we can use quotes and newlines without restrictions. `emit_opening_statement` visits the syntax tree's root node (the driver makes it available as a global variable called `$ROOT`). By default, all output from the intermediate file is to standard output until it comes across an `@openfile` directive.

    sub emit_open_file {
        my $file = shift;
        my $no_overwrite      = ($file =~ s/-no_overwrite//gi) ? 1 : 0;
        my $append            = ($file =~ s/-append//gi) ? 1 : 0;
        my $only_if_different = ($file =~ s/-only_if_different//gi) ? 1 : 0;
        $file =~ s/\s*//g;
        emit (<<"_EOC_");
    # Line $.
    open_file(\"$file\", $no_overwrite, $only_if_different, $append);
    _EOC_
    }

`emit_open_file` contains the translation for `@openfile` and simply emits a call to the utility function open_file (discussed later).

    sub emit_loop_begin {
        my $l_name = shift; # Name of the list variable
        my $condition = shift;
        my $l_name_i = $l_name . "_i";
    emit (<<"_EOC_");
    # Line $.
    foreach \$$l_name_i (\@\${$l_name}) {
        \$$l_name_i->visit ();
    _EOC_
        if ($condition) {
            emit ("next if (! ($condition));\n");
        }
    }
    sub emit_loop_end {
        emit(<<"_EOC_");
    #Line $.
        Ast->bye();
    }
    _EOC_
    }

We saw earlier the code generated for a `@foreach` directive. Note how we manufacture the iterator name and protect certain expressions from getting interpolated. This code can be better understood by looking at the sample output.

    sub emit {
        print I $_[0];
    }
    sub emit_perl {
        emit($_[0]);
    }
    sub emit_text {
        my $text = $_[0];
        chomp $text;
        # Escape quotes in the text
        $text =~ s/"/\\"/g;
        $text =~ s/'/\\'/g;
        emit(<<"_EOC_");
    output("$text\\n");
    _EOC_
    }

    sub emit_closing_stmts {
        emit(<<'_EOC_');
    Ast::bye();
    close(F);
    unlink ($tmp_file);
    sub open_file {
        my ($a_file, $a_nooverwrite, $a_only_if_different, $a_append) = @_;

        #First deal with the file previously opened
        close (F);
        if ($only_if_different) {
            if (JeevesUtil::compare ($orig_file, $curr_file) != 0) {
                rename ($curr_file, $orig_file) ||
                die "Error renaming $curr_file  to $orig_file";
            }
        }
        #Now for the new file ...
        $curr_file = $orig_file = $a_file;
        $only_if_different = ($a_only_if_different && (-f $curr_file))
                             ? 1 : 0;
        $no_overwrite = ($a_nooverwrite && (-f $curr_file))  ? 1 : 0;
        $mode =  ($a_append) ? ">>" : ">";
        if ($only_if_different) {
            unlink ($tmp_file);
            $curr_file = $tmp_file;
        }
        if (! $no_overwrite) {
            open (F, "$mode $curr_file") || die "could not open $curr_file";
        }
    }

    sub output {
        print F @_ (! $no_overwrite);
    }
    1;
    _EOC_
    }

The `open_file` and `output` routines are present in all intermediate code files (for no particular reason - they might as well have been put in the JeevesUtil package). `open_file` closes the previously opened file. If you say, `@openfile foo -only_if_different`, the intermediate file dumps the template output into a temporary file, and when it is done, it compares this temporary file to the contents of `foo`, and overwrites it only if it is different.

### 17.4.3 Jeeves Driver

The jeeves script is merely a driver that first calls the template parser to produce the intermediate file, then calls the input parser (its `parse()` method, actually) to produce the syntax tree, and finally `eval`s the intermediate file. The template file is recompiled only if it is newer than the intermediate file.

Example 17.3 gives the code for jeeves, minus the uninteresting stuff (such as `process_args()`).

#### Example 17.3: Jeeves

    #!/opt/bin/perl
    # process_args initializes the following global variables:
    #   $spec_file     - Name of the input specification (emp.om)
    #   $template_file - Name of the template file (oo.tpl)
    #   $inter_file    - name of the intermediate file
    #                        (defaults to "${template_file}.pl"
    process_args();
    #-------------------------------------------------------------------------
    # Parse the template file
    #-------------------------------------------------------------------------
    # Use "require" to allow process_args() to set @INC first
    require 'TemplateParser.pm';
    my $compile_template = 1;
    if ((-e $inter_file) &&
        (-M $inter_file) >= (-M $template_file)) {
            $compile_template = 0; # Don't compile if inter-file is newer.
    }
    if ($compile_template) {
        if (TemplateParser->parse ($template_file, $inter_file) == 0) {
            print STDERR ("Translated $template_file to $inter_file\n")
               if $verbose;
        } else {
            die "Could not parse template file - exiting\n";
        }
    }
    #-------------------------------------------------------------------------
    # Parse the input specification file
    #-------------------------------------------------------------------------
    require "${spec_parser}.pm"; $spec_parser->import;
    $ROOT = $spec_parser->parse($spec_file);
    print STDERR ("Parsed $spec_file\n") if $verbose;
    $ROOT->print() if $debugging;
    #-------------------------------------------------------------------------
    # Eval the intermediate Perl file
    #-------------------------------------------------------------------------
    require "$inter_file";
    die "$@\n" if $@;
    exit(0);

    #-------------------------------------------------------------------------
    sub Usage {
        print STDERR <<"_EOT_";

    Usage: jeeves <options> <specification file>
     where options are:
     -t <template file>            : Name of the template file.
                                     Default : "./jeeves.template"
                                     Default template directory = ".", which
                                     can be modified by setenv-ing
                                     "JEEVESTEMPLATEDIR"
     -q                            : Quiet Mode
     -d                            : Set a debugging trace. This is NOT quiet!
     -s <specification parser>     : Parser module that can parse the input
                                     specification file
                                     Default : "oo_schema"
    [-ti <intermediate perl file>] : jeeves translates the template file to
                                   : perl code. Default : "<template>.pl"
    -D var[=value]                 : Define variables on the command line

    The command line can be specified in the envt. variable "JEEVESOPTIONS".

    The pathname to all Jeeves modules can be set in the envt. variable
        "JEEVESLIBDIR" (colon-separated);
    _EOT_
        exit(1);
    }

17.3 Jeeves Overview |  | 17.5 Sample Specification Parser