Beta Shell v2.0

File Manager

~ /usr/share/perl5/vendor_perl/Sort/MergeSort
Name	Size	Perms	Modified	Actions
[ .. / .. ]
Iterator.pm	6.77 KB	-rw-r--r--	2009-07-24 07:59:12	Edit Del
Editing: Iterator.pm (6.77 KB)

package Sort::MergeSort::Iterator;

# $Id: Iterator.pm 13859 2009-07-24 08:02:37Z david $

use strict;
use warnings;
use Carp;
use Carp qw(confess);
our $VERSION = '0.01';
use Symbol;

##############################################################################
# Constructor.
##############################################################################

sub new {
	my ( $class, $code, $destroy ) = @_;
	croak qq{Argument "$code" is not a code reference} if ref $code ne 'CODE';
	croak qq{Argument "$destroy" is not a code reference}
		if $destroy && ref $destroy ne 'CODE';

	my $self = bless gensym, $class;
	${*$self}{code} = $code;
	${*$self}{destroy} = $destroy;
	${*$self}{count} = 0;

	tie(*$self, $class, $self);

	return $self;
}

DESTROY {
	my $self = shift;
	my $dest = ${*$self}{destroy} or return;
	$dest->();
}

##############################################################################
# Instance Methods.
##############################################################################

sub next {
	my $self = shift;
	${*$self}{curr} = exists ${*$self}{peek}
		? delete ${*$self}{peek}
		: ${*$self}{code}->();
	${*$self}{count}++ if defined ${*$self}{curr};
	return ${*$self}{curr};
}

##############################################################################

sub current { 
	my $self = shift;
	${*$self}{curr};
}

##############################################################################

sub peek {
	my $self = shift;
	return ${*$self}{peek} ||= ${*$self}{code}->();
}

##############################################################################

sub position { 
	my $self = shift;
	${*$self}{count};
}

##############################################################################

sub all {
	my $self = shift;
	my @items;
	push @items, $self->next while $self->peek;
	return wantarray ? @items : \@items;
}

##############################################################################

sub do {
	my ( $self, $code ) = @_;
	while ( local $_ = $self->next ) {
		return unless $code->($_);
	}
}

##############################################################################

sub close
{
	my $self = shift;
	my $dest = ${*$self}{destroy} or return;
	$dest->();
	delete ${*$self}{destroy};
	${*self}{code} = sub { die "attempt to read a closed iterator" };
}

*CLOSE = \&close;

sub sysread { die "not implemented" }
sub open { die "not implemented" }
sub syswrite { die "not implemented" }
sub ungetc { die "not implemented" }
sub getc { die "not implemented" }
sub ungetline { die "not implemented" }
sub xungetc { die "not implemented" }
sub print { die "not implemented" }
sub fileno { die "not implemented" }
sub PRINTF { die "not implemented" }
sub PRINT { die "not implemented" }
sub READ { confess "not implemented" }
sub read { die "not implemented" }
sub WRITE { die "not implemented" }
sub TELL { die "not implemented" }
sub SEEK { die "not implemented" }
sub OPEN { die "not implemented" }
sub GETC { die "not implemented" }
sub BINMODE { }

sub eof 
{
	my $self = shift;
	return ! defined $self->peek;
}

*EOF = \&eof;

sub getlines
{
	my $self = shift;
	die unless wantarray;
	return ($self->all());
}

sub TIEHANDLE
{
	my ($class, $self) = @_;
	return $self;
}

*READLINE = \&next;

1;
__END__

=head1 Name

Sort::MergeSort::Iterator - iteration object

=head1 Synopsis

  my $input = Sort::MergeSort::Iterator->new( sub { ... } );

  while (<$input>) {
  }

  while (my $i = $input->next) {
  }

  my $ahead = $input->peek;

=head1 Description

This class implements a simple iterator interface for iterating over items.
Just pass a code reference to the constructor that returns the next value over
which to iterate. Sort::MergeSort::Iterator will do the rest.

=head2 FileHandle Interface

You can pretend that an Iterator object is a filehandle.   It doesn't support
all filehandle operations, but it does allow you to iterate in the natural
way:

 while (<$input>) {
 }

=head2 Instance Methods

=head1 Class Interface

=head2 Constructors

=head3 new

  my $iter = Sort::MergeSort::Iterator->new(\&code_ref);
  my $iter = Sort::MergeSort::Iterator->new(\&code_ref, \&destroy_code_ref);

Constructs and returns a new iterator object. The code reference passed as the
first argument is required and must return the next item to iterate over each
time it is called, and C<undef> when there are no more items. C<undef> cannot
itself be an item. The optional second argument must also be a code reference,
and will only be executed when the iterator object is destroyed (that is, it
will be called in the C<DESTROY()> method).

=head3 current

  my $current = $iter->current;

Returns the current item in the iterator--that is, the same item returned by
the most recent call to C<next()>.

=head3 next

  while (my $thing = $iter->next) {
	  # Do something with $thing.
  }

Returns the next item in the iterator. Returns C<undef> when there are no more
items to iterate.

=head3 peek

  while ($iter->peek) {
	  $iter->next;
  }

Returns the next item to be returned by C<next()> without actually removing it
from the list of items to be returned. The item returned by C<peek()> will be
returned by the next call to C<next()>. After that, it will not be available
from C<peek()> but the next item will be.

=head3 position

  my $pos = $iter->position;

Returns the current position in the iterator. After the first time C<next()>
is called, the position is set to 1. After the second time, it's set to 2. And
so on. If C<next()> has never been called, C<position()> returns 0.

=head3 all

  for my $item ($iter->all) {
	  print "Item: $item\n";
  }

Returns a list or array reference of all of the items to be returned by the
iterator. If C<next()> has been called prior to the call to C<all()>, then
only the remaining items in the iterator will be returned. Use this method
with caution, as it could cause a large number of items to be loaded into
memory at once.

=head3 do

  $iter->do( sub { print "$_[0]\n"; return $_[0]; } );
  $iter->do( sub { print "$_\n"; return $_; } );

Pass a code reference to this method to execute it for each item in the
iterator. Each item will be set to C<$_> before executing the code reference,
and will also be passed as the sole argument to the code reference. If
C<next()> has been called prior to the call to C<do()>, then only the
remaining items in the iterator will passed to the code reference. Iteration
terminates when the code reference returns false, so be sure to have it return
a true value if you want it to iterate over every item.

=head1 Author

David Wheeler <wheeler@searchme.com>

=head1 Copyright and License

Copyright (c) 2004-2008 Kineticode, Inc. <info@kineticode.com>.

This work was based on
L<Object::Relation::Iterator|Object::Relation::Iterator> module developed by
Kineticode, Inc. As such, it is is free software; it can be redistributed it
and/or modified it under the same terms as Perl itself.

=cut