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;