You also seem to want the user to be able to write incomplete entries, escaping out of the field-entry loop with only one or more of the initial fields filled in, and one or more of the final fields in the sequence left undefined (null), and these get written to the database file along with complete entries.

I think what you might want here is a subroutine that takes two array refs, one containing the field labels and the other containing prompt strings, with both arrays ordered according to the desired sequence for user input; the sub would return a hash with field labels as keys and user input as values. Whatever is returned by the sub can then be written to the database. Something like this (not tested):

sub entry_prompter
{
    my ( $labels, $prompts ) = @_;
    my %entry;
    for my $i ( 0 .. $#$labels ) {
        my $user_input = prompt $$prompts[$i], -escape;
        last if ( $user_input eq "\e" );
        $entry{$$labels[$i]} = $user_input;
    }
    return %entry;
}
[download]

If I were you, I'd add another array that provides conditions for sanity checks on the fields, so that the "entry_prompter()" sub can test $user_input -- e.g. should be numeric, or "y/n", or not longer than 10 characters, or whatever.

Then again, if I were you, I'd use a real database (not a flat file), and I'd use Tk; to provide a nice GUI with appropriate user input widgets to fully populate a record as efficiently and reliably as possible, along with a "Submit" button.

(updated to simplify some of the wording in the text)

It's a very good point you bring up. I'm actually using Text::CSV_XS and using the print method to print the arrayref. The reason why I'm doing this is because other programs have to interact with the CSV files.

I'm keeping two different databases for information about receiving images: one for partial images, one for missing images. (I don't want to get into more one-off detail, but I will say that this is in support of the Phoenix Mars Lander...) Depending on the database you're manipulating, there could be 5 or 8 different fields, and the process is always evolving.

I would write a GUI for this but quite frankly I don't know how. I taught myself Perl a few months ago to get my job done effectively, so what I've been doing is pretty quick and dirty.

Just as a reminder, there are excellent database moduls on CPAN, for example DBM::Deep. They are well tested and might spare you a lot of work.

Your immediate problem might be solved by putting the prompt in a subroutine with the escape checking. Parameters of the subroutine would a flag whether ESC is allowed and the parameters to prompt(). Return values are the return value of prompt() plus a boolean to show whether ESC was pressed. Inside this subroutine you could do the write_to_db

If you really want an interrupt thingy, that can be simulated with putting your code inside an eval and die'ing when someone hits ESC. This is sadly the meager substitute for exceptions/interrupts in perl5.

sub enter_products {
  my @database = read_from_db();
  eval {
    while (1) {
      ...
      $comment = my_prompt "Enter comment";
      $descript = my_prompt "Enter description";
      $sku = my_prompt "Enter sku";
      $weight = my_prompt "Enter weight";
      $color = my_prompt "Enter color";
      ...
      $yn = my_prompt "Add another entry?", -yn;
      ...
    }
  };
  unless ($@ =~ /\AESC PRESSED/) {
    die $@; # propagate non-ESC exceptions
  }
  write_to_db(...);
}

sub my_prompt {
  my $input = prompt @_, -escape
  if ($input eq "\e") {
    die "ESC PRESSED";
  }
  return $input;
}
[download]

If that is the case, here's another 'solution':

our $ESC_EXIT_LABEL;

sub my_prompt {
  my $input = prompt @_, -escape
  if ($input eq "\e" && $ESC_EXIT_LABEL) {
    goto $ESC_EXIT_LABEL;
  }
  return $input;
}

sub enter_products {
  ...
  local($ESC_EXIT_LABEL) = "enter_products_esc_label";
  while (1) {
    ... call my_prompt many times...
  }
enter_products_esc_label:
  write_database(...);
}
[download]

Any time I find myself writing a big list of similar code, I know I need to do some data driven programming. By putting my variables in a datastructure, I can iterate over the structure with a small chunk of code, and do the same work with much less typing.

