File Coverage

blib/lib/String/Sections/Result.pm

Criterion	Covered	Total	%
statement	73	76	96.0
branch	9	10	90.0
condition	2	6	33.3
subroutine	21	21	100.0
pod	10	10	100.0
total	115	123	93.5

use strict;
use warnings;

package String::Sections::Result;
BEGIN {
  $String::Sections::Result::AUTHORITY = 'cpan:KENTNL';
}
{
  $String::Sections::Result::VERSION = '0.3.2';
}

# ABSTRACT: Glorified wrapper around a hash representing a parsed String::Sections result
#


use Moo 1.000008;

## no critic (RequireArgUnpacking)

sub _croak   { require Carp;         goto &Carp::croak; }
sub _blessed { require Scalar::Util; goto &Scalar::Util::blessed }



use Types::Standard qw( HashRef ArrayRef ScalarRef Str Maybe );

our $TYPE_SECTION_NAME     = Str;
our $TYPE_SECTION_NAMES    = ArrayRef [Str];
our $TYPE_SECTION          = ScalarRef [Str];
our $TYPE_OPTIONAL_SECTION = Maybe [$TYPE_SECTION];
our $TYPE_CURRENT          = Maybe [Str];
our $TYPE_SECTIONS         = HashRef [$TYPE_SECTION];

has 'sections' => (
  is      => ro =>,
  isa     => $TYPE_SECTIONS,
  lazy    => 1,
  builder => sub {
    return {};
  },
);



has '_current' => (
  is        => ro  =>,
  isa       => $TYPE_CURRENT,
  reader    => '_current',
  writer    => 'set_current',
  predicate => 'has_current',
  lazy      => 1,
  builder   => sub { return _croak('current never set, but tried to use it') },
);


has '_section_names' => (
  is   => ro =>,
  isa  => $TYPE_SECTION_NAMES,
  lazy => 1,
  builder => sub { return [] },
);


sub section {
  $TYPE_SECTION_NAME->assert_valid( $_[1] );
  return $_[0]->sections->{ $_[1] };
}


sub section_names { return ( my @list = @{ $_[0]->_section_names } ) }


sub section_names_sorted { return ( my @list = sort @{ $_[0]->_section_names } ) }


sub has_section {
  $TYPE_SECTION_NAME->assert_valid( $_[1] );
  return exists $_[0]->sections->{ $_[1] };
}


sub set_section {
  $TYPE_SECTION_NAME->assert_valid( $_[1] );
  $TYPE_SECTION->assert_valid( $_[2] );
  if ( not exists $_[0]->sections->{ $_[1] } ) {
    push @{ $_[0]->_section_names }, $_[1];
  }
  $_[0]->sections->{ $_[1] } = $_[2];
  return;
}


sub append_data_to_current_section {
  $TYPE_OPTIONAL_SECTION->assert_valid( $_[1] );
  if ( not exists $_[0]->sections->{ $_[0]->_current } ) {
    push @{ $_[0]->_section_names }, $_[0]->_current;
    my $blank = q{};
    $_[0]->sections->{ $_[0]->_current } = \$blank;
  }
  if ( defined $_[1] ) {
    ${ $_[0]->sections->{ $_[0]->_current } } .= ${ $_[1] };
  }
  return;
}


sub append_data_to_section {
  $TYPE_SECTION_NAME->assert_valid( $_[1] );
  $TYPE_OPTIONAL_SECTION->assert_valid( $_[2] );
  if ( not exists $_[0]->sections->{ $_[1] } ) {
    push @{ $_[0]->_section_names }, $_[1];
    my $blank = q{};
    $_[0]->sections->{ $_[1] } = \$blank;
  }
  if ( defined $_[2] ) {
    ${ $_[0]->sections->{ $_[1] } } .= ${ $_[2] };
  }
  return;
}


sub shallow_clone {
  my $class = _blessed( $_[0] ) || $_[0];
  my $instance = $class->new();
  for my $name ( $_[0]->section_names ) {
    $instance->set_section( $name, $_[0]->sections->{$name} );
  }
  return $instance;
}


sub shallow_merge {
  my $class = _blessed( $_[0] ) || $_[0];
  my $instance = $class->new();
  for my $name ( $_[0]->section_names ) {
    $instance->set_section( $name, $_[0]->sections->{$name} );
  }
  for my $name ( $_[1]->section_names ) {
    $instance->set_section( $name, $_[1]->sections->{$name} );
  }
  return $instance;
}


sub _compose_section {
  $TYPE_SECTION_NAME->assert_valid( $_[1] );
  return sprintf qq[__[%s]__\n%s], $_[1], ${ $_[0]->sections->{ $_[1] } };
}


sub to_s {
  my $self = $_[0];
  return join qq{\n}, map { $self->_compose_section($_) } $self->section_names_sorted;
}

1;

__END__