package Queue;

use strict;
use warnings;
use include;

# Make a new blank Queue object. Entries must be hashes for now.
sub new {
  return bless {
    IDs    => {},
    Queue  => [],
    Active => 0,
    Hooks  => [],
    Heap   => {}
  }, shift;
}

# Turn an ID into an entry number and verify its existence.
sub check {
  my ($self, $id) = @_;
  if ($id =~ m/\D/) {	# \D = has non-digits, aka, isnt a number
    #debug("$id not there...")
    return unless exists $self->{IDs}{$id};
    $id = $self->{IDs}{$id};
  }
  #carp("no entry #$id..."), return unless $self->{Queue}[$id];
  return unless $self->{Queue}[$id];
  return $id;
}

# Sets an existing entry.
sub set {
  my ($self, $id, %new) = @_;
  $id = $self->check($id) // croak "can't set to an undefined id";
  %{ $self->{Queue}[$id] } = (%{ $self->{Queue}[$id] }, %new);
  $self->callback("set", $id);
}

# Returns an entry.
sub get {
  my ($self, $id) = @_;
  $id = $self->check($id);
  return $self->{Queue}[$id] if defined $id;
}

# Returns the active ID.
sub active {
  my $self = shift;
  croak "No active entry yet... queue is empty" unless @{ $self->{Queue} };
  return $self->{Active};
}

# Adds a new hook.
sub hook {
  my ($self, $hook, $id, $ref) = @_;
  push @{ $self->{Hooks} }, $hook;
  $self->{Heap}{$id} = $ref;
}

sub callback {
  my $self = shift;
  foreach (@{ $self->{Hooks} }) {
    $_->($self, @_);
  }
}

# Adds a new entry to the end of the queue.
sub add {
  my ($self, $id, %new) = @_;
  croak "the ID key is reserved for use by queue!" if $new{ID};
  push @{ $self->{Queue} }, {%new, ID => $id};
  $self->{IDs}{$id} = $#{ $self->{Queue} };
  $id = $self->check($id);
  $self->callback("add", $id);
}

# Adds a new entry to the beginning of the queue.
sub preadd {
  my ($self, $id, %new) = @_;
  my $queue = $self->{Queue};
  croak "the ID key is reserved for use by queue!" if $new{ID};
  unshift @$queue, {%new, ID => $id};
  $self->{IDs}{$id} = 0;
  foreach (1 .. $#{ $queue }) {
    $self->{IDs}{ $queue->[$_]{ID} }++;
  }
  $id = $self->check($id);
  $self->callback("add", $id);
}

# Deletes an entry.
sub del {
  my ($self, $id) = @_[0, 1];
  my $aux = 1 if $_[2] and $_[2] eq "-aux";
  $id = $self->check($id) // croak "can't delete an unknown id";
  $self->{Active}-- if $id <= $self->active;
  $self->{Active} = 0 if $self->{Active} < 0;
  my $entry = splice @{ $self->{Queue} }, $id, 1;
  delete $self->{IDs}{ $entry->{ID} };
  foreach ($id .. $#{ $self->{Queue} }) {
    $self->{IDs}{ $self->{Queue}[$_]{ID} }--;
  }
  $self->callback("del", $entry) unless $aux;
  return $entry;
}

# Returns all the entries.
sub all {
  my $self = shift;
  return @{ $self->{Queue} };
}

# Change the active entry.
sub move_up {
  my $self = shift;
  return if $self->{Active} == 0;
  $self->{Active}--;
  $self->callback("move");
}

sub move_down {
  my $self = shift;
  return if $self->{Active} == $#{ $self->{Queue} };
  $self->{Active}++;
  $self->callback("move");
}

sub move_first {
  my $self = shift;
  return if $self->{Active} == 0;
  $self->{Active} = 0;
  $self->callback("move");
}

sub move_last {
  my $self = shift;
  return if $self->{Active} == $#{ $self->{Queue} };
  $self->{Active} = $#{ $self->{Queue} };
  $self->callback("move");
}

# Actually move the active entry to another position.
sub shift_up {
  my $self = shift;
  my ($active, $queue) = ($self->{Active}, $self->{Queue});
  return if $active == 0;
  ($queue->[$active], $queue->[$active - 1]) = ($queue->[$active - 1], $queue->[$active]);
  $self->{Active}--;
  $self->{IDs}{ $queue->[$self->{Active}]{ID} }--;
  $self->{IDs}{ $queue->[$self->{Active} + 1]{ID} }++;
  $self->callback("shift", $self->{Active} + 1, $self->{Active});
}

sub shift_down {
  my $self = shift;
  my ($active, $queue) = ($self->{Active}, $self->{Queue});
  return if $self->{Active} == $#{ $self->{Queue} };
  ($queue->[$active], $queue->[$active + 1]) = ($queue->[$active + 1], $queue->[$active]);
  $self->{Active}++;
  $self->{IDs}{ $queue->[$self->{Active}]{ID} }++;
  $self->{IDs}{ $queue->[$self->{Active} - 1]{ID} }--;
  $self->callback("shift", $self->{Active} - 1, $self->{Active});
}

sub shift_first {
  my $self = shift;
  my ($active, $queue) = ($self->{Active}, $self->{Queue});
  return if $active == 0;
  my $entry = $self->del($active, "-aux");
  unshift @$queue, $entry;
  $self->{IDs}{ $entry->{ID} } = 0;
  $self->{Active} = 0;
  foreach (1 .. $#{ $queue }) {
    $self->{IDs}{ $queue->[$_]{ID} }++;
  }
  $self->callback("shift", $active, $self->{Active});
}

sub shift_last {
  my $self = shift;
  my ($active, $queue) = ($self->{Active}, $self->{Queue});
  return if $active == $#{ $queue };
  my $entry = $self->del($active, "-aux");
  push @$queue, $entry;
  $self->{IDs}{ $entry->{ID} } = $#{ $queue };
  $self->{Active} = $#{ $queue };
  $self->callback("shift", $active, $self->{Active});
}

42;