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]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.