17.4 Jeeves ImplementationIn 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 ModuleThe 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 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 ParserThe template parser supports the directives in Table 17.1 .
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_"); 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( 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 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); } Copyright © 2001 O'Reilly & Associates. All rights reserved. | ||||||||||||
|