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   17387 use strict;
  27         34  
  27         873  
4 27     27   112 use warnings;
  27         36  
  27         605  
5 27     27   669 use namespace::autoclean;
  27         15011  
  27         1042  
6              
7             our $VERSION = '0.42';
8              
9 27     27   15263 use List::AllUtils qw( all pairwise );
  27         360975  
  27         2860  
10 27     27   15516 use Tie::IxHash;
  27         105248  
  27         937  
11              
12 27     27   9518 use Fey::Types qw( HashRef Named );
  27         97  
  27         234  
13              
14 27     27   293460 use Moose 0.90;
  27         850  
  27         261  
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 1143 my $class = shift;
31              
32 944         2260 return { _set => Tie::IxHash->new( map { $_->name() => $_ } @_ ) };
  767         17251  
33             }
34              
35             sub add {
36 930     930 1 4430 my $self = shift;
37              
38 930         1643 $self->_add( map { $_->name() => $_ } @_ );
  930         20485  
39              
40 930         99760 return;
41             }
42              
43             sub delete {
44 9     9 1 974 my $self = shift;
45              
46 9         24 $self->_delete( map { $_->name() } @_ );
  9         181  
47              
48 9         1136 return;
49             }
50              
51             sub object {
52 2944     2944 1 37086 my $self = shift;
53              
54 2944         7142 return $self->_get(shift);
55             }
56              
57             sub objects {
58 37     37 1 535 my $self = shift;
59              
60 37 100       160 return $self->_all() unless @_;
61              
62 17         42 return grep {defined} map { $self->_get($_) } @_;
  30         2096  
  30         1448  
63             }
64              
65             sub is_same_as {
66 122     122 1 765 my $self = shift;
67 122         200 my $other = shift;
68              
69 122         566 my @self_names = sort $self->_keys();
70 122         14173 my @other_names = sort $other->_keys();
71              
72 122 100       12963 return 0 unless @self_names == @other_names;
73              
74 116     120   1792 return all {$_} pairwise { $a eq $b } @self_names, @other_names;
  120         569  
  120         628  
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