add start of Mouse/Moose based OO Interface to packages

[debbugs.git] / Debbugs / Collection.pm

diff --git a/Debbugs/Collection.pm b/Debbugs/Collection.pm
new file mode 100644 (file)
index 0000000..ee478c6
--- /dev/null
+++ b/Debbugs/Collection.pm
@@ -0,0 +1,167 @@
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Collection;
+
+=head1 NAME
+
+Debbugs::Collection -- Collection base class which can generate lots of objects
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+
+extends 'Debbugs::OOBase';
+
+has 'members' => (is => 'bare',
+                 isa => 'ArrayRef',
+                 traits => ['Array'],
+                 default => sub {[]},
+                  writer => '_set_members',
+                 handles => {_add => 'push',
+                             members => 'elements',
+                             count => 'count',
+                             _get_member => 'get',
+                              grep => 'grep',
+                              apply => 'apply',
+                              sort => 'sort',
+                            },
+                );
+
+has 'member_hash' => (traits => ['Hash'],
+                     is => 'ro',
+                     isa => 'HashRef[Int]',
+                     lazy => 1,
+                     reader => '_member_hash',
+                     builder => '_build_member_hash',
+                      clearer => '_clear_member_hash',
+                     predicate => '_has_member_hash',
+                     handles => {_add_member_hash => 'set',
+                                 _member_key_exists => 'exists',
+                                 _get_member_hash => 'get',
+                                },
+                    );
+
+has 'universe' => (is => 'ro',
+                   isa => 'Debbugs::Collection',
+                   required => 1,
+                   builder => '_build_universe',
+                   writer => '_set_universe',
+                   predicate => 'has_universe',
+                  );
+
+sub _build_universe {
+    # By default, the universe is myself
+    return $_[0];
+}
+
+sub limit {
+    my $self = shift;
+    my $limit = $self->clone();
+    # Set the universe to whatever my universe is (potentially myself)
+    $limit->_set_universe($self->universe);
+    $limit->_set_members();
+    $limit->_clear_member_hash();
+    $limit->add($self->universe->get_or_create(@_));
+    return $limit;
+}
+
+sub get_or_create {
+    my $self = shift;
+    my @return;
+    my @exists;
+    my @need_to_add;
+    for my $i (0..$#_) {
+        # we assume that if it's already a blessed reference, that it's the right
+        if (blessed($_[$i])) {
+            $return[$i] =
+                $_[$i];
+        }
+        elsif ($self->_member_key_exists($_[$i])) {
+            push @exists,$i;
+        } else {
+            push @need_to_add,$i;
+        }
+    }
+    # create and add by key
+    @return[@need_to_add] =
+        $self->add_by_key(@_[@need_to_add]);
+    @return[@exists] =
+        $self->get(@_[@exists]);
+    return @return;
+}
+
+has 'constructor_args' => (is => 'rw',
+                          isa => 'ArrayRef',
+                          default => sub {[]},
+                         );
+
+sub add_by_key {
+    my $self = shift;
+    # we'll assume that add does the right thing. around this in subclasses
+    return $self->add(@_);
+}
+
+sub add {
+    my $self = shift;
+    my @members_to_add;
+    for my $member (@_) {
+       if ($self->exists($member)) {
+           next;
+       }
+       $self->_add($member);
+       $self->_add_member_hash($self->member_key($member),
+                               $self->count(),
+                              );
+    }
+    $self->_add(@members_to_add);
+    return @members_to_add;
+}
+
+sub get {
+    my $self = shift;
+    return $self->_get_member($self->_get_member_hash(@_));
+}
+
+
+sub member_key {
+    return $_[1];
+}
+
+sub exists {
+    my $self = shift;
+    return $self->_member_key_exists($self->member_key($_[0]));
+}
+
+sub _build_member_hash {
+    my $self = shift;
+    my $hash = {};
+    my $i = 0;
+    for my $member ($self->members) {
+       $hash->{$self->member_key($member)} =
+           $i++;
+    }
+    return $hash;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End: