1package Path::Class::File;
2
3$VERSION = '0.18';
4
5use strict;
6use Path::Class::Dir;
7use Path::Class::Entity;
8use base qw(Path::Class::Entity);
9
10use IO::File ();
11
12sub new {
13  my $self = shift->SUPER::new;
14  my $file = pop();
15  my @dirs = @_;
16
17  my ($volume, $dirs, $base) = $self->_spec->splitpath($file);
18
19  if (length $dirs) {
20    push @dirs, $self->_spec->catpath($volume, $dirs, '');
21  }
22
23  $self->{dir}  = @dirs ? Path::Class::Dir->new(@dirs) : undef;
24  $self->{file} = $base;
25
26  return $self;
27}
28
29sub as_foreign {
30  my ($self, $type) = @_;
31  local $Path::Class::Foreign = $self->_spec_class($type);
32  my $foreign = ref($self)->SUPER::new;
33  $foreign->{dir} = $self->{dir}->as_foreign($type) if defined $self->{dir};
34  $foreign->{file} = $self->{file};
35  return $foreign;
36}
37
38sub stringify {
39  my $self = shift;
40  return $self->{file} unless defined $self->{dir};
41  return $self->_spec->catfile($self->{dir}->stringify, $self->{file});
42}
43
44sub dir {
45  my $self = shift;
46  return $self->{dir} if defined $self->{dir};
47  return Path::Class::Dir->new($self->_spec->curdir);
48}
49BEGIN { *parent = \&dir; }
50
51sub volume {
52  my $self = shift;
53  return '' unless defined $self->{dir};
54  return $self->{dir}->volume;
55}
56
57sub basename { shift->{file} }
58sub open  { IO::File->new(@_) }
59
60sub openr { $_[0]->open('r') or die "Can't read $_[0]: $!"  }
61sub openw { $_[0]->open('w') or die "Can't write $_[0]: $!" }
62
63sub touch {
64  my $self = shift;
65  if (-e $self) {
66    my $now = time();
67    utime $now, $now, $self;
68  } else {
69    $self->openw;
70  }
71}
72
73sub slurp {
74  my ($self, %args) = @_;
75  my $fh = $self->openr;
76
77  if ($args{chomped} or $args{chomp}) {
78    chomp( my @data = <$fh> );
79    return wantarray ? @data : join '', @data;
80  }
81
82  local $/ unless wantarray;
83  return <$fh>;
84}
85
86sub remove {
87  my $file = shift->stringify;
88  return unlink $file unless -e $file; # Sets $! correctly
89  1 while unlink $file;
90  return not -e $file;
91}
92
931;
94__END__
95
96=head1 NAME
97
98Path::Class::File - Objects representing files
99
100=head1 SYNOPSIS
101
102  use Path::Class qw(file);  # Export a short constructor
103
104  my $file = file('foo', 'bar.txt');  # Path::Class::File object
105  my $file = Path::Class::File->new('foo', 'bar.txt'); # Same thing
106
107  # Stringifies to 'foo/bar.txt' on Unix, 'foo\bar.txt' on Windows, etc.
108  print "file: $file\n";
109
110  if ($file->is_absolute) { ... }
111  if ($file->is_relative) { ... }
112
113  my $v = $file->volume; # Could be 'C:' on Windows, empty string
114                         # on Unix, 'Macintosh HD:' on Mac OS
115
116  $file->cleanup; # Perform logical cleanup of pathname
117  $file->resolve; # Perform physical cleanup of pathname
118
119  my $dir = $file->dir;  # A Path::Class::Dir object
120
121  my $abs = $file->absolute; # Transform to absolute path
122  my $rel = $file->relative; # Transform to relative path
123
124=head1 DESCRIPTION
125
126The C<Path::Class::File> class contains functionality for manipulating
127file names in a cross-platform way.
128
129=head1 METHODS
130
131=over 4
132
133=item $file = Path::Class::File->new( <dir1>, <dir2>, ..., <file> )
134
135=item $file = file( <dir1>, <dir2>, ..., <file> )
136
137Creates a new C<Path::Class::File> object and returns it.  The
138arguments specify the path to the file.  Any volume may also be
139specified as the first argument, or as part of the first argument.
140You can use platform-neutral syntax:
141
142  my $dir = file( 'foo', 'bar', 'baz.txt' );
143
144or platform-native syntax:
145
146  my $dir = dir( 'foo/bar/baz.txt' );
147
148or a mixture of the two:
149
150  my $dir = dir( 'foo/bar', 'baz.txt' );
151
152All three of the above examples create relative paths.  To create an
153absolute path, either use the platform native syntax for doing so:
154
155  my $dir = dir( '/var/tmp/foo.txt' );
156
157or use an empty string as the first argument:
158
159  my $dir = dir( '', 'var', 'tmp', 'foo.txt' );
160
161If the second form seems awkward, that's somewhat intentional - paths
162like C</var/tmp> or C<\Windows> aren't cross-platform concepts in the
163first place, so they probably shouldn't appear in your code if you're
164trying to be cross-platform.  The first form is perfectly fine,
165because paths like this may come from config files, user input, or
166whatever.
167
168=item $file->stringify
169
170This method is called internally when a C<Path::Class::File> object is
171used in a string context, so the following are equivalent:
172
173  $string = $file->stringify;
174  $string = "$file";
175
176=item $file->volume
177
178Returns the volume (e.g. C<C:> on Windows, C<Macintosh HD:> on Mac OS,
179etc.) of the object, if any.  Otherwise, returns the empty string.
180
181=item $file->basename
182
183Returns the name of the file as a string, without the directory
184portion (if any).
185
186=item $file->is_dir
187
188Returns a boolean value indicating whether this object represents a
189directory.  Not surprisingly, C<Path::Class::File> objects always
190return false, and C<Path::Class::Dir> objects always return true.
191
192=item $file->is_absolute
193
194Returns true or false depending on whether the file refers to an
195absolute path specifier (like C</usr/local/foo.txt> or C<\Windows\Foo.txt>).
196
197=item $file->is_absolute
198
199Returns true or false depending on whether the file refers to a
200relative path specifier (like C<lib/foo.txt> or C<.\Foo.txt>).
201
202=item $file->cleanup
203
204Performs a logical cleanup of the file path.  For instance:
205
206  my $file = file('/foo//baz/./foo.txt')->cleanup;
207  # $file now represents '/foo/baz/foo.txt';
208
209=item $dir->resolve
210
211Performs a physical cleanup of the file path.  For instance:
212
213  my $dir = dir('/foo/baz/../foo.txt')->resolve;
214  # $dir now represents '/foo/foo.txt', assuming no symlinks
215
216This actually consults the filesystem to verify the validity of the
217path.
218
219=item $dir = $file->dir
220
221Returns a C<Path::Class::Dir> object representing the directory
222containing this file.
223
224=item $dir = $file->parent
225
226A synonym for the C<dir()> method.
227
228=item $abs = $file->absolute
229
230Returns a C<Path::Class::File> object representing C<$file> as an
231absolute path.  An optional argument, given as either a string or a
232C<Path::Class::Dir> object, specifies the directory to use as the base
233of relativity - otherwise the current working directory will be used.
234
235=item $rel = $file->relative
236
237Returns a C<Path::Class::File> object representing C<$file> as a
238relative path.  An optional argument, given as either a string or a
239C<Path::Class::Dir> object, specifies the directory to use as the base
240of relativity - otherwise the current working directory will be used.
241
242=item $foreign = $file->as_foreign($type)
243
244Returns a C<Path::Class::File> object representing C<$file> as it would
245be specified on a system of type C<$type>.  Known types include
246C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
247there is a subclass of C<File::Spec>.
248
249Any generated objects (subdirectories, files, parents, etc.) will also
250retain this type.
251
252=item $foreign = Path::Class::File->new_foreign($type, @args)
253
254Returns a C<Path::Class::File> object representing a file as it would
255be specified on a system of type C<$type>.  Known types include
256C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which
257there is a subclass of C<File::Spec>.
258
259The arguments in C<@args> are the same as they would be specified in
260C<new()>.
261
262=item $fh = $file->open($mode, $permissions)
263
264Passes the given arguments, including C<$file>, to C<< IO::File->new >>
265(which in turn calls C<< IO::File->open >> and returns the result
266as an C<IO::File> object.  If the opening
267fails, C<undef> is returned and C<$!> is set.
268
269=item $fh = $file->openr()
270
271A shortcut for
272
273 $fh = $file->open('r') or die "Can't read $file: $!";
274
275=item $fh = $file->openw()
276
277A shortcut for
278
279 $fh = $file->open('w') or die "Can't write $file: $!";
280
281=item $file->touch
282
283Sets the modification and access time of the given file to right now,
284if the file exists.  If it doesn't exist, C<touch()> will I<make> it
285exist, and - YES! - set its modification and access time to now.
286
287=item $file->slurp()
288
289In a scalar context, returns the contents of C<$file> in a string.  In
290a list context, returns the lines of C<$file> (according to how C<$/>
291is set) as a list.  If the file can't be read, this method will throw
292an exception.
293
294If you want C<chomp()> run on each line of the file, pass a true value
295for the C<chomp> or C<chomped> parameters:
296
297  my @lines = $file->slurp(chomp => 1);
298
299=item $file->remove()
300
301This method will remove the file in a way that works well on all
302platforms, and returns a boolean value indicating whether or not the
303file was successfully removed.
304
305C<remove()> is better than simply calling Perl's C<unlink()> function,
306because on some platforms (notably VMS) you actually may need to call
307C<unlink()> several times before all versions of the file are gone -
308the C<remove()> method handles this process for you.
309
310=item $st = $file->stat()
311
312Invokes C<< File::stat::stat() >> on this file and returns a
313C<File::stat> object representing the result.
314
315=item $st = $file->lstat()
316
317Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()>
318stats the link instead of the file the link points to.
319
320=back
321
322=head1 AUTHOR
323
324Ken Williams, kwilliams@cpan.org
325
326=head1 SEE ALSO
327
328Path::Class, Path::Class::Dir, File::Spec
329
330=cut
331