File Coverage

blib/lib/SVN/Dumpfile.pm

Criterion	Covered	Total	%
statement	147	158	93.0
branch	64	76	84.2
condition	22	24	91.6
subroutine	27	27	100.0
pod	12	12	100.0
total	272	297	91.5

################################################################################
# Copyright (c) 2008 Martin Scharrer
# This is open source software under the GPL v3 or later.
#
# $Id: Dumpfile.pm 107 2009-04-23 11:45:00Z martin $
################################################################################
package SVN::Dumpfile;
use strict;
use warnings;
use SVN::Dumpfile::Node;
use IO::File;
use Carp;
use Readonly;
Readonly my $NL => chr(10);

our $VERSION = do { '$Rev: 107 $' =~ /\$Rev: (\d+) \$/; '0.13' . ".$1" };


sub new {
    my $arg = shift;
    my $class = ref $arg ? ref $arg : $arg;

    my $self = bless {}, $class;
    return $self->_process_arguments(@_);
}

sub _process_arguments {
    my $self = shift;
    my @args;
    if ( @_ == 1 ) {
        if ( ref $_[0] eq 'HASH' ) {
            @args = %{ $_[0] };
        }
        elsif ( ref $_[0] eq 'ARRAY' ) {
            @args = @{ $_[0] };
        }
        elsif ( my $h = __PACKAGE__->_is_valid_fh( $_[0] ) ) {
            $self->{fh} = $h;
            @args = ();
        }
        elsif ( !ref $_[0] ) {
            $self->{file} = $_[0];
            @args = ();
        }
        else {
            carp "Single argument must be either a hash ref or a filename!";
            return undef;
        }
    }
    else {
        @args = @_;
    }
    croak "Final number of arguments not even"
        if @args % 2;

    %$self = ( %$self, @args );

    if ( exists $self->{version} ) {
        $self->{'SVN-fs-dump-format-version'} = $self->{version};
        delete $self->{version};
    }

    return $self;
}

sub dump {
    require Data::Dumper;
    my $self = shift;
    print STDERR Data::Dumper->Dump( [ \$self ], ['*self'] );
}

sub uuid : lvalue {
    my ( $self, $uuid ) = @_;
    $self->{'UUID'} = $uuid
        if defined $uuid;
    $self->{'UUID'};
}

sub version : lvalue {
    my ( $self, $version ) = @_;
    $self->{'SVN-fs-dump-format-version'} = $version
        if defined $version;
    $self->{'SVN-fs-dump-format-version'};
}

sub read_node {
    my $self = shift;
    my $node = SVN::Dumpfile::Node->new;
    return unless $self->{fh};
    $node = undef unless $node->read( $self->{fh} );

    return $node;
}
*get_node  = \&read_node;
*next_node = \&read_node;

sub write_node {
    my $self = shift;
    my $node = shift;

    return if not defined $node;

    return $node->write( $self->{fh} );
}

sub create {
    my $self = shift;
    if ( ref $self ) {
        return unless $self->_process_arguments(@_);
    }
    else {
        $self = $self->new(@_);
    }

    my $fh   = $self->{fh};
    my $file = $self->{file};
    if ( defined $fh ) {
        eval { $fh->binmode };
    }
    elsif ( defined $file ) {
        $self->{fh} = $fh = new IO::File;
        $fh->open( $file, '>' ) or croak "Couldn't create file.";
    }
    else {
        croak __PACKAGE__ . '::create() needs file name or handle.';
    }

    $fh->print( $self->as_string );
    return $self;
}

sub as_string {
    my $self   = shift;
    my $string = '';

    no warnings 'uninitialized';
    $self->{'SVN-fs-dump-format-version'} = 2
        if ( $self->{'SVN-fs-dump-format-version'} < 1 );

    $string
        = "SVN-fs-dump-format-version: "
        . $self->{'SVN-fs-dump-format-version'}
        . $NL x 2;

    if ( $self->{'SVN-fs-dump-format-version'} > 1 ) {
        if ( $self->{'UUID'} eq '' ) {
            $self->{'UUID'} = eval {

                # Use Data::GUID if available
                require Data::GUID;
                lc ( Data::GUID->new->as_string );
            } || eval {

                # Use Data::UUID if available
                require Data::UUID;
                my $ug       = new Data::UUID;
                my $uuid_bin = $ug->create();
                lc( $ug->to_string($uuid_bin) );
            } || do {
                my @r;

                # Otherwise just generate a random UUID
                push( @r, rand( 2**16 - 1 ) ) for ( 1 .. 9 );
                sprintf( "%04x%04x-%04x-%04x-%04x-%04x%04x%04x", @r );
            }
        }

        $string .= "UUID: $self->{UUID}" . $NL x 2;
    }

    return $string;
}
*to_string = \&as_string;

