| Panotools-Script documentation | Contained in the Panotools-Script distribution. |
Panotools::Script::Line - Panorama Tools script data
Base class for a line in a panotools script
A line starts with a single letter identifier then a series of namevalue items separated by whitespace
my $line = new Panotools::Script::Line::Foo;
my $identifier = $line->Identifier;
$line->Parse ('f a1.0 b2.0 bar3.0');
my $string = $line->Assemble;
$line->Set (a => 'something', b => 2);
Clone a line object
$clone = $l->Clone;
| Panotools-Script documentation | Contained in the Panotools-Script distribution. |
package Panotools::Script::Line; use strict; use warnings; use Storable qw/ dclone /;
sub new { my $class = shift; $class = ref $class || $class; my $self = bless {}, $class; $self->_defaults; return $self; }
sub Identifier { return '#'; }
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; }
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 ''; }
sub Set { my $self = shift; my %hash = @_; for my $entry (sort keys %hash) { $self->{$entry} = $hash{$entry}; } $self->_sanitise; }
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;