Ronnie has asked for the wisdom of the Perl Monks concerning the following question:

Ignore the following question - I was in Blair mode, confusing cause and effect! The problem wasn't strictly the return, more the fact that the values it was trying to return had been destroyed in the fetchrow_array - the full code is printed below if anyone feels like scoffing! Feel free to scoff as I won't hear being in the lowest, wettest smelliest cell possible for an errant monk!


Hello again Bretheren. Can anyone give me advice on a little difficulty I am having with a return value from a subroutine? I need to return 2 values - calculated via 2 calls to the DBI in the subroutine - I have these values in an array which I am trying to return but with no joy. I have even dallied with reurning a reference to this array but don't seem able to dereference it. Can you help/point me in the correct direction/show me the error of my ways? For what it's worth the code from the latest (failed) attempt is appended. Cheers, Ronnie 
#
   return $rarray ; # Reference to the array
#
}
#
#######################################################
#                     Variables                       #
#######################################################
#
my $to       = 'ronniec@it.aberdeen.net.uk' ;
my $from     = 'Buckethead' ;
my $logfile  = 'xxrc_test_DBI_special.log' ;
my $DB_name  = 'isw-test' ;
my $result   = 0 ;
my $count    = 0 ;
my $response = () ;
#
#####################################
#        mail_log variables.        #
#####################################
#
my $script              = 'chk_cals' ;
my $mail_msg            = 0 ;
my $null                = "none" ;
my $subject             = "Script $script completion details" ;
my $msg                 = "See attachment for completions details" ;
my $text                = "\tUnable to write the following to $logfile
+ :-\n\n" ;
my $row                 = undef ;
#
print "\n\t<************ SOR $0 ***************>\n" ;
#
$response = &chk_cals("$to","$from","$logfile","$DB_name") ;
#
print "\n\tBetcha dinna c this min - $$response[0]\n" ;
#

[download]

Replies are listed 'Best First'.
Re: Return Value Problem
by Joost (Canon) on Oct 14, 2004 at 10:00 UTC
    That code "should work" as long as $rarray is actually a reference to an array. Since you don't tell us what errors you are seeing, we can't tell what's wrong.

    however, there is a much more intuitive way of solving your problem: just return a list: 

     
sub somesub {
  my $x = 1;
  my $y = 2;
  return ($x,$y);
}

my ($r1,$r2) = somesub();

print "r1: $r1, r2: $r2\n";
__END__
r1: 1, r2: 2

    [download]
    "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]
[d/l]
      I've changed my code to reflect your suggestion :- 
      #!/usr/bin/perl -w
