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: 2004-08-05
  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(chgrp
  24              dir_read
  25              file_create
  26              file_read
  27              file_save
  28              file_unlock);
  29
  30 # chgrp()
  31 #
  32 # Change the group of files or directories
  33 #
  34 # Params: 1. Group name or group ID
  35 #         2. List of files
  36 #
  37 # Return: Number of files group successfully changed
  38 #         (or false)
  39
  40 sub chgrp($@)
  41 {
  42  my ($group,@files) = @_;
  43  my $gid = ($group !~ /^\d+$/) ? getgrnam($group) : $group;
  44
  45  return unless($gid);
  46  return chown(-1,$gid,@files);
  47 }
  48
  49 # dir_read()
  50 #
  51 # Collect the files and directories in a directory
  52 #
  53 # Params: Directory
  54 #
  55 # Return: Hash reference: dirs  => directories
  56 #                         files => files
  57
  58 sub dir_read($)
  59 {
  60  my $dir = shift;
  61  local *DIR;
  62
  63  return unless(-d $dir);
  64
  65  # Get all the entries in the directory
  66
  67  opendir(DIR,$dir) or return;
  68  my @entries = readdir(DIR);
  69  closedir(DIR) or return;
  70
  71  # Sort the entries
  72
  73  @entries = sort {uc($a) cmp uc($b)} @entries;
  74
  75  my @files;
  76  my @dirs;
  77
  78  foreach my $entry(@entries)
  79  {
  80   next if($entry eq "." || $entry eq "..");
  81
  82   if(-d $dir."/".$entry)
  83   {
  84    push(@dirs,$entry);
  85   }
  86   else
  87   {
  88    push(@files,$entry);
  89   }
  90  }
  91
  92  return {dirs => \@dirs, files => \@files};
  93 }
  94
  95 # file_create()
  96 #
  97 # Create a file, but only if it doesn't already exist
  98 #
  99 # (I wanted to use O_EXCL for this, but `perldoc -f sysopen`
 100 # doesn't say that it is available on every system - so I
 101 # created this workaround using O_RDONLY and O_CREAT)
 102 #
 103 # Params: File to create
 104 #
 105 # Return: true on success;
 106 #         false on error or if the file already exists
 107
 108 sub file_create($)
 109 {
 110  my $file = shift;
 111  local *FILE;
 112
 113  return if(-e $file);
 114
 115  sysopen(FILE,$file,O_RDONLY | O_CREAT) or return;
 116  close(FILE)                            or return;
 117
 118  return 1;
 119 }
 120
 121 # file_read()
 122 #
 123 # Read out a file completely
 124 #
 125 # Params: File
 126 #
 127 # Return: Contents of the file (Scalar Reference)
 128
 129 sub file_read($)
 130 {
 131  my $file = shift;
 132  local *FILE;
 133
 134  sysopen(FILE,$file,O_RDONLY) or return;
 135  read(FILE, my $content, -s $file);
 136  close(FILE)                  or return;
 137
 138  return \$content;
 139 }
 140
 141 # file_save()
 142 #
 143 # Save a file
 144 #
 145 # Params: 1. File
 146 #         2. File content as Scalar Reference
 147 #
 148 # Return: Status code (Boolean)
 149
 150 sub file_save($$)
 151 {
 152  my ($file,$content) = @_;
 153  local *FILE;
 154
 155  sysopen(FILE,$file,O_WRONLY | O_CREAT | O_TRUNC) or return;
 156  print FILE $$content                             or do { close(FILE); return };
 157  close(FILE)                                      or return;
 158
 159  return 1;
 160 }
 161
 162 # file_unlock()
 163 #
 164 # Remove a file from the list of files in use
 165 #
 166 # Params: 1. File::UseList object
 167 #         2. File to remove
 168 #
 169 # Return: -nothing-
 170
 171 sub file_unlock($$)
 172 {
 173  my ($uselist,$file) = @_;
 174
 175  $uselist->remove_file($file);
 176  $uselist->save;
 177
 178  return;
 179 }
 180
 181 # it's true, baby ;-)
 182
 183 1;
 184
 185 #
 186 ### End ###