File Coverage

blib/lib/SVN/Dump/Headers.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	14	14	100.0
condition	5	6	83.3
subroutine	10	10	100.0
pod	6	6	100.0
total	72	73	98.6

package SVN::Dump::Headers;
$SVN::Dump::Headers::VERSION = '0.07';
use strict;
use warnings;
use Carp;
use Scalar::Util qw( reftype );

my $NL = "\012";

sub new {
    my ( $class, $headers ) = @_;
    croak 'First parameter must be a HASH reference'
        if defined $headers
        && !( ref $headers && reftype $headers eq 'HASH' );
    my $self = bless {}, $class;
    $self->set( $_ => $headers->{$_} ) for keys %{ $headers || {} };
    return $self;
}

my %headers = (
    revision => [
        qw(
            Revision-number
            Prop-content-length
            Content-length
            )

    ],
    node => [
        qw(
            Node-path
            Node-kind
            Node-action
            Node-copyfrom-rev
            Node-copyfrom-path
            Prop-delta
            Prop-content-length
            Text-copy-source-md5
            Text-copy-source-sha1
            Text-delta
            Text-content-length
            Text-content-md5
            Text-content-sha1
            Content-length
            )
    ],
    uuid   => ['UUID'],
    format => ['SVN-fs-dump-format-version'],
);

# FIXME Prop-delta and Text-delta in version 3

sub as_string {
    my ($self) = @_;
    my $string = '';

    for my $k ( @{ $headers{ $self->type() } } ) {
        $string .= "$k: $self->{$k}$NL"
            if exists $self->{$k};
    }

    return $string . $NL;
}

sub type {
    my ($self) = @_;

    my $type =
          exists $self->{'Node-path'}                  ? 'node'
        : exists $self->{'Revision-number'}            ? 'revision'
        : exists $self->{'UUID'}                       ? 'uuid'
        : exists $self->{'SVN-fs-dump-format-version'} ? 'format'
        :   croak 'Unable to determine the record type';

    return $type;
}

sub set {
    my ($self, $h, $v) = @_;

    # FIXME shall we check that the header value is valid?
    $h =~ tr/_/-/; # allow _ for - simplification
    return $self->{$h} = $v;
}

sub get {
    my ($self, $h) = @_;
    $h =~ tr/_/-/; # allow _ for - simplification
    return $self->{$h};
}

sub keys {
    my ($self) = @_;
    return grep { exists $self->{$_} } @{ $headers{$self->type()} };
}

1;

__END__