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.

 

MENU:

 
SOFTWARE DEVELOPMENT:
    • EXPERIENCE
PRODUCTS:
UNIX: 

   • UNIX TUTORIALS

LEGACY SYSTEMS:

    • LEARN COBOL
    • PRODUCTS
    • GEN-CODE
    • COMPILERS   

INTERNET:
    • CYBERSUITE   
WINDOWS:

    • PRODUCTS


Search Now:
 
In Association with Amazon.com

Copyright©2001 King Computer Services Inc. All rights reserved.