File Coverage

blib/lib/Fey/NamedObjectSet.pm
Criterion Covered Total %
statement 47 47 100.0
branch 4 4 100.0
condition n/a
subroutine 14 14 100.0
pod 6 6 100.0
total 71 71 100.0


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