sub copy {
    my $self = shift;
    my $new  = $self->new();
    foreach my $key (qw(SVN-fs-dump-format-version UUID)) {
        $new->{$key} = $self->{$key};
    }
    return $new;
}

sub DESTROY {
    shift->close;
}

sub close {
    my $self = shift;
    $self->{fh}->close
        if defined $self->{fh};
}

sub version_supported {
    my $self    = shift;
    my $version = shift;
    if ( ref $self and not defined $version ) {
        $version = $self->{'SVN-fs-dump-format-version'};
    }

    return unless defined $version;

    # Versions 1 - 3 are supported
    return ( $version >= 1 && $version <= 3 );
}

sub _is_valid_fh {
    my $self = shift;
    my $h    = shift;
    return if not defined $h;
    return $h if eval { $h->isa('IO::Handle') };
    no strict 'refs';
    return *$h{IO}
        if ref $h eq 'GLOB'
            or ref \$h eq 'GLOB'
            or $h      eq 'STDIN'
            or $h      eq 'STDOUT';
    return;
}

sub _is_stdin {
    no warnings 'uninitialized';
    my $self = shift;
    my $file = shift;
    return ( $file eq '' or $file eq '-' or $file eq 'STDIN' );
}

sub _is_stdout {
    no warnings 'uninitialized';
    my $self = shift;
    my $file = shift;
    return ( $file eq '' or $file eq '-' or $file eq 'STDOUT' );
}

sub open {
    my $self = shift;
    if ( ref $self ) {
        return unless $self->_process_arguments(@_);
    }
    else {
        $self = $self->new(@_);
    }
    my $fh   = $self->{fh};
    my $file = $self->{file};
    if ( defined $fh ) {
        eval { $fh->binmode };
    }
    elsif ( defined $file ) {
        $self->{fh} = $fh = new IO::File;
        if ( !$fh->open( $file, '<' ) ) {
            carp "Couldn't open dumpfile.";
            return;
        }
    }
    else {
        croak __PACKAGE__ . '::open() needs file name or handle.';
    }

    my $irs  = IO::Handle->input_record_separator($NL);
    my $line = $fh->getline;
    if ( $line =~ /^SVN-fs-dump-format-version: (\d+)$/ ) {
        $self->{'SVN-fs-dump-format-version'} = $1;
        if ( !$self->version_supported ) {
            carp "Warning: Found dump format version ",
                $self->{'SVN-fs-dump-format-version'},
                " is not supported (yet).\n",
                "Unknown entries will be ignored. Use at your own risk.\n";
        }
    }
    else {
        carp "Error: Dumpfile looks invalid. Couldn't find valid ",
            "'SVN-fs-dump-format-version' header.\n";
    }

    if ( $self->{'SVN-fs-dump-format-version'} > 1 ) {
        my $char;
        while ( ( $char = $fh->getc ) eq "\012" ) { }
        if ( $char eq 'U' ) {
            $line = $char . $fh->getline;
            if ( $line =~ /^UUID: (.*)$/ ) {
                $self->{'UUID'} = $1;

                # read blank line after UUID:
                $char = $fh->getc;
                $fh->ungetc( ord $char ) if ( $char ne "\012" );
            }
            else {
                carp "Error: Dumpfile looks invalid. Couldn't find valid ",
                "'UUID' header.\n";
            }
        }
        else {
            carp "Error: Dumpfile looks invalid. Couldn't find valid ",
            "'UUID' header.\n";
            $fh->ungetc( ord $char );
        }
    }

    IO::Handle->input_record_separator($irs);
    return $self;
}

1;
__END__