#======================================================================== # # Badger::Filesystem::Path # # DESCRIPTION # OO representation of a path in a filesystem, serving as a base class # for file and directories. # # AUTHOR # Andy Wardley # #======================================================================== package Badger::Filesystem::Path; use File::Spec; use Badger::Class version => 0.01, debug => 0, base => 'Badger::Base Badger::Exporter', import => 'class', constants => 'HASH ARRAY TRUE', get_methods => 'path name volume directory', utils => 'blessed', constant => { is_file => 0, is_directory => 0, type => 'Path', }, exports => { tags => { fields => '@VDN_FIELDS @VD_FIELDS @STAT_FIELDS' }, }, messages => { no_exist => '%s does not exist: %s', bad_stat => '%s cannot be scanned: %s', bad_look => 'No path specified to look %s', missing => 'No %s specified', }; use overload '""' => \&path, bool => \&TRUE, fallback => 1; use Badger::Filesystem; use Badger::Filesystem::Directory; our $FILESYSTEM = 'Badger::Filesystem'; our @VDN_FIELDS = qw( volume directory name ); our @VD_FIELDS = qw( volume directory ); our @STAT_FIELDS = qw( device inode mode links user group device_type size accessed modified created block_size blocks readable writeable executable owner ); # generate methods to access stat fields my $n = 0; class->methods( map { my $m = $n++; # new lexical variable to bind in closure $_ => sub { $_[0]->stats->[$m] } } @STAT_FIELDS ); # define some aliases *is_dir = \&is_directory; *dir = \&directory; *vol = \&volume; # goes up to 11 *ext = \&extension; *up = \&parent; *meta = \&metadata; *canonical = \&absolute; sub new { my $class = shift; $class = ref $class || $class; my $args; if (@_ == 1) { $args = ref $_[0] eq HASH ? shift : ref $_[0] eq ARRAY || ! ref $_[0] ? { path => shift } : return $class->error_msg( unexpected => arguments => $_[0] => 'hash ref' ) } else { $args = { @_ }; } # allow short aliases for various configuration options, including # those of directory/file subclasses to make life easy for them. $args->{ filesystem } ||= $args->{ fs } if $args->{ fs }; $args->{ directory } ||= $args->{ dir } if $args->{ dir }; $args->{ volume } ||= $args->{ vol } if $args->{ vol }; my $self = bless { }, $class; # maintain a reference to the filesystem that created us, if available, # but don't bother if we didn't get one - we can use the default $self->{ filesystem } = $args->{ filesystem } if $args->{ filesystem }; $self->init($args); } sub init { my ($self, $config) = @_; my $path = $config->{ path } || return $self->error_msg( missing => 'path' ); my $fs = $self->filesystem; $path = $self->{ path } = $fs->join_directory($path); return $self; } sub is_absolute { my $self = shift; $self->{ absolute } = $self->filesystem->is_absolute($self->{ path }) unless defined $self->{ absolute }; return $self->{ absolute }; } sub is_relative { shift->is_absolute ? 0 : 1; } sub absolute { my $self = shift; return $self->is_absolute ? $self->{ path } : $self->filesystem->absolute($self->{ path }); } sub relative { my $self = shift; my $fs = $self->filesystem; my $path = $fs->join_directory(@_); # If the path isn't already absolute then we merge it onto our # directory or path if directory is undefined. By calling the # base() method, we allow the file subclass to return its # parent directory so that things Just Work[tm] # $self->debug("relative path: $path is_absolute?\n"); return $fs->is_absolute($path) ? $path : $fs->collapse_directory( $fs->join_directory($self->base, $path) ); } sub definitive { my $self = shift; $self->filesystem->definitive($self->{ path }); } sub collapse { my $self = shift->absolute; my $fs = $self->filesystem; $self->{ directory } = $fs->collapse_directory($self->{ directory }); $self->{ path } = $fs->join_path(@$self{@VDN_FIELDS}); return $self; } sub above { my $self = shift; my $this = quotemeta $self->collapse->path; my $that = shift || return $self->error_msg( bad_look => 'above' ); $that = $self->new("$that") unless blessed $that && $that->isa(__PACKAGE__); $that = $that->collapse->path; $self->debug("does $that match /^$this/ ??\n") if $DEBUG; $that =~ /^$this/; } sub below { my $self = shift; my $that = shift || return $self->error_msg( bad_look => 'above' ); $that = $self->new("$that") unless blessed $that && $that->isa(__PACKAGE__); $that->above($self); } sub base { my $self = shift; return $self->{ directory } || $self->{ path }; } sub parent { my $self = shift; my $skip = shift || 0; my $parent = $self->{ parent } ||= $self->filesystem->directory( $self->{ directory } ||= $self->path_up ); return # don't return parents above the root $self->{ path } eq $parent->{ path } ? $self # delegate to parent if there are generations to skip : $skip ? $parent->parent($skip - 1) # otherwise we've found the parent we're looking for : $parent; } sub path_up { my $self = shift; my $fs = $self->filesystem; my $path = $fs->split_directory($self->{ path }); $self->debug("split path [$path] into [", join(', ', @$path), "]\n") if $DEBUG; if (@$path > 1) { # multiple items in path can be relative or absolute - we're not # fussed. e.g. /foo/bar ==> /foo or foo/bar ==> foo pop(@$path); } elsif (@$path == 1) { # if there's a single item in a path then it's either a single # relative path item (e.g. 'foo' ==> ['foo']), in which case we # return the current working directory, or it's an empty item # indicating the root directory (e.g. '/' => ['']) in which case we # do nothing, because you can't go up from the root directory. if (length $path->[0]) { return $fs->cwd; } $self->not_implemented("going up from relative paths"); } else { $self->error("Invalid path (no elements)\n"); } return $fs->join_directory($path); } sub exists { my $self = shift; $self->filesystem->path_exists($self->{ path }); } sub must_exist { my $self = shift; unless ($self->exists) { if (@_ && $_[0]) { # true flag to attempt $self->create; } else { return $self->error_msg( no_exist => $self->type, $self->{ path } ); } } return $self; } sub create { shift->not_implemented; } sub stat { my $self = shift->must_exist; my @stats = (CORE::stat($self->{ path }), -r _, -w _, -x _, -o _); return $self->error_msg( bad_stat => $self->type, $self->{ path } ) unless @stats; $self->{ stats } = \@stats; return wantarray ? @stats : \@stats; } sub stats { my $stats = $_[0]->{ stats } || $_[0]->stat; return wantarray ? @$stats : $stats; } sub extension { my $self = shift; # TODO: is this filesystem specific? return $self->{ path } =~ /\.([^\.]+)$/ ? $1 : ''; } sub filesystem { my $self = shift; return $self->class->any_var('FILESYSTEM')->prototype unless ref $self; $self->{ filesystem } ||= $self->class->any_var('FILESYSTEM')->prototype; } sub visit { my $self = shift; my $visitor = $self->filesystem->visitor(@_); $visitor->visit($self); return $visitor; } sub collect { shift->visit(@_)->collect; } sub enter { # enter() is a custom accept() method for the entry point of a visitor shift->accept; } sub accept { $_[1]->visit_path($_[0]); } sub metadata { my $self = shift; my $meta = $self->{ metadata } ||= { }; if (@_ == 1) { return $meta->{ $_[0] }; } elsif (@_ > 1) { while (@_) { my $key = shift; $meta->{ $key } = shift; } } return $meta; } 1; =head1 NAME Badger::Filesystem::Path - generic fileystem path object =head1 SYNOPSIS # using Badger::Filesytem constructor subroutine use Badger::Filesystem 'Path'; # use native OS-specific paths: $path = Path('/path/to/something'); # or generic OS-independant paths $path = Path('path', 'to', 'something'); # manual object construction use Badger::Filesystem::Path; # positional arguments $path = Badger::Filesystem::Path->new('/path/to/something'); $path = Badger::Filesystem::Path->new(['path', 'to', 'something']); # named parameters $path = Badger::Filesystem::Path->new( path => '/path/to/something' ); $path = Badger::Filesystem::Path->new( path => ['path', 'to', 'something'] ); # path inspection methods $path->path; # current path $path->base; # parent directory or path itself $path->parent; # directory object for base $path->is_absolute; # path is absolute $path->is_relative; # path is relative $path->exists; # returns true/false $path->must_exist; # throws error if not @stats = $path->stat; # returns list $stats = $path->stat; # returns list ref # path translation methods $path->relative; # relative to cwd $path->relative($base); # relative to $base $path->absolute; # relative to filesystem root $path->definitive; # physical file location $path->collapse; # resolve '.' and '..' in $path # path comparison methods $path->above($another_path); # $path is ancestor of $another_path $path->below($another_path); # $path is descendant of $another_path =head1 INTRODUCTION This is the documentation for the C module. It defines a base class object for the L and L objects which inherit (and in some cases redefine) the methods described below. In other words, you should read this documentation first if you're working with L or L objects. =head1 DESCRIPTION The C module defines a base class object for representing paths in a real or virtual file system. You can create a generic path object (e.g. to represent a path that doesn't relate to a specific file or directory in a file system), using the C constructor method in L. use Badger::Filesystem 'Path'; my $path = Path('/path/to/something'); However in most cases you'll want to create a file or directory subclass object. The easiest way to do that is like this: use Badger::Filesystem 'File Path'; my $file = File('/path/to/file'); my $dir = Dir('/path/to/dir'); If you're concerned about portability to other operating systems and/or file systems, then you can specify paths as a list or reference to a list of component names. my $file = File('path', 'to', 'file'); my $dir = Dir(['path', 'to', 'dir']); =head1 METHODS =head2 new($path) Constructor method to create a new C object. The path can be specified as a single positional argument, either as a text string or reference to list of path components. # single text string $path = Badger::Filesystem::Path->new('/path/to/something'); # reference to list $path = Badger::Filesystem::Path->new(['path', 'to', 'something']); It can also be specified as a C named parameter. # named parameter list $path = Badger::Filesystem::Path->new( path => '/path/to/something' ); # reference to hash of named parameter(s) $path = Badger::Filesystem::Path->new({ path => '/path/to/something' }); The constructor method also recognises the C named parameter which can contain a reference to the L object or class that created it. In most cases you can rely on the L to create path objects for you, using either the L method, or the L subroutine. use Badger::Filesystem 'FS Path'; # FS is alias for 'Badger::Filesystem' # Path() is constructor subrooutine my $path; # using the path() method $path = FS->path('/path/to/something'); $path = FS->path('path', 'to', 'something'); $path = FS->path(['path', 'to', 'something']); # using the Path() subroutine $path = Path('/path/to/something'); $path = Path('path', 'to', 'something'); $path = Path(['path', 'to', 'something']); The examples that follow will use the C constructor subroutine. =head2 init(\%config) Default initialisation method which subclasses (e.g. L and L) can redefine. =head2 path() This method returns the path as a text string. It is called automatically whenever the path object is stringified. =head2 is_absolute() Returns true if the path is absolute, false if not. =head2 is_relative() Returns true if the path is relative, false if not. =head2 absolute($base) Returns an absolute representation of the path, relative to the C<$base> path passed as an argument, or the current working directory if C<$base> is not specified. # assume cwd is /foo/bar, my $path = Path('/baz/bam'); print $path->absolute; # /foo/bar/baz/bam print $path->absolute('/wiz'); # /wiz/baz/bam =head2 relative($base) Returns a relative representation of the path, relative to the C<$base> path passed as an argument, or the current working directory if C<$base> is not specified. # assume cwd is /foo/bar, my $path = Path('/foo/bar/baz/bam'); print $path->relative; # /baz/bam print $path->relative('/foo'); # /bar/baz/bam =head2 definitive() Returns the definitive representation of the path which in most cases will be the same as the L path. However, if you're using a L, then the I path I include the virtual root directory, whereas a the I path will I. my $vfs = Badger::Filesystem::Virtual->new( root => '/my/vfs' ); my $path = $vfs->file('/foo/bar'); print $path->absolute; # /foo/bar print $path->definitive; # /my/vfs/foo/bar =head2 canonical() This method returns the canonical representation of the path. In most cases this is the same as the absolute path (in fact the base class aliases the C method directly to the L method). print Path('foo')->canonical; # /your/current/path/foo print Path('/foo/bar')->canonical; # /foo/bar print Path('/foo/bar/')->canonical; # /foo/bar print Path('/foo/bar.txt')->canonical; # /foo/bar.txt Note that the C base class will I any trailing slashes (or whatever the appropriate directory separator is for your filesystem) from the end of an absolute path. In the case of directories, implemented by the L subclass, a trailing slash (or relevant separator for your filesystem) will be added. print Dir('/foo/bar')->canonical; # /foo/bar/ This is done by delegation to the L method in L. =head2 collapse() Reduces the path to its simplest form by resolving and removing any C<.> (current directory) and C<..> (parent directory) components (or whatever the corresponding tokens are for the current and parent directories of your filesystem). my $path = Path('/foo/bar/../baz')->collapse; print $path; # /foo/baz See the L method in L for further information. =head2 above($child) Returns true if the path is "above" the C<$child> path passed as an argument. Formally, we say that the path is an I of C<$child> meaning that it is the parent directory, or grand-parent, or great-grand-parent, and so on. my $parent = Path('/foo/bar'); my $child = Path('/foo/bar/baz'); $parent->above($child); # true This is implemented as a simple prefix match. That is, the parent path must appear at the start of the child path. Consequently, this method will not account for symbolic links or other similar filesystem features, and it may not work properly on systems that don't follow this convention (although there are none that I'm aware of). =head2 below($parent) Returns true if the path is "below" the C<$parent> path passed as an argument. Formally, we say that the path is a I of C<$parent> meaning that it is an immediate sub-directory, or sub-sub-directory, and so on. my $parent = Path('/foo/bar'); my $child = Path('/foo/bar/baz'); $child->below($parent); # true Like L, this is implemented using a simple prefix match. =head2 base() Returns the base directory of a path. For L and L objects, this method will return the complete path. print Path('/foo/bar')->base; # /foo/bar print Directory('/foo/bar')->base; # /foo/bar However the L module returns the parent directory in which the file is located. print File('/foo/bar')->base; # /foo =head2 parent($skip_generations) / up($skip_generations) Returns a L object representing the parent directory for a path. Path->('/foo/bar')->parent; # path object for /foo A numerical argument can be provided to indicate the number of generation you want to skip. A value of C<0> is the same as providing no argument - it returns the parent. A value of C<1> skips the parent and returns the grand-parent, and so on. Path->('/foo/bar/baz/bam')->parent(2); # path object for /foo The root directory will be returned if you try to skip too many generations. Path->('/foo/bar/baz/bam')->parent(20); # path object for / =head2 path_up() This returns a text string representing the parent of a path. If the path contains multiple items (e.g. '/foo/bar' or 'foo/bar') then the last item will be removed (e.g. resulting in '/foo' or 'foo' respectively). If an absolute path contains one item or none (e.g. '/foo' or '/') then the root directory ('/') will be returned. A relative path with only one item (e.g. 'foo') is assumed to be relative to the current working directory which will be returned (e.g. '/path/to/current/dir'). =head2 extension() / ext() Returns any file extension portion following the final C<.> in the path. =head2 exists() Returns true if the path exists in the filesystem (e.g. as a file, directory, or some other entry), or false if not. if ($path->exists) { print "$path already exists\n"; } else { print "Creating $path\n"; # ...etc... } =head2 must_exist($create) Checks that the path exists (by calling L) and throws an error if it doesn't. $path->must_exist; # no need to check return value The C<$create> flag can be set to have it attempt to L itself if it doesn't already exist. However, this only makes sense for file and directory subclasses and not base class paths. $dir->must_exist(1); # create if it doesn't =head2 create() In the base class this will method will throw an error. You can't physically create an abstract path unless you know what kind of concrete entity (e.g. file or directory) it maps onto. In other words, the L method will only work for the L and L subclasses. $path->create; # FAIL $dir->create; # OK $file->create; # OK =head2 stat() Performs a filesystem C on the path and returns a list (in list context), or a reference to a list (in scalar context) containing the 13 information elements. See C for further details on what they are. @list = $path->stat; # list context $list = $path->stat; # scalar context =head2 stats A wrapper around the L method which caches the results to avoid making repeated filesystem calls. @list = $path->stats; # list context $list = $path->stats; # scalar context =head2 filesystem Returns a reference to a L object, or the name of the filesystem class (e.g. L or a subclass) that created the path object. If this is undefined then the default value defined in the L<$FILESYSTEM> class variable is returned. Unless you've changed it, or re-defined it in a subclass, this value will be C. The end result is that you can use the C method to access a L object or class through which you can perform other filesystem related operations. This is used internally by a number of method. # access filesystem via existing path $path->filesystem->dir('/a/new/directory/object'); # same as Badger::Filesystem->dir('/a/new/directory/object'); =head2 visit($visitor) Entry point for a filesystem visitor to visit a filesystem path. A reference to a L object (or subclass) should be passed as the first argument. use Badger::Filesystem::Visitor; my $visitor = Badger::Filesystem::Visitor->new( recurse => 1 ); $path->visit($visitor); Alternately, a list or reference to a hash array of named parameters may be provided. These will be used to instantiate a new L object (via the L L method) which will then be applied to the path. If no arguments are passed then a visitor is created with a default configuration. # either list of named params $path->visit( recurse => 1 ); # or reference to hash array $path->visit({ recurse => 1}); The method then calls the visitor L passing C<$self> as an argument to begin the visit. =head2 accept($visitor) This method is called to dispatch a visitor to the correct method for a filesystem object. In the L base class, it calls the visitor L method, passing the C<$self> object reference as an argument. Subclasses redefine this method to call other visitor methods. =head2 enter($visitor) This is a special case of the L method which subclasses (e.g. L) use to differentiate between the initial entry point of a visitor and subsequent visits to directories contained therein. In the base class it simply delegates to the L method. =head2 collect(\%params) This is a short-cut to call the L method and then the L method on the L object returned. # short form my @items = $path->collect( files => 1, dirs => 0 ); # long form my @items = $path->visit( files => 1, dirs => 0 )->collect; =head2 metadata() / meta() This method allows you to associate metadata with a path. The method accepts multiple arguments to set metadata: $path->metadata( title => 'An Example', author => 'Arthur Dent' ); It also accepts a single argument to fetch a metadata item: print $path->metadata('author'); # Arthur Dent You can also call it without arguments. The method returns a reference to a hash array of metadata items. my $meta = $path->metadata; print $meta->{ author }; # Arthur Dent =head1 STUB METHODS The following methods serve little or no purpose in the C base class. They are redefined by the C and C modules to do the right thing. =head2 is_file() This method always returns false in the C base class. The C subclass redefines this to return true. NOTE: this may be changed to examine the filesystem and return true if the path references a file. =head2 is_directory() / is_dir() This method always returns false in the C base class. The C subclass redefines this to return true. NOTE: this may be changed to examine the filesystem and return true if the path references a file. =head2 volume() / vol() Returns any volume defined as part of the path. This method does nothing in the C base class. =head2 directory() / dir() Returns the directory portion of a path. This method does nothing in the C base class. =head2 name() Returns the file name portion of a path. This method does nothing in the C base class. =head1 AUTHOR Andy Wardley Eabw@wardley.orgE =head1 COPYRIGHT Copyright (C) 2005-2008 Andy Wardley. All rights reserved. =head1 ACKNOWLEDGEMENTS The C modules are built around a number of existing Perl modules, including L, L, L, L, L and draw heavily on ideas in L. Please see the L in L for further information. =head1 SEE ALSO L, L, L, L. =cut # Local Variables: # mode: Perl # perl-indent-level: 4 # indent-tabs-mode: nil # End: # # vim: expandtab shiftwidth=4: # TextMate: should support split pane editing