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 |