view release on metacpan or  search on metacpan

lib/File/System/Object.pm  view on Meta::CPAN

=head1 NAME

File::System::Object - Abstract class that every file system module builds upon

=head1 DESCRIPTION

Before reading this documentation, you should see L<File::System>.

File system modules extend this class to provide their functionality. A file system object represents a path in the file system and provides methods to locate other file system objects either relative to this object or from an absolute root.

If you wish to write your own file system module, see the documentation below for L</"MODULE AUTHORS">.

=head2 FEATURES

The basic idea is that every file system is comprised of objects. In general, all file systems will contain files and directories. Files are object which contain binary or textual data, while directories merely contain more files. Because any given f...

More advanced types might also be possible, e.g. symbolic links, devices, FIFOs, etc. However, at this time, no general solution is provided for handling these. (Individual file system modules may choose to add support for these in whatever way seems...

Each file system object must specify a method stating whether it contains file content and another method stating whether it may contain child files. It is possible that a given file system implementation provides both simultaneously in a single obje...

All file system objects allow for the lookup of other file system object by relative or absolute path names.

=head2 PATH METHODS

These methods provide the most generalized functionality provided by all objects. Each path specified to each of these must follow the rules given by the L</"FILE SYSTEM PATHS"> section and may either be relative or absolute. If absolute, the operati...

=over

=item $root = $obj-E<gt>root

Return an object for the root file system.

=item $test = $obj-E<gt>exists($path)

Check the given path C<$path> and determine whether a file system object exists at that path. Return a true value if there is such an object or false otherwise. If C<$path> is undefined, the method should assume C<$obj-E<gt>path>.

=cut

sub exists {
	my $self = shift;
	my $path = shift || $self->path;

	return defined $self->lookup($path);
}

=item $file = $obj-E<gt>lookup($path)

Lookup the given path C<$path> and return a L<File::System::Object> reference for that path or C<undef>.

=cut

sub lookup {
	my $self = shift;
	my $path = shift;

	my $abspath = $self->normalize_path($path);

	if ($self->is_root) {
		my $result = $self;
		my @components = split m#/#, $path;
		for my $component (@components) {
			$self->is_container && ($result = $result->child($component))
				or return undef;
		}

		return $result;
	} else {
		return $self->root->lookup($abspath);
	}
}

=item @objs = $obj->glob($glob)

Find all files matching the given file globs C<$glob>. The glob should be a typical csh-style file glob---see L</"FILE SYSTEM PATHS"> below. Returns all matching objects. Note that globs are matched against '.' and '..', so care must be taken in craf...

=cut

sub glob {
	my $self = shift; 
	my $glob = $self->normalize_path(shift);

	my @components = split /\//, $glob;
	shift @components;

	my @open_list;
	my @matches = ([ $self->root->path, $self->root ]);

	for my $component (@components) {
		@open_list = 
			map {
			   my ($path, $obj) = @$_; 
			   map { [ $_, $obj->lookup($_) ] } $obj->children_paths 
			} grep { $_->[1]->is_container } @matches;

		return () unless @open_list;

		@matches = 
			grep { $self->match_glob($component, $_->[0]) } @open_list;
	}

	return sort map { $_->[1] } @matches;
}

=item @files = $obj->find($want, @paths)

This is similar in function to, but very different in implementation from L<File::Find>.

Find all files matching or within the given paths C<@paths> or any subdirectory of those paths, which pass the criteria specifed by the C<$want> subroutine.  If no C<@paths> are given, then "C<$obj>" is considered to be the path to search within.

The C<$want> subroutine will be called once for every file found under the give paths. The C<$want> subroutine may expect a single argument, the L<File::System::Object> representing the given file. The C<$want> subroutine should return true to add th...

The implementation should perform a depth first search so that children are checked immediately after their parent (unless the children are pruned, of course).

=cut

sub find {
	my $self = shift;
	my $want = shift;

	my @dirs = @_ ? @_ : ($self);

lib/File/System/Object.pm  view on Meta::CPAN

=over

=item exists

=item glob

=back

=head2 HELPER METHODS

This class also provides a few helpers that may be useful to module uathors, but probably not of much use to typical users.

=over

=item $clean_path = $obj-E<gt>normalize_path($messy_path)

This method creates a canonical path out of the given path C<$messy_path>. This is the single most important method offered to module authors. It provides several things:

=over

=item 1.

If the path being canonified is relative, this method checks to see if the current object is a container. Paths are relative to the current object if the current object is container. Otherwise, the paths are relative to this object's parent.

=item 2.

Converts all relative paths to absolute paths.

=item 3.

Removes all superfluous '.' and '..' names so that it gives the most concise and direct name for the named file.

=item 4.

Enforces the principle that '..' applied to the root returns the root. This provides security by preventing users from getting to a file outside of the root (assuming that is possible for a given file system implementation).

=back

Always, always, always use this method to clean up your paths.

=cut

sub normalize_path {
	my $self = shift;
	my $path = shift;

	defined $path
		or croak "normalize_path must be given a path";

	# Skipped so we can still get some benefit in constructors
	if (ref $self && $path !~ m#^/#) {
		# Relative to me (I am a container) or to parent (I am not a container)
		$self->is_container
			or $self = $self->parent;

		# Fix us up to an absolute path
		$path = $self->path."/$path";
	}

	# Break into components
	my @components = split m#/+#, $path;
	@components = ('', '') unless @components;
	unshift @components, '' unless @components > 1;

	for (my $i = 1; $i < @components;) {
		if ($components[$i] eq '.') {
			splice @components, $i, 1;
		} elsif ($components[$i] eq '..' && $i == 1) {
			splice @components, $i, 1;
		} elsif ($components[$i] eq '..') {
			splice @components, ($i - 1), 2;
			$i--;
		} else {
			$i++;
		}
	}

	unshift @components, '' unless @components > 1;

	return join '/', @components;
}

=item @matched_paths = $obj-E<gt>match_glob($glob, @all_paths)

This will match the given glob pattern C<$glob> against the given paths C<@all_paths> and will return only those paths that match. This provides a de facto implementation of globbing so that any module can provide this functionality without having to...

=cut

my $globber = File::System::Globber->new;

sub match_glob {
	my $self = shift;
	my $glob = shift;
	my @tree = @{ $globber->glob($glob) };
	my @paths = @_;

	my @matches;
	MATCH: for my $str (@paths) {
		# Special circumstance: any pattern not explicitly starting with '.'
		# cannot match a file name starting with '.'
		next if $str =~ /^\./ && $glob !~ /^\./;

		my $orig = $str;

		my @backup = ();
		my $tree = [ @tree ];
		while (my $el = shift @$tree) {
			if (ref $el eq 'File::System::Glob::MatchOne') {
				goto BACKUP unless substr $str, 0, 1, '';
			} elsif (ref $el eq 'File::System::Glob::MatchAny') {
				push @backup, [ $str, 0, @$tree ];
			} elsif (ref $el eq 'File::System::Glob::MatchAlternative') {
				my $match = 0;
				for my $alt (@{ $el->{alternatives} }) {
					if ($alt eq substr($str, 0, length($alt))) {
						substr $str, 0, length($alt), '';
						$match = 1;
						last;
					}
				}

				goto BACKUP unless $match;
			} elsif (ref $el eq 'File::System::Glob::MatchCollection') {
				my $char = substr $str, 0, 1, '';
				
				my $match = 0;
				for my $class (@{ $el->{classes} }) {
					if ((ref $class) && ($char ge $class->[0]) && ($char le $class->[1])) {
						$match = 1;
						last;
					} elsif ($char eq $class) {
						$match = 1;
						last;
					}
				}

				goto BACKUP unless $match;
			} else {
				my $char = substr $str, 0, 1, '';

				goto BACKUP unless $char eq $el->{character};
			}

			next unless $str and !@$tree;

BACKUP:		my ($tstr, $amt, @ttree);
			do {
				next MATCH unless @backup;
				($tstr, $amt, @ttree) = @{ pop @backup };
			} while (++$amt > length $tstr);

			push @backup, [ $tstr, $amt, @ttree ];

			$str  = substr $tstr, $amt;
			$tree = \@ttree;
		}

		push @matches, $orig;
	}

	return @matches;
}

=item $basename = $obj-E<gt>basename_of_path($normalized_path)

Given a normalized path, this method will return the basename for that path according to the rules employed by C<File::System>. (Essentially, they are the same as L<File::Basename>, except that the basename of "/" is "/" rather than "".)

=cut

sub basename_of_path {
	my $self = shift;
	my $path = shift;

	if ($path eq '/') {
		return '/';
	} else {
		my @components = split m{/}, $path;
		return pop @components;
	}
}

=item $dirname = $obj-E<gt>dirname_of_path($normalized_path)

Given a normalized path, this method will return the dirname for that path according to the rules employed by C<File::System>. (These should be identical to the rules used by L<File::Basename> as far as I know.)

=cut

sub dirname_of_path {
	my $self = shift;
	my $path = shift;

	if ($path eq '/') {
		return '/';
	} else {
		my @components = split m{/}, $path;
		pop @components;
		push @components, '' if @components == 1;
		return join '/', @components;
	}
}

=back

=head1 SEE ALSO

L<File::System>

=head1 AUTHOR

Andrew Sterling Hanenkamp, E<lt>hanenkamp@users.sourceforge.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2005 Andrew Sterling Hanenkamp. All Rights Reserved.

This software is distributed and licensed under the same terms as Perl itself.

=cut

1