view release on metacpan or  search on metacpan

scripts/yatt.lib/YATT/XHF.pm  view on Meta::CPAN

package YATT::XHF;

=head1 NAME

YATT::XHF - Extended Header Fields format.

=cut

use strict;
use warnings qw(FATAL all NONFATAL misc);

use base qw(YATT::Class::Configurable);
use YATT::Fields qw(cf_FH cf_filename cf_tokens);
use Carp;

use YATT::Util::Enum -prefix => '_', qw(NAME VALUE SIGIL);

our $cc_name  = qr{\w|[\.\-%/]};
our $cc_sigil = qr{[:\#,\-\[\]\{\}]};
our $cc_tabsp = qr{[\ \t]};

our %OPN = qw([ array { hash);

sub configure_filename {
  (my MY $self, my ($fn)) = @_;
  open $self->{cf_FH}, '<', $fn
    or croak "Can't open file '$fn': $!";
  $self->{cf_filename} = $fn;
  $self;
}

sub configure_string {
  (my MY $self, my ($string)) = @_;
  open $self->{cf_FH}, '<', \$string
    or croak "Can't create string stream: $!";
  $self;
}

sub read_as_hashlist {
  my MY $reader = shift;
  local $/ = "";
  my $fh = $$reader{cf_FH};
  my @result;
  while (defined (my $paragraph = <$fh>)) {
    @{$$reader{cf_tokens}} = $reader->tokenize($paragraph)
      or next;
    push @result, $reader->organize_as_hash($reader->{cf_tokens});

  }
  wantarray ? @result : \@result;
}

sub read_as_hash {
  shift->read_as(hash => @_);
}

sub read_as {
  (my MY $reader, my ($type)) = @_;
  my $sub = $reader->can("organize_as_$type")
    or croak "Unknown read_as type: $type";

  local $/ = "";
  my $fh = $$reader{cf_FH};
  until ($$reader{cf_tokens} && @{$$reader{cf_tokens}}) {
    defined (my $paragraph = <$fh>) or last;
    @{$$reader{cf_tokens}} = $reader->tokenize($paragraph)
  }
  return unless $$reader{cf_tokens} && @{$$reader{cf_tokens}};
  $sub->($reader, $reader->{cf_tokens});
}

sub organize_as_pairlist {
  (my MY $reader, my ($tokens)) = @_;
  my $hash = $reader->organize_as_hash($tokens);
  %$hash;
}

sub organize_as_hash {
  (my MY $reader, my ($tokens)) = @_;
  my %result;
  while (@$tokens) {
    my $desc = shift @$tokens;
    my $sigil = pop @$desc;
    if (my $type = $OPN{$sigil}) {
      $desc->[_VALUE] = $reader->can("organize_as_$type")
	->($reader, $tokens);
    } elsif ($sigil eq '}') {
      last;
    }
    $reader->add_value($result{$reader->decode_name($desc->[_NAME])}
		       , $desc->[_VALUE]);
  }
  \%result;
}

sub organize_as_array {
  (my MY $reader, my ($tokens)) = @_;
  my @result;
  while (@$tokens) {
    my $desc = shift @$tokens;
    my $sigil = pop @$desc;
    unless ($desc->[_NAME] eq '') {
      croak "Array can not have name: $desc->[_NAME]";
    } elsif (my $type = $OPN{$sigil}) {
      $desc->[_VALUE] = $reader->can("organize_as_$type")
	->($reader, $tokens);
    } elsif ($sigil eq ']') {
      last;
    }
    push @result, $desc->[_VALUE];
  }
  \@result;
}

sub add_value {
  my MY $reader = shift;
  unless (defined $_[0]) {
    $_[0] = $_[1];
  } elsif (ref $_[0] ne 'ARRAY') {
    $_[0] = [$_[0], $_[1]];
  } else {
    push @{$_[0]}, $_[1];