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-21
  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(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
  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  local *FILE;
 130
 131  open(FILE,">$file")  or return;
 132  print FILE $$content or do { close(FILE); return };
 133  close(FILE)          or return;
 134
 135  return 1;
 136 }
 137
 138 # file_unlock()
 139 #
 140 # Remove a file from the list of files in use
 141 #
 142 # Params: 1. File::UseList object
 143 #         2. File to remove
 144 #
 145 # Return: -nothing-
 146
 147 sub file_unlock($$)
 148 {
 149  my ($uselist,$file) = @_;
 150
 151  $uselist->remove_file($file);
 152  $uselist->save;
 153
 154  return;
 155 }
 156
 157 # it's true, baby ;-)
 158
 159 1;
 160
 161 #
 162 ### End ###