UIMachines.pm #22

  • //
  • guest/
  • perforce_software/
  • revml/
  • lib/
  • VCP/
  • UIMachines.pm
  • View
  • Commits
  • Open Download .zip Download (40 KB)
package VCP::UIMachines;

=begin hackers

DO NOT EDIT!!! GENERATED FROM ui_machines/vcp_ui.tt2 by /usr/local/bin/stml AT Fri Jul 25 13:31:37 2003

=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;

=item init

Initialize the machine

Next state: source_prompt

=cut

sub init {
    return 'source_prompt';
}

=item source_prompt: Source SCM type

Enter the kind of repository to copy data from.

Valid answers:

    cvs => source_cvs_cvsroot_prompt
    vss => source_vss_filespec_prompt
    revml => source_revml_filespec_prompt
    p4 => source_p4_run_p4d_prompt


=cut

sub source_prompt {
    my ( $ui ) = @_;

    ## 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';
Source SCM type
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'cvs', 'cvs', 'source_cvs_cvsroot_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Source::cvs;
                $ui->{Source} = VCP::Source::cvs->new;
                $ui->{Source}->repo_scheme( 'cvs' );
            },
        
        ],
        [ 'vss', 'vss', 'source_vss_filespec_prompt',
            undef,
        
        ],
        [ 'revml', 'revml', 'source_revml_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Source::revml;
                $ui->{Source} = VCP::Source::revml->new;
                $ui->{Source}->repo_scheme( 'revml' );
            },
        
        ],
        [ 'p4', 'p4', 'source_p4_run_p4d_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Source::p4;
                $ui->{Source} = VCP::Source::p4->new;
                $ui->{Source}->repo_scheme( 'p4' );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the kind of repository to copy data from.
    
    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_prompt: Destination SCM type

Enter the kind of repository to copy data to.

Valid answers:

    cvs => dest_cvs_cvsroot_prompt
    vss => dest_vss_filespec_prompt
    p4 => dest_p4_run_p4d_prompt
    revml => dest_revml_filespec_prompt


=cut

sub dest_prompt {
    my ( $ui ) = @_;

    ## 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';
Destination SCM type
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'cvs', 'cvs', 'dest_cvs_cvsroot_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Dest::cvs;
                $ui->{Dest} = VCP::Dest::cvs->new;
                $ui->{Dest}->repo_scheme( 'cvs' );
            },
        
        ],
        [ 'vss', 'vss', 'dest_vss_filespec_prompt',
            undef,
        
        ],
        [ 'p4', 'p4', 'dest_p4_run_p4d_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Dest::p4;
                $ui->{Dest} = VCP::Dest::p4->new;
                $ui->{Dest}->repo_scheme( 'p4' );
            },
        
        ],
        [ 'revml', 'revml', 'dest_revml_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                require VCP::Dest::revml;
                $ui->{Dest} = VCP::Dest::revml->new;
                $ui->{Dest}->repo_scheme( 'revml' );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the kind of repository to copy data to.
    
    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item convert

Run VCP with the options entered

=cut

sub convert {
    return undef;
}

=item dest_p4_run_p4d_prompt: Launch a private p4d in a local directory

If you would like to insert into an offline repository in a local
directory, vcp can launch a 'p4d' daemon for you in that directory.
It will use a random high numbered TCP port.

Valid answers:

    yes => dest_p4_p4d_dir_prompt
    no => dest_p4_host_prompt


=cut

sub dest_p4_run_p4d_prompt {
    my ( $ui ) = @_;

    ## 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';
Launch a private p4d in a local directory
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'yes', qr/\Ay(es)?\z/i, 'dest_p4_p4d_dir_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->{P4_RUN_P4D} = 1;            },
        
        ],
        [ 'no', qr/\Ano?\z/i, 'dest_p4_host_prompt',
            undef,
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );

    
If you would like to insert into an offline repository in a local
directory, vcp can launch a 'p4d' daemon for you in that directory.
It will use a random high numbered TCP port.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_p4_p4d_dir_prompt: Directory to run p4d in

Enter the directory to launch the p4d in.  VCP will then check that
this is a valid directory.

Valid answers:

     => dest_p4_user_prompt


=cut

sub dest_p4_p4d_dir_prompt {
    my ( $ui ) = @_;

    ## 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';
Directory to run p4d in
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', sub { die qq{Please enter a directory name\n} unless length; die qq{'$_' is not a valid directory\n} unless -d; 1; }, 'dest_p4_user_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->repo_server( $answer );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the directory to launch the p4d in.  VCP will then check that
this is a valid directory.
    
    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_p4_host_prompt: P4 Host name, including port

Enter the name and port of the p4d to read from, separated by
a colon.  Leave empty to use the p4's default of the P4HOST
environment variable if set or "perforce:1666" if not.

Valid answers:

    perforce:1666 => dest_p4_user_prompt


=cut

sub dest_p4_host_prompt {
    my ( $ui ) = @_;

    ## 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';
P4 Host name, including port
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'perforce:1666', qr/^/, 'dest_p4_user_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->repo_server( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the name and port of the p4d to read from, separated by
a colon.  Leave empty to use the p4's default of the P4HOST
environment variable if set or "perforce:1666" if not.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_p4_user_prompt: P4 user id

Enter the user_id (P4USER) value needed to access the server.  Leave
empty to use the P4USER environemnt variable, if present; or the login
user if not.

Valid answers:

     => dest_p4_password_prompt


=cut

sub dest_p4_user_prompt {
    my ( $ui ) = @_;

    ## 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';
P4 user id
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'dest_p4_password_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_user( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the user_id (P4USER) value needed to access the server.  Leave
empty to use the P4USER environemnt variable, if present; or the login
user if not.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_p4_password_prompt: Password

If a password (P4PASSWD) is needed to access the server, enter it here.

WARNING: password will be echoed in plain text to the terminal.

Valid answers:

     => dest_p4_filespec_prompt


=cut

sub dest_p4_password_prompt {
    my ( $ui ) = @_;

    ## 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';
Password
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'dest_p4_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_password( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


If a password (P4PASSWD) is needed to access the server, enter it here.

WARNING: password will be echoed in plain text to the terminal.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_p4_filespec_prompt: Destination spec

The destination spec is a perforce repository spec and must begin with
// and a depot name ("//depot"), not a local filesystem spec or a
client spec.

Valid answers:

    //depot/directory-path/... => convert


=cut

sub dest_p4_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
Destination spec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '//depot/directory-path/...', qr#\A//#, 'convert',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->repo_filespec( $answer );
                $ui->{Dest}->init;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


The destination spec is a perforce repository spec and must begin with
// and a depot name ("//depot"), not a local filesystem spec or a
client spec.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_cvs_cvsroot_prompt: cvsroot

Enter the cvsroot spec.  Leave empty to use the CVSROOT environment
variable if set.

Valid answers:

    cvsroot spec => dest_cvs_filespec_prompt


=cut

sub dest_cvs_cvsroot_prompt {
    my ( $ui ) = @_;

    ## 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';
cvsroot
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'cvsroot spec', sub { die qq{A cvsroot spec is required because the CVSROOT environment variable is not set.\n} unless length or exists $ENV{CVSROOT}; 1; }, 'dest_cvs_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->repo_server( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the cvsroot spec.  Leave empty to use the CVSROOT environment
variable if set.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_cvs_filespec_prompt: cvs filespec

Enter the cvs filespec.  This must be in the form "module/filespec".
The filespec may contain trailing wildcards, like "a/b/..." to extract
an entire directory tree.

Valid answers:

    module/filepath/... => dest_cvs_init_cvsroot_prompt


=cut

sub dest_cvs_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
cvs filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'module/filepath/...', qr/./, 'dest_cvs_init_cvsroot_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->repo_filespec( $answer );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the cvs filespec.  This must be in the form "module/filespec".
The filespec may contain trailing wildcards, like "a/b/..." to extract
an entire directory tree.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_cvs_init_cvsroot_prompt: Initialize a cvs root

Initialize a cvs repository in the directory indicated in the cvs
CVSROOT spec?

Valid answers:

    no => convert
    yes => convert


=cut

sub dest_cvs_init_cvsroot_prompt {
    my ( $ui ) = @_;

    ## 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';
Initialize a cvs root
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'no', qr/\Ano?\z/i, 'convert',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->init;
            },
        
        ],
        [ 'yes', qr/\Ay(es)?\z/i, 'convert',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->init;
                $ui->{Dest}->{CVS_INIT_CVSROOT} = 1;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Initialize a cvs repository in the directory indicated in the cvs
CVSROOT spec?

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_vss_filespec_prompt: vss filespec

Enter the filespec which may contain trailing wildcards, like "a/b/..."
to extract an entire directory tree.

Valid answers:

     => convert


=cut

sub dest_vss_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
vss filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/./, 'convert',
            undef,
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the filespec which may contain trailing wildcards, like "a/b/..."
to extract an entire directory tree.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_run_p4d_prompt: Launch a private p4d in a local directory

If you would like to extract from an offline repository in a local
directory, vcp can launch a 'p4d' daemon for you in that directory.
It will use a random high numbered TCP port.

Valid answers:

    no => source_p4_host_prompt
    yes => source_p4_p4d_dir_prompt


=cut

sub source_p4_run_p4d_prompt {
    my ( $ui ) = @_;

    ## 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';
Launch a private p4d in a local directory
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'no', qr/\Ano?\z/i, 'source_p4_host_prompt',
            undef,
        
        ],
        [ 'yes', qr/\Ay(es)?\z/i, 'source_p4_p4d_dir_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->{P4_RUN_P4D} = 1;            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );

    
If you would like to extract from an offline repository in a local
directory, vcp can launch a 'p4d' daemon for you in that directory.
It will use a random high numbered TCP port.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_p4d_dir_prompt: Directory to run p4d in

Enter the directory to launch the p4d in.  VCP will then check that
this is a valid directory.

Valid answers:

     => source_p4_user_prompt


=cut

sub source_p4_p4d_dir_prompt {
    my ( $ui ) = @_;

    ## 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';
Directory to run p4d in
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', sub { die qq{Please enter a directory name\n} unless length; die qq{'$_' is not a valid directory\n} unless -d; 1; }, 'source_p4_user_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_server( $answer );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the directory to launch the p4d in.  VCP will then check that
this is a valid directory.
    
    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_host_prompt: P4 Host name, including port

Enter the name and port of the p4d to read from, separated by
a colon.  Leave empty to use the p4's default of the P4HOST
environment variable if set or "perforce:1666" if not.

Valid answers:

    perforce:1666 => source_p4_user_prompt


=cut

sub source_p4_host_prompt {
    my ( $ui ) = @_;

    ## 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';
P4 Host name, including port
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'perforce:1666', qr/^/, 'source_p4_user_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_server( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the name and port of the p4d to read from, separated by
a colon.  Leave empty to use the p4's default of the P4HOST
environment variable if set or "perforce:1666" if not.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_user_prompt: P4 user id

Enter the user_id (P4USER) value needed to access the server.  Leave
empty to the P4USER environment variable, if present; or the login
user if not.

Valid answers:

     => source_p4_password_prompt


=cut

sub source_p4_user_prompt {
    my ( $ui ) = @_;

    ## 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';
P4 user id
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'source_p4_password_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_user( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the user_id (P4USER) value needed to access the server.  Leave
empty to the P4USER environment variable, if present; or the login
user if not.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_password_prompt: Password

If a password (P4PASSWD) is needed to access the server, enter it here.

WARNING: password will be echoed in plain text to the terminal.

Valid answers:

     => source_p4_filespec_prompt


=cut

sub source_p4_password_prompt {
    my ( $ui ) = @_;

    ## 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';
Password
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'source_p4_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_password( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


If a password (P4PASSWD) is needed to access the server, enter it here.

WARNING: password will be echoed in plain text to the terminal.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_p4_filespec_prompt: Files to copy

If you want to copy a portion of the source repository, enter a p4
filespec starting with the depot name.  Do not enter any revision or
change number information.

Valid answers:

    //depot/directory-path/... => dest_prompt


=cut

sub source_p4_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
Files to copy
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '//depot/directory-path/...', qr{\A//.+}, 'dest_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_filespec( $answer );
                $ui->{Source}->init;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


If you want to copy a portion of the source repository, enter a p4
filespec starting with the depot name.  Do not enter any revision or
change number information.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item dest_revml_filespec_prompt: revml filespec

Enter the revml repo spec.  'revml:' will be prefixed to it then
parsed as if it was entered on the vcp command line.

Valid answers:

     => convert


=cut

sub dest_revml_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
revml filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/./, 'convert',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Dest}->parse_revml_repo_spec( "revml:" . $answer );
                $ui->{Dest}->init;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the revml repo spec.  'revml:' will be prefixed to it then
parsed as if it was entered on the vcp command line.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_cvsroot_prompt: cvsroot

Enter the cvsroot spec.  Leave empty to use the CVSROOT environment
variable if set.

Valid answers:

    cvsroot spec => source_cvs_filespec_prompt


=cut

sub source_cvs_cvsroot_prompt {
    my ( $ui ) = @_;

    ## 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';
cvsroot
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'cvsroot spec', sub { die qq{A cvsroot spec is required because the CVSROOT environment variable is not set.\n} unless length or exists $ENV{CVSROOT}; 1; }, 'source_cvs_filespec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_server( $answer )
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the cvsroot spec.  Leave empty to use the CVSROOT environment
variable if set.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_filespec_prompt: cvs filespec

Enter the cvs filespec.  This must be in the form "module/filespec".
The filespec may contain trailing wildcards, like "a/b/..." to extract
an entire directory tree.

Valid answers:

    module/filepath/... => source_cvs_working_directory_prompt


=cut

sub source_cvs_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
cvs filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'module/filepath/...', qr/./, 'source_cvs_working_directory_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->repo_filespec( $answer );
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the cvs filespec.  This must be in the form "module/filespec".
The filespec may contain trailing wildcards, like "a/b/..." to extract
an entire directory tree.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_working_directory_prompt: Enter CVS working directory

Enter the CVS working directory (Optional). VCP::Source::cvs will cd
to this directory before calling cvs, and won't initialize a CVS
workspace of it's own (normally, VCP::Source::cvs does a "cvs
checkout" in a temporary directory).

Valid answers:

     => source_cvs_binary_checkout_prompt


=cut

sub source_cvs_working_directory_prompt {
    my ( $ui ) = @_;

    ## 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';
Enter CVS working directory
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', sub { die qq{'$_' is not a valid directory\n} if length and not -d; 1; }, 'source_cvs_binary_checkout_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->{CVS_WORK_DIR} = $answer
                    unless empty $answer;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the CVS working directory (Optional). VCP::Source::cvs will cd
to this directory before calling cvs, and won't initialize a CVS
workspace of it's own (normally, VCP::Source::cvs does a "cvs
checkout" in a temporary directory).

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_binary_checkout_prompt: Force binary checkout

Pass the -kb option to cvs, to force a binary checkout. This is useful
when you want a text file to be checked out with Unix linends, or if
you know that some files in the repository are not flagged as binary
files and should be.

Valid answers:

    yes => source_cvs_use_cvs_prompt
    no => source_cvs_use_cvs_prompt


=cut

sub source_cvs_binary_checkout_prompt {
    my ( $ui ) = @_;

    ## 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';
Force binary checkout
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'yes', qr/\Ay(es)?\z/i, 'source_cvs_use_cvs_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->{CVS_K_OPTION} = "b";            },
        
        ],
        [ 'no', qr/\Ano?\z/i, 'source_cvs_use_cvs_prompt',
            undef,
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Pass the -kb option to cvs, to force a binary checkout. This is useful
when you want a text file to be checked out with Unix linends, or if
you know that some files in the repository are not flagged as binary
files and should be.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_use_cvs_prompt: Use cvs? (rather than reading local repositories directly)

Use cvs rather than a direct read of local repositories.  This is
slower, but the option is present in case there are repositories
vcp has trouble reading directly.

Valid answers:

    no => source_cvs_revision_prompt
    yes => source_cvs_revision_prompt


=cut

sub source_cvs_use_cvs_prompt {
    my ( $ui ) = @_;

    ## 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';
Use cvs? (rather than reading local repositories directly)
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ 'no', qr/\Ano?\z/i, 'source_cvs_revision_prompt',
            undef,
        
        ],
        [ 'yes', qr/\Ay(es)?\z/i, 'source_cvs_revision_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->{CVS_USE_CVS} = 1;            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Use cvs rather than a direct read of local repositories.  This is
slower, but the option is present in case there are repositories
vcp has trouble reading directly.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_revision_prompt: cvs log revision specification

Passed to "cvs log" as a "-r" revision specification. This corresponds
to the "-r" option for the rlog command, not either of the "-r"
options for the cvs command.  See rlog(1) man page for the format.

Valid answers:

     => source_cvs_date_spec_prompt


=cut

sub source_cvs_revision_prompt {
    my ( $ui ) = @_;

    ## 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';
cvs log revision specification
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'source_cvs_date_spec_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                unless( empty $answer ) {
                    $ui->{Source}->rev_spec( $answer );
                    $ui->{Source}->force_missing( defined $ui->{Source}->rev_spec );
                }
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Passed to "cvs log" as a "-r" revision specification. This corresponds
to the "-r" option for the rlog command, not either of the "-r"
options for the cvs command.  See rlog(1) man page for the format.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_cvs_date_spec_prompt: cvs log date specification

Passed to 'cvs log' as a "-d" date specification.  See rlog(1) man
page for the format.

Valid answers:

     => dest_prompt


=cut

sub source_cvs_date_spec_prompt {
    my ( $ui ) = @_;

    ## 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';
cvs log date specification
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'dest_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->date_spec( $answer )
                    unless empty $answer;
                $ui->{Source}->init;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Passed to 'cvs log' as a "-d" date specification.  See rlog(1) man
page for the format.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_vss_filespec_prompt: vss filespec

Enter the filespec which may contain trailing wildcards, like "a/b/..."
to extract an entire directory tree.

Valid answers:

     => source_vss_working_directory_prompt


=cut

sub source_vss_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
vss filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/./, 'source_vss_working_directory_prompt',
            undef,
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the filespec which may contain trailing wildcards, like "a/b/..."
to extract an entire directory tree.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_vss_working_directory_prompt: Enter VSS working directory

Used to set the VSS working directory. VCP::Source::vss will cd to
this directory before calling vss, and won't initialize a VSS
workspace of it's own (normally, VCP::Source::vss does a "vss
checkout" in a temporary directory).

Valid answers:

     => dest_prompt


=cut

sub source_vss_working_directory_prompt {
    my ( $ui ) = @_;

    ## 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';
Enter VSS working directory
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/^/, 'dest_prompt',
            undef,
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Used to set the VSS working directory. VCP::Source::vss will cd to
this directory before calling vss, and won't initialize a VSS
workspace of it's own (normally, VCP::Source::vss does a "vss
checkout" in a temporary directory).

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=item source_revml_filespec_prompt: revml filespec

Enter the revml repo spec.  'revml:' will be prefixed to it then
parsed as if it was entered on the vcp command line.

Valid answers:

     => dest_prompt


=cut

sub source_revml_filespec_prompt {
    my ( $ui ) = @_;

    ## 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';
revml filespec
END_PROMPT

    chomp $prompt;

    my @valid_answers = (
        [ '', qr/./, 'dest_prompt',
            sub {
                my ( $ui, $answer, $answer_record ) = @_;
                $ui->{Source}->parse_revml_repo_spec( "revml:" . $answer );
                $ui->{Source}->init;
            },
        
        ],
    );

    my ( $answer, $answer_record ) =
        $ui->ask( <<'END_DESCRIPTION', $prompt, \@valid_answers );


Enter the revml repo spec.  'revml:' will be prefixed to it then
parsed as if it was entered on the vcp command line.

    
END_DESCRIPTION

    ## Run handlers for this arc
    $answer_record->[-1]->( $ui, $answer, $answer_record )
        if defined $answer_record->[-1];

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

=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;
# Change User Description Committed
#50 5401 Barrie Slaymaker - UI updated
#49 4502 Barrie Slaymaker - "Run without saving" option removed
#48 4064 Barrie Slaymaker - RevML is no longer offered in the UI
- Sources and dests are given an id in the UI
- The .vcp file name defaulting now works
#47 4002 Barrie Slaymaker - Interactive UI no longer prompts for CVS -r and -d options
#46 3863 Barrie Slaymaker - UIMachines.pm updated
#45 3675 Barrie Slaymaker - More of a .vcp file is now editable
#44 3671 Barrie Slaymaker - Add user interface flow diagrams
- User interface flow diagrams now generated without handlers
  by default, make ui-with-handlers.{png,ps} to see the handlers.
#43 3666 Barrie Slaymaker - vcp can now edit existing .vcp files, for VSS sources and revml dests
#42 3654 Barrie Slaymaker - VCP-Source-vss UI prompt is more clear
- VCP::Source::vss' --cd option removed until a need is found
#41 3650 Barrie Slaymaker - UIMachines now current
#40 3640 Barrie Slaymaker - xmllint no longer require to build UI
- UI now offers multiple choices where appropriate
#39 3567 John Fetkovich - added the field UIManager in VCP::UI::Text.pm
- added the fields UIImplementation and TersePrompts in UI.pm
- removed Source and Dest fields in VCP::UI.pm
- UI.pm now returns the result of running the UI implementation.
- VCP::UI::Text->run return a list of (source, dest)
  all future UI implementations must do the same.
- bin/vcp gets (source, dest) list from VCP::UI->run.
- added --terse (or -t) command line option to vcp
  to remove verbose help from interactive UI.
#38 3547 John Fetkovich Added defaults to yes/no questions (no in all cases)
#37 3538 John Fetkovich bug fix P4PASSWD defaulting
#36 3523 John Fetkovich more ui defaults and checks added
#35 3522 John Fetkovich default cvsroot from $ENV{CVSROOT}
#34 3518 John Fetkovich more interactive ui improvements
#33 3517 John Fetkovich change mode to text+w
#32 3515 John Fetkovich added P4HOST default
#31 3514 John Fetkovich p4 password defaulting
#30 3513 John Fetkovich defaulting of p4 user variable
#29 3512 John Fetkovich enhanced ui checks on repo_server
#28 3503 John Fetkovich not sure if this was re-generated on last change
#27 3501 John Fetkovich added ui_set_revml_repo_spec, and caller in the stml file
#26 3499 John Fetkovich - implement recoverable and non-recoverable exceptions in arc
  handlers.  A user may accept a value that generated a
  recoverable exception.  Otherwise, the question will be
  re-asked.
- changed exceptions text in ui_set_revml_repo_spec.
#25 3494 John Fetkovich default values in interactive ui partially implemented
#24 3492 John Fetkovich interative ui question re-asked if exception generated when
arc handlers are run.  a single test case for source revml
input file has been tested.
#23 3486 John Fetkovich moved (source or dest)->init calls to bin/vcp
#22 3484 John Fetkovich fix a prompt name
#21 3481 John Fetkovich intro text moved out of state machine to bin/vcp.
       no longer requires user interaction to move on.
#20 3455 John Fetkovich remove "change branch rev #1" yes/no option from interactive interface
#19 3403 John Fetkovich options given on all multiple choice prompts,
       and most free-form prompts where it makes sense
#18 3399 John Fetkovich ui fixes
#17 3395 John Fetkovich various ui refinements
#16 3390 John Fetkovich handlers for cvs ui
#15 3389 John Fetkovich made change_branch_rev prompt have both yes & no exit arcs
#14 3387 Barrie Slaymaker Make always writable on client
#13 3383 John Fetkovich removed setting of repo_id, it's now done in 'sub init'
       in the sources and dests
#12 3375 John Fetkovich more ui changes
#11 3374 John Fetkovich set repo_id in branch running in local directory also
#10 3362 John Fetkovich revml source and dest now works through interactive UI
#9 3331 John Fetkovich Small change in source revml state machine.
       split 'sub init' from 'sub new' in Source/revml.pm
       and Dest/revml.pm
#8 3330 John Fetkovich Added revml source and dest to ui state machines
#7 3305 John Fetkovich added calls to set fields in p4 source and dest
       state machines, and then call to init
#6 3255 Barrie Slaymaker Add in support for <arc> <handler>s.
       Requires latest StateML.
       See VCP-Source-p4.stml for an example.       
       Calls VCP::Source::p4 in an unsupported way resulting in death.
#5 3253 John Fetkovich Added source::vss user interface
#4 3252 John Fetkovich added state machine parts for these destinations
#3 3244 Barrie Slaymaker Integrate VCP::UI with bin/vcp.
       Type 'vcp' to run the UI.
#2 3240 Barrie Slaymaker UI definition cleanup
#1 3237 Barrie Slaymaker More work on the UI StateML conventions