Doubly Linked List in Perl

DoubleLinkedList.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Data::Dumper;

use feature qw /say/;

package Node;
use Moose;
has 'prev' => (
  is => 'rw' #, isa => 'Node'
);

has 'nnext' => (
  is => 'rw'#,  isa => 'Node'
);

has val => ( is => 'rw' );

no Moose;

package DoublyLinkedList;
use Moose;
has 'first' => (
  is => 'rw' #,isa => 'Node'
);

has 'nlast' => (
  is => 'rw' #,  isa => 'Node'
);

sub BUILD {
  my $self = shift;
  my $args = shift;

  $self->toDoublyLinkedList( $args->{original_array_ref} );
}

sub isEmpty {
  my $self = shift;
  
  !defined($self->first);
}

sub is_first_node {
  my ( $self, $node ) = @_;
  
  !defined($self->prev_node($node));
}

sub is_last_node {
  my ( $self, $node ) = @_;
  
  !defined($self->next_node($node));
}

sub prev_node {
  my ($self, $node) = @_;
  
  return (defined $node ) ? $node->prev : undef;
}

sub next_node {
  my ($self, $node) = @_;
  
  return (defined $node ) ? $node->nnext : undef;
}

sub length {
  my $self = shift;
  
  my $answer = 0;
  my $node = $self->first;
  while (defined $node) {
    $answer++;
    $node = $self->next_node($node);
  }
  $answer;
}

sub createSingleElementList {
  my ( $self, $val ) = @_;
  
  $self->first(Node->new(
    'prev' => undef,
    'val' => $val,
    'nnext' => undef
  ));
  
  $self->nlast($self->first);
}

sub toDoublyLinkedList {
  my ( $self, $array_ref ) = @_;

  for my $val ( @{$array_ref} ) {
    if ( $self->isEmpty ) {
      $self->createSingleElementList( $val );
    } else {
      $self->insertAfter( $val, $self->nlast );
    }
  }
}

sub insertBefore {
  my ( $self, $val, $node ) = @_;
  
  my $prev = $node->prev;
  my $new_node = Node->new(
    'prev' => $prev,
    'val' => $val,
    'nnext' => $node
  );
  
  if ( $node == $self->first ) {    
    $self->first($new_node);
  } else {
    $prev->nnext($new_node);
  } 
  
  $node->prev($new_node);
}

sub insertAfter {
  my ( $self, $val, $node ) = @_;
  
  die "Node undefined" if ( !defined $node );
  my $nnext = $node->nnext; 
  my $new_node = Node->new(
    'prev' => $node,
    'val' => $val,
    'nnext' => $nnext
  );
  
  if ( $node == $self->nlast ) {    
    $self->nlast($new_node);
  } else {
    $nnext->prev($new_node);
  } 
  
  $node->nnext($new_node);
}

sub toString {
  my ($self) = shift;
 
  my $answer = "";
  my $node = $self->first;
  while (defined $node) {
    $answer .= ', ' unless( $node == $self->first);
    $answer .= $node->val;
    $node = $self->next_node($node);
  }
  $answer;
}

sub deleteNode {
  my ( $self, $node ) = @_;
  
  # Assume not empty.
  
  if ( $self->is_first_node($node) ) {
    $self->first($self->next_node($node));
    $self->first->prev(undef);
  } else {
    $self->prev_node($node)->nnext($self->next_node($node));
  }

  if ( $self->is_last_node($node) ) {
    $self->nlast($self->prev_node($node));
    $self->nlast->prev(undef);
  } else {
    $self->next_node($node)->prev($self->prev_node($node));
  }
    
  $node = undef;
}

sub nodeAt {
  my ( $self, $index ) = @_;
  
  my $answer = 0;
  my $node = $self->first;
  while (defined $node && $answer <= $index ) {
    return $node if ( $answer == $index );
    $node = $self->next_node($node);
    $answer++;
  }
  die("No such index $index. Last index is " . --$answer);
}

sub deleteNodeAt {
  my ( $self, $index ) = @_;
  
  $self->deleteNode($self->nodeAt($index));
}

no Moose;

package main;

Not saying it's the greatest bit of code. But it works.