File Coverage

blib/lib/Text/BIP.pm

Criterion	Covered	Total	%
statement	9	86	10.4
branch	0	42	0.0
condition	0	17	0.0
subroutine	3	24	12.5
pod	19	20	95.0
total	31	189	16.4

# Copyright (c) 2003-4 Timothy Appnel
# http://www.timaoutloud.org/
# This code is released under the Artistic License.
#
# Text::BIP -- Blosxom Infrastructure Package. An object-oriented module for facilitating event-based file system indexing.
#

package Text::BIP;

use DirHandle;
use File::Spec;
use vars qw( $VERSION );
$VERSION = '0.51';

my $path_delim=File::Spec->catfile('',''); # stupid hack, but it works. better way???

sub new {
	my $class = shift;
	my $self = bless { }, $class;
	$self->init(@_);
	return $self;
}

sub init {
	$_[0]->{__index_depth} = 0;
	$_[0]->{__base} = $_[1] ->{base} || '.';
	$_[0]->{__depth} = $_[1]->{depth} || 0;
	$_[0]->{__stash} = undef;
}

sub depth { $_[0]->{__depth}=$_[1] if $_[1]; $_[0]->{__depth}; }
sub base { $_[0]->{__base}=$_[1] if $_[1]; $_[0]->{__base}; }
sub stash {
	$_[0]->{__stash}->{ $_[1] } = $_[2] if $_[2];
	$_[0]->{__stash}->{ $_[1] };
}

# handler methods
sub clear_handlers { $_[0]->{__handlers} = undef; } # wipes out handler hashes.
sub prerun { shift->{__handlers}->{prerun}=shift if @_; }
sub postrun {  shift->{__handlers}->{postrun}=shift if @_; }
sub file_handler {
	my $self = shift;
	my $ref = shift;
	foreach my $ext ( @_ ) { $self->{__handlers}->{'file'}->{$ext}=$ref; }
}
sub index_handler {
	my($self,$ref) = @_;
	$self->{__handlers}->{'index'}->{'*'}=$ref;
}
sub read_handler {
	my $self = shift;
	my $ref = shift;
	foreach my $ext ( @_ ) { $self->{__handlers}->{'read'}->{$ext}=$ref; }
}

sub index {
	my $self = shift;
	my $path = shift || $self->base() || '.';
	if ($path) {
		$self->{__handlers}->{prerun}->($self)
			if ( defined($self->{__handlers}->{prerun}) );
		$self->{__index_depth}=1;
		_process_dir($self,$path);
		$self->{__index_depth}=0;
		$self->{__handlers}->{postrun}->($self)
			if ( defined($self->{__handlers}->{postrun}) );
	}
}

sub _process_dir {
	my $self = shift;
	my $path = shift;
	my $d = DirHandle->new($path);
	my $exts = $self->{exts};
	for my $file ($d->read()) {
		unless ($file=~/^\./) {
			my $path_file=File::Spec->catfile($path,$file);
			$file=~m/\.([^.]*)$/;
			my $ext = $1 || '';
			my %data = ( path=>$path, file=>$file, ext=>$ext );
			push(@{ $self->{__stack} }, \%data );
			if ( -f $path_file) { # all files hook?
				if ( defined( $self->{__handlers}->{file}->{ $ext } ) ) {
					$self->{__handlers}->{'file'}->{ $ext }->($self);
				} elsif ( defined( $self->{__handlers}->{file}->{'*'} ) ) {
					$self->{__handlers}->{'file'}->{'*'}->($self);
				}
			} elsif (-d $path_file) {
				$self->{__handlers}->{'index'}->{'*'}->($self)
					if ( defined( $self->{__handlers}->{'index'}->{'*'} ) );
				$self->{__index_depth}++;
				_process_dir($self, $path_file)
					if (! $self->depth || $self->{__index_depth} < $self->depth);
				$self->{__index_depth}--;
			}
			pop(@{ $self->{__stack} });
		}
	}
	1;
}

# accessors methods to current state while streaming.
sub dir { $_[0]->{__stack}->[-1]->{path} || $path_delim; }
sub relative_dir {
	my $base = $_[1] || $_[0]->base;
	$_[0]->{__stack}->[-1]->{path}=~m/^$base(.*)/ ? $1 : '';
}
sub file { $_[0]->{__stack}->[-1]->{file} || ''; }
sub ext { $_[0]->{__stack}->[-1]->{ext} || ''; }
sub name {
	my $x=$_[0]->{__stack}->[-1];
	File::Spec->catfile( $x->{path}, $x->{file} );
}
sub relative_name {
	my $base = $_[1] || $_[0]->base;
	$_[0]->name=~/^$base(.*)/;
	$1;
}
sub index_depth { $_[0]->{__index_depth}; }

# experimental convienence method for reading files automatically based on type.
# should this die silently or should a default handler be implemented?
sub read_file {
	my $self = shift;
	my $file = shift;
	(my $ext) = $file=~/\.([^.]*)$/;
	if ( my $hdlr = $self->{__handlers}->{'read'}->{$ext} ) {
		return $hdlr->($self, $file, @_);
	} elsif ( my $hdlr = $self->{__handlers}->{'read'}->{'*'} ) {
		return $hdlr->($self, $file, @_);
	} else {
		warn "Undefined handler for file extension: $ext";
		return '';
	}
}

1;

__END__