File Coverage

blib/lib/MARC/Spec/Structure.pm

Criterion	Covered	Total	%
statement	89	96	92.7
branch	41	48	85.4
condition	6	9	66.6
subroutine	13	14	92.8
pod	2	5	40.0
total	151	172	87.7

package MARC::Spec::Structure;

use Moo;
use Const::Fast;
use Carp qw(croak);
use namespace::clean;

our $VERSION = '1.0.0';

const my $NO_LENGTH => -1;
const my $LAST => '#';

has base => (
    is      => 'rwp',
    lazy    => 1,
    builder => '_base'
);

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

    my $base = ($self->can('tag')) ? $self->tag : '$'.$self->code;

    $base .= '['.$self->index_start;
    if($self->index_start ne $self->index_end) { $base .= '-'.$self->index_end }
    $base .= ']';

    if(defined $self->char_start) {
        my $char_start = $self->char_start;
        my $char_end   = $self->char_end;
        unless($char_start eq '0' && $char_end eq '#') {
            $base .= '/'.$char_start;
            if($char_end ne $char_start) { $base .= '-'.$char_end }
        }
    }
    if($self->can('indicator1')) {
        my $indicators = (defined $self->indicator1) ? $self->indicator1 : '_';
        $indicators   .= (defined $self->indicator2) ? $self->indicator2 : '';
        if($indicators ne '_') { $base .= '_'.$indicators }
    }

    return $base;
}


has index_start => (
    is      => 'rw',
    default => sub {0},
    trigger => sub {
        my ($self, $index_start) = @_;
        if ($LAST ne $self->index_end && $LAST ne $index_start && $self->index_end < $index_start) {
            $self->index_end($index_start);
        } else {
            $self->_set_base( $self->_base() );
        }
        $self->_set_index_length( _calculate_length($index_start, $self->index_end) )
    }
);

has index_end => (
    is      => 'rw',
    default => sub {$LAST},
    trigger => sub {
        my ($self, $index_end) = @_;
        if ($LAST ne $self->index_start && $LAST ne $index_end && $self->index_start > $index_end) {
            $self->index_start($index_end);
        } else {
            $self->_set_base( $self->_base() );
        }
        $self->_set_index_length( _calculate_length($self->index_start, $index_end) )
    }
);

has index_length => (
    is      => 'rwp',
    default => sub {$NO_LENGTH}
);

has char_start => (
    is      => 'rw',
    trigger => sub {
        my ($self, $char_start) = @_;
        if(!defined $self->char_end) { $self->char_end($char_start) }
        $self->_set_char_pos($self->char_start.'-'.$self->char_end);
        $self->_set_char_length( _calculate_length($char_start, $self->char_end) );
        $self->_set_base( $self->_base() )
    },
    predicate => 1
);

has char_end => (
    is      => 'rw',
    trigger => sub {
        my ($self, $char_end) = @_;
        if(!defined $self->char_start) { $self->char_start($char_end) }
        $self->_set_char_pos($self->char_start.'-'.$self->char_end);
        $self->_set_char_length( _calculate_length($self->char_start, $char_end) );
        $self->_set_base( $self->_base() )
    },
    predicate => 1
);

has char_pos => (
    is => 'rwp',
    predicate => 1
);

has char_length => (
    is      => 'rwp',
    lazy    => 1,
    builder => sub {
        my ($self) = @_;
        return _calculate_length($self->char_start, $self->char_end)
    }
);

has subspecs => (
    is  => 'rwp',
    isa => sub {
        foreach my $and (@{$_[0]}) {
            if(ref $and eq 'ARRAY') {
                foreach my $or (@{$and}) {
                    croak('Subspec is not an instance of MARC::Spec::Subspec.')
                        if(ref $or ne 'MARC::Spec::Subspec')
                }
            } else {
                croak('Subspec is not an instance of MARC::Spec::Subspec.')
                    if(ref $and ne 'MARC::Spec::Subspec')
            }
        }
    },
    predicate => 1
);

sub set_index_start_end {
    my ($self, $indizes) = @_;
    my @pos = _validate_pos($indizes);
    $self->index_start($pos[0]);
    defined $pos[1] ? $self->index_end($pos[1]) : $self->index_end($pos[0])
}

sub set_char_start_end {
    my ($self, $charpos) = @_;
    my @pos = _validate_pos($charpos);
    $self->char_start($pos[0]);
    defined $pos[1] ? $self->char_end($pos[1]) : $self->char_end($pos[0])
}

sub add_subspec {
    my ($self, $subspec) = @_;
    if(!$self->has_subspecs) {
        $self->_set_subspecs([$subspec]);
    } else {
        my @subspecs = ( @{$self->subspecs}, $subspec );
        $self->_set_subspecs( \@subspecs )
    }
}

sub add_subspecs {
    my ($self, $subspecs) = @_;
    if (ref $subspecs ne 'ARRAY') {
        croak('Subspecs is not an ARRAYRef!')
    }
    if(!$self->has_subspecs) {
        $self->_set_subspecs($subspecs)
    } else {
        my @merged = @{$self->subspecs};
        push @merged, @{$subspecs};
        $self->_set_subspecs( \@merged )
    }
}

sub to_string {
    my ($self) = @_;
    my $string = $self->base;
    if($self->has_subspecs) {
        my @outer = ();
        foreach my $ss (@{$self->subspecs}) {
            if(ref $ss eq 'ARRAY') {
                my $inner = join '|', map {$_->to_string()} @{$ss};
                push @outer, $inner;
            } else {
                push @outer, $ss->to_string();
            }
        }
        my $joined = join '}{', @outer;
        $string .= '{'. $joined .'}';
    }
    return $string;
}

sub _calculate_length {
    my ($start, $end) = @_;

    # start eq end
    if ($start eq $end) { return 1 }

    # start = #, end != #
    if($LAST eq $start && $LAST ne $end) { return $end + 1 }

    # start != #, end = #
    if($LAST ne $start && $LAST eq $end) { return $NO_LENGTH }

    my $length = $end - $start + 1;

    if(1 > $length) {
        _throw("Ending character or index position must be equal or higher than starting character or index position.", "$start-$end");
    }

    return $length;
}

sub _validate_pos {
    my ($charpos) = @_;

    if($charpos =~ /[^0-9\-#]/s) {
        _throw("Assuming index or character position or range. Only digits, the character '#' and one '-' is allowed.", $charpos);
    }

    # something like 123- is not valid
    if('-' eq substr $charpos, -1) {
        _throw("Assuming index or character range. At least two digits or the character '#' must be present." ,$charpos);
    }

    # something like -123 is not valid
    if('-' eq substr $charpos, 0, 1) {
        _throw("Assuming index or character position or range. First character must not be '-'.", $charpos);
    }

    my @pos = split /\-/, $charpos, 2;

    # set end pos to start pos if no end pos
    if(!defined $pos[1]) { push (@pos, $pos[0]) }

    return @pos;
}

sub _throw {
    my ($message, $hint) = @_;
    croak 'MARCspec Parser exception. '.$message.' Tried to parse: '.$hint;
}
1;
__END__