view release on metacpan or  search on metacpan

lib/Acme/List/CarCdr.pm  view on Meta::CPAN

# -*- 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__

##############################################################################
#
# DOCS

=head1 NAME

Acme::List::CarCdr - car cdr cdaadadrdrr

=head1 SYNOPSIS

  use Acme::List::CarCdr;
  my $can = Acme::List::CarCdr->new;

  $can->car(qw/cat dog fish/);  # "cat"
  $can->cdr(qw/cat dog fish/);  # "dog", "fish"
  $can->cddr(qw/cat dog fish/); # "fish"
  $can->c...r(...);             # ...

See also the C<t/> directory of the distribution of this module for
example code.

=head1 DESCRIPTION

C<car> or C<cdr> or C<caar> or C<cadadr> or so forth support for Perl.