modules/File/Access.pm

   1 package File::Access;
   2
   3 #
   4 # Dev-Editor - Module File::Access
   5 #
   6 # Some simple routines for doing things with files
   7 # with only one command
   8 #
   9 # Author:        Patrick Canterino <patshaping@gmx.net>
  10 # Last modified: 09-26-2003
  11 #
  12
  13 use strict;
  14
  15 use vars qw(@EXPORT);
  16
  17 use Carp qw(croak);
  18 use File::Spec;
  19
  20 ### Export ###
  21
  22 use base qw(Exporter);
  23
  24 @EXPORT = qw(dir_read
  25              file_create
  26              file_read
  27              file_save);
  28
  29 # dir_read()
  30 #
  31 # Collect the files and directories in a directory
  32 #
  33 # Params: Directory
  34 #
  35 # Return: Hash reference: dirs  => directories
  36 #                         files => files
  37
  38 sub dir_read($)
  39 {
  40  my $dir = shift;
  41  local *DIR;
  42
  43  return unless(-d $dir);
  44
  45  # Get all the entries in the directory
  46
  47  opendir(DIR,$dir) or return;
  48  my @entries = readdir(DIR);
  49  closedir(DIR) or return;
  50
  51  # Sort the entries
  52
  53  @entries = sort(@entries);
  54
  55  my @files;
  56  my @dirs;
  57
  58  foreach my $entry(@entries)
  59  {
  60   next if($entry eq "." || $entry eq "..");
  61
  62   if(-d File::Spec->canonpath($dir."/".$entry))
  63   {
  64    push(@dirs,$entry);
  65   }
  66   else
  67   {
  68    push(@files,$entry);
  69   }
  70  }
  71
  72  return {dirs => \@dirs, files => \@files};
  73 }
  74
  75 # file_create()
  76 #
  77 # Create a file
  78 #
  79 # Params: File to create
  80 #
  81 # Return: true on success;
  82 #         false on error or if the file already exists
  83
  84 sub file_create($)
  85 {
  86  my $file = shift;
  87  local *FILE;
  88
  89  return if(-e $file);
  90
  91  open(FILE,">",$file) or return;
  92  close(FILE)          or return;
  93
  94  return 1;
  95 }
  96
  97 # file_read()
  98 #
  99 # Read out a file completely
 100 #
 101 # Params: File
 102 #
 103 # Return: Contents of the file (Scalar Reference)
 104
 105 sub file_read($)
 106 {
 107  my $file = shift;
 108  local *FILE;
 109
 110  open(FILE,"<",$file) or return;
 111  read(FILE, my $content, -s $file);
 112  close(FILE)          or return;
 113
 114  return \$content;
 115 }
 116
 117 # file_save()
 118 #
 119 # Save a file
 120 #
 121 # Params: 1. File
 122 #         2. File content as Scalar Reference
 123 #
 124 # Return: Status code (Boolean)
 125
 126 sub file_save($$)
 127 {
 128  my ($file,$content) = @_;
 129  my $temp            = $file.".temp";
 130  local *FILE;
 131
 132  open(FILE,">",$temp) or return;
 133  print FILE $$content or do { close(FILE); return };
 134  close(FILE)          or return;
 135
 136  rename($temp,$file)  or return;
 137
 138  return 1;
 139 }
 140
 141 # it's true, baby ;-)
 142
 143 1;
 144
 145 #
 146 ### End ###