################################################################################
# Copyright (c) 2008 Martin Scharrer <martin@scharrer-online.de>
# 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__
=head1 NAME
SVN::Dumpfile::Node::Headers - Represents the header of a node in a subversion
dumpfile.
=head1 SYNOPSIS
Objects of this class are used in SVN::Dumpfile::Node objects. For normal
dumpfile operations this subclass is an implementation detail. Some scripts
however might need to use methods of the class directly.
use SVN::Dumpfile; # or use SVN::Dumpfile::Node:Content;
$df = new SVN::Dumpfile ("filename");
$node = $df->read_node;
my $header = $node->headers;
$header->{'Node-path'} =~ s/old/new/;
# but should be done using:
$node->header('Node-path') =~ s/old/new/;
=head1 DESCRIPTION, SEE ALSO, AUTHOR, COPYRIGHT
See L<SVN::Dumpfile>.
=head1 METHODS
=over 4
=item new()
Returns a new SVN::Dumpfile::Node::Headers object. Headers line can be given as
hash reference, as array reference or as list. Array and list must be even and
contain key/value pairs like a hash. For internal reasons a single but undefined
argument is ignored. The method returns undef if the number or kind of arguments
are incorrect.
=item number()
Returns the number of header lines. Can be taken as bool to check if there are
any headers.
=item read($filehandle)
Reads header lines from the given filehandle. This lines must be in the format
'Name: value' and must be followed by a blank line. The method croaks when a
miss-formatted line is found.
=item as_string()
=item to_string()
Returns all header lines as one string I<without> the needed blank line
separator which must be added manually.
The header lines are always returned in a pre-defined order, unlike properties.
=item write($filehandle)
Writes all header lines and a blank line as separator to the given filehandle.
The header lines are always written in a pre-defined order, unlike properties.
=item sanitycheck()
Checks the header is consistent, i.e. if the combination of header lines makes
sens. This method is work in progress and might not work at all at the moment.
=back