CGI::MxScreen - a multi-screen stateful CGI framework

CGI-MxScreen documentation Contained in the CGI-MxScreen distribution.

Index

Code Index:

NAME

Top

CGI::MxScreen - a multi-screen stateful CGI framework

SYNOPSIS

Top

 require CGI::MxScreen;

 my $manager = CGI::MxScreen->make(
     -bgcolor    => "#dedeef",
     -screens    =>
         {
             "state_1"   =>
                 [-class => "STATE_1", -title => "Hello"],
             "state_2"   =>
                 [-class => "STATE_2", -title => "Hello #2"],
         },
     -initial    => "state_1",
     -version    => "1.0",
 );

 $manager->play();

DESCRIPTION

Top

CGI::MxScreen is a framework for building multi-screen stateful CGI programs. It is rather object-oriented, with some peculiarities brought by persistency constraints: all objects must be handled by Storable.

CGI::MxScreen is based on the CGI module, and co-operates with it, meaning you are able to use most CGI calls normally. The few places where you should not is where CGI::MxScreen supersedes the CGI functionalities: for instance, there's no need to propagate hidden values when you use CGI::MxScreen.

CGI::MxScreen is architected around the concept of screens. Among the set of defined screens within the same script, only one is visible at a time. One moves around the various screens by pressing buttons, which submit data to the server and possibly move you to a different screen. The state machine is handled by CGI::MxScreen, the user only defines which state (screen) a button shall move the application to

CGI::MxScreen is stateful in the sense that many of the runtime objects created to operate (and screens are among those) are made persistent. This is a very interesting property, because you do not have to worry too much about the underlying stateless nature of the CGI protocol. The CGI module brought the statefulness to the level of form controls, but CGI::MxScreen raises it to the level of the application itself.

CGI::MxScreen is not meant to be used for so-called quick and dirty scripts, or for scripts which do not require some fair amount of round trips between the browser and the server. You'll be better off with using the good old CGI module. However, for more complex web applications, where there is a fair amount of processing required on the server side, and where each script involves several states, CGI::MxScreen is for you.

OK, enough talking.

FRAMEWORK

Top

This section describes the CGI::MxScreen framework. If you wish to read about the interface of the CGI::MxScreen managing object, please skip down to "INTERFACE".

Features

Here are the main features of CGI::MxScreen:

Flow

Here is a high-level description of the processing flow when issuing requests to a CGI::MxScreen script:

Example

The following example demonstrates the various common operations that need to be performed with CGI::MxScreen.

An important comment first: if we forget about the fact that you need an object per screen (which has some code overhead compared to using plain CGI), you will need to write more declarative code with CGI::MxScreen than you would with CGI, but this buys you more persistent state for fields, and lets you define the state transitions and associated processing for buttons.

Moreover, please note that this example could be written in less code by using the CGI module only. But CGI::MxScreen is not aimed at simple scripts.

Our example defines a two-state script, where one choose a color in the first screen, and then a week day in the second screen. The script reminds you about the choice made in the other screen, if any. It is possible to "redraw" the first screen to prove that the selection made is sticky. First, the whole script:

  1 #!/usr/local/bin/perl -T
  2 
  3 package Color; use base qw(CGI::MxScreen::Screen);
  4 
  5 use CGI qw/:standard/;
  6 
  7 sub init {
  8     my $self = shift;
  9     $self->vars->{color} = "";
 10 }
 11 
 12 sub display {
 13     my $self = shift;
 14     print h1($self->screen_title);
 15 
 16     my $color = $self->record_field(
 17         -name       => "color",
 18         -storage    => "color",
 19         -default    => $self->vars->{color} || "Green",
 20         -override   => 1,
 21         -values     => [qw(Red Green Blue White Black Yellow Orange Cyan)],
 22     );
 23 
 24     print p("You told me your favorite weekday was", $self->vars->{weekday})
 25         if exists $self->vars->{weekday};
 26 
 27     print p("Your favorite color is", popup_menu($color->properties));
 28 
 29     my $ok = $self->record_button(
 30         -name   => "Next",
 31         -target => "Weekday");
 32 
 33     my $redraw = $self->record_button(
 34         -name   => "Redraw",
 35         -target => $self->current_screen);
 36 
 37     print submit($ok->properties), submit($redraw->properties);
 38 }
 39 
 40 package Weekday; use base qw(CGI::MxScreen::Screen);
 41 
 42 use CGI qw/:standard/;
 43 
 44 sub init {
 45     my $self = shift;
 46     $self->vars->{weekday} = "";
 47 }
 48 
 49 sub display {
 50     my $self = shift;
 51     print h1($self->screen_title);
 52 
 53     print p("You told me your favorite color was", $self->vars->{color});
 54 
 55     my $weekday = $self->record_field(
 56         -name       => "day",
 57         -storage    => "weekday",
 58         -default    => $self->vars->{weekday} || "Mon",
 59         -override   => 1,
 60         -values     => [qw(Mon Tue Wed Thu Fri Sat Sun)],
 61     );
 62 
 63     print p("Your favorite weekday is", popup_menu($weekday->properties));
 64 
 65     my $back = $self->record_button(
 66         -name       => "Back",
 67         -target     => $self->spring_screen,
 68     );
 69 
 70     print submit($back->properties);
 71 }
 72 
 73 package main;
 74 
 75 require CGI::MxScreen;
 76 
 77 my $manager = CGI::MxScreen->make(
 78     -screens    =>
 79         {
 80             'Color'     => [-class => 'Color',   -title => "Choose Color" ],
 81             'Weekday'   => [-class => 'Weekday', -title => "Choose Day" ],
 82         },
 83     -initial    => ['Color'],
 84 );
 85 
 86 $manager->play();
 87

Let's study this a piece at a time:

  1 #!/usr/local/bin/perl -T
  2

The classical declaration for a CGI script, in taint mode.

  3 package Color; use base qw(CGI::MxScreen::Screen);
  4

This defines the first state, Color. It inherits from CGI::MxScreen::Screen, as it should.

  5 use CGI qw/:standard/;
  6

We're going to use CGI routines. We could do with less than what is exported by the :standard tag, but I did not bothered.

  7 sub init {
  8     my $self = shift;
  9     $self->vars->{color} = "";
 10 }
 11

The init() routine is called on the screen the first time it is created. Upon further invocations, the same screen object will be used and re-used each time we need to access the Color state.

To differentiate from a plain CGI script which would use hidden parameters to propagate the information, we store the application variable in the persistent hash table, which every screen can access through $self->vars. Here, we initialize the "color" key, because any access to an unknown key is an error at runtime (to avoid malicious typos).

 12 sub display {
 13     my $self = shift;

The display() routine is invoked by the state manager on the screen selected for displaying.

 14     print h1($self->screen_title);
 15

Prints screen title. This refers to the defined title in the manager, which are declared for each known screen further down on lines 78-82.

 16     my $color = $self->record_field(
 17         -name       => "color",
 18         -storage    => "color",
 19         -default    => $self->vars->{color} || "Green",
 20         -override   => 1,
 21         -values     => [qw(Red Green Blue White Black Yellow Orange Cyan)],
 22     );
 23

This declaration is very important. It tells CGI::MxScreen that the screen makes use of a field named "color", and whose value should be stored in the global persistent hash under the key "color" (as per the -storage indication).

The remaining attributes are simply collected to be passed to the popup_menu() routine via $color-properties> below. They could be omitted, and added inline when popup_menu() is called, but it's best to regroup common things together.

The underlying object created by record_field() will be serialized and included in the CGI::MxScreen context (only the relevant attributes are serialized, i.e. CGI parameters such as -values are not). This will allow the processing engine to honour some meaningful actions, such as validation, storage, or on-the-fly patching.

Another important property of those objects is that CGI::MxScreen will update the value attribute, which would be noticeable if there was no -default line: you could query $color-value> to get the current CGI parameter value, as submitted.

 24     print p("You told me your favorite weekday was", $self->vars->{weekday})
 25         if exists $self->vars->{weekday};
 26

If we have been in the Weekday screen, then the key "weekday" will be existing in the global hash $self->vars, because it is created by the init() routine of that object, at line 46. If we tried to access the key without protecting by the exists test on line 25, we'd get a fatal error saying:

    access to unknown key 'weekday'

This protection can be disabled if you want it so, but it is on by default. It will probably save you one day, but unfortunately this is a runtime check.

 27     print p("Your favorite color is", popup_menu($color->properties));
 28

The above is generating the sole input of this screen, i.e. a popup menu so that you can select your favorite color. Note that we're passing popup_menu(), which is a routine from the CGI module, a list of arguments derived from the recorded field $color, created at line 16.

 29     my $ok = $self->record_button(
 30         -name   => "Next",
 31         -target => "Weekday");
 32

This declaration is also very important. We're using record_button() to declare a state transition: we wish to move to the Weekday screen when the button Next is pressed.

 33     my $redraw = $self->record_button(
 34         -name   => "Redraw",
 35         -target => $self->current_screen);
 36

The Redraw button simply redisplays the current screen, i.e. there is no transition to another screen (state). The current_screen routine returns the name of the current screen we're in, along with all the parameters we were called with, so that the transition is indeed towards the exact same state.

 37     print submit($ok->properties), submit($redraw->properties);
 38 }
 39

