File Coverage

blib/lib/MDK/Common/DataStructure.pm
Criterion Covered Total %
statement 9 84 10.7
branch 0 20 0.0
condition 0 5 0.0
subroutine 3 24 12.5
pod 19 20 95.0
total 31 153 20.2


line stmt bran cond sub pod time code
1             package MDK::Common::DataStructure;
2              
3             =head1 NAME
4              
5             MDK::Common::DataStructure - miscellaneous list/hash manipulation functions
6              
7             =head1 SYNOPSIS
8              
9             use MDK::Common::DataStructure qw(:all);
10              
11             =head1 EXPORTS
12              
13             =over
14              
15             =item sort_numbers(LIST)
16              
17             numerical sort (small numbers at beginning)
18              
19             =item ikeys(HASH)
20              
21             aka I, as simple as C=E $b } keys>
22              
23             =item add2hash(HASH REF, HASH REF)
24              
25             adds to the first hash the second hash if the key/value is not already there
26              
27             =item add2hash_
28              
29             adds to the first hash the second hash if the key is not already there
30              
31             =item put_in_hash
32              
33             adds to the first hash the second hash, crushing existing key/values
34              
35             =item member(SCALAR, LIST)
36              
37             is the value in the list?
38              
39             =item invbool(SCALAR REF)
40              
41             toggles the boolean value
42              
43             =item listlength(LIST)
44              
45             returns the length of the list. Useful in list (opposed to array) context:
46              
47             sub f { "a", "b" }
48             my $l = listlength f();
49              
50             whereas C would return "b"
51              
52             =item deref(REF)
53              
54             de-reference
55              
56             =item deref_array(REF)
57              
58             de-reference arrays:
59              
60             deref_array [ "a", "b" ] #=> ("a", "b")
61             deref_array "a" #=> "a"
62              
63             =item is_empty_array_ref(SCALAR)
64              
65             is the scalar undefined or is the array empty
66              
67             =item is_empty_hash_ref(SCALAR)
68              
69             is the scalar undefined or is the hash empty
70              
71             =item uniq(LIST)
72              
73             returns the list with no duplicates (keeping the first elements)
74              
75             =item uniq_ { CODE } LIST
76              
77             returns the list with no duplicates according to the scalar results of CODE on each element of LIST (keeping the first elements)
78              
79             uniq_ { $_->[1] } [ 1, "fo" ], [ 2, "fob" ], [ 3, "fo" ], [ 4, "bar" ]
80              
81             gives [ 1, "fo" ], [ 2, "fob" ], [ 4, "bar" ]
82              
83             =item difference2(ARRAY REF, ARRAY REF)
84              
85             returns the first list without the element of the second list
86              
87             =item intersection(ARRAY REF, ARRAY REF, ...)
88              
89             returns the elements which are in all lists
90              
91             =item next_val_in_array(SCALAR, ARRAY REF)
92              
93             finds the value that follow the scalar in the list (circular):
94             C gives C<1>
95             (do not use a list with duplicates)
96              
97             =item group_by2(LIST)
98              
99             interprets the list as an ordered hash, returns a list of [key,value]:
100             C 2, 3 => 4, 5 => 6)> gives C<[1,2], [3,4], [5,6]>
101              
102             =item list2kv(LIST)
103              
104             interprets the list as an ordered hash, returns the keys and the values:
105             C 2, 3 => 4, 5 => 6)> gives C<[1,3,5], [2,4,6]>
106              
107             =back
108              
109             =head1 SEE ALSO
110              
111             L
112              
113             =cut
114              
115              
116 1     1   229 use MDK::Common::Math;
  1         2  
  1         36  
117 1     1   274 use MDK::Common::Func;
  1         3  
  1         41  
118              
119              
120 1     1   6 use Exporter;
  1         1  
  1         747  
121             our @ISA = qw(Exporter);
122             our @EXPORT_OK = qw(sort_numbers ikeys add2hash add2hash_ put_in_hash member invbool listlength deref deref_array is_empty_array_ref is_empty_hash_ref uniq uniq_ difference2 intersection next_val_in_array group_by2 list2kv);
123             our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
124              
125              
126 0     0 1   sub sort_numbers { sort { $a <=> $b } @_ }
  0            
127 0     0 1   sub ikeys { my %l = @_; sort { $a <=> $b } keys %l }
  0            
  0            
128 0 0   0 1   sub put_in_hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} = $v } $a }
  0            
  0            
  0            
  0            
129 0 0 0 0 1   sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } $a }
  0            
  0            
  0            
  0            
130 0 0   0 1   sub add2hash_ { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { exists $a->{$k} or $a->{$k} = $v } $a }
  0 0          
  0            
  0            
  0            
131 0 0   0 1   sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
  0            
  0            
  0            
132 0     0 1   sub invbool { my $a = shift; $$a = !$$a; $$a }
  0            
  0            
133 0     0 1   sub listlength { scalar @_ }
134 0   0 0 0   sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] }
135 0 0   0 1   sub deref { ref($_[0]) eq "ARRAY" ? @{$_[0]} : ref($_[0]) eq "HASH" ? %{$_[0]} : $_[0] }
  0 0          
  0            
136 0 0   0 1   sub deref_array { ref($_[0]) eq "ARRAY" ? @{$_[0]} : $_[0] }
  0            
137              
138 0 0   0 1   sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
  0            
139 0 0   0 1   sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
  0            
140              
141 0     0 1   sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
  0            
  0            
  0            
142 0     0 1   sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
  0            
  0            
  0            
  0            
  0            
143 0     0 1   sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = () } keys %l }
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
144              
145             sub uniq_(&@) {
146 0     0 1   my $f = shift;
147 0           my %l;
148 0           $l{$f->($_)} = 1 foreach @_;
149 0           grep { delete $l{$f->($_)} } @_;
  0            
150             }
151              
152              
153             sub next_val_in_array {
154 0     0 1   my ($v, $l) = @_;
155 0     0     my %l = MDK::Common::Func::mapn(sub { @_ }, $l, [ @$l[1..$#$l], $l->[0] ]);
  0            
156 0           $l{$v};
157             }
158              
159              
160             sub list2kv {
161 0     0 1   my (@k, @v);
162 0           for (my $i = 0; $i < @_; $i += 2) {
163 0           push @k, $_[$i + 0];
164 0           push @v, $_[$i + 1];
165             }
166 0           \@k, \@v;
167             }
168              
169             sub group_by2 {
170 0     0 1   my @l;
171 0           for (my $i = 0; $i < @_; $i += 2) {
172 0           push @l, [ $_[$i], $_[$i+1] ];
173             }
174 0           @l;
175             }
176              
177              
178             1;