Week
2

Week 2 in Review


By now, you know enough about programming in Perl to write some quite powerful programs. The program in Listing R2.1 illustrates some of the concepts you've learned this week. It prompts you for a directory name, lists the subdirectories for that directory, and stores them in an associative array for later access. It also enables you to move about in the directory hierarchy and print the names of the files in any directory.


Listing R2.1. Browsing directories and printing their contents.
1:   #!/usr/local/bin/perl

2:   

3:   $dircount = 0;

4:   $curdir = "";

5:   while (1) {

6:           # if we don't have a current directory, get one

7:           if ($curdir eq "") {

8:                   print ("Enter directory to list:\n");

9:                   $curdir = <STDIN>;

10:                  $curdir =~ s/^\s+|\s+$//g;

11:                  $curdir = &followlink($curdir);

12:                  &readsubdirs($curdir);

13:          }

14:          $curdir = &menudir($curdir);

15:  }

16:  

17:  

18:  # Find all subdirectories of the given directory,

19:  # and store them in an associative array.

20:  #

21:  # The associative array subscripts and values are: 

22:  # <directory name>:       1

23:  #       (indicates that directory has been read)

24:  # <directory name>.<num>  the <num>th subdirectory

25:  

26:  sub readsubdirs {

27:          local ($dirname) = @_;

28:          local ($dirvar, $subdircount, $name, $index);

29:  

30:          # open the current directory;

31:          # $dircount ensures that each file variable is unique

32:          $dirvar = "DIR" . ++$dircount;

33:          if (!opendir ($dirvar, $dirname)) {

34:                  warn ("Can't open $dirname\n");

35:                  return;

36:          }

37:  

38:          # read all the subdirectories; store in a standard array

39:          chdir ($dirname);

40:          $subdircount = 0;

41:          while ($name = readdir ($dirvar)) {

42:                  next if ($name eq ".");

43:                  if ($dirname eq "/") {

44:                          $name = $dirname . $name;

45:                  } else {

46:                          $name = $dirname . "/" . $name;

47:                  }

48:                  if (-d $name) {

49:                          $dirarray[$subdircount++] = $name;

50:                  }

51:          }

52:          closedir ($dirvar);

53:  

54:          # sort the standard array; assign the sorted array to the

55:          # associative array

56:          @dirarray = sort (@dirarray);

57:          for ($index = 0; $index < $subdircount; $index++) {

58:                  $dirarray {$dirname . $index} = $dirarray[$index];

59:          }

60:          undef (@dirarray);

61:          $dirarray{$dirname} = 1;

62:  }

63:  

64:  

65:  # Display the subdirectories of the current directory and the

66:  # available menu options.

67:  

68:  sub menudir {

69:          local ($curdir) = @_;

70:          local ($base) = 0;

71:          local ($command, $count, $subdir);

72:  

73:          while (1) {

74:                  print ("\nCurrent directory is: $curdir\n");

75:                  print ("\nSubdirectories:\n");

76:                  if ($base > 0) {

77:                          print ("<more up>\n");

78:                  }

79:                  for ($count=0; $count<10; $count++) {

80:                          $subdir = $count+$base;

81:                          $subdir = $dirarray{$curdir.$subdir};

82:                          last if ($subdir eq "");

83:                          print ("$count: $subdir\n");

84:                  }

85:                  if ($dirarray{$curdir.($base+10)} ne "") {

86:                          print ("<more down>\n");

87:                  }

88:                  print ("\nEnter a number to move to the ");

89:                  print ("specified directory,\n");

90:                  if ($base > 0) {

91:                          print ("enter < to move up in the list,\n");

92:                  }

93:                  if ($dirarray{$curdir.($base+10)} ne "") {

94:                          print ("enter > to move down in the list,\n");

95:                  }

96:                  print ("enter d to display the files,\n");

97:                  print ("enter e to specify a new directory,\n");

98:                  print ("or enter q to quit entirely.\n");

99:                  print ("> ");

100:                 $command = <STDIN>;

101:                 $command =~ s/^\s+|\s+$//g;

102:                 if ($command eq "q") {

103:                         exit (0);

104:                 } elsif ($command eq ">") {

105:                         if ($dirarray{$curdir.($base+10)} ne "") {

106:                                 $base += 10;

107:                         }

108:                 } elsif ($command eq "<") {

109:                         $base -= 10 if $base > 0;

110:                 } elsif ($command eq "d") {

111:                         &display ($curdir);

112:                 } elsif ($command eq "e") {

113:                         # set the current directory to "" to force

114:                         # the main program to prompt for a name

115:                         return ("");

116:                 } elsif ($command =~ /^\d+$/) {

117:                         $subdir = $dirarray{$curdir.($command+$base)};

118:                         # if subdirectory is the parent directory,

119:                         # remove .. and the last directory name

120:                         # from the path

121:                         if ($subdir =~ /\.\.$/) {

122:                                 $subdir =~ s#(.*)/.*/..#$1#;

123:                         }

124:                         # if subdirectory is defined, it becomes

125:                         # the new current directory

126:                         if ($subdir ne "") {

127:                                 if ($dirarray{$subdir} != 1) {

128:                                        $subdir = &followlink($subdir);

129:                                        &readsubdirs ($subdir);

130:                                 }

131:                                 return ($subdir);

132:                         }

133:                 } else {

134:                         warn ("Invalid command $command\n");

135:                 }

136:         }

137: }

