Call subroutine within subroutine

pmcmicha · Apr 16, 2003

I have a subroutine which will display the current time for a log file.

CURRENT_TIME STUFF,ETC,ETC
CURRENT_TIME MORE STUFF,ETC

During the course of the script, I call a number of subroutines for other information to be printed out to the log file. I would like to call the CURRENT_TIME subroutine from within another subroutine. But each time I try, it just ignores the entry and continues on with its normal processing. I have checked my PERL book, but I have come up with nothing on this, can this be done?

Thanks in advance.

PaulTEG · Apr 17, 2003

Does not compute, how did you declare your subroutine, and how are you calling it

Paul

pmcmicha · Apr 17, 2003

open(LOG, ">log_file&quot

;

sub CT {
$time = `date "+%T"`;
chomp $time;
print LOG "$time\t";
}

sub SOME_OTHER_ROUTINE {
CT; # This will not print the time in the log
print LOG "BLAH, BLAH, BLAH";
}

# Start Script here.
CT; # This does print the time.
print LOG "BLAH, BLAH";

Why can I not get the CT subroutine to work within another subroutine?

Swamphen · Apr 17, 2003

Well, it would help if you actually made a call to
SOME_OTHER_ROUTINE.

If you do that, you will see that the time will be printed twice.

Greetings,
Swamphen

pmcmicha · Apr 17, 2003

Okay then, let me show some actual syntax from the script which I am running. Please do not patronize me with this "Wll, it would help if you actually made a call to SOME_OTHER_ROUTINE". I do not appreciate that in the least. I did exactly what you said and the time would not be printed out to the log when called from within another subroutine. So please look at the following and see if this helps:

#!/usr/bin/perl
# The script has been modified to make use of getopts. The script was modified
# so that with getopts you would be able to call certain functions or run the
# whole script. This will be useful for fixes, etc.

# SET RETURN CODES
#
# 0 - Script completed successfully.
# 1 - User requested usage info or was given usage info.
# 2 - User requested script version information.
#
# END RETURN CODES

# SET GETOPTS
#
# c == Convert Image
# h == Create HTML
# i == Input Directory
# l == List File
# o == Output Directory
# t == Image Type
# u == Give Usage Info
# v == Give Script Version Info
# ? == Give Usage Info
#
# END GETOPTS

# SET VARIABLES
#
$bdir = "/content";
$ldir = "/content/log";
#
$ea = "\.ann"; # Extension: ann
$eh = "\.htm"; # Extension: htm
$version = "2.0";
#
# END VARIABLES

# SET MINI-FUNCTIONS
#
sub DATE {
$date = `date "+%m/%d/%Y - %T"`;
chomp $date;
print LOG "$date\t";
}

sub IMGCONV {
print LOG "Create file: $oimg.....";
$image->Resize(width=>$nw, height=>$nh);
$image->Quantize(colors=>16, colorspace=>'RGB');
$image->Write(filename=>"$oimg", compression=>'LZW');
if (!($OPT{"h"})) {
undef $image;
}
print LOG "Done.\n"
}

sub IMGINFO {
print LOG "Processing file: $img.....";
$image = new Image::Magick;
$image->Read("$img&quot

;
($h, $w) = $image->Get('height', 'width');
if (($h || $w) == 0) {
print ERROR "Filename: $img\n";
print ERROR "Height: $h\n";
print ERROR "Width: $w\n\n";
undef $image;
undef $img;
undef $oimg;
} else {
$r = 640/$w;
$nw = 640; # New width
$nh = $h * $r; # New height
}
print LOG "Done.\n";
}

sub MKHTM {
MTIME; # This will not print to the log.
print "Create HTML: $oimg.....";
open(ANN, "$iann&quot

;
open(HTML, ">$ohtm&quot

;
$header = <ANN>;
print HTML $hd;
while(<ANN>) {
($f1, $f2, $alt, $x, $y, $ex, $ey, $f8, $f9, $f10, $f11, $f12, $f13, $f14, $f15, $id) = split/\x1/;
($v1, $v2, $var, $v4) = split/,/, $id;
printf HTML "<AREA SHAPE=RECT COORDS=\"%d,%d,%d,%d\" HREF=\"Javascript

arent.TabManager.hotspot('%s');\" ALT=\"%s\">\n", $x*$r, $y*$r, ($x+$ex)*$r, ($y+$ey)*$r, $var, $alt;
}
print HTML $fd;
close(HTML);
close(ANN);
if (exists($OPT{"c"})) {
undef $image;
}
}

sub MTIME {
$time = `date "+%T"`;
chomp $time;
print LOG "$time\t";
}

sub USAGE {
print "\n\nUsage:\n";
print "\t -b: <EXTENSION TYPE TO LOOK FOR>
print "\t -c: Create Image file.\n";
print "\t -h: Create HTML file.\n";
print "\t -i: <INPUT DIRECTORY>\n";
print "\t -l: <LIST NAME>\n";
print "\t -o: <OUTPUT DIRECTORY>\n";
print "\t -t: <DEFINE IMAGE TYPE>\n";
print "\t -u: Gives usage information.\n";
print "\t -v: Gives script version information.\n";
print "\t -?: Gives usage information.\n\n\n";
exit 1;
}

sub VER {
print "\n\nScript: graph2.pl.....Current Version: $version\n\n\n";
exit 2;
}
#
# END MINI-FUNCTIONS

# Start log files.
open(ERROR, ">$ldir/graph2.err&quot

;
open(LOG, ">$ldir/graph2.log&quot

;
DATE; # This works.
print LOG "Script: graph2.pl.....Started.\n\n\n";

# Declare libraries.
MTIME; # This works.
print LOG "Now loading libraries.....";
use DirHandle;
use Getopt::Std;
use Image::Magick;
print LOG "Done.\n";

# Get the options.
MTIME;
print LOG "Process command line options.....";
my %OPT;
getopts('b:chi:l

:t:uv?', \%OPT);

if (exists($OPT{"b"})) {
$breed = $OPT{"b"};
$breed =~ s:/+$::;
}

if (exists($OPT{"c"})) {
$COF = "Enabled!!!";
} else {
$COF = "Disabled!!!";
}

if (exists($OPT{"h"})) {
$HOF = "Enabled!!!";
} else {
$HOF = "Disabled!!!";
}

if (exists($OPT{"i"})) {
$idir = $OPT{"i"}; # Input Directory
$idir =~ s:/+$::;
opendir(DIR, "$idir&quot

;
@fn = grep /.*\.$breed.*/, map "$idir/$_", readdir DIR;
closedir(DIR);
} else {
$idir = "N/A";
}

if (exists($OPT{"l"})) {
$list = $OPT{"l"};
$list =~ s:/+$::;
open(LIST, "$list&quot

;
@fn = <LIST>;
close(LIST);
} else {
$list = "N/A";
}

if (exists($OPT{"o"})) {
$odir = $OPT{"o"}; # Output Directory
$odir =~ s:/+$::;
$odir = "$odir/"; # Setup "/" at end of variable for later use.
} else {
$odir = "$bdir/temp";
}

if (exists($OPT{"t"})) {
$it = $OPT{"t"}; # Image Type
$it =~ s:/+$::;
$et = "\.$it"; # Extension: type
} else {
$it = "N/A";
}

if (exists($OPT{"u"}) || exists($OPT{"?"})) {
USAGE;
}

if (exists($OPT{"v"})) {
VER;
}

# Verify we have enough options for processing.
if ((exists($OPT{"i"}) && exists($OPT{"l"}))) {
print LOG "Failed!!!\n";
MTIME;
print LOG "You cannot specify OPTIONS: i and l at the same time.\n";
exit 3;
} elsif ((!($OPT{"i"}) && (!($OPT{"l"})))) {
print LOG "Failed!!!\n";
MTIME;
print LOG "You have to specify either OPTION: i or OPTION: l.\n";
exit 3;
} elsif ((exists($OPT{"h"}) && (exists($OPT{"t"}) && ( $et ne "\.gif" )))) {
print LOG "Failed!!!\n";
MTIME;
print LOG "This cannot be done, please try again.\n";
exit 3;
} else {
print LOG "Done.\n\n";
}

# State in the log what options are being processed.
MTIME;
print LOG "Create Image: $COF\n";
MTIME;
print LOG "Create HTML: $HOF\n";
MTIME;
print LOG "Input Directory: $idir\n";
MTIME;
print LOG "List File: $list\n";
MTIME;
print LOG "Output Directory: $odir\n";
MTIME;
print LOG "Image type: $it\n\n";

# Setup transitional variables and run main program.
while($file = shift(@fn)) {
$file =~ /(.*\/)(.*)(\.$breed)(.*)/; # Tif File
$ipath = $1; # Input Path
$filename = $2; # Name of file
$ext = $3; # Extension
if ( $ext eq "\.tif" ) {
$iann = "$ipath$filename.ann"; # Input annotation
} else {
$iann = $ipath . $filename . $ext;
}
if ( $ext eq "\.ann" ) {
$img = "$ipath$filename.tif"; # Input tif
} else {
$img = $ipath . $filename . $ext; # Tif by default.
}
$ohtm = $odir . $filename . $eh; # Output HTML
$oimg = $odir . $filename . $et; # Output Image

# Process Img first.
if (!(-e $img)) {
MTIME;
print ERROR "File Missing: $img\n";
} else {
MTIME;
IMGINFO;
}
if (exists($OPT{"c"})) {
MTIME;
IMGCONV;
} else {
undef $image;
}

# Process HTML second.
if (-e $ohtm) {
MTIME;
print LOG "Processing file: $ohtm.....Skipping!!!\n";
next;
}

$hd = "<HTML>\n" . "<IMG SRC=\"$filename$et\" ALT=\"$filename\" USEMAP=\"#mainmap\" BORDER=0>\n" . "<MAP NAME=\"mainmap\">\n";
$fd = "<\/MAP>\n" . "<\/HTML>\n";
if (exists($OPT{"h"})) {
# The following MTIME (Current Time) statements had to be put here.
MTIME;
print LOG "Processing file: $iann.....Done.\n";
MTIME;
print LOG "Create file: $ohtm.....Done.\n\n";
MKHTM;
}
}

close(LOG);
close(ERROR);
exit 0;
#EOS

Subroutine "MTIME" will not work when called from subroutine: MKHTM, IMGCONV, IMGINFO, etc. So could someone please enlighten me as to why this is occuring?

Swamphen,

It does not print twice, it will not print at all when called from another subroutine, it will only print when called from outside a subroutine, when called from the main part of the script. My apologies for not making sure that my PERL script example was complete.

Again, thanks in advance for whatever help can be offered in solving this problem.

PERL Version: 5.8

icrf · Apr 17, 2003

Code:

use strict;
use warnings;

sub CT {
	my $time = `time /T`;
	chomp $time;
	print &quot;$time\n&quot;;
}

sub SOME_OTHER_ROUTINE {
	CT;
	print &quot;in some other routine\n&quot;;
}

SOME_OTHER_ROUTINE;
CT;
print &quot;end of stuff\n&quot;;

outputs

Code:

 1:23p
in some other routine
 1:23p
end of stuff

So it works just like I'd expect. Does it not for you? (and being in windows, the date command is different)

----------------------------------------------------------------------------------
...but I'm just a C man trying to see the light

pmcmicha · Apr 17, 2003

icrf,

In the script above, I cannot get this to work, but when I just made a test script without loading any libraries or doing anything else, this worked without a problem. Thank you for your reply, it would seem that I have missed something and need to find what that is.

justice41 · Apr 17, 2003

Try running icrf's sample code but switch the order of the subroutine definitions. I think this will enlighten you (make sure you use warnings and strict).

Then call the subroutine as CT() or &CT and run it again. You should be able to figure out what is going on (the error message from the first run will be the most enlightening).

jaa

justice41 · Apr 17, 2003

BTW, if you can't figure it out, read the perlsub perldoc.

jaa

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Call subroutine within subroutine

pmcmicha

Technical User

PaulTEG

Technical User

pmcmicha

Technical User

Swamphen

Programmer

pmcmicha

Technical User

icrf

Programmer

pmcmicha

Technical User

justice41

Programmer

justice41

Programmer

Similar threads

Part and Inventory Search

Sponsor