File Coverage

blib/lib/List/Uniq.pm
Criterion Covered Total %
statement 35 37 94.5
branch 15 16 93.7
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 57 60 95.0


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             List::Uniq - extract the unique elements of a list
5              
6             =head1 SYNOPSIS
7              
8             use List::Uniq ':all';
9              
10             @uniq = uniq(@list);
11              
12             $list = [ qw|foo bar baz foo| ];
13             $uniq = uniq($list);
14              
15             =head1 DESCRIPTION
16              
17             List::Uniq extracts the unique elements of a list. This is a commonly
18             re-written (or at least re-looked-up) idiom in Perl programs.
19              
20             =cut
21              
22             package List::Uniq;
23 8     8   6097 use base 'Exporter';
  8         18  
  8         895  
24              
25 8     8   53 use strict;
  8         15  
  8         174  
26 8     8   37 use warnings;
  8         14  
  8         1858  
27              
28             our $VERSION = '0.23';
29              
30             # set up exports
31             our @EXPORT;
32             our @EXPORT_OK;
33             our %EXPORT_TAGS;
34             $EXPORT_TAGS{all} = [qw|uniq|];
35             Exporter::export_ok_tags('all');
36              
37             =head1 FUNCTIONS
38              
39             =head2 uniq( { OPTIONS }, ele1, ele2, ..., eleN )
40              
41             uniq() takes a list of elements and returns the unique elements of the list.
42             Each element may be a scalar value or a reference to a list.
43              
44             If the first element is a hash reference it is taken to be a set of options
45             that alter the way in which the unique filter is applied. The keys of the
46             option set are:
47              
48             =over 4
49              
50             =item * sort
51              
52             If set to a true value, the unique elements of the list will be returned
53             sorted. Perl's default sort will be used unless the B option is
54             also passed.
55              
56             B defaults to false.
57              
58             =item * flatten
59              
60             If set to a true value, array references in the list will be recursively
61             flattened, such that
62              
63             ( 'foo', [ [ 'bar' ] ], [ [ [ 'baz', 'quux' ] ] ] )
64              
65             becomes
66              
67             ( 'foo', 'bar', 'baz', 'quux' )
68              
69             B defaults to true.
70              
71             =item * compare
72              
73             A code reference that will be used to sort the elements of the list if the
74             B option is set. Passing a non-coderef will cause B to throw an
75             exception.
76              
77             The code ref will be passed a pair of list elements to be compared and
78             should return the same values as the L
79             operator.
80              
81             Using a custom sort slows things down because the sort routine will be
82             outside of the List::Uniq package. This requires that the pairs to be
83             compared be passed as parameters to the sort routine, not set as package
84             globals (see L). If speed is a concern, you are better off
85             sorting the return of B yourself.
86              
87             =back
88              
89             The return value is a list of the unique elements if called in list context
90             or a reference to a list of unique elements if called in scalar context.
91              
92             =cut
93              
94             my %default_opts = ( sort => 0, flatten => 1 );
95              
96             sub uniq {
97              
98             # pull options off the front of the list
99 18     18 1 9884 my $opts;
100 18 100       60 if ( ref $_[0] eq 'HASH' ) {
101 9         16 $opts = shift @_;
102             }
103 18         55 for my $opt ( keys %default_opts ) {
104 36 100       85 unless ( defined $opts->{$opt} ) {
105 27         57 $opts->{$opt} = $default_opts{$opt};
106             }
107             }
108              
109 18         68 my @list = @_;
110              
111             # flatten list references
112 18 100       45 if ( $opts->{flatten} ) {
113 17         43 @list = _unwrap( \@list );
114             }
115              
116             # uniq the elements
117 18         33 my @elements;
118             my %seen;
119             {
120 8     8   63 no warnings 'uninitialized';
  8         15  
  8         2604  
  18         25  
121 18         33 @elements = grep { !$seen{$_}++ } @list;
  143         309  
122             }
123              
124             # sort before returning if so desired
125 18 100       50 if ( $opts->{sort} ) {
126 7 100       22 if ( $opts->{compare} ) {
127 5 50       12 unless ( 'CODE' eq ref $opts->{compare} ) {
128 0         0 require Carp;
129 0         0 Carp::croak("compare option is not a CODEREF");
130             }
131 5         19 @elements = sort { $opts->{compare}->( $a, $b ) } @elements;
  69         174  
132             }
133             else {
134 2         10 @elements = sort @elements;
135             }
136             }
137              
138             # return a list or list ref
139 18 100       138 return wantarray ? @elements : \@elements;
140             }
141              
142             sub _unwrap {
143 54     54   98 my @list = @_;
144              
145 54 100       84 return map { 'ARRAY' eq ref $_ ? _unwrap(@$_) : $_ } @list;
  179         391  
146             }
147              
148             # keep require happy
149             1;
150              
151             __END__