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: 2003-12-01
  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
  28 # dir_read()
  29 #
  30 # Collect the files and directories in a directory
  31 #
  32 # Params: Directory
  33 #
  34 # Return: Hash reference: dirs  => directories
  35 #                         files => files
  36
  37 sub dir_read($)
  38 {
  39  my $dir = shift;
  40  local *DIR;
  41
  42  return unless(-d $dir);
  43
  44  # Get all the entries in the directory
  45
  46  opendir(DIR,$dir) or return;
  47  my @entries = readdir(DIR);
  48  closedir(DIR) or return;
  49
  50  # Sort the entries
  51
  52  @entries = sort(@entries);
  53
  54  my @files;
  55  my @dirs;
  56
  57  foreach my $entry(@entries)
  58  {
  59   next if($entry eq "." || $entry eq "..");
  60
  61   if(-d $dir."/".$entry)
  62   {
  63    push(@dirs,$entry);
  64   }
  65   else
  66   {
  67    push(@files,$entry);
  68   }
  69  }
  70
  71  return {dirs => \@dirs, files => \@files};
  72 }
  73
  74 # file_create()
  75 #
  76 # Create a file
  77 #
  78 # Params: File to create
  79 #
  80 # Return: true on success;
  81 #         false on error or if the file already exists
  82
  83 sub file_create($)
  84 {
  85  my $file = shift;
  86  local *FILE;
  87
  88  return if(-e $file);
  89
  90  open(FILE,">$file") or return;
  91  close(FILE)         or return;
  92
  93  return 1;
  94 }
  95
  96 # file_read()
  97 #
  98 # Read out a file completely
  99 #
 100 # Params: File
 101 #
 102 # Return: Contents of the file (Scalar Reference)
 103
 104 sub file_read($)
 105 {
 106  my $file = shift;
 107  local *FILE;
 108
 109  open(FILE,"<$file") or return;
 110  read(FILE, my $content, -s $file);
 111  close(FILE)         or return;
 112
 113  return \$content;
 114 }
 115
 116 # file_save()
 117 #
 118 # Save a file
 119 #
 120 # Params: 1. File
 121 #         2. File content as Scalar Reference
 122 #
 123 # Return: Status code (Boolean)
 124
 125 sub file_save($$)
 126 {
 127  my ($file,$content) = @_;
 128  local *FILE;
 129
 130  open(FILE,">$file")  or return;
 131  print FILE $$content or do { close(FILE); return };
 132  close(FILE)          or return;
 133
 134  return 1;
 135 }
 136
 137 # it's true, baby ;-)
 138
 139 1;
 140
 141 #
 142 ### End ###