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 <patrick@patshaping.de>
  10 # Last modified: 2004-10-26
  11 #
  12
  13 use strict;
  14
  15 use vars qw(@EXPORT);
  16
  17 use Fcntl;
  18
  19 ### Export ###
  20
  21 use base qw(Exporter);
  22
  23 @EXPORT = qw(dir_read
  24              file_create
  25              file_read
  26              file_save
  27              file_unlock);
  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 {uc($a) cmp uc($b)} @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 $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, but only if it doesn't already exist
  78 #
  79 # (I wanted to use O_EXCL for this, but `perldoc -f sysopen`
  80 # doesn't say that it is available on every system - so I
  81 # created this workaround using O_RDONLY and O_CREAT)
  82 #
  83 # Params: File to create
  84 #
  85 # Return: true on success;
  86 #         false on error or if the file already exists
  87
  88 sub file_create($)
  89 {
  90  my $file = shift;
  91  local *FILE;
  92
  93  return if(-e $file);
  94
  95  sysopen(FILE,$file,O_RDONLY | O_CREAT) or return;
  96  close(FILE)                            or return;
  97
  98  return 1;
  99 }
 100
 101 # file_read()
 102 #
 103 # Read out a file completely
 104 #
 105 # Params: File
 106 #
 107 # Return: Contents of the file (Scalar Reference)
 108
 109 sub file_read($)
 110 {
 111  my $file = shift;
 112  local *FILE;
 113
 114  sysopen(FILE,$file,O_RDONLY) or return;
 115  read(FILE, my $content, -s $file);
 116  close(FILE)                  or return;
 117
 118  return \$content;
 119 }
 120
 121 # file_save()
 122 #
 123 # Save a file
 124 #
 125 # Params: 1. File
 126 #         2. File content as Scalar Reference
 127 #
 128 # Return: Status code (Boolean)
 129
 130 sub file_save($$)
 131 {
 132  my ($file,$content) = @_;
 133  local *FILE;
 134
 135  sysopen(FILE,$file,O_WRONLY | O_CREAT | O_TRUNC) or return;
 136  print FILE $$content                             or do { close(FILE); return };
 137  close(FILE)                                      or return;
 138
 139  return 1;
 140 }
 141
 142 # file_unlock()
 143 #
 144 # Remove a file from the list of files in use
 145 #
 146 # Params: 1. File::UseList object
 147 #         2. File to remove
 148 #
 149 # Return: -nothing-
 150
 151 sub file_unlock($$)
 152 {
 153  my ($uselist,$file) = @_;
 154
 155  $uselist->remove_file($file);
 156  $uselist->save;
 157
 158  return;
 159 }
 160
 161 # it's true, baby ;-)
 162
 163 1;
 164
 165 #
 166 ### End ###