File Coverage

blib/lib/String/Sections.pm

Criterion	Covered	Total	%
statement	62	79	78.4
branch	13	26	50.0
condition	1	3	33.3
subroutine	17	22	77.2
pod	3	3	100.0
total	96	133	72.1

use strict;
use warnings;

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

# ABSTRACT: Extract labeled groups of sub-strings from a string.



use 5.010001;
use Moo;
use Types::Standard qw( RegexpRef Str Bool Maybe FileHandle ArrayRef );

our $TYPE_REGEXP          = RegexpRef;
our $TYPE_OPTIONAL_STRING = Maybe [Str];
our $TYPE_BOOL            = Bool;
our $TYPE_FILEHANDLE      = FileHandle;
our $TYPE_INPUT_LIST      = ArrayRef [Str];






sub _croak { require Carp; goto &Carp::croak; }


sub __add_line {

  my ( $self, $stash, $line ) = @_;

  if ( ${$line} =~ $self->header_regex ) {
    $stash->set_current("$1");
    $stash->append_data_to_current_section();
    return 1;    # 1 is next.
  }

  # not valid for lists because lists are not likely to have __END__ in them.
  if ( $self->stop_at_end ) {
    return 0 if ${$line} =~ $self->document_end_regex;
  }

  if ( $self->ignore_empty_prelude ) {
    return 1 if not $stash->has_current and ${$line} =~ $self->empty_line_regex;
  }

  if ( not $stash->has_current ) {
    _croak( 'bogus data section: text outside named section. line: ' . ${$line} );
  }

  if ( $self->enable_escapes ) {
    my $regex = $self->line_escape_regex;
    ${$line} =~ s{$regex}{}msx;
  }

  $stash->append_data_to_current_section($line);

  return 1;
}


sub load_list {
  my ( $self, @rest ) = @_;
  $TYPE_INPUT_LIST->assert_valid( \@rest );
  require String::Sections::Result;
  my $result_ob = String::Sections::Result->new();

  if ( $self->default_name ) {
    $result_ob->set_current( $self->default_name );
    $result_ob->append_data_to_current_section();
  }

  for my $line (@rest) {
    my $result = $self->__add_line( $result_ob, \$line );
    next if $result;
    last if not $result;

  }
  return $result_ob;
}


sub load_string {
  my ( $self, $string ) = @_;
  return _croak('Not Implemented');
}


sub load_filehandle {
  my ( $self, $fh ) = @_;

  $TYPE_FILEHANDLE->assert_valid($fh);
  require String::Sections::Result;
  my $result_ob = String::Sections::Result->new();

  if ( $self->default_name ) {
    $result_ob->set_current( $self->default_name );
    $result_ob->append_data_to_current_section();
  }
  while ( defined( my $line = <$fh> ) ) {
    my $result = $self->__add_line( $result_ob, \$line, );
    next if $result;
    last if not $result;
  }

  return $result_ob;

}

#
# Defines accessors *_regex and _*_regex , that are for public and private access respectively.
# Defaults to _default_*_regex.
#


sub _regex_type {
  my $name = shift;
  return ( is => 'ro', isa => $TYPE_REGEXP, builder => '_default_' . $name, lazy => 1 );
}


sub _string_type {
  my $name = shift;
  return ( is => 'ro', isa => $TYPE_OPTIONAL_STRING, builder => '_default_' . $name, lazy => 1 );
}


sub _boolean_type {
  my $name = shift;
  return ( is => 'ro', isa => $TYPE_BOOL, builder => '_default_' . $name, lazy => 1 );
}


has 'header_regex' => _regex_type('header_regex');


has 'empty_line_regex' => _regex_type('empty_line_regex');


has 'document_end_regex' => _regex_type('document_end_regex');


has 'line_escape_regex' => _regex_type('line_escape_regex');


has 'default_name' => _string_type('default_name');

# Boolean Accessors


has 'stop_at_end' => _boolean_type('stop_at_end');


has 'ignore_empty_prelude' => _boolean_type('ignore_empty_prelude');


has 'enable_escapes' => _boolean_type('enable_escapes');

# Default values for various attributes.


sub _default_header_regex {
  return qr{
    \A                # start
      _+\[            # __[
        \s*           # any whitespace
          ([^\]]+?)   # this is the actual name of the section
        \s*           # any whitespace
      \]_+            # ]__
      [\x0d\x0a]{1,2} # possible cariage return for windows files
    \z                # end
    }msx;
}


sub _default_empty_line_regex {
  return qr{
      ^
      \s*   # Any empty lines before the first section get ignored.
      $
  }msx;
}


sub _default_document_end_regex {
  return qr{
    ^          # Start of line
    __END__    # Document END matcher
  }msx;
}


sub _default_line_escape_regex {
  return qr{
    \A  # Start of line
    \\  # A literal \
  }msx;
}


sub _default_default_name { return }


sub _default_stop_at_end { return }


sub _default_ignore_empty_prelude { return 1 }


sub _default_enable_escapes { return }

1;

__END__