I do my work on Win32 systems, so I couldn't use IO::Prompt. Instead I hacked in a very ugly fake prompt function--ignore it, it's just a stand in for the real deal. I added a couple of other dummy functions to get things working--ignore these as well.

Here's how I approached your problem:

• I created a list of fields to process.
• I turned your while loop inside out: while( get_data ) {...}.
• In the loop, we prompt to continue entry. If user says to stop, we exit the loop.

With my method there is no need for exception catching or any dodgy goto tomfoolery. Also, you can use the same code to collect data for several different field sets.

use strict;
use warnings;

use Scalar::Util qw( reftype );
#use IO::Prompt;
# half-assed prompt routine to stand in for the nonportable IO::Prompt
sub prompt { 
    print join "\n", @_;
    print "\n";

    my $in = <>;
    $in = "\e" if $in =~ /ESC/;

    chomp $in;
    return 0 if uc($in) eq 'N';
    return $in;
}
#  return to 'real' code.

# Field definitions to reduce repeated code.
# This could also be stored as an AoA
#    ( [ id       => 'Product ID' ],
#      [ comments => 'Comments'   ],
#    ); 
my @fields = (
    {   name        => 'id',
        description => 'Product ID',
    },
    {   name        => 'comments',
        description => 'Comments',
    },
    # And so forth.  In the order you want to process them.
);


# It looks like your code was in a sub rountine call.
# So I enclosed my code in a subroutine as well.
Get_Data_For_DB( \@fields );

# the main sub
sub Get_Data_For_DB {
    my $fields = shift;  # Get field specification

    my @database = read_from_db(); 
    my $database_type = 'foo';  # give this variable a value.

    while ( collect_user_data( \@database, $fields ) ) {
        last unless continue_data_entry();
    }

    # finalize changes and return result.
    return write_to_db($database_type, @database);
}

# Attempt to get data from user.
# Return TRUE if we have data or a SKIP condition
# Return FALSE on an ABORT condition.
sub collect_user_data {
    my $db     = shift;
    my $fields = shift; 

    my $entry = get_data_entry( $fields );
    
    # this should probably be replaced with 
    # a dispatch table if any more conditions get added.
    if ( reftype $entry eq 'ARRAY' ) {
        push @$db, $entry;
        return 1;
    }
    elsif ( $entry eq 'SKIP' ) {
        return 1;
    }
    elsif ( $entry eq 'ABORT' ) {
        return;
    }

    die "Unexpected result: $entry";
}

# Get one entry worth of data.
# If entry succeeds, return an array ref containing data.
# Else return a status string-
#   'ABORT' to abort data entry
#   'SKIP'  to store no new data in db.
sub get_data_entry {
    my $fields = shift;

    # Initial entry
    my @values; # Ordered list.
    foreach my $field ( @$fields ) {
        my $value = prompt "Enter the $field->{description}: ", '-esca
+pe';

        return 'ABORT' if $value eq "\e";  
        # what happens if user types "foo\e"

        # Store data for return.
        push @values, $value;
    }

    # Confirmation - print field/value pairs
    print "Confirm the following data:\n";
    print map {
        " $fields->[$_]{description}: $values[$_]\n"
    } 0..$#$fields;
    print "\n";

    my $yn = prompt "Is this information correct? y/n: ", '-yn'; 

    return $yn ? \@values : 'SKIP';
}

# Prompt user for continuing entry.
# Return TRUE for Y
# Return FALSE for N or ESC
sub continue_data_entry {

    my $continue = prompt "Add another entry? y/n: ", '-yn', '-escape'
+;
    $continue = 0 if $continue eq "\e";

    return $continue;
}


# Dummy routine for test puproses.
sub read_from_db {
    return;
}

# Dummy routine for test puproses.
sub write_to_db {
    my $type = shift;

    use Data::Dumper;
    print Dumper \@_;
}
[download]

I didn't thoroughly look through this code, but it looks like it can get the job done very nicely. Right now my feeble attempt is being used, but I'll see if I can swap it out and add this in instead.

Thanks!