File Coverage

blib/lib/Set/Object/Weak.pm
Criterion Covered Total %
statement 25 25 100.0
branch 2 2 100.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 3 3 100.0
total 40 41 97.5


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Set::Object::Weak - Sets without the referant reference increment
5              
6             =head1 SYNOPSIS
7              
8             use Set::Object::Weak qw(weak_set);
9              
10             my $set = Set::Object::Weak->new( 0, "", {}, [], $object );
11             # or
12             my $set = weak_set( 0, "", {}, [], $object );
13              
14             print $set->size; # 2 - the scalars aren't objects
15              
16             =head1 DESCRIPTION
17              
18             Sets, but weak. See L<Set::Object/weaken>.
19              
20             Note that the C<set> in C<Set::Object::Weak> returns weak sets. This
21             is intentional, so that you can make all the sets in scope weak just
22             by changing C<use Set::Object> to C<use Set::Object::Weak>.
23              
24             =cut
25              
26             package Set::Object::Weak;
27 42     42   290 use strict;
  42         95  
  42         1397  
28 42     42   231 use base qw(Set::Object); # boo hiss no moose::role yet I hear you say
  42         73  
  42         6021  
29              
30 42     42   291 use base qw(Exporter); # my users would hate me otherwise
  42         1833  
  42         3502  
31 42     42   2131 use vars qw(@ISA @EXPORT_OK);
  42         90  
  42         5915  
32 42     42   307 use Set::Object qw(blessed);
  42         3654  
  42         11404  
33              
34             our @EXPORT_OK = qw(weak_set set);
35              
36             =head1 CONSTRUCTORS
37              
38             =over
39              
40             =item new
41              
42             This class method is exactly the same as C<Set::Object-E<gt>new>,
43             except that it returns a weak set.
44              
45             =cut
46              
47             sub new {
48 9     9 1 6990 my $class = shift;
49 9         44 my $self = $class->SUPER::new();
50 9         33 $self->weaken;
51 9         38 $self->insert(@_);
52 9         31 $self;
53             }
54              
55             =item weak_set( ... )
56              
57             This optionally exported B<function> is a shortcut for saying
58             C<Set::Object::Weak-E<gt>new(...)>.
59              
60             =cut
61              
62              
63             sub weak_set {
64 1     1 1 520 __PACKAGE__->new(@_);
65             }
66              
67             =item set( ... )
68              
69             This method is exported so that if you see:
70              
71             use Set::Object qw(set);
72              
73             You can turn it into using weak sets lexically with:
74              
75             use Set::Object::Weak qw(set);
76              
77             Set::Object 1.19 had a bug in this method that meant that it would not
78             add the passed members into it.
79              
80             =cut
81              
82             sub set {
83 7     7 1 533 my $class = __PACKAGE__;
84 7 100 66     70 if (blessed $_[0] and $_[0]->isa("Set::Object")) {
85 6         20 $class = (shift)->strong_pkg;
86             }
87 7         40 $class->new(@_);
88             }
89              
90             1;
91              
92             __END__
93              
94             =back
95              
96             =head1 SEE ALSO
97              
98             L<Set::Object>
99              
100             =head1 CREDITS
101              
102             Perl magic by Sam Vilain, <samv@cpan.org>
103              
104             Idea from nothingmuch.