File Coverage

blib/lib/CGI/Widget/Path.pm

Criterion	Covered	Total	%
statement	23	68	33.8
branch	8	28	28.5
condition	4	22	18.1
subroutine	4	7	57.1
pod	5	5	100.0
total	44	130	33.8

package CGI::Widget::Path;

require 5.005;
use strict;
use vars qw($VERSION);

$VERSION = '0.01';

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = ($#_ == 0) ? shift : { @_ };
	$self->{'separator'} = '>' unless defined $self->{'separator'};
	$self->{'link_last'} = 0 unless ( defined $self->{'link_last'} and $self->{'link_last'} =~ /^(0|1)$/ );
	$self->{'link'} = 1 unless ( defined $self->{'link'} and $self->{'link'} =~ /^(0|1)$/ );
	bless $self,$class;
	if ( $self->{'path'} ) {
		eval { require File::Spec};
		foreach ( File::Spec->splitdir($self->{'path'}) ) {
			$self->addElem( elems => [
				{ name => $_, wrap => [ { tag => 'a', attr => { 'href' => "$_/" } } ], append => 1 },
				] );
		}
		$self->{elems}->[0]->{'name'} ||= 'root';
	}
	return $self;
}

sub asHTML {
	my ($self,%args) = @_;
	my $str;
	my $tree_path = "$self->{'base_url'}" if $self->{'base_url'};

	for (my $i = 0; $i <= $#{@{$self->{'elems'}}}; $i++)	{
		#next if ( ! exists ${@{$self->{'elems'}}}[$i]{'name'} or ${@{$self->{'elems'}}}[$i]{'name'} eq '' ) ;
		next unless ( exists ${@{$self->{'elems'}}}[$i]{'name'} and ${@{$self->{'elems'}}}[$i]{'name'} ne '' ) ;
		my $element = ${@{$self->{'elems'}}}[$i]{'name'};
		$str .= $self->{'separator'} if $i > 0;
		foreach my $wrap( @{${@{$self->{'elems'}}}[$i]{'wrap'}} ) {
			unless ( $wrap->{'tag'} =~ /^a$/i and ( ($i == $#{@{$self->{'elems'}}} and ! $self->{'link_last'}) || ! $self->{'link'} ) ) {
				$element = '<' . $wrap->{'tag'} . ($wrap->{'attr'} ? ' ' . join ' ', map {"$_=\"" . ($_ =~ /^href$/i ? (${@{$self->{'elems'}}}[$i]{'append'} ? ($tree_path .= $wrap->{'attr'}{$_}) : "$self->{'base_url'}$wrap->{'attr'}{$_}") : "$wrap->{'attr'}{$_}") . '"'} keys %{$wrap->{'attr'}} : '' ) . '>' . $element . '{'tag'} . '>';
			}
		}
		$str .= $element;
	}
	$self->{'out'} = $str;
	return $self->{'out'};
}

sub addElem {
	my ($self,%args) = @_;
	$args{'position'} = ($#{@{$self->{'elems'}}} + 1) if ! defined $args{'position'};
	splice(@{$self->{'elems'}}, $args{'position'}, 0, @{$args{'elems'}});
	return scalar @{$self->{'elems'}};
}

sub deleteElem {
	my ($self,%args) = @_;
	$args{'position'} = $#{@{$self->{'elems'}}} if ! defined $args{'position'};
	$args{'lenght'} ||= 1;
	splice(@{$self->{'elems'}}, $args{'position'}, $args{'lenght'});
	return scalar @{$self->{'elems'}};
}

sub errstr {
	my $self = shift;
	$self->{'errstr'};
}

1;

__END__