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