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 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. =head1 AUTHOR Barrie Slaymaker =cut 1;