LABEL: {
...

 redo LABEL;
}
[download]

Or what about this?

while (1)
{ 
     # print ...

     if (...)
     {
          # ...
          last;
     }
     elsif (...)
     {
          # ...
          last;
     }
}
[download]

This is an infinite loop that can be "broken" with the last command. I find using labels to be rather pointless in most circumstances. After all, you can redo a block with no label at all.

This is an infinite loop that can be "broken" with the last command. I find using labels to be rather pointless in most circumstances. After all, you can redo a block with no label at all.

Hmm, several last statements vs. one redo. It may be a matter of taste, but the lazy programmer in me likes the one redo better. And its true you don't need loop labels in this instance, and on a shorter loop I'd leave the label off. I try to avoid long loop structures, but if there is one, I prefer having a label as an easy way to see where it starts.

The get_Origserver sub has been defined with an empty prototype which means that it Perl will not allow you to pass any arguments to it.

sub get_Origserver () {.....
[download]

This is probably accidental. Removing the empty brackets from the subs definition as in

sub get_Origserver {....
[download]

Or making the prototype so that it accepts (at least) a scalar argument as in

sub get_Origserver ($) { ....
[download]

should fix the problem.

I'd like to just insert that putting in prototypes is probably a Bad Thing. There are occasions when you need them, but for the most part, they're a deprecated nuisance. They can cause subtle errors, which are not pleasant to diagnose, because they perform an implicit scalar conversion to any passed arguments.

In short, this original post is merely one example as to why prototypes are undesirable. If you don't want to find others, just avoid them wherever possible.

Check out the "prototypes" section in perldoc perlsub for more information on how this all works.

        $perlmonks{seattlejohn} = 'John Clyman';

I have removed the parens and it works. But this is where it gets really confusing. Why does this code work? I make the same call at line 1047 and it compiles what is the difference between the two calls or sub routines.

1024  LABEL:
  1025  print "\nCREATE A DATABASE FOR EXISTING CLIENT OR COPY AN EXIS
+TING DATABASE? \n";
  1026  print "Create Existing Client Database => 1\n";
  1027  print "Create New Client Database C=> 2\n";
  1028  print "Copy Existing Database => 3\n";
  1029  chomp(my $answer = lc(<STDIN>));
  1030  print "$answer\n";
  1031  if ($answer eq "1") {
  1032
  1033     my $cltlist = display_client(\$dbhTarget);
  1034     if ($cltlist) {
  1035       $cltlist = "Existing clients: \n" . $cltlist .
  1036                  "\nEnter Client ID: ";
  1037       print $cltlist;
  1038       chomp(my $cltid = <STDIN>);
  1039       $params->put("Client.ID", $cltid);
  1040     }#end if statement
  1041
  1042  } elsif ($answer eq "2") {
  1043
  1044     print "Please enter new client name: \n";
  1045     chomp(my $clt = <STDIN>);
  1046     my $passwd = $params->get("Prod.Password");
  1047     my $cltid = add_client(\$dbhTarget, $clt, $passwd);
  1048     $params->put("Client.ID", $cltid);
  1049
  1050  } elsif($answer eq "3"){
  1051
  1052     print "Please enter name of the database to copy: \n";
  1053     chomp(my $Origdb = <STDIN>);
  1054     my $Origserver = get_Origserver(\$dbhTarget, $Origdb);
  1055     print "$Origserver is the server for the original db\n";
  1056
  1057  } else{
  1058
  1059     print "YOU MUST CHOOSE AN OPTION!!!!\n";
  1060     redo LABEL;
  1061
  1062  }#end else statement
[download]

This works

sub add_client() {

print "******ADDING ROW TO CLIENT TABLE******\n";
print "I AM HERE\n";
my ($dbh, $clt, $prdpasswd) = @_;
my $count = 1;
my $cltid;

my $sql = "select distinct CLT_ID from ENRMASTER..CLT order by CLT_ID"
+;

my $sth = $$dbh->prepare($sql)
        or $app->error($FATAL, "can't prepare SQL statement [ $sql ] :
+:$DBI::errstr");
$sth->execute();
}
[download]

This does not compile

sub get_Origserver() {
   919
   920  print "******GETTING SERVER NAME OF THE DB BEING COPIED******\
+n";
   921
   922  my ($dbh, $Origdb) = @_;
   923  print "This is the db $dbh\n";
[download]