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

patrick-canterino.de