modules/File/UseList.pm

   1 package File::UseList;
   2
   3 #
   4 # File::UseList 1.2
   5 #
   6 # Run a list with files that are currently in use
   7 # (bases on Filing::UseList by Roland Bluethgen <calocybe@web.de>)
   8 #
   9 # Author:        Patrick Canterino <patshaping@gmx.net>
  10 # Last modified: 2003-11-21
  11 #
  12
  13 use strict;
  14
  15 use Carp qw(croak);
  16
  17 # new()
  18 #
  19 # Constructor
  20 #
  21 # Params: Hash: listfile => File with list of files in use
  22 #               lockfile => Lock file (Default: List file + .lock)
  23 #               timeout  => Lock timeout in seconds (Default: 10)
  24 #
  25 # Return: File::UseList object (Blessed Reference)
  26
  27 sub new(%)
  28 {
  29  my ($class,%args) = @_;
  30
  31  # Check if we got all the necessary information
  32
  33  croak "Missing path to list file"             unless($args{'listfile'});
  34  $args{'lockfile'} = $args{'listfile'}.".lock" unless($args{'lockfile'}); # Default filename of lock file
  35  $args{'timeout'}  = 10                        unless($args{'timeout'});  # Default timeout
  36
  37  # Add some other information
  38
  39  $args{'files'}  = [];
  40  $args{'locked'} = 0;
  41
  42  return bless(\%args,$class);
  43 }
  44
  45 # lock()
  46 #
  47 # Lock list with files
  48 # (delete lock file)
  49 #
  50 # Params: -nothing-
  51 #
  52 # Return: Status code (Boolean)
  53
  54 sub lock
  55 {
  56  my $self     = shift;
  57  my $lockfile = $self->{'lockfile'};
  58  my $timeout  = $self->{'timeout'};
  59
  60  return 1 if($self->{'locked'});
  61
  62  # Try to delete the lock file one time per second
  63  # until the timeout is reached
  64
  65  for(my $x=$timeout;$x>=0;$x--)
  66  {
  67   if(unlink($lockfile))
  68   {
  69    $self->{'locked'} = 1;
  70    return 1;
  71   }
  72
  73   sleep(1);
  74  }
  75
  76  # Timeout
  77
  78  return;
  79 }
  80
  81 # unlock()
  82 #
  83 # Unlock list with files, but only if _we_ locked it
  84 # (create lock file)
  85 #
  86 # Params: -nothing-
  87 #
  88 # Return: Status code (Boolean)
  89
  90 sub unlock
  91 {
  92  my $self     = shift;
  93  my $lockfile = $self->{'lockfile'};
  94  local *LOCKFILE;
  95
  96  if($self->{'locked'})
  97  {
  98   open(LOCKFILE,">$lockfile") or return;
  99   close(LOCKFILE)             or return;
 100
 101   $self->{'locked'} = 0;
 102   return 1;
 103  }
 104
 105  # The list wasn't lock by us or it isn't locked at all
 106
 107  return;
 108 }
 109
 110 # load()
 111 #
 112 # Load the list with files from the list file
 113 #
 114 # Params: -nothing-
 115 #
 116 # Return: Status code (Boolean)
 117
 118 sub load
 119 {
 120  my $self = shift;
 121  my $file = $self->{'listfile'};
 122  local *FILE;
 123
 124  # Read out the file and split the content line-per-line
 125
 126  open(FILE,"<$file") or return;
 127  read(FILE, my $content, -s $file);
 128  close(FILE)         or return;
 129
 130  my @files = split(/\015\012|\012|\015/,$content);
 131
 132  # Remove useless lines
 133
 134  for(my $x=0;$x<@files;$x++)
 135  {
 136   if($files[$x] eq "" || $files[$x] =~ /^\s+$/)
 137   {
 138    splice(@files,$x,1);
 139    $x--; # <-- very important!
 140   }
 141  }
 142
 143  $self->{'files'} = \@files;
 144  return 1;
 145 }
 146
 147 # save()
 148 #
 149 # Write the list with files back to the list file
 150 #
 151 # Params: -nothing-
 152 #
 153 # Return: Status code (Boolean)
 154
 155 sub save
 156 {
 157  my $self  = shift;
 158  my $file  = $self->{'listfile'};
 159  my $temp  = $file.".temp";
 160  my $files = $self->{'files'};
 161  local *FILE;
 162
 163  my $data = (@$files) ? join("\n",@$files) : '';
 164
 165  open(FILE,">$temp") or return;
 166  print FILE $data    or do { close(FILE); return };
 167  close(FILE)         or return;
 168
 169  rename($temp,$file) or return;
 170
 171  return 1;
 172 }
 173
 174 # add_file()
 175 #
 176 # Add a file to the list
 177 #
 178 # Params: File
 179 #
 180 # Return: Status code (Boolean)
 181
 182 sub add_file($)
 183 {
 184  my ($self,$file) = @_;
 185  my $files = $self->{'files'};
 186
 187  # Check if the file is already in the list
 188
 189  return if($self->in_use($file));
 190
 191  push(@$files,$file);
 192  return 1;
 193 }
 194
 195 # remove_file()
 196 #
 197 # Remove a file from the list
 198 #
 199 # Params: File
 200 #
 201 # Return: Status code (Boolean)
 202
 203 sub remove_file($)
 204 {
 205  my ($self,$file) = @_;
 206  my $files = $self->{'files'};
 207
 208  # Check if the file is really in the list
 209
 210  return if($self->unused($file));
 211
 212  # Remove the file from the list
 213
 214  for(my $x=0;$x<@$files;$x++)
 215  {
 216   if($files->[$x] eq $file)
 217   {
 218    splice(@$files,$x,1);
 219    return 1;
 220   }
 221  }
 222 }
 223
 224 # in_use()
 225 #
 226 # Check if a file is in the list
 227 #
 228 # Params: File to check
 229 #
 230 # Return: Status code (Boolean)
 231
 232 sub in_use($)
 233 {
 234  my ($self,$file) = @_;
 235  my $files = $self->{'files'};
 236
 237  foreach(@$files)
 238  {
 239   return 1 if($_ eq $file);
 240  }
 241
 242  return;
 243 }
 244
 245 # unused()
 246 #
 247 # Check if a file is not in the list
 248 #
 249 # Params: File to check
 250 #
 251 # Return: Status code (Boolean)
 252
 253 sub unused($)
 254 {
 255  return not shift->in_use(shift);
 256 }
 257
 258 # it's true, baby ;-)
 259
 260 1;
 261
 262 #
 263 ### End ###