File Coverage

blib/lib/Acme/List/CarCdr.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	14	16	87.5
condition	5	5	100.0
subroutine	6	6	100.0
pod			n/a
total	71	74	95.9

# -*- Perl -*-
#
# c[ad]+r list-operation support for Perl, based on (car) and (cdr) and
# so forth of lisp fame, though with a limit of 704 as to the maximum
# length any such shenanigans.
#
# Run perldoc(1) on this file for additional documentation.

package Acme::List::CarCdr;

use 5.010000;
use strict;
use warnings;

use Carp qw(croak);
use Moo;

our $VERSION = '0.01';

##############################################################################
#
# METHODS

sub AUTOLOAD {
  my $method = our $AUTOLOAD;
  if ( $method =~ m/::c([ad]{1,704})r$/ ) {
    my $ops   = reverse $1;
    my $self  = shift;
    my $ref   = \@_;
    my $start = 0;
    my $end;
    my $delve = 0;
    while ( $ops =~ m/\G([ad])(\1*)/cg ) {
      my $op = $1;
      my $len = length $2 || 0;
      if ( $op eq 'a' ) {
        if ( $len > 0 ) {
          for my $i ( 1 .. $len ) {
            if ( ref $ref->[$start] ne 'ARRAY' ) {
              croak "$method: " . $ref->[$start] . " is not a list";
            }
            $ref   = $ref->[$start];
            $start = 0;
          }
        }
        $end   = $start;
        $delve = 1;
      } else {    # $op eq 'd'
        if ($delve) {
          if ( ref $ref->[$start] ne 'ARRAY' ) {
            croak "$AUTOLOAD: " . $ref->[$start] . " is not a list";
          }
          $ref   = $ref->[$start];
          $start = 0;
        }
        $start += $len + 1;
        $end = $#$ref;
      }
    }
    return if $start > $end;
    return @{ $ref->[$start] }
      if ( $start == $end and ref $ref->[$start] eq 'ARRAY' );
    return @$ref[ $start .. $end ];
  } else {
    croak "no such method $method";
  }
}

1;
__END__