138: 

139: 

140: # Display the files in a directory, three per line.

141: 

142: sub display {

143:         local ($dirname) = @_;

144:         local ($file, $filecount, $printfile);

145:         local (@filelist);

146: 

147:         if (!opendir(LOCALDIR, "$dirname")) {

148:                 warn ("Can't open $dirname\n");

149:                 return;

150:         }

151:         chdir ($dirname);

152:         print ("\n\nFiles in directory $dirname:\n");

153:         $filecount = 0;

154:         while ($file = readdir (LOCALDIR)) {

155:                 next if (-d $file);

156:                 $filelist[$filecount++] = $file;

157:         }

158:         closedir ($dirname);

159:         if ($filecount == 0) {

160:                 print ("\tDirectory contains no files.\n");

161:                 return;

162:         }

163:         @filelist = sort(@filelist);

164:         $filecount = 0;

165:         foreach $printfile (@filelist) {

166:                 if ($filecount == 30) {

167:                         print ("<Press return to continue>");

168:                         <STDIN>;

169:                         $filecount = 0;

170:                 }

171:                 if ($filecount % 3 == 0) {

172:                         print ("\t");

173:                 }

174:                 printf ("%-20s", $printfile);

175:                 $filecount += 1;

176:                 if ($filecount % 3 == 0) {

177:                         print ("\n");

178:                 }

179:         }

180: }

181: 

182: 

183: # Check whether the directory name is really a symbolic link.

184: # If it is, find the real name and use it.

185: 

186: sub followlink {

187:         local ($dirname) = @_;

188: 

189:         if (-l $dirname) {

190:                 $dirname = readlink ($dirname);

191:         }

192:         $dirname;        # return value

193: }


$ programR2_1

Enter directory to list:

/ag1/dave



Current directory is: /ag1/dave



Subdirectories:

0: /ag1/dave/..

1: /ag1/dave/.elm

2: /ag1/dave/.mosaic

3: /ag1/dave/.nn

4: /ag1/dave/Mail

5: /ag1/dave/News

6: /ag1/dave/bin

7: /ag1/dave/dave

8: /ag1/dave/ems

<more down>



Enter a number to move to the specified directory,

enter > to move down in the list,

enter d to display the files,

enter e to specify a new directory,

or enter q to quit entirely.

> d

Files in directory /ag1/dave:

         .Xauthority         .Xnormal           .Xresources

         .cshrc              .login             .newsrc

         .xsession           README             calendar

         doclist             foo                ideas

         letter              letter2            sched

Current directory is: /ag1/dave



Subdirectories:

0: /ag1/dave/..

1: /ag1/dave/.elm

2: /ag1/dave/.mosaic

3: /ag1/dave/.nn

4: /ag1/dave/Mail

