home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / File / Basename.pm next >
Text File  |  1995-07-03  |  9KB  |  255 lines
  1. package File::Basename;
  2.  
  3. =head1 NAME
  4.  
  5. Basename - parse file specifications
  6.  
  7. fileparse - split a pathname into pieces
  8.  
  9. basename - extract just the filename from a path
  10.  
  11. dirname - extract just the directory from a path
  12.  
  13. =head1 SYNOPSIS
  14.  
  15.     use File::Basename;
  16.  
  17.     ($name,$path,$suffix) = fileparse($fullname,@suffixlist)
  18.     fileparse_set_fstype($os_string);
  19.     $basename = basename($fullname,@suffixlist);
  20.     $dirname = dirname($fullname);
  21.  
  22.     ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.pm");
  23.     fileparse_set_fstype("VMS");
  24.     $basename = basename("lib/File/Basename.pm",".pm");
  25.     $dirname = dirname("lib/File/Basename.pm");
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. These routines allow you to parse file specifications into useful
  30. pieces using the syntax of different operating systems.
  31.  
  32. =over 4
  33.  
  34. =item fileparse_set_fstype
  35.  
  36. You select the syntax via the routine fileparse_set_fstype().
  37. If the argument passed to it contains one of the substrings
  38. "VMS", "MSDOS", or "MacOS", the file specification syntax of that
  39. operating system is used in future calls to fileparse(),
  40. basename(), and dirname().  If it contains none of these
  41. substrings, UNIX syntax is used.  This pattern matching is
  42. case-insensitive.  If you've selected VMS syntax, and the file
  43. specification you pass to one of these routines contains a "/",
  44. they assume you are using UNIX emulation and apply the UNIX syntax
  45. rules instead, for that function call only.
  46.  
  47. If you haven't called fileparse_set_fstype(), the syntax is chosen
  48. by examining the "osname" entry from the C<Config> package
  49. according to these rules.
  50.  
  51. =item fileparse
  52.  
  53. The fileparse() routine divides a file specification into three
  54. parts: a leading B<path>, a file B<name>, and a B<suffix>.  The
  55. B<path> contains everything up to and including the last directory
  56. separator in the input file specification.  The remainder of the input
  57. file specification is then divided into B<name> and B<suffix> based on
  58. the optional patterns you specify in C<@suffixlist>.  Each element of
  59. this list is interpreted as a regular expression, and is matched
  60. against the end of B<name>.  If this succeeds, the matching portion of
  61. B<name> is removed and prepended to B<suffix>.  By proper use of
  62. C<@suffixlist>, you can remove file types or versions for examination.
  63.  
  64. You are guaranteed that if you concatenate B<path>, B<name>, and
  65. B<suffix> together in that order, the result will be identical to the
  66. input file specification.
  67.  
  68. =back
  69.  
  70. =head1 EXAMPLES
  71.  
  72. Using UNIX file syntax:
  73.  
  74.     ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', 
  75.                     '\.book\d+');
  76.  
  77. would yield
  78.  
  79.     $base eq 'draft'
  80.     $path eq '/virgil/aeneid',
  81.     $tail eq '.book7'
  82.  
  83. Similarly, using VMS syntax:
  84.  
  85.     ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
  86.                    '\..*');
  87.  
  88. would yield
  89.  
  90.     $name eq 'Rhetoric'
  91.     $dir  eq 'Doc_Root:[Help]'
  92.     $type eq '.Rnh'
  93.  
  94. =item C<basename>
  95.  
  96. The basename() routine returns the first element of the list produced
  97. by calling fileparse() with the same arguments.  It is provided for
  98. compatibility with the UNIX shell command basename(1).
  99.  
  100. =item C<dirname>
  101.  
  102. The dirname() routine returns the directory portion of the input file
  103. specification.  When using VMS or MacOS syntax, this is identical to the
  104. second element of the list produced by calling fileparse() with the same
  105. input file specification.  When using UNIX or MSDOS syntax, the return
  106. value conforms to the behavior of the UNIX shell command dirname(1).  This
  107. is usually the same as the behavior of fileparse(), but differs in some
  108. cases.  For example, for the input file specification F<lib/>, fileparse()
  109. considers the directory name to be F<lib/>, while dirname() considers the
  110. directory name to be F<.>).
  111.  
  112. =cut
  113.  
  114. require 5.000;
  115. use Config;
  116. require Exporter;
  117. @ISA = qw(Exporter);
  118. @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
  119.  
  120. #   fileparse_set_fstype() - specify OS-based rules used in future
  121. #                            calls to routines in this package
  122. #
  123. #   Currently recognized values: VMS, MSDOS, MacOS
  124. #       Any other name uses Unix-style rules
  125.  
  126. sub fileparse_set_fstype {
  127.   my($old) = $Fileparse_fstype;
  128.   $Fileparse_fstype = $_[0] if $_[0];
  129.   $old;
  130. }
  131.  
  132. #   fileparse() - parse file specification
  133. #
  134. #   calling sequence:
  135. #     ($filename,$prefix,$tail) = &basename_pat($filespec,@excludelist);
  136. #     where  $filespec    is the file specification to be parsed, and
  137. #            @excludelist is a list of patterns which should be removed
  138. #                         from the end of $filename.
  139. #            $filename    is the part of $filespec after $prefix (i.e. the
  140. #                         name of the file).  The elements of @excludelist
  141. #                         are compared to $filename, and if an  
  142. #            $prefix     is the path portion $filespec, up to and including
  143. #                        the end of the last directory name
  144. #            $tail        any characters removed from $filename because they
  145. #                         matched an element of @excludelist.
  146. #
  147. #   fileparse() first removes the directory specification from $filespec,
  148. #   according to the syntax of the OS (code is provided below to handle
  149. #   VMS, Unix, MSDOS and MacOS; you can pick the one you want using
  150. #   fileparse_set_fstype(), or you can accept the default, which is
  151. #   based on the information in the %Config array).  It then compares
  152. #   each element of @excludelist to $filename, and if that element is a
  153. #   suffix of $filename, it is removed from $filename and prepended to
  154. #   $tail.  By specifying the elements of @excludelist in the right order,
  155. #   you can 'nibble back' $filename to extract the portion of interest
  156. #   to you.
  157. #
  158. #   For example, on a system running Unix,
  159. #   ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
  160. #                                       '\.book\d+');
  161. #   would yield $base == 'draft',
  162. #               $path == '/virgil/aeneid/'  (note trailing slash)
  163. #               $tail == '.book7'.
  164. #   Similarly, on a system running VMS,
  165. #   ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh','\..*');
  166. #   would yield $name == 'Rhetoric';
  167. #               $dir == 'Doc_Root:[Help]', and
  168. #               $type == '.Rnh'.
  169. #
  170. #   Version 2.2  13-Oct-1994  Charles Bailey  bailey@genetics.upenn.edu 
  171.  
  172.  
  173. sub fileparse {
  174.   my($fullname,@suffices) = @_;
  175.   my($fstype) = $Fileparse_fstype;
  176.   my($dirpath,$tail,$suffix);
  177.  
  178.   if ($fstype =~ /^VMS/i) {
  179.     if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
  180.     else {
  181.       ($dirpath,$basename) = ($fullname =~ /(.*[:>\]])?(.*)/);
  182.       $dirpath = $ENV{'DEFAULT'} unless $dirpath;
  183.     }
  184.   }
  185.   if ($fstype =~ /^MSDOS/i) {
  186.     ($dirpath,$basename) = ($fullname =~ /(.*\\)?(.*)/);
  187.     $dirpath = '.' unless $dirpath;
  188.   }
  189.   elsif ($fstype =~ /^MAC/i) {
  190.     ($dirpath,$basename) = ($fullname =~ /(.*:)?(.*)/);
  191.   }
  192.   elsif ($fstype !~ /^VMS/i) {  # default to Unix
  193.     ($dirpath,$basename) = ($fullname =~ m#(.*/)?(.*)#);
  194.     $dirpath = '.' unless $dirpath;
  195.   }
  196.  
  197.   if (@suffices) {
  198.     $tail = '';
  199.     foreach $suffix (@suffices) {
  200.       if ($basename =~ /($suffix)$/) {
  201.         $tail = $1 . $tail;
  202.         $basename = $`;
  203.       }
  204.     }
  205.   }
  206.  
  207.   wantarray ? ($basename,$dirpath,$tail) : $basename;
  208.  
  209. }
  210.  
  211.  
  212. #   basename() - returns first element of list returned by fileparse()
  213.  
  214. sub basename {
  215.   my($name) = shift;
  216.   (fileparse($name, map("\Q$_\E",@_)))[0];
  217. }
  218.   
  219.  
  220. #    dirname() - returns device and directory portion of file specification
  221. #        Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
  222. #        filespecs except for names ending with a separator, e.g., "/xx/yy/".
  223. #        This differs from the second element of the list returned
  224. #        by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and
  225. #        the last directory name if the filespec ends in a '/' or '\'), is lost.
  226.  
  227. sub dirname {
  228.     my($basename,$dirname) = fileparse($_[0]);
  229.     my($fstype) = $Fileparse_fstype;
  230.  
  231.     if ($fstype =~ /VMS/i) { 
  232.         if ($_[0] =~ m#/#) { $fstype = '' }
  233.         else { return $dirname }
  234.     }
  235.     if ($fstype =~ /MacOS/i) { return $dirname }
  236.     elsif ($fstype =~ /MSDOS/i) { 
  237.         if ( $dirname =~ /:\\$/) { return $dirname }
  238.         chop $dirname;
  239.         $dirname =~ s:[^\\]+$:: unless $basename;
  240.         $dirname = '.' unless $dirname;
  241.     }
  242.     else { 
  243.         if ( $dirname eq '/') { return $dirname }
  244.         chop $dirname;
  245.         $dirname =~ s:[^/]+$:: unless $basename;
  246.         $dirname = '.' unless $dirname;
  247.     }
  248.  
  249.     $dirname;
  250. }
  251.  
  252. $Fileparse_fstype = $Config{'osname'};
  253.  
  254. 1;
  255.