#
use DBI ;
use strict ;
#
sub chk_cals {
#
#########################################################
# This Perl subroutine can be used to call an SQLPLUS   #
# script. Should this routine run to completition a 1   #
# script by Perl. Should this routine run to completion #
# (True) is returned. A failure at any stage will exit  #
# the calling script and send an appropriate Email to   #
# all interested parties.                               #
#########################################################
#
#########################################################
# Ensure variable privacy by use of the strict pragma.  #
#########################################################
#
use strict ;
use lib '/home/interface/scripts/Perl_Modules' ;
use ACC_Various ("update_report", "end_it", "mail", "mail_log") ;   
use ACC_Oracle ;
#
#####################################
# Parameter Error Boolean           #
#####################################
#
my $PARAMETER_ERROR = 0 ;
my $VALID_DB        = 0 ;
#
#########################################################
# This routine must be supplied with 4 parameters or it #
# will fail with a parameter error.                     #
#########################################################
#
#####################################
# Parameter declarations            #
#####################################
#
my $to         = undef ;
my $from       = undef ;
my $DB_name    = undef ;
my $logfile    = undef ;
#
#####################################
#       DBI Handles                 #
#####################################
#
my $dbh = undef ;
my $sth = undef ;
#
#####################################
#       DBI Error variables         #
#####################################
#
#  $DBI::err ;
#  $DBI::errstr ;
#  $DBI::state ;
#
#####################################
#      DBI Variables (hashes)       #
#####################################
#
my %attr = (
    PrintError => 0,   
    RaiseError => 0
) ;
#
################################################
# Test that the requisite number of parameters #
# have been supplied. (There MUST be 4).       #
################################################
#
if (@_ != 4) {
 print "\n\tSub::run_sqlplus -  MUST be supplied with minimum of 4 par
+ameters!" ;
 $PARAMETER_ERROR = 1 ;
}
else {
#
###############################################
# Declare parameter names                     #
###############################################
#
 $to         = $_[0] ;
 $from       = $_[1] ;
 $logfile    = $_[2] ;
 $DB_name    = $_[3] ;
#
}
#
###############################################################
# Set up variables                                            #
###############################################################
# Date and time variables for headings in Emails/logfile etc. #
###############################################################
#
my ($min, $hour, $day, $mon, $year) = (localtime) [1,2,3,4,5] ;
my $date = sprintf("%02d/%02d/%04d", $day, $mon +=1, $year += 1900);
my $time = sprintf("%02d%02d" , $hour , $min) ;
my $ptime = sprintf("%02d:%02d" , $hour , $min) ;
#
##############################
# Variables (Common scalars) #
##############################
#
my $trace_file = 'DBI_chk_cals_trace.log' ;
# 
#############################
#
my $username        = undef ;
my $password        = undef ;
my $DB_pass         = undef ;
my $ENV_info        = undef ;
#
#####################################
# Array Variables                   #
#####################################
#
my @fields         = undef ;
my @return_values  = () ;
my @Valid_DB_Names = qw(isw-test isw-live isw-teach) ;
#
# Common or garden scalars
#############################
#
my $record_count    = 0 ;
my $bcount          = 0 ;
my $ecount          = 0 ;
#

######################################
#           Hash Table               #
######################################
#
my %uid_HashLookup = (
   'isw-live'  => "/etc/oracleLIVEuid",
   'isw-test'  => "/etc/oracleTESTuid",
   'isw-teach' => "/etc/oracleTEACHuid"
);

my %ENVHashLookup = (
   'isw-live'  => "ISWLIVE",
   'isw-test'  => "ISWTEST",
   'isw-teach' => "ISWTEACH",
);
#
#####################################
#        mail_log variables.        #
#####################################
#
my $script              = 'chk_cals' ;
my $mail_msg            = 1 ;
my $null                = "none" ;
my $subject             = "Urgent - $script Failed!" ;
my $msg                 = "This should change according to failure!" ;
my $text                = "\tUnable to write the following to $logfile
+ :-\n\n" ;
my $topline             = "\n\tThe error message is -\n\n" ;
#
###########################################################
# Processing                                              #
###########################################################
#
###########################################################
#            Is it a valid Database name                  #
###########################################################
#
   foreach (@Valid_DB_Names) {
      if ($DB_name eq $_) {
         $VALID_DB = 1 ;
      }
   }
#
   if (! $VALID_DB) {
      $msg = "Db name supplied - $DB_name - is not known to this scrip
+t!" ;
      &update_report("$logfile","$msg",1,3,1) or &end_it($mail_msg,$to
+,$from,$subject,$msg,$text,$logfile) ;
      print "\n\t$msg\n" ;
      $PARAMETER_ERROR = 1 ;
   }
   else
    {
     $ENV_info = $ENVHashLookup{$DB_name} ;
#
###############################################################
#              Check that DB_pass exists                      #
###############################################################
#
     $DB_pass = $uid_HashLookup{$DB_name} ;
     if ( !-e $DB_pass) {
       $msg = "File $DB_pass does not exist!" ;
       &update_report("$logfile","$msg",1,3,1) or &end_it($mail_msg,$t
+o,$from,$subject,$msg,$text,$logfile) ;
       print "\n\t$msg\n\n" ;
       $PARAMETER_ERROR = 1 ;
     }
    }
#
$msg = "Oracle/Perl DBI (chk_cals) run on $date at $ptime." ;
&update_report("$logfile","$msg",1,3,1) or &end_it($mail_msg,$to,$from
+,$subject,$msg,$text,$logfile) ;
#
###########################################################
#               Set up the relevant profile               #
###########################################################
#
$msg = "Failed to run ACC_Oracle_profile" ;
&ACC_Oracle_profile("$ENV_info") or &end_it($mail_msg,$to,$from,$subje
+ct,$msg,$null,$logfile) ;
#
$msg = "ACC_Oracle_profile completed for $DB_name Environment" ;
&update_report("$logfile","$msg",1,1,1) or &end_it($mail_msg,$to,$from
+,$subject,$msg,$text,$logfile) ;
#
###########################################################
#           P A R A M E T E R   E R R O R S               #
###########################################################
#
   if ($PARAMETER_ERROR) {
     $msg = "\n\tScript $script fails with parameter errors!\n" ;
     print "$msg" ;
     print "\t*****************************************\n" ;
     print "\t* Contact Analyst in Team 1 - Urgently! *\n" ;
     print "\t*****************************************\n" ;
     return 0 ;
   }
#
#####################################################
# Read the Password file                            #
#####################################################
#
   $msg = "Failed to OPEN $DB_pass for Input." ;
   open INF, "<$DB_pass" or &end_it($mail_msg,$to,$from,$subject,$msg,
+$text,$logfile) ;
#
   $msg = "File $DB_pass opened for input." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   $msg = "Processing I/P file :: $DB_pass." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;

   while (<INF>) {
    $record_count ++ ;

    chomp ;

    @fields = split /\//, $_ ;

    $username = $fields[0] ;
    $password = $fields[1] ;

   }
#
   $msg = "Failed to CLOSE $DB_pass." ;
   close INF or end_it($mail_msg,$to,$from,$subject,$msg,$text,$logfil
+e) ;
#
   $msg = "Closed input file :: $DB_pass." ;
   &update_report("$logfile","$msg",1,1,1) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   if ($record_count != 1) {
    $msg = "\n\tThere were too many records in the $DB_pass file!" ;
    print "$msg" ;
    print "\t*****************************************\n" ;
    print "\t* Contact Analyst in Team 1 - Urgently! *\n" ;
    print "\t*****************************************\n" ;
    &end_it($mail_msg,$to,$from,$subject,$msg,$topline) ;
   }
#
###########################################################
#         Test for & remove any existing trace_file       #
###########################################################
#
   if (-e $trace_file) {
     $msg = "DBI - Failed to unlink old $trace_file" ;  
     unlink $trace_file or
            &end_it($mail_msg,$to,$from,$subject,$msg,$null,$logfile) 
+;
#
###########################################################
#         Update logfile                                  #
###########################################################
#
   $msg = "DBI - Old $trace_file unlinked." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   }
#
###########################################################
#         Set tracing                                     #
###########################################################
#
   DBI->trace(2, $trace_file) ;
#
###########################################################
#         Update logfile                                  #
###########################################################
# 
   $msg = "DBI - Tracing switched on." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
#         Connect to the DB                               #
###########################################################
#
   $msg = "DBI - Failed to connect to $DB_name" ;
   $dbh = DBI->connect( "dbi:Oracle:$DB_name", "$username", "$password
+", \%attr) or
                    &end_it($mail_msg,$to,$from,$subject,$msg,$null,$l
+ogfile) ;
#
###########################################################
#         Update logfile                                  #
###########################################################
#
   $msg = "DBI - User $username connected to $DB_name." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
#         Prepare SQL                                     #
###########################################################
#
   $msg = "DBI - Preparing SQL (SELECT (1)...........)." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   $msg = "\n\tDBI failed to prepare the supplied code(1)\n" ;
   $sth = $dbh->prepare( "select count(*) 
                          from   O_YEARS y,
                                 O_CALENDARS c
                          where  c.CAL_ID = y.YRS_CAL_ID
                          and    c.CAL_TYPE ='BUDGET'
                          and    to_char(y.YRS_END_DATE,'YYYY') like (
+to_char(sysdate,'YYYY')+1)") or
   &end_it($mail_msg,$to,,$from,$subject,$msg,$null,$logfile) ;
#
   $msg = "DBI - prepared SQL (SELECT (1)..............)." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
#         Execute the prepared SQL                        #
###########################################################
#
   $msg = "\n\tFailed to execute SQL (SELECT (1)..............).\n" ;
   $sth->execute() or
       &end_it($mail_msg,$to,$from,$subject,$msg,$null,$logfile) ;

   $msg = "DBI - SQL (SELECT (1)...............) executed." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
# Retrieve the returned rows of data                      #
###########################################################
#
   $record_count = 0 ;
#
   while ( $bcount = $sth->fetchrow_array() ) {
     print "\n\tField bcount = $bcount.\n" ;
     $record_count ++ ;
   }
#
   print "\n\tThe record count(bcount) returned was $record_count.\n" 
+; 
#
   $msg = "DBI - Preparing SQL (SELECT (2)...........)." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   $sth = $dbh->prepare( "select count(*) 
                          from   O_YEARS y,
                                 O_CALENDARS c
                          where  c.CAL_ID=y.YRS_CAL_ID
                          and    c.CAL_TYPE='EXTERNAL'
                          and    to_char(y.YRS_END_DATE,'YYYY') like t
+o_char(sysdate,'YYYY')") or
   &end_it($mail_msg,$to,,$from,$subject,$msg,$null,$logfile) ;
#
   $msg = "DBI - prepared SQL (SELECT (2)..............)." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
#         Execute the prepared SQL                        #
###########################################################
#
   $msg = "\n\tFailed to execute SQL (SELECT (2)..............).\n" ;
   $sth->execute() or
       &end_it($mail_msg,$to,$from,$subject,$msg,$null,$logfile) ;

   $msg = "DBI - SQL (SELECT (2)...............) executed." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
###########################################################
# Retrieve the returned rows of data                      #
###########################################################
#
   $record_count = 0 ;
#
   while ( $ecount = $sth->fetchrow_array() ) {
     print "\n\tField ecount = $ecount.\n" ;
     $record_count ++ ;
   }
#
   print "\n\tThe record count(ecount) returned was $record_count.\n" 
+; 
#
###########################################################
#         Finish the extract tidily                       #
###########################################################
#
   $msg = "\n\tDBI failed to FINISH tidily\n"  ;
   $sth->finish() or &end_it($mail_msg,$to,$from,$subject,$msg,$text,$
+logfile) ;
#
###########################################################
#         Disconnect from the DB                          #
###########################################################
#
   $msg = "\n\tDBI - Failed to disconnect from $DB_name." ;
   $dbh->disconnect() or
         &end_it($mail_msg,$to,$from,$subject,$msg,$null,$logfile) ;
#
###########################################################
#         Update logfile                                  #
###########################################################
#
   $msg = "DBI - User $username disconnected from $DB_name." ;
   &update_report("$logfile","$msg",1,1,0) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   $msg = "<********** End Of Report **********>" ;
   &update_report("$logfile","$msg",2,3,1) or &end_it($mail_msg,$to,$f
+rom,$subject,$msg,$text,$logfile) ;
#
   return ($bcount,$ecount)
}
#
#######################################################
#                     Variables                       #
#######################################################
#
my $to       = 'ronniec@it.aberdeen.net.uk' ;
my $from     = 'Buckethead' ;
my $logfile  = 'xxrc_test_DBI_special.log' ;
my $DB_name  = 'isw-test' ;
my $result   = 0 ;
my $count    = 0 ;
my @response = () ;
#
#####################################
#        mail_log variables.        #
#####################################
#
my $script              = 'chk_cals' ;
my $mail_msg            = 0 ;
my $null                = "none" ;
my $subject             = "Script $script completion details" ;
my $msg                 = "See attachment for completions details" ;
my $text                = "\tUnable to write the following to $logfile
+ :-\n\n" ;
my $row                 = undef ;
#
print "\n\t<************ SOR $script ***************>\n" ;
#
my ($bcount,$ecount) = &chk_cals("$to","$from","$logfile","$DB_name") 
+;
#
print "\n\tScalar bcount :: $bcount\n" ;
#
print "\n\tScalar ecount :: $ecount\n" ;
#
$result = &mail_log($to,$from,$subject,$msg,$logfile) ;
#
if (! $result )
 {
   $msg = "\tFailed to send completions Email!\n" ;
   $subject = "Urgent - $0 Failed!" ; 
   print "$msg" ;
   print "\t*****************************************\n" ;
   print "\t* Contact Analyst in Team 1 - Urgently! *\n" ;
   print "\t*****************************************\n" ;
   exit(99) ;
 }
#
$mail_msg = 1 ;
#
print "\n\t<************ EOR $script ***************>\n" ;

      [download]
      but it still doesn't work. When printing out the $bcount/$ecount variables in the calling script I get the standard error - 
       
                <***** EOR ACC_Oracle_profile *****>
 
        Field bcount = 1.
 
        The record count(bcount) returned was 1.
 
        Field ecount = 1.
 
        The record count(ecount) returned was 1.
Use of uninitialized value in concatenation (.) or string at xxrcdbi.p
+l line 447
.
 
        Scalar bcount ::
Use of uninitialized value in concatenation (.) or string at xxrcdbi.p
+l line 449
.
 
        Scalar ecount ::
 
        Sub::mail_log - Ends without errors.
 
        <************ EOR chk_cals ***************>

      [download]
      This is the problem I'm encountering whichever method I use - any ideas? Ronnie "Bamboozeled" Cruickshank
[reply]
[d/l]
[select]
        Well, that's expected :-) to paraphrase your code: 
        sub somesub {
 # ...
 # ...

 # loop until $ecount is false
 # it is actually undocumented what this means
 # fetchrow_array is supposed to be called in list
 # context like so
 #
 #      ($ecount) = $sth->fetchrow_array();
 #
  
 while ( $ecount = $sth->fetchrow_array() ) { 
   # ..
 }
 # $ecount is undef here, probably (see above)

 return $ecount;
}

        [download]
        the return statement is working perfectly, but your variable s will always be false (certainly not some "count").
        "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]
[d/l]
        Sorry to have been such a complete ****ing! novice but I see what is wrong - bcount/ecount are being destroyed when the fetchrow_array is exhausted!! Back to the lowest cells for me!! Ronnie
[reply]
Re: Return Value Problem
by rinceWind (Monsignor) on Oct 14, 2004 at 10:06 UTC
    Not sure how the code you have supplied relates to the problem you have outlined, unless you are talking about sub chk_cals, which you have not supplied the code for.

    In principle, you return more than one value by returning a list.

    e.g.

    
return ('foo', 'bar');

return @out;

    [download]
    perldoc perlsub has the details of subs, parameter passing and return values. Also relevant is the wantarray function, see perldoc -f wantarray.

    --
    I'm Not Just Another Perl Hacker

[reply]
[d/l]
Re: Return Value Problem
by TedPride (Priest) on Oct 14, 2004 at 10:40 UTC 
    use strict;
use warnings;

my $ref = &mysub1;
print @$ref[0] . ' ' . @$ref[1] . "\n";

my ($a,$b) = &mysub2;
print "$a $b\n";

my @arr = &mysub3;
print join(' ', @arr) . "\n";

&mysub4;
print join(' ', @_) . "\n";

# Return a reference to an array...
sub mysub1 {
    return [1,2];
}

# Return individual values...
sub mysub2 {
    return (3,4);
}

# Return an array...
sub mysub3 {
    my @arr = (5,6,7);
    return @arr;
}

# Assign values to the default
# input / output global array...
sub mysub4 {
    @_ = (8,9,10);
}

    [download]
    There's probably several others as well (I didn't bother explaining how to pass hashes, for instance), but this should get you started.
[reply]
[d/l]

Back to Seekers of Perl Wisdom