File Coverage

blib/lib/Uniq.pm
Criterion Covered Total %
statement 38 38 100.0
branch 11 12 91.6
condition 8 9 88.8
subroutine 5 5 100.0
pod 0 3 0.0
total 62 67 92.5


line stmt bran cond sub pod time code
1             package Uniq;
2            
3 1     1   483 use strict;
  1         2  
  1         32  
4 1     1   5 use warnings;
  1         2  
  1         293  
5            
6             require Exporter;
7            
8             our @ISA = qw(Exporter);
9            
10             our @EXPORT = qw( uniq dups distinct );
11            
12             our $VERSION = '0.01';
13            
14             sub uniq{
15             # Eliminates redundant values from sorted list of values input.
16 4     4 0 82 my $prev = undef;
17 4         5 my @out;
18 4         10 foreach my $val (@_){
19 32 100 100     119 next if $prev && ($prev eq $val);
20 28         32 $prev = $val;
21 28         45 push(@out, $val);
22             }
23 4         26 return @out;
24             }
25             sub dups{
26             # Returns a list of values that occur multiple times in
27             # the sorted list of values supplied as input.
28 1     1 0 12 my $prev = undef;
29 1         2 my $ins = undef;
30 1         2 my @out;
31 1         3 foreach my $val (@_){
32 9 100 100     43 if ($prev && $prev eq $val){
33 2 50 66     11 next if ($ins && $ins eq $val);
34 2         14 push(@out, $val);
35 2         8 $ins = $val;
36            
37             }else{
38 7         11 $prev = $val;
39             }
40             }
41 1         5 return @out;
42             }
43             sub distinct{
44             # Eliminates values mentioned more than once from a list of
45             # sorted values presented.
46 1     1 0 14 my $prev = undef;
47 1         2 my $ctr = 0;
48 1         3 my @out;
49 1         2 foreach my $val (@_){
50 9 100       16 if ($prev){
51 8 100       19 if ($prev eq $val){
52 2         3 $ctr ++;
53 2         5 next;
54             }
55 6 100       15 push(@out,$prev) if ($ctr == 1);
56 6         8 $prev = $val;
57 6         6 $ctr = 1;
58 6         9 next;
59             }else{
60 1         1 $prev = $val;
61 1         2 $ctr = 1;
62             }
63            
64             }
65 1         6 return @out;
66             }
67             1;
68             __END__