We're finishing the display routine by calling the submit() routine from the CGI module to generate the submit buttons. Here again, we're calling properties() on each button object to expand the CGI parameters, just like we did for the field on line 27.

 40 package Weekday; use base qw(CGI::MxScreen::Screen);
 41 
 42 use CGI qw/:standard/;
 43

This defines the second state, Weekday. It inherits from CGI::MxScreen::Screen, as it should. We also import the CGI functions in that new package.

Note that the name of the class need not be the name of the state. The association between state name and classes is done during the creation of the manager object (see lines 78-82).

 44 sub init {
 45     my $self = shift;
 46     $self->vars->{weekday} = "";
 47 }
 48

Recall that init() is called when the screen is created. Since screen objects are made persistent for the duration of the whole session (i.e. while the user is interacting with the script's forms), that means the routine is called once for every screen that gets created.

Here, we initialize the "weekday" key, which is necessary because we're going to use it line 58 below...

 49 sub display {
 50     my $self = shift;
 51     print h1($self->screen_title);
 52

This is the display() routine for the screen Weekday. It will be called by the CGI::MxScreen manager when the selected state is "Weekday" (name determined line 81 below).

 53     print p("You told me your favorite color was", $self->vars->{color});
 54

We remind them about the color they have chosen in the previous screen. Note that we don't rely on a hidden parameter to propagate that value: because it is held in the global persistent hash, it gets part of the session context and is there for the duration of the session.

 55     my $weekday = $self->record_field(
 56         -name       => "day",
 57         -storage    => "weekday",
 58         -default    => $self->vars->{weekday} || "Mon",
 59         -override   => 1,
 60         -values     => [qw(Mon Tue Wed Thu Fri Sat Sun)],
 61     );
 62

The declaration of the field used to ask them about their preferred week day. It looks a lot like the one we did for the color, on lines 16-22, with the exception that the field name is "day" but the storage in the context is "weekday" (we used the same string "color" previously).

 63     print p("Your favorite weekday is", popup_menu($weekday->properties));
 64

The above line generates the popup. This will create a selection list whose CGI name is "day". However, upon reception of that parameter, CGI::MxScreen will immediately save the value to the location identified by the -storage line, thereby making the value available to the application via the $self->vars hash.

 65     my $back = $self->record_button(
 66         -name       => "Back",
 67         -target     => $self->spring_screen,
 68     );
 69

We declare a button named Back, which will bring us back to the screen we were when we sprang into the current screen. That's what spring_screen is about: it refers to the previous stable screen. Here, since there is no possibility to remain in the current screen, it will be the previous screen. But if we had a redraw button like we had in the Color screen, which would make a transition to the same state, then spring_screen will still correctly point to Color, whereas previous_screen would be Weekday in that case.

 70     print submit($back->properties);
 71 }
 72

This closes the display() routine by generating the sole submit button for that screen.

 73 package main;
 74

We now leave the screen definition and enter the main part, where the CGI::MxScreen manager gets created and invoked. In real life, the code for screens would not be inlined but stored in a dedicated file, one file for each class, and the CGI script would only contain the following code, plus some additional configuration.

 75 require CGI::MxScreen;
 76

We're not "using" it, only "requiring" since we're creating an object, not using any exported routine.

 77 my $manager = CGI::MxScreen->make(
 78     -screens    =>
 79         {
 80             'Color'     => [-class => 'Color',   -title => "Choose Color" ],
 81             'Weekday'   => [-class => 'Weekday', -title => "Choose Day" ],
 82         },
 83     -initial    => ['Color'],
 84 );
 85

The states of our state machine are described above. The keys of the -screens argument are the valid state names, and each state name is associated with a class, and a screen title. This screen title will be available to each screen with $self->title, but there's no obligation for screens to display that information. However, the manager needs to know because when the display() routine for the script is called, the HTML header has already been generated, and that includes the title.

The act of creating the manager object raises some underlying processing: the session context is retrieved, incoming parameters are processed and silently validated.

 86 $manager->play();
 87

This finally launches the state machine: the next state is computed, action callbacks are fired, and the target screen is displayed.

More Readings

To learn about the interface of the CGI::MxScreen manager object, see "INTERFACE" below.

To learn about the screen interface, i.e. what you must implement when you derive your own objects, what you can redefine, what you should not override (the other features that you cannot redefine, so to speak), please read CGI::MxScreen::Screen.

To learn more about the configuration options, see CGI::MxScreen::Config.

For information on the processing done on recorded fields, read CGI::MxScreen::Form::Field and CGI::MxScreen::Form::Utils.

For information on the state transitions that can be recorded, and the associated actions, see CGI::MxScreen::Form::Button.

The various session management schemes offered are described in CGI::MxScreen::Session::Medium.

The layering hooks allowing you to control where the generated HTML for the current screen goes in your grand formatting scheme are described in CGI::MxScreen::Layout.

Finally, the extra HTML-generating routines that are not implemented by the CGI module are presented in CGI::MxScreen::HMTL.

SPECIFIC DATA TYPES

Top

This sections documents in a central place the state and callback representations that can be used throughout the CGI::MxScreen framework.

Those specifications must be serializable, therefore all callbacks are expressed in various symbolic forms, avoiding code references.

Do not forget that all the arguments you specify in callbacks and screens get serialized into the context. Therefore, you must make sure your objects are indeed serializable by the serializer (which is Storable by default, well, actually CGI::MxScreen::Serializer::Storable, which is wrapping the Storable interface to something CGI::MxScreen understands). See CGI::MxScreen::Config to learn how to change the serializer, and CGI::MxScreen::Serializer for the interface it must follow.

States

A state is a screen name plus all the arguments that are given to its display() routine. However, the language used throughout this documentation is not too strict, and we tend to blurr the distinction between a state and a screen by forgetting about the parameters. That is because, in practice, the parameters are simply there to offer a slight variation of the overall screen dispay, but it is fundamentally the same screen.

Anyway, a state can be either given as:

Callbacks

When an argument expects a callback, you may provide it under the foloowing forms.

INTERFACE

Top

The public interface with the manager object is quite limited. The main entry points are the creation routine, which configures the overall operating mode, and the play() routine, which launches the state machine resolution.

Creation Routine

As usual, the creation routine is called make(). It takes a list of named arguments, some of which are optional:

-bgcolor => color

Optional, sets the default background color to be used for all screens. If unspecified, the value is gray75, aka "#bfbfbf", which is the default background in Netscape on Unix. The value you supply will be used in the BGCOLOR HTML tag, so any legal value there can be used. For instance:

    -bgcolor    => "beige"

You may override the default background on a screen basis, as explained in "Creation Routine" in CGI::MxScreen::Screen.

-initial => scalar | array_ref

Mandatory, defines the initial state. See States above for the actual format details.

The following two forms have identical effects:

    -initial    => ["Color"]
    -initial    => "Color"

and both define a state Color whose display() routine is called without arguments.

-layout => layout_object

Optional, provides a CGI::MxScreen::Layout object to be used for laying out the screen's HTML generated by display(). See CGI::MxScreen::Layout for details.

-screens => hash_ref

Mandatory, defines the list of valid states, whose class will handle it, and what the title of the page should be in that state. Usually, there is identity between a screen and a state, but via the display() parameters, you can have the same screen object used in two different states, with a slightly different mode of operation.

The hash reference given here is indexed by state names. The values must be array references, and their content is the list of arguments to supply to the screen's creation routine, plus a -class argument defining the class to use. See "Creation Routine" in CGI::MxScreen::Screen.

Example of hash_ref:

    {
        'Color'     => [-class => 'Color',   -title => "Choose Color" ],
        'Weekday'   => [-class => 'Weekday', -title => "Choose Day" ],
    }

The above sequence defines two states, each implemented by its own class.

-timeout => seconds

Optional, defines a session timeout, which will be enforced by CGI::MxScreen when retrieving the session context. It must be smaller than the session cleaning timout, if sessions are not stored within the browser.

When the session is expired, there is an error message stating so and the user is invited to restart a new session.

-version => string

Defines the script's version. This is your versioning scheme, which has nothing to do with the one used by CGI::MxScreen.

You should use this to track changes in the screen objects that would make deserialization of previous ones (from an old session) improper. For instance, if you add attributes to your screen objects and depend on them being set up, an old screen will not bear them, and your application will fail in mysterious ways.

By upgrading -version each time such an incompatibility is introduced, you let CGI::MxScreen trap the error and produce an error message.

Features

internal_error string

Immediately abort current processing and emit the error message string. If a layout is defined, it is honoured during the generation of the error message.

If you buffer STDOUT (which is the case by default), then all the output currently generated will be discarded cleanly. Otherwise, users might have to scroll down to see the error message.

log

Gives you access to the Log::Agent::Logger logging object. There is always an object, whether or not you enabled logging, if only to redirect all the logs to /dev/null. This is the same object used by CGI::MxScreen to do its hardwired logging.

See Log::Agent::Logger to learn what can be done with such objects.

play

The entry point that dispatches the state machine handling. Upon return, the whole HTML has been generated and sent back to the browser.

Utility Path

The concept of utility path stems from the need to keep all callback specification serializable. Since Storable cannot handle CODE references, CGI::MxScreen uses function names. In some cases, we have a default object to call the method on (e.g. during action callbacks), or one can specify an object. In some other case, a plain name must be used, and you must tell CGI::MxScreen in which packages it should look to find that name.

This is analogous to the PATH search done by the shell. Unless you specify an absolute path, the shell looks throughout your defined PATH directories, stopping at the first match.

Here, we're looking through package namespaces. For instance, given the name "is_num", we could check main::is_num, then Your::Module::is_num, etc... That's what the utility path is.

The routine CGI::MxScreen::add_utils_path must be used before the creation of the CGI::MxScreen manager, and takes a list of strings, which define the package namespaces to look through for field validation callbacks and patching routines. The reason it must be done before is that incoming CGI parameters are currently processed during the manager's creation routine.

LOGGING

Top

During its operation, CGI::MxScreen can emit application logs. The amount emitted depends on the configuration, as described in CGI::MxScreen::Config.

Logs are emitted with the session number prefixed, for instance:

    (192.168.0.3-29592) t=0.13s usr=0.12s sys=0.01s [screen computation]

The logged session number is the IP address of the remote machine, and the PID of the script when the session started. It remains constant throughout all the session.

There is also some timestamping and process pre-fixing done by the underlying logging channel. See Log::Agent::Stamping for details. The so-called "own" date stamping format is used by CGI::MxScreen, and it looks like this:

    01/04/18 12:08:22 script:

showing the date in yy/mm/dd format, and the time in HH::MM::SS format. The script: part is the process name, here the name of your CGI script.

At the "debug" logging level, you'll get this whole list of logs for every intial script invocation:

    [main/0] t=0s u="ram" q="id=4"
    using "Mozilla/4.75 [en] (X11; U; Linux 2.4.3-ac4 i686)"
    t=0.20s usr=0.17s sys=0.01s [context restore + log init]
    t=1.15s usr=0.86s sys=0.05s [parameter init]
    t=1.71s usr=0.61s sys=0.07s [outside CGI::MxScreen]
    main()
    t=0.13s usr=0.12s sys=0.01s [screen computation]
    t=46.46s usr=43.42s sys=1.67s ["main" display]
    t=0.30s usr=0.29s sys=0.02s [context save]
    t=50.01s usr=45.53s sys=1.83s [total time] T=52.45s

The t=0s indicates the start of a new session, and u="ram" signals that the request is made for an HTTP-authenticated user named ram. The [main/0] indicates that we're in the state called main, and 0 is the interaction counter (incremented at each roundtrip). The q="id=4" traces the query string.

The next line traces the user agent, and is only emitted at the start of a new session. May be useful if something goes wrong later on, so that you can suspect the user's browser.

Then follows a bunch of timing lines, each indicating what was timed in trailing square brackets. The final total summs up all the other lines, and also provides a precious T=52.45s priece of statistics, measuring the total wallclock time since the script startup. This helps you evaluate the overhead of loading the various modules.

The single main() line traces the state information. Here, since this is the start of a new session, we enter the initial state and there's no state transition.

Note the very large time spent by the display() routine for that screen. This is because Carp::Datum was on, and there was a lot of activity to trace.

Compare this to the following log, where the user pressed a button called refresh, which simply re-displays the same screen, and where Carp::Datum was turned off:

    [main/1] t=1m11s d=19s u="ram"
    t=0.90s usr=0.83s sys=0.08s [context restore + log init]
    t=0.01s usr=0.00s sys=0.00s [parameter init]
    t=0.02s usr=0.02s sys=0.00s [outside CGI::MxScreen]
    main() -> main() on "refresh" pressed
    t=0.02s usr=0.01s sys=0.00s [screen computation]
    t=0.56s usr=0.58s sys=0.00s ["main" display]
    t=0.05s usr=0.05s sys=0.00s [context save]
    t=1.56s usr=1.50s sys=0.08s [total time] T=3.24s

The new d=19s item on the first line indicates the elapsed time since the end of the first invocation of the script, and this new one. It is the time the user contemplated the screen before pressing a button.

Note that there is no q="id=4" shown: CGI::MxScreen uses POST requests between its invocations, and does not propagate the initial query string. It is up to you to save any relevant information into the context.

The following table indicates the logging level used to emit each of the logging lines outlined above:

   Level    Logging Line Exerpt
   -------  --------------------------------
   warning  [main/1] ...
   info     using "Mozilla/4.75...
   debug    ... [context restore + log init]
   debug    ... [parameter init]
   debug    ... [outside CGI::MxScreen]
   notice   main() -> main() on "refresh"...
   debug    ... [screen computation]
   debug    ... ["main" display]
   debug    ... [context save]
   info     ... [total time] T=3.24s

All timing logs but the last one summarizing the total time are made at the debug level. All state transitions (button press, or even bounce exceptions) are logged at the notice level. Invocations are logged at the warning level, in order to trace them more systematically.

BUGS

Top

There are still some rough edges. Time will certainly help polishing them.

If you find any bug, please contact both authors with the same message.

HISTORY AND CREDITS

Top

CGI::MxScreen began when Raphael Manfredi, who knew next to nothing about CGI programming, stumbled on the wonderful MxScreen program, by Tom Christiansen, circa 1998. It was a graphical query compiler for his Magic: The Gathering database. I confess I learned eveything there was to learn about by studying this program. I owed so much to that MxScreen script that I decided to keep the name in the module.

However, MxScreen was a single application, very well written, but not reusable without doing massive cut-and-paste, and rather monolithic. The first CGI::MxScreen version was written by Raphael Manfredi to modularize the various concepts in late 1998 and early 1999. It was never published, and was too procedural.

In late 1999, I introduced my CGI::MxScreen to Christophe Dehaudt. After studying it for a while, he bought the overall concept, but proposed to drop the procedural approach and switch to a pure object-oriented design, to make the framework easier to work with. I agreed.

The current version of CGI::MxScreen is the result of a joint work between us. Christophe did the initial experimenting with the new ideas, and Raphael consolidated the work, then wrote the whole documentation and regression test suite. We discussed the various implementation decisions together, and although the result is necessarily a compromise, I (Raphael) believe it is a good compromise.

We managed to use CGI::MxScreen in the industrial development of a web-based project time tracking system. The source was well over 20000 lines of pure Perl code (comments and blank lines stripped), and we reused more than 50000 lines of CPAN code. I don't think we would have succeeded without CGI::MxScreen, and without CPAN.

The public release of CGI::MxScreen was delayed more than a year because the dependencies of the module needed to be released first, and also we were lacking CGI::Test which was developped only recently. Without it, writing the regression test suite of CGI::MxScreen would have been a real pain, due to its context-sensitive nature. See CGI::Test if you're curious.

AUTHORS

Top

The original authors are Raphael Manfredi <Raphael_Manfredi@pobox.com> and Christophe Dehaudt <Christophe.Dehaudt@teamlog.fr>.

Send bug reports, suggestions, problems or questions to Jason Purdy <Jason@Purdy.INFO>

SEE ALSO

Top

CGI::MxScreen::Config(3), CGI::MxScreen::Screen(3), CGI::MxScreen::Layout(3).

CGI-MxScreen documentation Contained in the CGI-MxScreen distribution. 
# -*- Mode: perl -*-
#
# $Id: MxScreen.pm,v 0.1.1.1 2001/05/30 21:13:07 ram Exp $
#
#  Copyright (c) 1998-2001, Raphael Manfredi
#  Copyright (c) 2000-2001, Christophe Dehaudt
#  
#  You may redistribute only under the terms of the Artistic License,
#  as specified in the README file that comes with the distribution.
#
# HISTORY
# $Log: MxScreen.pm,v $
# Revision 0.1.1.1  2001/05/30 21:13:07  ram
# patch1: fixed HISTORY section
# patch1: random cleanup in named argument docs
# patch1: updated version number
#
# Revision 0.1  2001/04/22 17:57:03  ram
# Baseline for first Alpha release.
#
# $EndLog$
#


use strict;

package CGI::MxScreen;

use vars qw($VERSION $BIN_VERSION);
$VERSION = '0.103';
$BIN_VERSION = '0.1';

use CGI::MxScreen::Constant;
use CGI::MxScreen::Error;
use Carp::Datum;
use Log::Agent;
use Getargs::Long;
use Time::HiRes qw(time);

require CGI;
require CGI::MxScreen::Form::Field;
require CGI::MxScreen::Form::Button;
require CGI::MxScreen::Layout;
require CGI::MxScreen::Session;

my @managers;		# For END {}

#
# ->make
#
# Creation routine.
#
sub make {
    DFEATURE my $f_;
    my $self = bless {}, shift;
	my ($tm_start, $tm_user, $tm_sys) = (time, times);

	#
	# Prevent anything to be written to STDOUT by tieing it to a package
	# that will log anything written there, without letting it go through.
	#

	require CGI::MxScreen::Tie::Stdout;
	tie *main::STDOUT, "CGI::MxScreen::Tie::Stdout";

	#
	# Argument parsing.
	#

    (
		$self->{_screen_list},
		$self->{_initial_state}, 
		$self->{_cgi_version},
		$self->{_valid_time},
		$self->{_bgcolor},
		$self->{_layout},
	) =
		cxgetargs(@_,
			-screens	=> 'HASH',
			-initial	=> undef, 
			-version	=> [undef, '1.0'],
			-timeout	=> ['i'],
			-bgcolor	=> [undef, '#bfbfbf'],
			-layout		=> ['CGI::MxScreen::Layout'],
		);
    
	$self->{_start_times} = [$tm_start, $tm_user, $tm_sys];
	$self->{_last_times} = [$tm_start, $tm_user, $tm_sys];
	$self->{_layout} = CGI::MxScreen::Layout->make()
		unless defined $self->{_layout};

	#
	# Perform default initialization if not already done via a call
	# to "use CGI::MxScreen::Config;".
	#

	require CGI::MxScreen::Config;
	CGI::MxScreen::Config::configure();		# Will return if already done

	if (defined $CGI::MxScreen::Config::LOG) {
		$self->{_log} = $CGI::MxScreen::Config::LOG;
	} else {
		use File::Spec;
		require Log::Agent::Logger;
		require Log::Agent::Channel::File;

		my $devnull = Log::Agent::Channel::File->make(
			-filename		=> File::Spec->devnull,
			-no_prefixing	=> 1,
			-no_ucfirst		=> 1,
			-no_newline		=> 1,
		);
		$self->{_log} = Log::Agent::Logger->make(-channel => $devnull);
	}

	#
	# Now that logging is up, validate the creation routine parameters.
	#

	logcroak "-initial must be either a plain scalar or an ARRAY ref"
		if ref $self->initial_state && ref $self->initial_state ne "ARRAY";

	my $state_name = ref $self->initial_state ?
		$self->initial_state->[0] : $self->initial_state;

	logcroak "initial state '$state_name' is not a known state"
		unless $self->is_valid_state($state_name);

	#
    # Initialize whole script context.
	#

	$self->trace_incoming;	# XXX if logtrace_at("info") or logdebug_at("warn")

	my $session = $self->{_session} = CGI::MxScreen::Session->make(
		-serializer		=> $CGI::MxScreen::Config::SERIALIZER,
		-medium			=> $CGI::MxScreen::Config::MEDIUM,
	);

	$self->{_context} = $session->restore;
	$self->check_validity();

	#
	# Relink all serialized screens to the new manager.
	#

	my $ctx = $self->ctx;

	if (exists $ctx->{'screens'}) {
		foreach my $screen (values %{$ctx->{'screens'}}) {
			$screen->relink_to_manager($self);
		}
	}

	#
	# For session logging, maintain the following parameters in
	# the private CGI::MxScreen context.
	#
	#    log_session    unique session ID for logging (IP number-PID)
	#    log_starttime  time when session started
	#    log_cnt        counter incremented each time we're invoked
	#
	#

	unless (exists $ctx->{'log_session'}) {
		$ctx->{'log_session'} = CGI::remote_host() . "-" . $$;
		$ctx->{'log_starttime'} = int(time);
		$ctx->{'log_cnt'} = 0;
	} else {
		$ctx->{'log_cnt'}++;
	}

	#
	# From now on, all Log::Agent messages will bear the session ID.
	#

	require Log::Agent::Tag::String;
	use Log::Agent qw(logtags);

	my $tag = Log::Agent::Tag::String->make(
		-name		=> "session id",
		-value		=> "(" . $ctx->{'log_session'} . ")",
	);

	my $log = $self->log;
	$log->tags->append($tag);
	logtags()->append($tag);

	$log->warning("");
	$log->warning(\&log_session, $self);
	$log->info(\&log_agent, $self);
	$log->debug(\&log_inc_times, $self, "context restore + log init");

	#
	# Process incoming parameters, trap all errors.
	#
	# Since we might be using CGI::Carp, we must cancel any trap hook by
	# localizing the __DIE__ and __WARN__ special handlers.
	#

	eval {
		local $SIG{__DIE__};
		local $SIG{__WARN__};

		$self->process_params;
	};
	$log->debug(\&log_inc_times, $self, "parameter init");
	$self->internal_error($@) if chomp $@;

	push(@managers, $self);

    return DVAL $self;
}

#
# ->process_params
#
# Get CGI parameters, fill internal data structures.
#
sub process_params {
	DFEATURE my $f_;
	my $self = shift;

    #
    # Save params provided by CGI
    #
    # It is a quite big story because there are different possiblities
    # for the store location according to the way the fields have been
    # recorded, and also according to the storage indication settings.
    #
    # When the field has been recorded at display time (use of
    # record_field method), it might contain some storage indications
    # (see Form::Field). It may also contain an indication to not save
    # the value (useful for password). Anyway, when the incoming param
    # matches a recorded field from the last display, the store_value
    # method of the field is invoked to perform the task according to
    # the indication. Returning true indicates there is no need to
    # save the param value in the MxScreen repository (see
    # below). Actually, either the value has been save somewhere else
    # or there were some indication to not keep the value persistent.
    # 
    # When there is no specific indication for the storage (either the
    # field has not been recorded but has been merely displayed, or
    # the store_value method returned false), the value is memorized
    # into the MxScreen repository for the orphan params. It is a
    # dedicated section of the context. Each orphan params is stored
    # in that section under the index of the screen name. All the orphan
    # params are replayed --put into the CGI param list-- to benefit
    # from their values when the field is once again displayed.
    #
    # NOTES: You have to know that a button press returns also a value
    # into the incoming CGI param list. The following code needs to
    # take care of that by filtering them before being considered as
    # orphan fields. For simple button, it is quite easy since the
    # param name must have been recorded into the Mxscreen Button
    # list, but for image button the returned param does not match
    # exactly the one recorded. For this latter button, the returned
    # param is in fact 2 params which indicates the click
    # location. Their name is composed by the param name (recorded in
    # the Mxscreen Button list) plus '.x' or '.y'.
    #
    # NOTES: CGI param list does not alway returned a value for all
    # displayed field of the screen. For some specific elements (for
    # instance checkbox group), no value is returned when the field is
    # cleared (no box checked in the previous example). This clear
    # value must however be saved into the storage location. To cope
    # this problem, all the known displayed fields (those in the
    # recorded list of fields, and those in the orphan repository of
    # the screen) are checked to validate the existence of a value
    # into the CGI param list. When no value is found, a clear value
    # ('') is enforced.
    #

    # load the package of the last screen where all needed classes
    # should have been defined.
    my $current_state = $self->initial_state;
    $current_state = $self->ctx->{'current_state'} if
      (defined $self->ctx->{'current_state'});
    my ($screen_name) = $self->scatter($current_state);
    $self->load_screen_package($screen_name);

    # build a easy access way to recorded field and button: make a
    # hash from the array
    my $var_ctx = $self->context(PERSISTENT);
    my $field_hash = {};
    for my $field (@{$self->context(SCREEN_FIELD)}) {
        DASSERT $field->isa('CGI::MxScreen::Form::Field');
        $field_hash->{$field->name} = $field;
    }

    my $button_hash = {};
    for my $button (@{$self->context(SCREEN_BUTTON)}) {
        DASSERT $button->isa('CGI::MxScreen::Form::Button');
        $button_hash->{$button->name} = $button;
    }

	#
    # Patch the CGI param list for fields which are known to be
    # displayed but no value appears in the CGI list.
	#

    my $cgi_param = $self->context(CGI_PARAM);

    while (my ($k, $v) = each %{$cgi_param->{$screen_name}}) {
        CGI::param(-name => $k, -values => $v) unless 
          defined CGI::param($k);
    }
    while (my ($k, $v) = each %$field_hash) {
        CGI::param(-name => $k, -values => $v->value) unless 
          defined CGI::param($k);
    }
    
    # walkthrough the CGI param list to store values
    for my $param (CGI::param()) {
        DTRACE "storing incoming param $param";
        my $field = $field_hash->{$param};

        # return form CGI param might be either a single element or a
        # list of elements. To get all of them, an array context must
        # be used. Then, the value that will be stored is either the
        # array reference or the first and single element of the
        # array.
        my @value = CGI::param($param);
        my $value = $#value == 0 ? $value[0]: \@value;

        if (defined $field) {
			#
            # Patch the value (if needed)
            # Then store value according to the storage indication given in
            # the field (if any)
			#
			my ($patched, $nvalue) = $field->patch_value($value);
			if ($patched) {
				CGI::param(-name => $param, -values => $nvalue) if $patched;
				next if $field->store_value($var_ctx, $nvalue);
			} else {
				next if $field->store_value($var_ctx, $value);
			}
        }
        # no storage indication is present

        #
        # perhaps it was a button rather than a field
        #

        # image button press is embarrassing. In such a case, the
        # returned param is not 1 but 2 params which represents the
        # location of the click within the image
        if ($param =~ /(.*)\.([xy])$/) {
            if (defined (my $x = CGI::param("$1.x")) &&
                defined (my $y = CGI::param("$1.y"))) {
                next if $2 eq "y"; # do the job only for x
                $param = $1;
            }
        }

        if (defined $button_hash->{$param}) {
            $self->internal_error(
                "invalid input form: buttons '" . $self->button_pressed->name .
                 "' and '$param' were simultaneously pressed!")
              if defined $self->button_pressed;

            # Remember it as the button that was pressed
            $self->{_button_pressed} = $button_hash->{$param};
            next;
        }

        # It is an orphan field that has not been saved.  Keep it in
        # mind into the param repository.  The param context is stored
        # under the name of the screen to build a kind of
        # hierachy. That allows the clean up functionality when
        # leaving a screen (on explicit request).
        $cgi_param->{$screen_name}->{$param} = $value;
    }

    # all orphan params will populate the CGI's param list if they are
    # not already present. That will allow to prefill fields when
    # redisplay and to give an access to their values with regular
    # CGI::param().
    #
    # Information is organized in a hash table where the key is the
    # screen id (state name) and the value is another hash. The latter
    # contains the pair of data: symbol, value that must be restored.
    while (my ($screen , $hash) = each %$cgi_param) {
        while (my ($k, $v) = each %$hash) {
            CGI::param(-name => $k, -values => $v);
        }
    }

	return DVOID;
}


#########################################################################
# Internal Attribute Access: these methods are not intended to be used  #
# from the external world.                                              #
#########################################################################

sub screen_list    { $_[0]->{'_screen_list'} }
sub context_root   { $_[0]->{'_context'} }
sub screen         { $_[0]->{'_screen'} }
sub session        { $_[0]->{'_session'} }
sub cgi_version    { $_[0]->{'_cgi_version'} }
sub valid_time     { $_[0]->{'_valid_time'} }
sub initial_state  { $_[0]->{'_initial_state'} }
sub bgcolor        { $_[0]->{'_bgcolor'} }
sub layout         { $_[0]->{'_layout'} }
sub log            { $_[0]->{'_log'} }
sub start_times    { $_[0]->{'_start_times'} }
sub last_times     { $_[0]->{'_last_times'} }

sub button_pressed { $_[0]->{_button_pressed} }
sub ctx            {
	defined $_[0]->{'_context'} ? $_[0]->{'_context'}->[MXSCREEN] : {}
}

#
# ->is_valid_state
#
# Check whether state is known
#
sub is_valid_state {
    DFEATURE my $f_;
    my $self = shift;
    my ($state) = @_;

    return DVAL exists $self->screen_list->{$state};
}

#
# ->load_screen_package
#
# Load source file for the class implementing the screen $name, unless
# it is already present.
#
sub load_screen_package {
    DFEATURE my $f_;
    my $self = shift;
    my ($name) = @_;

    DREQUIRE $self->is_valid_state($name), "valid state '$name'";

    my ($class_name) = cgetargs(@{$self->screen_list->{$name}}, 
                                {-strict => 0},
                                qw(class));

	#
	# The following eval "" attempts to load the screen class by using
	# a require, assuming there is one class by file.  However, we
	# check for the presence of an @ISA variable in the target package
	# before performing the require, since the application could have
	# already loaded all the screen classes.  Given that all screens must
	# inherit from CGI::MxScreen::Screen, we know @ISA is defined if the
	# package is present.
	#

	eval "require $class_name unless defined \@${class_name}::ISA;";
	if (chomp $@) {
		logerr "loading of $class_name failed: $@";
		logdie "can't locate class \"$class_name\" for screen state \"$name\"";
	}

    return DVOID;
}

#
# ->make_screen
#
# Create the screen for given state.
#
sub make_screen {
    DFEATURE my $f_;
    my $self = shift;
    my ($name) = @_;

    DREQUIRE $self->is_valid_state($name), "valid state '$name'";

    $self->load_screen_package($name);
    my ($class_name, @remaining) = cgetargs(@{$self->screen_list->{$name}},
                                            {-strict => 0, -extra => 1},
                                            qw(class));

	#
	# If the state has already been seen already, it has been serialized
	# in the context, but it needs to be relinked to the new manager instance.
	#
	# Otherwise, a new object is created and remembered in the context.
	#

	my $cxt = $self->ctx;		# CGI::MxScreen own private context
	my $screen;

	if (exists $cxt->{'screens'}->{$name}) {
		$screen = $cxt->{'screens'}->{$name};
		$screen->remake($self);
	} else {
		$screen = $class_name->make(
			-manager => $self,
			-name    => $name,
			@remaining
		);
		$cxt->{'screens'}->{$name} = $screen;
	}

    return DVAL $screen;
}

#
# ->scatter
#
# Return:
#   either a list with a single element when incoming param is a
#   scalar value or a list with all element of the incoming list.
#
sub scatter {
    DFEATURE my $f_;
    my $self = shift;
    my ($id) = @_;

    return DARY @$id if ref $id eq 'ARRAY';
    return DARY ($id);
}

#
# ->obj_scatter
#
# Same as scatter(), but handles ($obj, $routine, @args) as well.
# Supplies the screen if no blessed object is identified in the first
# position of the list.
#
sub obj_scatter {
    DFEATURE my $f_;
    my $self = shift;
    my ($screen, $id) = @_;

	return DARY ($screen, $id) unless ref $id eq 'ARRAY';

	if (ref $id->[0] && UNIVERSAL::isa($id->[0], "UNIVERSAL")) {
		$screen = $id->[0];
		return DARY ($screen, @$id[1..$#$id]);
	}

	return DARY ($screen, @$id);
}

#########################################################################
# Class Feature: usable from the external world                         #
#########################################################################

#
# ->context
#
# return a reference of a given section withtin the overal context
# area
#
# Arguments:
#   $index: index of the context section to returned
#
# Return:
#   a reference to the requested context section
#
sub context {
    DFEATURE my $f_;

    DREQUIRE $_[1] =~ /^\d+$/;
	DREQUIRE $_[1] >= 0 && $_[1] < CONTEXT_COUNT;

    return DVAL $_[0]->context_root->[$_[1]];
}

#
# ->spring_screen
# ->previous_screen
# ->current_screen
#
# Returns [state, display_args]
#
sub spring_screen {
    DFEATURE my $f_;
    return DVAL $_[0]->ctx->{'spring_state'};		# Last stable state(args)
}
sub previous_screen {
    DFEATURE my $f_;
    return DVAL $_[0]->ctx->{'previous_state'};		# Previous state(args)
}
sub current_screen {
    DFEATURE my $f_;
    return DVAL $_[0]->ctx->{'current_state'};		# Current state(args)
}


#
# ->play
#
# Play the sequence of action necessary to display the new screen.
#
sub play {
    DFEATURE my $f_;
    my $self = shift;

# coderef is a temporary arg until storable is able to select things to
# store (storable::Hook)
    my ($coderef) = @_;

	my $log = $self->log;
	$log->debug(\&log_inc_times, $self, "outside CGI::MxScreen");

	#
	# Compute target screen, trap all errors.
	#
	# Since we might be using CGI::Carp, we must cancel any trap hook by
	# localizing the __DIE__ and __WARN__ special handlers.
	#

	my ($screen, $args);
	eval {
		local $SIG{__DIE__};
		local $SIG{__WARN__};

		($screen, $args) = $self->compute_screen;
	};
	$log->debug(\&log_inc_times, $self, "screen computation");
	$self->internal_error($@) if chomp $@;

	#
	# Emit CGI headers
	# From now on, output is safe and will not get us a server error.
	#

	untie *main::STDOUT;			# Restore original STDOUT stream

	#
	# If they configured us to buffer all STDOUT until context is ready
	# to be emitted, then create object, print headers and mark the
	# output of headers as done: further output to STDOUT will be buffered
	# and printed only after the context.
	#
	# The reason for this is to have the context emitted before any other
	# form widget.  That way, pressing a submit button before the whole form
	# is loaded in the browser won't matter as much, since we'll have at
	# least the context to propagate in the POST parameters.
	#

	my $stdout;
	if ($CGI::MxScreen::cf::mx_buffer_stdout) {
		require CGI::MxScreen::Tie::Buffered_Output;
		$stdout = tie *main::STDOUT, "CGI::MxScreen::Tie::Buffered_Output";
	}

	#
	# Display screen, with proper "bounce" exception support.
	# Returns screen that was finally displayed.
	#

	$screen = $self->display($screen, $args, $stdout);
	$log->debug(\&log_inc_times, $self, "\"%s\" display", $screen->name);

	#
	# Snapshot current time and last modification date of the
	# scriptright before saving context.  That fields can be used to
	# check for session validity.
	#

    $self->ctx->{'time'} = time;
    $self->ctx->{'script_date'} = (stat($0))[9]; 

	#
	# Cleanup context to avoid saving transient data
	#

    &{$coderef}() if defined $coderef; # TBR

    for my $f (@{$self->context_root->[SCREEN_FIELD]}) {
        DASSERT $f->isa('CGI::MxScreen::Form::Field');
        $f->cleanup();
    }
    for my $b (@{$self->context_root->[SCREEN_BUTTON]}) {
        DASSERT $b->isa('CGI::MxScreen::Form::Button');
        $b->cleanup();
    }

	#
	# If STDOUT was bufferd, the context must be emitted explicitely
	# between the header of the form and the remaining data.
	#

	if (defined $stdout) {
		my $context = $self->session->save;
		$stdout->print_all($context);
		untie_stdout();
	} else {
		print $self->session->save;
	}

	$log->debug(\&log_inc_times, $self, "context save");

	#
	# Emit CGI trailers.
	#

	print CGI::endform;

	my $layout = $self->layout;
	$layout->postamble;
	$layout->end_HTML;

    return DVOID;
}

#
# ->compute_screen
#
# Compute target screen, and run and enter/leave hooks if we change screens.
# This routine does not display anything, but runs all the action callbacks.
#
# Returns new screen object, and a ref to the argument list.
#
sub compute_screen {
	DFEATURE my $f_;
	my $self = shift;
    my ($current_state, $previous_state, $new_state);
    my ($origin_name, $target_name, @arg_list);
    my $screen;
	my $errors = 0;
    my $ctx = $self->ctx;

   
    # get the current state from the context its format can be either
    # 'screen_name' or ['screen_name', @arg_list]. 'screen_name' is the
    # symbol key given to a screen name into the given screen list (at
    # make time) and @arg_list is a list of arg to pass to the display
    # routine of the screen.

    $current_state = $self->initial_state;
    $current_state = $ctx->{'current_state'} if
      (defined $ctx->{'current_state'});

    $previous_state = $current_state;
    $new_state = $current_state;

    #
    # Compute the destination and process the associated actions when
    # a button has been detected as pressed (during the make method).
	#
	# If we could not identify a button that was pressed, we'll simply
	# remain in the current state and re-display the form unless there was
	# a default button recorded in the previous screen.
    #

	my $button_pressed = $self->button_pressed;

	if ($ctx->{'log_cnt'} && !defined $button_pressed) {

		#
        # Create the previous screen to lookup for a default button
		#

        ($origin_name) = $self->scatter($previous_state);
        $screen = $self->make_screen($origin_name);
		my $default = $screen->default_button;

		if (defined $default) {
			$button_pressed = $self->{_button_pressed} = $default;
			$self->log->warning("no button pressed, using default \"%s\"",
				$default->value);
		} else {
			$self->log->error(
				"no button pressed, no default, will stay in same state");
		}
	}

    if (defined $button_pressed) {
     
		#
        # Create the previous screen to perform the actions
		# Screen could have been created above, during the default
		# button computation, hence the check.
		#

		unless (defined $screen) {
			($origin_name) = $self->scatter($previous_state);
			$screen = $self->make_screen($origin_name);
		}

		# Those are not serialized
		DASSERT !defined $screen->error_env, "no callback error condition";
		DASSERT !defined $screen->error, "no user error condition";

		my $act_env;					# Action environment

        if (defined $button_pressed->action) {
            DASSERT ref $button_pressed->action eq 'ARRAY';

			use CGI::MxScreen::Error qw(is_mx_errcode);
			require CGI::MxScreen::Action_Env;

			$act_env = CGI::MxScreen::Action_Env->make();

            for my $action (@{$button_pressed->action}) {
                my ($obj, $routine, @routine_arg) =
					$self->obj_scatter($screen, $action);

				my $errcode = $obj->$routine(@routine_arg, $act_env);

				#
				# Temporary safety net whilst migration of all callback
				# returned values is ongoing.
				#

				if ($errcode == 0 || $errcode == 1) {
					logwarn "callback %s->%s returned OLD boolean status",
						ref $obj, $routine;
					$errcode = $errcode ? CGI_MX_OK : CGI_MX_ABORT;
				}

				VERIFY is_mx_errcode($errcode),
					"callback ", ref($obj), "->$routine returns valid code",
					" -- returned $errcode";

				next if $errcode == CGI_MX_OK;

				#
                # an error occurred, don't process the remaining
                # of actions if it is CGI_MX_ABORT.
				#
				# The screen is tagged with an error flag and the state
				# destination is resumed to the origin screen.
				#

				my $called = sprintf "%s->%s", ref($obj), $routine;
				my $binfo = sprintf "for button \"%s\"",
					$button_pressed->value;
				$binfo .= sprintf " (%s)", $button_pressed->name
					if $button_pressed->name ne $button_pressed->value;

                DTRACE "error in action callback: $called $binfo";
                $self->log->error("action callback $called failed $binfo%s",
					$errcode == CGI_MX_ABORT ? ", aborting" : "");

				$errors++;
                $screen->set_error_env($act_env);
				$act_env->add_error($obj, $routine, \@routine_arg);
				last if $errcode == CGI_MX_ABORT;
			}

			$new_state = $current_state if $errors;
        }
        
		#
        # Get the destination
		#
		#  * when an error was found, we look at -on_error or -dyn_on_error,
		#    and if one is found, we clear the error condition.
		#  * when no error is raised, we look at -dyn_target or -target.
		#

        if ($errors) {
			#
			# Look for possible error trapping, which will force a move to
			# an alternate screen.  The error condition is reset, therefore
			# the internal context of the screen will be cleared.
			#
			# For -dyn_on_error, we append the action environment.
			#

			DASSERT defined $act_env, "at least one action ran";

            if ($button_pressed->has_error_trap) {
				my $dyn = $button_pressed->dyn_on_error;
				if (defined $dyn) {
					my ($routine, @args) = $self->scatter($dyn); 
					DASSERT $screen->can($routine);
					$new_state = $screen->$routine(@args, $act_env);
				} else {
					$new_state = $button_pressed->on_error;
				}
				DASSERT defined $new_state;
				$errors = 0;			# Moving to alternate screen
			}
		} else {
			#
			# No error found.
			#

            if ($button_pressed->is_computed_target) {
                my ($routine, @args) = 
                  $self->scatter($button_pressed->dyn_target); 
                DASSERT $screen->can($routine);

                $new_state = $screen->$routine(@args);
            }
            else {
                $new_state = $button_pressed->target;
            }
        }
    }

    # clear context area dedicated to save field handles
    $self->context_root->[SCREEN_FIELD] = [];
    $self->context_root->[SCREEN_BUTTON] = [];
    # context might have been saved by the screen -> also clear the copy
    $screen->_clear_internal_context() if defined $screen && !$errors;

	#
    # update the MXSCREEN context
	#
    $ctx->{'current_state'} = $new_state;
    $ctx->{'previous_state'} = $previous_state unless $errors;
    $ctx->{'cgi_version'} = $self->cgi_version;
    $ctx->{'bin_version'} = $BIN_VERSION;

	$self->log->notice(\&log_state, $self, $previous_state, $new_state);

    #
    # Create the destination state (if needed)
	# Then call ->leave and ->enter hooks.
    #

    ($target_name, @arg_list) = $self->scatter($new_state);
	unless (defined $screen && $target_name eq $origin_name) {
		my $prev_screen = $screen;
		$screen = $self->make_screen($target_name);
		if (defined $prev_screen) {
			$prev_screen->leave($screen);
			$ctx->{'spring_state'} = $previous_state;	# Where we came from
		}
		$screen->enter($prev_screen);
	}

    return DARY ($screen, \@arg_list);
}

#
# ->display
#
# Display $screen, with args @$args, with proper support for screen "bounce".
#
# If $stdout is not undef, then it is a ref to a tied object, meaning STDOUT
# is buffered.  When bouncing with untied STDOUT, the layout and the headers
# can only be emitted once, i.e. for the original screen.  A warning is issued
# if bouncing.
#
# Returns screen that was finally displayed.
#
sub display {
	DFEATURE my $f_;
	my $self = shift;
	my ($screen, $args, $stdout) = @_;

	for (my $i = 0; $i < 20; $i++) {		# Max 20 bounces

		#
		# Can only emit the layout and the header each time when $stdout
		# is tied.  We always emit the first time, naturally, since we
		# don't know whether we'll bounce at all.
		#

		if ($i == 0 || defined $stdout) {

			#
			# The layout object controls the following aspects:
			#
			#  html headers
			#    preamble
			#      <form goes here>
			#    postabmle
			#  html trailers
			#

			my $layout = $self->layout;

			$layout->init($screen);
			$layout->start_HTML(
				-title		=> $screen->screen_title,
				-bgcolor	=> $screen->bgcolor,
			);
			$layout->preamble;

			#
			# Start the form
			#

			my @args = (-method => 'POST', -action => CGI::url());
			print $CGI::DISABLE_UPLOADS ?
				CGI::startform(@args) : CGI::start_multipart_form(@args);

		}

		$stdout->header_ok if defined $stdout;		# Buffer remaining as BODY

		#
		# Display target screen, trap all errors.
		#

		eval {
			local $SIG{__DIE__};
			local $SIG{__WARN__};

			$screen->display(@$args);
		};

		#
		# Deal with "bounce" exceptions.
		#

		if (ref $@ && $@->isa("CGI::MxScreen::Exception::Bounce")) {
			my $old_state = $self->current_screen;
			my $new_state = $@->target;
			my $log = $self->log;
			my $old_name = $screen->name;
			my $old_screen = $screen;

			$log->notice(\&log_bounce, $self, $old_state, $new_state, $@);
			$log->debug(\&log_inc_times, $self, "bounce on \"%s\"", $old_name);

			my ($target_name, @arg_list) = $self->scatter($new_state);

			#
			# Clear buffered data in tied STDOUT, so we may start afresh
			# with new screen.  If the old screen had started emitting data
			# before bouncing, warn them: the screen should not have done so
			# anyway, so we may discard data bluntly.
			#

			if (defined $stdout) {
				my $discarded = $stdout->reset;
				logwarn "discarded %d byte%s emitted by \"%s\" " .
					"(before bouncing to \"%s\")",
					$discarded, $discarded == 1 ? "" : "s",
					$old_name, $target_name if $discarded;
			}

			#
			# Set args for next loop.
			#

			$screen = $self->make_screen($target_name);
			$args   = \@arg_list;
			$self->ctx->{'current_state'} = $new_state;

			#
			# Need to call ->leave() and ->enter() when states are different.
			# We pass undef to leave() to indicate that we left as the result
			# of a bounce.
			#
			# We don't alter `spring_state' though.
			#

			if ($target_name ne $screen->name) {
				$old_screen->leave(undef);				# Signals: bounced
				$screen->enter($old_screen);
			}

			next;			# Restart display loop
		}

		#
		# Regular display error.
		#

		if (ref $@ || chomp $@) {
			my $msg = $@;
			$msg =~ s/^\(.*?\)\s+//;	# Remove already added session tag
			$self->log->critical("display error for screen \"%s\": %s",
					$screen->name, $msg);

			#
			# If they buffered STDOUT, it's nice, because the screen will not
			# mix regular output and the error message.  And since we discard
			# even the form header, the Content-Type printed by CGI::Carp will
			# not even show!
			#

			untie_stdout(1) if defined $stdout;
			logdie $msg;
		}

		return DVAL $screen;		# Successfully displayed the screen
	}

	$self->log->critical("too many screen bounces");
	logdie "possible infinite loop detected, aborting";
}

#
# ->check_validity
#
# Check context validity: proper version, no timeout.
#
sub check_validity {
    DFEATURE my $f_;
    my $self = shift;

	unless (defined $self->context_root) {
		logerr "mangled context from %s", CGI::remote_host();
		$self->internal_error("cannot retrieve application context");
	}

    my $ctx = $self->ctx;
	return DVOID unless exists $ctx->{'cgi_version'};	# Empty context

	#
	# Ensure binary version (which traces variations in the way session
	# context are represented) is compatible.
	#

	my $bin = $ctx->{'bin_version'};
    if ($bin > $BIN_VERSION) {
        $self->internal_error(<<EOS);
Script session used a format (v$bin) more recent than I am (v$BIN_VERSION).
Please restart a new session.
EOS
	}

    #
    # check that the script file has not been modified (compare the
    # last modification time on the file system)
    #
    if ($ctx->{'script_date'} != (stat($0))[9]) {
        $self->internal_error(<<EOS);
Script file has been modified since the last display, 
please restart a new session.
EOS
    }

    #
    # check whether the cgi version is still the same
    #
    if (defined $ctx->{'cgi_version'}) {
        my $version = $ctx->{'cgi_version'};

        if ($version ne $self->cgi_version) {
            $self->internal_error(<<EOS);
Script version has evolved since the last display, please restart a new session.
EOS
        }
    }

    #
    # check whether the timeout is not exhausted
    #
    if (defined $self->valid_time && defined $ctx->{'time'}) {
        my $last_time = $ctx->{'time'};

        if ((time - $last_time) > $self->valid_time) {
            $self->internal_error(<<EOS);
Session timeout since the last display, please restart a new session.
EOS
        }
    }

    return DVOID;
}

#
# ->internal_error
#
#
sub internal_error {
    DFEATURE my $f_;
    my $self = shift;
    my ($message) = @_;

	my $logmsg = $message;
	$logmsg =~ s/\s+/ /sg;
	logerr "internal error: $logmsg";

	untie_stdout(1);		# Restore original STDOUT stream, discard all

	my $layout = $self->layout;

	$layout->init(undef);
	$layout->start_HTML("Internal Script Error");
	$layout->preamble;

    print CGI::h1("Internal Script Error");
    print CGI::p(CGI::tt(ucfirst($message)));
    print CGI::p(CGI::a({-href => CGI::url()}, "Restart a new session"));

	$layout->postamble;
	$layout->end_HTML;

	my $log = $self->log;
	$log->alert("internal error: $logmsg") if defined $log;

    exit 0;
}

#
# ->trace_incoming
#
# Trace incoming parameters
#
sub trace_incoming {
	DFEATURE my $f_;
	foreach my $p (CGI::param()) {
		my $value = CGI::param($p);
		DTRACE(TRC_INFO, "incoming param: '$p' => '$value'");
	}
	return DVOID;
}

#
# (log_session)			-- logging callback
#
# Log session state
#
sub log_session {
	DFEATURE my $f_;
	my $self = shift;
    my $current = $self->current_screen || $self->initial_state;
	my $cxt = $self->ctx;
	my $cnt = $cxt->{log_cnt};
	my ($state) = $self->scatter($current);
	my $user = CGI::remote_user();
	my @url_param = CGI::url_param();
	my $query = join(';', map { "$_=" . CGI::url_param($_) } @url_param);

	my $msg = sprintf "[%s/%d]", $state, $cnt;
	$msg .= sprintf " t=%s", relative_age(int(time) - $cxt->{log_starttime});
	$msg .= sprintf " d=%s", relative_age($^T - $cxt->{time}) if $cnt;
	$msg .= " u=\"$user\"" if $user;

	#
	# If there were no parameters on the URL, CGI still returns one entry
	# for a "keywords" parameter, so we need to guard against this as well.
	#

	$msg .= " q=\"$query\"" if $query ne '' && $query ne 'keywords=';

	return DVAL $msg;
}

#
# (log_state)			-- logging callback
#
# Log state change and button pressed
#
sub log_state {
	DFEATURE my $f_;
	my $self = shift;
	my ($old, $new) = @_;
	my $cxt = $self->ctx;
	my $cnt = $cxt->{log_cnt};

	my ($old_state, @old_args) = $self->scatter($old);

	my $msg = sprintf "%s%s",
		$old_state, @old_args ? ("(" . join(', ', @old_args) . ")") : "";

	unless ($cnt) {							# First time
		return DVAL '' unless @old_args;	# Don't log state if no args
		return DVAL $msg
	}

	my ($new_state, @new_args) = $self->scatter($new);

	$msg .= sprintf " -> %s%s",
		$new_state, @new_args ? ("(" . join(', ', @new_args) . ")") : "";

	#
	# Log button pressed, or bounce indication.
	#

	my $button = $self->button_pressed;
	if (defined $button) {
		my $name = $button->name;
		my $value = $button->value;
		$msg .= sprintf " on \"%s\" pressed", $value;
		$msg .= sprintf " (%s)", $name if $value ne $name;
	}

	return DVAL $msg;
}

#
# (log_bounce)			-- logging callback
#
# Log screen bounces
#
sub log_bounce {
	DFEATURE my $f_;
	my $self = shift;
	my ($old, $new, $bounce) = @_;
	my $cxt = $self->ctx;

	my ($old_state, @old_args) = $self->scatter($old);

	my $msg = sprintf "%s%s",
		$old_state, @old_args ? ("(" . join(', ', @old_args) . ")") : "";

	my ($new_state, @new_args) = $self->scatter($new);

	$msg .= sprintf " -> %s%s",
		$new_state, @new_args ? ("(" . join(', ', @new_args) . ")") : "";

	$msg .= " (via $bounce)";

	return DVAL $msg;
}

#
# (log_agent)			-- logging callback
#
# Log user agent
#
sub log_agent {
	DFEATURE my $f_;
	my $self = shift;
	my $cnt = $self->ctx->{log_cnt};
	return if $cnt;					# Nothing after first time
	return DVAL sprintf "using \"%s\"", CGI::user_agent();
}

#
# (log_inc_times)		-- logging callback
#
# Log incremental time between values recorded in last_times and now.
# Update last_times as a side effect for next incremental logging.
#
sub log_inc_times {
	DFEATURE my $f_;
	my $self = shift;
	my ($fmt, @args) = @_;			# Can be single string or (fmt, args)
	$fmt = sprintf $fmt, @args if @args;
	my $times = $self->last_times;
	my $new_times = [time, (times)[0,1]];
	$self->{_last_times} = $new_times;
	my @delta;
	for (my $i = 0; $i < @$times; $i++) {
		$delta[$i] = $new_times->[$i] - $times->[$i];
	}
	return DVAL sprintf "t=%.2fs usr=%.2fs sys=%.2fs [%s]", @delta, $fmt;
}

#
# (log_total_time)		-- logging callback
#
# Log total time spent since start_times.
#
sub log_total_time {
	DFEATURE my $f_;
	my $self = shift;
	my $times = $self->start_times;
	my $new_times = [time, (times)[0,1]];
	my @delta;
	for (my $i = 0; $i < @$times; $i++) {
		$delta[$i] = $new_times->[$i] - $times->[$i];
	}
	my $runtime = time - $^T;
	return DVAL sprintf "t=%.2fs usr=%.2fs sys=%.2fs [total time] T=%.2fs",
		@delta, $runtime;
}

#
# relative_age
#
# Given seconds, convert to 4d9h23m15s format.
#
sub relative_age {
	DFEATURE my $f_;
	my ($secs) = @_;
	my ($days, $hours, $mins);

	$days  = int($secs / (24 * 60 * 60));
	$secs -= $days     * (24 * 60 * 60);

	$hours = int($secs / (60 * 60));
	$secs -= $hours    * (60 * 60);

	$mins  = int($secs / 60);
	$secs -= $mins     * 60;

	my $retstr  = '';
	$retstr .= $days  . "d" if $days;
	$retstr .= $hours . "h" if $hours;
	$retstr .= $mins  . "m" if $mins;
	$retstr .= int($secs + 0.5) . "s";	# can be fractional with Time::HiRes

	return DVAL $retstr;
}

#
# ::add_utils_path              -- static
#
# Screen designers can identify new Form::Utils packages for their own
# specific uses with this routine. It must be invoked in the user
# script as a static routine => CGI::MxScreen::add_utils_path , and
# before the creation of the MxScreen object.
#
# NB: This routine name is misleading: it does not involve file paths, but
# module names.  The purpose is to allow some kind of routine lookup to
# be able to locate a validation routine named "is_time" for instance.
# I'm keeping it for now, because it's been used in production, but this
# mechanism will have to be revisited.
#	-- RAM, 13/04/2001
#
sub add_utils_path {
    DFEATURE my $f_;

    VERIFY defined($_[0]) && !UNIVERSAL::isa($_[0], __PACKAGE__);

	require CGI::MxScreen::Form::Utils;

    CGI::MxScreen::Form::Utils::add_path(@_);
    return DVOID;
}

#
# ::untie_stdout
#
# Safely untie STDOUT by forcing a DESTROY, in case someone holds a reference
# on the tied object.
#
sub untie_stdout {
    DFEATURE my $f_;
	my ($discard) = @_;
	my $stdout = tied *main::STDOUT;

	#
	# Within CGI::MxScreen, all the packages that can be tied to STDOUT are
	# heirs of CGI::MxScreen::Tie::Sinkable, which provides a discard_all()
	# method.
	#

	DASSERT !defined($stdout) || $stdout->isa("CGI::MxScreen::Tie::Sinkable");

	if (defined $stdout) {
		logtrc 'info', "un-tieing STDOUT (%s) with%s discarding",
			ref $stdout, $discard ? "" : "out";
		$stdout->discard_all if defined $discard && $discard;
		$stdout->DESTROY;
		untie *main::STDOUT;
	}
    return DVOID;
}

#
# END
#
# Whatever happens, log total running time, provided they created a manager.
#
sub END {
	untie_stdout();		# They might have not got a chance to do so yet

	#
	# Log running time, once per manager.
	#

	foreach my $self (@managers) {
		$self->log->info(\&log_total_time, $self);
	}
}

1;
__END__