The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package PICA::Modification::Queue::Hash;
{
  $PICA::Modification::Queue::Hash::VERSION = '0.16';
}
#ABSTRACT: In-memory collection of modifications

use strict;
use warnings;
use v5.10;

use PICA::Modification::Request;
use Scalar::Util qw(blessed);

sub new { 
    bless [{},0], shift; 
}

sub get {
   my ($self, $id) = @_;
   return $self->[0]->{ $id };
}

sub request {
	my ($self, $mod) = @_;
	return if !$mod->isa('PICA::Modification') or $mod->isa('PICA::Modification::Request');
	$mod = PICA::Modification::Request->new( $mod );
	return if $mod->error;
	my $id = ++$self->[1];
	$self->[0]->{ $id } = $mod;
	return $id;
}

sub update { 
    my ($self, $id => $mod) = @_;
	$mod = PICA::Modification::Request->new( $mod );
	return if $mod->error;
	$self->[0]->{ $id } = $mod;
	return $id;
}

sub delete {
    my ($self, $id) = @_;
    return unless defined $self->[0]->{ $id };
	delete $self->[0]->{ $id }; 
	$id;
}

sub list {
	my ($self, %properties) = @_;

	my $limit  = delete $properties{limit} || 20;
	my $page   = delete $properties{page} || 1;
	my $sortby = delete $properties{sort};

	my $hash = $self->[0];

    my $c = 0;
    my $grep = sub {
        while (my ($k,$v) = each(%properties)) {
            return 0 unless $_[0]->{$k} eq $v; 
        }
        $c++;
        return 0 if $c > $page*$limit;
        return 0 if $c <= ($page-1)*$limit;
        1;
    };

    if ( $sortby ) {
        my $sort = sub { $a->{$sortby} cmp $b->{$sortby} };
        return [ grep { $grep->($_) } sort $sort values %$hash ];
    } else {
        return [ grep { $grep->($_) } values %$hash ];
    }
}

1;


__END__
=pod

=head1 NAME

PICA::Modification::Queue::Hash - In-memory collection of modifications

=head1 VERSION

version 0.16

=head1 DESCRIPTION

PICA::Modification::Queue::Hash implements a L<PICA::Modification::Queue> that
directly stored modification requests as references in memory.

=encoding utf-8

=head1 AUTHOR

Jakob Voß <voss@gbv.de>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Jakob Voß.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut