The manager of a fast food outlet requires a program to help track sales. The outlet only serves burgers with fries; a burger meal costs $5.95. Customers may order any number of burger meals. The program is to help calculate prices of orders, and is also to keep records of total orders and the largest single order. The program is to use a simple menu-select style loop with the options:

(1) Place order

(2) Print totals so far

(3) Quit

The order option should result in a prompt for the number of meals required. Any invalid input data (value <=0) are to be discarded; the program is to again prompt the user with the options. Valid input data should result in updates of total sales and, where appropriate, update of the record of the largest order. The program should also respond with an order number and the cost of the order. The totals option should print details of total sales and largest order. The quit option terminates the program. An invalid option selection is reported; then the program repeats the prompt for input. (The original specification included a printout showing the exact formats required for inputs and outputs.) Obviously, the Perl program requires a while loop containing an if...elsif...else construct.

#!/share/bin/perl -w
   $cost = 5.95;
   $orderNum = 0;
   $maxorder = 0;
   $totalsales = 0;
   while(1) {
   print 'Welcome to CS1 Burgers
   1. Make an Order
   2. Print totals
   3. Quit
   Enter your choice:';
   $order = <STDIN>;
   if ($order == 1) {
   print "How many meals do you want?";
   $size = <STDIN>;
   if($size <= 0) { next; }
   $orderNum++;
   print "You are customer number : $orderNum\n";
   $ordercost = $cost * $size;
   print "You owe: \$$ordercost\n";
   $maxorder = ($size > $maxorder) ? $size : $maxorder;
   $totalsales += $ordercost;
   }
   elsif($order == 2) {
   print "There were $orderNum customers\n";

print "Total amount: \$$totalsales\n";
   print "Maximum number of dishes ordered in a ".
   "single order: $maxorder dishes\n";
   }
   elsif($order == 3) { last; }
   else { print "That was a bad choice. ... Try again"; }
   }
 print "Bye!\n";

(Can you remember back to the times when something like this was a hard assignment that took you a week?) Features to note in the code are: A ‘forever’ while loop; terminated by the last statement in selection option 3. The use of amulti-line string definition to simplify the declaration of the prompt string. The use of <STDIN> input. The automatic coercion of input to a numeric value. An if...elsif...else conditional construct (probably intended to be a case statement in the original version of this assignment). next and last statements in the body of the loop. Proof that Perl has kept C’s ternary operator () ?... : ... Interpolation of data values into strings.

This assignment was actually from a higher-level subject, but it too requires only the most basic of programming structures. The program is to read data concerning files and directories as obtained from the Unix command ls -l. Input is to be read from STDIN (either pipe from ls -l or redirect from a file produced via ls -l). Example input data are:

-r-x--x--x 1 root bin 20796 Jan 6 2000 acctcom
   -r-x--x--x 37 root bin 5256 Jan 6 2000 adb
   lrwxrwxrwx 1 root root 29 Nov 30 2000 cachefspack ->
   ../lib/fs/cachefs/cachefspack
 drwxr-xr-x 2 root bin 512 Jun 10 15:08 sparcv7

The program is to process lines relating to simple files and directories; special directory entries, such as links, are to be ignored. The program is to generate an output line for each processed input line. This output line is to rewrite the file permissions in the form of the octal code used for Unix permissions; it is to indicate whether the line relates to a file or directory, and is to print the entry name. When all input lines have been processed, the program is to print counts of the number of files and directories and then terminate. The output for the data shown above should be:

511 file acctom
   511 file adb
   755 directory sparcv7

The first version of a solution for this assignment is again based on a while loop within which all the processing is performed. The loop reads a line from STDIN, and terminates when an empty line is received (end-of-file condition). The processing depends on the specific characters that are input; Perl’s standard substr function is used to select characters from the input line.

#!/share/bin/perl -w
   $files = 0;
   $directories = 0;
   while($str = <STDIN>) {
   chomp($str);
   $char = substr($str,0,1);
   if ($char eq "-") { $type = "file"; $files++; }
   elsif($char eq 'd') { $type = "directory"; $directories++; }
   else { next; }
   $code1 = 0;
   #compose octal code for owner
   if("r" eq substr($str,1,1)) { $code1 +=4; }
   if("w" eq substr($str,2,1)) { $code1 +=2; }
   if("x" eq substr($str,3,1)) { $code1 +=1; }
   $code2 = 0;
   #compose octal code for group
   if("r" eq substr($str,4,1)) { $code2 +=4; }
   if("w" eq substr($str,5,1)) { $code2 +=2; }
   if("x" eq substr($str,6,1)) { $code2 +=1; }
   $code3 = 0;
   #compose octal code for other
   if("r" eq substr($str,7,1)) { $code3 +=4; }
   if("w" eq substr($str,8,1)) { $code3 +=2; }
   if("x" eq substr($str,9,1)) { $code3 +=1; }
   $code = $code1 . $code2 . $code3;
   # extract file name at end of line
   $name = substr($str, $pos+1);

print "${code}\t${type}\t${name}\n";
   }
 print "$files files, and $directories directories\n";

The loop while($str=<STDIN>) { } reads the next input line and assigns it to the $str variable. At end-of-file, <STDIN> will return the empty string "" which is interpreted as false; this terminates the while loop. The substr() function supports several usages:
substr(str,offset) Selects the remainder of the string starting at the characters specified by the offset.
substr(str,offset,length) Selects a sub-string of specified length, starting at the specified offset.
substr(str,offset,length,replacement) Replace the sub-string. An offset can be negative; a negative offset is interpreted as being relative to the end of the string. Most of this program’s calls to substr are selecting individual characters, so they have specified offsets and unit lengths. The first test determines whether the input data line relates to a directory, a simple file, or some other entry such as a symbolic link. Directories appear in the ls -l listing with a ‘d’ as the first letter; simple files start with a ‘-‘ symbol. This program has rather labored code to build the octal codes for the three permission groups. Explicit tests are made for ‘read’, ‘write’ and ‘execute’ character tags in the input. If a tag is set, the code is incremented by the appropriate amount. The filename is the last entry on the input line; it will be preceded immediately by a space. The rindex() library function finds the last occurrence of a specified sub-string in a string; here it is used to select the last space character ($pos = rindex($str, " ");). The name is the sub-string starting at the next character and including all the remainder of the string ($name = substr($str, $pos+1);). In addition to the simple print function, Perl programs can also use printf from C’s stdio package. The printf function takes a format list argument that permits greater control over output. The simpler lister.pl example shown above can be rewritten using a for loop as the basis of a more effective mechanism for computing the access code and printf to format the output.

while($str = <STDIN>) {
   chomp($str);
   $char = substr($str,0,1);
   if ($char eq "-") { $type = "file"; $files++; }
   elsif($char eq 'd') { $type = "directory"; $directories++; }
   else { next; }
   $code = 0;

for($i=1;$i<10;$i++) {
   $code *=2;
   if("-" ne substr($str,$i,1)) { $code++; }
   }
   $pos = rindex($str, " ");
   $name = substr($str, $pos+1);
   printf "%o%s" , $code , "\t${type}\t${name}\n";
 }

In the printf statement, the first argument ‘%o%s’ is the format string; this specifies output of a numeric value in octal, followed by a string. The other arguments are the code, and a string with the type (file or directory) and the entity name. Of course, there is another way of doing it. Since a format string is a doubly quoted Perl string, it can interpolate values. The following variant would be as good:

printf "%o\t${type}\t${name}\n " , $code ;