local-lib5/lib/perl5/Data/OptList.pm

   1
   2 package Data::OptList;
   3 use strict;
   4 use warnings;
   5
   6 use List::Util ();
   7 use Params::Util ();
   8 use Sub::Install 0.92 ();
   9
  10 =head1 NAME
  11
  12 Data::OptList - parse and validate simple name/value option pairs
  13
  14 =head1 VERSION
  15
  16 version 0.104
  17
  18 =cut
  19
  20 our $VERSION = '0.104';
  21
  22 =head1 SYNOPSIS
  23
  24   use Data::OptList;
  25
  26   my $options = Data::Optlist::mkopt([
  27     qw(key1 key2 key3 key4),
  28     key5 => { ... },
  29     key6 => [ ... ],
  30     key7 => sub { ... },
  31     key8 => { ... },
  32     key8 => [ ... ],
  33   ]);
  34
  35 ...is the same thing, more or less, as:
  36
  37   my $options = [
  38     [ key1 => undef,        ],
  39     [ key2 => undef,        ],
  40     [ key3 => undef,        ],
  41     [ key4 => undef,        ],
  42     [ key5 => { ... },      ],
  43     [ key6 => [ ... ],      ],
  44     [ key7 => sub { ... },  ],
  45     [ key8 => { ... },      ],
  46     [ key8 => [ ... ],      ],
  47   ]);
  48
  49 =head1 DESCRIPTION
  50
  51 Hashes are great for storing named data, but if you want more than one entry
  52 for a name, you have to use a list of pairs.  Even then, this is really boring
  53 to write:
  54
  55   $values = [
  56     foo => undef,
  57     bar => undef,
  58     baz => undef,
  59     xyz => { ... },
  60   ];
  61
  62 Just look at all those undefs!  Don't worry, we can get rid of those:
  63
  64   $values = [
  65     map { $_ => undef } qw(foo bar baz),
  66     xyz => { ... },
  67   ];
  68
  69 Aaaauuugh!  We've saved a little typing, but now it requires thought to read,
  70 and thinking is even worse than typing... and it's got a bug!  It looked right,
  71 didn't it?  Well, the C<< xyz => { ... } >> gets consumed by the map, and we
  72 don't get the data we wanted.
  73
  74 With Data::OptList, you can do this instead:
  75
  76   $values = Data::OptList::mkopt([
  77     qw(foo bar baz),
  78     xyz => { ... },
  79   ]);
  80
  81 This works by assuming that any defined scalar is a name and any reference
  82 following a name is its value.
  83
  84 =head1 FUNCTIONS
  85
  86 =head2 mkopt
  87
  88   my $opt_list = Data::OptList::mkopt(
  89     $input,
  90     $moniker,
  91     $require_unique,
  92     $must_be,
  93   );
  94
  95 This produces an array of arrays; the inner arrays are name/value pairs.
  96 Values will be either "undef" or a reference.
  97
  98 Valid values for C<$input>:
  99
 100  undef    -> []
 101  hashref  -> [ [ key1 => value1 ] ... ] # non-ref values become undef
 102  arrayref -> every value followed by a ref becomes a pair: [ value => ref   ]
 103              every value followed by undef becomes a pair: [ value => undef ]
 104              otherwise, it becomes [ value => undef ] like so:
 105              [ "a", "b", [ 1, 2 ] ] -> [ [ a => undef ], [ b => [ 1, 2 ] ] ]
 106
 107 C<$moniker> is a name describing the data, which will be used in error
 108 messages.
 109
 110 If C<$require_unique> is true, an error will be thrown if any name is given
 111 more than once.
 112
 113 C<$must_be> is either a scalar or array of scalars; it defines what kind(s) of
 114 refs may be values.  If an invalid value is found, an exception is thrown.  If
 115 no value is passed for this argument, any reference is valid.  If C<$must_be>
 116 specifies that values must be CODE, HASH, ARRAY, or SCALAR, then Params::Util
 117 is used to check whether the given value can provide that interface.
 118 Otherwise, it checks that the given value is an object of the kind.
 119
 120 In other words:
 121
 122   [ qw(SCALAR HASH Object::Known) ]
 123
 124 Means:
 125
 126   _SCALAR0($value) or _HASH($value) or _INSTANCE($value, 'Object::Known')
 127
 128 =cut
 129
 130 my %test_for;
 131 BEGIN {
 132   %test_for = (
 133     CODE   => \&Params::Util::_CODELIKE,  ## no critic
 134     HASH   => \&Params::Util::_HASHLIKE,  ## no critic
 135     ARRAY  => \&Params::Util::_ARRAYLIKE, ## no critic
 136     SCALAR => \&Params::Util::_SCALAR0,   ## no critic
 137   );
 138 }
 139
 140 sub __is_a {
 141   my ($got, $expected) = @_;
 142
 143   return List::Util::first { __is_a($got, $_) } @$expected if ref $expected;
 144
 145   return defined (
 146     exists($test_for{$expected})
 147     ? $test_for{$expected}->($got)
 148     : Params::Util::_INSTANCE($got, $expected) ## no critic
 149   );
 150 }
 151
 152 sub mkopt {
 153   my ($opt_list, $moniker, $require_unique, $must_be) = @_;
 154
 155   return [] unless $opt_list;
 156
 157   $opt_list = [
 158     map { $_ => (ref $opt_list->{$_} ? $opt_list->{$_} : ()) } keys %$opt_list
 159   ] if ref $opt_list eq 'HASH';
 160
 161   my @return;
 162   my %seen;
 163
 164   for (my $i = 0; $i < @$opt_list; $i++) { ## no critic
 165     my $name = $opt_list->[$i];
 166     my $value;
 167
 168     if ($require_unique) {
 169       Carp::croak "multiple definitions provided for $name" if $seen{$name}++;
 170     }
 171
 172     if    ($i == $#$opt_list)             { $value = undef;            }
 173     elsif (not defined $opt_list->[$i+1]) { $value = undef; $i++       }
 174     elsif (ref $opt_list->[$i+1])         { $value = $opt_list->[++$i] }
 175     else                                  { $value = undef;            }
 176
 177     if ($must_be and defined $value) {
 178       unless (__is_a($value, $must_be)) {
 179         my $ref = ref $value;
 180         Carp::croak "$ref-ref values are not valid in $moniker opt list";
 181       }
 182     }
 183
 184     push @return, [ $name => $value ];
 185   }
 186
 187   return \@return;
 188 }
 189
 190 =head2 mkopt_hash
 191
 192   my $opt_hash = Data::OptList::mkopt_hash($input, $moniker, $must_be);
 193
 194 Given valid C<L</mkopt>> input, this routine returns a reference to a hash.  It
 195 will throw an exception if any name has more than one value.
 196
 197 =cut
 198
 199 sub mkopt_hash {
 200   my ($opt_list, $moniker, $must_be) = @_;
 201   return {} unless $opt_list;
 202
 203   $opt_list = mkopt($opt_list, $moniker, 1, $must_be);
 204   my %hash = map { $_->[0] => $_->[1] } @$opt_list;
 205   return \%hash;
 206 }
 207
 208 =head1 EXPORTS
 209
 210 Both C<mkopt> and C<mkopt_hash> may be exported on request.
 211
 212 =cut
 213
 214 BEGIN {
 215   *import = Sub::Install::exporter {
 216     exports => [qw(mkopt mkopt_hash)],
 217   };
 218 }
 219
 220 =head1 AUTHOR
 221
 222 Ricardo SIGNES, C<< <rjbs@cpan.org> >>
 223
 224 =head1 BUGS
 225
 226 Please report any bugs or feature requests at L<http://rt.cpan.org>. I will be
 227 notified, and then you'll automatically be notified of progress on your bug as
 228 I make changes.
 229
 230 =head1 COPYRIGHT
 231
 232 Copyright 2006-2007, Ricardo SIGNES.  This program is free software;  you can
 233 redistribute it and/or modify it under the same terms as Perl itself.
 234
 235 =cut
 236
 237 1;