view release on metacpan or  search on metacpan

lib/Farly/Object/Aggregate.pm  view on Meta::CPAN

    my @sorted = sort {

        my $r;
        foreach my $key (@keys) {
            $r = $a->get($key)->compare( $b->get($key) );
            return $r if ( $r != 0 );
        }
        return $r;

    } @$list;

    my @grouped;

    for ( my $i = 0 ; $i != scalar(@sorted) ; $i++ ) {

        my $root = Farly::Object->new();

        foreach my $key (@keys) {
            $root->set( $key, $sorted[$i]->get($key) );
        }

        my $result = Farly::Object::List->new();

        my $j = $i;

        while ( $sorted[$j]->matches($root) ) {

            $result->add( $sorted[$j] );

            $j++;

            last() if $j == scalar(@sorted);
        }

        $i = $j - 1;

        $root->set( '__AGG__', $result );

        push @grouped, $root;
    }

    $self->{'GROUPED'} = \@grouped;
}

# input = search object
# return the __AGG__ object on first match
sub matches {
    my ( $self, $search ) = @_;

    foreach my $object ( $self->iter() ) {
        if ( $object->matches($search) ) {
            return $object->get('__AGG__');
        }
    }

    #return an empty List on no match
    return Farly::Object::List->new();
}

# input = search object and new __AGG__
sub update {
    my ( $self, $search, $list ) = @_;

    confess "Farly::Object::List required"
      unless defined($list);

    confess "Farly::Object::List required"
      unless $list->isa('Farly::Object::List');

    foreach my $object ( $self->iter() ) {
        if ( $object->matches($search) ) {
            $object->set( '__AGG__', $list );
            return;
        }
    }

    confess $search->dump(), " not found";
}

1;
__END__

=head1 NAME

Farly::Object::Aggregate - Group Farly::Objects with common identity

=head1 SYNOPSIS

  use Farly::Object;
 
  my $list = Farly::Object::List->new();
 
  my $object1 = Farly::Object->new();
  my $object2 = Farly::Object->new();
  
  $object1->set( 'id', Farly::Value::String->new('id1234') );
  $object2->set( 'id', Farly::Value::String->new('id1234') );
  .
  .
  .
  More $object attributes
  
  $list->add($object1);
  $list->add($object2);
 
  my $aggregate = Farly::Object::Aggregate->new( $list );
  $aggregate->groupby( 'id' );

  my $id = Farly::Object->new();
  $id->set( 'id', Farly::Value::String->new('id1234') );

  my $list = $aggregate->matches( $id );

=head1 DESCRIPTION

Farly::Object::Aggregate groups Farly::Objects with a common
identity (i.e. equal key/value pairs) into Farly::Object::Lists.

=head1 METHODS

=head2 new()