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