File Coverage

blib/lib/Data/Page/Tied.pm

Criterion	Covered	Total	%
statement	47	64	73.4
branch	3	4	75.0
condition	1	3	33.3
subroutine	15	25	60.0
pod	6	6	100.0
total	72	102	70.5

#
# Copyright (c) 2002-2006
#          Steffen Müller
#
# All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

package Data::Page::Tied;

use strict;
use Carp;

use Data::Page;

use vars qw/$VERSION @ISA/;
$VERSION = '2.01';

# inherit methods from Data::Page.
push @ISA, 'Data::Page';

# constructor
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = {};

  # get the data to start with
  my $entries               = shift;

  if (ref $entries eq 'ARRAY') {
    # if it's an array ref, we use its contents
    $self->{ENTRIES}   = [ @{ $entries } ];
  } else {
    # if it's not an array ref, we return a Data::Page object
    return Data::Page->new($entries, @_);
  }

  bless($self, $class);

  # set entries per page and current page (args)
  $self->set_entries_per_page(shift);
  $self->set_current_page(shift);

  return $self;
}

# return the total number of entries.
sub total_entries {
  my $self = shift;

  return scalar(@{$self->{ENTRIES}});
}

# set the current page.
sub set_current_page {
  my $o = shift()->current_page(@_);
  $o->current_page();
}

# set entries per page
sub set_entries_per_page {
  my $o = shift()->entries_per_page( @_ );
  return $o->entries_per_page;
}

# access an entry
sub entry {
  my $self = shift;
  my $index = shift;
  $self->{ENTRIES}->[$index] = shift if @_;
  return $self->{ENTRIES}->[$index];
}

# set an entry
sub set_entry {
  shift()->entry(@_);
}

##################
# tied interface #
##################

# invokes constructor
sub TIEARRAY {
  my $class = shift;
  my $self  = $class->new(@_);
  return $self;
}

sub FETCH {
  $_[0]->{ENTRIES}->[$_[1]];
}

sub STORE {
  $_[0]->{ENTRIES}->[$_[1]] = $_[2];
}

sub FETCHSIZE {
  my $self = shift;
  return scalar @{$self->{ENTRIES}};
}

sub STORESIZE {
  my $self = shift;
  $#{$self->{ENTRIES}} = shift() - 1;
}

sub EXTEND {
   my $self = shift;
   $#{$self->{ENTRIES}} = shift() - 1;
}

sub POP { pop @{ $_[0]->{ENTRIES} } }

sub PUSH { push @{ $_[0]->{ENTRIES} }, @_ }

sub SHIFT { shift @{ $_[0]->{ENTRIES} } }

sub UNSHIFT { unshift @{ $_[0]->{ENTRIES} }, @_ }

sub SPLICE { splice @{ $_[0]->{ENTRIES} }, @_ }

sub DELETE { $_[0]->{ENTRIES}->[$_[1]] = '' }

sub EXISTS { croak "We don't do 'exists' here!" }

sub CLEAR { }

sub DESTROY { }


1;

__END__