File Coverage

blib/lib/SVN/RaWeb/Light.pm

Criterion	Covered	Total	%
statement	218	218	100.0
branch	48	48	100.0
condition	16	16	100.0
subroutine	44	44	100.0
pod	2	2	100.0
total	328	328	100.0

package SVN::RaWeb::Light;

use strict;
use warnings;

use 5.008;
use vars qw($VERSION);

$VERSION = '0.60003';

use CGI ();
use IO::Scalar;

require SVN::Core;
require SVN::Ra;

use base 'Class::Accessor';

use SVN::RaWeb::Light::Help;

__PACKAGE__->mk_accessors(qw(cgi dir_contents esc_url_suffix path rev_num),
    qw(should_be_dir svn_ra url_suffix));

# Preloaded methods go here.

# We alias _escape() to CGI::escapeHTML().
*_escape = \&CGI::escapeHTML;

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

sub _init
{
    my $self = shift;

    my %args = (@_);

    my $cgi = CGI->new();
    $self->cgi($cgi);

    my $svn_ra =
        SVN::Ra->new(
            'url' => $args{'url'},
        );

    $self->svn_ra($svn_ra);

    my $url_translations = $args{'url_translations'} || [];
    $self->{'url_translations'} = $url_translations;

    return $self;
}

sub _get_user_url_translations
{
    my $self = shift;

    my @transes = $self->cgi()->param('trans_user');

    my @ret;
    for my $i (0 .. $#transes)
    {
        my $elem = $transes[$i];
        push @ret,
            (($elem =~ /^([^:,]*),(.*)$/) ?
                { 'label' => $1, 'url' => $2, } :
                { 'label' => ("UserDef" . ($i+1)), 'url' => $elem, }
            );
    }
    return \@ret;
}

# TODO :
# Create a way for the user to specify one extra url translation of his own.
sub _get_url_translations
{
    my $self = shift;

    my (%args) = (@_);

    my $cgi = $self->cgi();

    my $is_list_item = $args{'is_list_item'};

    if ($is_list_item && $cgi->param('trans_no_list'))
    {
        return [];
    }

    return [
        ($cgi->param('trans_hide_all') ?
            () :
            (@{$self->{'url_translations'}})
        ),
        @{$self->_get_user_url_translations()},
    ];
}

sub _get_mode
{
    my $self = shift;

    my $mode = $self->cgi()->param("mode");

    return (defined($mode) ? $mode : "view");
}

# This function must be called before rev_num() and url_suffix() are valid.
sub _calc_rev_num
{
    my $self = shift;

    my $rev_param = $self->cgi()->param('rev');

    my ($rev_num, $url_suffix);

    # If a revision is specified - get the tree out of it, and persist with
    # it throughout the browsing session. Otherwise, get the latest revision.
    if (defined($rev_param))
    {
        $rev_num = abs(int($rev_param));
    }
    else
    {
        $rev_num = $self->svn_ra()->get_latest_revnum();
    }

    $self->rev_num($rev_num);
    $self->url_suffix($self->_get_url_suffix_with_extras());
    $self->esc_url_suffix(_escape($self->url_suffix()));
}

# Gets the URL suffix calculated with optional extra components.
sub _get_url_suffix_with_extras
{
    my $self = shift;
    my $components = shift;

    my $query_string = $self->cgi->query_string();
    if ($query_string eq "")
    {
        if (defined($components))
        {
            return "?" . $components;
        }
        else
        {
            return "";
        }
    }
    else
    {
        if (defined($components))
        {
            return "?" . $query_string . ";" . $components;
        }
        else
        {
            return "?" . $query_string;
        }
    }
}

sub _calc_path
{
    my $self = shift;

    my $path = $self->cgi()->path_info();
    if ($path eq "")
    {
        die +{
            'callback' =>
            sub {
                $self->cgi()->script_name() =~ m{([^/]+)$};
                print $self->cgi()->redirect("./$1/");
            },
        };
    }
    if ($path =~ /\/\//)
    {
        die +{ 'callback' => sub { $self->_multi_slashes(); } };
    }

    $path =~ s!^/!!;

    $self->should_be_dir(($path eq "") || ($path =~ s{/$}{}));
    $self->path($path);
}

sub _get_correct_node_kind
{
    my $self = shift;
    return $self->should_be_dir() ? $SVN::Node::dir : $SVN::Node::file;
}

sub _get_escaped_path
{
    my $self = shift;
    return _escape($self->path());
}

sub _check_node_kind
{
    my $self = shift;
    my $node_kind = shift;

    if (($node_kind eq $SVN::Node::none) || ($node_kind eq $SVN::Node::unknown))
    {
        die +{
            'callback' =>
                sub {
                    print $self->cgi()->header();
                    print "Does not exist!";
                    print "Does not exist!";
                },
        };
    }
    elsif ($node_kind ne $self->_get_correct_node_kind())
    {
        die +{
            'callback' =>
                sub {
                    $self->path() =~ m{([^/]+)$};
                    print $self->cgi()->redirect(
                        ($node_kind eq $SVN::Node::dir) ?
                            "./$1/" :
                            "../$1"
                        );
                },
        };
    }
}

sub _get_esc_item_url_translations
{
    my $self = shift;

    if (!exists($self->{'escaped_item_url_translations'}))
    {
        $self->{'escaped_item_url_translations'} =
        [
        (
            map {
            +{
                'url' => _escape($_->{'url'}),
                'label' => _escape($_->{'label'}),
            }
            }
            @{$self->_get_url_translations('is_list_item' => 1)}
        )
        ];
    }
    return $self->{'escaped_item_url_translations'};
}

sub _render_list_item
{
    my ($self, $args) = (@_);

    return
        qq(
268
        qq(@{[$self->esc_url_suffix()]}">$args->{label}) .
        join("",
        map
        {
            " [{url}$args->{path_in_repos}\">$_->{label}]"
        }
        @{$self->_get_esc_item_url_translations()}
        ) .
        "\n";
}

sub _get_esc_up_path
{
    my $self = shift;

    $self->path() =~ /^(.*?)[^\/]+$/;

    return _escape($1);
}

sub _real_render_up_list_item
{
    my $self = shift;
    return $self->_render_list_item(
        {
            'link' => "../",
            'label' => "..",
            'path_in_repos' => $self->_get_esc_up_path(),
        }
    );
}

# The purpose of this function ios to get the list item of the ".." directory
# that goes one level up in the repository.
sub _render_up_list_item
{
    my $self = shift;
    # If the path is the root - then we cannot have an upper directory
    if ($self->path() eq "")
    {
        return ();
    }
    else
    {
        return $self->_real_render_up_list_item();
    }
}

# This method gets the escaped path along with a potential trailing slash
# (if it isn't empty)
sub _get_normalized_path
{
    my $self = shift;

    my $url = $self->path();
    if ($url ne "")
    {
        $url .= "/";
    }
    return $url;
}

sub _render_regular_list_item
{
    my ($self, $entry) = @_;

    my $escaped_name = _escape($entry);
    if ($self->dir_contents->{$entry}->kind() eq $SVN::Node::dir)
    {
        $escaped_name .= "/";
    }

    return $self->_render_list_item(
        {
            (map { $_ => $escaped_name } qw(link label)),
            'path_in_repos' =>
                (_escape($self->_get_normalized_path()).$escaped_name),
        }
    );
}

sub _render_top_url_translations_text
{
    my $self = shift;

    my $top_url_translations =
        $self->_get_url_translations('is_list_item' => 0);
    my $ret = "";
    if (@$top_url_translations)
    {
        $ret .= "\n"; \n"; 




359




5





 





 





 





 





8



         foreach my $trans (@$top_url_translations) 




360




 





 





 





 





 





 



         { 




361




8





 





 





 





 





19



             my $url = $self->_get_normalized_path(); 




362




8





 





 





 





 





26



             my $escaped_url = _escape($trans->{'url'} . $url); 




363




8





 





 





 





 





66



             my $escaped_label = _escape($trans->{'label'}); 




364




8





 





 





 





 





64



             $ret .= "$escaped_label




365




 





 





 





 





 





 



         } 




366




5





 





 





 





 





11



         $ret .= "\n";
        foreach my $trans (@$top_url_translations)
        {
            my $url = $self->_get_normalized_path();
            my $escaped_url = _escape($trans->{'url'} . $url);
            my $escaped_label = _escape($trans->{'label'});
            $ret .= "
        }
        $ret .= "
    }
    return $ret;
}

sub _render_dir_header
{
    my $self = shift;

    my $title = "Revision ". $self->rev_num() . ": /" .
        $self->_get_escaped_path();
    my $ret = "";
    $ret .= $self->cgi()->header();
    $ret .= "$title\n";
    $ret .= "\n";
    $ret .="$title\n";

    return $ret;
}

sub _get_items_list_items_order
{
    my $self = shift;
    return [ sort { $a cmp $b } keys(%{$self->dir_contents()}) ];
}

sub _get_items_list_regular_items
{
    my $self = shift;
    return
        [map
        {
            $self->_render_regular_list_item($_)
        }
        (@{$self->_get_items_list_items_order()})
        ];
}

sub _get_items_list_items
{
    my $self = shift;
    return
    [
        $self->_render_up_list_item(),
        @{$self->_get_items_list_regular_items()},
    ];
}

sub _print_items_list
{
    my ($self) = @_;
    print "\n";

    print @{$self->_get_items_list_items()};
    print "\n";
}

sub _print_control_section
{
    my $self = shift;
    print "\n" .
        "Show Help Screen\n" .
        "_get_url_suffix_with_extras("panel=1")) . "\">Show Control Panel\n" .
        "\n";
}

sub _get_dir
{
    my $self = shift;

    my ($dir_contents, $fetched_rev) =
        $self->svn_ra()->get_dir($self->path(), $self->rev_num());
    $self->dir_contents($dir_contents);
}

sub _process_dir
{
    my $self = shift;
    $self->_get_dir();
    print $self->_render_dir_header();
    print $self->_render_top_url_translations_text();
    $self->_print_items_list();
    $self->_print_control_section();
    print "\n";
}

sub _process_file
{
    my $self = shift;

    my $buffer = "";
    my $fh = IO::Scalar->new(\$buffer);
    my ($fetched_rev, $props)
        = $self->svn_ra()->get_file($self->path(), $self->rev_num(), $fh);
    print $self->cgi()->header(
        -type => ($props->{'svn:mime-type'} || 'text/plain')
        );
    print $buffer;
}

sub _process_help
{
    my $self = shift;

    print $self->cgi()->header();
    SVN::RaWeb::Light::Help::print_data();
}

sub _real_run
{
    my $self = shift;
    my $cgi = $self->cgi();

    if ($self->_get_mode() eq "help")
    {
        return $self->_process_help();
    }
    if ($cgi->param("panel"))
    {
        print $cgi->header();
        print <<"EOF";
Not Implemented Yet
Sorry but the control panel is not implemented yet.


EOF
        return 0;
    }

    $self->_calc_rev_num();
    $self->_calc_path();

    my $node_kind =
        $self->svn_ra()->check_path($self->path(), $self->rev_num());

    $self->_check_node_kind($node_kind);

    if ($node_kind eq $SVN::Node::dir)
    {
        return $self->_process_dir();
    }
    # This means $node_kind eq $SVN::Node::file
    else
    {
        return $self->_process_file();
    }
}

sub run
{
    my $self = shift;

    my @ret;
    eval {
        @ret = $self->_real_run();
    };

    if ($@)
    {
        if ((ref($@) eq "HASH") && (exists($@->{'callback'})))
        {
            return $@->{'callback'}->();
        }
        else
        {
            die $@;
        }
    }
    else
    {
        return @ret;
    }
}

sub _multi_slashes
{
    my $self = shift;
    print $self->cgi()->header();
    print "Wrong URL!";
    print "Wrong URL - Multiple Adjacent Slashes (//) in the URL." .
        "";
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;


__END__