~allison/ubuntu/raring/libsvn-web-perl/fix-for-1106378

use strict;

use warnings;

 

our $VERSION = 0.63;

 

use Encode;

use File::Temp ();

use POSIX ();

use Time::Zone ();

An instance of a CGI compatible object corresponding to the current request.  This is normally an object from either the L<CGI> or L<CGI::Fast> modules, although it is possible to specify another class with the C<cgi_class> directive in

F<config.yaml>. Since we now use Plack, this is a L<Plack::Request> object.

    my ($self, $path, $rev) = @_;

 

    my $ra = $self->{repos}{ra};

 

    $ra->get_log( [ Encode::encode('utf8',$self->rpath($path)) ], $rev, 1, 1, 0, 1, sub { @log_result = @_; } );

    return $log_result[1];    # Revision number

    my $act_rev =

      defined $exp_rev

      ? $self->recent_interesting_rev( $path, $exp_rev )

      : $self->recent_interesting_rev( $path, $yng_rev );

    if ( !defined $exp_rev or $exp_rev eq '' ) {

        $at_head = 1;

    }

    else {

        if ( $exp_rev == $yng_rev ) {

            $at_head = 1;

        }

    }

    return ( $exp_rev, $yng_rev, $act_rev, $at_head );

my $tz_offset = undef;    # Cache the timezone offset

    my (@time) = $cstring =~ /^(....)-(..)-(..)T(..):(..):(..)/;

 

    my $time =

      timegm_nocheck( $time[5], $time[4], $time[3], $time[2], $time[1] - 1,

        $time[0] );

 

    if ( $self->{config}->{timezone} eq 'local' ) {

        return POSIX::strftime( $self->{config}->{timedate_format},

            localtime($time) );

    }

 

    if ( ( not defined $tz_offset ) and ( $self->{config}->{timezone} ne '' ) )

    {

        $tz_offset = Time::Zone::tz_offset( $self->{config}->{timezone} );

        $time += $tz_offset;

    }

 

    return POSIX::strftime( $self->{config}->{timedate_format}, gmtime($time) );

Copyright 2012 by Dean Hamstead C<< <dean@fragfest.com.au> >>.

 

sub rpath {

    my ( $self, $p ) = @_;

    my $path = $p || $self->{path};

    $path =~ s{^/}{} if $path;

    return $path

}

 

sub svn_get_node_kind {

    my ($self, $uri, $peg_revision, $revision, $pool) = @_;

 

    my $node_kind;

 

    my @args = ($self->encode_svn_uri($uri), $peg_revision, $revision, sub { $node_kind = $_[1]->kind() }, 0);

    push @args, $pool if $pool;

    $self->{repos}{client}->info(@args);

 

    return $node_kind;

}

 

sub svn_get_diff {

    my ($self, $target1, $rev1, $target2, $rev2, $recursive, $pool) = @_;

 

    my ( $out_h, $out_fn ) = File::Temp::tempfile();

    my ( $err_h, $err_fn ) = File::Temp::tempfile();

 

    my @args = ([], $self->encode_svn_uri($target1), $rev1, $self->encode_svn_uri($target2), $rev2, $recursive, 1, 0, $out_h, $err_h);

    push @args, $pool if $pool;

    $self->{repos}{client}->diff(@args);

 

    my $out;

    local $/ = undef;

    seek($out_h, 0, 0);

    $out = <$out_h>;

    unlink( $out_fn ); unlink( $err_fn );

    close( $out_h ); close( $err_h );

 

    return $out;

}

 

sub ctx_ls {

    my ($self, $uri) = splice(@_, 0, 2);

    return $self->{repos}{client}->ls( $self->encode_svn_uri($uri), @_ );

}

 

sub ctx_revprop_get {

    my ($self, $prop_name, $uri, $rev) = splice(@_, 0, 4);

    return $self->{repos}{client}->revprop_get( $prop_name, $self->encode_svn_uri($uri), $rev, @_ );

}

 

sub ctx_propget {

    my ($self, $prop_name, $uri, $rev, $recursive) = splice(@_, 0, 5);

    return $self->{repos}{client}->propget( $prop_name, $self->encode_svn_uri($uri), $rev, $recursive, @_ );

}

 

sub ctx_cat {

    my ($self, $fh, $uri, $rev) = splice(@_, 0, 4);

    return $self->{repos}{client}->cat( $fh, $self->encode_svn_uri($uri), $rev, @_ );

}

 

sub ctx_blame {

    my ($self, $uri, $start_rev, $end_rev, $cb) = splice(@_, 0, 5);

    return $self->{repos}{client}->blame( $self->encode_svn_uri($uri), $start_rev, $end_rev, $cb, @_ );

}

 

sub encode_svn_uri {

    my $uri = Encode::encode('utf8', $_[1]);

    # same as in svn_path_uri_encode (see subversion/libsvn_subr/path.c)

    $uri =~ s#([^\-\!\$\&\'\(\)\*\+\,\.\/\:\=\@\~\_0-9A-Za-z])#sprintf("%%%02X",ord($1))#eg;

    return $uri;

}

 

sub decode_svn_uri {

    my ($self, $uri) = @_;

    $uri =~ s#%([0-9A-Fa-f]{2})#chr(hex($1))#eg;

    return Encode::decode('utf8', $uri);

}