modules/File/UseList.pm

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