File Coverage

blib/lib/SVN/Dumpfile/Node/Headers.pm

Criterion	Covered	Total	%
statement	60	91	65.9
branch	24	46	52.1
condition	18	48	37.5
subroutine	10	10	100.0
pod	6	6	100.0
total	118	201	58.7

################################################################################
# Copyright (c) 2008 Martin Scharrer
# This is open source software under the GPL v3 or later.
#
# $Id: Headers.pm 103 2008-10-14 21:11:21Z martin $
################################################################################
package SVN::Dumpfile::Node::Headers;
use strict;
use warnings;
use Carp;
use Readonly;
Readonly my $NL => chr(10);

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

my @SVNHEADER = qw(
    Revision-number
    Node-path
    Node-kind
    Node-action
    Node-copyfrom-rev
    Node-copyfrom-path
    Prop-delta
    Prop-content-length
    Text-delta
    Text-content-length
    Text-copy-source-md5
    Text-content-md5
    Content-length
);

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

    if ( @_ == 1 && ref $_[0] eq 'HASH' ) {
        $self = { %{ $_[0] } };
    }
    elsif ( @_ == 1 && ref $_[0] eq 'ARRAY' && @{ $_[0] } % 2 == 0 ) {
        $self = { @{ $_[0] } };
    }
    elsif ( @_ % 2 == 0 ) {
        $self = {@_};
    }
    elsif ( @_ == 1 && !defined $_[0] ) {

        # Ignore single undef value
    }
    else {
        carp "${class}::new() awaits hashref, key/value pairs or an "
            . "arrayref to them as arguments. Ignoring all arguments.";
        return;
    }
    $self = bless $self, $class;
    return $self;
}

sub number {
    my $self = shift;
    scalar keys %$self;
}

sub read {
    my $self = shift;
    my $fh   = shift;

    my $line = eval { $fh->getline };
    return unless defined $line;

    while ( defined $line and $line =~ /^$/ ) {
        $line = $fh->getline;
    }

    # Should be 'Node-path: ' or 'Revision-number: ' now
    if ( $line !~ /^(Node-path|Revision-number): / ) {
        chomp($line);
        croak "No node start found at input file position ", $fh->tell, ".";
    }

    # Read headers
    do {
        if ( $line =~ /^([^:]+):\s*(.*)$/ ) {
            $self->{$1} = $2;
        }
        else {
            chomp $line;
            croak "Error in header at position ", $fh->tell,
                ", input line '$line'";
        }
    } while ( defined( $line = $fh->getline ) && $line !~ /^$/ );

    return 1;
}

sub as_string {
    my $self = shift;
    my $str  = "";

    my %not_printed = map { $_ => 0 } keys %$self;

    # Print in given order
    foreach my $key (@SVNHEADER) {
        next unless exists $self->{$key};
        $str .= "${key}: $self->{$key}$NL";
        delete $not_printed{$key};
    }

    # Print rest if exists
    foreach my $key ( keys %not_printed ) {
        $str .= "${key}: $self->{$key}$NL";
    }
    return $str;
}

*to_string = \&as_string;

sub write {
    my $self = shift;
    my $fh   = shift;

    unless ( eval { $fh->isa('IO::Handle') }
        || ref $fh  eq 'GLOB'
        || ref \$fh eq 'GLOB' )
    {
        croak "Given argument is no valid file handle.";
    }

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

#################
## sanitycheck - Checks if needed Headers exists and belong to each other
#####

sub sanitycheck {
    my $header = shift;
    my $error  = 0;

    # Revision entry needs also 'Prop-content-length' and 'Content-length'
    if ( exists $header->{'Revision-number'} ) {
        if (   !exists $header->{'Prop-content-length'}
            || !exists $header->{'Content-length'} )
        {
            carp "Missing needed header(s) after 'Revision-number'.\n";
            $error++;
        }
    }

    elsif ( !exists $header->{'Node-path'} ) {
        carp "Missing needed header 'Node-path' or 'Revision-number'.";
        return 10_000;
    }

    # Nodes need 'Node-action' at minimum.
    elsif ( !exists $header->{'Node-action'} ) {
        carp "Missing needed header 'Node-action' after 'Node-path'.";
        $error++;
    }
    else    # 'Node-action' exists:
    {
        my $action = $header->{'Node-action'};    # buffer
        if ( $action eq 'delete' ) {
            my $num_headers_expected
                = ( exists $header->{'Node-kind'} ) ? 3 : 2;

            if ( keys %$header != $num_headers_expected ) {
                carp "Two much headers for 'Node-action: delete'.\n";
                local $, = "\n";

                while ( my ( $key, $value ) = each %$header ) {
                    print STDERR "$key: $value\n";
                }
                $error++;
            }
        }
        elsif ( $action eq 'add' or $action eq 'replace' ) {
            if ( !exists $header->{'Node-kind'} ) {
                carp "Missing header 'Node-kind' for 'Node-action: add'.\n";
                $error++;
            }
            elsif ( $header->{'Node-kind'} eq 'file' ) {
                unless (    # This two header both exist
                    (      exists $header->{'Text-content-length'}
                        && exists $header->{'Text-content-md5'}
                        && !(    # and this two both exist or both non-exist
                            exists $header->{
                                'Node-copyfrom-rev'} ^    #\ xor+negation
                            exists $header->{
                                'Node-copyfrom-path'}     #/ = equivalence
                        )
                    )
                    || (    # This two header both exist
                        exists $header->{'Node-copyfrom-rev'}
                        && exists $header->{'Node-copyfrom-path'}
                        && !(    # and this two both exist or both non-exist
                            exists $header->{
                                'Text-content-length'} ^    #\ xor+negation
                            exists $header->{
                                'Text-content-md5'}         #/ = equivalence
                        )
                    )
                    )
                {    # then there is something wrong
                    carp "Missing/wrong header(s) for 'Node-action: add'/"
                        . "'Node-kind: file'.";
                    $error++;
                }
            }
            elsif ( $header->{'Node-kind'} eq 'dir' ) {
                if (   exists $header->{'Text-content-length'}
                    || exists $header->{'Text-content-md5'} )
                {
                    carp "To much header(s) for 'Node-action: add'/'Node-kind:
                    dir'.";
                    $error++;
                }
            }
            else {
                carp "Invalid value '"
                    . $header->{'Node-kind'}
                    . "' for 'Node-kind'.";
                $error++;
            }
        }
        elsif ( $action eq 'change' ) {

        }
        else {

        }
    }    # end of else path of "if ( !exists $header->{'Node-action'} )"

    #print STDERR Data::Dumper->Dump([$header], ['%header']) if $error;
    return $error;
}

1;
__END__