DBIx-DR

 view release on metacpan or  search on metacpan

lib/DBIx/DR/Iterator.pm  view on Meta::CPAN

use utf8;
use strict;
use warnings;

package DBIx::DR::Iterator;
use Scalar::Util qw(blessed weaken);
use DBIx::DR::Util;
use Carp;


# Perl 5.18 refuses smartmatch
my $is = sub($$) {
    my ($v1, $v2) = @_;
    return 0 if defined($v1) xor defined($v2);
    return 1 unless defined $v1;
    return $v1 eq $v2;
};


sub new {
    my ($class, $fetch, %opts) = @_;

    my ($is_hash, $is_array) = (0, 0);

    my $count;

    if ('ARRAY' eq ref $fetch) {
        $is_array = 1;
        if ($count = @$fetch) {
            croak 'You must use array of hashrefs'
                unless 'HASH' eq ref $fetch->[0] or blessed $fetch->[0];
        }
    } elsif ('HASH' eq ref $fetch) {
        $is_hash = 1;
        my ($k) = each %$fetch;
        if ($count = keys %$fetch) {
            croak 'You must use hash of hashrefs'
                unless 'HASH' eq ref $fetch->{$k} or blessed $fetch->{$k};
        }
    } else {
        croak "You should bless 'HASHREF' or 'ARRAYREF' value";
    }


    my ($item_class, $item_constructor) =
        camelize($opts{'-item'} || 'dbix-dr-iterator-item#new');

    my $keep_blessed = $opts{-keep_blessed};
    $keep_blessed //= 1;


    return bless {
        fetch               => $fetch,
        is_hash             => $is_hash,
        is_array            => $is_array,
        count               => $count,
        iterator            => 0,
        item_class          => $item_class,
        item_constructor    => $item_constructor,
        is_changed          => 0,
        keep_blessed        => $keep_blessed,
        noitem_iter         => $opts{-noitem_iter} ? 1 : 0,
    } => ref($class) || $class;
}

lib/DBIx/DR/Iterator.pm  view on Meta::CPAN

    $item;
}


sub find : method {
    my ($self, $field, $value) = @_;

    $self->reset;
    while(my $item = $self->next) {
        return $item if $is->($item->$field, $value);
    }
    return;
}



package DBIx::DR::Iterator::Item;
use Scalar::Util ();
use Carp ();

# to exclude this method from AUTOLOAD
sub DESTROY {}

sub AUTOLOAD {
    our $AUTOLOAD;
    my ($method) = $AUTOLOAD =~ /.*::(.*)/;
    my ($self, $value) = @_;

    Carp::croak "Can't find method '$self->$method'" unless ref $self;
    Carp::croak "Can't find method '$method' in this item"
        unless exists $self->{$method};

    if (@_ > 1) {
        my $is_changed;

        if (ref $value and ref $self->{$method}) {
            $is_changed = Scalar::Util::refaddr($value)
                != Scalar::Util::refaddr($self->{$method});
        } elsif(ref($value) ne ref($self->{$method})) {
            $is_changed = 1;
        } elsif(defined $value and defined $self->{$method}) {
            $is_changed = $value ne $self->{$method};
        } elsif(defined $value xor defined $self->{$method}) {
            $is_changed = 1;
        }

        $self->is_changed(1) if $is_changed;
        $self->{$method} = $value;
    }

    return $self->{$method};
}

sub new {
    my ($class, $object, $iterator) = @_;
    return unless defined $object;
    Carp::croak "Usage: DBIx::DR::Iterator::Item->new(HASHREF [, iterator ])"
        unless 'HASH' eq ref $object;
    my $self = bless $object => ref($class) || $class;
    $self->{iterator} = $iterator;
    Scalar::Util::weaken($self->{iterator});
    $self->{is_changed} = 0;
    return $self;
}

sub is_changed {
    my ($self, $value) = @_;
    if (@_ > 1) {{
        $self->{is_changed} = $value ? 1 : 0;

        last unless $self->{is_changed};
        last unless Scalar::Util::blessed $self->{iterator};
        last unless $self->{iterator}->can('is_changed');
        $self->{iterator}->is_changed( 1 );
    }}
    return $self->{is_changed};
}

sub can {
    my ($self, $method) = @_;
    return 1 if ref $self and exists $self->{$method};
    return $self->SUPER::can($method);
}


1;

=head1 NAME

DBIx::DR::Iterator - iterator for L<DBIx::DR>.

=head1 SYNOPSIS

    my $it = DBIx::DR::Iterator->new($arrayref);

    printf "Rows count: %d\n", $it->count;

    while(my $row == $it->next) {
        print "Row: %s\n", $row->field;
    }

    my $row = $it->get(15); # element 15



    my $it = DBIx::DR::Iterator->new($hashref);

    printf "Rows count: %d\n", $it->count;

    while(my $row == $it->next) {
        print "Row: %s\n", $row->field;
    }

    my $row = $it->get('abc'); # element with key name eq 'abc'


=head1 DESCRIPTION

The package constructs iterator from HASHREF or ARRAYREF value.

=head1 Methods

lib/DBIx/DR/Iterator.pm  view on Meta::CPAN

=head2 get(name|number)

Returns element by 'B<name|number>'. It will throw exception if element
isn't L<exists|exists(name|number)>.

=head2 next

Returns next element or B<undef>.

=head2 reset

Resets internal iterator (that is used by L<next>).

=head2 all

Returns all elements (as an array).

If You notice an argument it will extract specified fields:

    my @ids = $it->all('id');

The same as:

    my @ids = map { $_->id } $it->all;

=head2 grep

Constructs new iterator that is subset of parent iterator.

    my $busy = $list->grep(sub { $_[0]->busy ? 1 : 0 });

=head2 push

Pushes one element into iterator.

If You use HASH-iterator You have to note key name.

=head3 Example

    $hiter->push(abc => { id => 1 });
    $hiter->push(abc => $oiter->get('abc'));

    $aiter->push({ id => 1 });

=head1 DBIx::DR::Iterator::Item

One row. It has methods names coincident with field names. Also it has a few
additional methods:

=head2 new

Constructor. Receives two arguments: B<HASHREF> and link to
L<iterator|DBIx::DR::Iterator>.

    my $row = DBIx::DR::Iterator::Item->new({ id => 1 });
    $row = DBIx::DR::Iterator::Item->new({ id => 1 }, $iterator); }

=head2 iterator

Returns (or set) iterator object. The link is created by constructor.
This is a L<weaken|Scalar::Util/weaken> link.

=head2 is_changed

Returns (or set) flag if the row has been changed. If You change any of
row's fields the flag will be set. Also iterator's flag will be set.


=head1 COPYRIGHT

 Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
 Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>

 This program is free software, you can redistribute it and/or
 modify it under the terms of the Artistic License.

=cut