package VCP::UIMachines; =begin hackers DO NOT EDIT!!! GENERATED FROM ui_machines/vcp_ui.tt2 by /usr/local/bin/stml AT Wed Jul 30 16:43:06 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: p4 => source_p4_run_p4d_prompt revml => source_revml_filespec_prompt cvs => source_cvs_cvsroot_prompt vss => source_vss_filespec_prompt =cut sub source_prompt { my ( $ui ) = @_; my $default = 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'; Source SCM type END_PROMPT chomp $prompt; my @valid_answers = ( [ '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' ); }, ], [ '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' ); }, ], [ '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, ], ); my $description = <<'END_DESCRIPTION'; Enter the kind of repository to copy data from. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item dest_prompt: Destination SCM type Enter the kind of repository to copy data to. Valid answers: revml => dest_revml_filespec_prompt vss => dest_vss_filespec_prompt p4 => dest_p4_run_p4d_prompt cvs => dest_cvs_cvsroot_prompt =cut sub dest_prompt { my ( $ui ) = @_; my $default = 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'; Destination SCM type END_PROMPT chomp $prompt; my @valid_answers = ( [ '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' ); }, ], [ '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' ); }, ], [ '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' ); }, ], ); my $description = <<'END_DESCRIPTION'; Enter the kind of repository to copy data to. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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: no => dest_p4_host_prompt yes => dest_p4_p4d_dir_prompt =cut sub dest_p4_run_p4d_prompt { my ( $ui ) = @_; my $default = 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'; Launch a private p4d in a local directory END_PROMPT chomp $prompt; my @valid_answers = ( [ 'no', qr/\Ano?\z/i, 'dest_p4_host_prompt', undef, ], [ 'yes', qr/\Ay(es)?\z/i, 'dest_p4_p4d_dir_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Dest}->{P4_RUN_P4D} = 1; }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Directory to run p4d in END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'dest_p4_user_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; # will set repo_server $ui->{Dest}->ui_set_p4d_dir( $answer ); }, ], ); my $description = <<'END_DESCRIPTION'; Enter the directory to launch the p4d in. VCP will then check that this is a valid directory. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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. Defaults to 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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; Enter the name and port of the p4d to read from, separated by a colon. Defaults to the P4HOST environment variable if set or "perforce:1666" if not. END_DESCRIPTION my $h = $ui->{Dest}->p4_get_settings; $default = empty $h->{P4HOST} ? "perforce:1666" : $h->{P4HOST} ; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item dest_p4_user_prompt: P4 user id Enter the user_id (P4USER) value needed to access the server. Defaults to the P4USER environment variable, if present; or the login user if not. Valid answers: => dest_p4_password_prompt =cut sub dest_p4_user_prompt { my ( $ui ) = @_; my $default = 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'; P4 user id END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'dest_p4_password_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Dest}->repo_user( $answer ) unless empty $answer; }, ], ); my $description = <<'END_DESCRIPTION'; Enter the user_id (P4USER) value needed to access the server. Defaults to the P4USER environment variable, if present; or the login user if not. END_DESCRIPTION my $h = $ui->{Dest}->p4_get_settings; $default = empty $h->{P4USER} ? ( empty $ENV{USER} ? undef : $ENV{USER} ) : $h->{P4USER} ; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Password END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'dest_p4_filespec_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; my $pw; my $h = $ui->{Dest}->p4_get_settings; $pw = $h->{P4PASSWD} if $pw eq "Use value of P4PASSWD environment variable"; $ui->{Dest}->repo_password( $pw ) unless empty $pw; }, ], ); my $description = <<'END_DESCRIPTION'; 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 my $h = $ui->{Dest}->p4_get_settings; $default = "Use value of P4PASSWD environment variable" unless empty $h->{P4PASSWD}; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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 ); }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item dest_cvs_cvsroot_prompt: cvsroot Enter the cvsroot spec. Defaults to the CVSROOT environment variable if set. Valid answers: cvsroot spec => dest_cvs_filespec_prompt =cut sub dest_cvs_cvsroot_prompt { my ( $ui ) = @_; my $default = 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'; cvsroot END_PROMPT chomp $prompt; my @valid_answers = ( [ 'cvsroot spec', qr/./, 'dest_cvs_filespec_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Dest}->repo_server( $answer ) unless empty $answer; }, ], ); my $description = <<'END_DESCRIPTION'; Enter the cvsroot spec. Defaults to the CVSROOT environment variable if set. END_DESCRIPTION $default = empty $ENV{CVSROOT} ? undef : $ENV{CVSROOT}; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item dest_cvs_init_cvsroot_prompt: Initialize a cvs repository Initialize a cvs repository in the directory indicated in the cvs CVSROOT spec? Valid answers: yes => convert no => convert =cut sub dest_cvs_init_cvsroot_prompt { my ( $ui ) = @_; my $default = 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'; Initialize a cvs repository END_PROMPT chomp $prompt; my @valid_answers = ( [ 'yes', qr/\Ay(es)?\z/i, 'convert', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Dest}->{CVS_INIT_CVSROOT} = 1; }, ], [ 'no', qr/\Ano?\z/i, 'convert', undef, ], ); my $description = <<'END_DESCRIPTION'; Initialize a cvs repository in the directory indicated in the cvs CVSROOT spec? END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; vss filespec END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'convert', undef, ], ); my $description = <<'END_DESCRIPTION'; Enter the filespec which may contain trailing wildcards, like "a/b/..." to extract an entire directory tree. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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: yes => source_p4_p4d_dir_prompt no => source_p4_host_prompt =cut sub source_p4_run_p4d_prompt { my ( $ui ) = @_; my $default = 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'; Launch a private p4d in a local directory END_PROMPT chomp $prompt; my @valid_answers = ( [ 'yes', qr/\Ay(es)?\z/i, 'source_p4_p4d_dir_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->{P4_RUN_P4D} = 1; }, ], [ 'no', qr/\Ano?\z/i, 'source_p4_host_prompt', undef, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Directory to run p4d in END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'source_p4_user_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; # will set repo_server $ui->{Source}->ui_set_p4d_dir( $answer ); }, ], ); my $description = <<'END_DESCRIPTION'; Enter the directory to launch the p4d in. VCP will then check that this is a valid directory. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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. Defaults to 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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; Enter the name and port of the p4d to read from, separated by a colon. Defaults to the P4HOST environment variable if set or "perforce:1666" if not. END_DESCRIPTION my $h = $ui->{Source}->p4_get_settings; $default = empty $h->{P4HOST} ? "perforce:1666" : $h->{P4HOST} ; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item source_p4_user_prompt: P4 user id Enter the user_id (P4USER) value needed to access the server. Defaults 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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; Enter the user_id (P4USER) value needed to access the server. Defaults to the P4USER environment variable, if present; or the login user if not. END_DESCRIPTION my $h = $ui->{Source}->p4_get_settings; $default = empty $h->{P4USER} ? ( empty $ENV{USER} ? undef : $ENV{USER} ) : $h->{P4USER} ; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Password END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'source_p4_filespec_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; my $pw; my $h = $ui->{Source}->p4_get_settings; $pw = $h->{P4PASSWD} if $pw eq "Use value of P4PASSWD environment variable"; $ui->{Source}->repo_password( $pw ) unless empty $pw; }, ], ); my $description = <<'END_DESCRIPTION'; 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 my $h = $ui->{Source}->p4_get_settings; $default = "Use value of P4PASSWD environment variable" unless empty $h->{P4PASSWD}; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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 ); }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; revml filespec END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'convert', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Dest}->ui_set_revml_repo_spec( "revml:" . $answer ); }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =item source_cvs_cvsroot_prompt: cvsroot Enter the cvsroot spec. Defaults to the CVSROOT environment variable if set. Valid answers: cvsroot spec => source_cvs_filespec_prompt =cut sub source_cvs_cvsroot_prompt { my ( $ui ) = @_; my $default = 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'; cvsroot END_PROMPT chomp $prompt; my @valid_answers = ( [ 'cvsroot spec', qr/./, 'source_cvs_filespec_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->repo_server( $answer ) unless empty $answer; }, ], ); my $description = <<'END_DESCRIPTION'; Enter the cvsroot spec. Defaults to the CVSROOT environment variable if set. END_DESCRIPTION $default = empty $ENV{CVSROOT} ? undef : $ENV{CVSROOT}; while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Enter CVS working directory END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/^/, 'source_cvs_binary_checkout_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->ui_set_cvs_work_dir( $answer ) unless empty $answer; }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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: no => source_cvs_use_cvs_prompt yes => source_cvs_use_cvs_prompt =cut sub source_cvs_binary_checkout_prompt { my ( $ui ) = @_; my $default = 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'; Force binary checkout END_PROMPT chomp $prompt; my @valid_answers = ( [ 'no', qr/\Ano?\z/i, 'source_cvs_use_cvs_prompt', undef, ], [ 'yes', qr/\Ay(es)?\z/i, 'source_cvs_use_cvs_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->{CVS_K_OPTION} = "b"; }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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: yes => source_cvs_revision_prompt no => source_cvs_revision_prompt =cut sub source_cvs_use_cvs_prompt { my ( $ui ) = @_; my $default = 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'; Use cvs? (rather than reading local repositories directly) END_PROMPT chomp $prompt; my @valid_answers = ( [ 'yes', qr/\Ay(es)?\z/i, 'source_cvs_revision_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->{CVS_USE_CVS} = 1; }, ], [ 'no', qr/\Ano?\z/i, 'source_cvs_revision_prompt', undef, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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 $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; 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; }, ], ); my $description = <<'END_DESCRIPTION'; Passed to 'cvs log' as a "-d" date specification. See rlog(1) man page for the format. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; vss filespec END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'source_vss_working_directory_prompt', undef, ], ); my $description = <<'END_DESCRIPTION'; Enter the filespec which may contain trailing wildcards, like "a/b/..." to extract an entire directory tree. END_DESCRIPTION while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; Enter VSS working directory END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/^/, 'dest_prompt', undef, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 ) = @_; my $default = 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'; revml filespec END_PROMPT chomp $prompt; my @valid_answers = ( [ '', qr/./, 'dest_prompt', sub { my ( $ui, $answer, $answer_record ) = @_; $ui->{Source}->ui_set_revml_repo_spec( "revml:" . $answer ); }, ], ); my $description = <<'END_DESCRIPTION'; 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 while(1) { my ( $answer, $answer_record ) = $ui->ask( $description, $prompt, $default, \@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( $eval_error, "Accept this value anyway", "no", [ [ "yes", qr/\Ay(es)?\z/i, undef ], [ "no", qr/\Ano?\z/i, 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]; } } =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 |