File Coverage

blib/lib/File/System/Passthrough.pm

Criterion	Covered	Total	%
statement	146	178	82.0
branch	25	84	29.7
condition			n/a
subroutine	38	40	95.0
pod	35	35	100.0
total	244	337	72.4

package File::System::Passthrough;

use strict;
use warnings;

our $VERSION = '1.02';

use Carp;
use base 'File::System::Object';

=head1 NAME

File::System::Passthrough - A file system module that delegates work to another

=head1 SYNOPSIS

  package File::System::MyModule;

  use strict;
  use base 'File::System::Passthrough';

  # You now have all methods available, just define those you must.

=head1 DESCRIPTION

This module is pretty useless on it's own. It simply delegates all the real work to an internal wrapped module. It shouldn't be used directly. However, I've found that many of the special modules written are used to wrap others and this provides the basic functionality.

=head2 SUBCLASSING

Basically, you can just declare L as your base class and be done. You can define as many or few other methods as you prefer. You can refer to the wrapped class like so:

  sub my_method {
      my $self = shift;
      my $wrapped_fs = $self->{fs};

      # ...
  }

As of this writing, no other key in the C<$self> hash is used, so you can manipulate the other keys as you wish.

=head2 ADDITIONAL API

=over

=item $obj = File::System-Enew('Passthrough', $wrapped_obj)

The constructor takes either a decendent of L or a reference to an array that can be used to construct such an object in C<$wrapped_obj>.

=cut

sub new {
	my $class = shift;
	my $fs    = shift;

	$fs = File::System->new(@$fs) if UNIVERSAL::isa($fs, 'ARRAY');

	UNIVERSAL::isa($fs, 'File::System::Object')
		or croak "Wrapped object must be of type File::System::Object.";

	return bless {
		fs => $fs,
	}, $class;
}

my @plain = qw/
	exists
	is_creatable
	is_valid
	basename
	dirname
	path
	is_root
	properties
	settable_properties
	get_property
	set_property
	rename
	move
	remove
	object_type
	has_content
	is_container
	is_readable
	is_seekable
	is_writable
	is_appendable
	open
	content
	has_children
	children_paths
/;

my @wrap_if_defined = qw/
	root
	lookup
	create
	parent
	copy
	child
/;

my @wrap_list = qw/
	glob
	children
/;

for my $sub (@plain) {
	eval <
sub $sub {
	my \$self = shift;

	my \@args = map {
		UNIVERSAL::isa(\$_, 'File::System::Passthrough') ?
			\$_->{fs} : \$_
	} \@_;

	return \$self->{fs}->$sub(\@args);
}
EOF

	die $@ if $@;
}

for my $sub (@wrap_if_defined) {
	eval <
sub $sub {
	my \$self = shift;

	my \@args = map {
		UNIVERSAL::isa(\$_, 'File::System::Passthrough') ?
			\$_->{fs} : \$_
	} \@_;

	my \$obj = \$self->{fs}->$sub(\@args);

	if (defined \$obj) {
		return bless {
			fs => \$obj,
		}, ref \$self;
	} else {
		return undef;
	}
}
EOF

	die $@ if $@;
}

for my $sub (@wrap_list) {
	eval <
sub $sub {
	my \$self = shift;

	my \@args = map {
		UNIVERSAL::isa(\$_, 'File::System::Passthrough') ?
			\$_->{fs} : \$_
	} \@_;

	return map {
		bless {
			fs => \$_,
		}, ref \$self;
	} \$self->{fs}->$sub(\@args);
}
EOF

	die $@ if $@;
}

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

	my @args = (sub {
		my $file = shift;
		return $want->(bless { fs => $file }, ref $self);
	});

	push @args, map {
		UNIVERSAL::isa($_, 'File::System::Passthrough') ?
			$_->{fs} : $_
	} @_;

	return map {
		bless {
			fs => $_,
		}, ref $self;
	} $self->{fs}->find(@args);
}

=back

=head1 SEE ALSO

L, L

=head1 AUTHOR

Andrew Sterling Hanenkamp, [e-mail]

=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