File Coverage

lib/Pod/Eventual/Reconstruct/LazyCut.pm

Criterion	Covered	Total	%
statement	21	28	75.0
branch			n/a
condition			n/a
subroutine	7	10	70.0
pod	2	2	100.0
total	30	40	75.0

use 5.006;
use strict;
use warnings;

package Pod::Eventual::Reconstruct::LazyCut;

# ABSTRACT: A Subclass of Pod::Eventual::Reconstruct that emits less =cut's

our $VERSION = '1.000001';

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY












use Moo qw( extends has around );
use Carp qw(carp);
use Data::Dump qw(pp);
extends 'Pod::Eventual::Reconstruct';











has 'inpod' => (
  is        => ro  =>,
  writer    => 'set_inpod',
  clearer   => 'clear_inpod',
  predicate => 'is_inpod',
  lazy      => 1,
  builder   => sub { undef },
);

around write_command => sub {
  my ( $orig, $self, $event ) = @_;
  if ( $event->{type} ne 'command' ) {
    return $self->$orig($event);
  }
  if ( $event->{command} ne 'cut' ) {
    my $result = $self->$orig($event);
    $self->set_inpod(1);
    return $result;
  }
  if ( $self->is_inpod ) {
    my $result = $self->$orig($event);
    $self->clear_inpod();
    return $result;
  }

  # Skipping a cut
  return $self;
};

around write_text => sub {
  my ( $orig, $self, $event ) = @_;
  if ( $event->{type} ne 'text' ) {
    return $self->$orig($event);
  }
  if ( not $self->is_inpod ) {
    return $self->write_text_outside_pod( $orig, $event );
  }
  return $self->$orig($event);
};

around write_nonpod => sub {
  my ( $orig, $self, $event ) = @_;
  if ( $event->{type} ne 'nonpod' ) {
    return $self->$orig($event);
  }
  if ( $self->is_inpod ) {
    return $self->write_nonpod_inside_pod( $orig, $event );
  }
  return $self->$orig($event);
};

no Moo;













sub write_text_outside_pod {
  my ( $self, $orig, $event ) = @_;
  carp 'POD Text element outside POD ' . pp($event);
  return $self->$orig($event);
}













sub write_nonpod_inside_pod {
  my ( $self, $orig, $event ) = @_;
  carp 'NONPOD element inside POD ' . pp($event);
  return $self->$orig($event);
}

1;

__END__