home *** CD-ROM | disk | FTP | other *** search
/ Nebula 2 / Nebula Two.iso / SourceCode / MiscKit1.7.1 / MiscKit / Examples / AutoDoc / lib / perl5 / Autodoc / FileSupport.pm < prev    next >
Encoding:
Perl POD Document  |  1995-11-02  |  4.8 KB  |  174 lines
  1. package Autodoc::FileSupport;
  2.  
  3. ###############################################################################
  4. ###############################################################################
  5. ##
  6. ##    Written by Adam Swift (c) 1995 by Friday Software and Consulting
  7. ##                           All rights reserved.
  8. ##
  9. ##      This notice may not be removed from this source code.
  10. ##
  11. ##    This program is included in the MiscKit by permission from the author
  12. ##    and its use is governed by the MiscKit license, found in the file
  13. ##    "LICENSE.rtf" in the MiscKit distribution.  Please refer to that file
  14. ##    for a list of all applicable permissions and restrictions.
  15. ##
  16. ##    Because AutoDoc is licensed free of charge, there is no warranty 
  17. ##    for the program.  Copyright holder, Friday Software and Consulting, 
  18. ##    is providing this program "as is" and this program is distributed in 
  19. ##    the hope that it will be useful, but WITHOUT ANY WARRANTY; without 
  20. ##    even the implied warranty of MERCHANTABILITY or FITNESS FOR A 
  21. ##    PARTICULAR PURPOSE.
  22. ##
  23. ###############################################################################
  24. ###############################################################################
  25.  
  26. require 5.000;
  27.  
  28. ##########################
  29. # load required packages #
  30. ##########################
  31. use Exporter;
  32.  
  33. @ISA      = qw(Exporter);
  34. @EXPORT   = qw(file_expandpath
  35.            file_findnewest);
  36.  
  37. ###########################
  38. # Set version information #
  39. ###########################
  40. $module_version = '$Revision: 1.3 $';
  41. $module_version =~ s!(\$\w+: | \$)!!g;
  42. $module_id    = '$Id: FileSupport.pm,v 1.3 1995/10/20 22:16:26 aswift Exp $';
  43. $module_id      =~ s!(\$\w+: | \$)!!g;
  44. $module_name    = $module_id;
  45. $module_name    =~ s!^([^\,]+).*$!$1!;
  46.  
  47.  
  48. ############################################################################
  49. # 
  50. # Purpose: Module that encapsulates some file actions and tests
  51. #
  52. # HISTORY: START
  53. # $Log: FileSupport.pm,v $
  54. # Revision 1.3  1995/10/20  22:16:26  aswift
  55. # Added DevMan style changes Log support
  56. #
  57. #
  58. # HISTORY: END
  59. ############################################################################
  60.  
  61.  
  62.  
  63. #############################################################################
  64. #
  65. # NAME:       module_version
  66. #
  67. # ACTION:     returns the version number of this module
  68. #
  69. # RETURN:     the module version
  70. #
  71. #############################################################################
  72. sub module_version
  73. {
  74.     return $module_version;
  75. }
  76.  
  77. sub module_versionstamp
  78. {
  79.     return "$module_name (rev-$module_version)";
  80. }
  81.  
  82. #############################################################################
  83. #
  84. # NAME:       expand_filepath
  85. #
  86. # ACTION:     Replace the file path '~[user]' '.' or '..' references 
  87. #             with an expanded file path starting with '/'
  88. #
  89. # ARGUMENTS:  A file path
  90. #
  91. # RETURN:     The expanded file path
  92. #
  93. #############################################################################
  94. sub file_expandpath
  95.   {
  96.     local ($filepath, $expanddir);
  97.     $filepath = $_[0];
  98.     
  99.     # If the path starts with '/' no expansion is needed.
  100.     return $filepath if ($filepath =~ m!^/!);
  101.     
  102.     # If the path starts with '~' then user HOME from the user ENV
  103.     if (($filepath =~ m!^~$!) || ($filepath =~ m!^~/!)) {
  104.       $filepath =~ s!^~!$ENV{'HOME'}!;
  105.       return $filepath;
  106.     }
  107.     
  108.     
  109.     # Otherwise, get lazy and make the filesystem to expand it for us
  110.     if ($filepath =~ m!^([^/]+)!) {
  111.       $expanddir = $1;
  112.       
  113.       # Check to see if the path is simply a file name (no directories)
  114.       # if so, add a './' and expand from there.
  115.       if (($expanddir eq $filepath) && !(-d $expanddir)) {
  116.         $filepath = "./$filepath";
  117.         $expanddir = ".";
  118.       }
  119.       
  120.       if ($expanddir ne "") {
  121.         open (EXPDIR, "cd $expanddir; pwd |");
  122.         $expanddir = <EXPDIR>;
  123.         close (EXPDIR);
  124.         chop $expanddir if ($expanddir =~ m!\n$!);
  125.         
  126.         # if it is a directory, replace it in $filepath
  127.         if (($expanddir ne "") && (-d $expanddir)) {
  128.           $filepath =~ s!^[^/]+!$expanddir!;
  129.         }
  130.       }
  131.     }
  132.     
  133.     return $filepath;
  134.   }
  135.  
  136.  
  137. #############################################################################
  138. #
  139. # NAME:       file_findnewest
  140. #
  141. # ACTION:     Finds the newest file of all files passed as arguments and 
  142. #             returns it (the one with the latest time stamp).
  143. #
  144. # ARGUMENTS:  Any number of file paths
  145. #
  146. # RETURN:     The newest file's path
  147. #
  148. #############################################################################
  149. sub file_findnewest
  150.   {
  151.     local ($newest_file, $newest_age, $file, $fileage);
  152.     
  153.     $newest_file = "";
  154.     $newest_age = 0;
  155.     
  156.     foreach $file (@_) {
  157.       if (-r $file) {
  158.         $fileage = -M $file;
  159.         # print "file $file is age $fileage\n";
  160.         if (($newest_age == 0) || ($fileage < $newest_age)) {
  161.           $newest_file = $file;
  162.           $newest_age  = $fileage;
  163.         }
  164.       }
  165.     }
  166.     # print "latest file = $newest_file\n";
  167.  
  168.     return $newest_file;
  169.   }
  170.  
  171.  
  172. 1;
  173.     
  174.