File Coverage

lib/Panotools/Script/Line.pm

Criterion	Covered	Total	%
statement	45	48	93.7
branch	5	6	83.3
condition	2	5	40.0
subroutine	10	12	83.3
pod	0	6	0.0
total	62	77	80.5

package Panotools::Script::Line;

use strict;
use warnings;

use Storable qw/ dclone /;

=head1 NAME

Panotools::Script::Line - Panorama Tools script data

=head1 SYNOPSIS

Base class for a line in a panotools script

=head1 DESCRIPTION

A line starts with a single letter identifier then a series of
namevalue items separated by whitespace

=head1 USAGE

  my $line = new Panotools::Script::Line::Foo;

=cut

sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $self = bless {}, $class;
    $self->_defaults;
    return $self;
}

=pod

  my $identifier = $line->Identifier;

=cut

sub Identifier
{
    return '#';
}

=pod

  $line->Parse ('f a1.0 b2.0 bar3.0');

=cut

sub Parse
{
    my $self = shift;
    my $string = shift || return 0;
    my $valid = $self->_valid;
    my @res = $string =~ / ([a-zA-Z][^ "]+)|([a-zA-Z][a-z]*"[^"]+")/g;
    for my $token (grep { defined $_ } @res)
    {
        my ($key, $value) = $token =~ /$valid/;
        next unless defined $key;
        $self->{$key} = $value;
    }
    $self->_sanitise;
    return 1;
}

=pod

  my $string = $line->Assemble;

=cut

sub Assemble
{
    my $self = shift;
    $self->_sanitise;
    my @tokens;
    for my $entry (sort keys %{$self})
    {
        push @tokens, $entry . $self->{$entry};
    }
    return (join ' ', ($self->Identifier, @tokens)) ."\n" if (@tokens);
    return '';
}

=pod

  $line->Set (a => 'something', b => 2);

=cut

sub Set
{
    my $self = shift;
    my %hash = @_;
    for my $entry (sort keys %hash)
    {
        $self->{$entry} = $hash{$entry};
    }
    $self->_sanitise;
}

=pod

Clone a line object

 $clone = $l->Clone;

=cut

sub Clone
{
    my $self = shift;
    dclone ($self);
}

sub _defaults {}

sub _valid { return '^(.)(.*)' }

sub _sanitise
{
    my $self = shift;
    my $valid = $self->_valid;
    for my $key (keys %{$self})
    {
        delete $self->{$key} unless (grep /$valid/, $key);
    }
}

1;