vcp_ui.tt2 #19

package [% package %];

=begin hackers

[% autogenerated_warning %]

=end hackers

=head1 NAME

    VCP::UIMachines - State machines for user interface

=head1 SYNOPSIS

    Called by VCP::UI

=head1 DESCRIPTION

The user interface module L<VCP::UI|VCP::UI> is a framework that bolts
the implementation of the user interface to a state machine representing
the user interface.

Each state in this state machine is a method that runs the state and
returns a result (or dies to exit the program).

=cut

use strict;

use VCP::Debug qw( :debug );
use VCP::Utils qw( empty );

=head1 API

=over

=item new

Creates a new user interface object.

=cut

sub new {
    my $class = ref $_[0] ? ref shift : shift;
    my $self = bless { @_ }, $class;
}

=item run

Executes the user interface.

=cut

sub run {
    my $self = shift;
    my ( $ui ) = @_;

    $self->{STATE} = "init";
    while ( defined $self->{STATE} ) {
        debug "UI entering state $self->{STATE}" if debugging;
        no strict "refs";
        $self->{STATE} = $self->{STATE}->( $ui );
    }

    return;
}

=back

=head2 Interactive Methods

=over

=cut

use strict;

[%- FOR s = machine.states -%]

[%- SWITCH s.class_ids -%]

[%- CASE "entry_class" -%]

=item [% s.id %]

[% s.description | trim %]

Next state: [% s.arcs_from.to %]

=cut

sub [% s.id %] {
    return '[% s.arcs_from.to %]';
}

[%- CASE "exit_class" -%]

=item [% s.id %]

[% s.description | trim %]

=cut

sub [% s.id %] {
    return undef;
}

[%- CASE "prompt_class" -%]

=item [% s.id %]: [% s.name %]

[% s.description | trim %]

Valid answers:

[% FOR a = s.arcs_from -%]
    [% a.description %][% IF a.event.api %] ([%- a.event.api -%])[% END %] => [% a.to %]
[% END %]

=cut

sub [% s.id %] {
    my ( $ui ) = @_;

    my $default = undef;
    my $is_current_value = undef;

    ## Use single-quotish HERE docs as the most robust form of quoting
    ## so we don't have to mess with escaping.
    my $prompt = <<'END_PROMPT';
[% s.name %]
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
[% FOR a = s.arcs_from -%]
        [ '[% a.description %]',
        [%- IF a.guard %] [% a.guard -%],
        [%- ELSE %] qr/^/,
        [%- END %] '[% a.to -%]',
        [%- IF a.handlers %]
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                [%- FOR h = a.handlers %]
[% h | indent( '                ' )%]
                [%- END -%]
            },
        [% ELSE %]
            undef,
        [% END %]
        ],
[% END -%]
    );

    my $description = <<'END_DESCRIPTION';
[% s.description %]
END_DESCRIPTION

    [% FOR h = s.entry_handlers %]
[% h | indent( '    ' ) %]
    [% END -%]

    while (1) {
        my ( $answer, $answer_record ) =
            $ui->ask(
                0,
                $description,
                0,
                $prompt,
                $prompt,
                $default,
                $is_current_value,
                \@valid_answers
            );

        ## Run handlers for this arc, redo question if exceptions generated
        my $ok = eval {
            $answer_record->[-1]->( $ui, $answer, $answer_record )
                if defined $answer_record->[-1];
            1;
        };

        unless ( $ok ) {
            my $eval_error = $@;

            if ( $eval_error =~ /^warning:/i ) {
                ## recoverable error, ask if user wants to accept value anyway?
                my ( undef, $r ) = $ui->ask(
                    'error',
                    $eval_error,
                    1,
                    "Warning",
                    "Accept this value anyway",
                    "no",
                    0,
                    [
                        [ "yes", "yes", undef ],
                        [ "no",  "no",  undef ],
                    ]
                );
                next unless $r->[0] eq "yes";
            }
            else {
                ## completely un-acceptable exception, re-ask question.
                chomp $eval_error;
                warn "\n\n  $eval_error\n\n";
                next; 
            }
        }

        ## The next state
        return $answer_record->[-2];
    }
}

[%- END -%]

[%- END -%]

=back

=head1 WARNING: AUTOGENERATED

This module is autogenerated in the pre-distribution build process, so
to change it, you need the master repository files in ui_machines/...,
not a CPAN/PPM/tarball/.zip/etc. distribution.

=head1 COPYRIGHT

Copyright 2003, Perforce Software, Inc.  All Rights Reserved.

This module and the VCP package are licensed according to the terms given in
the file LICENSE accompanying this distribution, a copy of which is included in
L<vcp>.

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=cut

1;