File Coverage

blib/lib/CodeGen/Cpppp/Output.pm

Criterion	Covered	Total	%
statement	65	104	62.5
branch	7	26	26.9
condition	4	19	21.0
subroutine	13	16	81.2
pod	9	10	90.0
total	98	175	56.0

package CodeGen::Cpppp::Output;
$INC{'CodeGen/Cpppp/Output.pm'}= 1;
use v5.20;
use warnings;
use Carp;
use Scalar::Util 'looks_like_number';
use List::Util 'max';
use experimental 'signatures';


our %standard_sections= (
   public => 100,
   protected => 200,
   private => 10000,
);
sub new($class, @args) {
   bless {
      section_priority => { %standard_sections },
      out => {},
      @args == 1 && ref $args[0]? %{$args[0]}
      : !(@args & 1)? @args
      : croak "Expected hashref or even-length list"
   }, $class;
}


sub section_list($self) {
   my $pri= $self->section_priority;
   sort { $pri->{$a} <=> $pri->{$b} } keys %$pri;
}

sub has_section($self, $name) {
   defined $self->section_priority->{$name};
}

sub section_priority($self) {
   $self->{section_priority}
}

sub declare_sections($self, @list) {
   my $pri= $self->section_priority;
   my $max_before_private= max grep $_ < $pri->{private}, values %$pri;
   my $next= $max_before_private + 1;
   while (@list) {
      my $name= shift @list;
      looks_like_number($name) and croak "Expected non-numeric name at '$name'";
      if (looks_like_number($list[0])) {
         $pri->{$name}= shift @list;
      } elsif (!defined $pri->{$name}) {
         $name =~ /\.\.|,/ and croak "Section names may not contain '..' or ','";
         $pri->{$name}= $next++;
      }
   }
   $self;
}


sub append($self, $section, @code) {
   defined $self->{section_priority}{$section} or croak "Unknown section $section";
   push @{$self->{out}{$section}}, @code;
}
sub prepend($self, $section, @code) {
   defined $self->{section_priority}{$section} or croak "Unknown section $section";
   unshift @{$self->{out}{$section}}, @code;
}


sub expand_section_selector($self, @list) {
   @list= map +(ref $_ eq 'ARRAY'? @$_ : $_), @list;
   @list= map split(',', $_), @list;
   my $sec_pri= $self->section_priority;
   my %seen;
   for (@list) {
      if (/([^.]+)\.\.([^.]+)/) {
         my $low= $sec_pri->{$1} // croak "Unknown section $1";
         my $high= $sec_pri->{$2} // croak "Unknown section $2";
         for (keys %$sec_pri) {
            $seen{$_}++ if $sec_pri->{$_} >= $low && $sec_pri->{$_} <= $high;
         }
      } else {
         $sec_pri->{$_} // croak "Unknown section $_";
         $seen{$_}++;
      }
   }
   sort { $sec_pri->{$a} <=> $sec_pri->{$b} } keys %seen;
}


sub get($self, @sections) {
   my @sec= @sections? $self->expand_section_selector(@sections) : $self->section_list;
   join '', map @{$self->{out}{$_} // []}, @sec;
}

sub consume($self, @sections) {
   my @sec= @sections? $self->expand_section_selector(@sections) : $self->section_list;
   my $out= join '', map @{delete $self->{out}{$_} // []}, @sec;
   @{$self->{out}{$_}}= () for @sec;
   $out
}

1;

__END__