5: /ag1/dave/News

6: /ag1/dave/bin

7: /ag1/dave/dave

8: /ag1/dave/ems

<more down>



Enter a number to move to the specified directory,

enter > to move down in the list,

enter d to display the files,

enter e to specify a new directory,

or enter q to quit entirely.

> 6

Current directory is: /ag1/dave/bin



Subdirectories:

0: /ag1/dave/bin/..

Enter a number to move to the specified directory,

enter d to display the files,

enter e to specify a new directory,

or enter q to quit entirely.

> q

$

The program in Listing R2.1 consists of five parts:

The main program is quite simple: all it does is prompt for a directory name and call the subroutines &readsubdirs and &menudir. (Many complicated programs are like this: the main portion of the program just calls a few subroutines.)

The subroutine &readsubdirs is passed the name of a directory to examine. Line 33 opens the directory using opendir, and lines 38-51 store the subdirectories in a (standard) array named @dirarray. After this, line 56 sorts the array, and lines 57-59 load the sorted elements into an associative array named %dirarray. (Recall that Perl programs can use the same name for an associative array and for a standard array because the program always can tell them apart.)

The subscripts for the associative array use a simple scheme:

Line 60 introduces a function you have not yet seen: undef. This function basically just throws away the contents of @dirarray because the program no longer needs them. (For more details on undef, see Day 14, "Scalar-Conversion and List-Manipulation Functions.")

The subroutine &menudir uses this associative array to display the subdirectories of the current directory. Line 74 prints the name of the current directory, and lines 79-84 print the names of the subdirectories of the directory. If there are more than ten subdirectories, &menudir displays only a "window" of ten subdirectories, and it prints <more down> or <more up> to show that there are more subdirectories available. Each subdirectory is printed with a corresponding number that you can use to select the subdirectory and set it to be the current directory.

After &menudir prints the subdirectory names, lines 88-99 print a list of the available menu commands. These commands are

Line 100 reads a command from the standard input file, and line 101 gets rid of any leading or trailing white space. Lines 102-135 determine which command has been entered.

If q has been entered, line 103 calls exit, which terminates the program.

If either > or < has been entered, lines 104-109 move up or down in the directory list. They do this by modifying the value of a variable named $base, which determines how many subdirectory names to skip before lines 79-84 start printing.

If d has been entered, line 111 calls &display, which prints the list of files.

If e has been entered, line 115 exits the subroutine with a return value of the null string. This forces the main program to execute lines 7-13 again, which prompt you for a directory name.

If a number has been entered, line 117 takes the number, joins it to the current directory name, and uses the resulting string as the subscript into the associative array %dirarray. (For example, if the current directory is /ag1/dave and the number 6 has been entered, line 117 accesses the associative array element %dirarray{"/ag1/dave6"}). This is one of the array elements that line 49 of &readsubdirs created; its value is the name of a subdirectory.

Line 127 takes the name of this subdirectory and uses it, in turn, as an associative array subscript. (For example, if the value of %dirarray{"/ag1/dave6"} is "/ag1/dave/bin", line 127 checks the associative array element %dirarray{"/ag1/dave/bin"}.) If the value of this element is 1, &readsubdirs has already read this directory and stored its subdirectory names in the associative array, so the program does not need to do it again. If this element is not defined, the program calls &readsubdirs, which reads and stores the names of the subdirectories of this directory.

The subroutine &display prints the names of the files stored in a particular directory. To save space, it prints the filenames three per line. &display prints only ten lines at a time. If there are more than ten lines (in other words, 30 filenames), line 168 pauses and waits for you to press Enter before continuing to print. This gives you time to read all of the currently displayed names.

The final subroutine is &followlink, which always is called immediately before the subroutine &readsubdirs is called. Its job is to check whether a directory name is really a symbolic link. If it is, line 190 calls readlink, which retrieves the real directory name. This directory name is returned to the calling subroutine or main program and then is passed to &readsubdirs.

As you can see, you now know enough about Perl to write programs that manipulate the file system and use complex data structures. In Week 3, you'll learn about the remainder of Perl's built-in functions and the rest of the features of Perl.