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-07-28
  11 #
  12
  13 use strict;
  14
  15 use vars qw(@EXPORT);
  16
  17 use Carp qw(croak);
  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
  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 = getgrnam($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
  98 #
  99 # Params: File to create
 100 #
 101 # Return: true on success;
 102 #         false on error or if the file already exists
 103
 104 sub file_create($)
 105 {
 106  my $file = shift;
 107  local *FILE;
 108
 109  return if(-e $file);
 110
 111  open(FILE,">$file") or return;
 112  close(FILE)         or return;
 113
 114  return 1;
 115 }
 116
 117 # file_read()
 118 #
 119 # Read out a file completely
 120 #
 121 # Params: File
 122 #
 123 # Return: Contents of the file (Scalar Reference)
 124
 125 sub file_read($)
 126 {
 127  my $file = shift;
 128  local *FILE;
 129
 130  open(FILE,"<$file") or return;
 131  read(FILE, my $content, -s $file);
 132  close(FILE)         or return;
 133
 134  return \$content;
 135 }
 136
 137 # file_save()
 138 #
 139 # Save a file
 140 #
 141 # Params: 1. File
 142 #         2. File content as Scalar Reference
 143 #
 144 # Return: Status code (Boolean)
 145
 146 sub file_save($$)
 147 {
 148  my ($file,$content) = @_;
 149  local *FILE;
 150
 151  open(FILE,">$file")  or return;
 152  print FILE $$content or do { close(FILE); return };
 153  close(FILE)          or return;
 154
 155  return 1;
 156 }
 157
 158 # file_unlock()
 159 #
 160 # Remove a file from the list of files in use
 161 #
 162 # Params: 1. File::UseList object
 163 #         2. File to remove
 164 #
 165 # Return: -nothing-
 166
 167 sub file_unlock($$)
 168 {
 169  my ($uselist,$file) = @_;
 170
 171  $uselist->remove_file($file);
 172  $uselist->save;
 173
 174  return;
 175 }
 176
 177 # it's true, baby ;-)
 178
 179 1;
 180
 181 #
 182 ### End ###