/usr/local/CPAN/Zobel/LiveGeez/URI.pm

• package LiveGeez::URI
  • new
  • _set_dir_file
  • dir
  • dir_clean
  • file
  • file_clean
  • file_base
  • ext
  • scheme_authority
  • doc_root
  • iscgi
  • DESTROY
  • AUTOLOAD
• __END__
• EOF

package LiveGeez::URI;


BEGIN
{
	use strict;
	use vars qw($VERSION);

	$VERSION = '0.20';

	use URI;
	$URI::ABS_REMOTE_LEADING_DOTS = 1;
}


sub new
{
my $class = shift;
my $self = {};

	my $blessing = bless $self, $class;

	$self->{_uri} = new URI ( @_ );

	$self->{last_path}  = undef;
	$self->{file}       = undef;
	$self->{file_clean} = undef;
	$self->{dir}        = undef;
	$self->{dir_clean}  = undef;
	$self->{ext}        = undef;

	$blessing;
}



sub _set_dir_file
{
my ($self, $path) = @_;

	$path .= "/" unless ( ($path  =~ /\.(\w+)$/o) || ($path =~ /\/$/o) );
	$path =~ s|/+|/|g;
	my ($file, $dir) = split ( m#/#, reverse($path), 2 );
	$dir  = reverse($dir);
	$file = reverse($file);
	if ( ("/$file" eq $path) && $file !~ /\./ ) {
		$self->{dir}  = $path;
		$self->{file} = "";
	}
	else {
		$self->{dir}  = $dir;
		$self->{file} = $file;
	}
	$dir =~ s|/$||;
	$self->{last_path} = $path;
}



sub dir
{
my $self = shift;

	if ( @_ ) {
		$self->{dir} = shift;
	}
	elsif ( (my $path = $self->{_uri}->path) ne $self->{last_path} ) {
		$self->_set_dir_file ( $path );
	}

	$self->{dir};
}


sub dir_clean
{
my $self = shift;

	if ( @_ ) {
		$self->{dir_clean} = shift;
	}
	else {
		$self->{dir_clean} = $self->dir;
		$self->{dir_clean} =~ s/[ ()]/_/g;
	}

	$self->{dir_clean};
}


sub file
{
my $self = shift;

	if ( @_ ) {
		$self->{file} = shift;
	}
	elsif ( (my $path = $self->{_uri}->path) ne $self->{last_path} ) {
		$self->_set_dir_file ( $path );
	}

	$self->{file};

}


sub file_clean
{
my $self = shift;

	if ( @_ ) {
		$self->{file_clean} = shift;
	}
	else {
		$self->{file_clean} = $self->file;
		$self->{file_clean} =~ s/[ ()]/_/g;
	}

	$self->{file_clean};
}


sub file_base
{
my $self = shift;

	if ( @_ ) {
		$self->{file_base} = shift;
	}
	else {
		my $file = $self->file_clean;
		my $ext = $self->ext;
		$file =~ s/\.$ext$// if ( $ext );
		$self->{file_base} = $file;
	}

	$self->{file_base};
}


sub ext
{
my $self = shift;

	if ( @_ ) {
		$self->{ext} = shift;
	}
	elsif ( $self->{file} ) {
		($self->{ext}) = ( $self->{file} =~ /([^.]+)$/ );
	}

	$self->{ext};

}


sub scheme_authority
{
my $self = shift;

	if ( @_ ) {
		$self->{scheme_authority} = shift;
	}
	else {
		$self->{scheme_authority} = $self->{_uri}->scheme . "://" . $self->{_uri}->authority ;
	}

	$self->{scheme_authority};
}


sub doc_root
{
my $self = shift;

	if ( @_ ) {
		$self->{doc_root} = shift;
	}
	else {
		$self->{doc_root} = $self->scheme_authority . $self->dir_clean;
	}

	$self->{doc_root};
}



sub iscgi
{
my $self = shift;

	if ( @_ ) {
		$self->{iscgi} = shift;
	}
	else {
		$self->{iscgi} = ( $self->query || $self->path =~ /cgi/ || ($self->ext =~ /(pl)|(cgi)/i) ) ? 1 : 0 ;
	}

	$self->{iscgi};
}


sub DESTROY
{
1;
}


sub AUTOLOAD
{
	my($self) = shift;
	# my($arg) = shift;
	my($method) = ($AUTOLOAD =~ /::([^:]+)$/);
	return unless ($method);

	$self->{_uri}->$method ( @_ );
}

1;

__END__