Getting started with Perl, Part 2

Unix Insider –

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:

<font face="Courier"> 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	
</font>

This menu program produced a screen something like the following by using a

<font face="Courier">menufile.txt</font>
containing menu selections:

<font face="Courier">        a       Say Hello Gracie
        b       Show Perl man pages
        c       Show Current Directory
        x       Exit


Enter your selection
</font>

The

<font face="Courier">menufile.txt</font>
is repeated in the following listing:

<font face="Courier">a:Say Hello Gracie:echo "Hello Gracie"
b:Show Perl man pages:man perl
c:Show Current Directory:ls -l|more
</font>

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

<font face="Courier">menufile.txt</font>
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
<font face="Courier">menufile.txt</font>
. Create a new version of
<font face="Courier">menufile.txt</font>
, or modify the one you created for last month's article, so that it matches this illustration.

<font face="Courier">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
</font>

Menu options

<font face="Courier">d</font>
,
<font face="Courier">e</font>
and
<font face="Courier">f</font>
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.

<font face="Courier">        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
</font>

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.

<font face="Courier">#!/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>;
}
</font>

The major change in the menu routine is show below at lines 77 through 104 in the

<font face="Courier">do_pick()</font>
routine. At line 86 the row that has been read in from
<font face="Courier">menufile.txt</font>
is split into four fields instead of three. The fourth field includes the
<font face="Courier">$menutype</font>
. At lines 89 through 96, the
<font face="Courier">$menutype</font>
is tested, and if it is
<font face="Courier">"system"</font>
, then the command extracted in
<font face="Courier">$menucommand</font>
is executed via system. Other wise the command is executed as
<font face="Courier">&$menucommand</font>
. 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
<font face="Courier">$menucommand</font>
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
<font face="Courier">$menucommand</font>
.

<font face="Courier">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	
</font>

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

<font face="Courier">menufile.txt</font>
you will see that it is looking for Perl functions named
<font face="Courier">add_contact</font>
,
<font face="Courier">lookup_contact</font>
, and
<font face="Courier">print_contacts</font>
. 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
<font face="Courier">Perl menu</font>
(or whatever name you have chosen for this project). Enter a
<font face="Courier">d</font>
, an
<font face="Courier">e</font>
, and an
<font face="Courier">f</font>
from the menu to ensure that you are getting the three messages.

<font face="Courier">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"
}
</font>

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.

<font face="Courier">#!/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";
}
</font>

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

<font face="Courier">contact.txt</font>
.

<font face="Courier">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
</font>

The new code to provide the

<font face="Courier">add_contact()</font>
,
<font face="Courier">lookup_contact()</font>
, and
<font face="Courier">print_contacts()</font>
routines to maintain the
<font face="Courier">contact.txt</font>
file, begins at line 113 after the
<font face="Courier">press_enter()</font>
routine. The
<font face="Courier">add_contact()</font>
function repeated calls to a
<font face="Courier">get_data()</font>
function passing in a prompt number and a prompt. The return value from
<font face="Courier">get_data()</font>
is stored in the variables
<font face="Courier">$first</font>
,
<font face="Courier">$last</font>
,
<font face="Courier">$address1</font>
, 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:

<font face="Courier">sub get_data;
</font>

which identifies

<font face="Courier">get_data()</font>
as a function before it is called, and makes it possible to call
<font face="Courier">get_data()</font>
without parentheses as in

<font face="Courier">124		$address1 = get_data 3,"Address 1" ;
125		$address2 = get_data 4,"Address 2" ;
</font>
<font face="Courier">
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	}
</font>

The

<font face="Courier">get_data()</font>
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,
<font face="Courier">@_</font>
(at underscore). In this example, at line 138, the values for the line number and prompt are pulled from
<font face="Courier">@_</font>
. The number and prompt are used to build a request to the user to enter information at line 139. The result is read into
<font face="Courier">$res</font>
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
<font face="Courier">my</font>
keyword at line 138 is also new. The
<font face="Courier">my</font>
keyword creates a local variable that has value within the function but not outside of it. If a global variable named
<font face="Courier">$num</font>
or
<font face="Courier">$prompt</font>
exists anywhere else in the program, it will be ignored inside the
<font face="Courier">get_data()</font>
routine in favor of the local versions of
<font face="Courier">$num</font>
and
<font face="Courier">$prompt</font>
.

<font face="Courier">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	}
</font>

The routine

<font face="Courier">is_it_ok()</font>
at lines 146 through 156 is called at line 131 in
<font face="Courier">add_contact()</font>
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
<font face="Courier">get_changes()</font>
is called to get the changes.

<font face="Courier">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	}
</font>

The

<font face="Courier">print_contact()</font>
routine at lines 158 through 169 prints the values in
<font face="Courier">$first</font>
,
<font face="Courier">$last</font>
, and so on by calling a one line printing routine
<font face="Courier">print_date()</font>
and passing in a prompt number, a prompt, and the actual value to print.

<font face="Courier">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	}
</font>

The

<font face="Courier">print_data()</font>
routine extracts the passed values in
<font face="Courier">@_</font>
into local variables and uses them to format a line of print data.

<font face="Courier">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	}
</font>

The

<font face="Courier">get_yes_no()</font>
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.

<font face="Courier">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	}
</font>

The

<font face="Courier">get_changes()</font>
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.

<font face="Courier">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	}
</font>

The

<font face="Courier">change_field()</font>
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
<font face="Courier">last</font>
operator. A block of code can be given a label. The keyword
<font face="Courier">last</font>
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,
<font face="Courier">get_data()</font>
is called for the appropriate piece of data, and the block exits. You have already seen the
<font face="Courier">get_data()</font>
function at lines 135 through 142.

<font face="Courier">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	}
</font>

The

<font face="Courier">write_contact()</font>
function opens the
<font face="Courier">contact.txt</font>
file for append at line 221. The chevrons included in the file name
<font face="Courier">">>contact.txt"</font>
indicate open for append. Other open values include
<font face="Courier">">"</font>
for open output and
<font face="Courier">"<"</font>
for open input. The values of
<font face="Courier">$first</font>
,
<font face="Courier">$last</font>
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.

<font face="Courier">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	#---------------------------------------------------
</font>

This completes the first menu pick option for

<font face="Courier">add_contact</font>
. 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

<font face="Courier">lookup_contact</font>
. 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
<font face="Courier">lookup_this_contact()</font>
. If
<font face="Courier">lookup_this_contact</font>
returns a "0", then a message indicating that no matches were found is printed.

<font face="Courier">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	}
</font>

The

<font face="Courier">lookup_this_contact()</font>
routine is passed one value -- the last name to look up -- and this is extracted into
<font face="Courier">$lu</font>
at line 252. The routine opens the contact file and reads through it, extracting the values for
<font face="Courier">$first</font>
,
<font face="Courier">$last</font>
, and so on. The value for
<font face="Courier">$last</font>
is compared to
<font face="Courier">$lu</font>
and, if it matches,
<font face="Courier">print_contact()</font>
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.

<font face="Courier">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	}
</font>

The last menu function,

<font face="Courier">print_contacts()</font>
, 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.

<font face="Courier">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	}
</font>

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.

From CIO: 8 Free Online Courses to Grow Your Tech Skills
Join the discussion
Be the first to comment on this article. Our Commenting Policies