Getting started with Perl, Part 2
Building on last month's menu script
Summary
In this conclusion to the Perl series, Mo covers more on Perl syntax, passing values to and returning them from Perl functions, and some tricks on calling Perl
functions by reference instead of by name. (3,000 words)
Based on some excellent suggestions from a few readers, I am making a change in the format of the listings and listing explanations in these articles. One reader suggested that listings would be easier to cut and paste if they did not include line numbers. Another pointed out that a long explanation of a long listing causes the reader to have to flip up and down the screen to refer to the text of the explanation and then the text of the listing. To accommodate both of these very good suggestions, I have changed the listing/explanation format to start with a description of what the program or listing does, followed by a complete copy of the listing without line numbers. If the program requires a further explanation broken down line by line, the unnumbered full listing will be followed by a detailed explanation composed of alternating explanations and line numbered listing fragments in the text. This should handle both problems, and, I believe, will improve the usefulness and readability of these articles. Let me know what you think.
In the last issue we took Perl logic up to the point of generating a simple menu program which I repeat here in the following listing:
1 #!/usr/bin/perl
2
3
4 #---------------------------------------
5 # MAIN ROUTINE
6 #---------------------------------------
7 # Display a menu and get a selection
8 get_menu_pick();
9
10 # as long as the E(x)it option is not chosen,
11 # execute the menu option and then display
12 # the menu again and ask for another choice
13
14 while ( $pick ne "x" )
15 {
16 do_pick();
17 get_menu_pick();
18 }
19
20 # clear the screen and exit with a 0 return code
21 clear_screen();
22
23 exit (0);
24 #---------------------------------------
25 # MAIN ROUTINE ENDS
26 #---------------------------------------
27
28 # Clear the screen, Show the menu and get user input
29 sub get_menu_pick
30 {
31 clear_screen();
32 show_menu();
33 get_pick();
34 }
35
36 # Clear the screen by printing 25 newlines
37 sub clear_screen
38 {
39 for ($i=0; $i < 25; ++$i){
40 print "\n";
41 }
42 }
43
44 # Open menufile.txt or exit with an error
45 # read in each row picking up the first two fields by
46 # splitting it on the pipe |
47 # print the first two fields
48 # send some form feeds to do some centering
49 sub show_menu
50 {
51 $count = 0;
52 open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
53 while ($menurow=<MENUFILE>)
54 {
55 ($menupick,$menuprompt)=split /:/,$menurow;
56 print "\t$menupick\t$menuprompt \n";
57 ++$count;
58 }
59 close MENUFILE;
60 print "\tx\tExit\n";
61 ++$count;
62 $count = (24 - $count ) / 2;
63 for ($i=0; $i < $count; ++$i){
64 print "\n";
65 }
66 print "\n\nEnter your selection\n";
67
68 }
69
70 # get user input and chop off the newline
71 sub get_pick()
72 {
73 chomp($pick = <STDIN>);
74 }
75
76 sub do_pick()
77 {
78
79 open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
80 while ($menurow=<MENUFILE>)
81 {
82 ($menupick, $menuprompt, $menucommand)=split /:/,$menurow;
83 if ($menupick eq $pick)
84 {
85 system $menucommand;
86 break;
87 }
88 }
89 close MENUFILE;
90 press_enter();
91 }
92
93 # put up a message and wait for user to press ENTER
94 sub press_enter
95 {
96 print "Press Enter to Continue . . .\n";
97 $dummy = <STDIN>;
98 }
99
This menu program produced a screen something like the following by using a menufile.txt containing menu selections:
a Say Hello Gracie
b Show Perl man pages
c Show Current Directory
x Exit
Enter your selection
The menufile.txt is repeated in the following listing:
a:Say Hello Gracie:echo "Hello Gracie"
b:Show Perl man pages:man perl
c:Show Current Directory:ls -l|more
Adding Unix shell commands
The first step is to extend this simple menu program to allow a user to execute Unix shell commands, which the program can already do, as well as Perl functions internal to a Perl script. There is a different syntax to calling a Perl function, so the menufile.txt must identify when a menu selection is a system request and when it is a Perl function request. To do this, a fourth field, containing a flag indicating whether the menu request is for a system call or a Perl function, must be added to the menu file. An example of this is shown in the following display of the new menufile.txt. Create a new version of menufile.txt, or modify the one you created for last month's article, so that it matches this illustration.
a:Say Hello Gracie:echo "Hello Gracie":system
b:Show Perl man pages:man perl:system
c:Show Current Directory:ls -l|more:system
d:Add a New Contact:add_contact:perl
e:Display Contact Information:lookup_contact:perl
f:Display All Contacts:print_contacts:perl
Menu options d, e and f display additional menu options, but when they are selected, they will call Perl functions that are internal to the program. The new menu screen is shown below.
a Say Hello Gracie
b Show Perl man pages
c Show Current Directory
e Add a New Contact
f Display Contact Information
g Display All Contacts
x Exit
Enter your selection
The actual change to the menu is very simple and is show in the following listing. An explanation of the changes follows the listing, as promised.
#!/usr/bin/perl
#---------------------------------------
# MAIN ROUTINE
#---------------------------------------
# Display a menu and get a selection
get_menu_pick();
# as long as the E(x)it option is not chosen,
# execute the menu option and then display
# the menu again and ask for another choice
while ( $pick ne "x" )
{
do_pick();
get_menu_pick();
}
# clear the screen and exit with a 0 return code
clear_screen();
exit (0);
#---------------------------------------
# MAIN ROUTINE ENDS
#---------------------------------------
# Clear the screen, Show the menu and get user input
sub get_menu_pick
{
clear_screen();
show_menu();
get_pick();
}
# Clear the screen by printing 25 newlines
sub clear_screen
{
for ($i=0; $i < 25; ++$i){
print "\n";
}
}
# Open menufile.txt or exit with an error
# read in each row picking up the first two fields by
# splitting it on the pipe |
# print the first two fields
# send some formfeeds to do some centering
sub show_menu
{
$count = 0;
open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
while ($menurow=<MENUFILE>)
{
($menupick,$menuprompt)=split /:/,$menurow;
print "\t$menupick\t$menuprompt \n";
++$count;
}
close MENUFILE;
print "\tx\tExit\n";
++$count;
$count = (24 - $count ) / 2;
for ($i=0; $i < $count; ++$i){
print "\n";
}
print "\n\nEnter your selection\n";
}
# get user input and chop off the newline
sub get_pick()
{
chomp($pick = <STDIN>);
}
# Do the pick the user requested either as a call to the system
# or as an internal perl function
sub do_pick()
{
open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
while ($menurow=<MENUFILE>)
{
($menupick,$menuprompt,$menucommand,$menutype)=split /:/,$menurow;
if ($menupick eq $pick)
{
if ($menutype eq "system" )
{
system $menucommand;
}
else
{
&$menucommand;
}
break;
}
}
close MENUFILE;
press_enter();
}
# put up a message and wait for user to press ENTER
sub press_enter
{
print "Press Enter to Continue . . .\n";
$dummy = <STDIN>;
}
The major change in the menu routine is show below at lines 77 through 104 in the do_pick() routine. At line 86 the row that has been read in from menufile.txt is split into four fields instead of three. The fourth field includes the $menutype. At lines 89 through 96, the $menutype is tested, and if it is "system", then the command extracted in $menucommand is executed via system. Other wise the command is executed as &$menucommand. The ampersand is Perl's way of flagging a variable or identifier as the name of a function. Officially, the ampersand is part of the function name, but in most contexts, Perl can figure out that you want to call (or define/declare) a function, and the ampersand is optional. In this case, the content of $menucommand has been read in from a file, and Perl needs the ampersand to recognize that it is supposed to call a function that is named by the value in $menucommand.
77 # Do the pick the user requested either as a call to the system
78 # or as an internal perl function
79
80 sub do_pick()
81 {
82
83 open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
84 while ($menurow=<MENUFILE>)
85 {
86 ($menupick,$menuprompt,$menucommand,$menutype)=split /:/,$menurow;
87 if ($menupick eq $pick)
88 {
89 if ($menutype eq "system" )
90 {
91 system $menucommand;
92 }
93 else
94 {
95 &$menucommand;
96 }
97
98 break;
99 }
100 }
101 close MENUFILE;
102 press_enter();
103 }
104
Now we have a method of calling a Perl function, and a method of putting those functions on a menu, but where are the functions? If you look back at the new version of menufile.txt you will see that it is looking for Perl functions named add_contact, lookup_contact, and print_contacts. These will be functions directly added into the Perl menu program. For now, add the following lines of code to the end of your existing project (or cut these lines and paste them to the end of the project). To test that the process of calling an internal Perl function is working correctly, run your Perl program by typing Perl menu (or whatever name you have chosen for this project). Enter a d, an e, and an f from the menu to ensure that you are getting the three messages.
sub add_contact
{
print "Adding a contact. \n"
}
sub lookup_contact
{
print "Looking up a contact. \n"
}
sub print_contacts
{
print "Printing all contacts. \n"
}
The complete program as it is supposed to look is shown below. The explanation follows. Be warned that this program does not always contain the best way to get a particular job done; its purpose is to illustrate basic Perl programming constructs. I have also used some different styles for blocking (enclosing statements in braces) just for illustration.
#!/usr/bin/perl
#---------------------------------------
# MAIN ROUTINE
#---------------------------------------
# Display a menu and get a selection
get_menu_pick();
# as long as the E(x)it option is not chosen,
# execute the menu option and then display
# the menu again and ask for another choice
while ( $pick ne "x" )
{
do_pick();
get_menu_pick();
}
# clear the screen and exit with a 0 return code
clear_screen();
exit (0);
#---------------------------------------
# MAIN ROUTINE ENDS
#---------------------------------------
# Clear the screen, Show the menu and get user input
sub get_menu_pick
{
clear_screen();
show_menu();
get_pick();
}
# Clear the screen by printing 25 newlines
sub clear_screen
{
for ($i=0; $i < 25; ++$i){
print "\n";
}
}
# Open menufile.txt or exit with an error
# read in each row picking up the first two fields by
# splitting it on the pipe |
# print the first two fields
# send some formfeeds to do some centering
sub show_menu
{
$count = 0;
open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
while ($menurow=<MENUFILE>)
{
($menupick,$menuprompt)=split /:/,$menurow;
print "\t$menupick\t$menuprompt \n";
++$count;
}
close MENUFILE;
print "\tx\tExit\n";
++$count;
$count = (24 - $count ) / 2;
for ($i=0; $i < $count; ++$i){
print "\n";
}
print "\n\nEnter your selection\n";
}
# get user input and chop off the newline
sub get_pick()
{
chomp($pick = <STDIN>);
}
# Do the pick the user requested either as a call to the system
# or as an internal perl function
sub do_pick()
{
open( MENUFILE, "menufile.txt") or die "Can't open menufile.txt: $!\n";
while ($menurow=<MENUFILE>)
{
($menupick,$menuprompt,$menucommand,$menutype)=split /:/,$menurow;
if ($menupick eq $pick)
{
if ($menutype eq "system" )
{
system $menucommand;
}
else
{
&$menucommand;
}
break;
}
}
close MENUFILE;
press_enter();
}
# put up a message and wait for user to press ENTER
sub press_enter
{
print "Press Enter to Continue . . .\n";
$dummy = <STDIN>;
}
#---------------------------------------------------
# add_contact() routine and supporting routines
#---------------------------------------------------
# Get data for each of the fields in the contact file
# verify that the data is correct and write it to
# file.
sub add_contact
{
$first = get_data (1,"First Name");
$last = get_data(2,"Last Name");
$address1 = get_data(3,"Address 1");
$address2 = get_data(4,"Address 2");
$city = get_data(5,"City");
$state = get_data(6,"State");
$zip = get_data(7,"Zip");
$phone = get_data(8,"Phone");
is_it_ok();
write_contact();
}
# prompt and enter data
sub get_data
{
my ($num, $prompt) = @_;
print "\t\t$num. Please enter $prompt?\n";
chomp(my $res = <STDIN>);
return $res;
}
# show the user the entry and ask if its OK
# allow changes if not
sub is_it_ok
{
$ans = "n";
while ($ans eq "n")
{
print_contact();
print "Is this correct? ";
$ans = get_yes_no();
if ($ans eq "n") {get_changes();}
}
}
# print all fields of a contact
sub print_contact
{
print_data (1,"First Name",$first);
print_data(2,"Last Name",$last);
print_data(3,"Address 1",$address1);
print_data(4,"Address 2",$address2);
print_data(5,"City",$city);
print_data(6,"State",$state);
print_data(7,"Zip",$zip);
print_data(8,"Phone",$phone);
}
# print one field of a contact
sub print_data
{
my ($num, $prompt, $value) = @_;
print "\t\t$num.\t$prompt\t$value\n";
}
# ask for a yes or no answer
sub get_yes_no
{
print "yes/no (y/n)\n";
chomp ( my $res = <STDIN>);
return $res;
}
# get the number of the field to change and then ask the
# user for new data
sub get_changes
{
print "Which field do you want to change (99 to exit)?\n";
chomp ( my $num = <STDIN> );
while ($num != 99)
{
change_field($num);
print "Which field do you want to change (99 to exit)?\n";
chomp ( $num = <STDIN> );
}
}
# based on the number of the field to change
# ask the user for new data
sub change_field
{
my ($nm) = @_;
SWITCH:{
if ($nm==1){$first=get_data($nm,"First Name");last SWITCH;}
if ($nm==2){$last=get_data($nm,"Last Name");last SWITCH;}
if ($nm==3){$address1=get_data($nm,"Address 1");last SWITCH;}
if ($nm==4){$address2=get_data($nm,"Address 2");last SWITCH;}
if ($nm==5){$city=get_data($nm,"City");last SWITCH;}
if ($nm==6){$state=get_data($nm,"State");last SWITCH;}
if ($nm==7){$zip=get_data($nm,"Zip");last SWITCH;}
if ($nm==8){$phone=get_data($nm,"Phone");last SWITCH;}
}
}
# write all fields to contact.txt with : delimiters
sub write_contact
{
open (CONTACTS,">>contact.txt");
print CONTACTS "$first:$last:$address1:$address2:$city:$state:$zip:$phone\n";
close CONTACTS;
}
#---------------------------------------------------
# lookup_contact() routine and supporting routines
#---------------------------------------------------
# ASk the user for a last name to look up and then search the
# contact.txt file for it
sub lookup_contact
{
print "Enter the last name to look for\n";
chomp(my $lookup=<STDIN>);
if (0 == lookup_this_contact($lookup))
{
print "$lookup not found\n";
}
else
{
print "Last entry has been displayed\n";
}
}
# open the contact.txt file and read through it looking for
# a match on the passed last name field. Display the contact
# data anytime the last name matches
sub lookup_this_contact
{
my $found = 0;
my ($lu)=@_;
open( CONTACTS, "contact.txt") or die "Can't open contact.txt: $!\n";
while ($datarow=<CONTACTS>)
{
@data=split /:/,$datarow;
($first,$last,$address1,$address2,$city,$state,$zip,$phone)=@data;
if ($lu eq $last)
{
$found = 1;
print_contact();
press_enter();
}
}
close CONTACTS;
return $found
}
#---------------------------------------------------
# print_contacts() routine
# using support routines from other functions
#---------------------------------------------------
# step through the contact file listing contact information
sub print_contacts
{
open( CONTACTS, "contact.txt") or die "Can't open contact.txt: $!\n";
while ($datarow=<CONTACTS>)
{
@data=split /:/,$datarow;
($first,$last,$address1,$address2,$city,$state,$zip,$phone)=@data;
print_contact();
press_enter();
clear_screen();
}
close CONTACTS;
print "Last Entry has been displayed.\n";
}
This program is designed to maintain a contact file that looks like the following example. The fields for first name, last name, address 1, address 2, city, state, zip, and phone are separated by colons and stored in a file name contact.txt.
Charles:Dickens:1010 Maypole Rd:Little Wickham:Stow-on-Sea:SUSSEX:2NT NY7:011-123456
Charlotte:Bronte:High Wickham::Newton Abbot:Shropshire:2NN RT7:011-48789
Emily:Bronte:Lower Wickham::Newton Abbot:Worchestershire:4YN NN7:011-98765
Robert:Heinlein:6 Friday Ave:Apt 66:Strangeland:CA:12345:555-1234
The new code to provide the add_contact(), lookup_contact(), and print_contacts() routines to maintain the contact.txt file, begins at line 113 after the press_enter() routine. The add_contact() function repeated calls to a get_data() function passing in a prompt number and a prompt. The return value from get_data() is stored in the variables $first, $last, $address1, and so on through to the phone number. This section of code illustrates the simplest way of calling a function with arguments. In last month's article I mentioned that parentheses are not always needed. That is the case when the subroutine has been declared in advance of its usage. This can be achieved, among other ways, by adding earlier in the code, usually near the top of the program, the following line:
sub get_data;
which identifies get_data() as a function before it is called, and makes it possible to call get_data() without parentheses as in
124 $address1 = get_data 3,"Address 1" ;
125 $address2 = get_data 4,"Address 2" ;
113 #---------------------------------------------------
114 # add_contact() routine and supporting routines
115 #---------------------------------------------------
116
117 # Get data for each of the fields in the contact file
118 # verify that the data is correct and write it to
119 # file.
120 sub add_contact
121 {
122 $first = get_data (1,"First Name");
123 $last = get_data(2,"Last Name");
124 $address1 = get_data(3,"Address 1");
125 $address2 = get_data(4,"Address 2");
126 $city = get_data(5,"City");
127 $state = get_data(6,"State");
128 $zip = get_data(7,"Zip");
129 $phone = get_data(8,"Phone");
130
131 is_it_ok();
132 write_contact();
133 }
The get_data() function at lines 135 through 142 uses the values passed to it to create a prompt on the screen and to ask the user for information. This is the first example you have seen of a function that has been passed values, and the secret to these functions is covered in line 138. You have already seen the list operator and extraction of list values in the menu itself and this line is another example of the same technique. The difference is the list itself. In Perl, the list of values passed to a function appears in a local list variable, @_ (at underscore). In this example, at line 138, the values for the line number and prompt are pulled from @_. The number and prompt are used to build a request to the user to enter information at line 139. The result is read into $res from standard input at line 140 and finally returned at line 141. Formally, Perl returns the value of the last action in a subroutine, and line 141 is redundant, but I prefer to make an explicit return, which is a self-documenting piece of code that makes clear the intention of the subroutine. The my keyword at line 138 is also new. The my keyword creates a local variable that has value within the function but not outside of it. If a global variable named $num or $prompt exists anywhere else in the program, it will be ignored inside the get_data() routine in favor of the local versions of $num and $prompt.
135 # prompt and enter data
136 sub get_data
137 {
138 my ($num, $prompt) = @_;
139 print "\t\t$num. Please enter $prompt?\n";
140 chomp(my $res = <STDIN>);
141 return $res;
142 }
The routine is_it_ok() at lines 146 through 156 is called at line 131 in add_contact() and is a simple routine which displays the contact information that has been entered and asks the user if everything is correct. If the answer is no, then a routine called get_changes() is called to get the changes.
144 # show the user the entry and ask if its OK
145 # allow changes if not
146 sub is_it_ok
147 {
148 $ans = "n";
149 while ($ans eq "n")
150 {
151 print_contact();
152 print "Is this correct? ";
153 $ans = get_yes_no();
154 if ($ans eq "n") {get_changes();}
155 }
156 }
The print_contact() routine at lines 158 through 169 prints the values in $first, $last, and so on by calling a one line printing routine print_date() and passing in a prompt number, a prompt, and the actual value to print.
158 # print all fields of a contact
159 sub print_contact
160 {
161 print_data(1,"First Name",$first);
162 print_data(2,"Last Name",$last);
163 print_data(3,"Address 1",$address1);
164 print_data(4,"Address 2",$address2);
165 print_data(5,"City",$city);
166 print_data(6,"State",$state);
167 print_data(7,"Zip",$zip);
168 print_data(8,"Phone",$phone);
169 }
The print_data() routine extracts the passed values in @_ into local variables and uses them to format a line of print data.
171 # print one field of a contact
172 sub print_data
173 {
174 my ($num, $prompt, $value) = @_;
175 print "\t\t$num.\t$prompt\t$value\n";
176 }
The get_yes_no() function is a very simple function to get a yes or no answer and return it. This function could improved a lot by adding in validation and checking for upper and lower case versions of Y and N.
178 # ask for a yes or no answer
179 sub get_yes_no
180 {
181 print "yes/no (y/n)\n";
182 chomp ( my $res = <STDIN>);
183 return $res;
184 }
The get_changes() routine asks the user for the number of the field to change. I knew you were wondering why each field had a number, and here is the explanation: it is a simple way of identifying which prompt needs to be repeated to the user.
186 # get the number of the field to change and then ask the
187 # user for new data
188 sub get_changes
189 {
190 print "Which field do you want to change (99 to exit)?\n";
191 chomp ( my $num = <STDIN> );
192 while ($num != 99)
193 {
194 change_field($num);
195 print "Which field do you want to change (99 to exit)?\n";
196 chomp ( $num = <STDIN> );
197 }
198 }
The change_field() routine illustrates the case or switch statement in Perl. I say illustrates with my tongue planted firmly in my cheek, because there is no case statement. Instead, Perl allows for a named block of code which starts, in this example, at line 205, and ends at 214 with the closing braces. Inside a block of code, the user can be sent to the end of the block using the last operator. A block of code can be given a label. The keyword last can be used to jump
to the end of the current block of code, or can be followed by a label name
indicating that the program is to jump to the end of the block that is named
with that label. That is exactly what happens in this case statement. Each line is a test. If the test is true, get_data() is called for the appropriate piece of data, and the block exits. You have already seen the get_data() function at lines 135 through 142.
200 # based on the number of the field to change
201 # ask the user for new data
202 sub change_field
203 {
204 my ($nm) = @_;
205 SWITCH:{
206 if ($nm==1){$first=get_data($nm,"First Name");last SWITCH;}
207 if ($nm==2){$last=get_data($nm,"Last Name");last SWITCH;}
208 if ($nm==3){$address1=get_data($nm,"Adress 1");last SWITCH;}
209 if ($nm==4){$address2=get_data($nm,"Address 2");last SWITCH;}
210 if ($nm==5){$city=get_data($nm,"City");last SWITCH;}
211 if ($nm==6){$state=get_data($nm,"State");last SWITCH;}
212 if ($nm==7){$zip=get_data($nm,"Zip");last SWITCH;}
213 if ($nm==8){$phone=get_data($nm,"Phone");last SWITCH;}
214 }
215 }
The write_contact() function opens the contact.txt file for append at line 221. The chevrons included in the file name ">>contact.txt" indicate open for append. Other open values include ">" for open output and "<" for open input. The values of $first, $last and so on are strung together with colons to separate the fields. Next they are written to the contacts file, and finally the contacts file is closed.
218 # write all fields to contact.txt with : delimiters
219 sub write_contact
220 {
221 open (CONTACTS,">>contact.txt");
222 print CONTACTS "$first:$last:$address1:$address2:$city:$state:$zip:$phone\n";
223 close CONTACTS;
224 }
225
226 #---------------------------------------------------
227 # lookup_contact() routine and supporting routines
228 #---------------------------------------------------
This completes the first menu pick option for add_contact. This section was quite long, but the remaining sections heavily use routines from this first section so the going gets easier.
The second menu pick was lookup_contact. This option asks the user for a last name at lines 234 and 235, and searches the database for any entries matching the last name by calling lookup_this_contact(). If lookup_this_contact returns a "0", then a message indicating that no matches were found is printed.
230 # Ask the user for a last name to look up and then search the
231 # contact.txt file for it
232 sub lookup_contact
233 {
234 print "Enter the last name to look for\n";
235 chomp(my $lookup=<STDIN>);
236 if (0 == lookup_this_contact($lookup))
237 {
238 print "$lookup not found\n";
239 }
240 else
241 {
242 print "Last entry has been displayed\n";
243 }
244 }
The lookup_this_contact() routine is passed one value -- the last name to look up -- and this is extracted into $lu at line 252. The routine opens the contact file and reads through it, extracting the values for $first, $last, and so on. The value for $last is compared to $lu and, if it matches, print_contact() is called to display the information. The loop continues reading in rows of data from the file on the basis that there may be more than one entry with that last name.
246 # open the contact.txt file and read through it looking for
247 # a match on the passed last name field. Display the contact
248 # data anytime the last name matches
249 sub lookup_this_contact
250 {
251 my $found = 0;
252 my ($lu)=@_;
253
254 open( CONTACTS, "contact.txt") or die "Can't open contact.txt: $!\n";
255 while ($datarow=<CONTACTS>)
256 {
257 @data=split /:/,$datarow;
258 ($first,$last,$address1,$address2,$city,$state,$zip,$phone)=@data;
259 if ($lu eq $last)
260 {
261 $found = 1;
262 print_contact();
263 press_enter();
264 }
265 }
266 close CONTACTS;
267 return $found
268 }
The last menu function, print_contacts(), has very little hard work to do. It simply reads through the entire file and prints each record to the screen, using calls to already existing functions.
270 #---------------------------------------------------
271 # print_contacts() routine
272 # using support routines from other functions
273 #---------------------------------------------------
274
275 # step through the contact file listing contact information
276 sub print_contacts
277 {
278 open( CONTACTS, "contact.txt") or die "Can't open contact.txt: $!\n";
279 while ($datarow=<CONTACTS>)
280 {
281 @data=split /:/,$datarow;
282 ($first,$last,$address1,$address2,$city,$state,$zip,$phone)=@data;
283 print_contact();
284 press_enter();
285 clear_screen();
286 }
287 close CONTACTS;
288 print "Last Entry has been displayed.\n";
289 }
As you can see from these examples, Perl chews up and spits out text processing problems for breakfast, and this is only a small sample of what it can do. The above program, with some changes to input and output and some tweaking to handle sharing, could be used as a CGI script to allow Web users to input their names and addresses and look up friends in a simple white-pages style directory. Explore Perl further; it is fascinating and versatile.
I'd like to hear from you about the new layout for the articles and I hope it makes them easier to read and to get at the code.
Contact
us for a free consultation. |
