File Coverage

blib/lib/Fey/NamedObjectSet.pm
Criterion Covered Total %
statement 11 13 84.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 16 18 88.8


line stmt bran cond sub pod time code
1             package Fey::NamedObjectSet;
2             BEGIN {
3 1     1   48247 $Fey::NamedObjectSet::VERSION = '0.40';
4             }
5              
6 1     1   10 use strict;
  1         2  
  1         43  
7 1     1   6 use warnings;
  1         2  
  1         31  
8 1     1   894 use namespace::autoclean;
  1         30237  
  1         9  
9              
10 1     1   778 use List::AllUtils qw( all pairwise );
  0            
  0            
11             use Tie::IxHash;
12              
13             use Fey::Types qw( HashRef Named );
14              
15             use Moose;
16              
17             has '_set' => (
18             is => 'bare',
19             isa => 'Tie::IxHash',
20             handles => {
21             _get => 'FETCH',
22             _add => 'STORE',
23             _delete => 'Delete',
24             _all => 'Values',
25             _keys => 'Keys',
26             },
27             required => 1,
28             );
29              
30             sub BUILDARGS {
31             my $class = shift;
32              
33             return { _set => Tie::IxHash->new( map { $_->name() => $_ } @_ ) };
34             }
35              
36             sub add {
37             my $self = shift;
38              
39             $self->_add( map { $_->name() => $_ } @_ );
40              
41             return;
42             }
43              
44             sub delete {
45             my $self = shift;
46              
47             $self->_delete( map { $_->name() } @_ );
48              
49             return;
50             }
51              
52             sub object {
53             my $self = shift;
54              
55             return $self->_get(shift);
56             }
57              
58             sub objects {
59             my $self = shift;
60              
61             return $self->_all() unless @_;
62              
63             return grep {defined} map { $self->_get($_) } @_;
64             }
65              
66             sub is_same_as {
67             my $self = shift;
68             my $other = shift;
69              
70             my @self_names = sort $self->_keys();
71             my @other_names = sort $other->_keys();
72              
73             return 0 unless @self_names == @other_names;
74              
75             return all {$_} pairwise { $a eq $b } @self_names, @other_names;
76             }
77              
78             __PACKAGE__->meta()->make_immutable();
79              
80             1;
81              
82             =head1 SYNOPSIS
83              
84             my $set = Fey::NamedObjectSet->new( $name_col, $size_col );
85              
86             =head1 DESCRIPTION
87              
88             This class represents a set of named objects, such as tables or
89             columns. You can look up objects in the set by name, or simply
90             retrieve all of the objects at once.
91              
92             It exists to simplify Fey's internals, since named sets of objects are
93             quite common in SQL.
94              
95             =head1 METHODS
96              
97             This class provides the following methods:
98              
99             =head2 Fey::NamedObjectSet->new(@objects)
100              
101             This method returns a new C<Fey::NamedObjectSet> object. Any objects
102             passed to this method are added to the set as it is created. Each
103             object passed must implement a C<name()> method, which is expected to
104             return a unique name for that object.
105              
106             =head2 $set->add(@objects)
107              
108             Adds one or more named objects to the set.
109              
110             =head2 $set->delete(@objects)
111              
112             This method accepts one or more objects and removes them from the set,
113             if they are part of it.
114              
115             =head2 $set->object($name)
116              
117             Given a name, this method returns the corresponding object.
118              
119             =head2 $set->objects(@names)
120              
121             When given a list of names as an argument, this method returns the
122             named objects in the order specified, if they exist in the set. If not
123             given any arguments it returns all of the objects in the set.
124              
125             =head2 $set->is_same_as($other_set)
126              
127             Given a C<Fey::NamedObjectSet>, this method indicates whether or not
128             the two sets are the same.
129              
130             =head1 BUGS
131              
132             See L<Fey> for details on how to report bugs.
133              
134             =cut