File Coverage

blib/lib/Set/Scalar/Valued.pm
Criterion Covered Total %
statement 33 69 47.8
branch 1 8 12.5
condition n/a
subroutine 9 22 40.9
pod 0 10 0.0
total 43 109 39.4


line stmt bran cond sub pod time code
1             package Set::Scalar::Valued;
2              
3 1     1   578 use strict;
  1         2  
  1         47  
4             local $^W = 1;
5              
6 1     1   5 use vars qw($VERSION @ISA);
  1         1  
  1         92  
7              
8             $VERSION = '1.29';
9             @ISA = qw(Set::Scalar::Base Set::Scalar::Real);
10              
11 1     1   715 use Set::Scalar::Base qw(_make_elements as_string _strval);
  1         2  
  1         89  
12 1     1   664 use Set::Scalar::Real;
  1         3  
  1         43  
13 1     1   570 use Set::Scalar::ValuedUniverse;
  1         3  
  1         56  
14              
15             use overload
16 1         5 '""' => \&as_string,
17 1     1   5 'cmp' => \&cmp;
  1         3  
18              
19 0     0 0 0 sub ELEMENT_SEPARATOR { ", " }
20 0     0 0 0 sub VALUE_SEPARATOR { " => " }
21 0     0 0 0 sub SET_FORMAT { "{%s}" }
22              
23             sub _make_valued_elements {
24 4     4   4 my $elements = shift;
25 4         5 my %elements;
26              
27 4         16 while (my ($key, $value) = splice @$elements, 0, 2) {
28 4         13 $elements{ _strval($key) } = [ $key, $value ];
29             }
30              
31 4         23 return %elements;
32             }
33              
34             sub _insert_hook {
35 4     4   5 my $self = shift;
36              
37 4 50       12 if (@_) {
38 4         7 my $elements = shift;
39              
40 4         16 $self->universe->_extend( { _make_elements( map { $_->[0] }
  4         12  
41             values %$elements ) } );
42 4         16 $self->_insert_elements( $elements );
43             }
44             }
45              
46             sub _new_hook {
47 4     4   6 my $self = shift;
48 4         6 my $elements = shift;
49              
50 4         15 $self->{'universe'} = Set::Scalar::ValuedUniverse->universe;
51              
52 4         8 $self->_insert( { _make_valued_elements( $elements ) } );
53             }
54              
55             sub insert {
56 0     0 0   my $self = shift;
57              
58 0           $self->_insert( { _make_valued_elements \@_ } );
59             }
60              
61             sub _valued_elements {
62 0     0     my $self = shift;
63              
64 0           return @_ ?
65 0           @{ $self->{'elements'} }{ map { _strval($_) } @_ } :
  0            
66 0 0         values %{ $self->{'elements'} };
67             }
68              
69             sub valued_elements {
70 0     0 0   my $self = shift;
71              
72 0           return map { @$_ } $self->_valued_elements(@_);
  0            
73             }
74              
75             *valued_members = \&valued_elements;
76              
77             sub value {
78 0     0 0   my $self = shift;
79 0           my $member = shift;
80              
81 0           return $self->{'elements'}->{ $member };
82             }
83              
84             sub elements {
85 0     0 0   my $self = shift;
86              
87 0           return map { $_->[0] } $self->_valued_elements(@_);
  0            
88             }
89              
90             sub values {
91 0     0 0   my $self = shift;
92              
93 0           return map { $_->[1] } $self->_valued_elements(@_);
  0            
94             }
95              
96             sub _elements_as_string {
97 0     0     my $self = shift;
98              
99 0           my %valued_elements = $self->valued_elements;
100 0           my $value_separator = $self->_value_separator;
101              
102 0           my @elements = map { $_ .
  0            
103             $value_separator .
104             $valued_elements{$_}
105             } keys %valued_elements;
106              
107 0           return (join($self->_element_separator, sort @elements),
108             $self->_elements_have_reference([%valued_elements]));
109             }
110              
111             sub _value_separator {
112 0     0     my $self = shift;
113              
114 0 0         return $self->{'display'}->{'value_separator'}
115             if exists $self->{'display'}->{'value_separator'};
116              
117 0           my $universe = $self->universe;
118              
119 0 0         return $universe->{'display'}->{'value_separator'}
120             if exists $universe->{'display'}->{'value_separator'};
121              
122 0           return (ref $self)->VALUE_SEPARATOR;
123             }
124              
125             sub invert {
126 0     0 0   my $self = shift;
127              
128 0           $self->_invert( { _make_valued_elements \@_ } );
129             }
130              
131             sub fill {
132 0     0 0   die "$0: ", __PACKAGE__, "::fill() inappropriate.\n";
133             }
134              
135             =pod
136              
137             =head1 NAME
138              
139             Set::Scalar::Valued - valued sets
140              
141             =head1 SYNOPSIS
142              
143             use Set::Scalar::Valued;
144             $s = Set::Scalar::Valued->new;
145             $s->insert(a => 12, 'b c' => $d);
146             $s->delete('b c' => $d);
147             $t = Set::Scalar->new(x => $y, y => $z);
148              
149             =head1 DESCRIPTION
150              
151             Valued sets are an extension of the traditional set concept. In
152             addition to a member just existing in the set, the member also has a
153             distinct value. You can think of this a combination of a traditional
154             set and a Perl hash.
155              
156             The used methods are as for the traditional of Set::Scalar, with
157             the difference that when creating (new()) or modifying (insert(),
158             delete(), invert()), you must supply twice the number of arguments:
159             the member-value pairs, instead of just the members. Note, though,
160             that in the current implementation of delete() the value half is
161             unused, the deletion is by the member. In future implementation
162             this behavior may change so that also the value matters.
163              
164             There are a couple of additional methods:
165              
166             %ve = $s->valued_members;
167              
168             which returns the member-value pairs, and
169              
170             @v = $s->values;
171              
172             which returns just the values (in the same order as the members()
173             method would return the members), and
174              
175             $v = $s->value($member);
176              
177             which returns the value of the member.
178              
179             The display format of a valued set is the member-value pairs separated
180             by " => ", the pairs separated by ", " and enclosed in curly brackets {}.
181              
182             =head1 AUTHOR
183              
184             Jarkko Hietaniemi
185              
186             =cut
187              
188             1;