Showing 3 changed files with 611 additions and 12181 deletions
+9 -29
cpanfile
... ...
@@ -1,36 +1,16 @@
1
-requires 'DBI', '== 1.625';
2
-requires 'DBD::SQLite', '== 1.40';
3
-requires 'Object::Simple', '== 3.09';
4
-requires 'DBIx::Custom', '== 0.28';
5
-requires 'Config::Tiny', '== 2.14';
6
-requires 'Time::HiRes', '== 1.9725';
7
-requires 'Test::Simple', '== 0.98';
8
-requires 'Validator::Custom', '== 1.01';
1
+requires 'Time::HiRes', '== 1.9732';
2
+requires 'DBD::SQLite', '== 1.50';
3
+requires 'DBI', '== 1.634';
9 4
 requires 'DBIx::Connector', '== 0.53';
10
-requires 'Module::Build', '== 0.4003';
11
-requires 'Test::Harness', '== 3.26';
12
-requires 'Module::Metadata', '== 1.000011';
13
-requires 'Perl::OSType', '== 1.003';
14
-requires 'ExtUtils::CBuilder', '== 0.280205';
15
-requires 'File::Spec', '== 3.40';
16
-requires 'IPC::Cmd', '== 0.80';
17
-requires 'Locale::Maketext::Simple', '== 0.21';
18
-requires 'Module::Load::Conditional', '== 0.54';
19
-requires 'Module::Load', '== 0.24';
20
-requires 'Params::Check', '== 0.36';
21
-requires 'ExtUtils::ParseXS', '== 3.24';
22
-requires 'Test::MockModule', '== 0.05';
23
-requires 'Digest::SHA', '== 5.84';
24
-requires 'Text::Markdown::Hoedown', '== 1.01';
25
-requires 'parent', '== 0.228';
5
+requires 'Object::Simple', '== 3.14';
6
+requires 'DBIx::Custom', '== 0.36';
7
+requires 'Validator::Custom', '== 1.01';
8
+requires 'Config::Tiny', '== 2.23';
26 9
 requires 'Data::Page', '== 2.02';
27
-requires 'Class::Accessor::Chained', '== 0.01';
28
-requires 'Class::Accessor', '== 0.34';
29
-requires 'Test::Exception', '== 0.32';
30
-requires 'Sub::Uplevel', '== 0.24';
31
-requires 'Data::Page::Navigation', '== 0.06';
32 10
 requires 'Data::Page::Navigation', '== 0.06';
11
+requires 'Mojolicious', '== 6.57';
33 12
 requires 'Mojolicious::Plugin::BasicAuth', '== 0.08';
34 13
 requires 'Mojolicious::Plugin::AutoRoute', '== 0.19';
35 14
 requires 'Mojolicious::Plugin::INIConfig', '== 0.03';
36 15
 requires 'Mojolicious::Plugin::DBViewer', '== 0.28';
16
+requires 'Text::Markdown::Hoedown', '== 1.01';
+600 -12150
cpanm 1000644 → 1000755
... ...
@@ -1,481 +1,35 @@
1 1
 #!/usr/bin/env perl
2 2
 #
3
-# You want to install cpanminus? Run the following command and it will
4
-# install itself for you. You might want to run it as a root with sudo
5
-# if you want to install to places like /usr/local/bin.
3
+# This is a pre-compiled source code for the cpanm (cpanminus) program.
4
+# For more details about how to install cpanm, go to the following URL:
6 5
 #
7
-#   % curl -L http://cpanmin.us | perl - --self-upgrade
6
+#   https://github.com/miyagawa/cpanminus
8 7
 #
9
-# If you don't have curl but wget, replace `curl -L` with `wget -O -`.
8
+# Quickstart: Run the following command and it will install itself for
9
+# you. You might want to run it as a root with sudo if you want to install
10
+# to places like /usr/local/bin.
10 11
 #
11
-# For more details about this program, visit http://search.cpan.org/dist/App-cpanminus
12
+#   % curl -L https://cpanmin.us | perl - App::cpanminus
12 13
 #
14
+# If you don't have curl but wget, replace `curl -L` with `wget -O -`.
15
+
13 16
 # DO NOT EDIT -- this is an auto generated file
17
+
14 18
 # This chunk of stuff was generated by App::FatPacker. To find the original
15 19
 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
16 20
 BEGIN {
17 21
 my %fatpacked;
18 22
 
19
-$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
20
-  package App::cpanminus;
21
-  our $VERSION = "1.6005";
22
-  
23
-  =head1 NAME
24
-  
25
-  App::cpanminus - get, unpack, build and install modules from CPAN
26
-  
27
-  =head1 SYNOPSIS
28
-  
29
-      cpanm Module
30
-  
31
-  Run C<cpanm -h> or C<perldoc cpanm> for more options.
32
-  
33
-  =head1 DESCRIPTION
34
-  
35
-  cpanminus is a script to get, unpack, build and install modules from
36
-  CPAN and does nothing else.
37
-  
38
-  It's dependency free (can bootstrap itself), requires zero
39
-  configuration, and stands alone. When running, it requires only 10MB
40
-  of RAM.
41
-  
42
-  =head1 INSTALLATION
43
-  
44
-  There are several ways to install cpanminus to your system.
45
-  
46
-  =head2 Package management system
47
-  
48
-  There are Debian packages, RPMs, FreeBSD ports, and packages for other
49
-  operation systems available. If you want to use the package management system,
50
-  search for cpanminus and use the appropriate command to install. This makes it
51
-  easy to install C<cpanm> to your system without thinking about where to
52
-  install, and later upgrade.
53
-  
54
-  =head2 Installing to system perl
55
-  
56
-  You can also use the latest cpanminus to install cpanminus itself:
57
-  
58
-      curl -L http://cpanmin.us | perl - --sudo App::cpanminus
59
-  
60
-  This will install C<cpanm> to your bin directory like
61
-  C</usr/local/bin> (unless you configured C<INSTALL_BASE> with
62
-  L<local::lib>), so you probably need the C<--sudo> option.
63
-  
64
-  =head2 Installing to local perl (perlbrew)
65
-  
66
-  If you have perl in your home directory, which is the case if you use
67
-  tools like L<perlbrew>, you don't need the C<--sudo> option, since
68
-  you're most likely to have a write permission to the perl's library
69
-  path. You can just do:
70
-  
71
-      curl -L http://cpanmin.us | perl - App::cpanminus
72
-  
73
-  to install the C<cpanm> executable to the perl's bin path, like
74
-  C<~/perl5/perlbrew/bin/cpanm>.
75
-  
76
-  =head2 Downloading the standalone executable
77
-  
78
-  You can also copy the standalone executable to whatever location you'd like.
79
-  
80
-      cd ~/bin
81
-      curl -LO http://xrl.us/cpanm
82
-      chmod +x cpanm
83
-      # edit shebang if you don't have /usr/bin/env
84
-  
85
-  This just works, but be sure to grab the new version manually when you
86
-  upgrade because C<--self-upgrade> might not work for this.
87
-  
88
-  =head1 DEPENDENCIES
89
-  
90
-  perl 5.8 or later.
91
-  
92
-  =over 4
93
-  
94
-  =item *
95
-  
96
-  'tar' executable (bsdtar or GNU tar version 1.22 are rcommended) or Archive::Tar to unpack files.
97
-  
98
-  =item *
99
-  
100
-  C compiler, if you want to build XS modules.
101
-  
102
-  =item *
103
-  
104
-  make
105
-  
106
-  =item *
107
-  
108
-  Module::Build (core in 5.10)
109
-  
110
-  =back
111
-  
112
-  =head1 QUESTIONS
113
-  
114
-  =head2 Another CPAN installer?
115
-  
116
-  OK, the first motivation was this: the CPAN shell runs out of memory (or swaps
117
-  heavily and gets really slow) on Slicehost/linode's most affordable plan with
118
-  only 256MB RAM. Should I pay more to install perl modules from CPAN? I don't
119
-  think so.
120
-  
121
-  =head2 But why a new client?
122
-  
123
-  First of all, let me be clear that CPAN and CPANPLUS are great tools
124
-  I've used for I<literally> years (you know how many modules I have on
125
-  CPAN, right?). I really respect their efforts of maintaining the most
126
-  important tools in the CPAN toolchain ecosystem.
127
-  
128
-  However, for less experienced users (mostly from outside the Perl community),
129
-  or even really experienced Perl developers who know how to shoot themselves in
130
-  their feet, setting up the CPAN toolchain often feels like yak shaving,
131
-  especially when all they want to do is just install some modules and start
132
-  writing code.
133
-  
134
-  =head2 Zero-conf? How does this module get/parse/update the CPAN index?
135
-  
136
-  It queries the CPAN Meta DB site at L<http://cpanmetadb.plackperl.org/>.
137
-  The site is updated at least every hour to reflect the latest changes
138
-  from fast syncing mirrors. The script then also falls back to query the
139
-  module at L<http://metacpan.org/> using its wonderful API.
140
-  
141
-  Fetched files are unpacked in C<~/.cpanm> and automatically cleaned up
142
-  periodically.  You can configure the location of this with the
143
-  C<PERL_CPANM_HOME> environment variable.
144
-  
145
-  =head2 Where does this install modules to? Do I need root access?
146
-  
147
-  It installs to wherever ExtUtils::MakeMaker and Module::Build are
148
-  configured to (via C<PERL_MM_OPT> and C<PERL_MB_OPT>). So if you're
149
-  using local::lib, then it installs to your local perl5
150
-  directory. Otherwise it installs to the site_perl directory that
151
-  belongs to your perl.
152
-  
153
-  cpanminus at a boot time checks whether you have configured
154
-  local::lib, or have the permission to install modules to the site_perl
155
-  directory.  If neither, it automatically sets up local::lib compatible
156
-  installation path in a C<perl5> directory under your home
157
-  directory. To avoid this, run the script as the root user, with
158
-  C<--sudo> option or with C<--local-lib> option.
159
-  
160
-  =head2 cpanminus can't install the module XYZ. Is it a bug?
161
-  
162
-  It is more likely a problem with the distribution itself. cpanminus
163
-  doesn't support or is known to have issues with distributions like as
164
-  follows:
165
-  
166
-  =over 4
167
-  
168
-  =item *
169
-  
170
-  Tests that require input from STDIN.
171
-  
172
-  =item *
173
-  
174
-  Tests that might fail when C<AUTOMATED_TESTING> is enabled.
175
-  
176
-  =item *
177
-  
178
-  Modules that have invalid numeric values as VERSION (such as C<1.1a>)
179
-  
180
-  =back
181
-  
182
-  These failures can be reported back to the author of the module so
183
-  that they can fix it accordingly, rather than me.
184
-  
185
-  =head2 Does cpanm support the feature XYZ of L<CPAN> and L<CPANPLUS>?
186
-  
187
-  Most likely not. Here are the things that cpanm doesn't do by
188
-  itself. And it's a feature - you got that from the name I<minus>,
189
-  right?
190
-  
191
-  If you need these features, use L<CPAN>, L<CPANPLUS> or the standalone
192
-  tools that are mentioned.
193
-  
194
-  =over 4
195
-  
196
-  =item *
197
-  
198
-  Bundle:: module dependencies
199
-  
200
-  =item *
201
-  
202
-  CPAN testers reporting
203
-  
204
-  =item *
205
-  
206
-  Building RPM packages from CPAN modules
207
-  
208
-  =item *
209
-  
210
-  Listing the outdated modules that needs upgrading. See L<App::cpanoutdated>
211
-  
212
-  =item *
213
-  
214
-  Uninstalling modules. See L<pm-uninstall>.
215
-  
216
-  =item *
217
-  
218
-  Showing the changes of the modules you're about to upgrade. See L<cpan-listchanges>
219
-  
220
-  =item *
221
-  
222
-  Patching CPAN modules with distroprefs.
223
-  
224
-  =back
225
-  
226
-  See L<cpanm> or C<cpanm -h> to see what cpanminus I<can> do :)
227
-  
228
-  =head1 COPYRIGHT
229
-  
230
-  Copyright 2010- Tatsuhiko Miyagawa
231
-  
232
-  The standalone executable contains the following modules embedded.
233
-  
234
-  =over 4
235
-  
236
-  =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
237
-  
238
-  =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
239
-  
240
-  =item L<local::lib> Copyright 2007-2009 Matt S Trout
241
-  
242
-  =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
243
-  
244
-  =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
245
-  
246
-  =item L<version> Copyright 2004-2010 John Peacock
247
-  
248
-  =item L<JSON::PP> Copyright 2007−2011 by Makamaka Hannyaharamitu
249
-  
250
-  =item L<CPAN::Meta>, L<CPAN::Meta::Requirements> Copyright (c) 2010 by David Golden and Ricardo Signes
251
-  
252
-  =item L<CPAN::Meta::YAML> Copyright 2010 Adam Kennedy
253
-  
254
-  =item L<File::pushd> Copyright 2012 David Golden
255
-  
256
-  =back
257
-  
258
-  =head1 LICENSE
259
-  
260
-  Same as Perl.
261
-  
262
-  =head1 CREDITS
263
-  
264
-  =head2 CONTRIBUTORS
265
-  
266
-  Patches and code improvements were contributed by:
267
-  
268
-  Goro Fuji, Kazuhiro Osawa, Tokuhiro Matsuno, Kenichi Ishigaki, Ian
269
-  Wells, Pedro Melo, Masayoshi Sekimura, Matt S Trout (mst), squeeky,
270
-  horus and Ingy dot Net.
271
-  
272
-  =head2 ACKNOWLEDGEMENTS
273
-  
274
-  Bug reports, suggestions and feedbacks were sent by, or general
275
-  acknowledgement goes to:
276
-  
277
-  Jesse Vincent, David Golden, Andreas Koenig, Jos Boumans, Chris
278
-  Williams, Adam Kennedy, Audrey Tang, J. Shirley, Chris Prather, Jesse
279
-  Luehrs, Marcus Ramberg, Shawn M Moore, chocolateboy, Chirs Nehren,
280
-  Jonathan Rockway, Leon Brocard, Simon Elliott, Ricardo Signes, AEvar
281
-  Arnfjord Bjarmason, Eric Wilhelm, Florian Ragwitz and xaicron.
282
-  
283
-  =head1 COMMUNITY
284
-  
285
-  =over 4
286
-  
287
-  =item L<http://github.com/miyagawa/cpanminus> - source code repository, issue tracker
288
-  
289
-  =item L<irc://irc.perl.org/#toolchain> - discussions about Perl toolchain. I'm there.
290
-  
291
-  =back
292
-  
293
-  =head1 NO WARRANTY
294
-  
295
-  This software is provided "as-is," without any express or implied
296
-  warranty. In no event shall the author be held liable for any damages
297
-  arising from the use of the software.
298
-  
299
-  =head1 SEE ALSO
300
-  
301
-  L<CPAN> L<CPANPLUS> L<pip>
302
-  
303
-  =cut
304
-  
305
-  1;
23
+$fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS';
24
+  package App::cpanminus;our$VERSION="1.7040";1;
306 25
 APP_CPANMINUS
307 26
 
308
-$fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
309
-  package App::cpanminus::script;
310
-  use strict;
311
-  use Config;
312
-  use Cwd ();
313
-  use App::cpanminus;
314
-  use File::Basename ();
315
-  use File::Find ();
316
-  use File::Path ();
317
-  use File::Spec ();
318
-  use File::Copy ();
319
-  use File::Temp ();
320
-  use Getopt::Long ();
321
-  use Parse::CPAN::Meta;
322
-  use Symbol ();
323
-  
324
-  use constant WIN32 => $^O eq 'MSWin32';
325
-  use constant SUNOS => $^O eq 'solaris';
326
-  
327
-  our $VERSION = $App::cpanminus::VERSION;
328
-  
329
-  if ($INC{"App/FatPacker/Trace.pm"}) {
330
-      require JSON::PP;
331
-      require CPAN::Meta::YAML;
332
-      require CPAN::Meta::Prereqs;
333
-      require version::vpp;
334
-      require File::pushd;
335
-  }
336
-  
337
-  my $quote = WIN32 ? q/"/ : q/'/;
338
-  
339
-  sub agent {
340
-      my $self = shift;
341
-      "cpanminus/$VERSION perl/$]";
342
-  }
343
-  
344
-  sub determine_home {
345
-      my $class = shift;
346
-  
347
-      my $homedir = $ENV{HOME}
348
-        || eval { require File::HomeDir; File::HomeDir->my_home }
349
-        || join('', @ENV{qw(HOMEDRIVE HOMEPATH)}); # Win32
350
-  
351
-      if (WIN32) {
352
-          require Win32; # no fatpack
353
-          $homedir = Win32::GetShortPathName($homedir);
354
-      }
355
-  
356
-      return "$homedir/.cpanm";
357
-  }
358
-  
359
-  sub new {
360
-      my $class = shift;
361
-  
362
-      bless {
363
-          home => $class->determine_home,
364
-          cmd  => 'install',
365
-          seen => {},
366
-          notest => undef,
367
-          test_only => undef,
368
-          installdeps => undef,
369
-          force => undef,
370
-          sudo => undef,
371
-          make  => undef,
372
-          verbose => undef,
373
-          quiet => undef,
374
-          interactive => undef,
375
-          log => undef,
376
-          mirrors => [],
377
-          mirror_only => undef,
378
-          mirror_index => undef,
379
-          perl => $^X,
380
-          argv => [],
381
-          local_lib => undef,
382
-          self_contained => undef,
383
-          prompt_timeout => 0,
384
-          prompt => undef,
385
-          configure_timeout => 60,
386
-          try_lwp => 1,
387
-          try_wget => 1,
388
-          try_curl => 1,
389
-          uninstall_shadows => ($] < 5.012),
390
-          skip_installed => 1,
391
-          skip_satisfied => 0,
392
-          auto_cleanup => 7, # days
393
-          pod2man => 1,
394
-          installed_dists => 0,
395
-          showdeps => 0,
396
-          scandeps => 0,
397
-          scandeps_tree => [],
398
-          format   => 'tree',
399
-          save_dists => undef,
400
-          skip_configure => 0,
401
-          verify => 0,
402
-          @_,
403
-      }, $class;
404
-  }
405
-  
406
-  sub env {
407
-      my($self, $key) = @_;
408
-      $ENV{"PERL_CPANM_" . $key};
409
-  }
410
-  
411
-  sub parse_options {
412
-      my $self = shift;
413
-  
414
-      local @ARGV = @{$self->{argv}};
415
-      push @ARGV, split /\s+/, $self->env('OPT');
416
-      push @ARGV, @_;
417
-  
418
-      Getopt::Long::Configure("bundling");
419
-      Getopt::Long::GetOptions(
420
-          'f|force'   => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
421
-          'n|notest!' => \$self->{notest},
422
-          'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
423
-          'S|sudo!'   => \$self->{sudo},
424
-          'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
425
-          'verify!'   => \$self->{verify},
426
-          'q|quiet!'  => \$self->{quiet},
427
-          'h|help'    => sub { $self->{action} = 'show_help' },
428
-          'V|version' => sub { $self->{action} = 'show_version' },
429
-          'perl=s'    => \$self->{perl},
430
-          'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
431
-          'L|local-lib-contained=s' => sub {
432
-              $self->{local_lib} = $self->maybe_abs($_[1]);
433
-              $self->{self_contained} = 1;
434
-              $self->{pod2man} = undef;
435
-          },
436
-          'mirror=s@' => $self->{mirrors},
437
-          'mirror-only!' => \$self->{mirror_only},
438
-          'mirror-index=s'  => \$self->{mirror_index},
439
-          'cascade-search!' => \$self->{cascade_search},
440
-          'prompt!'   => \$self->{prompt},
441
-          'installdeps' => \$self->{installdeps},
442
-          'skip-installed!' => \$self->{skip_installed},
443
-          'skip-satisfied!' => \$self->{skip_satisfied},
444
-          'reinstall'    => sub { $self->{skip_installed} = 0 },
445
-          'interactive!' => \$self->{interactive},
446
-          'i|install' => sub { $self->{cmd} = 'install' },
447
-          'info'      => sub { $self->{cmd} = 'info' },
448
-          'look'      => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
449
-          'self-upgrade' => sub { $self->check_upgrade; $self->{cmd} = 'install'; $self->{skip_installed} = 1; push @ARGV, 'App::cpanminus' },
450
-          'uninst-shadows!'  => \$self->{uninstall_shadows},
451
-          'lwp!'    => \$self->{try_lwp},
452
-          'wget!'   => \$self->{try_wget},
453
-          'curl!'   => \$self->{try_curl},
454
-          'auto-cleanup=s' => \$self->{auto_cleanup},
455
-          'man-pages!' => \$self->{pod2man},
456
-          'scandeps'   => \$self->{scandeps},
457
-          'showdeps'   => sub { $self->{showdeps} = 1; $self->{skip_installed} = 0 },
458
-          'format=s'   => \$self->{format},
459
-          'save-dists=s' => sub {
460
-              $self->{save_dists} = $self->maybe_abs($_[1]);
461
-          },
462
-          'skip-configure!' => \$self->{skip_configure},
463
-          'dev!'       => \$self->{dev_release},
464
-          'metacpan!'  => \$self->{metacpan},
465
-      );
466
-  
467
-      if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
468
-          push @ARGV, $self->load_argv_from_fh(\*STDIN);
469
-          $self->{load_from_stdin} = 1;
470
-      }
471
-  
472
-      $self->{argv} = \@ARGV;
473
-  }
474
-  
475
-  sub check_upgrade {
476
-      if ($0 !~ /^$Config{installsitebin}/) {
477
-          if ($0 =~ m!perlbrew/bin!) {
478
-              warn <<WARN;
27
+$fatpacked{"App/cpanminus/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_DEPENDENCY';
28
+  package App::cpanminus::Dependency;use strict;use CPAN::Meta::Requirements;sub from_prereqs {my($class,$prereqs,$phases,$types)=@_;my@deps;for my$type (@$types){push@deps,$class->from_versions($prereqs->merged_requirements($phases,[$type])->as_string_hash,$type,)}return@deps}sub from_versions {my($class,$versions,$type)=@_;my@deps;while (my($module,$version)=each %$versions){push@deps,$class->new($module,$version,$type)}@deps}sub merge_with {my($self,$requirements)=@_;$self->{original_version}=$self->version;eval {$requirements->add_string_requirement($self->module,$self->version)};if ($@ =~ /illegal requirements/){warn sprintf("Can't merge requirements for %s: '%s' and '%s'",$self->module,$self->version,$requirements->requirements_for_module($self->module))}$self->{version}=$requirements->requirements_for_module($self->module)}sub new {my($class,$module,$version,$type)=@_;bless {module=>$module,version=>$version,type=>$type || 'requires',},$class}sub module {$_[0]->{module}}sub version {$_[0]->{version}}sub type {$_[0]->{type}}sub requires_version {my$self=shift;if (defined$self->{original_version}){return$self->{original_version}}$self->version}sub is_requirement {$_[0]->{type}eq 'requires'}1;
29
+APP_CPANMINUS_DEPENDENCY
30
+
31
+$fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT';
32
+  package App::cpanminus::script;use strict;use Config;use Cwd ();use App::cpanminus;use App::cpanminus::Dependency;use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use Getopt::Long ();use Symbol ();use String::ShellQuote ();use version ();use constant WIN32=>$^O eq 'MSWin32';use constant BAD_TAR=>($^O eq 'solaris' || $^O eq 'hpux');use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION=$App::cpanminus::VERSION;if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}my$quote=WIN32 ? q/"/ : q/'/;sub agent {my$self=shift;my$agent="cpanminus/$VERSION";$agent .= " perl/$]" if$self->{report_perl_version};$agent}sub determine_home {my$class=shift;my$homedir=$ENV{HOME}|| eval {require File::HomeDir;File::HomeDir->my_home}|| join('',@ENV{qw(HOMEDRIVE HOMEPATH)});if (WIN32){require Win32;$homedir=Win32::GetShortPathName($homedir)}return "$homedir/.cpanm"}sub new {my$class=shift;bless {home=>$class->determine_home,cmd=>'install',seen=>{},notest=>undef,test_only=>undef,installdeps=>undef,force=>undef,sudo=>undef,make=>undef,verbose=>undef,quiet=>undef,interactive=>undef,log=>undef,mirrors=>[],mirror_only=>undef,mirror_index=>undef,cpanmetadb=>"http://cpanmetadb.plackperl.org/v1.0/",perl=>$^X,argv=>[],local_lib=>undef,self_contained=>undef,exclude_vendor=>undef,prompt_timeout=>0,prompt=>undef,configure_timeout=>60,build_timeout=>3600,test_timeout=>1800,try_lwp=>1,try_wget=>1,try_curl=>1,uninstall_shadows=>($] < 5.012),skip_installed=>1,skip_satisfied=>0,auto_cleanup=>7,pod2man=>1,installed_dists=>0,install_types=>['requires'],with_develop=>0,showdeps=>0,scandeps=>0,scandeps_tree=>[],format=>'tree',save_dists=>undef,skip_configure=>0,verify=>0,report_perl_version=>!$class->maybe_ci,build_args=>{},features=>{},pure_perl=>0,cpanfile_path=>'cpanfile',@_,},$class}sub env {my($self,$key)=@_;$ENV{"PERL_CPANM_" .$key}}sub maybe_ci {my$class=shift;grep$ENV{$_},qw(TRAVIS CI AUTOMATED_TESTING AUTHOR_TESTING)}sub install_type_handlers {my$self=shift;my@handlers;for my$type (qw(recommends suggests)){push@handlers,"with-$type"=>sub {my%uniq;$self->{install_types}=[grep!$uniq{$_}++,@{$self->{install_types}},$type ]};push@handlers,"without-$type"=>sub {$self->{install_types}=[grep $_ ne $type,@{$self->{install_types}}]}}@handlers}sub build_args_handlers {my$self=shift;my@handlers;for my$phase (qw(configure build test install)){push@handlers,"$phase-args=s"=>\($self->{build_args}{$phase})}@handlers}sub parse_options {my$self=shift;local@ARGV=@{$self->{argv}};push@ARGV,grep length,split /\s+/,$self->env('OPT');push@ARGV,@_;Getopt::Long::Configure("bundling");Getopt::Long::GetOptions('f|force'=>sub {$self->{skip_installed}=0;$self->{force}=1},'n|notest!'=>\$self->{notest},'test-only'=>sub {$self->{notest}=0;$self->{skip_installed}=0;$self->{test_only}=1},'S|sudo!'=>\$self->{sudo},'v|verbose'=>\$self->{verbose},'verify!'=>\$self->{verify},'q|quiet!'=>\$self->{quiet},'h|help'=>sub {$self->{action}='show_help'},'V|version'=>sub {$self->{action}='show_version'},'perl=s'=>sub {$self->diag("--perl is deprecated since it's known to be fragile in figuring out dependencies. Run `$_[1] -S cpanm` instead.\n",1);$self->{perl}=$_[1]},'l|local-lib=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1])},'L|local-lib-contained=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1]);$self->{self_contained}=1;$self->{pod2man}=undef},'self-contained!'=>\$self->{self_contained},'exclude-vendor!'=>\$self->{exclude_vendor},'mirror=s@'=>$self->{mirrors},'mirror-only!'=>\$self->{mirror_only},'mirror-index=s'=>sub {$self->{mirror_index}=$self->maybe_abs($_[1])},'M|from=s'=>sub {$self->{mirrors}=[$_[1]];$self->{mirror_only}=1},'cpanmetadb=s'=>\$self->{cpanmetadb},'cascade-search!'=>\$self->{cascade_search},'prompt!'=>\$self->{prompt},'installdeps'=>\$self->{installdeps},'skip-installed!'=>\$self->{skip_installed},'skip-satisfied!'=>\$self->{skip_satisfied},'reinstall'=>sub {$self->{skip_installed}=0},'interactive!'=>\$self->{interactive},'i|install'=>sub {$self->{cmd}='install'},'info'=>sub {$self->{cmd}='info'},'look'=>sub {$self->{cmd}='look';$self->{skip_installed}=0},'U|uninstall'=>sub {$self->{cmd}='uninstall'},'self-upgrade'=>sub {$self->{action}='self_upgrade'},'uninst-shadows!'=>\$self->{uninstall_shadows},'lwp!'=>\$self->{try_lwp},'wget!'=>\$self->{try_wget},'curl!'=>\$self->{try_curl},'auto-cleanup=s'=>\$self->{auto_cleanup},'man-pages!'=>\$self->{pod2man},'scandeps'=>\$self->{scandeps},'showdeps'=>sub {$self->{showdeps}=1;$self->{skip_installed}=0},'format=s'=>\$self->{format},'save-dists=s'=>sub {$self->{save_dists}=$self->maybe_abs($_[1])},'skip-configure!'=>\$self->{skip_configure},'dev!'=>\$self->{dev_release},'metacpan!'=>\$self->{metacpan},'report-perl-version!'=>\$self->{report_perl_version},'configure-timeout=i'=>\$self->{configure_timeout},'build-timeout=i'=>\$self->{build_timeout},'test-timeout=i'=>\$self->{test_timeout},'with-develop'=>\$self->{with_develop},'without-develop'=>sub {$self->{with_develop}=0},'with-feature=s'=>sub {$self->{features}{$_[1]}=1},'without-feature=s'=>sub {$self->{features}{$_[1]}=0},'with-all-features'=>sub {$self->{features}{__all}=1},'pp|pureperl!'=>\$self->{pure_perl},"cpanfile=s"=>\$self->{cpanfile_path},$self->install_type_handlers,$self->build_args_handlers,);if (!@ARGV && $0 ne '-' &&!-t STDIN){push@ARGV,$self->load_argv_from_fh(\*STDIN);$self->{load_from_stdin}=1}$self->{argv}=\@ARGV}sub check_upgrade {my$self=shift;my$install_base=$ENV{PERL_LOCAL_LIB_ROOT}? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}): $Config{installsitebin};if ($0 eq '-'){return}elsif ($0 !~ /^$install_base/){if ($0 =~ m!perlbrew/bin!){die <<DIE}else {die <<DIE}}}sub check_libs {my$self=shift;return if$self->{_checked}++;$self->bootstrap_local_lib}sub setup_verify {my$self=shift;my$has_modules=eval {require Module::Signature;require Digest::SHA;1};$self->{cpansign}=$self->which('cpansign');unless ($has_modules && $self->{cpansign}){warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";$self->{verify}=0}}sub parse_module_args {my($self,$module)=@_;$module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;if ($module =~ /\~[v\d\._,\!<>= ]+$/){return split /\~/,$module,2}else {return$module,undef}}sub doit {my$self=shift;my$code;eval {$code=($self->_doit==0)};if (my$e=$@){warn$e;$code=1}return$code}sub _doit {my$self=shift;$self->setup_home;$self->init_tools;$self->setup_verify if$self->{verify};if (my$action=$self->{action}){$self->$action()and return 1}return$self->show_help(1)unless @{$self->{argv}}or $self->{load_from_stdin};$self->configure_mirrors;my$cwd=Cwd::cwd;my@fail;for my$module (@{$self->{argv}}){if ($module =~ s/\.pm$//i){my ($volume,$dirs,$file)=File::Spec->splitpath($module);$module=join '::',grep {$_}File::Spec->splitdir($dirs),$file}($module,my$version)=$self->parse_module_args($module);$self->chdir($cwd);if ($self->{cmd}eq 'uninstall'){$self->uninstall_module($module)or push@fail,$module}else {$self->install_module($module,0,$version)or push@fail,$module}}if ($self->{base}&& $self->{auto_cleanup}){$self->cleanup_workdirs}if ($self->{installed_dists}){my$dists=$self->{installed_dists}> 1 ? "distributions" : "distribution";$self->diag("$self->{installed_dists} $dists installed\n",1)}if ($self->{scandeps}){$self->dump_scandeps()}$self->chdir($cwd);return!@fail}sub setup_home {my$self=shift;$self->{home}=$self->env('HOME')if$self->env('HOME');unless (_writable($self->{home})){die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n"}$self->{base}="$self->{home}/work/" .time .".$$";File::Path::mkpath([$self->{base}],0,0777);$self->{log}=File::Spec->catfile($self->{base},"build.log");my$final_log="$self->{home}/build.log";{open my$out,">$self->{log}" or die "$self->{log}: $!"}if (CAN_SYMLINK){my$build_link="$self->{home}/latest-build";unlink$build_link;symlink$self->{base},$build_link;unlink$final_log;symlink$self->{log},$final_log}else {my$log=$self->{log};my$home=$self->{home};$self->{at_exit}=sub {my$self=shift;my$temp_log="$home/build.log." .time .".$$";File::Copy::copy($log,$temp_log)&& unlink($final_log);rename($temp_log,$final_log)}}$self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" ."Work directory is $self->{base}\n")}sub package_index_for {my ($self,$mirror)=@_;return$self->source_for($mirror)."/02packages.details.txt"}sub generate_mirror_index {my ($self,$mirror)=@_;my$file=$self->package_index_for($mirror);my$gz_file=$file .'.gz';my$index_mtime=(stat$gz_file)[9];unless (-e $file && (stat$file)[9]>= $index_mtime){$self->chat("Uncompressing index file...\n");if (eval {require Compress::Zlib}){my$gz=Compress::Zlib::gzopen($gz_file,"rb")or do {$self->diag_fail("$Compress::Zlib::gzerrno opening compressed index");return};open my$fh,'>',$file or do {$self->diag_fail("$! opening uncompressed index for write");return};my$buffer;while (my$status=$gz->gzread($buffer)){if ($status < 0){$self->diag_fail($gz->gzerror ." reading compressed index");return}print$fh $buffer}}else {if (system("gunzip -c $gz_file > $file")){$self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");return}}utime$index_mtime,$index_mtime,$file}return 1}sub search_mirror_index {my ($self,$mirror,$module,$version)=@_;$self->search_mirror_index_file($self->package_index_for($mirror),$module,$version)}sub search_mirror_index_file {my($self,$file,$module,$version)=@_;open my$fh,'<',$file or return;my$found;while (<$fh>){if (m!^\Q$module\E\s+([\w\.]+)\s+(\S*)!m){$found=$self->cpan_module($module,$2,$1);last}}return$found unless$self->{cascade_search};if ($found){if ($self->satisfy_version($module,$found->{module_version},$version)){return$found}else {$self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n")}}return}sub with_version_range {my($self,$version)=@_;defined($version)&& $version =~ /(?:<|!=|==)/}sub encode_json {my($self,$data)=@_;require JSON::PP;my$json=JSON::PP::encode_json($data);$json =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$json}sub version_to_query {my($self,$module,$version)=@_;require CPAN::Meta::Requirements;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement($module,$version || '0');my$req=$requirements->requirements_for_module($module);if ($req =~ s/^==\s*//){return {term=>{'module.version'=>$req },}}elsif ($req !~ /\s/){return {range=>{'module.version_numified'=>{'gte'=>$self->numify_ver_metacpan($req)}},}}else {my%ops=qw(< lt <= lte > gt >= gte);my(%range,@exclusion);my@requirements=split /,\s*/,$req;for my$r (@requirements){if ($r =~ s/^([<>]=?)\s*//){$range{$ops{$1}}=$self->numify_ver_metacpan($r)}elsif ($r =~ s/\!=\s*//){push@exclusion,$self->numify_ver_metacpan($r)}}my@filters=({range=>{'module.version_numified'=>\%range }},);if (@exclusion){push@filters,{not=>{or=>[map {+{term=>{'module.version_numified'=>$self->numify_ver_metacpan($_)}}}@exclusion ]},}}return@filters}}sub numify_ver_metacpan {my($self,$ver)=@_;$ver =~ s/_//g;version->new($ver)->numify}sub numify_ver {my($self,$ver)=@_;eval version->new($ver)->numify}sub maturity_filter {my($self,$module,$version)=@_;if ($version =~ /==/){return}elsif ($self->{dev_release}){return +{not=>{term=>{status=>'backpan' }}}}else {return ({not=>{term=>{status=>'backpan' }}},{term=>{maturity=>'released' }},)}}sub by_version {my%s=qw(latest 3 cpan 2 backpan 1);$b->{_score}<=> $a->{_score}|| $s{$b->{fields}{status}}<=> $s{$a->{fields}{status}}}sub by_first_come {$a->{fields}{date}cmp $b->{fields}{date}}sub by_date {$b->{fields}{date}cmp $a->{fields}{date}}sub find_best_match {my($self,$match,$version)=@_;return unless$match && @{$match->{hits}{hits}|| []};my@hits=$self->{dev_release}? sort {by_version || by_date}@{$match->{hits}{hits}}: sort {by_version || by_first_come}@{$match->{hits}{hits}};$hits[0]->{fields}}sub search_metacpan {my($self,$module,$version)=@_;require JSON::PP;$self->chat("Searching $module ($version) on metacpan ...\n");my$metacpan_uri='http://api.metacpan.org/v0';my@filter=$self->maturity_filter($module,$version);my$query={filtered=>{(@filter ? (filter=>{and=>\@filter }): ()),query=>{nested=>{score_mode=>'max',path=>'module',query=>{custom_score=>{metacpan_script=>"score_version_numified",query=>{constant_score=>{filter=>{and=>[{term=>{'module.authorized'=>JSON::PP::true()}},{term=>{'module.indexed'=>JSON::PP::true()}},{term=>{'module.name'=>$module }},$self->version_to_query($module,$version),]}}},}},}},}};my$module_uri="$metacpan_uri/file/_search?source=";$module_uri .= $self->encode_json({query=>$query,fields=>['date','release','author','module','status' ],});my($release,$author,$module_version);my$module_json=$self->get($module_uri);my$module_meta=eval {JSON::PP::decode_json($module_json)};my$match=$self->find_best_match($module_meta);if ($match){$release=$match->{release};$author=$match->{author};my$module_matched=(grep {$_->{name}eq $module}@{$match->{module}})[0];$module_version=$module_matched->{version}}unless ($release){$self->chat("! Could not find a release matching $module ($version) on MetaCPAN.\n");return}my$dist_uri="$metacpan_uri/release/_search?source=";$dist_uri .= $self->encode_json({filter=>{and=>[{term=>{'release.name'=>$release }},{term=>{'release.author'=>$author }},]},fields=>['download_url','stat','status' ],});my$dist_json=$self->get($dist_uri);my$dist_meta=eval {JSON::PP::decode_json($dist_json)};if ($dist_meta){$dist_meta=$dist_meta->{hits}{hits}[0]{fields}}if ($dist_meta && $dist_meta->{download_url}){(my$distfile=$dist_meta->{download_url})=~ s!.+/authors/id/!!;local$self->{mirrors}=$self->{mirrors};if ($dist_meta->{status}eq 'backpan'){$self->{mirrors}=['http://backpan.perl.org' ]}elsif ($dist_meta->{stat}{mtime}> time()-24*60*60){$self->{mirrors}=['http://cpan.metacpan.org' ]}return$self->cpan_module($module,$distfile,$module_version)}$self->diag_fail("Finding $module on metacpan failed.");return}sub search_database {my($self,$module,$version)=@_;my$found;if ($self->{dev_release}or $self->{metacpan}){$found=$self->search_metacpan($module,$version)and return$found;$found=$self->search_cpanmetadb($module,$version)and return$found}else {$found=$self->search_cpanmetadb($module,$version)and return$found;$found=$self->search_metacpan($module,$version)and return$found}}sub search_cpanmetadb {my($self,$module,$version)=@_;$self->chat("Searching $module ($version) on cpanmetadb ...\n");if ($self->with_version_range($version)){return$self->search_cpanmetadb_history($module,$version)}else {return$self->search_cpanmetadb_package($module,$version)}}sub search_cpanmetadb_package {my($self,$module,$version)=@_;require CPAN::Meta::YAML;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/package/$module};my$yaml=$self->get($uri);my$meta=eval {CPAN::Meta::YAML::Load($yaml)};if ($meta && $meta->{distfile}){return$self->cpan_module($module,$meta->{distfile},$meta->{version})}$self->diag_fail("Finding $module on cpanmetadb failed.");return}sub search_cpanmetadb_history {my($self,$module,$version)=@_;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/history/$module};my$content=$self->get($uri)or return;my@found;for my$line (split /\r?\n/,$content){if ($line =~ /^$module\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_obj=>version::->parse($1),distfile=>$2,}}}return unless@found;$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_obj}cmp $a->{version_obj}}@found){if ($self->satisfy_version($module,$try->{version_obj},$version)){local$self->{mirrors}=$self->{mirrors};unshift @{$self->{mirrors}},'http://backpan.perl.org' unless$try->{latest};return$self->cpan_module($module,$try->{distfile},$try->{version})}}$self->diag_fail("Finding $module ($version) on cpanmetadb failed.");return}sub search_module {my($self,$module,$version)=@_;if ($self->{mirror_index}){$self->mask_output(chat=>"Searching $module on mirror index $self->{mirror_index} ...\n");my$pkg=$self->search_mirror_index_file($self->{mirror_index},$module,$version);return$pkg if$pkg;unless ($self->{cascade_search}){$self->mask_output(diag_fail=>"Finding $module ($version) on mirror index $self->{mirror_index} failed.");return}}unless ($self->{mirror_only}){my$found=$self->search_database($module,$version);return$found if$found}MIRROR: for my$mirror (@{$self->{mirrors}}){$self->mask_output(chat=>"Searching $module on mirror $mirror ...\n");my$name='02packages.details.txt.gz';my$uri="$mirror/modules/$name";my$gz_file=$self->package_index_for($mirror).'.gz';unless ($self->{pkgs}{$uri}){$self->mask_output(chat=>"Downloading index file $uri ...\n");$self->mirror($uri,$gz_file);$self->generate_mirror_index($mirror)or next MIRROR;$self->{pkgs}{$uri}="!!retrieved!!"}my$pkg=$self->search_mirror_index($mirror,$module,$version);return$pkg if$pkg;$self->mask_output(diag_fail=>"Finding $module ($version) on mirror $mirror failed.")}return}sub source_for {my($self,$mirror)=@_;$mirror =~ s/[^\w\.\-]+/%/g;my$dir="$self->{home}/sources/$mirror";File::Path::mkpath([$dir ],0,0777);return$dir}sub load_argv_from_fh {my($self,$fh)=@_;my@argv;while(defined(my$line=<$fh>)){chomp$line;$line =~ s/#.+$//;$line =~ s/^\s+//;$line =~ s/\s+$//;push@argv,split ' ',$line if$line}return@argv}sub show_version {my$self=shift;print "cpanm (App::cpanminus) version $VERSION ($0)\n";print "perl version $] ($^X)\n\n";print "  \%Config:\n";for my$key (qw(archname installsitelib installsitebin installman1dir installman3dir sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp)){print "    $key=$Config{$key}\n" if$Config{$key}}print "  \%ENV:\n";for my$key (grep /^PERL/,sort keys%ENV){print "    $key=$ENV{$key}\n"}print "  \@INC:\n";for my$inc (@INC){print "    $inc\n" unless ref($inc)eq 'CODE'}return 1}sub show_help {my$self=shift;if ($_[0]){print <<USAGE;return}print <<HELP;return 1}sub _writable {my$dir=shift;my@dir=File::Spec->splitdir($dir);while (@dir){$dir=File::Spec->catdir(@dir);if (-e $dir){return -w _}pop@dir}return}sub maybe_abs {my($self,$lib)=@_;if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)){return$lib}else {return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(),$lib))}}sub local_lib_target {my($self,$root)=@_;(grep {$_ ne ''}split /\Q$Config{path_sep}/,$root)[0]}sub bootstrap_local_lib {my$self=shift;if ($self->{local_lib}){return$self->setup_local_lib($self->{local_lib})}if ($ENV{PERL_LOCAL_LIB_ROOT}&& $ENV{PERL_MM_OPT}){return$self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}),1)}return if$self->{sudo}or (_writable($Config{installsitelib})and _writable($Config{installsitebin}));if ($ENV{PERL_MM_OPT}and ($ENV{MODULEBUILDRC}or $ENV{PERL_MB_OPT})){return}$self->setup_local_lib;$self->diag(<<DIAG,1);sleep 2}sub upgrade_toolchain {my($self,$config_deps)=@_;my%deps=map {$_->module=>$_}@$config_deps;my$reqs=CPAN::Meta::Requirements->from_string_hash({'Module::Build'=>'0.38','ExtUtils::MakeMaker'=>'6.58','ExtUtils::Install'=>'1.46',});if ($deps{"ExtUtils::MakeMaker"}){$deps{"ExtUtils::MakeMaker"}->merge_with($reqs)}elsif ($deps{"Module::Build"}){$deps{"Module::Build"}->merge_with($reqs);$deps{"ExtUtils::Install"}||= App::cpanminus::Dependency->new("ExtUtils::Install",0,'configure');$deps{"ExtUtils::Install"}->merge_with($reqs)}@$config_deps=values%deps}sub _core_only_inc {my($self,$base)=@_;require local::lib;(local::lib->resolve_path(local::lib->install_base_arch_path($base)),local::lib->resolve_path(local::lib->install_base_perl_path($base)),(!$self->{exclude_vendor}? grep {$_}@Config{qw(vendorarch vendorlibexp)}: ()),@Config{qw(archlibexp privlibexp)},)}sub _diff {my($self,$old,$new)=@_;my@diff;my%old=map {$_=>1}@$old;for my$n (@$new){push@diff,$n unless exists$old{$n}}@diff}sub _setup_local_lib_env {my($self,$base)=@_;$self->diag(<<WARN,1)if$base =~ /\s/;local$SIG{__WARN__}=sub {};local::lib->setup_env_hash_for($base,0)}sub setup_local_lib {my($self,$base,$no_env)=@_;$base=undef if$base eq '_';require local::lib;{local $0='cpanm';$base ||= "~/perl5";$base=local::lib->resolve_path($base);if ($self->{self_contained}){my@inc=$self->_core_only_inc($base);$self->{search_inc}=[@inc ]}else {$self->{search_inc}=[local::lib->install_base_arch_path($base),local::lib->install_base_perl_path($base),@INC,]}$self->_setup_local_lib_env($base)unless$no_env;$self->{local_lib}=$base}}sub prompt_bool {my($self,$mess,$def)=@_;my$val=$self->prompt($mess,$def);return lc$val eq 'y'}sub prompt {my($self,$mess,$def)=@_;my$isa_tty=-t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT));my$dispdef=defined$def ? "[$def] " : " ";$def=defined$def ? $def : "";if (!$self->{prompt}|| (!$isa_tty && eof STDIN)){return$def}local $|=1;local $\;my$ans;eval {local$SIG{ALRM}=sub {undef$ans;die "alarm\n"};print STDOUT "$mess $dispdef";alarm$self->{prompt_timeout}if$self->{prompt_timeout};$ans=<STDIN>;alarm 0};if (defined$ans){chomp$ans}else {print STDOUT "\n"}return (!defined$ans || $ans eq '')? $def : $ans}sub diag_ok {my($self,$msg)=@_;chomp$msg;$msg ||= "OK";if ($self->{in_progress}){$self->_diag("$msg\n");$self->{in_progress}=0}$self->log("-> $msg\n")}sub diag_fail {my($self,$msg,$always)=@_;chomp$msg;if ($self->{in_progress}){$self->_diag("FAIL\n");$self->{in_progress}=0}if ($msg){$self->_diag("! $msg\n",$always,1);$self->log("-> FAIL $msg\n")}}sub diag_progress {my($self,$msg)=@_;chomp$msg;$self->{in_progress}=1;$self->_diag("$msg ... ");$self->log("$msg\n")}sub _diag {my($self,$msg,$always,$error)=@_;my$fh=$error ? *STDERR : *STDOUT;print {$fh}$msg if$always or $self->{verbose}or!$self->{quiet}}sub diag {my($self,$msg,$always)=@_;$self->_diag($msg,$always);$self->log($msg)}sub chat {my$self=shift;print STDERR @_ if$self->{verbose};$self->log(@_)}sub mask_output {my$self=shift;my$method=shift;$self->$method($self->mask_uri_passwords(@_))}sub log {my$self=shift;open my$out,">>$self->{log}";print$out @_}sub run {my($self,$cmd)=@_;if (WIN32){$cmd=$self->shell_quote(@$cmd)if ref$cmd eq 'ARRAY';unless ($self->{verbose}){$cmd .= " >> " .$self->shell_quote($self->{log})." 2>&1"}!system$cmd}else {my$pid=fork;if ($pid){waitpid$pid,0;return!$?}else {$self->run_exec($cmd)}}}sub run_exec {my($self,$cmd)=@_;if (ref$cmd eq 'ARRAY'){unless ($self->{verbose}){open my$logfh,">>",$self->{log};open STDERR,'>&',$logfh;open STDOUT,'>&',$logfh;close$logfh}exec @$cmd}else {unless ($self->{verbose}){$cmd .= " >> " .$self->shell_quote($self->{log})." 2>&1"}exec$cmd}}sub run_timeout {my($self,$cmd,$timeout)=@_;return$self->run($cmd)if WIN32 || $self->{verbose}||!$timeout;my$pid=fork;if ($pid){eval {local$SIG{ALRM}=sub {die "alarm\n"};alarm$timeout;waitpid$pid,0;alarm 0};if ($@ && $@ eq "alarm\n"){$self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");local$SIG{TERM}='IGNORE';kill TERM=>0;waitpid$pid,0;return}return!$?}elsif ($pid==0){$self->run_exec($cmd)}else {$self->chat("! fork failed: falling back to system()\n");$self->run($cmd)}}sub append_args {my($self,$cmd,$phase)=@_;if (my$args=$self->{build_args}{$phase}){$cmd=join ' ',$self->shell_quote(@$cmd),$args}$cmd}sub configure {my($self,$cmd,$depth)=@_;local$ENV{PERL5_CPAN_IS_RUNNING}=local$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$;local$ENV{PERL5_CPANM_IS_RUNNING}=$$;my$use_default=!$self->{interactive};local$ENV{PERL_MM_USE_DEFAULT}=$use_default;local$ENV{PERL_MM_OPT}=$ENV{PERL_MM_OPT};local$ENV{PERL_MB_OPT}=$ENV{PERL_MB_OPT};unless ($self->{pod2man}){$ENV{PERL_MM_OPT}.= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";$ENV{PERL_MB_OPT}.= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir="}if ($self->{pure_perl}){$ENV{PERL_MM_OPT}.= " PUREPERL_ONLY=1";$ENV{PERL_MB_OPT}.= " --pureperl-only"}$cmd=$self->append_args($cmd,'configure')if$depth==0;local$self->{verbose}=$self->{verbose}|| $self->{interactive};$self->run_timeout($cmd,$self->{configure_timeout})}sub build {my($self,$cmd,$distname,$depth)=@_;local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};$cmd=$self->append_args($cmd,'build')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{build_timeout});while (1){my$ans=lc$self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->build($cmd,$distname,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}sub test {my($self,$cmd,$distname,$depth)=@_;return 1 if$self->{notest};local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{NONINTERACTIVE_TESTING}=!$self->{interactive};$cmd=$self->append_args($cmd,'test')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{test_timeout});if ($self->{force}){$self->diag_fail("Testing $distname failed but installing it anyway.");return 1}else {$self->diag_fail;while (1){my$ans=lc$self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->test($cmd,$distname,$depth)if$ans eq 'r';return 1 if$ans eq 'f';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}}sub install {my($self,$cmd,$uninst_opts,$depth)=@_;if ($depth==0 && $self->{test_only}){return 1}if ($self->{sudo}){unshift @$cmd,"sudo"}if ($self->{uninstall_shadows}&&!$ENV{PERL_MM_OPT}){push @$cmd,@$uninst_opts}$cmd=$self->append_args($cmd,'install')if$depth==0;$self->run($cmd)}sub look {my$self=shift;my$shell=$ENV{SHELL};$shell ||= $ENV{COMSPEC}if WIN32;if ($shell){my$cwd=Cwd::cwd;$self->diag("Entering $cwd with $shell\n");system$shell}else {$self->diag_fail("You don't seem to have a SHELL :/")}}sub show_build_log {my$self=shift;my@pagers=($ENV{PAGER},(WIN32 ? (): ('less')),'more');my$pager;while (@pagers){$pager=shift@pagers;next unless$pager;$pager=$self->which($pager);next unless$pager;last}if ($pager){system("$pager < $self->{log}")}else {$self->diag_fail("You don't seem to have a PAGER :/")}}sub chdir {my$self=shift;Cwd::chdir(File::Spec->canonpath($_[0]))or die "$_[0]: $!"}sub configure_mirrors {my$self=shift;unless (@{$self->{mirrors}}){$self->{mirrors}=['http://www.cpan.org' ]}for (@{$self->{mirrors}}){s!^/!file:///!;s!/$!!}}sub self_upgrade {my$self=shift;$self->check_upgrade;$self->{argv}=['App::cpanminus' ];return}sub install_module {my($self,$module,$depth,$version)=@_;$self->check_libs;if ($self->{seen}{$module}++){$self->chat("Already tried $module. Skipping.\n");return 1}if ($self->{skip_satisfied}){my($ok,$local)=$self->check_module($module,$version || 0);if ($ok){$self->diag("You have $module ($local)\n",1);return 1}}my$dist=$self->resolve_name($module,$version);unless ($dist){my$what=$module .($version ? " ($version)" : "");$self->diag_fail("Couldn't find module or a distribution $what",1);return}if ($dist->{distvname}&& $self->{seen}{$dist->{distvname}}++){$self->chat("Already tried $dist->{distvname}. Skipping.\n");return 1}if ($self->{cmd}eq 'info'){print$self->format_dist($dist),"\n";return 1}$dist->{depth}=$depth;if ($dist->{module}){unless ($self->satisfy_version($dist->{module},$dist->{module_version},$version)){$self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n",1);return}my$cmp=$version ? "==" : "";my$requirement=$dist->{module_version}? "$cmp$dist->{module_version}" : 0;my($ok,$local)=$self->check_module($dist->{module},$requirement);if ($self->{skip_installed}&& $ok){$self->diag("$dist->{module} is up to date. ($local)\n",1);return 1}}if ($dist->{dist}eq 'perl'){$self->diag("skipping $dist->{pathname}\n");return 1}$self->diag("--> Working on $module\n");$dist->{dir}||= $self->fetch_module($dist);unless ($dist->{dir}){$self->diag_fail("Failed to fetch distribution $dist->{distvname}",1);return}$self->chat("Entering $dist->{dir}\n");$self->chdir($self->{base});$self->chdir($dist->{dir});if ($self->{cmd}eq 'look'){$self->look;return 1}return$self->build_stuff($module,$dist,$depth)}sub uninstall_search_path {my$self=shift;$self->{local_lib}? (local::lib->install_base_arch_path($self->{local_lib}),local::lib->install_base_perl_path($self->{local_lib})): @Config{qw(installsitearch installsitelib)}}sub uninstall_module {my ($self,$module)=@_;$self->check_libs;my@inc=$self->uninstall_search_path;my($metadata,$packlist)=$self->packlists_containing($module,\@inc);unless ($packlist){$self->diag_fail(<<DIAG,1);return}my@uninst_files=$self->uninstall_target($metadata,$packlist);$self->ask_permission($module,\@uninst_files)or return;$self->uninstall_files(@uninst_files,$packlist);$self->diag("Successfully uninstalled $module\n",1);return 1}sub packlists_containing {my($self,$module,$inc)=@_;require Module::Metadata;my$metadata=Module::Metadata->new_from_module($module,inc=>$inc)or return;my$packlist;my$wanted=sub {return unless $_ eq '.packlist' && -f $_;for my$file ($self->unpack_packlist($File::Find::name)){$packlist ||= $File::Find::name if$file eq $metadata->filename}};{require File::pushd;my$pushd=File::pushd::pushd();my@search=grep -d $_,map File::Spec->catdir($_,'auto'),@$inc;File::Find::find($wanted,@search)}return$metadata,$packlist}sub uninstall_target {my($self,$metadata,$packlist)=@_;if ($self->has_shadow_install($metadata)or $self->{local_lib}){grep$self->should_unlink($_),$self->unpack_packlist($packlist)}else {$self->unpack_packlist($packlist)}}sub has_shadow_install {my($self,$metadata)=@_;my@shadow=grep defined,map Module::Metadata->new_from_module($metadata->name,inc=>[$_]),@INC;@shadow >= 2}sub should_unlink {my($self,$file)=@_;if ($self->{local_lib}){$file =~ /^\Q$self->{local_lib}\E/}else {!(grep$file =~ /^\Q$_\E/,@Config{qw(installbin installscript installman1dir installman3dir)})}}sub ask_permission {my ($self,$module,$files)=@_;$self->diag("$module contains the following files:\n\n");for my$file (@$files){$self->diag("  $file\n")}$self->diag("\n");return 'force uninstall' if$self->{force};local$self->{prompt}=1;return$self->prompt_bool("Are you sure you want to uninstall $module?",'y')}sub unpack_packlist {my ($self,$packlist)=@_;open my$fh,'<',$packlist or die "$packlist: $!";map {chomp;$_}<$fh>}sub uninstall_files {my ($self,@files)=@_;$self->diag("\n");for my$file (@files){$self->diag("Unlink: $file\n");unlink$file or $self->diag_fail("$!: $file")}$self->diag("\n");return 1}sub format_dist {my($self,$dist)=@_;return "$dist->{cpanid}/$dist->{filename}"}sub trim {local $_=shift;tr/\n/ /d;s/^\s*|\s*$//g;$_}sub fetch_module {my($self,$dist)=@_;$self->chdir($self->{base});for my$uri (@{$dist->{uris}}){$self->mask_output(diag_progress=>"Fetching $uri");my$filename=$dist->{filename}|| $uri;my$name=File::Basename::basename($filename);my$cancelled;my$fetch=sub {my$file;eval {local$SIG{INT}=sub {$cancelled=1;die "SIGINT\n"};$self->mirror($uri,$name);$file=$name if -e $name};$self->diag("ERROR: " .trim("$@")."\n",1)if $@ && $@ ne "SIGINT\n";return$file};my($try,$file);while ($try++ < 3){$file=$fetch->();last if$cancelled or $file;$self->mask_output(diag_fail=>"Download $uri failed. Retrying ... ")}if ($cancelled){$self->diag_fail("Download cancelled.");return}unless ($file){$self->mask_output(diag_fail=>"Failed to download $uri");next}$self->diag_ok;$dist->{local_path}=File::Spec->rel2abs($name);my$dir=$self->unpack($file,$uri,$dist);next unless$dir;if (my$save=$self->{save_dists}){my$path=$dist->{pathname}? "$save/authors/id/$dist->{pathname}" : "$save/vendor/$file";$self->chat("Copying $name to $path\n");File::Path::mkpath([File::Basename::dirname($path)],0,0777);File::Copy::copy($file,$path)or warn $!}return$dist,$dir}}sub unpack {my($self,$file,$uri,$dist)=@_;if ($self->{verify}){$self->verify_archive($file,$uri,$dist)or return}$self->chat("Unpacking $file\n");my$dir=$file =~ /\.zip/i ? $self->unzip($file): $self->untar($file);unless ($dir){$self->diag_fail("Failed to unpack $file: no directory")}return$dir}sub verify_checksums_signature {my($self,$chk_file)=@_;require Module::Signature;$self->chat("Verifying the signature of CHECKSUMS\n");my$rv=eval {local$SIG{__WARN__}=sub {};my$v=Module::Signature::_verify($chk_file);$v==Module::Signature::SIGNATURE_OK()};if ($rv){$self->chat("Verified OK!\n")}else {$self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");return}return 1}sub verify_archive {my($self,$file,$uri,$dist)=@_;unless ($dist->{cpanid}){$self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");return 1}(my$mirror=$uri)=~ s!/authors/id.*$!!;(my$chksum_uri=$uri)=~ s!/[^/]*$!/CHECKSUMS!;my$chk_file=$self->source_for($mirror)."/$dist->{cpanid}.CHECKSUMS";$self->mask_output(diag_progress=>"Fetching $chksum_uri");$self->mirror($chksum_uri,$chk_file);unless (-e $chk_file){$self->diag_fail("Fetching $chksum_uri failed.\n");return}$self->diag_ok;$self->verify_checksums_signature($chk_file)or return;$self->verify_checksum($file,$chk_file)}sub verify_checksum {my($self,$file,$chk_file)=@_;$self->chat("Verifying the SHA1 for $file\n");open my$fh,"<$chk_file" or die "$chk_file: $!";my$data=join '',<$fh>;$data =~ s/\015?\012/\n/g;require Safe;my$chksum=Safe->new->reval($data);if (!ref$chksum or ref$chksum ne 'HASH'){$self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");return}if (my$sha=$chksum->{$file}{sha256}){my$hex=$self->sha1_for($file);if ($hex eq $sha){$self->chat("Checksum for $file: Verified!\n")}else {$self->diag_fail("Checksum mismatch for $file\n");return}}else {$self->chat("Checksum for $file not found in CHECKSUMS.\n");return}}sub sha1_for {my($self,$file)=@_;require Digest::SHA;open my$fh,"<",$file or die "$file: $!";my$dg=Digest::SHA->new(256);my($data);while (read($fh,$data,4096)){$dg->add($data)}return$dg->hexdigest}sub verify_signature {my($self,$dist)=@_;$self->diag_progress("Verifying the SIGNATURE file");my$out=`$self->{cpansign} -v --skip 2>&1`;$self->log($out);if ($out =~ /Signature verified OK/){$self->diag_ok("Verified OK");return 1}else {$self->diag_fail("SIGNATURE verificaion for $dist->{filename} failed\n");return}}sub resolve_name {my($self,$module,$version)=@_;if ($module =~ /(?:^git:|\.git(?:@.+)?$)/){return$self->git_uri($module)}if ($module =~ /^(ftp|https?|file):/){if ($module =~ m!authors/id/(.*)!){return$self->cpan_dist($1,$module)}else {return {uris=>[$module ]}}}if ($module =~ m!^[\./]! && -d $module){return {source=>'local',dir=>Cwd::abs_path($module),}}if (-f $module){return {source=>'local',uris=>["file://" .Cwd::abs_path($module)],}}if ($module =~ s!^cpan:///distfile/!!){return$self->cpan_dist($module)}if ($module =~ m!^(?:[A-Z]/[A-Z]{2}/)?([A-Z]{2}[\-A-Z0-9]*/.*)$!){return$self->cpan_dist($1)}return$self->search_module($module,$version)}sub cpan_module {my($self,$module,$dist,$version)=@_;my$dist=$self->cpan_dist($dist);$dist->{module}=$module;$dist->{module_version}=$version if$version && $version ne 'undef';return$dist}sub cpan_dist {my($self,$dist,$url)=@_;$dist =~ s!^([A-Z]{2})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;require CPAN::DistnameInfo;my$d=CPAN::DistnameInfo->new($dist);if ($url){$url=[$url ]unless ref$url eq 'ARRAY'}else {my$id=$d->cpanid;my$fn=substr($id,0,1)."/" .substr($id,0,2)."/" .$id ."/" .$d->filename;my@mirrors=@{$self->{mirrors}};my@urls=map "$_/authors/id/$fn",@mirrors;$url=\@urls,}return {$d->properties,source=>'cpan',uris=>$url,}}sub git_uri {my ($self,$uri)=@_;($uri,my$commitish)=split /(?<=\.git)@/i,$uri,2;my$dir=File::Temp::tempdir(CLEANUP=>1);$self->mask_output(diag_progress=>"Cloning $uri");$self->run(['git','clone',$uri,$dir ]);unless (-e "$dir/.git"){$self->diag_fail("Failed cloning git repository $uri",1);return}if ($commitish){require File::pushd;my$dir=File::pushd::pushd($dir);unless ($self->run(['git','checkout',$commitish ])){$self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");return}}$self->diag_ok;return {source=>'local',dir=>$dir,}}sub setup_module_build_patch {my$self=shift;open my$out,">$self->{base}/ModuleBuildSkipMan.pm" or die $!;print$out <<EOF}sub core_version_for {my($self,$module)=@_;require Module::CoreList;unless (exists$Module::CoreList::version{$]+0}){die sprintf("Module::CoreList %s (loaded from %s) doesn't seem to have entries for perl $]. " ."You're strongly recommended to upgrade Module::CoreList from CPAN.\n",$Module::CoreList::VERSION,$INC{"Module/CoreList.pm"})}unless (exists$Module::CoreList::version{$]+0}{$module}){return -1}return$Module::CoreList::version{$]+0}{$module}}sub search_inc {my$self=shift;$self->{search_inc}||= do {if (defined$::Bin){[grep!/^\Q$::Bin\E\/..\/(?:fat)?lib$/,@INC]}else {[@INC]}}}sub check_module {my($self,$mod,$want_ver)=@_;require Module::Metadata;my$meta=Module::Metadata->new_from_module($mod,inc=>$self->search_inc)or return 0,undef;my$version=$meta->version;if ($self->{self_contained}&& $self->loaded_from_perl_lib($meta)){$version=$self->core_version_for($mod);return 0,undef if$version && $version==-1}$self->{local_versions}{$mod}=$version;if ($self->is_deprecated($meta)){return 0,$version}elsif ($self->satisfy_version($mod,$version,$want_ver)){return 1,($version || 'undef')}else {return 0,$version}}sub satisfy_version {my($self,$mod,$version,$want_ver)=@_;$want_ver='0' unless defined($want_ver)&& length($want_ver);require CPAN::Meta::Requirements;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement($mod,$want_ver);$requirements->accepts_module($mod,$version)}sub unsatisfy_how {my($self,$ver,$want_ver)=@_;if ($want_ver =~ /^[v0-9\.\_]+$/){return "$ver < $want_ver"}else {return "$ver doesn't satisfy $want_ver"}}sub is_deprecated {my($self,$meta)=@_;my$deprecated=eval {require Module::CoreList;Module::CoreList::is_deprecated($meta->{module})};return$deprecated && $self->loaded_from_perl_lib($meta)}sub loaded_from_perl_lib {my($self,$meta)=@_;require Config;my@dirs=qw(archlibexp privlibexp);if ($self->{self_contained}&&!$self->{exclude_vendor}&& $Config{vendorarch}){unshift@dirs,qw(vendorarch vendorlibexp)}for my$dir (@dirs){my$confdir=$Config{$dir};if ($confdir eq substr($meta->filename,0,length($confdir))){return 1}}return}sub should_install {my($self,$mod,$ver)=@_;$self->chat("Checking if you have $mod $ver ... ");my($ok,$local)=$self->check_module($mod,$ver);if ($ok){$self->chat("Yes ($local)\n")}elsif ($local){$self->chat("No (" .$self->unsatisfy_how($local,$ver).")\n")}else {$self->chat("No\n")}return$mod unless$ok;return}sub check_perl_version {my($self,$version)=@_;require CPAN::Meta::Requirements;my$req=CPAN::Meta::Requirements->from_string_hash({perl=>$version });$req->accepts_module(perl=>$])}sub install_deps {my($self,$dir,$depth,@deps)=@_;my(@install,%seen,@fail);for my$dep (@deps){next if$seen{$dep->module};if ($dep->module eq 'perl'){if ($dep->is_requirement &&!$self->check_perl_version($dep->version)){$self->diag("Needs perl @{[$dep->version]}, you have $]\n");push@fail,'perl'}}elsif ($self->should_install($dep->module,$dep->version)){push@install,$dep;$seen{$dep->module}=1}}if (@install){$self->diag("==> Found dependencies: " .join(", ",map $_->module,@install)."\n")}for my$dep (@install){$self->install_module($dep->module,$depth + 1,$dep->version)}$self->chdir($self->{base});$self->chdir($dir)if$dir;if ($self->{scandeps}){return 1}my@not_ok=$self->unsatisfied_deps(@deps);if (@not_ok){return 0,\@not_ok}else {return 1}}sub unsatisfied_deps {my($self,@deps)=@_;require CPAN::Meta::Check;require CPAN::Meta::Requirements;my$reqs=CPAN::Meta::Requirements->new;for my$dep (grep $_->is_requirement,@deps){$reqs->add_string_requirement($dep->module=>$dep->requires_version || '0')}my$ret=CPAN::Meta::Check::check_requirements($reqs,'requires',$self->{search_inc});grep defined,values %$ret}sub install_deps_bailout {my($self,$target,$dir,$depth,@deps)=@_;my($ok,$fail)=$self->install_deps($dir,$depth,@deps);if (!$ok){$self->diag_fail("Installing the dependencies failed: " .join(", ",@$fail),1);unless ($self->prompt_bool("Do you want to continue building $target anyway?","n")){$self->diag_fail("Bailing out the installation for $target.",1);return}}return 1}sub build_stuff {my($self,$stuff,$dist,$depth)=@_;if ($self->{verify}&& -e 'SIGNATURE'){$self->verify_signature($dist)or return}require CPAN::Meta;my($meta_file)=grep -f,qw(META.json META.yml);if ($meta_file){$self->chat("Checking configure dependencies from $meta_file\n");$dist->{cpanmeta}=eval {CPAN::Meta->load_file($meta_file)}}elsif ($dist->{dist}&& $dist->{version}){$self->chat("META.yml/json not found. Creating skeleton for it.\n");$dist->{cpanmeta}=CPAN::Meta->new({name=>$dist->{dist},version=>$dist->{version}})}$dist->{meta}=$dist->{cpanmeta}? $dist->{cpanmeta}->as_struct : {};my@config_deps;if ($dist->{cpanmeta}){push@config_deps,App::cpanminus::Dependency->from_prereqs($dist->{cpanmeta}->effective_prereqs,['configure'],$self->{install_types},)}if (-e 'Build.PL' &&!$self->should_use_mm($dist->{dist})&&!@config_deps){push@config_deps,App::cpanminus::Dependency->from_versions({'Module::Build'=>'0.38' },'configure',)}$self->upgrade_toolchain(\@config_deps);my$target=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};{$self->install_deps_bailout($target,$dist->{dir},$depth,@config_deps)or return}$self->diag_progress("Configuring $target");my$configure_state=$self->configure_this($dist,$depth);$self->diag_ok($configure_state->{configured_ok}? "OK" : "N/A");if ($dist->{cpanmeta}&& $dist->{source}eq 'cpan'){$dist->{provides}=$dist->{cpanmeta}{provides}|| $self->extract_packages($dist->{cpanmeta},".")}my$root_target=(($self->{installdeps}or $self->{showdeps})and $depth==0);$dist->{want_phases}=$self->{notest}&&!$root_target ? [qw(build runtime)]: [qw(build test runtime)];push @{$dist->{want_phases}},'develop' if$self->{with_develop}&& $depth==0;my@deps=$self->find_prereqs($dist);my$module_name=$self->find_module_name($configure_state)|| $dist->{meta}{name};$module_name =~ s/-/::/g;if ($self->{showdeps}){for my$dep (@config_deps,@deps){print$dep->module,($dep->version ? ("~".$dep->version): ""),"\n"}return 1}my$distname=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;my$walkup;if ($self->{scandeps}){$walkup=$self->scandeps_append_child($dist)}$self->install_deps_bailout($distname,$dist->{dir},$depth,@deps)or return;if ($self->{scandeps}){unless ($configure_state->{configured_ok}){my$diag=<<DIAG;if (@config_deps){my@tree=@{$self->{scandeps_tree}};$diag .= "!\n" .join("",map "! * $_->[0]{module}\n",@tree[0..$#tree-1])if@tree}$self->diag("!\n$diag!\n",1)}$walkup->();return 1}if ($self->{installdeps}&& $depth==0){if ($configure_state->{configured_ok}){$self->diag("<== Installed dependencies for $stuff. Finishing.\n");return 1}else {$self->diag("! Configuring $distname failed. See $self->{log} for details.\n",1);return}}my$installed;if ($configure_state->{use_module_build}&& -e 'Build' && -f _){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{perl},"./Build" ],$distname,$depth)&& $self->test([$self->{perl},"./Build","test" ],$distname,$depth)&& $self->install([$self->{perl},"./Build","install" ],["--uninst",1 ],$depth)&& $installed++}elsif ($self->{make}&& -e 'Makefile'){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{make}],$distname,$depth)&& $self->test([$self->{make},"test" ],$distname,$depth)&& $self->install([$self->{make},"install" ],["UNINST=1" ],$depth)&& $installed++}else {my$why;my$configure_failed=$configure_state->{configured}&&!$configure_state->{configured_ok};if ($configure_failed){$why="Configure failed for $distname."}elsif ($self->{make}){$why="The distribution doesn't have a proper Makefile.PL/Build.PL"}else {$why="Can't configure the distribution. You probably need to have 'make'."}$self->diag_fail("$why See $self->{log} for details.",1);return}if ($installed && $self->{test_only}){$self->diag_ok;$self->diag("Successfully tested $distname\n",1)}elsif ($installed){my$local=$self->{local_versions}{$dist->{module}|| ''};my$version=$dist->{module_version}|| $dist->{meta}{version}|| $dist->{version};my$reinstall=$local && ($local eq $version);my$action=$local &&!$reinstall ? $self->numify_ver($version)< $self->numify_ver($local)? "downgraded" : "upgraded" : undef;my$how=$reinstall ? "reinstalled $distname" : $local ? "installed $distname ($action from $local)" : "installed $distname" ;my$msg="Successfully $how";$self->diag_ok;$self->diag("$msg\n",1);$self->{installed_dists}++;$self->save_meta($stuff,$dist,$module_name,\@config_deps,\@deps);return 1}else {my$what=$self->{test_only}? "Testing" : "Installing";$self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.",1);return}}sub perl_requirements {my($self,@requires)=@_;my@perl;for my$requires (grep defined,@requires){if (exists$requires->{perl}){push@perl,App::cpanminus::Dependency->new(perl=>$requires->{perl})}}return@perl}sub should_use_mm {my($self,$dist)=@_;my%should_use_mm=map {$_=>1}qw(version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest);$should_use_mm{$dist}}sub configure_this {my($self,$dist,$depth)=@_;if (-e $self->{cpanfile_path}&& $self->{installdeps}&& $depth==0){require Module::CPANfile;$dist->{cpanfile}=eval {Module::CPANfile->load($self->{cpanfile_path})};$self->diag_fail($@,1)if $@;return {configured=>1,configured_ok=>!!$dist->{cpanfile},use_module_build=>0,}}if ($self->{skip_configure}){my$eumm=-e 'Makefile';my$mb=-e 'Build' && -f _;return {configured=>1,configured_ok=>$eumm || $mb,use_module_build=>$mb,}}my$state={};my$try_eumm=sub {if (-e 'Makefile.PL'){$self->chat("Running Makefile.PL\n");if ($self->configure([$self->{perl},"Makefile.PL" ],$depth)){$state->{configured_ok}=-e 'Makefile'}$state->{configured}++}};my$try_mb=sub {if (-e 'Build.PL'){$self->chat("Running Build.PL\n");if ($self->configure([$self->{perl},"Build.PL" ],$depth)){$state->{configured_ok}=-e 'Build' && -f _}$state->{use_module_build}++;$state->{configured}++}};my@try;if ($dist->{dist}&& $self->should_use_mm($dist->{dist})){@try=($try_eumm,$try_mb)}else {@try=($try_mb,$try_eumm)}for my$try (@try){$try->();last if$state->{configured_ok}}unless ($state->{configured_ok}){while (1){my$ans=lc$self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");last if$ans eq 's';return$self->configure_this($dist,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}return$state}sub find_module_name {my($self,$state)=@_;return unless$state->{configured_ok};if ($state->{use_module_build}&& -e "_build/build_params"){my$params=do {open my$in,"_build/build_params";$self->safe_eval(join "",<$in>)};return eval {$params->[2]{module_name}}|| undef}elsif (-e "Makefile"){open my$mf,"Makefile";while (<$mf>){if (/^\#\s+NAME\s+=>\s+(.*)/){return$self->safe_eval($1)}}}return}sub list_files {my$self=shift;if (-e 'MANIFEST'){require ExtUtils::Manifest;my$manifest=eval {ExtUtils::Manifest::manifind()}|| {};return sort {lc$a cmp lc$b}keys %$manifest}else {require File::Find;my@files;my$finder=sub {my$name=$File::Find::name;$name =~ s!\.[/\\]!!;push@files,$name};File::Find::find($finder,".");return sort {lc$a cmp lc$b}@files}}sub extract_packages {my($self,$meta,$dir)=@_;my$try=sub {my$file=shift;return 0 if$file =~ m!^(?:x?t|inc|local|perl5|fatlib|_build)/!;return 1 unless$meta->{no_index};return 0 if grep {$file =~ m!^$_/!}@{$meta->{no_index}{directory}|| []};return 0 if grep {$file eq $_}@{$meta->{no_index}{file}|| []};return 1};require Parse::PMFile;my@files=grep {/\.pm(?:\.PL)?$/ && $try->($_)}$self->list_files;my$provides={};for my$file (@files){my$parser=Parse::PMFile->new($meta,{UNSAFE=>1,ALLOW_DEV_VERSION=>1 });my$packages=$parser->parse($file);while (my($package,$meta)=each %$packages){$provides->{$package}||= {file=>$meta->{infile},($meta->{version}eq 'undef')? (): (version=>$meta->{version}),}}}return$provides}sub save_meta {my($self,$module,$dist,$module_name,$config_deps,$build_deps)=@_;return unless$dist->{distvname}&& $dist->{source}eq 'cpan';my$base=($ENV{PERL_MM_OPT}|| '')=~ /INSTALL_BASE=/ ? ($self->install_base($ENV{PERL_MM_OPT})."/lib/perl5"): $Config{sitelibexp};my$provides=$dist->{provides};File::Path::mkpath("blib/meta",0,0777);my$local={name=>$module_name,target=>$module,version=>exists$provides->{$module_name}? ($provides->{$module_name}{version}|| $dist->{version}): $dist->{version},dist=>$dist->{distvname},pathname=>$dist->{pathname},provides=>$provides,};require JSON::PP;open my$fh,">","blib/meta/install.json" or die $!;print$fh JSON::PP::encode_json($local);if (-e "MYMETA.json"){File::Copy::copy("MYMETA.json","blib/meta/MYMETA.json")}my@cmd=(($self->{sudo}? 'sudo' : ()),$^X,'-MExtUtils::Install=install','-e',qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],);$self->run(\@cmd)}sub _merge_hashref {my($self,@hashrefs)=@_;my%hash;for my$h (@hashrefs){%hash=(%hash,%$h)}return \%hash}sub install_base {my($self,$mm_opt)=@_;$mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;die "Your PERL_MM_OPT doesn't contain INSTALL_BASE"}sub safe_eval {my($self,$code)=@_;eval$code}sub configure_features {my($self,$dist,@features)=@_;map $_->identifier,grep {$self->effective_feature($dist,$_)}@features}sub effective_feature {my($self,$dist,$feature)=@_;if ($dist->{depth}==0){my$value=$self->{features}{$feature->identifier};return$value if defined$value;return 1 if$self->{features}{__all}}if ($self->{interactive}){require CPAN::Meta::Requirements;$self->diag("[@{[ $feature->description ]}]\n",1);my$req=CPAN::Meta::Requirements->new;for my$phase (@{$dist->{want_phases}}){for my$type (@{$self->{install_types}}){$req->add_requirements($feature->prereqs->requirements_for($phase,$type))}}my$reqs=$req->as_string_hash;my@missing;for my$module (keys %$reqs){if ($self->should_install($module,$req->{$module})){push@missing,$module}}if (@missing){my$howmany=@missing;$self->diag("==> Found missing dependencies: " .join(", ",@missing)."\n",1);local$self->{prompt}=1;return$self->prompt_bool("Install the $howmany optional module(s)?","y")}}return}sub find_prereqs {my($self,$dist)=@_;my@deps=$self->extract_meta_prereqs($dist);if ($dist->{module}=~ /^Bundle::/i){push@deps,$self->bundle_deps($dist)}if ($self->{cpanfile_requirements}&&!$dist->{cpanfile}){for my$dep (@deps){$dep->merge_with($self->{cpanfile_requirements})}}return@deps}sub extract_meta_prereqs {my($self,$dist)=@_;if ($dist->{cpanfile}){my@features=$self->configure_features($dist,$dist->{cpanfile}->features);my$prereqs=$dist->{cpanfile}->prereqs_with(@features);$self->{cpanfile_requirements}=$prereqs->merged_requirements($dist->{want_phases},['requires']);return App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}require CPAN::Meta;my@deps;my($meta_file)=grep -f,qw(MYMETA.json MYMETA.yml);if ($meta_file){$self->chat("Checking dependencies from $meta_file ...\n");my$mymeta=eval {CPAN::Meta->load_file($meta_file,{lazy_validation=>1 })};if ($mymeta){$dist->{meta}{name}=$mymeta->name;$dist->{meta}{version}=$mymeta->version;return$self->extract_prereqs($mymeta,$dist)}}if (-e '_build/prereqs'){$self->chat("Checking dependencies from _build/prereqs ...\n");my$prereqs=do {open my$in,"_build/prereqs";$self->safe_eval(join "",<$in>)};my$meta=CPAN::Meta->new({name=>$dist->{meta}{name},version=>$dist->{meta}{version},%$prereqs },{lazy_validation=>1 },);@deps=$self->extract_prereqs($meta,$dist)}elsif (-e 'Makefile'){$self->chat("Finding PREREQ from Makefile ...\n");open my$mf,"Makefile";while (<$mf>){if (/^\#\s+PREREQ_PM => \{\s*(.*?)\s*\}/){my@all;my@pairs=split ', ',$1;for (@pairs){my ($pkg,$v)=split '=>',$_;push@all,[$pkg,$v ]}my$list=join ", ",map {"'$_->[0]' => $_->[1]"}@all;my$prereq=$self->safe_eval("no strict; +{ $list }");push@deps,App::cpanminus::Dependency->from_versions($prereq)if$prereq;last}}}return@deps}sub bundle_deps {my($self,$dist)=@_;my@files;File::Find::find({wanted=>sub {push@files,File::Spec->rel2abs($_)if /\.pm/i},no_chdir=>1,},'.');my@deps;for my$file (@files){open my$pod,"<",$file or next;my$in_contents;while (<$pod>){if (/^=head\d\s+CONTENTS/){$in_contents=1}elsif (/^=/){$in_contents=0}elsif ($in_contents){/^(\S+)\s*(\S+)?/ and push@deps,App::cpanminus::Dependency->new($1,$self->maybe_version($2))}}}return@deps}sub maybe_version {my($self,$string)=@_;return$string && $string =~ /^\.?\d/ ? $string : undef}sub extract_prereqs {my($self,$meta,$dist)=@_;my@features=$self->configure_features($dist,$meta->features);my$prereqs=$self->soften_makemaker_prereqs($meta->effective_prereqs(\@features)->clone);return App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}sub soften_makemaker_prereqs {my($self,$prereqs)=@_;return$prereqs unless -e "inc/Module/Install.pm";for my$phase (qw(build test runtime)){my$reqs=$prereqs->requirements_for($phase,'requires');if ($reqs->requirements_for_module('ExtUtils::MakeMaker')){$reqs->clear_requirement('ExtUtils::MakeMaker');$reqs->add_minimum('ExtUtils::MakeMaker'=>0)}}$prereqs}sub cleanup_workdirs {my$self=shift;my$expire=time - 24 * 60 * 60 * $self->{auto_cleanup};my@targets;opendir my$dh,"$self->{home}/work";while (my$e=readdir$dh){next if$e !~ /^(\d+)\.\d+$/;my$time=$1;if ($time < $expire){push@targets,"$self->{home}/work/$e"}}if (@targets){if (@targets >= 64){$self->diag("Expiring " .scalar(@targets)." work directories. This might take a while...\n")}else {$self->chat("Expiring " .scalar(@targets)." work directories.\n")}File::Path::rmtree(\@targets,0,0)}}sub scandeps_append_child {my($self,$dist)=@_;my$new_node=[$dist,[]];my$curr_node=$self->{scandeps_current}|| [undef,$self->{scandeps_tree}];push @{$curr_node->[1]},$new_node;$self->{scandeps_current}=$new_node;return sub {$self->{scandeps_current}=$curr_node}}sub dump_scandeps {my$self=shift;if ($self->{format}eq 'tree'){$self->walk_down(sub {my($dist,$depth)=@_;if ($depth==0){print "$dist->{distvname}\n"}else {print " " x ($depth - 1);print "\\_ $dist->{distvname}\n"}},1)}elsif ($self->{format}=~ /^dists?$/){$self->walk_down(sub {my($dist,$depth)=@_;print$self->format_dist($dist),"\n"},0)}elsif ($self->{format}eq 'json'){require JSON::PP;print JSON::PP::encode_json($self->{scandeps_tree})}elsif ($self->{format}eq 'yaml'){require YAML;print YAML::Dump($self->{scandeps_tree})}else {$self->diag("Unknown format: $self->{format}\n")}}sub walk_down {my($self,$cb,$pre)=@_;$self->_do_walk_down($self->{scandeps_tree},$cb,0,$pre)}sub _do_walk_down {my($self,$children,$cb,$depth,$pre)=@_;for my$node (@$children){$cb->($node->[0],$depth)if$pre;$self->_do_walk_down($node->[1],$cb,$depth + 1,$pre);$cb->($node->[0],$depth)unless$pre}}sub DESTROY {my$self=shift;$self->{at_exit}->($self)if$self->{at_exit}}sub shell_quote {my($self,@stuff)=@_;if (WIN32){join ' ',map {/^${quote}.+${quote}$/ ? $_ : ($quote .$_ .$quote)}@stuff}else {String::ShellQuote::shell_quote_best_effort(@stuff)}}sub which {my($self,$name)=@_;if (File::Spec->file_name_is_absolute($name)){if (-x $name &&!-d _){return$name}}my$exe_ext=$Config{_exe};for my$dir (File::Spec->path){my$fullpath=File::Spec->catfile($dir,$name);if ((-x $fullpath || -x ($fullpath .= $exe_ext))&&!-d _){if ($fullpath =~ /\s/){$fullpath=$self->shell_quote($fullpath)}return$fullpath}}return}sub get {my($self,$uri)=@_;if ($uri =~ /^file:/){$self->file_get($uri)}else {$self->{_backends}{get}->(@_)}}sub mirror {my($self,$uri,$local)=@_;if ($uri =~ /^file:/){$self->file_mirror($uri,$local)}else {$self->{_backends}{mirror}->(@_)}}sub untar {$_[0]->{_backends}{untar}->(@_)};sub unzip {$_[0]->{_backends}{unzip}->(@_)};sub uri_to_file {my($self,$uri)=@_;if ($uri =~ s!file:/+!!){$uri="/$uri" unless$uri =~ m![a-zA-Z]:!}return$uri}sub file_get {my($self,$uri)=@_;my$file=$self->uri_to_file($uri);open my$fh,"<$file" or return;join '',<$fh>}sub file_mirror {my($self,$uri,$path)=@_;my$file=$self->uri_to_file($uri);File::Copy::copy($file,$path)}sub has_working_lwp {my($self,$mirrors)=@_;my$https=grep /^https:/,@$mirrors;eval {require LWP::UserAgent;LWP::UserAgent->VERSION(5.802);require LWP::Protocol::https if$https;1}}sub init_tools {my$self=shift;return if$self->{initialized}++;if ($self->{make}=$self->which($Config{make})){$self->chat("You have make $self->{make}\n")}if ($self->{try_lwp}&& $self->has_working_lwp($self->{mirrors})){$self->chat("You have LWP $LWP::VERSION\n");my$ua=sub {LWP::UserAgent->new(parse_head=>0,env_proxy=>1,agent=>$self->agent,timeout=>30,@_,)};$self->{_backends}{get}=sub {my$self=shift;my$res=$ua->()->request(HTTP::Request->new(GET=>$_[0]));return unless$res->is_success;return$res->decoded_content};$self->{_backends}{mirror}=sub {my$self=shift;my$res=$ua->()->mirror(@_);die$res->content if$res->code==501;$res->code}}elsif ($self->{try_wget}and my$wget=$self->which('wget')){$self->chat("You have $wget\n");my@common=('--user-agent',$self->agent,'--retry-connrefused',($self->{verbose}? (): ('-q')),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O','-')or die "wget $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O',$path)or die "wget $uri: $!";local $/;<$fh>}}elsif ($self->{try_curl}and my$curl=$self->which('curl')){$self->chat("You have $curl\n");my@common=('--location','--user-agent',$self->agent,($self->{verbose}? (): '-s'),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$curl,@common,$uri)or die "curl $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$curl,@common,$uri,'-#','-o',$path)or die "curl $uri: $!";local $/;<$fh>}}else {require HTTP::Tiny;$self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");my%common=(agent=>$self->agent,);$self->{_backends}{get}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->get($_[0]);return unless$res->{success};return$res->{content}};$self->{_backends}{mirror}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->mirror(@_);return$res->{status}}}my$tar=$self->which('tar');my$tar_ver;my$maybe_bad_tar=sub {WIN32 || BAD_TAR || (($tar_ver=`$tar --version 2>/dev/null`)=~ /GNU.*1\.13/i)};if ($tar &&!$maybe_bad_tar->()){chomp$tar_ver;$self->chat("You have $tar: $tar_ver\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$xf=($self->{verbose}? 'v' : '')."xf";my$ar=$tarfile =~ /bz2$/ ? 'j' : 'z';my($root,@others)=`$tar ${ar}tf $tarfile` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$tar $ar$xf $tarfile";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif ($tar and my$gzip=$self->which('gzip')and my$bzip2=$self->which('bzip2')){$self->chat("You have $tar, $gzip and $bzip2\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$x="x" .($self->{verbose}? 'v' : '')."f -";my$ar=$tarfile =~ /bz2$/ ? $bzip2 : $gzip;my($root,@others)=`$ar -dc $tarfile | $tar tf -` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$ar -dc $tarfile | $tar $x";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif (eval {require Archive::Tar}){$self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");$self->{_backends}{untar}=sub {my$self=shift;my$t=Archive::Tar->new($_[0]);my($root,@others)=$t->list_files;FILE: {$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}$t->extract;return -d $root ? $root : undef}}else {$self->{_backends}{untar}=sub {die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n"}}if (my$unzip=$self->which('unzip')){$self->chat("You have $unzip\n");$self->{_backends}{unzip}=sub {my($self,$zipfile)=@_;my$opt=$self->{verbose}? '' : '-q';my(undef,$root,@others)=`$unzip -t $zipfile` or return undef;chomp$root;$root =~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1};system "$unzip $opt $zipfile";return$root if -d $root;$self->diag_fail("Bad archive: [$root] $zipfile");return undef}}else {$self->{_backends}{unzip}=sub {eval {require Archive::Zip}or die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";my($self,$file)=@_;my$zip=Archive::Zip->new();my$status;$status=$zip->read($file);$self->diag_fail("Read of file[$file] failed")if$status!=Archive::Zip::AZ_OK();my@members=$zip->members();for my$member (@members){my$af=$member->fileName();next if ($af =~ m!^(/|\.\./)!);$status=$member->extractToFileNamed($af);$self->diag_fail("Extracting of file[$af] from zipfile[$file failed")if$status!=Archive::Zip::AZ_OK()}my ($root)=$zip->membersMatching(qr<^[^/]+/$>);$root &&= $root->fileName;return -d $root ? $root : undef}}}sub safeexec {my$self=shift;my$rdr=$_[0]||= Symbol::gensym();if (WIN32){my$cmd=$self->shell_quote(@_[1..$#_]);return open($rdr,"$cmd |")}if (my$pid=open($rdr,'-|')){return$pid}elsif (defined$pid){exec(@_[1 .. $#_ ]);exit 1}else {return}}sub mask_uri_passwords {my($self,@strings)=@_;s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:********@}gx for@strings;return@strings}1;
479 33
   It appears your cpanm executable was installed via `perlbrew install-cpanm`.
480 34
   cpanm --self-upgrade won't upgrade the version of cpanm you're running.
481 35
   
... ...
@@ -483,9 +37,7 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
483 37
   
484 38
     perlbrew install-cpanm
485 39
   
486
-  WARN
487
-          } else {
488
-              warn <<WARN;
40
+  DIE
489 41
   You are running cpanm from the path where your current perl won't install executables to.
490 42
   Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running.
491 43
   
... ...
@@ -494,11698 +46,463 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
494 46
   
495 47
   It means you either installed cpanm globally with system perl, or use distro packages such
496 48
   as rpm or apt-get, and you have to use them again to upgrade cpanm.
497
-  WARN
498
-          }
499
-      }
500
-  }
501
-  
502
-  sub check_libs {
503
-      my $self = shift;
504
-      return if $self->{_checked}++;
505
-  
506
-      $self->bootstrap_local_lib;
507
-      if (@{$self->{bootstrap_deps} || []}) {
508
-          local $self->{notest} = 1; # test failure in bootstrap should be tolerated
509
-          local $self->{scandeps} = 0;
510
-          $self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
511
-      }
512
-  }
513
-  
514
-  sub setup_verify {
515
-      my $self = shift;
516
-  
517
-      my $has_modules = eval { require Module::Signature; require Digest::SHA; 1 };
518
-      $self->{cpansign} = $self->which('cpansign');
519
-  
520
-      unless ($has_modules && $self->{cpansign}) {
521
-          warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";
522
-          $self->{verify} = 0;
523
-      }
524
-  }
525
-  
526
-  sub parse_module_args {
527
-      my($self, $module) = @_;
528
-  
529
-      # Plack@1.2 -> Plack~"==1.2"
530
-      # BUT don't expand @ in git URLs
531
-      $module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;
532
-  
533
-      # Plack~1.20, DBI~"> 1.0, <= 2.0"
534
-      if ($module =~ /\~[v\d\._,\!<>= ]+$/) {
535
-          return split /\~/, $module, 2;
536
-      } else {
537
-          return $module, undef;
538
-      }
539
-  }
540
-  
541
-  sub doit {
542
-      my $self = shift;
543
-  
544
-      $self->setup_home;
545
-      $self->init_tools;
546
-      $self->setup_verify if $self->{verify};
547
-  
548
-      if (my $action = $self->{action}) {
549
-          $self->$action() and return 1;
550
-      }
551
-  
552
-      $self->show_help(1)
553
-          unless @{$self->{argv}} or $self->{load_from_stdin};
554
-  
555
-      $self->configure_mirrors;
556
-  
557
-      my $cwd = Cwd::cwd;
558
-  
559
-      my @fail;
560
-      for my $module (@{$self->{argv}}) {
561
-          if ($module =~ s/\.pm$//i) {
562
-              my ($volume, $dirs, $file) = File::Spec->splitpath($module);
563
-              $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
564
-          }
565
-  
566
-          ($module, my $version) = $self->parse_module_args($module);
567
-          if ($self->{skip_satisfied}) {
568
-              $self->check_libs;
569
-              my($ok, $local) = $self->check_module($module, $version || 0);
570
-              if ($ok) {
571
-                  $self->diag("You have $module ($local)\n", 1);
572
-                  next;
573
-              }
574
-          }
575
-  
576
-          $self->chdir($cwd);
577
-          $self->install_module($module, 0, $version)
578
-              or push @fail, $module;
579
-      }
580
-  
581
-      if ($self->{base} && $self->{auto_cleanup}) {
582
-          $self->cleanup_workdirs;
583
-      }
584
-  
585
-      if ($self->{installed_dists}) {
586
-          my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
587
-          $self->diag("$self->{installed_dists} $dists installed\n", 1);
588
-      }
589
-  
590
-      if ($self->{scandeps}) {
591
-          $self->dump_scandeps();
592
-      }
593
-      # Workaround for older File::Temp's
594
-      # where creating a tempdir with an implicit $PWD
595
-      # causes tempdir non-cleanup if $PWD changes
596
-      # as paths are stored internally without being resolved
597
-      # absolutely.
598
-      # https://rt.cpan.org/Public/Bug/Display.html?id=44924
599
-      $self->chdir($cwd);
600
-  
601
-      return !@fail;
602
-  }
603
-  
604
-  sub setup_home {
605
-      my $self = shift;
606
-  
607
-      $self->{home} = $self->env('HOME') if $self->env('HOME');
608
-  
609
-      unless (_writable($self->{home})) {
610
-          die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
611
-      }
612
-  
613
-      $self->{base} = "$self->{home}/work/" . time . ".$$";
614
-      File::Path::mkpath([ $self->{base} ], 0, 0777);
615
-  
616
-      my $link = "$self->{home}/latest-build";
617
-      eval { unlink $link; symlink $self->{base}, $link };
618
-  
619
-      $self->{log} = File::Spec->catfile($self->{home}, "build.log"); # because we use shell redirect
620
-  
621
-      {
622
-          my $log = $self->{log}; my $base = $self->{base};
623
-          $self->{at_exit} = sub {
624
-              my $self = shift;
625
-              File::Copy::copy($self->{log}, "$self->{base}/build.log");
626
-          };
627
-      }
628
-  
629
-      { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
630
-  
631
-      $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
632
-                  "Work directory is $self->{base}\n");
633
-  }
634
-  
635
-  sub fetch_meta_sco {
636
-      my($self, $dist) = @_;
637
-      return if $self->{mirror_only};
638
-  
639
-      my $meta_yml = $self->get("http://search.cpan.org/meta/$dist->{distvname}/META.yml");
640
-      return $self->parse_meta_string($meta_yml);
641
-  }
642
-  
643
-  sub package_index_for {
644
-      my ($self, $mirror) = @_;
645
-      return $self->source_for($mirror) . "/02packages.details.txt";
646
-  }
647
-  
648
-  sub generate_mirror_index {
649
-      my ($self, $mirror) = @_;
650
-      my $file = $self->package_index_for($mirror);
651
-      my $gz_file = $file . '.gz';
652
-      my $index_mtime = (stat $gz_file)[9];
653
-  
654
-      unless (-e $file && (stat $file)[9] >= $index_mtime) {
655
-          $self->chat("Uncompressing index file...\n");
656
-          if (eval {require Compress::Zlib}) {
657
-              my $gz = Compress::Zlib::gzopen($gz_file, "rb")
658
-                  or do { $self->diag_fail("$Compress::Zlib::gzerrno opening compressed index"); return};
659
-              open my $fh, '>', $file
660
-                  or do { $self->diag_fail("$! opening uncompressed index for write"); return };
661
-              my $buffer;
662
-              while (my $status = $gz->gzread($buffer)) {
663
-                  if ($status < 0) {
664
-                      $self->diag_fail($gz->gzerror . " reading compressed index");
665
-                      return;
666
-                  }
667
-                  print $fh $buffer;
668
-              }
669
-          } else {
670
-              if (system("gunzip -c $gz_file > $file")) {
671
-                  $self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");
672
-                  return;
673
-              }
674
-          }
675
-          utime $index_mtime, $index_mtime, $file;
676
-      }
677
-      return 1;
678
-  }
679
-  
680
-  sub search_mirror_index {
681
-      my ($self, $mirror, $module, $version) = @_;
682
-      $self->search_mirror_index_file($self->package_index_for($mirror), $module, $version);
683
-  }
684
-  
685
-  sub search_mirror_index_file {
686
-      my($self, $file, $module, $version) = @_;
687
-  
688
-      open my $fh, '<', $file or return;
689
-      my $found;
690
-      while (<$fh>) {
691
-          if (m!^\Q$module\E\s+([\w\.]+)\s+(\S*)!m) {
692
-              $found = $self->cpan_module($module, $2, $1);
693
-              last;
694
-          }
695
-      }
696
-  
697
-      return $found unless $self->{cascade_search};
698
-  
699
-      if ($found) {
700
-          if ($self->satisfy_version($module, $found->{module_version}, $version)) {
701
-              return $found;
702
-          } else {
703
-              $self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n");
704
-          }
705
-      }
706
-  
707
-      return;
708
-  }
709
-  
710
-  sub with_version_range {
711
-      my($self, $version) = @_;
712
-      defined($version) && $version =~ /[<>=]/;
713
-  }
714
-  
715
-  sub encode_json {
716
-      my($self, $data) = @_;
717
-      require JSON::PP;
718
-  
719
-      my $json = JSON::PP::encode_json($data);
720
-      $json =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
721
-      $json;
722
-  }
723
-  
724
-  # TODO extract this as a module?
725
-  sub version_to_query {
726
-      my($self, $module, $version) = @_;
727
-  
728
-      require CPAN::Meta::Requirements;
49
+  DIE
50
+  Usage: cpanm [options] Module [...]
729 51
   
730
-      my $requirements = CPAN::Meta::Requirements->new;
731
-      $requirements->add_string_requirement($module, $version || '0');
52
+  Try `cpanm --help` or `man cpanm` for more options.
53
+  USAGE
54
+  Usage: cpanm [options] Module [...]
732 55
   
733
-      my $req = $requirements->requirements_for_module($module);
734
-  
735
-      if ($req =~ s/^==\s*//) {
736
-          return {
737
-              term => { 'module.version' => $req },
738
-          };
739
-      } elsif ($req !~ /\s/) {
740
-          return {
741
-              range => { 'module.version_numified' => { 'gte' => $self->numify_ver($req) } },
742
-          };
743
-      } else {
744
-          my %ops = qw(< lt <= lte > gt >= gte);
745
-          my(%range, @exclusion);
746
-          my @requirements = split /,\s*/, $req;
747
-          for my $r (@requirements) {
748
-              if ($r =~ s/^([<>]=?)\s*//) {
749
-                  $range{$ops{$1}} = $self->numify_ver($r);
750
-              } elsif ($r =~ s/\!=\s*//) {
751
-                  push @exclusion, $self->numify_ver($r);
752
-              }
753
-          }
754
-  
755
-          my @filters= (
756
-              { range => { 'module.version_numified' => \%range } },
757
-          );
758
-  
759
-          if (@exclusion) {
760
-              push @filters, {
761
-                  not => { or => [ map { +{ term => { 'module.version_numified' => $self->numify_ver($_) } } } @exclusion ] },
762
-              };
763
-          }
764
-  
765
-          return @filters;
766
-      }
767
-  }
768
-  
769
-  sub numify_ver {
770
-      my($self, $ver) = @_;
771
-      version->new($ver)->numify;
772
-  }
773
-  
774
-  sub maturity_filter {
775
-      my($self, $module, $version) = @_;
776
-  
777
-      my @filters;
778
-  
779
-      # TODO: dev release should be enabled per dist
780
-      if (!$self->with_version_range($version) or $self->{dev_release}) {
781
-          # backpan'ed dev release are considered "cancelled"
782
-          push @filters, { not => { term => { status => 'backpan' } } };
783
-      }
784
-  
785
-      unless ($self->{dev_release} or $version =~ /==/) {
786
-          push @filters, { term => { maturity => 'released' } };
787
-      }
788
-  
789
-      return @filters;
790
-  }
791
-  
792
-  sub search_metacpan {
793
-      my($self, $module, $version) = @_;
794
-  
795
-      require JSON::PP;
796
-  
797
-      $self->chat("Searching $module ($version) on metacpan ...\n");
798
-  
799
-      my $metacpan_uri = 'http://api.metacpan.org/v0';
800
-  
801
-      my @filter = $self->maturity_filter($module, $version);
802
-  
803
-      my $query = { filtered => {
804
-          (@filter ? (filter => { and => \@filter }) : ()),
805
-          query => { nested => {
806
-              score_mode => 'max',
807
-              path => 'module',
808
-              query => { custom_score => {
809
-                  metacpan_script => "score_version_numified",
810
-                  query => { constant_score => {
811
-                      filter => { and => [
812
-                          { term => { 'module.authorized' => JSON::PP::true() } },
813
-                          { term => { 'module.indexed' => JSON::PP::true() } },
814
-                          { term => { 'module.name' => $module } },
815
-                          $self->version_to_query($module, $version),
816
-                      ] }
817
-                  } },
818
-              } },
819
-          } },
820
-      } };
821
-  
822
-      my $module_uri = "$metacpan_uri/file/_search?source=";
823
-      $module_uri .= $self->encode_json({
824
-          query => $query,
825
-          fields => [ 'release', 'module' ],
826
-      });
827
-  
828
-      my($release, $module_version);
829
-  
830
-      my $module_json = $self->get($module_uri);
831
-      my $module_meta = eval { JSON::PP::decode_json($module_json) };
832
-      my $match = $module_meta ? $module_meta->{hits}{hits}[0]{fields} : undef;
833
-      if ($match) {
834
-          $release = $match->{release};
835
-          my $module_matched = (grep { $_->{name} eq $module } @{$match->{module}})[0];
836
-          $module_version = $module_matched->{version};
837
-      }
838
-  
839
-      unless ($release) {
840
-          $self->chat("! Could not find a release matching $module ($version) on MetaCPAN.\n");
841
-          return;
842
-      }
843
-  
844
-      my $dist_uri = "$metacpan_uri/release/_search?source=";
845
-      $dist_uri .= $self->encode_json({
846
-          filter => {
847
-              term => { 'release.name' => $release },
848
-          },
849
-          fields => [ 'download_url', 'stat', 'status' ],
850
-      });
851
-  
852
-      my $dist_json = $self->get($dist_uri);
853
-      my $dist_meta = eval { JSON::PP::decode_json($dist_json) };
854
-  
855
-      if ($dist_meta) {
856
-          $dist_meta = $dist_meta->{hits}{hits}[0]{fields};
857
-      }
858
-      if ($dist_meta && $dist_meta->{download_url}) {
859
-          (my $distfile = $dist_meta->{download_url}) =~ s!.+/authors/id/!!;
860
-          local $self->{mirrors} = $self->{mirrors};
861
-          if ($dist_meta->{status} eq 'backpan') {
862
-              $self->{mirrors} = [ 'http://backpan.perl.org' ];
863
-          } elsif ($dist_meta->{stat}{mtime} > time()-24*60*60) {
864
-              $self->{mirrors} = [ 'http://cpan.metacpan.org' ];
865
-          }
866
-          return $self->cpan_module($module, $distfile, $module_version);
867
-      }
868
-  
869
-      $self->diag_fail("Finding $module on metacpan failed.");
870
-      return;
871
-  }
872
-  
873
-  sub search_database {
874
-      my($self, $module, $version) = @_;
875
-  
876
-      my $found;
877
-      my $range = ($self->with_version_range($version) || $self->{dev_release});
878
-  
879
-      if ($range or $self->{metacpan}) {
880
-          $found = $self->search_metacpan($module, $version)   and return $found;
881
-          $found = $self->search_cpanmetadb($module, $version) and return $found;
882
-      } else {
883
-          $found = $self->search_cpanmetadb($module, $version) and return $found;
884
-          $found = $self->search_metacpan($module, $version)   and return $found;
885
-      }
886
-  }
887
-  
888
-  sub search_cpanmetadb {
889
-      my($self, $module, $version) = @_;
890
-  
891
-      $self->chat("Searching $module on cpanmetadb ...\n");
892
-  
893
-      my $uri  = "http://cpanmetadb.plackperl.org/v1.0/package/$module";
894
-      my $yaml = $self->get($uri);
895
-      my $meta = $self->parse_meta_string($yaml);
896
-      if ($meta && $meta->{distfile}) {
897
-          return $self->cpan_module($module, $meta->{distfile}, $meta->{version});
898
-      }
899
-  
900
-      $self->diag_fail("Finding $module on cpanmetadb failed.");
901
-      return;
902
-  }
903
-  
904
-  sub search_module {
905
-      my($self, $module, $version) = @_;
906
-  
907
-      if ($self->{mirror_index}) {
908
-          $self->chat("Searching $module on mirror index $self->{mirror_index} ...\n");
909
-          my $pkg = $self->search_mirror_index_file($self->{mirror_index}, $module, $version);
910
-          return $pkg if $pkg;
911
-  
912
-          unless ($self->{cascade_search}) {
913
-             $self->diag_fail("Finding $module ($version) on mirror index $self->{mirror_index} failed.");
914
-             return;
915
-          }
916
-      }
917
-  
918
-      unless ($self->{mirror_only}) {
919
-          my $found = $self->search_database($module, $version);
920
-          return $found if $found;
921
-      }
922
-  
923
-      MIRROR: for my $mirror (@{ $self->{mirrors} }) {
924
-          $self->chat("Searching $module on mirror $mirror ...\n");
925
-          my $name = '02packages.details.txt.gz';
926
-          my $uri  = "$mirror/modules/$name";
927
-          my $gz_file = $self->package_index_for($mirror) . '.gz';
928
-  
929
-          unless ($self->{pkgs}{$uri}) {
930
-              $self->chat("Downloading index file $uri ...\n");
931
-              $self->mirror($uri, $gz_file);
932
-              $self->generate_mirror_index($mirror) or next MIRROR;
933
-              $self->{pkgs}{$uri} = "!!retrieved!!";
934
-          }
935
-  
936
-          my $pkg = $self->search_mirror_index($mirror, $module, $version);
937
-          return $pkg if $pkg;
938
-  
939
-          $self->diag_fail("Finding $module ($version) on mirror $mirror failed.");
940
-      }
941
-  
942
-      return;
943
-  }
944
-  
945
-  sub source_for {
946
-      my($self, $mirror) = @_;
947
-      $mirror =~ s/[^\w\.\-]+/%/g;
948
-  
949
-      my $dir = "$self->{home}/sources/$mirror";
950
-      File::Path::mkpath([ $dir ], 0, 0777);
951
-  
952
-      return $dir;
953
-  }
954
-  
955
-  sub load_argv_from_fh {
956
-      my($self, $fh) = @_;
957
-  
958
-      my @argv;
959
-      while(defined(my $line = <$fh>)){
960
-          chomp $line;
961
-          $line =~ s/#.+$//; # comment
962
-          $line =~ s/^\s+//; # trim spaces
963
-          $line =~ s/\s+$//; # trim spaces
964
-  
965
-          push @argv, split ' ', $line if $line;
966
-      }
967
-      return @argv;
968
-  }
969
-  
970
-  sub show_version {
971
-      print "cpanm (App::cpanminus) version $VERSION\n";
972
-      return 1;
973
-  }
974
-  
975
-  sub show_help {
976
-      my $self = shift;
977
-  
978
-      if ($_[0]) {
979
-          die <<USAGE;
980
-  Usage: cpanm [options] Module [...]
981
-  
982
-  Try `cpanm --help` or `man cpanm` for more options.
983
-  USAGE
984
-      }
985
-  
986
-      print <<HELP;
987
-  Usage: cpanm [options] Module [...]
988
-  
989
-  Options:
990
-    -v,--verbose              Turns on chatty output
991
-    -q,--quiet                Turns off the most output
992
-    --interactive             Turns on interactive configure (required for Task:: modules)
993
-    -f,--force                force install
994
-    -n,--notest               Do not run unit tests
995
-    --test-only               Run tests only, do not install
996
-    -S,--sudo                 sudo to run install commands
997
-    --installdeps             Only install dependencies
998
-    --showdeps                Only display direct dependencies
999
-    --reinstall               Reinstall the distribution even if you already have the latest version installed
1000
-    --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
1001
-    --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
1002
-    --prompt                  Prompt when configure/build/test fails
1003
-    -l,--local-lib            Specify the install base to install modules
1004
-    -L,--local-lib-contained  Specify the install base to install all non-core modules
1005
-    --auto-cleanup            Number of days that cpanm's work directories expire in. Defaults to 7
56
+  Options:
57
+    -v,--verbose              Turns on chatty output
58
+    -q,--quiet                Turns off the most output
59
+    --interactive             Turns on interactive configure (required for Task:: modules)
60
+    -f,--force                force install
61
+    -n,--notest               Do not run unit tests
62
+    --test-only               Run tests only, do not install
63
+    -S,--sudo                 sudo to run install commands
64
+    --installdeps             Only install dependencies
65
+    --showdeps                Only display direct dependencies
66
+    --reinstall               Reinstall the distribution even if you already have the latest version installed
67
+    --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
68
+    --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
69
+    -M,--from                 Use only this mirror base URL and its index file
70
+    --prompt                  Prompt when configure/build/test fails
71
+    -l,--local-lib            Specify the install base to install modules
72
+    -L,--local-lib-contained  Specify the install base to install all non-core modules
73
+    --self-contained          Install all non-core modules, even if they're already installed.
74
+    --auto-cleanup            Number of days that cpanm's work directories expire in. Defaults to 7
1006 75
   
1007 76
   Commands:
1008 77
     --self-upgrade            upgrades itself
1009
-    --info                    Displays distribution info on CPAN
1010
-    --look                    Opens the distribution with your SHELL
1011
-    -V,--version              Displays software version
1012
-  
1013
-  Examples:
1014
-  
1015
-    cpanm Test::More                                          # install Test::More
1016
-    cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
1017
-    cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
1018
-    cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
1019
-    cpanm --interactive Task::Kensho                          # Configure interactively
1020
-    cpanm .                                                   # install from local directory
1021
-    cpanm --installdeps .                                     # install all the deps for the current directory
1022
-    cpanm -L extlib Plack                                     # install Plack and all non-core deps into extlib
1023
-    cpanm --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
1024
-  
1025
-  You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
1026
-  
1027
-    export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
1028
-  
1029
-  Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
1030
-  
1031
-  HELP
1032
-  
1033
-      return 1;
1034
-  }
1035
-  
1036
-  sub _writable {
1037
-      my $dir = shift;
1038
-      my @dir = File::Spec->splitdir($dir);
1039
-      while (@dir) {
1040
-          $dir = File::Spec->catdir(@dir);
1041
-          if (-e $dir) {
1042
-              return -w _;
1043
-          }
1044
-          pop @dir;
1045
-      }
1046
-  
1047
-      return;
1048
-  }
1049
-  
1050
-  sub maybe_abs {
1051
-      my($self, $lib) = @_;
1052
-      if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)) {
1053
-          return $lib;
1054
-      } else {
1055
-          return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(), $lib));
1056
-      }
1057
-  }
1058
-  
1059
-  sub bootstrap_local_lib {
1060
-      my $self = shift;
1061
-  
1062
-      # If -l is specified, use that.
1063
-      if ($self->{local_lib}) {
1064
-          return $self->setup_local_lib($self->{local_lib});
1065
-      }
1066
-  
1067
-      # root, locally-installed perl or --sudo: don't care about install_base
1068
-      return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));
1069
-  
1070
-      # local::lib is configured in the shell -- yay
1071
-      if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
1072
-          $self->bootstrap_local_lib_deps;
1073
-          return;
1074
-      }
1075
-  
1076
-      $self->setup_local_lib;
1077
-  
1078
-      $self->diag(<<DIAG);
1079
-  !
1080
-  ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
1081
-  ! To turn off this warning, you have to do one of the following:
1082
-  !   - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
1083
-  !   - Configure local::lib your existing local::lib in this shell to set PERL_MM_OPT etc.
1084
-  !   - Install local::lib by running the following commands
1085
-  !
1086
-  !         cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
1087
-  !
1088
-  DIAG
1089
-      sleep 2;
1090
-  }
1091
-  
1092
-  sub _core_only_inc {
1093
-      my($self, $base) = @_;
1094
-      require local::lib;
1095
-      (
1096
-          local::lib->resolve_path(local::lib->install_base_perl_path($base)),
1097
-          local::lib->resolve_path(local::lib->install_base_arch_path($base)),
1098
-          @Config{qw(privlibexp archlibexp)},
1099
-      );
1100
-  }
1101
-  
1102
-  sub _diff {
1103
-      my($self, $old, $new) = @_;
1104
-  
1105
-      my @diff;
1106
-      my %old = map { $_ => 1 } @$old;
1107
-      for my $n (@$new) {
1108
-          push @diff, $n unless exists $old{$n};
1109
-      }
1110
-  
1111
-      @diff;
1112
-  }
1113
-  
1114
-  sub _setup_local_lib_env {
1115
-      my($self, $base) = @_;
1116
-      local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
1117
-      local::lib->setup_env_hash_for($base);
1118
-  }
1119
-  
1120
-  sub setup_local_lib {
1121
-      my($self, $base) = @_;
1122
-      $base = undef if $base eq '_';
1123
-  
1124
-      require local::lib;
1125
-      {
1126
-          local $0 = 'cpanm'; # so curl/wget | perl works
1127
-          $base ||= "~/perl5";
1128
-          if ($self->{self_contained}) {
1129
-              my @inc = $self->_core_only_inc($base);
1130
-              $self->{search_inc} = [ @inc ];
1131
-          } else {
1132
-              $self->{search_inc} = [
1133
-                  local::lib->resolve_path(local::lib->install_base_arch_path($base)),
1134
-                  local::lib->resolve_path(local::lib->install_base_perl_path($base)),
1135
-                  @INC,
1136
-              ];
1137
-          }
1138
-          $self->_setup_local_lib_env($base);
1139
-      }
1140
-  
1141
-      $self->bootstrap_local_lib_deps;
1142
-  }
1143
-  
1144
-  sub bootstrap_local_lib_deps {
1145
-      my $self = shift;
1146
-      push @{$self->{bootstrap_deps}},
1147
-          'ExtUtils::MakeMaker' => 6.31,
1148
-          'ExtUtils::Install'   => 1.46;
1149
-  }
1150
-  
1151
-  sub prompt_bool {
1152
-      my($self, $mess, $def) = @_;
1153
-  
1154
-      my $val = $self->prompt($mess, $def);
1155
-      return lc $val eq 'y';
1156
-  }
1157
-  
1158
-  sub prompt {
1159
-      my($self, $mess, $def) = @_;
1160
-  
1161
-      my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
1162
-      my $dispdef = defined $def ? "[$def] " : " ";
1163
-      $def = defined $def ? $def : "";
1164
-  
1165
-      if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
1166
-          return $def;
1167
-      }
1168
-  
1169
-      local $|=1;
1170
-      local $\;
1171
-      my $ans;
1172
-      eval {
1173
-          local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
1174
-          print STDOUT "$mess $dispdef";
1175
-          alarm $self->{prompt_timeout} if $self->{prompt_timeout};
1176
-          $ans = <STDIN>;
1177
-          alarm 0;
1178
-      };
1179
-      if ( defined $ans ) {
1180
-          chomp $ans;
1181
-      } else { # user hit ctrl-D or alarm timeout
1182
-          print STDOUT "\n";
1183
-      }
1184
-  
1185
-      return (!defined $ans || $ans eq '') ? $def : $ans;
1186
-  }
1187
-  
1188
-  sub diag_ok {
1189
-      my($self, $msg) = @_;
1190
-      chomp $msg;
1191
-      $msg ||= "OK";
1192
-      if ($self->{in_progress}) {
1193
-          $self->_diag("$msg\n");
1194
-          $self->{in_progress} = 0;
1195
-      }
1196
-      $self->log("-> $msg\n");
1197
-  }
1198
-  
1199
-  sub diag_fail {
1200
-      my($self, $msg, $always) = @_;
1201
-      chomp $msg;
1202
-      if ($self->{in_progress}) {
1203
-          $self->_diag("FAIL\n");
1204
-          $self->{in_progress} = 0;
1205
-      }
1206
-  
1207
-      if ($msg) {
1208
-          $self->_diag("! $msg\n", $always);
1209
-          $self->log("-> FAIL $msg\n");
1210
-      }
1211
-  }
1212
-  
1213
-  sub diag_progress {
1214
-      my($self, $msg) = @_;
1215
-      chomp $msg;
1216
-      $self->{in_progress} = 1;
1217
-      $self->_diag("$msg ... ");
1218
-      $self->log("$msg\n");
1219
-  }
1220
-  
1221
-  sub _diag {
1222
-      my($self, $msg, $always) = @_;
1223
-      print STDERR $msg if $always or $self->{verbose} or !$self->{quiet};
1224
-  }
1225
-  
1226
-  sub diag {
1227
-      my($self, $msg, $always) = @_;
1228
-      $self->_diag($msg, $always);
1229
-      $self->log($msg);
1230
-  }
1231
-  
1232
-  sub chat {
1233
-      my $self = shift;
1234
-      print STDERR @_ if $self->{verbose};
1235
-      $self->log(@_);
1236
-  }
1237
-  
1238
-  sub log {
1239
-      my $self = shift;
1240
-      open my $out, ">>$self->{log}";
1241
-      print $out @_;
1242
-  }
1243
-  
1244
-  sub run {
1245
-      my($self, $cmd) = @_;
1246
-  
1247
-      if (WIN32 && ref $cmd eq 'ARRAY') {
1248
-          $cmd = join q{ }, map { $self->shell_quote($_) } @$cmd;
1249
-      }
1250
-  
1251
-      if (ref $cmd eq 'ARRAY') {
1252
-          my $pid = fork;
1253
-          if ($pid) {
1254
-              waitpid $pid, 0;
1255
-              return !$?;
1256
-          } else {
1257
-              $self->run_exec($cmd);
1258
-          }
1259
-      } else {
1260
-          unless ($self->{verbose}) {
1261
-              $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
1262
-          }
1263
-          !system $cmd;
1264
-      }
1265
-  }
1266
-  
1267
-  sub run_exec {
1268
-      my($self, $cmd) = @_;
1269
-  
1270
-      if (ref $cmd eq 'ARRAY') {
1271
-          unless ($self->{verbose}) {
1272
-              open my $logfh, ">>", $self->{log};
1273
-              open STDERR, '>&', $logfh;
1274
-              open STDOUT, '>&', $logfh;
1275
-              close $logfh;
1276
-          }
1277
-          exec @$cmd;
1278
-      } else {
1279
-          unless ($self->{verbose}) {
1280
-              $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
1281
-          }
1282
-          exec $cmd;
1283
-      }
1284
-  }
1285
-  
1286
-  sub run_timeout {
1287
-      my($self, $cmd, $timeout) = @_;
1288
-      return $self->run($cmd) if WIN32 || $self->{verbose} || !$timeout;
1289
-  
1290
-      my $pid = fork;
1291
-      if ($pid) {
1292
-          eval {
1293
-              local $SIG{ALRM} = sub { die "alarm\n" };
1294
-              alarm $timeout;
1295
-              waitpid $pid, 0;
1296
-              alarm 0;
1297
-          };
1298
-          if ($@ && $@ eq "alarm\n") {
1299
-              $self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");
1300
-              local $SIG{TERM} = 'IGNORE';
1301
-              kill TERM => 0;
1302
-              waitpid $pid, 0;
1303
-              return;
1304
-          }
1305
-          return !$?;
1306
-      } elsif ($pid == 0) {
1307
-          $self->run_exec($cmd);
1308
-      } else {
1309
-          $self->chat("! fork failed: falling back to system()\n");
1310
-          $self->run($cmd);
1311
-      }
1312
-  }
1313
-  
1314
-  sub configure {
1315
-      my($self, $cmd) = @_;
1316
-  
1317
-      # trick AutoInstall
1318
-      local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;
1319
-  
1320
-      # e.g. skip CPAN configuration on local::lib
1321
-      local $ENV{PERL5_CPANM_IS_RUNNING} = $$;
1322
-  
1323
-      my $use_default = !$self->{interactive};
1324
-      local $ENV{PERL_MM_USE_DEFAULT} = $use_default;
1325
-  
1326
-      # skip man page generation
1327
-      local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
1328
-      unless ($self->{pod2man}) {
1329
-          $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
1330
-      }
1331
-  
1332
-      local $self->{verbose} = $self->{verbose} || $self->{interactive};
1333
-      $self->run_timeout($cmd, $self->{configure_timeout});
1334
-  }
1335
-  
1336
-  sub build {
1337
-      my($self, $cmd, $distname) = @_;
1338
-  
1339
-      return 1 if $self->run_timeout($cmd, $self->{build_timeout});
1340
-      while (1) {
1341
-          my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
1342
-          return                               if $ans eq 's';
1343
-          return $self->build($cmd, $distname) if $ans eq 'r';
1344
-          $self->show_build_log                if $ans eq 'e';
1345
-          $self->look                          if $ans eq 'l';
1346
-      }
1347
-  }
1348
-  
1349
-  sub test {
1350
-      my($self, $cmd, $distname) = @_;
1351
-      return 1 if $self->{notest};
1352
-  
1353
-      # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
1354
-      local $ENV{PERL_MM_USE_DEFAULT} = 1;
1355
-  
1356
-      return 1 if $self->run_timeout($cmd, $self->{test_timeout});
1357
-      if ($self->{force}) {
1358
-          $self->diag_fail("Testing $distname failed but installing it anyway.");
1359
-          return 1;
1360
-      } else {
1361
-          $self->diag_fail;
1362
-          while (1) {
1363
-              my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
1364
-              return                              if $ans eq 's';
1365
-              return $self->test($cmd, $distname) if $ans eq 'r';
1366
-              return 1                            if $ans eq 'f';
1367
-              $self->show_build_log               if $ans eq 'e';
1368
-              $self->look                         if $ans eq 'l';
1369
-          }
1370
-      }
1371
-  }
1372
-  
1373
-  sub install {
1374
-      my($self, $cmd, $uninst_opts, $depth) = @_;
1375
-  
1376
-      if ($depth == 0 && $self->{test_only}) {
1377
-          return 1;
1378
-      }
1379
-  
1380
-      if ($self->{sudo}) {
1381
-          unshift @$cmd, "sudo";
1382
-      }
1383
-  
1384
-      if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
1385
-          push @$cmd, @$uninst_opts;
1386
-      }
1387
-  
1388
-      $self->run($cmd);
1389
-  }
1390
-  
1391
-  sub look {
1392
-      my $self = shift;
1393
-  
1394
-      my $shell = $ENV{SHELL};
1395
-      $shell  ||= $ENV{COMSPEC} if WIN32;
1396
-      if ($shell) {
1397
-          my $cwd = Cwd::cwd;
1398
-          $self->diag("Entering $cwd with $shell\n");
1399
-          system $shell;
1400
-      } else {
1401
-          $self->diag_fail("You don't seem to have a SHELL :/");
1402
-      }
1403
-  }
1404
-  
1405
-  sub show_build_log {
1406
-      my $self = shift;
1407
-  
1408
-      my @pagers = (
1409
-          $ENV{PAGER},
1410
-          (WIN32 ? () : ('less')),
1411
-          'more'
1412
-      );
1413
-      my $pager;
1414
-      while (@pagers) {
1415
-          $pager = shift @pagers;
1416
-          next unless $pager;
1417
-          $pager = $self->which($pager);
1418
-          next unless $pager;
1419
-          last;
1420
-      }
1421
-  
1422
-      if ($pager) {
1423
-          # win32 'more' doesn't allow "more build.log", the < is required
1424
-          system("$pager < $self->{log}");
1425
-      }
1426
-      else {
1427
-          $self->diag_fail("You don't seem to have a PAGER :/");
1428
-      }
1429
-  }
1430
-  
1431
-  sub chdir {
1432
-      my $self = shift;
1433
-      Cwd::chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
1434
-  }
1435
-  
1436
-  sub configure_mirrors {
1437
-      my $self = shift;
1438
-      unless (@{$self->{mirrors}}) {
1439
-          $self->{mirrors} = [ 'http://www.cpan.org' ];
1440
-      }
1441
-      for (@{$self->{mirrors}}) {
1442
-          s!^/!file:///!;
1443
-          s!/$!!;
1444
-      }
1445
-  }
1446
-  
1447
-  sub self_upgrade {
1448
-      my $self = shift;
1449
-      $self->{argv} = [ 'App::cpanminus' ];
1450
-      return; # continue
1451
-  }
1452
-  
1453
-  sub install_module {
1454
-      my($self, $module, $depth, $version) = @_;
1455
-  
1456
-      if ($self->{seen}{$module}++) {
1457
-          $self->chat("Already tried $module. Skipping.\n");
1458
-          return 1;
1459
-      }
1460
-  
1461
-      my $dist = $self->resolve_name($module, $version);
1462
-      unless ($dist) {
1463
-          $self->diag_fail("Couldn't find module or a distribution $module ($version)", 1);
1464
-          return;
1465
-      }
1466
-  
1467
-      if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
1468
-          $self->chat("Already tried $dist->{distvname}. Skipping.\n");
1469
-          return 1;
1470
-      }
1471
-  
1472
-      if ($self->{cmd} eq 'info') {
1473
-          print $self->format_dist($dist), "\n";
1474
-          return 1;
1475
-      }
1476
-  
1477
-      $self->check_libs;
1478
-      $self->setup_module_build_patch unless $self->{pod2man};
1479
-  
1480
-      if ($dist->{module}) {
1481
-          unless ($self->with_version_range($version)) {
1482
-              my($ok, $local) = $self->check_module($dist->{module}, $dist->{module_version} || 0);
1483
-              if ($self->{skip_installed} && $ok) {
1484
-                  $self->diag("$dist->{module} is up to date. ($local)\n", 1);
1485
-                  return 1;
1486
-              }
1487
-          }
1488
-  
1489
-          unless ($self->satisfy_version($dist->{module}, $dist->{module_version}, $version)) {
1490
-              $self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n");
1491
-              return;
1492
-          }
1493
-      }
1494
-  
1495
-      if ($dist->{dist} eq 'perl'){
1496
-          $self->diag("skipping $dist->{pathname}\n");
1497
-          return 1;
1498
-      }
1499
-  
1500
-      $self->diag("--> Working on $module\n");
1501
-  
1502
-      $dist->{dir} ||= $self->fetch_module($dist);
1503
-  
1504
-      unless ($dist->{dir}) {
1505
-          $self->diag_fail("Failed to fetch distribution $dist->{distvname}", 1);
1506
-          return;
1507
-      }
1508
-  
1509
-      $self->chat("Entering $dist->{dir}\n");
1510
-      $self->chdir($self->{base});
1511
-      $self->chdir($dist->{dir});
1512
-  
1513
-      if ($self->{cmd} eq 'look') {
1514
-          $self->look;
1515
-          return 1;
1516
-      }
1517
-  
1518
-      return $self->build_stuff($module, $dist, $depth);
1519
-  }
1520
-  
1521
-  sub format_dist {
1522
-      my($self, $dist) = @_;
1523
-  
1524
-      # TODO support --dist-format?
1525
-      return "$dist->{cpanid}/$dist->{filename}";
1526
-  }
1527
-  
1528
-  sub fetch_module {
1529
-      my($self, $dist) = @_;
1530
-  
1531
-      $self->chdir($self->{base});
1532
-  
1533
-      for my $uri (@{$dist->{uris}}) {
1534
-          $self->diag_progress("Fetching $uri");
1535
-  
1536
-          # Ugh, $dist->{filename} can contain sub directory
1537
-          my $filename = $dist->{filename} || $uri;
1538
-          my $name = File::Basename::basename($filename);
1539
-  
1540
-          my $cancelled;
1541
-          my $fetch = sub {
1542
-              my $file;
1543
-              eval {
1544
-                  local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
1545
-                  $self->mirror($uri, $name);
1546
-                  $file = $name if -e $name;
1547
-              };
1548
-              $self->chat("$@") if $@ && $@ ne "SIGINT\n";
1549
-              return $file;
1550
-          };
1551
-  
1552
-          my($try, $file);
1553
-          while ($try++ < 3) {
1554
-              $file = $fetch->();
1555
-              last if $cancelled or $file;
1556
-              $self->diag_fail("Download $uri failed. Retrying ... ");
1557
-          }
1558
-  
1559
-          if ($cancelled) {
1560
-              $self->diag_fail("Download cancelled.");
1561
-              return;
1562
-          }
1563
-  
1564
-          unless ($file) {
1565
-              $self->diag_fail("Failed to download $uri");
1566
-              next;
1567
-          }
1568
-  
1569
-          $self->diag_ok;
1570
-          $dist->{local_path} = File::Spec->rel2abs($name);
1571
-  
1572
-          my $dir = $self->unpack($file, $uri, $dist);
1573
-          next unless $dir; # unpack failed
1574
-  
1575
-          if (my $save = $self->{save_dists}) {
1576
-              my $path = "$save/authors/id/$dist->{pathname}";
1577
-              $self->chat("Copying $name to $path\n");
1578
-              File::Path::mkpath([ File::Basename::dirname($path) ], 0, 0777);
1579
-              File::Copy::copy($file, $path) or warn $!;
1580
-          }
1581
-  
1582
-          return $dist, $dir;
1583
-      }
1584
-  }
1585
-  
1586
-  sub unpack {
1587
-      my($self, $file, $uri, $dist) = @_;
1588
-  
1589
-      if ($self->{verify}) {
1590
-          $self->verify_archive($file, $uri, $dist) or return;
1591
-      }
1592
-  
1593
-      $self->chat("Unpacking $file\n");
1594
-      my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
1595
-      unless ($dir) {
1596
-          $self->diag_fail("Failed to unpack $file: no directory");
1597
-      }
1598
-      return $dir;
1599
-  }
1600
-  
1601
-  sub verify_checksums_signature {
1602
-      my($self, $chk_file) = @_;
1603
-  
1604
-      require Module::Signature; # no fatpack
1605
-  
1606
-      $self->chat("Verifying the signature of CHECKSUMS\n");
1607
-  
1608
-      my $rv = eval {
1609
-          local $SIG{__WARN__} = sub {}; # suppress warnings
1610
-          my $v = Module::Signature::_verify($chk_file);
1611
-          $v == Module::Signature::SIGNATURE_OK();
1612
-      };
1613
-      if ($rv) {
1614
-          $self->chat("Verified OK!\n");
1615
-      } else {
1616
-          $self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");
1617
-          return;
1618
-      }
1619
-  
1620
-      return 1;
1621
-  }
1622
-  
1623
-  sub verify_archive {
1624
-      my($self, $file, $uri, $dist) = @_;
1625
-  
1626
-      unless ($dist->{cpanid}) {
1627
-          $self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");
1628
-      }
1629
-  
1630
-      (my $mirror = $uri) =~ s!/authors/id.*$!!;
1631
-  
1632
-      (my $chksum_uri = $uri) =~ s!/[^/]*$!/CHECKSUMS!;
1633
-      my $chk_file = $self->source_for($mirror) . "/$dist->{cpanid}.CHECKSUMS";
1634
-      $self->diag_progress("Fetching $chksum_uri");
1635
-      $self->mirror($chksum_uri, $chk_file);
1636
-  
1637
-      unless (-e $chk_file) {
1638
-          $self->diag_fail("Fetching $chksum_uri failed.\n");
1639
-          return;
1640
-      }
1641
-  
1642
-      $self->diag_ok;
1643
-      $self->verify_checksums_signature($chk_file) or return;
1644
-      $self->verify_checksum($file, $chk_file);
1645
-  }
1646
-  
1647
-  sub verify_checksum {
1648
-      my($self, $file, $chk_file) = @_;
1649
-  
1650
-      $self->chat("Verifying the SHA1 for $file\n");
1651
-  
1652
-      open my $fh, "<$chk_file" or die "$chk_file: $!";
1653
-      my $data = join '', <$fh>;
1654
-      $data =~ s/\015?\012/\n/g;
1655
-  
1656
-      require Safe; # no fatpack
1657
-      my $chksum = Safe->new->reval($data);
1658
-  
1659
-      if (!ref $chksum or ref $chksum ne 'HASH') {
1660
-          $self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");
1661
-          return;
1662
-      }
1663
-  
1664
-      if (my $sha = $chksum->{$file}{sha256}) {
1665
-          my $hex = $self->sha1_for($file);
1666
-          if ($hex eq $sha) {
1667
-              $self->chat("Checksum for $file: Verified!\n");
1668
-          } else {
1669
-              $self->diag_fail("Checksum mismatch for $file\n");
1670
-              return;
1671
-          }
1672
-      } else {
1673
-          $self->chat("Checksum for $file not found in CHECKSUMS.\n");
1674
-          return;
1675
-      }
1676
-  }
1677
-  
1678
-  sub sha1_for {
1679
-      my($self, $file) = @_;
1680
-  
1681
-      require Digest::SHA; # no fatpack
1682
-  
1683
-      open my $fh, "<", $file or die "$file: $!";
1684
-      my $dg = Digest::SHA->new(256);
1685
-      my($data);
1686
-      while (read($fh, $data, 4096)) {
1687
-          $dg->add($data);
1688
-      }
1689
-  
1690
-      return $dg->hexdigest;
1691
-  }
1692
-  
1693
-  sub verify_signature {
1694
-      my($self, $dist) = @_;
1695
-  
1696
-      $self->diag_progress("Verifying the SIGNATURE file");
1697
-      my $out = `$self->{cpansign} -v --skip 2>&1`;
1698
-      $self->log($out);
1699
-  
1700
-      if ($out =~ /Signature verified OK/) {
1701
-          $self->diag_ok("Verified OK");
1702
-          return 1;
1703
-      } else {
1704
-          $self->diag_fail("SIGNATURE verificaion for $dist->{filename} failed\n");
1705
-          return;
1706
-      }
1707
-  }
1708
-  
1709
-  sub resolve_name {
1710
-      my($self, $module, $version) = @_;
1711
-  
1712
-      # URL
1713
-      if ($module =~ /^(ftp|https?|file):/) {
1714
-          if ($module =~ m!authors/id/(.*)!) {
1715
-              return $self->cpan_dist($1, $module);
1716
-          } else {
1717
-              return { uris => [ $module ] };
1718
-          }
1719
-      }
1720
-  
1721
-      # Directory
1722
-      if ($module =~ m!^[\./]! && -d $module) {
1723
-          return {
1724
-              source => 'local',
1725
-              dir => Cwd::abs_path($module),
1726
-          };
1727
-      }
1728
-  
1729
-      # File
1730
-      if (-f $module) {
1731
-          return {
1732
-              source => 'local',
1733
-              uris => [ "file://" . Cwd::abs_path($module) ],
1734
-          };
1735
-      }
1736
-  
1737
-      # Git
1738
-      if ($module =~ /(^git:|\.git$)/) {
1739
-          return $self->git_uri($module);
1740
-      }
1741
-  
1742
-      # cpan URI
1743
-      if ($module =~ s!^cpan:///distfile/!!) {
1744
-          return $self->cpan_dist($module);
1745
-      }
1746
-  
1747
-      # PAUSEID/foo
1748
-      if ($module =~ m!([A-Z]{3,})/!) {
1749
-          return $self->cpan_dist($module);
1750
-      }
1751
-  
1752
-      # Module name
1753
-      return $self->search_module($module, $version);
1754
-  }
1755
-  
1756
-  sub cpan_module {
1757
-      my($self, $module, $dist, $version) = @_;
1758
-  
1759
-      my $dist = $self->cpan_dist($dist);
1760
-      $dist->{module} = $module;
1761
-      $dist->{module_version} = $version if $version && $version ne 'undef';
1762
-  
1763
-      return $dist;
1764
-  }
1765
-  
1766
-  sub cpan_dist {
1767
-      my($self, $dist, $url) = @_;
1768
-  
1769
-      $dist =~ s!^([A-Z]{3})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;
1770
-  
1771
-      require CPAN::DistnameInfo;
1772
-      my $d = CPAN::DistnameInfo->new($dist);
1773
-  
1774
-      if ($url) {
1775
-          $url = [ $url ] unless ref $url eq 'ARRAY';
1776
-      } else {
1777
-          my $id = $d->cpanid;
1778
-          my $fn = substr($id, 0, 1) . "/" . substr($id, 0, 2) . "/" . $id . "/" . $d->filename;
1779
-  
1780
-          my @mirrors = @{$self->{mirrors}};
1781
-          my @urls    = map "$_/authors/id/$fn", @mirrors;
1782
-  
1783
-          $url = \@urls,
1784
-      }
1785
-  
1786
-      return {
1787
-          $d->properties,
1788
-          source  => 'cpan',
1789
-          uris    => $url,
1790
-      };
1791
-  }
1792
-  
1793
-  sub git_uri {
1794
-      my ($self, $uri) = @_;
1795
-  
1796
-      # similar to http://www.pip-installer.org/en/latest/logic.html#vcs-support
1797
-      # git URL has to end with .git when you need to use pin @ commit/tag/branch
1798
-  
1799
-      ($uri, my $commitish) = split /(?<=\.git)@/i, $uri, 2;
1800
-  
1801
-      my $dh  = File::Temp->newdir(CLEANUP => 1);
1802
-      my $dir = Cwd::abs_path($dh->dirname);
1803
-  
1804
-      $self->diag_progress("Cloning $uri");
1805
-      $self->run([ 'git', 'clone', $uri, $dir ]);
1806
-  
1807
-      unless (-e "$dir/.git") {
1808
-          $self->diag_fail("Failed cloning git repository $uri");
1809
-          return;
1810
-      }
1811
-  
1812
-      if ($commitish) {
1813
-          require File::pushd;
1814
-          my $dir = File::pushd::pushd($dir);
1815
-  
1816
-          unless ($self->run([ 'git', 'checkout', $commitish ])) {
1817
-              $self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");
1818
-              return;
1819
-          }
1820
-      }
1821
-  
1822
-      $self->diag_ok;
1823
-  
1824
-      return {
1825
-          source => 'local',
1826
-          dir    => $dir,
1827
-          handle => $dh,
1828
-      };
1829
-  }
1830
-  
1831
-  sub setup_module_build_patch {
1832
-      my $self = shift;
1833
-  
1834
-      open my $out, ">$self->{base}/ModuleBuildSkipMan.pm" or die $!;
1835
-      print $out <<EOF;
1836
-  package ModuleBuildSkipMan;
1837
-  CHECK {
1838
-    if (%Module::Build::) {
1839
-      no warnings 'redefine';
1840
-      *Module::Build::Base::ACTION_manpages = sub {};
1841
-      *Module::Build::Base::ACTION_docs     = sub {};
1842
-    }
1843
-  }
1844
-  1;
1845
-  EOF
1846
-  }
1847
-  
1848
-  sub check_module {
1849
-      my($self, $mod, $want_ver) = @_;
1850
-  
1851
-      require Module::Metadata;
1852
-      my $meta = Module::Metadata->new_from_module($mod, inc => $self->{search_inc})
1853
-          or return 0, undef;
1854
-  
1855
-      my $version = $meta->version;
1856
-  
1857
-      # When -L is in use, the version loaded from 'perl' library path
1858
-      # might be newer than (or actually wasn't core at) the version
1859
-      # that is shipped with the current perl
1860
-      if ($self->{self_contained} && $self->loaded_from_perl_lib($meta)) {
1861
-          require Module::CoreList; # no fatpack
1862
-          unless (exists $Module::CoreList::version{$]+0}{$mod}) {
1863
-              return 0, undef;
1864
-          }
1865
-          $version = $Module::CoreList::version{$]+0}{$mod};
1866
-      }
1867
-  
1868
-      $self->{local_versions}{$mod} = $version;
1869
-  
1870
-      if ($self->is_deprecated($meta)){
1871
-          return 0, $version;
1872
-      } elsif ($self->satisfy_version($mod, $version, $want_ver)) {
1873
-          return 1, ($version || 'undef');
1874
-      } else {
1875
-          return 0, $version;
1876
-      }
1877
-  }
1878
-  
1879
-  sub satisfy_version {
1880
-      my($self, $mod, $version, $want_ver) = @_;
1881
-  
1882
-      $want_ver = '0' unless defined($want_ver) && length($want_ver);
1883
-  
1884
-      require CPAN::Meta::Requirements;
1885
-      my $requirements = CPAN::Meta::Requirements->new;
1886
-      $requirements->add_string_requirement($mod, $want_ver);
1887
-      $requirements->accepts_module($mod, $version);
1888
-  }
1889
-  
1890
-  sub unsatisfy_how {
1891
-      my($self, $ver, $want_ver) = @_;
1892
-  
1893
-      if ($want_ver =~ /^[v0-9\.\_]+$/) {
1894
-          return "$ver < $want_ver";
1895
-      } else {
1896
-          return "$ver doesn't satisfy $want_ver";
1897
-      }
1898
-  }
1899
-  
1900
-  sub is_deprecated {
1901
-      my($self, $meta) = @_;
1902
-  
1903
-      my $deprecated = eval {
1904
-          require Module::CoreList; # no fatpack
1905
-          Module::CoreList::is_deprecated($meta->{module});
1906
-      };
1907
-  
1908
-      return $deprecated && $self->loaded_from_perl_lib($meta);
1909
-  }
1910
-  
1911
-  sub loaded_from_perl_lib {
1912
-      my($self, $meta) = @_;
1913
-  
1914
-      require Config;
1915
-      for my $dir (qw(archlibexp privlibexp)) {
1916
-          my $confdir = $Config{$dir};
1917
-          if ($confdir eq substr($meta->filename, 0, length($confdir))) {
1918
-              return 1;
1919
-          }
1920
-      }
1921
-  
1922
-      return;
1923
-  }
1924
-  
1925
-  sub should_install {
1926
-      my($self, $mod, $ver) = @_;
1927
-  
1928
-      $self->chat("Checking if you have $mod $ver ... ");
1929
-      my($ok, $local) = $self->check_module($mod, $ver);
1930
-  
1931
-      if ($ok)       { $self->chat("Yes ($local)\n") }
1932
-      elsif ($local) { $self->chat("No (" . $self->unsatisfy_how($local, $ver) . ")\n") }
1933
-      else           { $self->chat("No\n") }
1934
-  
1935
-      return $mod unless $ok;
1936
-      return;
1937
-  }
1938
-  
1939
-  sub install_deps {
1940
-      my($self, $dir, $depth, @deps) = @_;
1941
-  
1942
-      my(@install, %seen);
1943
-      while (my($mod, $ver) = splice @deps, 0, 2) {
1944
-          next if $seen{$mod} or $mod eq 'perl' or $mod eq 'Config';
1945
-          if ($self->should_install($mod, $ver)) {
1946
-              push @install, [ $mod, $ver ];
1947
-              $seen{$mod} = 1;
1948
-          }
1949
-      }
1950
-  
1951
-      if (@install) {
1952
-          $self->diag("==> Found dependencies: " . join(", ",  map $_->[0], @install) . "\n");
1953
-      }
1954
-  
1955
-      my @fail;
1956
-      for my $mod (@install) {
1957
-          $self->install_module($mod->[0], $depth + 1, $mod->[1])
1958
-              or push @fail, $mod->[0];
1959
-      }
1960
-  
1961
-      $self->chdir($self->{base});
1962
-      $self->chdir($dir) if $dir;
1963
-  
1964
-      return @fail;
1965
-  }
1966
-  
1967
-  sub install_deps_bailout {
1968
-      my($self, $target, $dir, $depth, @deps) = @_;
1969
-  
1970
-      my @fail = $self->install_deps($dir, $depth, @deps);
1971
-      if (@fail) {
1972
-          unless ($self->prompt_bool("Installing the following dependencies failed:\n==> " .
1973
-                                     join(", ", @fail) . "\nDo you want to continue building $target anyway?", "n")) {
1974
-              $self->diag_fail("Bailing out the installation for $target. Retry with --prompt or --force.", 1);
1975
-              return;
1976
-          }
1977
-      }
1978
-  
1979
-      return 1;
1980
-  }
1981
-  
1982
-  sub build_stuff {
1983
-      my($self, $stuff, $dist, $depth) = @_;
1984
-  
1985
-      if ($self->{verify} && -e 'SIGNATURE') {
1986
-          $self->verify_signature($dist) or return;
1987
-      }
1988
-  
1989
-      my @config_deps;
1990
-      if (-e 'META.json') {
1991
-          $self->chat("Checking configure dependencies from META.json\n");
1992
-          $dist->{meta} = $self->parse_meta('META.json');
1993
-      } elsif (-e 'META.yml') {
1994
-          $self->chat("Checking configure dependencies from META.yml\n");
1995
-          $dist->{meta} = $self->parse_meta('META.yml');
1996
-      }
1997
-  
1998
-      if (!$dist->{meta} && $dist->{source} eq 'cpan') {
1999
-          $self->chat("META.yml/json not found or unparsable. Fetching META.yml from search.cpan.org\n");
2000
-          $dist->{meta} = $self->fetch_meta_sco($dist);
2001
-      }
2002
-  
2003
-      $dist->{meta} ||= {};
2004
-  
2005
-      if ( $dist->{meta}->{prereqs} ) {
2006
-          push @config_deps, %{$dist->{meta}{prereqs}{configure}{requires} || {}};
2007
-      }
2008
-      else {
2009
-          push @config_deps, %{$dist->{meta}{configure_requires} || {}};
2010
-      }
2011
-  
2012
-      my $target = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};
2013
-  
2014
-      $self->install_deps_bailout($target, $dist->{dir}, $depth, @config_deps)
2015
-          or return;
2016
-  
2017
-      $self->diag_progress("Configuring $target");
2018
-  
2019
-      my $configure_state = $self->configure_this($dist, $depth);
2020
-  
2021
-      $self->diag_ok($configure_state->{configured_ok} ? "OK" : "N/A");
2022
-  
2023
-      my @deps = $self->find_prereqs($dist);
2024
-      my $module_name = $self->find_module_name($configure_state) || $dist->{meta}{name};
2025
-      $module_name =~ s/-/::/g;
2026
-  
2027
-      if ($self->{showdeps}) {
2028
-          my %rootdeps = (@config_deps, @deps); # merge
2029
-          for my $mod (keys %rootdeps) {
2030
-              my $ver = $rootdeps{$mod};
2031
-              print $mod, ($ver ? "~$ver" : ""), "\n";
2032
-          }
2033
-          return 1;
2034
-      }
2035
-  
2036
-      my $distname = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;
2037
-  
2038
-      my $walkup;
2039
-      if ($self->{scandeps}) {
2040
-          $walkup = $self->scandeps_append_child($dist);
2041
-      }
2042
-  
2043
-      $self->install_deps_bailout($distname, $dist->{dir}, $depth, @deps)
2044
-          or return;
2045
-  
2046
-      if ($self->{scandeps}) {
2047
-          unless ($configure_state->{configured_ok}) {
2048
-              my $diag = <<DIAG;
2049
-  ! Configuring $distname failed. See $self->{log} for details.
2050
-  ! You might have to install the following modules first to get --scandeps working correctly.
2051
-  DIAG
2052
-              if (@config_deps) {
2053
-                  my @tree = @{$self->{scandeps_tree}};
2054
-                  $diag .= "!\n" . join("", map "! * $_->[0]{module}\n", @tree[0..$#tree-1]) if @tree;
2055
-              }
2056
-              $self->diag("!\n$diag!\n", 1);
2057
-          }
2058
-          $walkup->();
2059
-          return 1;
2060
-      }
2061
-  
2062
-      if ($self->{installdeps} && $depth == 0) {
2063
-          if ($configure_state->{configured_ok}) {
2064
-              $self->diag("<== Installed dependencies for $stuff. Finishing.\n");
2065
-              return 1;
2066
-          } else {
2067
-              $self->diag("! Configuring $distname failed. See $self->{log} for details.\n", 1);
2068
-              return;
2069
-          }
2070
-      }
2071
-  
2072
-      my $installed;
2073
-      if ($configure_state->{use_module_build} && -e 'Build' && -f _) {
2074
-          my @switches = $self->{pod2man} ? () : ("-I$self->{base}", "-MModuleBuildSkipMan");
2075
-          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
2076
-          $self->build([ $self->{perl}, @switches, "./Build" ], $distname) &&
2077
-          $self->test([ $self->{perl}, "./Build", "test" ], $distname) &&
2078
-          $self->install([ $self->{perl}, @switches, "./Build", "install" ], [ "--uninst", 1 ], $depth) &&
2079
-          $installed++;
2080
-      } elsif ($self->{make} && -e 'Makefile') {
2081
-          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
2082
-          $self->build([ $self->{make} ], $distname) &&
2083
-          $self->test([ $self->{make}, "test" ], $distname) &&
2084
-          $self->install([ $self->{make}, "install" ], [ "UNINST=1" ], $depth) &&
2085
-          $installed++;
2086
-      } else {
2087
-          my $why;
2088
-          my $configure_failed = $configure_state->{configured} && !$configure_state->{configured_ok};
2089
-          if ($configure_failed) { $why = "Configure failed for $distname." }
2090
-          elsif ($self->{make})  { $why = "The distribution doesn't have a proper Makefile.PL/Build.PL" }
2091
-          else                   { $why = "Can't configure the distribution. You probably need to have 'make'." }
2092
-  
2093
-          $self->diag_fail("$why See $self->{log} for details.", 1);
2094
-          return;
2095
-      }
2096
-  
2097
-      if ($installed && $self->{test_only}) {
2098
-          $self->diag_ok;
2099
-          $self->diag("Successfully tested $distname\n", 1);
2100
-      } elsif ($installed) {
2101
-          my $local   = $self->{local_versions}{$dist->{module} || ''};
2102
-          my $version = $dist->{module_version} || $dist->{meta}{version} || $dist->{version};
2103
-          my $reinstall = $local && ($local eq $version);
2104
-  
2105
-          my $how = $reinstall ? "reinstalled $distname"
2106
-                  : $local     ? "installed $distname (upgraded from $local)"
2107
-                               : "installed $distname" ;
2108
-          my $msg = "Successfully $how";
2109
-          $self->diag_ok;
2110
-          $self->diag("$msg\n", 1);
2111
-          $self->{installed_dists}++;
2112
-          $self->save_meta($stuff, $dist, $module_name, \@config_deps, \@deps);
2113
-          return 1;
2114
-      } else {
2115
-          my $what = $self->{test_only} ? "Testing" : "Installing";
2116
-          $self->diag_fail("$what $stuff failed. See $self->{log} for details.", 1);
2117
-          return;
2118
-      }
2119
-  }
2120
-  
2121
-  sub configure_this {
2122
-      my($self, $dist, $depth) = @_;
2123
-  
2124
-      if (-e 'cpanfile' && $self->{installdeps} && $depth == 0) {
2125
-          require Module::CPANfile;
2126
-          $dist->{cpanfile} = eval { Module::CPANfile->load('cpanfile') };
2127
-          $self->diag_fail($@, 1) if $@;
2128
-          return {
2129
-              configured       => 1,
2130
-              configured_ok    => !!$dist->{cpanfile},
2131
-              use_module_build => 0,
2132
-          };
2133
-      }
2134
-  
2135
-      if ($self->{skip_configure}) {
2136
-          my $eumm = -e 'Makefile';
2137
-          my $mb   = -e 'Build' && -f _;
2138
-          return {
2139
-              configured => 1,
2140
-              configured_ok => $eumm || $mb,
2141
-              use_module_build => $mb,
2142
-          };
2143
-      }
2144
-  
2145
-      my @mb_switches;
2146
-      unless ($self->{pod2man}) {
2147
-          # it has to be push, so Module::Build is loaded from the adjusted path when -L is in use
2148
-          push @mb_switches, ("-I$self->{base}", "-MModuleBuildSkipMan");
2149
-      }
2150
-  
2151
-      my $state = {};
2152
-  
2153
-      my $try_eumm = sub {
2154
-          if (-e 'Makefile.PL') {
2155
-              $self->chat("Running Makefile.PL\n");
2156
-  
2157
-              # NOTE: according to Devel::CheckLib, most XS modules exit
2158
-              # with 0 even if header files are missing, to avoid receiving
2159
-              # tons of FAIL reports in such cases. So exit code can't be
2160
-              # trusted if it went well.
2161
-              if ($self->configure([ $self->{perl}, "Makefile.PL" ])) {
2162
-                  $state->{configured_ok} = -e 'Makefile';
2163
-              }
2164
-              $state->{configured}++;
2165
-          }
2166
-      };
2167
-  
2168
-      my $try_mb = sub {
2169
-          if (-e 'Build.PL') {
2170
-              $self->chat("Running Build.PL\n");
2171
-              if ($self->configure([ $self->{perl}, @mb_switches, "Build.PL" ])) {
2172
-                  $state->{configured_ok} = -e 'Build' && -f _;
2173
-              }
2174
-              $state->{use_module_build}++;
2175
-              $state->{configured}++;
2176
-          }
2177
-      };
2178
-  
2179
-      # Module::Build deps should use MakeMaker because that causes circular deps and fail
2180
-      # Otherwise we should prefer Build.PL
2181
-      my %should_use_mm = map { $_ => 1 } qw( version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest );
2182
-  
2183
-      my @try;
2184
-      if ($dist->{dist} && $should_use_mm{$dist->{dist}}) {
2185
-          @try = ($try_eumm, $try_mb);
2186
-      } else {
2187
-          @try = ($try_mb, $try_eumm);
2188
-      }
2189
-  
2190
-      for my $try (@try) {
2191
-          $try->();
2192
-          last if $state->{configured_ok};
2193
-      }
2194
-  
2195
-      unless ($state->{configured_ok}) {
2196
-          while (1) {
2197
-              my $ans = lc $self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
2198
-              last                                        if $ans eq 's';
2199
-              return $self->configure_this($dist, $depth) if $ans eq 'r';
2200
-              $self->show_build_log                       if $ans eq 'e';
2201
-              $self->look                                 if $ans eq 'l';
2202
-          }
2203
-      }
2204
-  
2205
-      return $state;
2206
-  }
2207
-  
2208
-  sub find_module_name {
2209
-      my($self, $state) = @_;
2210
-  
2211
-      return unless $state->{configured_ok};
2212
-  
2213
-      if ($state->{use_module_build} &&
2214
-          -e "_build/build_params") {
2215
-          my $params = do { open my $in, "_build/build_params"; $self->safe_eval(join "", <$in>) };
2216
-          return eval { $params->[2]{module_name} } || undef;
2217
-      } elsif (-e "Makefile") {
2218
-          open my $mf, "Makefile";
2219
-          while (<$mf>) {
2220
-              if (/^\#\s+NAME\s+=>\s+(.*)/) {
2221
-                  return $self->safe_eval($1);
2222
-              }
2223
-          }
2224
-      }
2225
-  
2226
-      return;
2227
-  }
2228
-  
2229
-  sub save_meta {
2230
-      my($self, $module, $dist, $module_name, $config_deps, $build_deps) = @_;
2231
-  
2232
-      return unless $dist->{distvname} && $dist->{source} eq 'cpan';
2233
-  
2234
-      my $base = ($ENV{PERL_MM_OPT} || '') =~ /INSTALL_BASE=/
2235
-          ? ($self->install_base($ENV{PERL_MM_OPT}) . "/lib/perl5") : $Config{sitelibexp};
2236
-  
2237
-      my $provides = $self->_merge_hashref(
2238
-          map Module::Metadata->package_versions_from_directory($_),
2239
-              qw( blib/lib blib/arch ) # FCGI.pm :(
2240
-      );
2241
-  
2242
-      File::Path::mkpath("blib/meta", 0, 0777);
2243
-  
2244
-      my $local = {
2245
-          name => $module_name,
2246
-          target => $module,
2247
-          version => $provides->{$module_name}{version} || $dist->{version},
2248
-          dist => $dist->{distvname},
2249
-          pathname => $dist->{pathname},
2250
-          provides => $provides,
2251
-      };
2252
-  
2253
-      require JSON::PP;
2254
-      open my $fh, ">", "blib/meta/install.json" or die $!;
2255
-      print $fh JSON::PP::encode_json($local);
2256
-  
2257
-      # Existence of MYMETA.* Depends on EUMM/M::B versions and CPAN::Meta
2258
-      if (-e "MYMETA.json") {
2259
-          File::Copy::copy("MYMETA.json", "blib/meta/MYMETA.json");
2260
-      }
2261
-  
2262
-      my @cmd = (
2263
-          ($self->{sudo} ? 'sudo' : ()),
2264
-          $^X,
2265
-          '-MExtUtils::Install=install',
2266
-          '-e',
2267
-          qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],
2268
-      );
2269
-      $self->run(\@cmd);
2270
-  }
2271
-  
2272
-  sub _merge_hashref {
2273
-      my($self, @hashrefs) = @_;
2274
-  
2275
-      my %hash;
2276
-      for my $h (@hashrefs) {
2277
-          %hash = (%hash, %$h);
2278
-      }
2279
-  
2280
-      return \%hash;
2281
-  }
2282
-  
2283
-  sub install_base {
2284
-      my($self, $mm_opt) = @_;
2285
-      $mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;
2286
-      die "Your PERL_MM_OPT doesn't contain INSTALL_BASE";
2287
-  }
2288
-  
2289
-  sub safe_eval {
2290
-      my($self, $code) = @_;
2291
-      eval $code;
2292
-  }
2293
-  
2294
-  sub find_prereqs {
2295
-      my($self, $dist) = @_;
2296
-  
2297
-      my @deps = $self->extract_meta_prereqs($dist);
2298
-  
2299
-      if ($dist->{module} =~ /^Bundle::/i) {
2300
-          push @deps, $self->bundle_deps($dist);
2301
-      }
2302
-  
2303
-      return @deps;
2304
-  }
2305
-  
2306
-  sub extract_meta_prereqs {
2307
-      my($self, $dist) = @_;
2308
-  
2309
-      if ($dist->{cpanfile}) {
2310
-          my $prereq = $dist->{cpanfile}->prereq;
2311
-          my @phase = $self->{notest} ? qw( build runtime ) : qw( build test runtime );
2312
-          require CPAN::Meta::Requirements;
2313
-          my $req = CPAN::Meta::Requirements->new;
2314
-          $req->add_requirements($prereq->requirements_for($_, 'requires')) for @phase;
2315
-          return %{$req->as_string_hash};
2316
-      }
2317
-  
2318
-      my $meta = $dist->{meta};
2319
-  
2320
-      my @deps;
2321
-      if (-e "MYMETA.json") {
2322
-          require JSON::PP;
2323
-          $self->chat("Checking dependencies from MYMETA.json ...\n");
2324
-          my $json = do { open my $in, "<MYMETA.json"; local $/; <$in> };
2325
-          my $mymeta = JSON::PP::decode_json($json);
2326
-          if ($mymeta) {
2327
-              $meta->{$_} = $mymeta->{$_} for qw(name version);
2328
-              return $self->extract_requires($mymeta);
2329
-          }
2330
-      }
2331
-  
2332
-      if (-e 'MYMETA.yml') {
2333
-          $self->chat("Checking dependencies from MYMETA.yml ...\n");
2334
-          my $mymeta = $self->parse_meta('MYMETA.yml');
2335
-          if ($mymeta) {
2336
-              $meta->{$_} = $mymeta->{$_} for qw(name version);
2337
-              return $self->extract_requires($mymeta);
2338
-          }
2339
-      }
2340
-  
2341
-      if (-e '_build/prereqs') {
2342
-          $self->chat("Checking dependencies from _build/prereqs ...\n");
2343
-          my $mymeta = do { open my $in, "_build/prereqs"; $self->safe_eval(join "", <$in>) };
2344
-          @deps = $self->extract_requires($mymeta);
2345
-      } elsif (-e 'Makefile') {
2346
-          $self->chat("Finding PREREQ from Makefile ...\n");
2347
-          open my $mf, "Makefile";
2348
-          while (<$mf>) {
2349
-              if (/^\#\s+PREREQ_PM => \{\s*(.*?)\s*\}/) {
2350
-                  my @all;
2351
-                  my @pairs = split ', ', $1;
2352
-                  for (@pairs) {
2353
-                      my ($pkg, $v) = split '=>', $_;
2354
-                      push @all, [ $pkg, $v ];
2355
-                  }
2356
-                  my $list = join ", ", map { "'$_->[0]' => $_->[1]" } @all;
2357
-                  my $prereq = $self->safe_eval("no strict; +{ $list }");
2358
-                  push @deps, %$prereq if $prereq;
2359
-                  last;
2360
-              }
2361
-          }
2362
-      }
2363
-  
2364
-      return @deps;
2365
-  }
2366
-  
2367
-  sub bundle_deps {
2368
-      my($self, $dist) = @_;
2369
-  
2370
-      my @files;
2371
-      File::Find::find({
2372
-          wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i },
2373
-          no_chdir => 1,
2374
-      }, '.');
2375
-  
2376
-      my @deps;
2377
-  
2378
-      for my $file (@files) {
2379
-          open my $pod, "<", $file or next;
2380
-          my $in_contents;
2381
-          while (<$pod>) {
2382
-              if (/^=head\d\s+CONTENTS/) {
2383
-                  $in_contents = 1;
2384
-              } elsif (/^=/) {
2385
-                  $in_contents = 0;
2386
-              } elsif ($in_contents) {
2387
-                  /^(\S+)\s*(\S+)?/
2388
-                      and push @deps, $1, $self->maybe_version($2);
2389
-              }
2390
-          }
2391
-      }
2392
-  
2393
-      return @deps;
2394
-  }
2395
-  
2396
-  sub maybe_version {
2397
-      my($self, $string) = @_;
2398
-      return $string && $string =~ /^\.?\d/ ? $string : undef;
2399
-  }
2400
-  
2401
-  sub extract_requires {
2402
-      my($self, $meta) = @_;
2403
-  
2404
-      if ($meta->{'meta-spec'} && $meta->{'meta-spec'}{version} == 2) {
2405
-          my @phase = $self->{notest} ? qw( build runtime ) : qw( build test runtime );
2406
-          my @deps = map {
2407
-              my $p = $meta->{prereqs}{$_} || {};
2408
-              %{$p->{requires} || {}};
2409
-          } @phase;
2410
-          return @deps;
2411
-      }
2412
-  
2413
-      my @deps;
2414
-      push @deps, %{$meta->{build_requires}} if $meta->{build_requires};
2415
-      push @deps, %{$meta->{requires}} if $meta->{requires};
2416
-  
2417
-      return @deps;
2418
-  }
2419
-  
2420
-  sub cleanup_workdirs {
2421
-      my $self = shift;
2422
-  
2423
-      my $expire = time - 24 * 60 * 60 * $self->{auto_cleanup};
2424
-      my @targets;
2425
-  
2426
-      opendir my $dh, "$self->{home}/work";
2427
-      while (my $e = readdir $dh) {
2428
-          next if $e !~ /^(\d+)\.\d+$/; # {UNIX time}.{PID}
2429
-          my $time = $1;
2430
-          if ($time < $expire) {
2431
-              push @targets, "$self->{home}/work/$e";
2432
-          }
2433
-      }
2434
-  
2435
-      if (@targets) {
2436
-          $self->chat("Expiring ", scalar(@targets), " work directories.\n");
2437
-          File::Path::rmtree(\@targets, 0, 0); # safe = 0, since blib usually doesn't have write bits
2438
-      }
2439
-  }
2440
-  
2441
-  sub scandeps_append_child {
2442
-      my($self, $dist) = @_;
2443
-  
2444
-      my $new_node = [ $dist, [] ];
2445
-  
2446
-      my $curr_node = $self->{scandeps_current} || [ undef, $self->{scandeps_tree} ];
2447
-      push @{$curr_node->[1]}, $new_node;
2448
-  
2449
-      $self->{scandeps_current} = $new_node;
2450
-  
2451
-      return sub { $self->{scandeps_current} = $curr_node };
2452
-  }
2453
-  
2454
-  sub dump_scandeps {
2455
-      my $self = shift;
2456
-  
2457
-      if ($self->{format} eq 'tree') {
2458
-          $self->walk_down(sub {
2459
-              my($dist, $depth) = @_;
2460
-              if ($depth == 0) {
2461
-                  print "$dist->{distvname}\n";
2462
-              } else {
2463
-                  print " " x ($depth - 1);
2464
-                  print "\\_ $dist->{distvname}\n";
2465
-              }
2466
-          }, 1);
2467
-      } elsif ($self->{format} =~ /^dists?$/) {
2468
-          $self->walk_down(sub {
2469
-              my($dist, $depth) = @_;
2470
-              print $self->format_dist($dist), "\n";
2471
-          }, 0);
2472
-      } elsif ($self->{format} eq 'json') {
2473
-          require JSON::PP;
2474
-          print JSON::PP::encode_json($self->{scandeps_tree});
2475
-      } elsif ($self->{format} eq 'yaml') {
2476
-          require YAML; # no fatpack
2477
-          print YAML::Dump($self->{scandeps_tree});
2478
-      } else {
2479
-          $self->diag("Unknown format: $self->{format}\n");
2480
-      }
2481
-  }
2482
-  
2483
-  sub walk_down {
2484
-      my($self, $cb, $pre) = @_;
2485
-      $self->_do_walk_down($self->{scandeps_tree}, $cb, 0, $pre);
2486
-  }
2487
-  
2488
-  sub _do_walk_down {
2489
-      my($self, $children, $cb, $depth, $pre) = @_;
2490
-  
2491
-      # DFS - $pre determines when we call the callback
2492
-      for my $node (@$children) {
2493
-          $cb->($node->[0], $depth) if $pre;
2494
-          $self->_do_walk_down($node->[1], $cb, $depth + 1, $pre);
2495
-          $cb->($node->[0], $depth) unless $pre;
2496
-      }
2497
-  }
2498
-  
2499
-  sub DESTROY {
2500
-      my $self = shift;
2501
-      $self->{at_exit}->($self) if $self->{at_exit};
2502
-  }
2503
-  
2504
-  # Utils
2505
-  
2506
-  sub shell_quote {
2507
-      my($self, $stuff) = @_;
2508
-      $stuff =~ /^${quote}.+${quote}$/ ? $stuff : ($quote . $stuff . $quote);
2509
-  }
2510
-  
2511
-  sub which {
2512
-      my($self, $name) = @_;
2513
-      my $exe_ext = $Config{_exe};
2514
-      for my $dir (File::Spec->path) {
2515
-          my $fullpath = File::Spec->catfile($dir, $name);
2516
-          if (-x $fullpath || -x ($fullpath .= $exe_ext)) {
2517
-              if ($fullpath =~ /\s/ && $fullpath !~ /^$quote/) {
2518
-                  $fullpath = $self->shell_quote($fullpath);
2519
-              }
2520
-              return $fullpath;
2521
-          }
2522
-      }
2523
-      return;
2524
-  }
2525
-  
2526
-  sub get {
2527
-      my($self, $uri) = @_;
2528
-      if ($uri =~ /^file:/) {
2529
-          $self->file_get($uri);
2530
-      } else {
2531
-          $self->{_backends}{get}->(@_);
2532
-      }
2533
-  }
2534
-  
2535
-  sub mirror {
2536
-      my($self, $uri, $local) = @_;
2537
-      if ($uri =~ /^file:/) {
2538
-          $self->file_mirror($uri, $local);
2539
-      } else {
2540
-          $self->{_backends}{mirror}->(@_);
2541
-      }
2542
-  }
2543
-  
2544
-  sub untar    { $_[0]->{_backends}{untar}->(@_) };
2545
-  sub unzip    { $_[0]->{_backends}{unzip}->(@_) };
2546
-  
2547
-  sub uri_to_file {
2548
-      my($self, $uri) = @_;
2549
-  
2550
-      # file:///path/to/file -> /path/to/file
2551
-      # file://C:/path       -> C:/path
2552
-      if ($uri =~ s!file:/+!!) {
2553
-          $uri = "/$uri" unless $uri =~ m![a-zA-Z]:!;
2554
-      }
2555
-  
2556
-      return $uri;
2557
-  }
2558
-  
2559
-  sub file_get {
2560
-      my($self, $uri) = @_;
2561
-      my $file = $self->uri_to_file($uri);
2562
-      open my $fh, "<$file" or return;
2563
-      join '', <$fh>;
2564
-  }
2565
-  
2566
-  sub file_mirror {
2567
-      my($self, $uri, $path) = @_;
2568
-      my $file = $self->uri_to_file($uri);
2569
-      File::Copy::copy($file, $path);
2570
-  }
2571
-  
2572
-  sub init_tools {
2573
-      my $self = shift;
2574
-  
2575
-      return if $self->{initialized}++;
2576
-  
2577
-      if ($self->{make} = $self->which($Config{make})) {
2578
-          $self->chat("You have make $self->{make}\n");
2579
-      }
2580
-  
2581
-      # use --no-lwp if they have a broken LWP, to upgrade LWP
2582
-      if ($self->{try_lwp} && eval { require LWP::UserAgent; LWP::UserAgent->VERSION(5.802) }) {
2583
-          $self->chat("You have LWP $LWP::VERSION\n");
2584
-          my $ua = sub {
2585
-              LWP::UserAgent->new(
2586
-                  parse_head => 0,
2587
-                  env_proxy => 1,
2588
-                  agent => $self->agent,
2589
-                  timeout => 30,
2590
-                  @_,
2591
-              );
2592
-          };
2593
-          $self->{_backends}{get} = sub {
2594
-              my $self = shift;
2595
-              my $res = $ua->()->request(HTTP::Request->new(GET => $_[0]));
2596
-              return unless $res->is_success;
2597
-              return $res->decoded_content;
2598
-          };
2599
-          $self->{_backends}{mirror} = sub {
2600
-              my $self = shift;
2601
-              my $res = $ua->()->mirror(@_);
2602
-              $res->code;
2603
-          };
2604
-      } elsif ($self->{try_wget} and my $wget = $self->which('wget')) {
2605
-          $self->chat("You have $wget\n");
2606
-          my @common = (
2607
-              '--user-agent', $self->agent,
2608
-              '--retry-connrefused',
2609
-              ($self->{verbose} ? () : ('-q')),
2610
-          );
2611
-          $self->{_backends}{get} = sub {
2612
-              my($self, $uri) = @_;
2613
-              $self->safeexec( my $fh, $wget, $uri, @common, '-O', '-' ) or die "wget $uri: $!";
2614
-              local $/;
2615
-              <$fh>;
2616
-          };
2617
-          $self->{_backends}{mirror} = sub {
2618
-              my($self, $uri, $path) = @_;
2619
-              $self->safeexec( my $fh, $wget, $uri, @common, '-O', $path ) or die "wget $uri: $!";
2620
-              local $/;
2621
-              <$fh>;
2622
-          };
2623
-      } elsif ($self->{try_curl} and my $curl = $self->which('curl')) {
2624
-          $self->chat("You have $curl\n");
2625
-          my @common = (
2626
-              '--location',
2627
-              '--user-agent', $self->agent,
2628
-              ($self->{verbose} ? () : '-s'),
2629
-          );
2630
-          $self->{_backends}{get} = sub {
2631
-              my($self, $uri) = @_;
2632
-              $self->safeexec( my $fh, $curl, @common, $uri ) or die "curl $uri: $!";
2633
-              local $/;
2634
-              <$fh>;
2635
-          };
2636
-          $self->{_backends}{mirror} = sub {
2637
-              my($self, $uri, $path) = @_;
2638
-              $self->safeexec( my $fh, $curl, @common, $uri, '-#', '-o', $path ) or die "curl $uri: $!";
2639
-              local $/;
2640
-              <$fh>;
2641
-          };
2642
-      } else {
2643
-          require HTTP::Tiny;
2644
-          $self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");
2645
-          my %common = (
2646
-              agent => $self->agent,
2647
-          );
2648
-          $self->{_backends}{get} = sub {
2649
-              my $self = shift;
2650
-              my $res = HTTP::Tiny->new(%common)->get($_[0]);
2651
-              return unless $res->{success};
2652
-              return $res->{content};
2653
-          };
2654
-          $self->{_backends}{mirror} = sub {
2655
-              my $self = shift;
2656
-              my $res = HTTP::Tiny->new(%common)->mirror(@_);
2657
-              return $res->{status};
2658
-          };
2659
-      }
2660
-  
2661
-      my $tar = $self->which('tar');
2662
-      my $tar_ver;
2663
-      my $maybe_bad_tar = sub { WIN32 || SUNOS || (($tar_ver = `$tar --version 2>/dev/null`) =~ /GNU.*1\.13/i) };
2664
-  
2665
-      if ($tar && !$maybe_bad_tar->()) {
2666
-          chomp $tar_ver;
2667
-          $self->chat("You have $tar: $tar_ver\n");
2668
-          $self->{_backends}{untar} = sub {
2669
-              my($self, $tarfile) = @_;
2670
-  
2671
-              my $xf = ($self->{verbose} ? 'v' : '')."xf";
2672
-              my $ar = $tarfile =~ /bz2$/ ? 'j' : 'z';
2673
-  
2674
-              my($root, @others) = `$tar ${ar}tf $tarfile`
2675
-                  or return undef;
2676
-  
2677
-              FILE: {
2678
-                  chomp $root;
2679
-                  $root =~ s!^\./!!;
2680
-                  $root =~ s{^(.+?)/.*$}{$1};
2681
-  
2682
-                  if (!length($root)) {
2683
-                      # archive had ./ as the first entry, so try again
2684
-                      $root = shift(@others);
2685
-                      redo FILE if $root;
2686
-                  }
2687
-              }
2688
-  
2689
-              system "$tar $ar$xf $tarfile";
2690
-              return $root if -d $root;
2691
-  
2692
-              $self->diag_fail("Bad archive: $tarfile");
2693
-              return undef;
2694
-          }
2695
-      } elsif (    $tar
2696
-               and my $gzip = $self->which('gzip')
2697
-               and my $bzip2 = $self->which('bzip2')) {
2698
-          $self->chat("You have $tar, $gzip and $bzip2\n");
2699
-          $self->{_backends}{untar} = sub {
2700
-              my($self, $tarfile) = @_;
2701
-  
2702
-              my $x  = "x" . ($self->{verbose} ? 'v' : '') . "f -";
2703
-              my $ar = $tarfile =~ /bz2$/ ? $bzip2 : $gzip;
2704
-  
2705
-              my($root, @others) = `$ar -dc $tarfile | $tar tf -`
2706
-                  or return undef;
2707
-  
2708
-              FILE: {
2709
-                  chomp $root;
2710
-                  $root =~ s!^\./!!;
2711
-                  $root =~ s{^(.+?)/.*$}{$1};
2712
-  
2713
-                  if (!length($root)) {
2714
-                      # archive had ./ as the first entry, so try again
2715
-                      $root = shift(@others);
2716
-                      redo FILE if $root;
2717
-                  }
2718
-              }
2719
-  
2720
-              system "$ar -dc $tarfile | $tar $x";
2721
-              return $root if -d $root;
2722
-  
2723
-              $self->diag_fail("Bad archive: $tarfile");
2724
-              return undef;
2725
-          }
2726
-      } elsif (eval { require Archive::Tar }) { # uses too much memory!
2727
-          $self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");
2728
-          $self->{_backends}{untar} = sub {
2729
-              my $self = shift;
2730
-              my $t = Archive::Tar->new($_[0]);
2731
-              my($root, @others) = $t->list_files;
2732
-              FILE: {
2733
-                  $root =~ s!^\./!!;
2734
-                  $root =~ s{^(.+?)/.*$}{$1};
2735
-  
2736
-                  if (!length($root)) {
2737
-                      # archive had ./ as the first entry, so try again
2738
-                      $root = shift(@others);
2739
-                      redo FILE if $root;
2740
-                  }
2741
-              }
2742
-              $t->extract;
2743
-              return -d $root ? $root : undef;
2744
-          };
2745
-      } else {
2746
-          $self->{_backends}{untar} = sub {
2747
-              die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n";
2748
-          };
2749
-      }
2750
-  
2751
-      if (my $unzip = $self->which('unzip')) {
2752
-          $self->chat("You have $unzip\n");
2753
-          $self->{_backends}{unzip} = sub {
2754
-              my($self, $zipfile) = @_;
2755
-  
2756
-              my $opt = $self->{verbose} ? '' : '-q';
2757
-              my(undef, $root, @others) = `$unzip -t $zipfile`
2758
-                  or return undef;
2759
-  
2760
-              chomp $root;
2761
-              $root =~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1};
2762
-  
2763
-              system "$unzip $opt $zipfile";
2764
-              return $root if -d $root;
2765
-  
2766
-              $self->diag_fail("Bad archive: [$root] $zipfile");
2767
-              return undef;
2768
-          }
2769
-      } else {
2770
-          $self->{_backends}{unzip} = sub {
2771
-              eval { require Archive::Zip }
2772
-                  or  die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
2773
-              my($self, $file) = @_;
2774
-              my $zip = Archive::Zip->new();
2775
-              my $status;
2776
-              $status = $zip->read($file);
2777
-              $self->diag_fail("Read of file[$file] failed")
2778
-                  if $status != Archive::Zip::AZ_OK();
2779
-              my @members = $zip->members();
2780
-              for my $member ( @members ) {
2781
-                  my $af = $member->fileName();
2782
-                  next if ($af =~ m!^(/|\.\./)!);
2783
-                  $status = $member->extractToFileNamed( $af );
2784
-                  $self->diag_fail("Extracting of file[$af] from zipfile[$file failed")
2785
-                      if $status != Archive::Zip::AZ_OK();
2786
-              }
2787
-  
2788
-              my ($root) = $zip->membersMatching( qr<^[^/]+/$> );
2789
-              $root &&= $root->fileName;
2790
-              return -d $root ? $root : undef;
2791
-          };
2792
-      }
2793
-  }
2794
-  
2795
-  sub safeexec {
2796
-      my $self = shift;
2797
-      my $rdr = $_[0] ||= Symbol::gensym();
2798
-  
2799
-      if (WIN32) {
2800
-          my $cmd = join q{ }, map { $self->shell_quote($_) } @_[ 1 .. $#_ ];
2801
-          return open( $rdr, "$cmd |" );
2802
-      }
2803
-  
2804
-      if ( my $pid = open( $rdr, '-|' ) ) {
2805
-          return $pid;
2806
-      }
2807
-      elsif ( defined $pid ) {
2808
-          exec( @_[ 1 .. $#_ ] );
2809
-          exit 1;
2810
-      }
2811
-      else {
2812
-          return;
2813
-      }
2814
-  }
2815
-  
2816
-  sub parse_meta {
2817
-      my($self, $file) = @_;
2818
-      return eval { Parse::CPAN::Meta->load_file($file) };
2819
-  }
2820
-  
2821
-  sub parse_meta_string {
2822
-      my($self, $yaml) = @_;
2823
-      return eval { Parse::CPAN::Meta->load_yaml_string($yaml) };
2824
-  }
2825
-  
2826
-  1;
2827
-APP_CPANMINUS_SCRIPT
2828
-
2829
-$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
2830
-  
2831
-  package CPAN::DistnameInfo;
2832
-  
2833
-  $VERSION = "0.12";
2834
-  use strict;
2835
-  
2836
-  sub distname_info {
2837
-    my $file = shift or return;
2838
-  
2839
-    my ($dist, $version) = $file =~ /^
2840
-      ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
2841
-       (?:
2842
-  	[A-Za-z](?=[^A-Za-z]|$)
2843
-  	|
2844
-  	\d(?=-)
2845
-       )(?<![._-][vV])
2846
-      )+)(.*)
2847
-    $/xs or return ($file,undef,undef);
2848
-  
2849
-    if ($dist =~ /-undef\z/ and ! length $version) {
2850
-      $dist =~ s/-undef\z//;
2851
-    }
2852
-  
2853
-    # Remove potential -withoutworldwriteables suffix
2854
-    $version =~ s/-withoutworldwriteables$//;
2855
-  
2856
-    if ($version =~ /^(-[Vv].*)-(\d.*)/) {
2857
-     
2858
-      # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
2859
-      # where the V3_1_1 is part of the distname
2860
-      $dist .= $1;
2861
-      $version = $2;
2862
-    }
2863
-  
2864
-    if ($version =~ /(.+_.*)-(\d.*)/) {
2865
-        # Catch names like Task-Deprecations5_14-1.00.tar.gz where the 5_14 is
2866
-        # part of the distname. However, names like libao-perl_0.03-1.tar.gz
2867
-        # should still have 0.03-1 as their version.
2868
-        $dist .= $1;
2869
-        $version = $2;
2870
-    }
2871
-  
2872
-    # Normalize the Dist.pm-1.23 convention which CGI.pm and
2873
-    # a few others use.
2874
-    $dist =~ s{\.pm$}{};
2875
-  
2876
-    $version = $1
2877
-      if !length $version and $dist =~ s/-(\d+\w)$//;
2878
-  
2879
-    $version = $1 . $version
2880
-      if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
2881
-  
2882
-    if ($version =~ /\d\.\d/) {
2883
-      $version =~ s/^[-_.]+//;
2884
-    }
2885
-    else {
2886
-      $version =~ s/^[-_]+//;
2887
-    }
2888
-  
2889
-    my $dev;
2890
-    if (length $version) {
2891
-      if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
2892
-        $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
2893
-      }
2894
-      elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
2895
-        $dev = 1;
2896
-      }
2897
-    }
2898
-    else {
2899
-      $version = undef;
2900
-    }
2901
-  
2902
-    ($dist, $version, $dev);
2903
-  }
2904
-  
2905
-  sub new {
2906
-    my $class = shift;
2907
-    my $distfile = shift;
2908
-  
2909
-    $distfile =~ s,//+,/,g;
2910
-  
2911
-    my %info = ( pathname => $distfile );
2912
-  
2913
-    ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
2914
-      and $info{cpanid} = $6;
2915
-  
2916
-    if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
2917
-      $info{distvname} = $1;
2918
-      $info{extension} = $2;
2919
-    }
2920
-  
2921
-    @info{qw(dist version beta)} = distname_info($info{distvname});
2922
-    $info{maturity} = delete $info{beta} ? 'developer' : 'released';
2923
-  
2924
-    return bless \%info, $class;
2925
-  }
2926
-  
2927
-  sub dist      { shift->{dist} }
2928
-  sub version   { shift->{version} }
2929
-  sub maturity  { shift->{maturity} }
2930
-  sub filename  { shift->{filename} }
2931
-  sub cpanid    { shift->{cpanid} }
2932
-  sub distvname { shift->{distvname} }
2933
-  sub extension { shift->{extension} }
2934
-  sub pathname  { shift->{pathname} }
2935
-  
2936
-  sub properties { %{ $_[0] } }
2937
-  
2938
-  1;
2939
-  
2940
-  __END__
2941
-  
2942
-CPAN_DISTNAMEINFO
2943
-
2944
-$fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
2945
-  use 5.006;
2946
-  use strict;
2947
-  use warnings;
2948
-  package CPAN::Meta;
2949
-  our $VERSION = '2.120921'; # VERSION
2950
-  
2951
-  
2952
-  use Carp qw(carp croak);
2953
-  use CPAN::Meta::Feature;
2954
-  use CPAN::Meta::Prereqs;
2955
-  use CPAN::Meta::Converter;
2956
-  use CPAN::Meta::Validator;
2957
-  use Parse::CPAN::Meta 1.4403 ();
2958
-  
2959
-  BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone }
2960
-  
2961
-  
2962
-  BEGIN {
2963
-    my @STRING_READERS = qw(
2964
-      abstract
2965
-      description
2966
-      dynamic_config
2967
-      generated_by
2968
-      name
2969
-      release_status
2970
-      version
2971
-    );
2972
-  
2973
-    no strict 'refs';
2974
-    for my $attr (@STRING_READERS) {
2975
-      *$attr = sub { $_[0]{ $attr } };
2976
-    }
2977
-  }
2978
-  
2979
-  
2980
-  BEGIN {
2981
-    my @LIST_READERS = qw(
2982
-      author
2983
-      keywords
2984
-      license
2985
-    );
2986
-  
2987
-    no strict 'refs';
2988
-    for my $attr (@LIST_READERS) {
2989
-      *$attr = sub {
2990
-        my $value = $_[0]{ $attr };
2991
-        croak "$attr must be called in list context"
2992
-          unless wantarray;
2993
-        return @{ _dclone($value) } if ref $value;
2994
-        return $value;
2995
-      };
2996
-    }
2997
-  }
2998
-  
2999
-  sub authors  { $_[0]->author }
3000
-  sub licenses { $_[0]->license }
3001
-  
3002
-  
3003
-  BEGIN {
3004
-    my @MAP_READERS = qw(
3005
-      meta-spec
3006
-      resources
3007
-      provides
3008
-      no_index
3009
-  
3010
-      prereqs
3011
-      optional_features
3012
-    );
3013
-  
3014
-    no strict 'refs';
3015
-    for my $attr (@MAP_READERS) {
3016
-      (my $subname = $attr) =~ s/-/_/;
3017
-      *$subname = sub {
3018
-        my $value = $_[0]{ $attr };
3019
-        return _dclone($value) if $value;
3020
-        return {};
3021
-      };
3022
-    }
3023
-  }
3024
-  
3025
-  
3026
-  sub custom_keys {
3027
-    return grep { /^x_/i } keys %{$_[0]};
3028
-  }
3029
-  
3030
-  sub custom {
3031
-    my ($self, $attr) = @_;
3032
-    my $value = $self->{$attr};
3033
-    return _dclone($value) if ref $value;
3034
-    return $value;
3035
-  }
3036
-  
3037
-  
3038
-  sub _new {
3039
-    my ($class, $struct, $options) = @_;
3040
-    my $self;
3041
-  
3042
-    if ( $options->{lazy_validation} ) {
3043
-      # try to convert to a valid structure; if succeeds, then return it
3044
-      my $cmc = CPAN::Meta::Converter->new( $struct );
3045
-      $self = $cmc->convert( version => 2 ); # valid or dies
3046
-      return bless $self, $class;
3047
-    }
3048
-    else {
3049
-      # validate original struct
3050
-      my $cmv = CPAN::Meta::Validator->new( $struct );
3051
-      unless ( $cmv->is_valid) {
3052
-        die "Invalid metadata structure. Errors: "
3053
-          . join(", ", $cmv->errors) . "\n";
3054
-      }
3055
-    }
3056
-  
3057
-    # up-convert older spec versions
3058
-    my $version = $struct->{'meta-spec'}{version} || '1.0';
3059
-    if ( $version == 2 ) {
3060
-      $self = $struct;
3061
-    }
3062
-    else {
3063
-      my $cmc = CPAN::Meta::Converter->new( $struct );
3064
-      $self = $cmc->convert( version => 2 );
3065
-    }
3066
-  
3067
-    return bless $self, $class;
3068
-  }
3069
-  
3070
-  sub new {
3071
-    my ($class, $struct, $options) = @_;
3072
-    my $self = eval { $class->_new($struct, $options) };
3073
-    croak($@) if $@;
3074
-    return $self;
3075
-  }
3076
-  
3077
-  
3078
-  sub create {
3079
-    my ($class, $struct, $options) = @_;
3080
-    my $version = __PACKAGE__->VERSION || 2;
3081
-    $struct->{generated_by} ||= __PACKAGE__ . " version $version" ;
3082
-    $struct->{'meta-spec'}{version} ||= int($version);
3083
-    my $self = eval { $class->_new($struct, $options) };
3084
-    croak ($@) if $@;
3085
-    return $self;
3086
-  }
3087
-  
3088
-  
3089
-  sub load_file {
3090
-    my ($class, $file, $options) = @_;
3091
-    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
3092
-  
3093
-    croak "load_file() requires a valid, readable filename"
3094
-      unless -r $file;
3095
-  
3096
-    my $self;
3097
-    eval {
3098
-      my $struct = Parse::CPAN::Meta->load_file( $file );
3099
-      $self = $class->_new($struct, $options);
3100
-    };
3101
-    croak($@) if $@;
3102
-    return $self;
3103
-  }
3104
-  
3105
-  
3106
-  sub load_yaml_string {
3107
-    my ($class, $yaml, $options) = @_;
3108
-    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
3109
-  
3110
-    my $self;
3111
-    eval {
3112
-      my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml );
3113
-      $self = $class->_new($struct, $options);
3114
-    };
3115
-    croak($@) if $@;
3116
-    return $self;
3117
-  }
3118
-  
3119
-  
3120
-  sub load_json_string {
3121
-    my ($class, $json, $options) = @_;
3122
-    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
3123
-  
3124
-    my $self;
3125
-    eval {
3126
-      my $struct = Parse::CPAN::Meta->load_json_string( $json );
3127
-      $self = $class->_new($struct, $options);
3128
-    };
3129
-    croak($@) if $@;
3130
-    return $self;
3131
-  }
3132
-  
3133
-  
3134
-  sub save {
3135
-    my ($self, $file, $options) = @_;
3136
-  
3137
-    my $version = $options->{version} || '2';
3138
-    my $layer = $] ge '5.008001' ? ':utf8' : '';
3139
-  
3140
-    if ( $version ge '2' ) {
3141
-      carp "'$file' should end in '.json'"
3142
-        unless $file =~ m{\.json$};
3143
-    }
3144
-    else {
3145
-      carp "'$file' should end in '.yml'"
3146
-        unless $file =~ m{\.yml$};
3147
-    }
3148
-  
3149
-    my $data = $self->as_string( $options );
3150
-    open my $fh, ">$layer", $file
3151
-      or die "Error opening '$file' for writing: $!\n";
3152
-  
3153
-    print {$fh} $data;
3154
-    close $fh
3155
-      or die "Error closing '$file': $!\n";
3156
-  
3157
-    return 1;
3158
-  }
3159
-  
3160
-  
3161
-  sub meta_spec_version {
3162
-    my ($self) = @_;
3163
-    return $self->meta_spec->{version};
3164
-  }
3165
-  
3166
-  
3167
-  sub effective_prereqs {
3168
-    my ($self, $features) = @_;
3169
-    $features ||= [];
3170
-  
3171
-    my $prereq = CPAN::Meta::Prereqs->new($self->prereqs);
3172
-  
3173
-    return $prereq unless @$features;
3174
-  
3175
-    my @other = map {; $self->feature($_)->prereqs } @$features;
3176
-  
3177
-    return $prereq->with_merged_prereqs(\@other);
3178
-  }
3179
-  
3180
-  
3181
-  sub should_index_file {
3182
-    my ($self, $filename) = @_;
3183
-  
3184
-    for my $no_index_file (@{ $self->no_index->{file} || [] }) {
3185
-      return if $filename eq $no_index_file;
3186
-    }
3187
-  
3188
-    for my $no_index_dir (@{ $self->no_index->{directory} }) {
3189
-      $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z};
3190
-      return if index($filename, $no_index_dir) == 0;
3191
-    }
3192
-  
3193
-    return 1;
3194
-  }
3195
-  
3196
-  
3197
-  sub should_index_package {
3198
-    my ($self, $package) = @_;
3199
-  
3200
-    for my $no_index_pkg (@{ $self->no_index->{package} || [] }) {
3201
-      return if $package eq $no_index_pkg;
3202
-    }
3203
-  
3204
-    for my $no_index_ns (@{ $self->no_index->{namespace} }) {
3205
-      return if index($package, "${no_index_ns}::") == 0;
3206
-    }
3207
-  
3208
-    return 1;
3209
-  }
3210
-  
3211
-  
3212
-  sub features {
3213
-    my ($self) = @_;
3214
-  
3215
-    my $opt_f = $self->optional_features;
3216
-    my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) }
3217
-                   keys %$opt_f;
3218
-  
3219
-    return @features;
3220
-  }
3221
-  
3222
-  
3223
-  sub feature {
3224
-    my ($self, $ident) = @_;
3225
-  
3226
-    croak "no feature named $ident"
3227
-      unless my $f = $self->optional_features->{ $ident };
3228
-  
3229
-    return CPAN::Meta::Feature->new($ident, $f);
3230
-  }
3231
-  
3232
-  
3233
-  sub as_struct {
3234
-    my ($self, $options) = @_;
3235
-    my $struct = _dclone($self);
3236
-    if ( $options->{version} ) {
3237
-      my $cmc = CPAN::Meta::Converter->new( $struct );
3238
-      $struct = $cmc->convert( version => $options->{version} );
3239
-    }
3240
-    return $struct;
3241
-  }
3242
-  
3243
-  
3244
-  sub as_string {
3245
-    my ($self, $options) = @_;
3246
-  
3247
-    my $version = $options->{version} || '2';
3248
-  
3249
-    my $struct;
3250
-    if ( $self->meta_spec_version ne $version ) {
3251
-      my $cmc = CPAN::Meta::Converter->new( $self->as_struct );
3252
-      $struct = $cmc->convert( version => $version );
3253
-    }
3254
-    else {
3255
-      $struct = $self->as_struct;
3256
-    }
3257
-  
3258
-    my ($data, $backend);
3259
-    if ( $version ge '2' ) {
3260
-      $backend = Parse::CPAN::Meta->json_backend();
3261
-      $data = $backend->new->pretty->canonical->encode($struct);
3262
-    }
3263
-    else {
3264
-      $backend = Parse::CPAN::Meta->yaml_backend();
3265
-      $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
3266
-      if ( $@ ) {
3267
-        croak $backend->can('errstr') ? $backend->errstr : $@
3268
-      }
3269
-    }
3270
-  
3271
-    return $data;
3272
-  }
3273
-  
3274
-  # Used by JSON::PP, etc. for "convert_blessed"
3275
-  sub TO_JSON {
3276
-    return { %{ $_[0] } };
3277
-  }
3278
-  
3279
-  1;
3280
-  
3281
-  # ABSTRACT: the distribution metadata for a CPAN dist
3282
-  
3283
-  
3284
-  
3285
-  
3286
-  __END__
3287
-  
3288
-  
3289
-CPAN_META
3290
-
3291
-$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
3292
-  use 5.006;
3293
-  use strict;
3294
-  use warnings;
3295
-  package CPAN::Meta::Converter;
3296
-  our $VERSION = '2.120921'; # VERSION
3297
-  
3298
-  
3299
-  use CPAN::Meta::Validator;
3300
-  use CPAN::Meta::Requirements;
3301
-  use version 0.88 ();
3302
-  use Parse::CPAN::Meta 1.4400 ();
3303
-  
3304
-  sub _dclone {
3305
-    my $ref = shift;
3306
-  
3307
-    # if an object is in the data structure and doesn't specify how to
3308
-    # turn itself into JSON, we just stringify the object.  That does the
3309
-    # right thing for typical things that might be there, like version objects,
3310
-    # Path::Class objects, etc.
3311
-    no warnings 'once';
3312
-    local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
3313
-  
3314
-    my $backend = Parse::CPAN::Meta->json_backend();
3315
-    return $backend->new->utf8->decode(
3316
-      $backend->new->utf8->allow_blessed->convert_blessed->encode($ref)
3317
-    );
3318
-  }
3319
-  
3320
-  my %known_specs = (
3321
-      '2'   => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
3322
-      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
3323
-      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
3324
-      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
3325
-      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
3326
-      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
3327
-  );
3328
-  
3329
-  my @spec_list = sort { $a <=> $b } keys %known_specs;
3330
-  my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
3331
-  
3332
-  #--------------------------------------------------------------------------#
3333
-  # converters
3334
-  #
3335
-  # called as $converter->($element, $field_name, $full_meta, $to_version)
3336
-  #
3337
-  # defined return value used for field
3338
-  # undef return value means field is skipped
3339
-  #--------------------------------------------------------------------------#
3340
-  
3341
-  sub _keep { $_[0] }
3342
-  
3343
-  sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
3344
-  
3345
-  sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
3346
-  
3347
-  sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
3348
-  
3349
-  sub _generated_by {
3350
-    my $gen = shift;
3351
-    my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
3352
-  
3353
-    return $sig unless defined $gen and length $gen;
3354
-    return $gen if $gen =~ /(, )\Q$sig/;
3355
-    return "$gen, $sig";
3356
-  }
3357
-  
3358
-  sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
3359
-  
3360
-  sub _prefix_custom {
3361
-    my $key = shift;
3362
-    $key =~ s/^(?!x_)   # Unless it already starts with x_
3363
-               (?:x-?)? # Remove leading x- or x (if present)
3364
-             /x_/ix;    # and prepend x_
3365
-    return $key;
3366
-  }
3367
-  
3368
-  sub _ucfirst_custom {
3369
-    my $key = shift;
3370
-    $key = ucfirst $key unless $key =~ /[A-Z]/;
3371
-    return $key;
3372
-  }
3373
-  
3374
-  sub _change_meta_spec {
3375
-    my ($element, undef, undef, $version) = @_;
3376
-    $element->{version} = $version;
3377
-    $element->{url} = $known_specs{$version};
3378
-    return $element;
3379
-  }
3380
-  
3381
-  my @valid_licenses_1 = (
3382
-    'perl',
3383
-    'gpl',
3384
-    'apache',
3385
-    'artistic',
3386
-    'artistic_2',
3387
-    'lgpl',
3388
-    'bsd',
3389
-    'gpl',
3390
-    'mit',
3391
-    'mozilla',
3392
-    'open_source',
3393
-    'unrestricted',
3394
-    'restrictive',
3395
-    'unknown',
3396
-  );
3397
-  
3398
-  my %license_map_1 = (
3399
-    ( map { $_ => $_ } @valid_licenses_1 ),
3400
-    artistic2 => 'artistic_2',
3401
-  );
3402
-  
3403
-  sub _license_1 {
3404
-    my ($element) = @_;
3405
-    return 'unknown' unless defined $element;
3406
-    if ( $license_map_1{lc $element} ) {
3407
-      return $license_map_1{lc $element};
3408
-    }
3409
-    return 'unknown';
3410
-  }
3411
-  
3412
-  my @valid_licenses_2 = qw(
3413
-    agpl_3
3414
-    apache_1_1
3415
-    apache_2_0
3416
-    artistic_1
3417
-    artistic_2
3418
-    bsd
3419
-    freebsd
3420
-    gfdl_1_2
3421
-    gfdl_1_3
3422
-    gpl_1
3423
-    gpl_2
3424
-    gpl_3
3425
-    lgpl_2_1
3426
-    lgpl_3_0
3427
-    mit
3428
-    mozilla_1_0
3429
-    mozilla_1_1
3430
-    openssl
3431
-    perl_5
3432
-    qpl_1_0
3433
-    ssleay
3434
-    sun
3435
-    zlib
3436
-    open_source
3437
-    restricted
3438
-    unrestricted
3439
-    unknown
3440
-  );
3441
-  
3442
-  # The "old" values were defined by Module::Build, and were often vague.  I have
3443
-  # made the decisions below based on reading Module::Build::API and how clearly
3444
-  # it specifies the version of the license.
3445
-  my %license_map_2 = (
3446
-    (map { $_ => $_ } @valid_licenses_2),
3447
-    apache      => 'apache_2_0',  # clearly stated as 2.0
3448
-    artistic    => 'artistic_1',  # clearly stated as 1
3449
-    artistic2   => 'artistic_2',  # clearly stated as 2
3450
-    gpl         => 'open_source', # we don't know which GPL; punt
3451
-    lgpl        => 'open_source', # we don't know which LGPL; punt
3452
-    mozilla     => 'open_source', # we don't know which MPL; punt
3453
-    perl        => 'perl_5',      # clearly Perl 5
3454
-    restrictive => 'restricted',
3455
-  );
3456
-  
3457
-  sub _license_2 {
3458
-    my ($element) = @_;
3459
-    return [ 'unknown' ] unless defined $element;
3460
-    $element = [ $element ] unless ref $element eq 'ARRAY';
3461
-    my @new_list;
3462
-    for my $lic ( @$element ) {
3463
-      next unless defined $lic;
3464
-      if ( my $new = $license_map_2{lc $lic} ) {
3465
-        push @new_list, $new;
3466
-      }
3467
-    }
3468
-    return @new_list ? \@new_list : [ 'unknown' ];
3469
-  }
3470
-  
3471
-  my %license_downgrade_map = qw(
3472
-    agpl_3            open_source
3473
-    apache_1_1        apache
3474
-    apache_2_0        apache
3475
-    artistic_1        artistic
3476
-    artistic_2        artistic_2
3477
-    bsd               bsd
3478
-    freebsd           open_source
3479
-    gfdl_1_2          open_source
3480
-    gfdl_1_3          open_source
3481
-    gpl_1             gpl
3482
-    gpl_2             gpl
3483
-    gpl_3             gpl
3484
-    lgpl_2_1          lgpl
3485
-    lgpl_3_0          lgpl
3486
-    mit               mit
3487
-    mozilla_1_0       mozilla
3488
-    mozilla_1_1       mozilla
3489
-    openssl           open_source
3490
-    perl_5            perl
3491
-    qpl_1_0           open_source
3492
-    ssleay            open_source
3493
-    sun               open_source
3494
-    zlib              open_source
3495
-    open_source       open_source
3496
-    restricted        restrictive
3497
-    unrestricted      unrestricted
3498
-    unknown           unknown
3499
-  );
3500
-  
3501
-  sub _downgrade_license {
3502
-    my ($element) = @_;
3503
-    if ( ! defined $element ) {
3504
-      return "unknown";
3505
-    }
3506
-    elsif( ref $element eq 'ARRAY' ) {
3507
-      if ( @$element == 1 ) {
3508
-        return $license_downgrade_map{$element->[0]} || "unknown";
3509
-      }
3510
-    }
3511
-    elsif ( ! ref $element ) {
3512
-      return $license_downgrade_map{$element} || "unknown";
3513
-    }
3514
-    return "unknown";
3515
-  }
3516
-  
3517
-  my $no_index_spec_1_2 = {
3518
-    'file' => \&_listify,
3519
-    'dir' => \&_listify,
3520
-    'package' => \&_listify,
3521
-    'namespace' => \&_listify,
3522
-  };
3523
-  
3524
-  my $no_index_spec_1_3 = {
3525
-    'file' => \&_listify,
3526
-    'directory' => \&_listify,
3527
-    'package' => \&_listify,
3528
-    'namespace' => \&_listify,
3529
-  };
3530
-  
3531
-  my $no_index_spec_2 = {
3532
-    'file' => \&_listify,
3533
-    'directory' => \&_listify,
3534
-    'package' => \&_listify,
3535
-    'namespace' => \&_listify,
3536
-    ':custom'  => \&_prefix_custom,
3537
-  };
3538
-  
3539
-  sub _no_index_1_2 {
3540
-    my (undef, undef, $meta) = @_;
3541
-    my $no_index = $meta->{no_index} || $meta->{private};
3542
-    return unless $no_index;
3543
-  
3544
-    # cleanup wrong format
3545
-    if ( ! ref $no_index ) {
3546
-      my $item = $no_index;
3547
-      $no_index = { dir => [ $item ], file => [ $item ] };
3548
-    }
3549
-    elsif ( ref $no_index eq 'ARRAY' ) {
3550
-      my $list = $no_index;
3551
-      $no_index = { dir => [ @$list ], file => [ @$list ] };
3552
-    }
3553
-  
3554
-    # common mistake: files -> file
3555
-    if ( exists $no_index->{files} ) {
3556
-      $no_index->{file} = delete $no_index->{file};
3557
-    }
3558
-    # common mistake: modules -> module
3559
-    if ( exists $no_index->{modules} ) {
3560
-      $no_index->{module} = delete $no_index->{module};
3561
-    }
3562
-    return _convert($no_index, $no_index_spec_1_2);
3563
-  }
3564
-  
3565
-  sub _no_index_directory {
3566
-    my ($element, $key, $meta, $version) = @_;
3567
-    return unless $element;
3568
-  
3569
-    # cleanup wrong format
3570
-    if ( ! ref $element ) {
3571
-      my $item = $element;
3572
-      $element = { directory => [ $item ], file => [ $item ] };
3573
-    }
3574
-    elsif ( ref $element eq 'ARRAY' ) {
3575
-      my $list = $element;
3576
-      $element = { directory => [ @$list ], file => [ @$list ] };
3577
-    }
3578
-  
3579
-    if ( exists $element->{dir} ) {
3580
-      $element->{directory} = delete $element->{dir};
3581
-    }
3582
-    # common mistake: files -> file
3583
-    if ( exists $element->{files} ) {
3584
-      $element->{file} = delete $element->{file};
3585
-    }
3586
-    # common mistake: modules -> module
3587
-    if ( exists $element->{modules} ) {
3588
-      $element->{module} = delete $element->{module};
3589
-    }
3590
-    my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
3591
-    return _convert($element, $spec);
3592
-  }
3593
-  
3594
-  sub _is_module_name {
3595
-    my $mod = shift;
3596
-    return unless defined $mod && length $mod;
3597
-    return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
3598
-  }
3599
-  
3600
-  sub _clean_version {
3601
-    my ($element, $key, $meta, $to_version) = @_;
3602
-    return 0 if ! defined $element;
3603
-  
3604
-    $element =~ s{^\s*}{};
3605
-    $element =~ s{\s*$}{};
3606
-    $element =~ s{^\.}{0.};
3607
-  
3608
-    return 0 if ! length $element;
3609
-    return 0 if ( $element eq 'undef' || $element eq '<undef>' );
3610
-  
3611
-    my $v = eval { version->new($element) };
3612
-    # XXX check defined $v and not just $v because version objects leak memory
3613
-    # in boolean context -- dagolden, 2012-02-03
3614
-    if ( defined $v ) {
3615
-      return $v->is_qv ? $v->normal : $element;
3616
-    }
3617
-    else {
3618
-      return 0;
3619
-    }
3620
-  }
3621
-  
3622
-  sub _bad_version_hook {
3623
-    my ($v) = @_;
3624
-    $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
3625
-    my $vobj = eval { version->parse($v) };
3626
-    return defined($vobj) ? $vobj : version->parse(0); # or give up
3627
-  }
3628
-  
3629
-  sub _version_map {
3630
-    my ($element) = @_;
3631
-    return unless defined $element;
3632
-    if ( ref $element eq 'HASH' ) {
3633
-      # XXX turn this into CPAN::Meta::Requirements with bad version hook
3634
-      # and then turn it back into a hash
3635
-      my $new_map = CPAN::Meta::Requirements->new(
3636
-        { bad_version_hook => sub { version->new(0) } } # punt
3637
-      );
3638
-      while ( my ($k,$v) = each %$element ) {
3639
-        next unless _is_module_name($k);
3640
-        if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>'  ) {
3641
-          $v = 0;
3642
-        }
3643
-        # some weird, old META have bad yml with module => module
3644
-        # so check if value is like a module name and not like a version
3645
-        if ( _is_module_name($v) && ! version::is_lax($v) ) {
3646
-          $new_map->add_minimum($k => 0);
3647
-          $new_map->add_minimum($v => 0);
3648
-        }
3649
-        $new_map->add_string_requirement($k => $v);
3650
-      }
3651
-      return $new_map->as_string_hash;
3652
-    }
3653
-    elsif ( ref $element eq 'ARRAY' ) {
3654
-      my $hashref = { map { $_ => 0 } @$element };
3655
-      return _version_map($hashref); # cleanup any weird stuff
3656
-    }
3657
-    elsif ( ref $element eq '' && length $element ) {
3658
-      return { $element => 0 }
3659
-    }
3660
-    return;
3661
-  }
3662
-  
3663
-  sub _prereqs_from_1 {
3664
-    my (undef, undef, $meta) = @_;
3665
-    my $prereqs = {};
3666
-    for my $phase ( qw/build configure/ ) {
3667
-      my $key = "${phase}_requires";
3668
-      $prereqs->{$phase}{requires} = _version_map($meta->{$key})
3669
-        if $meta->{$key};
3670
-    }
3671
-    for my $rel ( qw/requires recommends conflicts/ ) {
3672
-      $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
3673
-        if $meta->{$rel};
3674
-    }
3675
-    return $prereqs;
3676
-  }
3677
-  
3678
-  my $prereqs_spec = {
3679
-    configure => \&_prereqs_rel,
3680
-    build     => \&_prereqs_rel,
3681
-    test      => \&_prereqs_rel,
3682
-    runtime   => \&_prereqs_rel,
3683
-    develop   => \&_prereqs_rel,
3684
-    ':custom'  => \&_prefix_custom,
3685
-  };
3686
-  
3687
-  my $relation_spec = {
3688
-    requires   => \&_version_map,
3689
-    recommends => \&_version_map,
3690
-    suggests   => \&_version_map,
3691
-    conflicts  => \&_version_map,
3692
-    ':custom'  => \&_prefix_custom,
3693
-  };
3694
-  
3695
-  sub _cleanup_prereqs {
3696
-    my ($prereqs, $key, $meta, $to_version) = @_;
3697
-    return unless $prereqs && ref $prereqs eq 'HASH';
3698
-    return _convert( $prereqs, $prereqs_spec, $to_version );
3699
-  }
3700
-  
3701
-  sub _prereqs_rel {
3702
-    my ($relation, $key, $meta, $to_version) = @_;
3703
-    return unless $relation && ref $relation eq 'HASH';
3704
-    return _convert( $relation, $relation_spec, $to_version );
3705
-  }
3706
-  
3707
-  
3708
-  BEGIN {
3709
-    my @old_prereqs = qw(
3710
-      requires
3711
-      configure_requires
3712
-      recommends
3713
-      conflicts
3714
-    );
3715
-  
3716
-    for ( @old_prereqs ) {
3717
-      my $sub = "_get_$_";
3718
-      my ($phase,$type) = split qr/_/, $_;
3719
-      if ( ! defined $type ) {
3720
-        $type = $phase;
3721
-        $phase = 'runtime';
3722
-      }
3723
-      no strict 'refs';
3724
-      *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
3725
-    }
3726
-  }
3727
-  
3728
-  sub _get_build_requires {
3729
-    my ($data, $key, $meta) = @_;
3730
-  
3731
-    my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
3732
-    my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
3733
-  
3734
-    my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
3735
-    my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h);
3736
-  
3737
-    $test_req->add_requirements($build_req)->as_string_hash;
3738
-  }
3739
-  
3740
-  sub _extract_prereqs {
3741
-    my ($prereqs, $phase, $type) = @_;
3742
-    return unless ref $prereqs eq 'HASH';
3743
-    return scalar _version_map($prereqs->{$phase}{$type});
3744
-  }
3745
-  
3746
-  sub _downgrade_optional_features {
3747
-    my (undef, undef, $meta) = @_;
3748
-    return unless exists $meta->{optional_features};
3749
-    my $origin = $meta->{optional_features};
3750
-    my $features = {};
3751
-    for my $name ( keys %$origin ) {
3752
-      $features->{$name} = {
3753
-        description => $origin->{$name}{description},
3754
-        requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
3755
-        configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
3756
-        build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
3757
-        recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
3758
-        conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
3759
-      };
3760
-      for my $k (keys %{$features->{$name}} ) {
3761
-        delete $features->{$name}{$k} unless defined $features->{$name}{$k};
3762
-      }
3763
-    }
3764
-    return $features;
3765
-  }
3766
-  
3767
-  sub _upgrade_optional_features {
3768
-    my (undef, undef, $meta) = @_;
3769
-    return unless exists $meta->{optional_features};
3770
-    my $origin = $meta->{optional_features};
3771
-    my $features = {};
3772
-    for my $name ( keys %$origin ) {
3773
-      $features->{$name} = {
3774
-        description => $origin->{$name}{description},
3775
-        prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
3776
-      };
3777
-      delete $features->{$name}{prereqs}{configure};
3778
-    }
3779
-    return $features;
3780
-  }
3781
-  
3782
-  my $optional_features_2_spec = {
3783
-    description => \&_keep,
3784
-    prereqs => \&_cleanup_prereqs,
3785
-    ':custom'  => \&_prefix_custom,
3786
-  };
3787
-  
3788
-  sub _feature_2 {
3789
-    my ($element, $key, $meta, $to_version) = @_;
3790
-    return unless $element && ref $element eq 'HASH';
3791
-    _convert( $element, $optional_features_2_spec, $to_version );
3792
-  }
3793
-  
3794
-  sub _cleanup_optional_features_2 {
3795
-    my ($element, $key, $meta, $to_version) = @_;
3796
-    return unless $element && ref $element eq 'HASH';
3797
-    my $new_data = {};
3798
-    for my $k ( keys %$element ) {
3799
-      $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
3800
-    }
3801
-    return unless keys %$new_data;
3802
-    return $new_data;
3803
-  }
3804
-  
3805
-  sub _optional_features_1_4 {
3806
-    my ($element) = @_;
3807
-    return unless $element;
3808
-    $element = _optional_features_as_map($element);
3809
-    for my $name ( keys %$element ) {
3810
-      for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
3811
-        delete $element->{$name}{$drop};
3812
-      }
3813
-    }
3814
-    return $element;
3815
-  }
3816
-  
3817
-  sub _optional_features_as_map {
3818
-    my ($element) = @_;
3819
-    return unless $element;
3820
-    if ( ref $element eq 'ARRAY' ) {
3821
-      my %map;
3822
-      for my $feature ( @$element ) {
3823
-        my (@parts) = %$feature;
3824
-        $map{$parts[0]} = $parts[1];
3825
-      }
3826
-      $element = \%map;
3827
-    }
3828
-    return $element;
3829
-  }
3830
-  
3831
-  sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
3832
-  
3833
-  sub _url_or_drop {
3834
-    my ($element) = @_;
3835
-    return $element if _is_urlish($element);
3836
-    return;
3837
-  }
3838
-  
3839
-  sub _url_list {
3840
-    my ($element) = @_;
3841
-    return unless $element;
3842
-    $element = _listify( $element );
3843
-    $element = [ grep { _is_urlish($_) } @$element ];
3844
-    return unless @$element;
3845
-    return $element;
3846
-  }
3847
-  
3848
-  sub _author_list {
3849
-    my ($element) = @_;
3850
-    return [ 'unknown' ] unless $element;
3851
-    $element = _listify( $element );
3852
-    $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
3853
-    return [ 'unknown' ] unless @$element;
3854
-    return $element;
3855
-  }
3856
-  
3857
-  my $resource2_upgrade = {
3858
-    license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
3859
-    homepage   => \&_url_or_drop,
3860
-    bugtracker => sub {
3861
-      my ($item) = @_;
3862
-      return unless $item;
3863
-      if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
3864
-      elsif( _is_urlish($item) ) { return { web => $item } }
3865
-      else { return }
3866
-    },
3867
-    repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
3868
-    ':custom'  => \&_prefix_custom,
3869
-  };
3870
-  
3871
-  sub _upgrade_resources_2 {
3872
-    my (undef, undef, $meta, $version) = @_;
3873
-    return unless exists $meta->{resources};
3874
-    return _convert($meta->{resources}, $resource2_upgrade);
3875
-  }
3876
-  
3877
-  my $bugtracker2_spec = {
3878
-    web => \&_url_or_drop,
3879
-    mailto => \&_keep,
3880
-    ':custom'  => \&_prefix_custom,
3881
-  };
3882
-  
3883
-  sub _repo_type {
3884
-    my ($element, $key, $meta, $to_version) = @_;
3885
-    return $element if defined $element;
3886
-    return unless exists $meta->{url};
3887
-    my $repo_url = $meta->{url};
3888
-    for my $type ( qw/git svn/ ) {
3889
-      return $type if $repo_url =~ m{\A$type};
3890
-    }
3891
-    return;
3892
-  }
3893
-  
3894
-  my $repository2_spec = {
3895
-    web => \&_url_or_drop,
3896
-    url => \&_url_or_drop,
3897
-    type => \&_repo_type,
3898
-    ':custom'  => \&_prefix_custom,
3899
-  };
3900
-  
3901
-  my $resources2_cleanup = {
3902
-    license    => \&_url_list,
3903
-    homepage   => \&_url_or_drop,
3904
-    bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
3905
-    repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
3906
-    ':custom'  => \&_prefix_custom,
3907
-  };
3908
-  
3909
-  sub _cleanup_resources_2 {
3910
-    my ($resources, $key, $meta, $to_version) = @_;
3911
-    return unless $resources && ref $resources eq 'HASH';
3912
-    return _convert($resources, $resources2_cleanup, $to_version);
3913
-  }
3914
-  
3915
-  my $resource1_spec = {
3916
-    license    => \&_url_or_drop,
3917
-    homepage   => \&_url_or_drop,
3918
-    bugtracker => \&_url_or_drop,
3919
-    repository => \&_url_or_drop,
3920
-    ':custom'  => \&_keep,
3921
-  };
3922
-  
3923
-  sub _resources_1_3 {
3924
-    my (undef, undef, $meta, $version) = @_;
3925
-    return unless exists $meta->{resources};
3926
-    return _convert($meta->{resources}, $resource1_spec);
3927
-  }
3928
-  
3929
-  *_resources_1_4 = *_resources_1_3;
3930
-  
3931
-  sub _resources_1_2 {
3932
-    my (undef, undef, $meta) = @_;
3933
-    my $resources = $meta->{resources} || {};
3934
-    if ( $meta->{license_url} && ! $resources->{license} ) {
3935
-      $resources->{license} = $meta->license_url
3936
-        if _is_urlish($meta->{license_url});
3937
-    }
3938
-    return unless keys %$resources;
3939
-    return _convert($resources, $resource1_spec);
3940
-  }
3941
-  
3942
-  my $resource_downgrade_spec = {
3943
-    license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
3944
-    homepage   => \&_url_or_drop,
3945
-    bugtracker => sub { return $_[0]->{web} },
3946
-    repository => sub { return $_[0]->{url} || $_[0]->{web} },
3947
-    ':custom'  => \&_ucfirst_custom,
3948
-  };
3949
-  
3950
-  sub _downgrade_resources {
3951
-    my (undef, undef, $meta, $version) = @_;
3952
-    return unless exists $meta->{resources};
3953
-    return _convert($meta->{resources}, $resource_downgrade_spec);
3954
-  }
3955
-  
3956
-  sub _release_status {
3957
-    my ($element, undef, $meta) = @_;
3958
-    return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
3959
-    return _release_status_from_version(undef, undef, $meta);
3960
-  }
3961
-  
3962
-  sub _release_status_from_version {
3963
-    my (undef, undef, $meta) = @_;
3964
-    my $version = $meta->{version} || '';
3965
-    return ( $version =~ /_/ ) ? 'testing' : 'stable';
3966
-  }
3967
-  
3968
-  my $provides_spec = {
3969
-    file => \&_keep,
3970
-    version => \&_clean_version,
3971
-  };
3972
-  
3973
-  my $provides_spec_2 = {
3974
-    file => \&_keep,
3975
-    version => \&_clean_version,
3976
-    ':custom'  => \&_prefix_custom,
3977
-  };
3978
-  
3979
-  sub _provides {
3980
-    my ($element, $key, $meta, $to_version) = @_;
3981
-    return unless defined $element && ref $element eq 'HASH';
3982
-    my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
3983
-    my $new_data = {};
3984
-    for my $k ( keys %$element ) {
3985
-      $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
3986
-    }
3987
-    return $new_data;
3988
-  }
3989
-  
3990
-  sub _convert {
3991
-    my ($data, $spec, $to_version) = @_;
3992
-  
3993
-    my $new_data = {};
3994
-    for my $key ( keys %$spec ) {
3995
-      next if $key eq ':custom' || $key eq ':drop';
3996
-      next unless my $fcn = $spec->{$key};
3997
-      die "spec for '$key' is not a coderef"
3998
-        unless ref $fcn && ref $fcn eq 'CODE';
3999
-      my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
4000
-      $new_data->{$key} = $new_value if defined $new_value;
4001
-    }
4002
-  
4003
-    my $drop_list   = $spec->{':drop'};
4004
-    my $customizer  = $spec->{':custom'} || \&_keep;
4005
-  
4006
-    for my $key ( keys %$data ) {
4007
-      next if $drop_list && grep { $key eq $_ } @$drop_list;
4008
-      next if exists $spec->{$key}; # we handled it
4009
-      $new_data->{ $customizer->($key) } = $data->{$key};
4010
-    }
4011
-  
4012
-    return $new_data;
4013
-  }
4014
-  
4015
-  #--------------------------------------------------------------------------#
4016
-  # define converters for each conversion
4017
-  #--------------------------------------------------------------------------#
4018
-  
4019
-  # each converts from prior version
4020
-  # special ":custom" field is used for keys not recognized in spec
4021
-  my %up_convert = (
4022
-    '2-from-1.4' => {
4023
-      # PRIOR MANDATORY
4024
-      'abstract'            => \&_keep_or_unknown,
4025
-      'author'              => \&_author_list,
4026
-      'generated_by'        => \&_generated_by,
4027
-      'license'             => \&_license_2,
4028
-      'meta-spec'           => \&_change_meta_spec,
4029
-      'name'                => \&_keep,
4030
-      'version'             => \&_keep,
4031
-      # CHANGED TO MANDATORY
4032
-      'dynamic_config'      => \&_keep_or_one,
4033
-      # ADDED MANDATORY
4034
-      'release_status'      => \&_release_status_from_version,
4035
-      # PRIOR OPTIONAL
4036
-      'keywords'            => \&_keep,
4037
-      'no_index'            => \&_no_index_directory,
4038
-      'optional_features'   => \&_upgrade_optional_features,
4039
-      'provides'            => \&_provides,
4040
-      'resources'           => \&_upgrade_resources_2,
4041
-      # ADDED OPTIONAL
4042
-      'description'         => \&_keep,
4043
-      'prereqs'             => \&_prereqs_from_1,
4044
-  
4045
-      # drop these deprecated fields, but only after we convert
4046
-      ':drop' => [ qw(
4047
-          build_requires
4048
-          configure_requires
4049
-          conflicts
4050
-          distribution_type
4051
-          license_url
4052
-          private
4053
-          recommends
4054
-          requires
4055
-      ) ],
4056
-  
4057
-      # other random keys need x_ prefixing
4058
-      ':custom'              => \&_prefix_custom,
4059
-    },
4060
-    '1.4-from-1.3' => {
4061
-      # PRIOR MANDATORY
4062
-      'abstract'            => \&_keep_or_unknown,
4063
-      'author'              => \&_author_list,
4064
-      'generated_by'        => \&_generated_by,
4065
-      'license'             => \&_license_1,
4066
-      'meta-spec'           => \&_change_meta_spec,
4067
-      'name'                => \&_keep,
4068
-      'version'             => \&_keep,
4069
-      # PRIOR OPTIONAL
4070
-      'build_requires'      => \&_version_map,
4071
-      'conflicts'           => \&_version_map,
4072
-      'distribution_type'   => \&_keep,
4073
-      'dynamic_config'      => \&_keep_or_one,
4074
-      'keywords'            => \&_keep,
4075
-      'no_index'            => \&_no_index_directory,
4076
-      'optional_features'   => \&_optional_features_1_4,
4077
-      'provides'            => \&_provides,
4078
-      'recommends'          => \&_version_map,
4079
-      'requires'            => \&_version_map,
4080
-      'resources'           => \&_resources_1_4,
4081
-      # ADDED OPTIONAL
4082
-      'configure_requires'  => \&_keep,
4083
-  
4084
-      # drop these deprecated fields, but only after we convert
4085
-      ':drop' => [ qw(
4086
-        license_url
4087
-        private
4088
-      )],
4089
-  
4090
-      # other random keys are OK if already valid
4091
-      ':custom'              => \&_keep
4092
-    },
4093
-    '1.3-from-1.2' => {
4094
-      # PRIOR MANDATORY
4095
-      'abstract'            => \&_keep_or_unknown,
4096
-      'author'              => \&_author_list,
4097
-      'generated_by'        => \&_generated_by,
4098
-      'license'             => \&_license_1,
4099
-      'meta-spec'           => \&_change_meta_spec,
4100
-      'name'                => \&_keep,
4101
-      'version'             => \&_keep,
4102
-      # PRIOR OPTIONAL
4103
-      'build_requires'      => \&_version_map,
4104
-      'conflicts'           => \&_version_map,
4105
-      'distribution_type'   => \&_keep,
4106
-      'dynamic_config'      => \&_keep_or_one,
4107
-      'keywords'            => \&_keep,
4108
-      'no_index'            => \&_no_index_directory,
4109
-      'optional_features'   => \&_optional_features_as_map,
4110
-      'provides'            => \&_provides,
4111
-      'recommends'          => \&_version_map,
4112
-      'requires'            => \&_version_map,
4113
-      'resources'           => \&_resources_1_3,
4114
-  
4115
-      # drop these deprecated fields, but only after we convert
4116
-      ':drop' => [ qw(
4117
-        license_url
4118
-        private
4119
-      )],
4120
-  
4121
-      # other random keys are OK if already valid
4122
-      ':custom'              => \&_keep
4123
-    },
4124
-    '1.2-from-1.1' => {
4125
-      # PRIOR MANDATORY
4126
-      'version'             => \&_keep,
4127
-      # CHANGED TO MANDATORY
4128
-      'license'             => \&_license_1,
4129
-      'name'                => \&_keep,
4130
-      'generated_by'        => \&_generated_by,
4131
-      # ADDED MANDATORY
4132
-      'abstract'            => \&_keep_or_unknown,
4133
-      'author'              => \&_author_list,
4134
-      'meta-spec'           => \&_change_meta_spec,
4135
-      # PRIOR OPTIONAL
4136
-      'build_requires'      => \&_version_map,
4137
-      'conflicts'           => \&_version_map,
4138
-      'distribution_type'   => \&_keep,
4139
-      'dynamic_config'      => \&_keep_or_one,
4140
-      'recommends'          => \&_version_map,
4141
-      'requires'            => \&_version_map,
4142
-      # ADDED OPTIONAL
4143
-      'keywords'            => \&_keep,
4144
-      'no_index'            => \&_no_index_1_2,
4145
-      'optional_features'   => \&_optional_features_as_map,
4146
-      'provides'            => \&_provides,
4147
-      'resources'           => \&_resources_1_2,
4148
-  
4149
-      # drop these deprecated fields, but only after we convert
4150
-      ':drop' => [ qw(
4151
-        license_url
4152
-        private
4153
-      )],
4154
-  
4155
-      # other random keys are OK if already valid
4156
-      ':custom'              => \&_keep
4157
-    },
4158
-    '1.1-from-1.0' => {
4159
-      # CHANGED TO MANDATORY
4160
-      'version'             => \&_keep,
4161
-      # IMPLIED MANDATORY
4162
-      'name'                => \&_keep,
4163
-      # PRIOR OPTIONAL
4164
-      'build_requires'      => \&_version_map,
4165
-      'conflicts'           => \&_version_map,
4166
-      'distribution_type'   => \&_keep,
4167
-      'dynamic_config'      => \&_keep_or_one,
4168
-      'generated_by'        => \&_generated_by,
4169
-      'license'             => \&_license_1,
4170
-      'recommends'          => \&_version_map,
4171
-      'requires'            => \&_version_map,
4172
-      # ADDED OPTIONAL
4173
-      'license_url'         => \&_url_or_drop,
4174
-      'private'             => \&_keep,
4175
-  
4176
-      # other random keys are OK if already valid
4177
-      ':custom'              => \&_keep
4178
-    },
4179
-  );
4180
-  
4181
-  my %down_convert = (
4182
-    '1.4-from-2' => {
4183
-      # MANDATORY
4184
-      'abstract'            => \&_keep_or_unknown,
4185
-      'author'              => \&_author_list,
4186
-      'generated_by'        => \&_generated_by,
4187
-      'license'             => \&_downgrade_license,
4188
-      'meta-spec'           => \&_change_meta_spec,
4189
-      'name'                => \&_keep,
4190
-      'version'             => \&_keep,
4191
-      # OPTIONAL
4192
-      'build_requires'      => \&_get_build_requires,
4193
-      'configure_requires'  => \&_get_configure_requires,
4194
-      'conflicts'           => \&_get_conflicts,
4195
-      'distribution_type'   => \&_keep,
4196
-      'dynamic_config'      => \&_keep_or_one,
4197
-      'keywords'            => \&_keep,
4198
-      'no_index'            => \&_no_index_directory,
4199
-      'optional_features'   => \&_downgrade_optional_features,
4200
-      'provides'            => \&_provides,
4201
-      'recommends'          => \&_get_recommends,
4202
-      'requires'            => \&_get_requires,
4203
-      'resources'           => \&_downgrade_resources,
4204
-  
4205
-      # drop these unsupported fields (after conversion)
4206
-      ':drop' => [ qw(
4207
-        description
4208
-        prereqs
4209
-        release_status
4210
-      )],
4211
-  
4212
-      # custom keys will be left unchanged
4213
-      ':custom'              => \&_keep
4214
-    },
4215
-    '1.3-from-1.4' => {
4216
-      # MANDATORY
4217
-      'abstract'            => \&_keep_or_unknown,
4218
-      'author'              => \&_author_list,
4219
-      'generated_by'        => \&_generated_by,
4220
-      'license'             => \&_license_1,
4221
-      'meta-spec'           => \&_change_meta_spec,
4222
-      'name'                => \&_keep,
4223
-      'version'             => \&_keep,
4224
-      # OPTIONAL
4225
-      'build_requires'      => \&_version_map,
4226
-      'conflicts'           => \&_version_map,
4227
-      'distribution_type'   => \&_keep,
4228
-      'dynamic_config'      => \&_keep_or_one,
4229
-      'keywords'            => \&_keep,
4230
-      'no_index'            => \&_no_index_directory,
4231
-      'optional_features'   => \&_optional_features_as_map,
4232
-      'provides'            => \&_provides,
4233
-      'recommends'          => \&_version_map,
4234
-      'requires'            => \&_version_map,
4235
-      'resources'           => \&_resources_1_3,
4236
-  
4237
-      # drop these unsupported fields, but only after we convert
4238
-      ':drop' => [ qw(
4239
-        configure_requires
4240
-      )],
4241
-  
4242
-      # other random keys are OK if already valid
4243
-      ':custom'              => \&_keep,
4244
-    },
4245
-    '1.2-from-1.3' => {
4246
-      # MANDATORY
4247
-      'abstract'            => \&_keep_or_unknown,
4248
-      'author'              => \&_author_list,
4249
-      'generated_by'        => \&_generated_by,
4250
-      'license'             => \&_license_1,
4251
-      'meta-spec'           => \&_change_meta_spec,
4252
-      'name'                => \&_keep,
4253
-      'version'             => \&_keep,
4254
-      # OPTIONAL
4255
-      'build_requires'      => \&_version_map,
4256
-      'conflicts'           => \&_version_map,
4257
-      'distribution_type'   => \&_keep,
4258
-      'dynamic_config'      => \&_keep_or_one,
4259
-      'keywords'            => \&_keep,
4260
-      'no_index'            => \&_no_index_1_2,
4261
-      'optional_features'   => \&_optional_features_as_map,
4262
-      'provides'            => \&_provides,
4263
-      'recommends'          => \&_version_map,
4264
-      'requires'            => \&_version_map,
4265
-      'resources'           => \&_resources_1_3,
4266
-  
4267
-      # other random keys are OK if already valid
4268
-      ':custom'              => \&_keep,
4269
-    },
4270
-    '1.1-from-1.2' => {
4271
-      # MANDATORY
4272
-      'version'             => \&_keep,
4273
-      # IMPLIED MANDATORY
4274
-      'name'                => \&_keep,
4275
-      'meta-spec'           => \&_change_meta_spec,
4276
-      # OPTIONAL
4277
-      'build_requires'      => \&_version_map,
4278
-      'conflicts'           => \&_version_map,
4279
-      'distribution_type'   => \&_keep,
4280
-      'dynamic_config'      => \&_keep_or_one,
4281
-      'generated_by'        => \&_generated_by,
4282
-      'license'             => \&_license_1,
4283
-      'private'             => \&_keep,
4284
-      'recommends'          => \&_version_map,
4285
-      'requires'            => \&_version_map,
4286
-  
4287
-      # drop unsupported fields
4288
-      ':drop' => [ qw(
4289
-        abstract
4290
-        author
4291
-        provides
4292
-        no_index
4293
-        keywords
4294
-        resources
4295
-      )],
4296
-  
4297
-      # other random keys are OK if already valid
4298
-      ':custom'              => \&_keep,
4299
-    },
4300
-    '1.0-from-1.1' => {
4301
-      # IMPLIED MANDATORY
4302
-      'name'                => \&_keep,
4303
-      'meta-spec'           => \&_change_meta_spec,
4304
-      'version'             => \&_keep,
4305
-      # PRIOR OPTIONAL
4306
-      'build_requires'      => \&_version_map,
4307
-      'conflicts'           => \&_version_map,
4308
-      'distribution_type'   => \&_keep,
4309
-      'dynamic_config'      => \&_keep_or_one,
4310
-      'generated_by'        => \&_generated_by,
4311
-      'license'             => \&_license_1,
4312
-      'recommends'          => \&_version_map,
4313
-      'requires'            => \&_version_map,
4314
-  
4315
-      # other random keys are OK if already valid
4316
-      ':custom'              => \&_keep,
4317
-    },
4318
-  );
4319
-  
4320
-  my %cleanup = (
4321
-    '2' => {
4322
-      # PRIOR MANDATORY
4323
-      'abstract'            => \&_keep_or_unknown,
4324
-      'author'              => \&_author_list,
4325
-      'generated_by'        => \&_generated_by,
4326
-      'license'             => \&_license_2,
4327
-      'meta-spec'           => \&_change_meta_spec,
4328
-      'name'                => \&_keep,
4329
-      'version'             => \&_keep,
4330
-      # CHANGED TO MANDATORY
4331
-      'dynamic_config'      => \&_keep_or_one,
4332
-      # ADDED MANDATORY
4333
-      'release_status'      => \&_release_status,
4334
-      # PRIOR OPTIONAL
4335
-      'keywords'            => \&_keep,
4336
-      'no_index'            => \&_no_index_directory,
4337
-      'optional_features'   => \&_cleanup_optional_features_2,
4338
-      'provides'            => \&_provides,
4339
-      'resources'           => \&_cleanup_resources_2,
4340
-      # ADDED OPTIONAL
4341
-      'description'         => \&_keep,
4342
-      'prereqs'             => \&_cleanup_prereqs,
4343
-  
4344
-      # drop these deprecated fields, but only after we convert
4345
-      ':drop' => [ qw(
4346
-          build_requires
4347
-          configure_requires
4348
-          conflicts
4349
-          distribution_type
4350
-          license_url
4351
-          private
4352
-          recommends
4353
-          requires
4354
-      ) ],
4355
-  
4356
-      # other random keys need x_ prefixing
4357
-      ':custom'              => \&_prefix_custom,
4358
-    },
4359
-    '1.4' => {
4360
-      # PRIOR MANDATORY
4361
-      'abstract'            => \&_keep_or_unknown,
4362
-      'author'              => \&_author_list,
4363
-      'generated_by'        => \&_generated_by,
4364
-      'license'             => \&_license_1,
4365
-      'meta-spec'           => \&_change_meta_spec,
4366
-      'name'                => \&_keep,
4367
-      'version'             => \&_keep,
4368
-      # PRIOR OPTIONAL
4369
-      'build_requires'      => \&_version_map,
4370
-      'conflicts'           => \&_version_map,
4371
-      'distribution_type'   => \&_keep,
4372
-      'dynamic_config'      => \&_keep_or_one,
4373
-      'keywords'            => \&_keep,
4374
-      'no_index'            => \&_no_index_directory,
4375
-      'optional_features'   => \&_optional_features_1_4,
4376
-      'provides'            => \&_provides,
4377
-      'recommends'          => \&_version_map,
4378
-      'requires'            => \&_version_map,
4379
-      'resources'           => \&_resources_1_4,
4380
-      # ADDED OPTIONAL
4381
-      'configure_requires'  => \&_keep,
4382
-  
4383
-      # other random keys are OK if already valid
4384
-      ':custom'             => \&_keep
4385
-    },
4386
-    '1.3' => {
4387
-      # PRIOR MANDATORY
4388
-      'abstract'            => \&_keep_or_unknown,
4389
-      'author'              => \&_author_list,
4390
-      'generated_by'        => \&_generated_by,
4391
-      'license'             => \&_license_1,
4392
-      'meta-spec'           => \&_change_meta_spec,
4393
-      'name'                => \&_keep,
4394
-      'version'             => \&_keep,
4395
-      # PRIOR OPTIONAL
4396
-      'build_requires'      => \&_version_map,
4397
-      'conflicts'           => \&_version_map,
4398
-      'distribution_type'   => \&_keep,
4399
-      'dynamic_config'      => \&_keep_or_one,
4400
-      'keywords'            => \&_keep,
4401
-      'no_index'            => \&_no_index_directory,
4402
-      'optional_features'   => \&_optional_features_as_map,
4403
-      'provides'            => \&_provides,
4404
-      'recommends'          => \&_version_map,
4405
-      'requires'            => \&_version_map,
4406
-      'resources'           => \&_resources_1_3,
4407
-  
4408
-      # other random keys are OK if already valid
4409
-      ':custom'             => \&_keep
4410
-    },
4411
-    '1.2' => {
4412
-      # PRIOR MANDATORY
4413
-      'version'             => \&_keep,
4414
-      # CHANGED TO MANDATORY
4415
-      'license'             => \&_license_1,
4416
-      'name'                => \&_keep,
4417
-      'generated_by'        => \&_generated_by,
4418
-      # ADDED MANDATORY
4419
-      'abstract'            => \&_keep_or_unknown,
4420
-      'author'              => \&_author_list,
4421
-      'meta-spec'           => \&_change_meta_spec,
4422
-      # PRIOR OPTIONAL
4423
-      'build_requires'      => \&_version_map,
4424
-      'conflicts'           => \&_version_map,
4425
-      'distribution_type'   => \&_keep,
4426
-      'dynamic_config'      => \&_keep_or_one,
4427
-      'recommends'          => \&_version_map,
4428
-      'requires'            => \&_version_map,
4429
-      # ADDED OPTIONAL
4430
-      'keywords'            => \&_keep,
4431
-      'no_index'            => \&_no_index_1_2,
4432
-      'optional_features'   => \&_optional_features_as_map,
4433
-      'provides'            => \&_provides,
4434
-      'resources'           => \&_resources_1_2,
4435
-  
4436
-      # other random keys are OK if already valid
4437
-      ':custom'             => \&_keep
4438
-    },
4439
-    '1.1' => {
4440
-      # CHANGED TO MANDATORY
4441
-      'version'             => \&_keep,
4442
-      # IMPLIED MANDATORY
4443
-      'name'                => \&_keep,
4444
-      'meta-spec'           => \&_change_meta_spec,
4445
-      # PRIOR OPTIONAL
4446
-      'build_requires'      => \&_version_map,
4447
-      'conflicts'           => \&_version_map,
4448
-      'distribution_type'   => \&_keep,
4449
-      'dynamic_config'      => \&_keep_or_one,
4450
-      'generated_by'        => \&_generated_by,
4451
-      'license'             => \&_license_1,
4452
-      'recommends'          => \&_version_map,
4453
-      'requires'            => \&_version_map,
4454
-      # ADDED OPTIONAL
4455
-      'license_url'         => \&_url_or_drop,
4456
-      'private'             => \&_keep,
4457
-  
4458
-      # other random keys are OK if already valid
4459
-      ':custom'             => \&_keep
4460
-    },
4461
-    '1.0' => {
4462
-      # IMPLIED MANDATORY
4463
-      'name'                => \&_keep,
4464
-      'meta-spec'           => \&_change_meta_spec,
4465
-      'version'             => \&_keep,
4466
-      # IMPLIED OPTIONAL
4467
-      'build_requires'      => \&_version_map,
4468
-      'conflicts'           => \&_version_map,
4469
-      'distribution_type'   => \&_keep,
4470
-      'dynamic_config'      => \&_keep_or_one,
4471
-      'generated_by'        => \&_generated_by,
4472
-      'license'             => \&_license_1,
4473
-      'recommends'          => \&_version_map,
4474
-      'requires'            => \&_version_map,
4475
-  
4476
-      # other random keys are OK if already valid
4477
-      ':custom'             => \&_keep,
4478
-    },
4479
-  );
4480
-  
4481
-  #--------------------------------------------------------------------------#
4482
-  # Code
4483
-  #--------------------------------------------------------------------------#
4484
-  
4485
-  
4486
-  sub new {
4487
-    my ($class,$data) = @_;
4488
-  
4489
-    # create an attributes hash
4490
-    my $self = {
4491
-      'data'    => $data,
4492
-      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
4493
-    };
4494
-  
4495
-    # create the object
4496
-    return bless $self, $class;
4497
-  }
4498
-  
4499
-  
4500
-  sub convert {
4501
-    my ($self, %args) = @_;
4502
-    my $args = { %args };
4503
-  
4504
-    my $new_version = $args->{version} || $HIGHEST;
4505
-  
4506
-    my ($old_version) = $self->{spec};
4507
-    my $converted = _dclone($self->{data});
4508
-  
4509
-    if ( $old_version == $new_version ) {
4510
-      $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
4511
-      my $cmv = CPAN::Meta::Validator->new( $converted );
4512
-      unless ( $cmv->is_valid ) {
4513
-        my $errs = join("\n", $cmv->errors);
4514
-        die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
4515
-      }
4516
-      return $converted;
4517
-    }
4518
-    elsif ( $old_version > $new_version )  {
4519
-      my @vers = sort { $b <=> $a } keys %known_specs;
4520
-      for my $i ( 0 .. $#vers-1 ) {
4521
-        next if $vers[$i] > $old_version;
4522
-        last if $vers[$i+1] < $new_version;
4523
-        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
4524
-        $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
4525
-        my $cmv = CPAN::Meta::Validator->new( $converted );
4526
-        unless ( $cmv->is_valid ) {
4527
-          my $errs = join("\n", $cmv->errors);
4528
-          die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
4529
-        }
4530
-      }
4531
-      return $converted;
4532
-    }
4533
-    else {
4534
-      my @vers = sort { $a <=> $b } keys %known_specs;
4535
-      for my $i ( 0 .. $#vers-1 ) {
4536
-        next if $vers[$i] < $old_version;
4537
-        last if $vers[$i+1] > $new_version;
4538
-        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
4539
-        $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
4540
-        my $cmv = CPAN::Meta::Validator->new( $converted );
4541
-        unless ( $cmv->is_valid ) {
4542
-          my $errs = join("\n", $cmv->errors);
4543
-          die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
4544
-        }
4545
-      }
4546
-      return $converted;
4547
-    }
4548
-  }
4549
-  
4550
-  1;
4551
-  
4552
-  # ABSTRACT: Convert CPAN distribution metadata structures
4553
-  
4554
-  
4555
-  
4556
-  
4557
-  __END__
4558
-  
4559
-  
4560
-CPAN_META_CONVERTER
4561
-
4562
-$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
4563
-  use 5.006;
4564
-  use strict;
4565
-  use warnings;
4566
-  package CPAN::Meta::Feature;
4567
-  our $VERSION = '2.120921'; # VERSION
4568
-  
4569
-  use CPAN::Meta::Prereqs;
4570
-  
4571
-  
4572
-  sub new {
4573
-    my ($class, $identifier, $spec) = @_;
4574
-  
4575
-    my %guts = (
4576
-      identifier  => $identifier,
4577
-      description => $spec->{description},
4578
-      prereqs     => CPAN::Meta::Prereqs->new($spec->{prereqs}),
4579
-    );
4580
-  
4581
-    bless \%guts => $class;
4582
-  }
4583
-  
4584
-  
4585
-  sub identifier  { $_[0]{identifier}  }
4586
-  
4587
-  
4588
-  sub description { $_[0]{description} }
4589
-  
4590
-  
4591
-  sub prereqs     { $_[0]{prereqs} }
4592
-  
4593
-  1;
4594
-  
4595
-  # ABSTRACT: an optional feature provided by a CPAN distribution
4596
-  
4597
-  
4598
-  
4599
-  
4600
-  __END__
4601
-  
4602
-  
4603
-  
4604
-CPAN_META_FEATURE
4605
-
4606
-$fatpacked{"CPAN/Meta/History.pm"} = <<'CPAN_META_HISTORY';
4607
-  # vi:tw=72
4608
-  use 5.006;
4609
-  use strict;
4610
-  use warnings;
4611
-  package CPAN::Meta::History;
4612
-  our $VERSION = '2.120921'; # VERSION
4613
-  
4614
-  1;
4615
-  
4616
-  # ABSTRACT: history of CPAN Meta Spec changes
4617
-  
4618
-  
4619
-  
4620
-  __END__
4621
-  =pod
4622
-  
4623
-CPAN_META_HISTORY
4624
-
4625
-$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
4626
-  use 5.006;
4627
-  use strict;
4628
-  use warnings;
4629
-  package CPAN::Meta::Prereqs;
4630
-  our $VERSION = '2.120921'; # VERSION
4631
-  
4632
-  
4633
-  use Carp qw(confess);
4634
-  use Scalar::Util qw(blessed);
4635
-  use CPAN::Meta::Requirements 2.121;
4636
-  
4637
-  
4638
-  sub __legal_phases { qw(configure build test runtime develop)   }
4639
-  sub __legal_types  { qw(requires recommends suggests conflicts) }
4640
-  
4641
-  # expect a prereq spec from META.json -- rjbs, 2010-04-11
4642
-  sub new {
4643
-    my ($class, $prereq_spec) = @_;
4644
-    $prereq_spec ||= {};
4645
-  
4646
-    my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases;
4647
-    my %is_legal_type  = map {; $_ => 1 } $class->__legal_types;
4648
-  
4649
-    my %guts;
4650
-    PHASE: for my $phase (keys %$prereq_spec) {
4651
-      next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase};
4652
-  
4653
-      my $phase_spec = $prereq_spec->{ $phase };
4654
-      next PHASE unless keys %$phase_spec;
4655
-  
4656
-      TYPE: for my $type (keys %$phase_spec) {
4657
-        next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type};
4658
-  
4659
-        my $spec = $phase_spec->{ $type };
4660
-  
4661
-        next TYPE unless keys %$spec;
4662
-  
4663
-        $guts{prereqs}{$phase}{$type} = CPAN::Meta::Requirements->from_string_hash(
4664
-          $spec
4665
-        );
4666
-      }
4667
-    }
4668
-  
4669
-    return bless \%guts => $class;
4670
-  }
4671
-  
4672
-  
4673
-  sub requirements_for {
4674
-    my ($self, $phase, $type) = @_;
4675
-  
4676
-    confess "requirements_for called without phase" unless defined $phase;
4677
-    confess "requirements_for called without type"  unless defined $type;
4678
-  
4679
-    unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
4680
-      confess "requested requirements for unknown phase: $phase";
4681
-    }
4682
-  
4683
-    unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
4684
-      confess "requested requirements for unknown type: $type";
4685
-    }
4686
-  
4687
-    my $req = ($self->{prereqs}{$phase}{$type} ||= CPAN::Meta::Requirements->new);
4688
-  
4689
-    $req->finalize if $self->is_finalized;
4690
-  
4691
-    return $req;
4692
-  }
4693
-  
4694
-  
4695
-  sub with_merged_prereqs {
4696
-    my ($self, $other) = @_;
4697
-  
4698
-    my @other = blessed($other) ? $other : @$other;
4699
-  
4700
-    my @prereq_objs = ($self, @other);
4701
-  
4702
-    my %new_arg;
4703
-  
4704
-    for my $phase ($self->__legal_phases) {
4705
-      for my $type ($self->__legal_types) {
4706
-        my $req = CPAN::Meta::Requirements->new;
4707
-  
4708
-        for my $prereq (@prereq_objs) {
4709
-          my $this_req = $prereq->requirements_for($phase, $type);
4710
-          next unless $this_req->required_modules;
4711
-  
4712
-          $req->add_requirements($this_req);
4713
-        }
4714
-  
4715
-        next unless $req->required_modules;
4716
-  
4717
-        $new_arg{ $phase }{ $type } = $req->as_string_hash;
4718
-      }
4719
-    }
4720
-  
4721
-    return (ref $self)->new(\%new_arg);
4722
-  }
4723
-  
4724
-  
4725
-  sub as_string_hash {
4726
-    my ($self) = @_;
4727
-  
4728
-    my %hash;
4729
-  
4730
-    for my $phase ($self->__legal_phases) {
4731
-      for my $type ($self->__legal_types) {
4732
-        my $req = $self->requirements_for($phase, $type);
4733
-        next unless $req->required_modules;
4734
-  
4735
-        $hash{ $phase }{ $type } = $req->as_string_hash;
4736
-      }
4737
-    }
4738
-  
4739
-    return \%hash;
4740
-  }
4741
-  
4742
-  
4743
-  sub is_finalized { $_[0]{finalized} }
4744
-  
4745
-  
4746
-  sub finalize {
4747
-    my ($self) = @_;
4748
-  
4749
-    $self->{finalized} = 1;
4750
-  
4751
-    for my $phase (keys %{ $self->{prereqs} }) {
4752
-      $_->finalize for values %{ $self->{prereqs}{$phase} };
4753
-    }
4754
-  }
4755
-  
4756
-  
4757
-  sub clone {
4758
-    my ($self) = @_;
4759
-  
4760
-    my $clone = (ref $self)->new( $self->as_string_hash );
4761
-  }
4762
-  
4763
-  1;
4764
-  
4765
-  # ABSTRACT: a set of distribution prerequisites by phase and type
4766
-  
4767
-  
4768
-  
4769
-  
4770
-  __END__
4771
-  
4772
-  
4773
-  
4774
-CPAN_META_PREREQS
4775
-
4776
-$fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
4777
-  use strict;
4778
-  use warnings;
4779
-  package CPAN::Meta::Requirements;
4780
-  our $VERSION = '2.122'; # VERSION
4781
-  # ABSTRACT: a set of version requirements for a CPAN dist
4782
-  
4783
-  
4784
-  use Carp ();
4785
-  use Scalar::Util ();
4786
-  use version 0.77 (); # the ->parse method
4787
-  
4788
-  
4789
-  my @valid_options = qw( bad_version_hook );
4790
-  
4791
-  sub new {
4792
-    my ($class, $options) = @_;
4793
-    $options ||= {};
4794
-    Carp::croak "Argument to $class\->new() must be a hash reference"
4795
-      unless ref $options eq 'HASH';
4796
-    my %self = map {; $_ => $options->{$_}} @valid_options;
4797
-  
4798
-    return bless \%self => $class;
4799
-  }
4800
-  
4801
-  sub _version_object {
4802
-    my ($self, $version) = @_;
4803
-  
4804
-    my $vobj;
4805
-  
4806
-    eval {
4807
-      $vobj  = (! defined $version)                ? version->parse(0)
4808
-             : (! Scalar::Util::blessed($version)) ? version->parse($version)
4809
-             :                                       $version;
4810
-    };
4811
-  
4812
-    if ( my $err = $@ ) {
4813
-      my $hook = $self->{bad_version_hook};
4814
-      $vobj = eval { $hook->($version) }
4815
-        if ref $hook eq 'CODE';
4816
-      unless (Scalar::Util::blessed($vobj) && $vobj->isa("version")) {
4817
-        $err =~ s{ at .* line \d+.*$}{};
4818
-        die "Can't convert '$version': $err";
4819
-      }
4820
-    }
4821
-  
4822
-    # ensure no leading '.'
4823
-    if ( $vobj =~ m{\A\.} ) {
4824
-      $vobj = version->parse("0$vobj");
4825
-    }
4826
-  
4827
-    # ensure normal v-string form
4828
-    if ( $vobj->is_qv ) {
4829
-      $vobj = version->parse($vobj->normal);
4830
-    }
4831
-  
4832
-    return $vobj;
4833
-  }
4834
-  
4835
-  
4836
-  BEGIN {
4837
-    for my $type (qw(minimum maximum exclusion exact_version)) {
4838
-      my $method = "with_$type";
4839
-      my $to_add = $type eq 'exact_version' ? $type : "add_$type";
4840
-  
4841
-      my $code = sub {
4842
-        my ($self, $name, $version) = @_;
4843
-  
4844
-        $version = $self->_version_object( $version );
4845
-  
4846
-        $self->__modify_entry_for($name, $method, $version);
4847
-  
4848
-        return $self;
4849
-      };
4850
-      
4851
-      no strict 'refs';
4852
-      *$to_add = $code;
4853
-    }
4854
-  }
4855
-  
4856
-  
4857
-  sub add_requirements {
4858
-    my ($self, $req) = @_;
4859
-  
4860
-    for my $module ($req->required_modules) {
4861
-      my $modifiers = $req->__entry_for($module)->as_modifiers;
4862
-      for my $modifier (@$modifiers) {
4863
-        my ($method, @args) = @$modifier;
4864
-        $self->$method($module => @args);
4865
-      };
4866
-    }
4867
-  
4868
-    return $self;
4869
-  }
4870
-  
4871
-  
4872
-  sub accepts_module {
4873
-    my ($self, $module, $version) = @_;
4874
-  
4875
-    $version = $self->_version_object( $version );
4876
-  
4877
-    return 1 unless my $range = $self->__entry_for($module);
4878
-    return $range->_accepts($version);
4879
-  }
4880
-  
4881
-  
4882
-  sub clear_requirement {
4883
-    my ($self, $module) = @_;
4884
-  
4885
-    return $self unless $self->__entry_for($module);
4886
-  
4887
-    Carp::confess("can't clear requirements on finalized requirements")
4888
-      if $self->is_finalized;
4889
-  
4890
-    delete $self->{requirements}{ $module };
4891
-  
4892
-    return $self;
4893
-  }
4894
-  
4895
-  
4896
-  sub requirements_for_module {
4897
-    my ($self, $module) = @_;
4898
-    my $entry = $self->__entry_for($module);
4899
-    return unless $entry;
4900
-    return $entry->as_string;
4901
-  }
4902
-  
4903
-  
4904
-  sub required_modules { keys %{ $_[0]{requirements} } }
4905
-  
4906
-  
4907
-  sub clone {
4908
-    my ($self) = @_;
4909
-    my $new = (ref $self)->new;
4910
-  
4911
-    return $new->add_requirements($self);
4912
-  }
4913
-  
4914
-  sub __entry_for     { $_[0]{requirements}{ $_[1] } }
4915
-  
4916
-  sub __modify_entry_for {
4917
-    my ($self, $name, $method, $version) = @_;
4918
-  
4919
-    my $fin = $self->is_finalized;
4920
-    my $old = $self->__entry_for($name);
4921
-  
4922
-    Carp::confess("can't add new requirements to finalized requirements")
4923
-      if $fin and not $old;
4924
-  
4925
-    my $new = ($old || 'CPAN::Meta::Requirements::_Range::Range')
4926
-            ->$method($version);
4927
-  
4928
-    Carp::confess("can't modify finalized requirements")
4929
-      if $fin and $old->as_string ne $new->as_string;
4930
-  
4931
-    $self->{requirements}{ $name } = $new;
4932
-  }
4933
-  
4934
-  
4935
-  sub is_simple {
4936
-    my ($self) = @_;
4937
-    for my $module ($self->required_modules) {
4938
-      # XXX: This is a complete hack, but also entirely correct.
4939
-      return if $self->__entry_for($module)->as_string =~ /\s/;
4940
-    }
4941
-  
4942
-    return 1;
4943
-  }
4944
-  
4945
-  
4946
-  sub is_finalized { $_[0]{finalized} }
4947
-  
4948
-  
4949
-  sub finalize { $_[0]{finalized} = 1 }
4950
-  
4951
-  
4952
-  sub as_string_hash {
4953
-    my ($self) = @_;
4954
-  
4955
-    my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
4956
-               $self->required_modules;
4957
-  
4958
-    return \%hash;
4959
-  }
4960
-  
4961
-  
4962
-  my %methods_for_op = (
4963
-    '==' => [ qw(exact_version) ],
4964
-    '!=' => [ qw(add_exclusion) ],
4965
-    '>=' => [ qw(add_minimum)   ],
4966
-    '<=' => [ qw(add_maximum)   ],
4967
-    '>'  => [ qw(add_minimum add_exclusion) ],
4968
-    '<'  => [ qw(add_maximum add_exclusion) ],
4969
-  );
4970
-  
4971
-  sub add_string_requirement {
4972
-    my ($self, $module, $req) = @_;
4973
-  
4974
-    Carp::confess("No requirement string provided for $module")
4975
-      unless defined $req && length $req;
4976
-  
4977
-    my @parts = split qr{\s*,\s*}, $req;
4978
-  
4979
-  
4980
-    for my $part (@parts) {
4981
-      my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};
4982
-  
4983
-      if (! defined $op) {
4984
-        $self->add_minimum($module => $part);
4985
-      } else {
4986
-        Carp::confess("illegal requirement string: $req")
4987
-          unless my $methods = $methods_for_op{ $op };
4988
-  
4989
-        $self->$_($module => $ver) for @$methods;
4990
-      }
4991
-    }
4992
-  }
4993
-  
4994
-  
4995
-  sub from_string_hash {
4996
-    my ($class, $hash) = @_;
4997
-  
4998
-    my $self = $class->new;
4999
-  
5000
-    for my $module (keys %$hash) {
5001
-      my $req = $hash->{$module};
5002
-      unless ( defined $req && length $req ) {
5003
-        $req = 0;
5004
-        Carp::carp("Undefined requirement for $module treated as '0'");
5005
-      }
5006
-      $self->add_string_requirement($module, $req);
5007
-    }
5008
-  
5009
-    return $self;
5010
-  }
5011
-  
5012
-  ##############################################################
5013
-  
5014
-  {
5015
-    package
5016
-      CPAN::Meta::Requirements::_Range::Exact;
5017
-    sub _new     { bless { version => $_[1] } => $_[0] }
5018
-  
5019
-    sub _accepts { return $_[0]{version} == $_[1] }
5020
-  
5021
-    sub as_string { return "== $_[0]{version}" }
5022
-  
5023
-    sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] }
5024
-  
5025
-    sub _clone {
5026
-      (ref $_[0])->_new( version->new( $_[0]{version} ) )
5027
-    }
5028
-  
5029
-    sub with_exact_version {
5030
-      my ($self, $version) = @_;
5031
-  
5032
-      return $self->_clone if $self->_accepts($version);
5033
-  
5034
-      Carp::confess("illegal requirements: unequal exact version specified");
5035
-    }
5036
-  
5037
-    sub with_minimum {
5038
-      my ($self, $minimum) = @_;
5039
-      return $self->_clone if $self->{version} >= $minimum;
5040
-      Carp::confess("illegal requirements: minimum above exact specification");
5041
-    }
5042
-  
5043
-    sub with_maximum {
5044
-      my ($self, $maximum) = @_;
5045
-      return $self->_clone if $self->{version} <= $maximum;
5046
-      Carp::confess("illegal requirements: maximum below exact specification");
5047
-    }
5048
-  
5049
-    sub with_exclusion {
5050
-      my ($self, $exclusion) = @_;
5051
-      return $self->_clone unless $exclusion == $self->{version};
5052
-      Carp::confess("illegal requirements: excluded exact specification");
5053
-    }
5054
-  }
5055
-  
5056
-  ##############################################################
5057
-  
5058
-  {
5059
-    package
5060
-      CPAN::Meta::Requirements::_Range::Range;
5061
-  
5062
-    sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) }
5063
-  
5064
-    sub _clone {
5065
-      return (bless { } => $_[0]) unless ref $_[0];
5066
-  
5067
-      my ($s) = @_;
5068
-      my %guts = (
5069
-        (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()),
5070
-        (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()),
5071
-  
5072
-        (exists $s->{exclusions}
5073
-          ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ])
5074
-          : ()),
5075
-      );
5076
-  
5077
-      bless \%guts => ref($s);
5078
-    }
5079
-  
5080
-    sub as_modifiers {
5081
-      my ($self) = @_;
5082
-      my @mods;
5083
-      push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum};
5084
-      push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum};
5085
-      push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []};
5086
-      return \@mods;
5087
-    }
5088
-  
5089
-    sub as_string {
5090
-      my ($self) = @_;
5091
-  
5092
-      return 0 if ! keys %$self;
5093
-  
5094
-      return "$self->{minimum}" if (keys %$self) == 1 and exists $self->{minimum};
5095
-  
5096
-      my @exclusions = @{ $self->{exclusions} || [] };
5097
-  
5098
-      my @parts;
5099
-  
5100
-      for my $pair (
5101
-        [ qw( >= > minimum ) ],
5102
-        [ qw( <= < maximum ) ],
5103
-      ) {
5104
-        my ($op, $e_op, $k) = @$pair;
5105
-        if (exists $self->{$k}) {
5106
-          my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions;
5107
-          if (@new_exclusions == @exclusions) {
5108
-            push @parts, "$op $self->{ $k }";
5109
-          } else {
5110
-            push @parts, "$e_op $self->{ $k }";
5111
-            @exclusions = @new_exclusions;
5112
-          }
5113
-        }
5114
-      }
5115
-  
5116
-      push @parts, map {; "!= $_" } @exclusions;
5117
-  
5118
-      return join q{, }, @parts;
5119
-    }
5120
-  
5121
-    sub with_exact_version {
5122
-      my ($self, $version) = @_;
5123
-      $self = $self->_clone;
5124
-  
5125
-      Carp::confess("illegal requirements: exact specification outside of range")
5126
-        unless $self->_accepts($version);
5127
-  
5128
-      return CPAN::Meta::Requirements::_Range::Exact->_new($version);
5129
-    }
5130
-  
5131
-    sub _simplify {
5132
-      my ($self) = @_;
5133
-  
5134
-      if (defined $self->{minimum} and defined $self->{maximum}) {
5135
-        if ($self->{minimum} == $self->{maximum}) {
5136
-          Carp::confess("illegal requirements: excluded all values")
5137
-            if grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] };
5138
-  
5139
-          return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})
5140
-        }
5141
-  
5142
-        Carp::confess("illegal requirements: minimum exceeds maximum")
5143
-          if $self->{minimum} > $self->{maximum};
5144
-      }
5145
-  
5146
-      # eliminate irrelevant exclusions
5147
-      if ($self->{exclusions}) {
5148
-        my %seen;
5149
-        @{ $self->{exclusions} } = grep {
5150
-          (! defined $self->{minimum} or $_ >= $self->{minimum})
5151
-          and
5152
-          (! defined $self->{maximum} or $_ <= $self->{maximum})
5153
-          and
5154
-          ! $seen{$_}++
5155
-        } @{ $self->{exclusions} };
5156
-      }
5157
-  
5158
-      return $self;
5159
-    }
5160
-  
5161
-    sub with_minimum {
5162
-      my ($self, $minimum) = @_;
5163
-      $self = $self->_clone;
5164
-  
5165
-      if (defined (my $old_min = $self->{minimum})) {
5166
-        $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0];
5167
-      } else {
5168
-        $self->{minimum} = $minimum;
5169
-      }
5170
-  
5171
-      return $self->_simplify;
5172
-    }
5173
-  
5174
-    sub with_maximum {
5175
-      my ($self, $maximum) = @_;
5176
-      $self = $self->_clone;
5177
-  
5178
-      if (defined (my $old_max = $self->{maximum})) {
5179
-        $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0];
5180
-      } else {
5181
-        $self->{maximum} = $maximum;
5182
-      }
5183
-  
5184
-      return $self->_simplify;
5185
-    }
5186
-  
5187
-    sub with_exclusion {
5188
-      my ($self, $exclusion) = @_;
5189
-      $self = $self->_clone;
5190
-  
5191
-      push @{ $self->{exclusions} ||= [] }, $exclusion;
5192
-  
5193
-      return $self->_simplify;
5194
-    }
5195
-  
5196
-    sub _accepts {
5197
-      my ($self, $version) = @_;
5198
-  
5199
-      return if defined $self->{minimum} and $version < $self->{minimum};
5200
-      return if defined $self->{maximum} and $version > $self->{maximum};
5201
-      return if defined $self->{exclusions}
5202
-            and grep { $version == $_ } @{ $self->{exclusions} };
5203
-  
5204
-      return 1;
5205
-    }
5206
-  }
5207
-  
5208
-  1;
5209
-  # vim: ts=2 sts=2 sw=2 et:
5210
-  
5211
-  __END__
5212
-  =pod
5213
-  
5214
-CPAN_META_REQUIREMENTS
5215
-
5216
-$fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
5217
-  # vi:tw=72
5218
-  use 5.006;
5219
-  use strict;
5220
-  use warnings;
5221
-  package CPAN::Meta::Spec;
5222
-  our $VERSION = '2.120921'; # VERSION
5223
-  
5224
-  1;
5225
-  
5226
-  # ABSTRACT: specification for CPAN distribution metadata
5227
-  
5228
-  
5229
-  
5230
-  __END__
5231
-  =pod
5232
-  
5233
-CPAN_META_SPEC
5234
-
5235
-$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
5236
-  use 5.006;
5237
-  use strict;
5238
-  use warnings;
5239
-  package CPAN::Meta::Validator;
5240
-  our $VERSION = '2.120921'; # VERSION
5241
-  
5242
-  
5243
-  #--------------------------------------------------------------------------#
5244
-  # This code copied and adapted from Test::CPAN::Meta
5245
-  # by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
5246
-  # L<http://www.missbarbell.co.uk>
5247
-  #--------------------------------------------------------------------------#
5248
-  
5249
-  #--------------------------------------------------------------------------#
5250
-  # Specification Definitions
5251
-  #--------------------------------------------------------------------------#
5252
-  
5253
-  my %known_specs = (
5254
-      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
5255
-      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
5256
-      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
5257
-      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
5258
-      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
5259
-  );
5260
-  my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
5261
-  
5262
-  my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
5263
-  
5264
-  my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version   } } };
5265
-  
5266
-  my $no_index_2 = {
5267
-      'map'       => { file       => { list => { value => \&string } },
5268
-                       directory  => { list => { value => \&string } },
5269
-                       'package'  => { list => { value => \&string } },
5270
-                       namespace  => { list => { value => \&string } },
5271
-                      ':key'      => { name => \&custom_2, value => \&anything },
5272
-      }
5273
-  };
5274
-  
5275
-  my $no_index_1_3 = {
5276
-      'map'       => { file       => { list => { value => \&string } },
5277
-                       directory  => { list => { value => \&string } },
5278
-                       'package'  => { list => { value => \&string } },
5279
-                       namespace  => { list => { value => \&string } },
5280
-                       ':key'     => { name => \&string, value => \&anything },
5281
-      }
5282
-  };
5283
-  
5284
-  my $no_index_1_2 = {
5285
-      'map'       => { file       => { list => { value => \&string } },
5286
-                       dir        => { list => { value => \&string } },
5287
-                       'package'  => { list => { value => \&string } },
5288
-                       namespace  => { list => { value => \&string } },
5289
-                       ':key'     => { name => \&string, value => \&anything },
5290
-      }
5291
-  };
5292
-  
5293
-  my $no_index_1_1 = {
5294
-      'map'       => { ':key'     => { name => \&string, list => { value => \&string } },
5295
-      }
5296
-  };
5297
-  
5298
-  my $prereq_map = {
5299
-    map => {
5300
-      ':key' => {
5301
-        name => \&phase,
5302
-        'map' => {
5303
-          ':key'  => {
5304
-            name => \&relation,
5305
-            %$module_map1,
5306
-          },
5307
-        },
5308
-      }
5309
-    },
5310
-  };
5311
-  
5312
-  my %definitions = (
5313
-    '2' => {
5314
-      # REQUIRED
5315
-      'abstract'            => { mandatory => 1, value => \&string  },
5316
-      'author'              => { mandatory => 1, lazylist => { value => \&string } },
5317
-      'dynamic_config'      => { mandatory => 1, value => \&boolean },
5318
-      'generated_by'        => { mandatory => 1, value => \&string  },
5319
-      'license'             => { mandatory => 1, lazylist => { value => \&license } },
5320
-      'meta-spec' => {
5321
-        mandatory => 1,
5322
-        'map' => {
5323
-          version => { mandatory => 1, value => \&version},
5324
-          url     => { value => \&url },
5325
-          ':key' => { name => \&custom_2, value => \&anything },
5326
-        }
5327
-      },
5328
-      'name'                => { mandatory => 1, value => \&string  },
5329
-      'release_status'      => { mandatory => 1, value => \&release_status },
5330
-      'version'             => { mandatory => 1, value => \&version },
5331
-  
5332
-      # OPTIONAL
5333
-      'description' => { value => \&string },
5334
-      'keywords'    => { lazylist => { value => \&string } },
5335
-      'no_index'    => $no_index_2,
5336
-      'optional_features'   => {
5337
-        'map'       => {
5338
-          ':key'  => {
5339
-            name => \&string,
5340
-            'map'   => {
5341
-              description        => { value => \&string },
5342
-              prereqs => $prereq_map,
5343
-              ':key' => { name => \&custom_2, value => \&anything },
5344
-            }
5345
-          }
5346
-        }
5347
-      },
5348
-      'prereqs' => $prereq_map,
5349
-      'provides'    => {
5350
-        'map'       => {
5351
-          ':key' => {
5352
-            name  => \&module,
5353
-            'map' => {
5354
-              file    => { mandatory => 1, value => \&file },
5355
-              version => { value => \&version },
5356
-              ':key' => { name => \&custom_2, value => \&anything },
5357
-            }
5358
-          }
5359
-        }
5360
-      },
5361
-      'resources'   => {
5362
-        'map'       => {
5363
-          license    => { lazylist => { value => \&url } },
5364
-          homepage   => { value => \&url },
5365
-          bugtracker => {
5366
-            'map' => {
5367
-              web => { value => \&url },
5368
-              mailto => { value => \&string},
5369
-              ':key' => { name => \&custom_2, value => \&anything },
5370
-            }
5371
-          },
5372
-          repository => {
5373
-            'map' => {
5374
-              web => { value => \&url },
5375
-              url => { value => \&url },
5376
-              type => { value => \&string },
5377
-              ':key' => { name => \&custom_2, value => \&anything },
5378
-            }
5379
-          },
5380
-          ':key'     => { value => \&string, name => \&custom_2 },
5381
-        }
5382
-      },
5383
-  
5384
-      # CUSTOM -- additional user defined key/value pairs
5385
-      # note we can only validate the key name, as the structure is user defined
5386
-      ':key'        => { name => \&custom_2, value => \&anything },
5387
-    },
5388
-  
5389
-  '1.4' => {
5390
-    'meta-spec'           => {
5391
-      mandatory => 1,
5392
-      'map' => {
5393
-        version => { mandatory => 1, value => \&version},
5394
-        url     => { mandatory => 1, value => \&urlspec },
5395
-        ':key'  => { name => \&string, value => \&anything },
5396
-      },
5397
-    },
5398
-  
5399
-    'name'                => { mandatory => 1, value => \&string  },
5400
-    'version'             => { mandatory => 1, value => \&version },
5401
-    'abstract'            => { mandatory => 1, value => \&string  },
5402
-    'author'              => { mandatory => 1, list  => { value => \&string } },
5403
-    'license'             => { mandatory => 1, value => \&license },
5404
-    'generated_by'        => { mandatory => 1, value => \&string  },
5405
-  
5406
-    'distribution_type'   => { value => \&string  },
5407
-    'dynamic_config'      => { value => \&boolean },
5408
-  
5409
-    'requires'            => $module_map1,
5410
-    'recommends'          => $module_map1,
5411
-    'build_requires'      => $module_map1,
5412
-    'configure_requires'  => $module_map1,
5413
-    'conflicts'           => $module_map2,
5414
-  
5415
-    'optional_features'   => {
5416
-      'map'       => {
5417
-          ':key'  => { name => \&string,
5418
-              'map'   => { description        => { value => \&string },
5419
-                           requires           => $module_map1,
5420
-                           recommends         => $module_map1,
5421
-                           build_requires     => $module_map1,
5422
-                           conflicts          => $module_map2,
5423
-                           ':key'  => { name => \&string, value => \&anything },
5424
-              }
5425
-          }
5426
-       }
5427
-    },
5428
-  
5429
-    'provides'    => {
5430
-      'map'       => {
5431
-        ':key' => { name  => \&module,
5432
-          'map' => {
5433
-            file    => { mandatory => 1, value => \&file },
5434
-            version => { value => \&version },
5435
-            ':key'  => { name => \&string, value => \&anything },
5436
-          }
5437
-        }
5438
-      }
5439
-    },
5440
-  
5441
-    'no_index'    => $no_index_1_3,
5442
-    'private'     => $no_index_1_3,
5443
-  
5444
-    'keywords'    => { list => { value => \&string } },
5445
-  
5446
-    'resources'   => {
5447
-      'map'       => { license    => { value => \&url },
5448
-                       homepage   => { value => \&url },
5449
-                       bugtracker => { value => \&url },
5450
-                       repository => { value => \&url },
5451
-                       ':key'     => { value => \&string, name => \&custom_1 },
5452
-      }
5453
-    },
5454
-  
5455
-    # additional user defined key/value pairs
5456
-    # note we can only validate the key name, as the structure is user defined
5457
-    ':key'        => { name => \&string, value => \&anything },
5458
-  },
5459
-  
5460
-  '1.3' => {
5461
-    'meta-spec'           => {
5462
-      mandatory => 1,
5463
-      'map' => {
5464
-        version => { mandatory => 1, value => \&version},
5465
-        url     => { mandatory => 1, value => \&urlspec },
5466
-        ':key'  => { name => \&string, value => \&anything },
5467
-      },
5468
-    },
5469
-  
5470
-    'name'                => { mandatory => 1, value => \&string  },
5471
-    'version'             => { mandatory => 1, value => \&version },
5472
-    'abstract'            => { mandatory => 1, value => \&string  },
5473
-    'author'              => { mandatory => 1, list  => { value => \&string } },
5474
-    'license'             => { mandatory => 1, value => \&license },
5475
-    'generated_by'        => { mandatory => 1, value => \&string  },
5476
-  
5477
-    'distribution_type'   => { value => \&string  },
5478
-    'dynamic_config'      => { value => \&boolean },
5479
-  
5480
-    'requires'            => $module_map1,
5481
-    'recommends'          => $module_map1,
5482
-    'build_requires'      => $module_map1,
5483
-    'conflicts'           => $module_map2,
5484
-  
5485
-    'optional_features'   => {
5486
-      'map'       => {
5487
-          ':key'  => { name => \&string,
5488
-              'map'   => { description        => { value => \&string },
5489
-                           requires           => $module_map1,
5490
-                           recommends         => $module_map1,
5491
-                           build_requires     => $module_map1,
5492
-                           conflicts          => $module_map2,
5493
-                           ':key'  => { name => \&string, value => \&anything },
5494
-              }
5495
-          }
5496
-       }
5497
-    },
5498
-  
5499
-    'provides'    => {
5500
-      'map'       => {
5501
-        ':key' => { name  => \&module,
5502
-          'map' => {
5503
-            file    => { mandatory => 1, value => \&file },
5504
-            version => { value => \&version },
5505
-            ':key'  => { name => \&string, value => \&anything },
5506
-          }
5507
-        }
5508
-      }
5509
-    },
5510
-  
5511
-  
5512
-    'no_index'    => $no_index_1_3,
5513
-    'private'     => $no_index_1_3,
5514
-  
5515
-    'keywords'    => { list => { value => \&string } },
5516
-  
5517
-    'resources'   => {
5518
-      'map'       => { license    => { value => \&url },
5519
-                       homepage   => { value => \&url },
5520
-                       bugtracker => { value => \&url },
5521
-                       repository => { value => \&url },
5522
-                       ':key'     => { value => \&string, name => \&custom_1 },
5523
-      }
5524
-    },
5525
-  
5526
-    # additional user defined key/value pairs
5527
-    # note we can only validate the key name, as the structure is user defined
5528
-    ':key'        => { name => \&string, value => \&anything },
5529
-  },
5530
-  
5531
-  # v1.2 is misleading, it seems to assume that a number of fields where created
5532
-  # within v1.1, when they were created within v1.2. This may have been an
5533
-  # original mistake, and that a v1.1 was retro fitted into the timeline, when
5534
-  # v1.2 was originally slated as v1.1. But I could be wrong ;)
5535
-  '1.2' => {
5536
-    'meta-spec'           => {
5537
-      mandatory => 1,
5538
-      'map' => {
5539
-        version => { mandatory => 1, value => \&version},
5540
-        url     => { mandatory => 1, value => \&urlspec },
5541
-        ':key'  => { name => \&string, value => \&anything },
5542
-      },
5543
-    },
5544
-  
5545
-  
5546
-    'name'                => { mandatory => 1, value => \&string  },
5547
-    'version'             => { mandatory => 1, value => \&version },
5548
-    'license'             => { mandatory => 1, value => \&license },
5549
-    'generated_by'        => { mandatory => 1, value => \&string  },
5550
-    'author'              => { mandatory => 1, list => { value => \&string } },
5551
-    'abstract'            => { mandatory => 1, value => \&string  },
5552
-  
5553
-    'distribution_type'   => { value => \&string  },
5554
-    'dynamic_config'      => { value => \&boolean },
5555
-  
5556
-    'keywords'            => { list => { value => \&string } },
5557
-  
5558
-    'private'             => $no_index_1_2,
5559
-    '$no_index'           => $no_index_1_2,
5560
-  
5561
-    'requires'            => $module_map1,
5562
-    'recommends'          => $module_map1,
5563
-    'build_requires'      => $module_map1,
5564
-    'conflicts'           => $module_map2,
5565
-  
5566
-    'optional_features'   => {
5567
-      'map'       => {
5568
-          ':key'  => { name => \&string,
5569
-              'map'   => { description        => { value => \&string },
5570
-                           requires           => $module_map1,
5571
-                           recommends         => $module_map1,
5572
-                           build_requires     => $module_map1,
5573
-                           conflicts          => $module_map2,
5574
-                           ':key'  => { name => \&string, value => \&anything },
5575
-              }
5576
-          }
5577
-       }
5578
-    },
5579
-  
5580
-    'provides'    => {
5581
-      'map'       => {
5582
-        ':key' => { name  => \&module,
5583
-          'map' => {
5584
-            file    => { mandatory => 1, value => \&file },
5585
-            version => { value => \&version },
5586
-            ':key'  => { name => \&string, value => \&anything },
5587
-          }
5588
-        }
5589
-      }
5590
-    },
5591
-  
5592
-    'resources'   => {
5593
-      'map'       => { license    => { value => \&url },
5594
-                       homepage   => { value => \&url },
5595
-                       bugtracker => { value => \&url },
5596
-                       repository => { value => \&url },
5597
-                       ':key'     => { value => \&string, name => \&custom_1 },
5598
-      }
5599
-    },
5600
-  
5601
-    # additional user defined key/value pairs
5602
-    # note we can only validate the key name, as the structure is user defined
5603
-    ':key'        => { name => \&string, value => \&anything },
5604
-  },
5605
-  
5606
-  # note that the 1.1 spec only specifies 'version' as mandatory
5607
-  '1.1' => {
5608
-    'name'                => { value => \&string  },
5609
-    'version'             => { mandatory => 1, value => \&version },
5610
-    'license'             => { value => \&license },
5611
-    'generated_by'        => { value => \&string  },
5612
-  
5613
-    'license_uri'         => { value => \&url },
5614
-    'distribution_type'   => { value => \&string  },
5615
-    'dynamic_config'      => { value => \&boolean },
5616
-  
5617
-    'private'             => $no_index_1_1,
5618
-  
5619
-    'requires'            => $module_map1,
5620
-    'recommends'          => $module_map1,
5621
-    'build_requires'      => $module_map1,
5622
-    'conflicts'           => $module_map2,
5623
-  
5624
-    # additional user defined key/value pairs
5625
-    # note we can only validate the key name, as the structure is user defined
5626
-    ':key'        => { name => \&string, value => \&anything },
5627
-  },
5628
-  
5629
-  # note that the 1.0 spec doesn't specify optional or mandatory fields
5630
-  # but we will treat version as mandatory since otherwise META 1.0 is
5631
-  # completely arbitrary and pointless
5632
-  '1.0' => {
5633
-    'name'                => { value => \&string  },
5634
-    'version'             => { mandatory => 1, value => \&version },
5635
-    'license'             => { value => \&license },
5636
-    'generated_by'        => { value => \&string  },
5637
-  
5638
-    'license_uri'         => { value => \&url },
5639
-    'distribution_type'   => { value => \&string  },
5640
-    'dynamic_config'      => { value => \&boolean },
5641
-  
5642
-    'requires'            => $module_map1,
5643
-    'recommends'          => $module_map1,
5644
-    'build_requires'      => $module_map1,
5645
-    'conflicts'           => $module_map2,
5646
-  
5647
-    # additional user defined key/value pairs
5648
-    # note we can only validate the key name, as the structure is user defined
5649
-    ':key'        => { name => \&string, value => \&anything },
5650
-  },
5651
-  );
5652
-  
5653
-  #--------------------------------------------------------------------------#
5654
-  # Code
5655
-  #--------------------------------------------------------------------------#
5656
-  
5657
-  
5658
-  sub new {
5659
-    my ($class,$data) = @_;
5660
-  
5661
-    # create an attributes hash
5662
-    my $self = {
5663
-      'data'    => $data,
5664
-      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
5665
-      'errors'  => undef,
5666
-    };
5667
-  
5668
-    # create the object
5669
-    return bless $self, $class;
5670
-  }
5671
-  
5672
-  
5673
-  sub is_valid {
5674
-      my $self = shift;
5675
-      my $data = $self->{data};
5676
-      my $spec_version = $self->{spec};
5677
-      $self->check_map($definitions{$spec_version},$data);
5678
-      return ! $self->errors;
5679
-  }
5680
-  
5681
-  
5682
-  sub errors {
5683
-      my $self = shift;
5684
-      return ()   unless(defined $self->{errors});
5685
-      return @{$self->{errors}};
5686
-  }
5687
-  
5688
-  
5689
-  my $spec_error = "Missing validation action in specification. "
5690
-    . "Must be one of 'map', 'list', 'lazylist', or 'value'";
5691
-  
5692
-  sub check_map {
5693
-      my ($self,$spec,$data) = @_;
5694
-  
5695
-      if(ref($spec) ne 'HASH') {
5696
-          $self->_error( "Unknown META specification, cannot validate." );
5697
-          return;
5698
-      }
5699
-  
5700
-      if(ref($data) ne 'HASH') {
5701
-          $self->_error( "Expected a map structure from string or file." );
5702
-          return;
5703
-      }
5704
-  
5705
-      for my $key (keys %$spec) {
5706
-          next    unless($spec->{$key}->{mandatory});
5707
-          next    if(defined $data->{$key});
5708
-          push @{$self->{stack}}, $key;
5709
-          $self->_error( "Missing mandatory field, '$key'" );
5710
-          pop @{$self->{stack}};
5711
-      }
5712
-  
5713
-      for my $key (keys %$data) {
5714
-          push @{$self->{stack}}, $key;
5715
-          if($spec->{$key}) {
5716
-              if($spec->{$key}{value}) {
5717
-                  $spec->{$key}{value}->($self,$key,$data->{$key});
5718
-              } elsif($spec->{$key}{'map'}) {
5719
-                  $self->check_map($spec->{$key}{'map'},$data->{$key});
5720
-              } elsif($spec->{$key}{'list'}) {
5721
-                  $self->check_list($spec->{$key}{'list'},$data->{$key});
5722
-              } elsif($spec->{$key}{'lazylist'}) {
5723
-                  $self->check_lazylist($spec->{$key}{'lazylist'},$data->{$key});
5724
-              } else {
5725
-                  $self->_error( "$spec_error for '$key'" );
5726
-              }
5727
-  
5728
-          } elsif ($spec->{':key'}) {
5729
-              $spec->{':key'}{name}->($self,$key,$key);
5730
-              if($spec->{':key'}{value}) {
5731
-                  $spec->{':key'}{value}->($self,$key,$data->{$key});
5732
-              } elsif($spec->{':key'}{'map'}) {
5733
-                  $self->check_map($spec->{':key'}{'map'},$data->{$key});
5734
-              } elsif($spec->{':key'}{'list'}) {
5735
-                  $self->check_list($spec->{':key'}{'list'},$data->{$key});
5736
-              } elsif($spec->{':key'}{'lazylist'}) {
5737
-                  $self->check_lazylist($spec->{':key'}{'lazylist'},$data->{$key});
5738
-              } else {
5739
-                  $self->_error( "$spec_error for ':key'" );
5740
-              }
5741
-  
5742
-  
5743
-          } else {
5744
-              $self->_error( "Unknown key, '$key', found in map structure" );
5745
-          }
5746
-          pop @{$self->{stack}};
5747
-      }
5748
-  }
5749
-  
5750
-  # if it's a string, make it into a list and check the list
5751
-  sub check_lazylist {
5752
-      my ($self,$spec,$data) = @_;
5753
-  
5754
-      if ( defined $data && ! ref($data) ) {
5755
-        $data = [ $data ];
5756
-      }
5757
-  
5758
-      $self->check_list($spec,$data);
5759
-  }
5760
-  
5761
-  sub check_list {
5762
-      my ($self,$spec,$data) = @_;
5763
-  
5764
-      if(ref($data) ne 'ARRAY') {
5765
-          $self->_error( "Expected a list structure" );
5766
-          return;
5767
-      }
5768
-  
5769
-      if(defined $spec->{mandatory}) {
5770
-          if(!defined $data->[0]) {
5771
-              $self->_error( "Missing entries from mandatory list" );
5772
-          }
5773
-      }
5774
-  
5775
-      for my $value (@$data) {
5776
-          push @{$self->{stack}}, $value || "<undef>";
5777
-          if(defined $spec->{value}) {
5778
-              $spec->{value}->($self,'list',$value);
5779
-          } elsif(defined $spec->{'map'}) {
5780
-              $self->check_map($spec->{'map'},$value);
5781
-          } elsif(defined $spec->{'list'}) {
5782
-              $self->check_list($spec->{'list'},$value);
5783
-          } elsif(defined $spec->{'lazylist'}) {
5784
-              $self->check_lazylist($spec->{'lazylist'},$value);
5785
-          } elsif ($spec->{':key'}) {
5786
-              $self->check_map($spec,$value);
5787
-          } else {
5788
-            $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
5789
-          }
5790
-          pop @{$self->{stack}};
5791
-      }
5792
-  }
5793
-  
5794
-  
5795
-  sub header {
5796
-      my ($self,$key,$value) = @_;
5797
-      if(defined $value) {
5798
-          return 1    if($value && $value =~ /^--- #YAML:1.0/);
5799
-      }
5800
-      $self->_error( "file does not have a valid YAML header." );
5801
-      return 0;
5802
-  }
5803
-  
5804
-  sub release_status {
5805
-    my ($self,$key,$value) = @_;
5806
-    if(defined $value) {
5807
-      my $version = $self->{data}{version} || '';
5808
-      if ( $version =~ /_/ ) {
5809
-        return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
5810
-        $self->_error( "'$value' for '$key' is invalid for version '$version'" );
5811
-      }
5812
-      else {
5813
-        return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
5814
-        $self->_error( "'$value' for '$key' is invalid" );
5815
-      }
5816
-    }
5817
-    else {
5818
-      $self->_error( "'$key' is not defined" );
5819
-    }
5820
-    return 0;
5821
-  }
5822
-  
5823
-  # _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
5824
-  sub _uri_split {
5825
-       return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
5826
-  }
5827
-  
5828
-  sub url {
5829
-      my ($self,$key,$value) = @_;
5830
-      if(defined $value) {
5831
-        my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
5832
-        unless ( defined $scheme && length $scheme ) {
5833
-          $self->_error( "'$value' for '$key' does not have a URL scheme" );
5834
-          return 0;
5835
-        }
5836
-        unless ( defined $auth && length $auth ) {
5837
-          $self->_error( "'$value' for '$key' does not have a URL authority" );
5838
-          return 0;
5839
-        }
5840
-        return 1;
5841
-      }
5842
-      $value ||= '';
5843
-      $self->_error( "'$value' for '$key' is not a valid URL." );
5844
-      return 0;
5845
-  }
5846
-  
5847
-  sub urlspec {
5848
-      my ($self,$key,$value) = @_;
5849
-      if(defined $value) {
5850
-          return 1    if($value && $known_specs{$self->{spec}} eq $value);
5851
-          if($value && $known_urls{$value}) {
5852
-              $self->_error( 'META specification URL does not match version' );
5853
-              return 0;
5854
-          }
5855
-      }
5856
-      $self->_error( 'Unknown META specification' );
5857
-      return 0;
5858
-  }
5859
-  
5860
-  sub anything { return 1 }
5861
-  
5862
-  sub string {
5863
-      my ($self,$key,$value) = @_;
5864
-      if(defined $value) {
5865
-          return 1    if($value || $value =~ /^0$/);
5866
-      }
5867
-      $self->_error( "value is an undefined string" );
5868
-      return 0;
5869
-  }
5870
-  
5871
-  sub string_or_undef {
5872
-      my ($self,$key,$value) = @_;
5873
-      return 1    unless(defined $value);
5874
-      return 1    if($value || $value =~ /^0$/);
5875
-      $self->_error( "No string defined for '$key'" );
5876
-      return 0;
5877
-  }
5878
-  
5879
-  sub file {
5880
-      my ($self,$key,$value) = @_;
5881
-      return 1    if(defined $value);
5882
-      $self->_error( "No file defined for '$key'" );
5883
-      return 0;
5884
-  }
5885
-  
5886
-  sub exversion {
5887
-      my ($self,$key,$value) = @_;
5888
-      if(defined $value && ($value || $value =~ /0/)) {
5889
-          my $pass = 1;
5890
-          for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
5891
-          return $pass;
5892
-      }
5893
-      $value = '<undef>'  unless(defined $value);
5894
-      $self->_error( "'$value' for '$key' is not a valid version." );
5895
-      return 0;
5896
-  }
5897
-  
5898
-  sub version {
5899
-      my ($self,$key,$value) = @_;
5900
-      if(defined $value) {
5901
-          return 0    unless($value || $value =~ /0/);
5902
-          return 1    if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
5903
-      } else {
5904
-          $value = '<undef>';
5905
-      }
5906
-      $self->_error( "'$value' for '$key' is not a valid version." );
5907
-      return 0;
5908
-  }
5909
-  
5910
-  sub boolean {
5911
-      my ($self,$key,$value) = @_;
5912
-      if(defined $value) {
5913
-          return 1    if($value =~ /^(0|1|true|false)$/);
5914
-      } else {
5915
-          $value = '<undef>';
5916
-      }
5917
-      $self->_error( "'$value' for '$key' is not a boolean value." );
5918
-      return 0;
5919
-  }
5920
-  
5921
-  my %v1_licenses = (
5922
-      'perl'         => 'http://dev.perl.org/licenses/',
5923
-      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
5924
-      'apache'       => 'http://apache.org/licenses/LICENSE-2.0',
5925
-      'artistic'     => 'http://opensource.org/licenses/artistic-license.php',
5926
-      'artistic_2'   => 'http://opensource.org/licenses/artistic-license-2.0.php',
5927
-      'lgpl'         => 'http://www.opensource.org/licenses/lgpl-license.php',
5928
-      'bsd'          => 'http://www.opensource.org/licenses/bsd-license.php',
5929
-      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
5930
-      'mit'          => 'http://opensource.org/licenses/mit-license.php',
5931
-      'mozilla'      => 'http://opensource.org/licenses/mozilla1.1.php',
5932
-      'open_source'  => undef,
5933
-      'unrestricted' => undef,
5934
-      'restrictive'  => undef,
5935
-      'unknown'      => undef,
5936
-  );
5937
-  
5938
-  my %v2_licenses = map { $_ => 1 } qw(
5939
-    agpl_3
5940
-    apache_1_1
5941
-    apache_2_0
5942
-    artistic_1
5943
-    artistic_2
5944
-    bsd
5945
-    freebsd
5946
-    gfdl_1_2
5947
-    gfdl_1_3
5948
-    gpl_1
5949
-    gpl_2
5950
-    gpl_3
5951
-    lgpl_2_1
5952
-    lgpl_3_0
5953
-    mit
5954
-    mozilla_1_0
5955
-    mozilla_1_1
5956
-    openssl
5957
-    perl_5
5958
-    qpl_1_0
5959
-    ssleay
5960
-    sun
5961
-    zlib
5962
-    open_source
5963
-    restricted
5964
-    unrestricted
5965
-    unknown
5966
-  );
5967
-  
5968
-  sub license {
5969
-      my ($self,$key,$value) = @_;
5970
-      my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
5971
-      if(defined $value) {
5972
-          return 1    if($value && exists $licenses->{$value});
5973
-      } else {
5974
-          $value = '<undef>';
5975
-      }
5976
-      $self->_error( "License '$value' is invalid" );
5977
-      return 0;
5978
-  }
5979
-  
5980
-  sub custom_1 {
5981
-      my ($self,$key) = @_;
5982
-      if(defined $key) {
5983
-          # a valid user defined key should be alphabetic
5984
-          # and contain at least one capital case letter.
5985
-          return 1    if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
5986
-      } else {
5987
-          $key = '<undef>';
5988
-      }
5989
-      $self->_error( "Custom resource '$key' must be in CamelCase." );
5990
-      return 0;
5991
-  }
5992
-  
5993
-  sub custom_2 {
5994
-      my ($self,$key) = @_;
5995
-      if(defined $key) {
5996
-          return 1    if($key && $key =~ /^x_/i);  # user defined
5997
-      } else {
5998
-          $key = '<undef>';
5999
-      }
6000
-      $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
6001
-      return 0;
6002
-  }
6003
-  
6004
-  sub identifier {
6005
-      my ($self,$key) = @_;
6006
-      if(defined $key) {
6007
-          return 1    if($key && $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
6008
-      } else {
6009
-          $key = '<undef>';
6010
-      }
6011
-      $self->_error( "Key '$key' is not a legal identifier." );
6012
-      return 0;
6013
-  }
6014
-  
6015
-  sub module {
6016
-      my ($self,$key) = @_;
6017
-      if(defined $key) {
6018
-          return 1    if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
6019
-      } else {
6020
-          $key = '<undef>';
6021
-      }
6022
-      $self->_error( "Key '$key' is not a legal module name." );
6023
-      return 0;
6024
-  }
6025
-  
6026
-  my @valid_phases = qw/ configure build test runtime develop /;
6027
-  sub phase {
6028
-      my ($self,$key) = @_;
6029
-      if(defined $key) {
6030
-          return 1 if( length $key && grep { $key eq $_ } @valid_phases );
6031
-          return 1 if $key =~ /x_/i;
6032
-      } else {
6033
-          $key = '<undef>';
6034
-      }
6035
-      $self->_error( "Key '$key' is not a legal phase." );
6036
-      return 0;
6037
-  }
6038
-  
6039
-  my @valid_relations = qw/ requires recommends suggests conflicts /;
6040
-  sub relation {
6041
-      my ($self,$key) = @_;
6042
-      if(defined $key) {
6043
-          return 1 if( length $key && grep { $key eq $_ } @valid_relations );
6044
-          return 1 if $key =~ /x_/i;
6045
-      } else {
6046
-          $key = '<undef>';
6047
-      }
6048
-      $self->_error( "Key '$key' is not a legal prereq relationship." );
6049
-      return 0;
6050
-  }
6051
-  
6052
-  sub _error {
6053
-      my $self = shift;
6054
-      my $mess = shift;
6055
-  
6056
-      $mess .= ' ('.join(' -> ',@{$self->{stack}}).')'  if($self->{stack});
6057
-      $mess .= " [Validation: $self->{spec}]";
6058
-  
6059
-      push @{$self->{errors}}, $mess;
6060
-  }
6061
-  
6062
-  1;
6063
-  
6064
-  # ABSTRACT: validate CPAN distribution metadata structures
6065
-  
6066
-  
6067
-  
6068
-  
6069
-  __END__
6070
-  
6071
-  
6072
-  
6073
-CPAN_META_VALIDATOR
6074
-
6075
-$fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
6076
-  package CPAN::Meta::YAML;
6077
-  {
6078
-    $CPAN::Meta::YAML::VERSION = '0.008';
6079
-  }
6080
-  
6081
-  use strict;
6082
-  
6083
-  # UTF Support?
6084
-  sub HAVE_UTF8 () { $] >= 5.007003 }
6085
-  BEGIN {
6086
-  	if ( HAVE_UTF8 ) {
6087
-  		# The string eval helps hide this from Test::MinimumVersion
6088
-  		eval "require utf8;";
6089
-  		die "Failed to load UTF-8 support" if $@;
6090
-  	}
6091
-  
6092
-  	# Class structure
6093
-  	require 5.004;
6094
-  	require Exporter;
6095
-  	require Carp;
6096
-  	@CPAN::Meta::YAML::ISA       = qw{ Exporter  };
6097
-  	@CPAN::Meta::YAML::EXPORT    = qw{ Load Dump };
6098
-  	@CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
6099
-  
6100
-  	# Error storage
6101
-  	$CPAN::Meta::YAML::errstr    = '';
6102
-  }
6103
-  
6104
-  # The character class of all characters we need to escape
6105
-  # NOTE: Inlined, since it's only used once
6106
-  # my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
6107
-  
6108
-  # Printed form of the unprintable characters in the lowest range
6109
-  # of ASCII characters, listed by ASCII ordinal position.
6110
-  my @UNPRINTABLE = qw(
6111
-  	z    x01  x02  x03  x04  x05  x06  a
6112
-  	x08  t    n    v    f    r    x0e  x0f
6113
-  	x10  x11  x12  x13  x14  x15  x16  x17
6114
-  	x18  x19  x1a  e    x1c  x1d  x1e  x1f
6115
-  );
6116
-  
6117
-  # Printable characters for escapes
6118
-  my %UNESCAPES = (
6119
-  	z => "\x00", a => "\x07", t    => "\x09",
6120
-  	n => "\x0a", v => "\x0b", f    => "\x0c",
6121
-  	r => "\x0d", e => "\x1b", '\\' => '\\',
6122
-  );
6123
-  
6124
-  # Special magic boolean words
6125
-  my %QUOTE = map { $_ => 1 } qw{
6126
-  	null Null NULL
6127
-  	y Y yes Yes YES n N no No NO
6128
-  	true True TRUE false False FALSE
6129
-  	on On ON off Off OFF
6130
-  };
6131
-  
6132
-  
6133
-  
6134
-  
6135
-  
6136
-  #####################################################################
6137
-  # Implementation
6138
-  
6139
-  # Create an empty CPAN::Meta::YAML object
6140
-  sub new {
6141
-  	my $class = shift;
6142
-  	bless [ @_ ], $class;
6143
-  }
6144
-  
6145
-  # Create an object from a file
6146
-  sub read {
6147
-  	my $class = ref $_[0] ? ref shift : shift;
6148
-  
6149
-  	# Check the file
6150
-  	my $file = shift or return $class->_error( 'You did not specify a file name' );
6151
-  	return $class->_error( "File '$file' does not exist" )              unless -e $file;
6152
-  	return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
6153
-  	return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
6154
-  
6155
-  	# Slurp in the file
6156
-  	local $/ = undef;
6157
-  	local *CFG;
6158
-  	unless ( open(CFG, $file) ) {
6159
-  		return $class->_error("Failed to open file '$file': $!");
6160
-  	}
6161
-  	my $contents = <CFG>;
6162
-  	unless ( close(CFG) ) {
6163
-  		return $class->_error("Failed to close file '$file': $!");
6164
-  	}
6165
-  
6166
-  	$class->read_string( $contents );
6167
-  }
6168
-  
6169
-  # Create an object from a string
6170
-  sub read_string {
6171
-  	my $class  = ref $_[0] ? ref shift : shift;
6172
-  	my $self   = bless [], $class;
6173
-  	my $string = $_[0];
6174
-  	eval {
6175
-  		unless ( defined $string ) {
6176
-  			die \"Did not provide a string to load";
6177
-  		}
6178
-  
6179
-  		# Byte order marks
6180
-  		# NOTE: Keeping this here to educate maintainers
6181
-  		# my %BOM = (
6182
-  		#     "\357\273\277" => 'UTF-8',
6183
-  		#     "\376\377"     => 'UTF-16BE',
6184
-  		#     "\377\376"     => 'UTF-16LE',
6185
-  		#     "\377\376\0\0" => 'UTF-32LE'
6186
-  		#     "\0\0\376\377" => 'UTF-32BE',
6187
-  		# );
6188
-  		if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
6189
-  			die \"Stream has a non UTF-8 BOM";
6190
-  		} else {
6191
-  			# Strip UTF-8 bom if found, we'll just ignore it
6192
-  			$string =~ s/^\357\273\277//;
6193
-  		}
6194
-  
6195
-  		# Try to decode as utf8
6196
-  		utf8::decode($string) if HAVE_UTF8;
6197
-  
6198
-  		# Check for some special cases
6199
-  		return $self unless length $string;
6200
-  		unless ( $string =~ /[\012\015]+\z/ ) {
6201
-  			die \"Stream does not end with newline character";
6202
-  		}
6203
-  
6204
-  		# Split the file into lines
6205
-  		my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
6206
-  			    split /(?:\015{1,2}\012|\015|\012)/, $string;
6207
-  
6208
-  		# Strip the initial YAML header
6209
-  		@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
6210
-  
6211
-  		# A nibbling parser
6212
-  		while ( @lines ) {
6213
-  			# Do we have a document header?
6214
-  			if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
6215
-  				# Handle scalar documents
6216
-  				shift @lines;
6217
-  				if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
6218
-  					push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
6219
-  					next;
6220
-  				}
6221
-  			}
6222
-  
6223
-  			if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
6224
-  				# A naked document
6225
-  				push @$self, undef;
6226
-  				while ( @lines and $lines[0] !~ /^---/ ) {
6227
-  					shift @lines;
6228
-  				}
6229
-  
6230
-  			} elsif ( $lines[0] =~ /^\s*\-/ ) {
6231
-  				# An array at the root
6232
-  				my $document = [ ];
6233
-  				push @$self, $document;
6234
-  				$self->_read_array( $document, [ 0 ], \@lines );
6235
-  
6236
-  			} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
6237
-  				# A hash at the root
6238
-  				my $document = { };
6239
-  				push @$self, $document;
6240
-  				$self->_read_hash( $document, [ length($1) ], \@lines );
6241
-  
6242
-  			} else {
6243
-  				die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
6244
-  			}
6245
-  		}
6246
-  	};
6247
-  	if ( ref $@ eq 'SCALAR' ) {
6248
-  		return $self->_error(${$@});
6249
-  	} elsif ( $@ ) {
6250
-  		require Carp;
6251
-  		Carp::croak($@);
6252
-  	}
6253
-  
6254
-  	return $self;
6255
-  }
6256
-  
6257
-  # Deparse a scalar string to the actual scalar
6258
-  sub _read_scalar {
6259
-  	my ($self, $string, $indent, $lines) = @_;
6260
-  
6261
-  	# Trim trailing whitespace
6262
-  	$string =~ s/\s*\z//;
6263
-  
6264
-  	# Explitic null/undef
6265
-  	return undef if $string eq '~';
6266
-  
6267
-  	# Single quote
6268
-  	if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
6269
-  		return '' unless defined $1;
6270
-  		$string = $1;
6271
-  		$string =~ s/\'\'/\'/g;
6272
-  		return $string;
6273
-  	}
6274
-  
6275
-  	# Double quote.
6276
-  	# The commented out form is simpler, but overloaded the Perl regex
6277
-  	# engine due to recursion and backtracking problems on strings
6278
-  	# larger than 32,000ish characters. Keep it for reference purposes.
6279
-  	# if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
6280
-  	if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
6281
-  		# Reusing the variable is a little ugly,
6282
-  		# but avoids a new variable and a string copy.
6283
-  		$string = $1;
6284
-  		$string =~ s/\\"/"/g;
6285
-  		$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
6286
-  		return $string;
6287
-  	}
6288
-  
6289
-  	# Special cases
6290
-  	if ( $string =~ /^[\'\"!&]/ ) {
6291
-  		die \"CPAN::Meta::YAML does not support a feature in line '$string'";
6292
-  	}
6293
-  	return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
6294
-  	return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
6295
-  
6296
-  	# Regular unquoted string
6297
-  	if ( $string !~ /^[>|]/ ) {
6298
-  		if (
6299
-  			$string =~ /^(?:-(?:\s|$)|[\@\%\`])/
6300
-  			or
6301
-  			$string =~ /:(?:\s|$)/
6302
-  		) {
6303
-  			die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
6304
-  		}
6305
-  		$string =~ s/\s+#.*\z//;
6306
-  		return $string;
6307
-  	}
6308
-  
6309
-  	# Error
6310
-  	die \"CPAN::Meta::YAML failed to find multi-line scalar content" unless @$lines;
6311
-  
6312
-  	# Check the indent depth
6313
-  	$lines->[0]   =~ /^(\s*)/;
6314
-  	$indent->[-1] = length("$1");
6315
-  	if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
6316
-  		die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
6317
-  	}
6318
-  
6319
-  	# Pull the lines
6320
-  	my @multiline = ();
6321
-  	while ( @$lines ) {
6322
-  		$lines->[0] =~ /^(\s*)/;
6323
-  		last unless length($1) >= $indent->[-1];
6324
-  		push @multiline, substr(shift(@$lines), length($1));
6325
-  	}
6326
-  
6327
-  	my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
6328
-  	my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
6329
-  	return join( $j, @multiline ) . $t;
6330
-  }
6331
-  
6332
-  # Parse an array
6333
-  sub _read_array {
6334
-  	my ($self, $array, $indent, $lines) = @_;
6335
-  
6336
-  	while ( @$lines ) {
6337
-  		# Check for a new document
6338
-  		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
6339
-  			while ( @$lines and $lines->[0] !~ /^---/ ) {
6340
-  				shift @$lines;
6341
-  			}
6342
-  			return 1;
6343
-  		}
6344
-  
6345
-  		# Check the indent level
6346
-  		$lines->[0] =~ /^(\s*)/;
6347
-  		if ( length($1) < $indent->[-1] ) {
6348
-  			return 1;
6349
-  		} elsif ( length($1) > $indent->[-1] ) {
6350
-  			die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
6351
-  		}
6352
-  
6353
-  		if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
6354
-  			# Inline nested hash
6355
-  			my $indent2 = length("$1");
6356
-  			$lines->[0] =~ s/-/ /;
6357
-  			push @$array, { };
6358
-  			$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
6359
-  
6360
-  		} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
6361
-  			# Array entry with a value
6362
-  			shift @$lines;
6363
-  			push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
6364
-  
6365
-  		} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
6366
-  			shift @$lines;
6367
-  			unless ( @$lines ) {
6368
-  				push @$array, undef;
6369
-  				return 1;
6370
-  			}
6371
-  			if ( $lines->[0] =~ /^(\s*)\-/ ) {
6372
-  				my $indent2 = length("$1");
6373
-  				if ( $indent->[-1] == $indent2 ) {
6374
-  					# Null array entry
6375
-  					push @$array, undef;
6376
-  				} else {
6377
-  					# Naked indenter
6378
-  					push @$array, [ ];
6379
-  					$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
6380
-  				}
6381
-  
6382
-  			} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
6383
-  				push @$array, { };
6384
-  				$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
6385
-  
6386
-  			} else {
6387
-  				die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
6388
-  			}
6389
-  
6390
-  		} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
6391
-  			# This is probably a structure like the following...
6392
-  			# ---
6393
-  			# foo:
6394
-  			# - list
6395
-  			# bar: value
6396
-  			#
6397
-  			# ... so lets return and let the hash parser handle it
6398
-  			return 1;
6399
-  
6400
-  		} else {
6401
-  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
6402
-  		}
6403
-  	}
6404
-  
6405
-  	return 1;
6406
-  }
6407
-  
6408
-  # Parse an array
6409
-  sub _read_hash {
6410
-  	my ($self, $hash, $indent, $lines) = @_;
6411
-  
6412
-  	while ( @$lines ) {
6413
-  		# Check for a new document
6414
-  		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
6415
-  			while ( @$lines and $lines->[0] !~ /^---/ ) {
6416
-  				shift @$lines;
6417
-  			}
6418
-  			return 1;
6419
-  		}
6420
-  
6421
-  		# Check the indent level
6422
-  		$lines->[0] =~ /^(\s*)/;
6423
-  		if ( length($1) < $indent->[-1] ) {
6424
-  			return 1;
6425
-  		} elsif ( length($1) > $indent->[-1] ) {
6426
-  			die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
6427
-  		}
6428
-  
6429
-  		# Get the key
6430
-  		unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
6431
-  			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
6432
-  				die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
6433
-  			}
6434
-  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
6435
-  		}
6436
-  		my $key = $1;
6437
-  
6438
-  		# Do we have a value?
6439
-  		if ( length $lines->[0] ) {
6440
-  			# Yes
6441
-  			$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
6442
-  		} else {
6443
-  			# An indent
6444
-  			shift @$lines;
6445
-  			unless ( @$lines ) {
6446
-  				$hash->{$key} = undef;
6447
-  				return 1;
6448
-  			}
6449
-  			if ( $lines->[0] =~ /^(\s*)-/ ) {
6450
-  				$hash->{$key} = [];
6451
-  				$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
6452
-  			} elsif ( $lines->[0] =~ /^(\s*)./ ) {
6453
-  				my $indent2 = length("$1");
6454
-  				if ( $indent->[-1] >= $indent2 ) {
6455
-  					# Null hash entry
6456
-  					$hash->{$key} = undef;
6457
-  				} else {
6458
-  					$hash->{$key} = {};
6459
-  					$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
6460
-  				}
6461
-  			}
6462
-  		}
6463
-  	}
6464
-  
6465
-  	return 1;
6466
-  }
6467
-  
6468
-  # Save an object to a file
6469
-  sub write {
6470
-  	my $self = shift;
6471
-  	my $file = shift or return $self->_error('No file name provided');
6472
-  
6473
-  	# Write it to the file
6474
-  	open( CFG, '>' . $file ) or return $self->_error(
6475
-  		"Failed to open file '$file' for writing: $!"
6476
-  		);
6477
-  	print CFG $self->write_string;
6478
-  	close CFG;
6479
-  
6480
-  	return 1;
6481
-  }
6482
-  
6483
-  # Save an object to a string
6484
-  sub write_string {
6485
-  	my $self = shift;
6486
-  	return '' unless @$self;
6487
-  
6488
-  	# Iterate over the documents
6489
-  	my $indent = 0;
6490
-  	my @lines  = ();
6491
-  	foreach my $cursor ( @$self ) {
6492
-  		push @lines, '---';
6493
-  
6494
-  		# An empty document
6495
-  		if ( ! defined $cursor ) {
6496
-  			# Do nothing
6497
-  
6498
-  		# A scalar document
6499
-  		} elsif ( ! ref $cursor ) {
6500
-  			$lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
6501
-  
6502
-  		# A list at the root
6503
-  		} elsif ( ref $cursor eq 'ARRAY' ) {
6504
-  			unless ( @$cursor ) {
6505
-  				$lines[-1] .= ' []';
6506
-  				next;
6507
-  			}
6508
-  			push @lines, $self->_write_array( $cursor, $indent, {} );
6509
-  
6510
-  		# A hash at the root
6511
-  		} elsif ( ref $cursor eq 'HASH' ) {
6512
-  			unless ( %$cursor ) {
6513
-  				$lines[-1] .= ' {}';
6514
-  				next;
6515
-  			}
6516
-  			push @lines, $self->_write_hash( $cursor, $indent, {} );
6517
-  
6518
-  		} else {
6519
-  			Carp::croak("Cannot serialize " . ref($cursor));
6520
-  		}
6521
-  	}
6522
-  
6523
-  	join '', map { "$_\n" } @lines;
6524
-  }
6525
-  
6526
-  sub _write_scalar {
6527
-  	my $string = $_[1];
6528
-  	return '~'  unless defined $string;
6529
-  	return "''" unless length  $string;
6530
-  	if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
6531
-  		$string =~ s/\\/\\\\/g;
6532
-  		$string =~ s/"/\\"/g;
6533
-  		$string =~ s/\n/\\n/g;
6534
-  		$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
6535
-  		return qq|"$string"|;
6536
-  	}
6537
-  	if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
6538
-  		return "'$string'";
6539
-  	}
6540
-  	return $string;
6541
-  }
6542
-  
6543
-  sub _write_array {
6544
-  	my ($self, $array, $indent, $seen) = @_;
6545
-  	if ( $seen->{refaddr($array)}++ ) {
6546
-  		die "CPAN::Meta::YAML does not support circular references";
6547
-  	}
6548
-  	my @lines  = ();
6549
-  	foreach my $el ( @$array ) {
6550
-  		my $line = ('  ' x $indent) . '-';
6551
-  		my $type = ref $el;
6552
-  		if ( ! $type ) {
6553
-  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
6554
-  			push @lines, $line;
6555
-  
6556
-  		} elsif ( $type eq 'ARRAY' ) {
6557
-  			if ( @$el ) {
6558
-  				push @lines, $line;
6559
-  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
6560
-  			} else {
6561
-  				$line .= ' []';
6562
-  				push @lines, $line;
6563
-  			}
6564
-  
6565
-  		} elsif ( $type eq 'HASH' ) {
6566
-  			if ( keys %$el ) {
6567
-  				push @lines, $line;
6568
-  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
6569
-  			} else {
6570
-  				$line .= ' {}';
6571
-  				push @lines, $line;
6572
-  			}
6573
-  
6574
-  		} else {
6575
-  			die "CPAN::Meta::YAML does not support $type references";
6576
-  		}
6577
-  	}
6578
-  
6579
-  	@lines;
6580
-  }
6581
-  
6582
-  sub _write_hash {
6583
-  	my ($self, $hash, $indent, $seen) = @_;
6584
-  	if ( $seen->{refaddr($hash)}++ ) {
6585
-  		die "CPAN::Meta::YAML does not support circular references";
6586
-  	}
6587
-  	my @lines  = ();
6588
-  	foreach my $name ( sort keys %$hash ) {
6589
-  		my $el   = $hash->{$name};
6590
-  		my $line = ('  ' x $indent) . "$name:";
6591
-  		my $type = ref $el;
6592
-  		if ( ! $type ) {
6593
-  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
6594
-  			push @lines, $line;
6595
-  
6596
-  		} elsif ( $type eq 'ARRAY' ) {
6597
-  			if ( @$el ) {
6598
-  				push @lines, $line;
6599
-  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
6600
-  			} else {
6601
-  				$line .= ' []';
6602
-  				push @lines, $line;
6603
-  			}
6604
-  
6605
-  		} elsif ( $type eq 'HASH' ) {
6606
-  			if ( keys %$el ) {
6607
-  				push @lines, $line;
6608
-  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
6609
-  			} else {
6610
-  				$line .= ' {}';
6611
-  				push @lines, $line;
6612
-  			}
6613
-  
6614
-  		} else {
6615
-  			die "CPAN::Meta::YAML does not support $type references";
6616
-  		}
6617
-  	}
6618
-  
6619
-  	@lines;
6620
-  }
6621
-  
6622
-  # Set error
6623
-  sub _error {
6624
-  	$CPAN::Meta::YAML::errstr = $_[1];
6625
-  	undef;
6626
-  }
6627
-  
6628
-  # Retrieve error
6629
-  sub errstr {
6630
-  	$CPAN::Meta::YAML::errstr;
6631
-  }
6632
-  
6633
-  
6634
-  
6635
-  
6636
-  
6637
-  #####################################################################
6638
-  # YAML Compatibility
6639
-  
6640
-  sub Dump {
6641
-  	CPAN::Meta::YAML->new(@_)->write_string;
6642
-  }
6643
-  
6644
-  sub Load {
6645
-  	my $self = CPAN::Meta::YAML->read_string(@_);
6646
-  	unless ( $self ) {
6647
-  		Carp::croak("Failed to load YAML document from string");
6648
-  	}
6649
-  	if ( wantarray ) {
6650
-  		return @$self;
6651
-  	} else {
6652
-  		# To match YAML.pm, return the last document
6653
-  		return $self->[-1];
6654
-  	}
6655
-  }
6656
-  
6657
-  BEGIN {
6658
-  	*freeze = *Dump;
6659
-  	*thaw   = *Load;
6660
-  }
6661
-  
6662
-  sub DumpFile {
6663
-  	my $file = shift;
6664
-  	CPAN::Meta::YAML->new(@_)->write($file);
6665
-  }
6666
-  
6667
-  sub LoadFile {
6668
-  	my $self = CPAN::Meta::YAML->read($_[0]);
6669
-  	unless ( $self ) {
6670
-  		Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
6671
-  	}
6672
-  	if ( wantarray ) {
6673
-  		return @$self;
6674
-  	} else {
6675
-  		# Return only the last document to match YAML.pm, 
6676
-  		return $self->[-1];
6677
-  	}
6678
-  }
6679
-  
6680
-  
6681
-  
6682
-  
6683
-  
6684
-  #####################################################################
6685
-  # Use Scalar::Util if possible, otherwise emulate it
6686
-  
6687
-  BEGIN {
6688
-  	local $@;
6689
-  	eval {
6690
-  		require Scalar::Util;
6691
-  	};
6692
-  	my $v = eval("$Scalar::Util::VERSION") || 0;
6693
-  	if ( $@ or $v < 1.18 ) {
6694
-  		eval <<'END_PERL';
6695
-  # Scalar::Util failed to load or too old
6696
-  sub refaddr {
6697
-  	my $pkg = ref($_[0]) or return undef;
6698
-  	if ( !! UNIVERSAL::can($_[0], 'can') ) {
6699
-  		bless $_[0], 'Scalar::Util::Fake';
6700
-  	} else {
6701
-  		$pkg = undef;
6702
-  	}
6703
-  	"$_[0]" =~ /0x(\w+)/;
6704
-  	my $i = do { local $^W; hex $1 };
6705
-  	bless $_[0], $pkg if defined $pkg;
6706
-  	$i;
6707
-  }
6708
-  END_PERL
6709
-  	} else {
6710
-  		*refaddr = *Scalar::Util::refaddr;
6711
-  	}
6712
-  }
6713
-  
6714
-  1;
6715
-  
6716
-  
6717
-  
6718
-  
6719
-  __END__
6720
-  
6721
-  
6722
-  # ABSTRACT: Read and write a subset of YAML for CPAN Meta files
6723
-  
6724
-  
6725
-CPAN_META_YAML
6726
-
6727
-$fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
6728
-  use strict;
6729
-  use warnings;
6730
-  package File::pushd;
6731
-  # ABSTRACT: change directory temporarily for a limited scope
6732
-  our $VERSION = '1.004'; # VERSION
6733
-  
6734
-  our @EXPORT  = qw( pushd tempd );
6735
-  our @ISA     = qw( Exporter );
6736
-  
6737
-  use Exporter;
6738
-  use Carp;
6739
-  use Cwd         qw( cwd abs_path );
6740
-  use File::Path  qw( rmtree );
6741
-  use File::Temp  qw();
6742
-  use File::Spec;
6743
-  
6744
-  use overload
6745
-      q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
6746
-      fallback => 1;
6747
-  
6748
-  #--------------------------------------------------------------------------#
6749
-  # pushd()
6750
-  #--------------------------------------------------------------------------#
6751
-  
6752
-  sub pushd {
6753
-      my ($target_dir, $options) = @_;
6754
-      $options->{untaint_pattern} ||= qr{^([-+@\w./]+)$};
6755
-  
6756
-      my $tainted_orig = cwd;
6757
-      my $orig;
6758
-      if ( $tainted_orig =~ $options->{untaint_pattern} ) {
6759
-        $orig = $1;
6760
-      }
6761
-      else {
6762
-        $orig = $tainted_orig;
6763
-      }
6764
-  
6765
-      my $tainted_dest;
6766
-      eval { $tainted_dest   = $target_dir ? abs_path( $target_dir ) : $orig };
6767
-      croak "Can't locate directory $target_dir: $@" if $@;
6768
-  
6769
-      my $dest;
6770
-      if ( $tainted_dest =~ $options->{untaint_pattern} ) {
6771
-        $dest = $1;
6772
-      }
6773
-      else {
6774
-        $dest = $tainted_dest;
6775
-      }
6776
-  
6777
-      if ($dest ne $orig) {
6778
-          chdir $dest or croak "Can't chdir to $dest\: $!";
6779
-      }
6780
-  
6781
-      my $self = bless {
6782
-          _pushd => $dest,
6783
-          _original => $orig
6784
-      }, __PACKAGE__;
6785
-  
6786
-      return $self;
6787
-  }
6788
-  
6789
-  #--------------------------------------------------------------------------#
6790
-  # tempd()
6791
-  #--------------------------------------------------------------------------#
6792
-  
6793
-  sub tempd {
6794
-      my ($options) = @_;
6795
-      my $dir;
6796
-      eval { $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ), $options ) };
6797
-      croak $@ if $@;
6798
-      $dir->{_tempd} = 1;
6799
-      return $dir;
6800
-  }
6801
-  
6802
-  #--------------------------------------------------------------------------#
6803
-  # preserve()
6804
-  #--------------------------------------------------------------------------#
6805
-  
6806
-  sub preserve {
6807
-      my $self = shift;
6808
-      return 1 if ! $self->{"_tempd"};
6809
-      if ( @_ == 0 ) {
6810
-          return $self->{_preserve} = 1;
6811
-      }
6812
-      else {
6813
-          return $self->{_preserve} = $_[0] ? 1 : 0;
6814
-      }
6815
-  }
6816
-  
6817
-  #--------------------------------------------------------------------------#
6818
-  # DESTROY()
6819
-  # Revert to original directory as object is destroyed and cleanup
6820
-  # if necessary
6821
-  #--------------------------------------------------------------------------#
6822
-  
6823
-  sub DESTROY {
6824
-      my ($self) = @_;
6825
-      my $orig = $self->{_original};
6826
-      chdir $orig if $orig; # should always be so, but just in case...
6827
-      if ( $self->{_tempd} &&
6828
-          !$self->{_preserve} ) {
6829
-          # don't destroy existing $@ if there is no error.
6830
-          my $err = do {
6831
-              local $@;
6832
-              eval { rmtree( $self->{_pushd} ) };
6833
-              $@;
6834
-          };
6835
-          carp $err if $err;
6836
-      }
6837
-  }
6838
-  
6839
-  1;
6840
-  
6841
-  __END__
6842
-  
6843
-FILE_PUSHD
6844
-
6845
-$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
6846
-  # vim: ts=4 sts=4 sw=4 et:
6847
-  package HTTP::Tiny;
6848
-  use strict;
6849
-  use warnings;
6850
-  # ABSTRACT: A small, simple, correct HTTP/1.1 client
6851
-  our $VERSION = '0.028'; # VERSION
6852
-  
6853
-  use Carp ();
6854
-  
6855
-  
6856
-  my @attributes;
6857
-  BEGIN {
6858
-      @attributes = qw(agent cookie_jar default_headers local_address max_redirect max_size proxy timeout SSL_options verify_SSL);
6859
-      no strict 'refs';
6860
-      for my $accessor ( @attributes ) {
6861
-          *{$accessor} = sub {
6862
-              @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
6863
-          };
6864
-      }
6865
-  }
6866
-  
6867
-  sub new {
6868
-      my($class, %args) = @_;
6869
-  
6870
-      (my $default_agent = $class) =~ s{::}{-}g;
6871
-      $default_agent .= "/" . ($class->VERSION || 0);
6872
-  
6873
-      my $self = {
6874
-          agent        => $default_agent,
6875
-          max_redirect => 5,
6876
-          timeout      => 60,
6877
-          verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
6878
-      };
6879
-  
6880
-      $args{agent} .= $default_agent
6881
-          if defined $args{agent} && $args{agent} =~ / $/;
6882
-  
6883
-      $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
6884
-  
6885
-      for my $key ( @attributes ) {
6886
-          $self->{$key} = $args{$key} if exists $args{$key}
6887
-      }
6888
-  
6889
-      # Never override proxy argument as this breaks backwards compat.
6890
-      if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
6891
-          if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
6892
-              $self->{proxy} = $http_proxy;
6893
-          }
6894
-          else {
6895
-              Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
6896
-          }
6897
-      }
6898
-  
6899
-      return bless $self, $class;
6900
-  }
6901
-  
6902
-  
6903
-  for my $sub_name ( qw/get head put post delete/ ) {
6904
-      my $req_method = uc $sub_name;
6905
-      no strict 'refs';
6906
-      eval <<"HERE"; ## no critic
6907
-      sub $sub_name {
6908
-          my (\$self, \$url, \$args) = \@_;
6909
-          \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
6910
-          or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
6911
-          return \$self->request('$req_method', \$url, \$args || {});
6912
-      }
6913
-  HERE
6914
-  }
6915
-  
6916
-  
6917
-  sub post_form {
6918
-      my ($self, $url, $data, $args) = @_;
6919
-      (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
6920
-          or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
6921
-  
6922
-      my $headers = {};
6923
-      while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
6924
-          $headers->{lc $key} = $value;
6925
-      }
6926
-      delete $args->{headers};
6927
-  
6928
-      return $self->request('POST', $url, {
6929
-              %$args,
6930
-              content => $self->www_form_urlencode($data),
6931
-              headers => {
6932
-                  %$headers,
6933
-                  'content-type' => 'application/x-www-form-urlencoded'
6934
-              },
6935
-          }
6936
-      );
6937
-  }
6938
-  
6939
-  
6940
-  sub mirror {
6941
-      my ($self, $url, $file, $args) = @_;
6942
-      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
6943
-        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
6944
-      if ( -e $file and my $mtime = (stat($file))[9] ) {
6945
-          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
6946
-      }
6947
-      my $tempfile = $file . int(rand(2**31));
6948
-      open my $fh, ">", $tempfile
6949
-          or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!\n/);
6950
-      binmode $fh;
6951
-      $args->{data_callback} = sub { print {$fh} $_[0] };
6952
-      my $response = $self->request('GET', $url, $args);
6953
-      close $fh
6954
-          or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!\n/);
6955
-      if ( $response->{success} ) {
6956
-          rename $tempfile, $file
6957
-              or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
6958
-          my $lm = $response->{headers}{'last-modified'};
6959
-          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
6960
-              utime $mtime, $mtime, $file;
6961
-          }
6962
-      }
6963
-      $response->{success} ||= $response->{status} eq '304';
6964
-      unlink $tempfile;
6965
-      return $response;
6966
-  }
6967
-  
6968
-  
6969
-  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
6970
-  
6971
-  sub request {
6972
-      my ($self, $method, $url, $args) = @_;
6973
-      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
6974
-        or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
6975
-      $args ||= {}; # we keep some state in this during _request
6976
-  
6977
-      # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
6978
-      my $response;
6979
-      for ( 0 .. 1 ) {
6980
-          $response = eval { $self->_request($method, $url, $args) };
6981
-          last unless $@ && $idempotent{$method}
6982
-              && $@ =~ m{^(?:Socket closed|Unexpected end)};
6983
-      }
6984
-  
6985
-      if (my $e = "$@") {
6986
-          $response = {
6987
-              url     => $url,
6988
-              success => q{},
6989
-              status  => 599,
6990
-              reason  => 'Internal Exception',
6991
-              content => $e,
6992
-              headers => {
6993
-                  'content-type'   => 'text/plain',
6994
-                  'content-length' => length $e,
6995
-              }
6996
-          };
6997
-      }
6998
-      return $response;
6999
-  }
7000
-  
7001
-  
7002
-  sub www_form_urlencode {
7003
-      my ($self, $data) = @_;
7004
-      (@_ == 2 && ref $data)
7005
-          or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
7006
-      (ref $data eq 'HASH' || ref $data eq 'ARRAY')
7007
-          or Carp::croak("form data must be a hash or array reference\n");
7008
-  
7009
-      my @params = ref $data eq 'HASH' ? %$data : @$data;
7010
-      @params % 2 == 0
7011
-          or Carp::croak("form data reference must have an even number of terms\n");
7012
-  
7013
-      my @terms;
7014
-      while( @params ) {
7015
-          my ($key, $value) = splice(@params, 0, 2);
7016
-          if ( ref $value eq 'ARRAY' ) {
7017
-              unshift @params, map { $key => $_ } @$value;
7018
-          }
7019
-          else {
7020
-              push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
7021
-          }
7022
-      }
7023
-  
7024
-      return join("&", sort @terms);
7025
-  }
7026
-  
7027
-  #--------------------------------------------------------------------------#
7028
-  # private methods
7029
-  #--------------------------------------------------------------------------#
7030
-  
7031
-  my %DefaultPort = (
7032
-      http => 80,
7033
-      https => 443,
7034
-  );
7035
-  
7036
-  sub _request {
7037
-      my ($self, $method, $url, $args) = @_;
7038
-  
7039
-      my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
7040
-  
7041
-      my $request = {
7042
-          method    => $method,
7043
-          scheme    => $scheme,
7044
-          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
7045
-          uri       => $path_query,
7046
-          headers   => {},
7047
-      };
7048
-  
7049
-      my $handle  = HTTP::Tiny::Handle->new(
7050
-          timeout         => $self->{timeout},
7051
-          SSL_options     => $self->{SSL_options},
7052
-          verify_SSL      => $self->{verify_SSL},
7053
-          local_address   => $self->{local_address},
7054
-      );
7055
-  
7056
-      if ($self->{proxy}) {
7057
-          $request->{uri} = "$scheme://$request->{host_port}$path_query";
7058
-          die(qq/HTTPS via proxy is not supported\n/)
7059
-              if $request->{scheme} eq 'https';
7060
-          $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
7061
-      }
7062
-      else {
7063
-          $handle->connect($scheme, $host, $port);
7064
-      }
7065
-  
7066
-      $self->_prepare_headers_and_cb($request, $args, $url);
7067
-      $handle->write_request($request);
7068
-  
7069
-      my $response;
7070
-      do { $response = $handle->read_response_header }
7071
-          until (substr($response->{status},0,1) ne '1');
7072
-  
7073
-      $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
7074
-  
7075
-      if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
7076
-          $handle->close;
7077
-          return $self->_request(@redir_args, $args);
7078
-      }
7079
-  
7080
-      if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
7081
-          # response has no message body
7082
-      }
7083
-      else {
7084
-          my $data_cb = $self->_prepare_data_cb($response, $args);
7085
-          $handle->read_body($data_cb, $response);
7086
-      }
7087
-  
7088
-      $handle->close;
7089
-      $response->{success} = substr($response->{status},0,1) eq '2';
7090
-      $response->{url} = $url;
7091
-      return $response;
7092
-  }
7093
-  
7094
-  sub _prepare_headers_and_cb {
7095
-      my ($self, $request, $args, $url) = @_;
7096
-  
7097
-      for ($self->{default_headers}, $args->{headers}) {
7098
-          next unless defined;
7099
-          while (my ($k, $v) = each %$_) {
7100
-              $request->{headers}{lc $k} = $v;
7101
-          }
7102
-      }
7103
-      $request->{headers}{'host'}         = $request->{host_port};
7104
-      $request->{headers}{'connection'}   = "close";
7105
-      $request->{headers}{'user-agent'} ||= $self->{agent};
7106
-  
7107
-      if (defined $args->{content}) {
7108
-          $request->{headers}{'content-type'} ||= "application/octet-stream";
7109
-          if (ref $args->{content} eq 'CODE') {
7110
-              $request->{headers}{'transfer-encoding'} = 'chunked'
7111
-                unless $request->{headers}{'content-length'}
7112
-                    || $request->{headers}{'transfer-encoding'};
7113
-              $request->{cb} = $args->{content};
7114
-          }
7115
-          else {
7116
-              my $content = $args->{content};
7117
-              if ( $] ge '5.008' ) {
7118
-                  utf8::downgrade($content, 1)
7119
-                      or die(qq/Wide character in request message body\n/);
7120
-              }
7121
-              $request->{headers}{'content-length'} = length $content
7122
-                unless $request->{headers}{'content-length'}
7123
-                    || $request->{headers}{'transfer-encoding'};
7124
-              $request->{cb} = sub { substr $content, 0, length $content, '' };
7125
-          }
7126
-          $request->{trailer_cb} = $args->{trailer_callback}
7127
-              if ref $args->{trailer_callback} eq 'CODE';
7128
-      }
7129
-  
7130
-      ### If we have a cookie jar, then maybe add relevant cookies
7131
-      if ( $self->{cookie_jar} ) {
7132
-          my $cookies = $self->cookie_jar->cookie_header( $url );
7133
-          $request->{headers}{cookie} = $cookies if length $cookies;
7134
-      }
7135
-  
7136
-      return;
7137
-  }
7138
-  
7139
-  sub _prepare_data_cb {
7140
-      my ($self, $response, $args) = @_;
7141
-      my $data_cb = $args->{data_callback};
7142
-      $response->{content} = '';
7143
-  
7144
-      if (!$data_cb || $response->{status} !~ /^2/) {
7145
-          if (defined $self->{max_size}) {
7146
-              $data_cb = sub {
7147
-                  $_[1]->{content} .= $_[0];
7148
-                  die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
7149
-                    if length $_[1]->{content} > $self->{max_size};
7150
-              };
7151
-          }
7152
-          else {
7153
-              $data_cb = sub { $_[1]->{content} .= $_[0] };
7154
-          }
7155
-      }
7156
-      return $data_cb;
7157
-  }
7158
-  
7159
-  sub _update_cookie_jar {
7160
-      my ($self, $url, $response) = @_;
7161
-  
7162
-      my $cookies = $response->{headers}->{'set-cookie'};
7163
-      return unless defined $cookies;
7164
-  
7165
-      my @cookies = ref $cookies ? @$cookies : $cookies;
7166
-  
7167
-      $self->cookie_jar->add( $url, $_ ) for @cookies;
7168
-  
7169
-      return;
7170
-  }
7171
-  
7172
-  sub _validate_cookie_jar {
7173
-      my ($class, $jar) = @_;
7174
-  
7175
-      # duck typing
7176
-      for my $method ( qw/add cookie_header/ ) {
7177
-          Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
7178
-              unless ref($jar) && ref($jar)->can($method);
7179
-      }
7180
-  
7181
-      return;
7182
-  }
7183
-  
7184
-  sub _maybe_redirect {
7185
-      my ($self, $request, $response, $args) = @_;
7186
-      my $headers = $response->{headers};
7187
-      my ($status, $method) = ($response->{status}, $request->{method});
7188
-      if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
7189
-          and $headers->{location}
7190
-          and ++$args->{redirects} <= $self->{max_redirect}
7191
-      ) {
7192
-          my $location = ($headers->{location} =~ /^\//)
7193
-              ? "$request->{scheme}://$request->{host_port}$headers->{location}"
7194
-              : $headers->{location} ;
7195
-          return (($status eq '303' ? 'GET' : $method), $location);
7196
-      }
7197
-      return;
7198
-  }
7199
-  
7200
-  sub _split_url {
7201
-      my $url = pop;
7202
-  
7203
-      # URI regex adapted from the URI module
7204
-      my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
7205
-        or die(qq/Cannot parse URL: '$url'\n/);
7206
-  
7207
-      $scheme     = lc $scheme;
7208
-      $path_query = "/$path_query" unless $path_query =~ m<\A/>;
7209
-  
7210
-      my $host = (length($authority)) ? lc $authority : 'localhost';
7211
-         $host =~ s/\A[^@]*@//;   # userinfo
7212
-      my $port = do {
7213
-         $host =~ s/:([0-9]*)\z// && length $1
7214
-           ? $1
7215
-           : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
7216
-      };
7217
-  
7218
-      return ($scheme, $host, $port, $path_query);
7219
-  }
7220
-  
7221
-  # Date conversions adapted from HTTP::Date
7222
-  my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
7223
-  my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
7224
-  sub _http_date {
7225
-      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
7226
-      return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
7227
-          substr($DoW,$wday*4,3),
7228
-          $mday, substr($MoY,$mon*4,3), $year+1900,
7229
-          $hour, $min, $sec
7230
-      );
7231
-  }
7232
-  
7233
-  sub _parse_http_date {
7234
-      my ($self, $str) = @_;
7235
-      require Time::Local;
7236
-      my @tl_parts;
7237
-      if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
7238
-          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
7239
-      }
7240
-      elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
7241
-          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
7242
-      }
7243
-      elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
7244
-          @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
7245
-      }
7246
-      return eval {
7247
-          my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
7248
-          $t < 0 ? undef : $t;
7249
-      };
7250
-  }
7251
-  
7252
-  # URI escaping adapted from URI::Escape
7253
-  # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
7254
-  # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
7255
-  my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
7256
-  $escapes{' '}="+";
7257
-  my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
7258
-  
7259
-  sub _uri_escape {
7260
-      my ($self, $str) = @_;
7261
-      if ( $] ge '5.008' ) {
7262
-          utf8::encode($str);
7263
-      }
7264
-      else {
7265
-          $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
7266
-              if ( length $str == do { use bytes; length $str } );
7267
-          $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
7268
-      }
7269
-      $str =~ s/($unsafe_char)/$escapes{$1}/ge;
7270
-      return $str;
7271
-  }
7272
-  
7273
-  package
7274
-      HTTP::Tiny::Handle; # hide from PAUSE/indexers
7275
-  use strict;
7276
-  use warnings;
7277
-  
7278
-  use Errno      qw[EINTR EPIPE];
7279
-  use IO::Socket qw[SOCK_STREAM];
7280
-  
7281
-  sub BUFSIZE () { 32768 } ## no critic
7282
-  
7283
-  my $Printable = sub {
7284
-      local $_ = shift;
7285
-      s/\r/\\r/g;
7286
-      s/\n/\\n/g;
7287
-      s/\t/\\t/g;
7288
-      s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
7289
-      $_;
7290
-  };
7291
-  
7292
-  my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
7293
-  
7294
-  sub new {
7295
-      my ($class, %args) = @_;
7296
-      return bless {
7297
-          rbuf             => '',
7298
-          timeout          => 60,
7299
-          max_line_size    => 16384,
7300
-          max_header_lines => 64,
7301
-          verify_SSL       => 0,
7302
-          SSL_options      => {},
7303
-          %args
7304
-      }, $class;
7305
-  }
7306
-  
7307
-  sub connect {
7308
-      @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
7309
-      my ($self, $scheme, $host, $port) = @_;
7310
-  
7311
-      if ( $scheme eq 'https' ) {
7312
-          die(qq/IO::Socket::SSL 1.56 must be installed for https support\n/)
7313
-              unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.56)};
7314
-          die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
7315
-              unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
7316
-      }
7317
-      elsif ( $scheme ne 'http' ) {
7318
-        die(qq/Unsupported URL scheme '$scheme'\n/);
7319
-      }
7320
-      $self->{fh} = 'IO::Socket::INET'->new(
7321
-          PeerHost  => $host,
7322
-          PeerPort  => $port,
7323
-          $self->{local_address} ?
7324
-              ( LocalAddr => $self->{local_address} ) : (),
7325
-          Proto     => 'tcp',
7326
-          Type      => SOCK_STREAM,
7327
-          Timeout   => $self->{timeout}
7328
-      ) or die(qq/Could not connect to '$host:$port': $@\n/);
7329
-  
7330
-      binmode($self->{fh})
7331
-        or die(qq/Could not binmode() socket: '$!'\n/);
7332
-  
7333
-      if ( $scheme eq 'https') {
7334
-          my $ssl_args = $self->_ssl_args($host);
7335
-          IO::Socket::SSL->start_SSL(
7336
-              $self->{fh},
7337
-              %$ssl_args,
7338
-              SSL_create_ctx_callback => sub {
7339
-                  my $ctx = shift;
7340
-                  Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
7341
-              },
7342
-          );
7343
-  
7344
-          unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
7345
-              my $ssl_err = IO::Socket::SSL->errstr;
7346
-              die(qq/SSL connection failed for $host: $ssl_err\n/);
7347
-          }
7348
-      }
7349
-  
7350
-      $self->{host} = $host;
7351
-      $self->{port} = $port;
7352
-  
7353
-      return $self;
7354
-  }
7355
-  
7356
-  sub close {
7357
-      @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
7358
-      my ($self) = @_;
7359
-      CORE::close($self->{fh})
7360
-        or die(qq/Could not close socket: '$!'\n/);
7361
-  }
7362
-  
7363
-  sub write {
7364
-      @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
7365
-      my ($self, $buf) = @_;
7366
-  
7367
-      if ( $] ge '5.008' ) {
7368
-          utf8::downgrade($buf, 1)
7369
-              or die(qq/Wide character in write()\n/);
7370
-      }
7371
-  
7372
-      my $len = length $buf;
7373
-      my $off = 0;
7374
-  
7375
-      local $SIG{PIPE} = 'IGNORE';
7376
-  
7377
-      while () {
7378
-          $self->can_write
7379
-            or die(qq/Timed out while waiting for socket to become ready for writing\n/);
7380
-          my $r = syswrite($self->{fh}, $buf, $len, $off);
7381
-          if (defined $r) {
7382
-              $len -= $r;
7383
-              $off += $r;
7384
-              last unless $len > 0;
7385
-          }
7386
-          elsif ($! == EPIPE) {
7387
-              die(qq/Socket closed by remote server: $!\n/);
7388
-          }
7389
-          elsif ($! != EINTR) {
7390
-              if ($self->{fh}->can('errstr')){
7391
-                  my $err = $self->{fh}->errstr();
7392
-                  die (qq/Could not write to SSL socket: '$err'\n /);
7393
-              }
7394
-              else {
7395
-                  die(qq/Could not write to socket: '$!'\n/);
7396
-              }
7397
-  
7398
-          }
7399
-      }
7400
-      return $off;
7401
-  }
7402
-  
7403
-  sub read {
7404
-      @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
7405
-      my ($self, $len, $allow_partial) = @_;
7406
-  
7407
-      my $buf  = '';
7408
-      my $got = length $self->{rbuf};
7409
-  
7410
-      if ($got) {
7411
-          my $take = ($got < $len) ? $got : $len;
7412
-          $buf  = substr($self->{rbuf}, 0, $take, '');
7413
-          $len -= $take;
7414
-      }
7415
-  
7416
-      while ($len > 0) {
7417
-          $self->can_read
7418
-            or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
7419
-          my $r = sysread($self->{fh}, $buf, $len, length $buf);
7420
-          if (defined $r) {
7421
-              last unless $r;
7422
-              $len -= $r;
7423
-          }
7424
-          elsif ($! != EINTR) {
7425
-              if ($self->{fh}->can('errstr')){
7426
-                  my $err = $self->{fh}->errstr();
7427
-                  die (qq/Could not read from SSL socket: '$err'\n /);
7428
-              }
7429
-              else {
7430
-                  die(qq/Could not read from socket: '$!'\n/);
7431
-              }
7432
-          }
7433
-      }
7434
-      if ($len && !$allow_partial) {
7435
-          die(qq/Unexpected end of stream\n/);
7436
-      }
7437
-      return $buf;
7438
-  }
7439
-  
7440
-  sub readline {
7441
-      @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
7442
-      my ($self) = @_;
7443
-  
7444
-      while () {
7445
-          if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
7446
-              return $1;
7447
-          }
7448
-          if (length $self->{rbuf} >= $self->{max_line_size}) {
7449
-              die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
7450
-          }
7451
-          $self->can_read
7452
-            or die(qq/Timed out while waiting for socket to become ready for reading\n/);
7453
-          my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
7454
-          if (defined $r) {
7455
-              last unless $r;
7456
-          }
7457
-          elsif ($! != EINTR) {
7458
-              if ($self->{fh}->can('errstr')){
7459
-                  my $err = $self->{fh}->errstr();
7460
-                  die (qq/Could not read from SSL socket: '$err'\n /);
7461
-              }
7462
-              else {
7463
-                  die(qq/Could not read from socket: '$!'\n/);
7464
-              }
7465
-          }
7466
-      }
7467
-      die(qq/Unexpected end of stream while looking for line\n/);
7468
-  }
7469
-  
7470
-  sub read_header_lines {
7471
-      @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
7472
-      my ($self, $headers) = @_;
7473
-      $headers ||= {};
7474
-      my $lines   = 0;
7475
-      my $val;
7476
-  
7477
-      while () {
7478
-           my $line = $self->readline;
7479
-  
7480
-           if (++$lines >= $self->{max_header_lines}) {
7481
-               die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
7482
-           }
7483
-           elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
7484
-               my ($field_name) = lc $1;
7485
-               if (exists $headers->{$field_name}) {
7486
-                   for ($headers->{$field_name}) {
7487
-                       $_ = [$_] unless ref $_ eq "ARRAY";
7488
-                       push @$_, $2;
7489
-                       $val = \$_->[-1];
7490
-                   }
7491
-               }
7492
-               else {
7493
-                   $val = \($headers->{$field_name} = $2);
7494
-               }
7495
-           }
7496
-           elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
7497
-               $val
7498
-                 or die(qq/Unexpected header continuation line\n/);
7499
-               next unless length $1;
7500
-               $$val .= ' ' if length $$val;
7501
-               $$val .= $1;
7502
-           }
7503
-           elsif ($line =~ /\A \x0D?\x0A \z/x) {
7504
-              last;
7505
-           }
7506
-           else {
7507
-              die(q/Malformed header line: / . $Printable->($line) . "\n");
7508
-           }
7509
-      }
7510
-      return $headers;
7511
-  }
7512
-  
7513
-  sub write_request {
7514
-      @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
7515
-      my($self, $request) = @_;
7516
-      $self->write_request_header(@{$request}{qw/method uri headers/});
7517
-      $self->write_body($request) if $request->{cb};
7518
-      return;
7519
-  }
7520
-  
7521
-  my %HeaderCase = (
7522
-      'content-md5'      => 'Content-MD5',
7523
-      'etag'             => 'ETag',
7524
-      'te'               => 'TE',
7525
-      'www-authenticate' => 'WWW-Authenticate',
7526
-      'x-xss-protection' => 'X-XSS-Protection',
7527
-  );
7528
-  
7529
-  sub write_header_lines {
7530
-      (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
7531
-      my($self, $headers) = @_;
7532
-  
7533
-      my $buf = '';
7534
-      while (my ($k, $v) = each %$headers) {
7535
-          my $field_name = lc $k;
7536
-          if (exists $HeaderCase{$field_name}) {
7537
-              $field_name = $HeaderCase{$field_name};
7538
-          }
7539
-          else {
7540
-              $field_name =~ /\A $Token+ \z/xo
7541
-                or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
7542
-              $field_name =~ s/\b(\w)/\u$1/g;
7543
-              $HeaderCase{lc $field_name} = $field_name;
7544
-          }
7545
-          for (ref $v eq 'ARRAY' ? @$v : $v) {
7546
-              /[^\x0D\x0A]/
7547
-                or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
7548
-              $buf .= "$field_name: $_\x0D\x0A";
7549
-          }
7550
-      }
7551
-      $buf .= "\x0D\x0A";
7552
-      return $self->write($buf);
7553
-  }
7554
-  
7555
-  sub read_body {
7556
-      @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
7557
-      my ($self, $cb, $response) = @_;
7558
-      my $te = $response->{headers}{'transfer-encoding'} || '';
7559
-      if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
7560
-          $self->read_chunked_body($cb, $response);
7561
-      }
7562
-      else {
7563
-          $self->read_content_body($cb, $response);
7564
-      }
7565
-      return;
7566
-  }
7567
-  
7568
-  sub write_body {
7569
-      @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
7570
-      my ($self, $request) = @_;
7571
-      if ($request->{headers}{'content-length'}) {
7572
-          return $self->write_content_body($request);
7573
-      }
7574
-      else {
7575
-          return $self->write_chunked_body($request);
7576
-      }
7577
-  }
7578
-  
7579
-  sub read_content_body {
7580
-      @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
7581
-      my ($self, $cb, $response, $content_length) = @_;
7582
-      $content_length ||= $response->{headers}{'content-length'};
7583
-  
7584
-      if ( $content_length ) {
7585
-          my $len = $content_length;
7586
-          while ($len > 0) {
7587
-              my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
7588
-              $cb->($self->read($read, 0), $response);
7589
-              $len -= $read;
7590
-          }
7591
-      }
7592
-      else {
7593
-          my $chunk;
7594
-          $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
7595
-      }
7596
-  
7597
-      return;
7598
-  }
7599
-  
7600
-  sub write_content_body {
7601
-      @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
7602
-      my ($self, $request) = @_;
7603
-  
7604
-      my ($len, $content_length) = (0, $request->{headers}{'content-length'});
7605
-      while () {
7606
-          my $data = $request->{cb}->();
7607
-  
7608
-          defined $data && length $data
7609
-            or last;
7610
-  
7611
-          if ( $] ge '5.008' ) {
7612
-              utf8::downgrade($data, 1)
7613
-                  or die(qq/Wide character in write_content()\n/);
7614
-          }
7615
-  
7616
-          $len += $self->write($data);
7617
-      }
7618
-  
7619
-      $len == $content_length
7620
-        or die(qq/Content-Length missmatch (got: $len expected: $content_length)\n/);
7621
-  
7622
-      return $len;
7623
-  }
7624
-  
7625
-  sub read_chunked_body {
7626
-      @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
7627
-      my ($self, $cb, $response) = @_;
7628
-  
7629
-      while () {
7630
-          my $head = $self->readline;
7631
-  
7632
-          $head =~ /\A ([A-Fa-f0-9]+)/x
7633
-            or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
7634
-  
7635
-          my $len = hex($1)
7636
-            or last;
7637
-  
7638
-          $self->read_content_body($cb, $response, $len);
7639
-  
7640
-          $self->read(2) eq "\x0D\x0A"
7641
-            or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
7642
-      }
7643
-      $self->read_header_lines($response->{headers});
7644
-      return;
7645
-  }
7646
-  
7647
-  sub write_chunked_body {
7648
-      @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
7649
-      my ($self, $request) = @_;
7650
-  
7651
-      my $len = 0;
7652
-      while () {
7653
-          my $data = $request->{cb}->();
7654
-  
7655
-          defined $data && length $data
7656
-            or last;
7657
-  
7658
-          if ( $] ge '5.008' ) {
7659
-              utf8::downgrade($data, 1)
7660
-                  or die(qq/Wide character in write_chunked_body()\n/);
7661
-          }
7662
-  
7663
-          $len += length $data;
7664
-  
7665
-          my $chunk  = sprintf '%X', length $data;
7666
-             $chunk .= "\x0D\x0A";
7667
-             $chunk .= $data;
7668
-             $chunk .= "\x0D\x0A";
7669
-  
7670
-          $self->write($chunk);
7671
-      }
7672
-      $self->write("0\x0D\x0A");
7673
-      $self->write_header_lines($request->{trailer_cb}->())
7674
-          if ref $request->{trailer_cb} eq 'CODE';
7675
-      return $len;
7676
-  }
7677
-  
7678
-  sub read_response_header {
7679
-      @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
7680
-      my ($self) = @_;
7681
-  
7682
-      my $line = $self->readline;
7683
-  
7684
-      $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
7685
-        or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
7686
-  
7687
-      my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
7688
-  
7689
-      die (qq/Unsupported HTTP protocol: $protocol\n/)
7690
-          unless $version =~ /0*1\.0*[01]/;
7691
-  
7692
-      return {
7693
-          status   => $status,
7694
-          reason   => $reason,
7695
-          headers  => $self->read_header_lines,
7696
-          protocol => $protocol,
7697
-      };
7698
-  }
7699
-  
7700
-  sub write_request_header {
7701
-      @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
7702
-      my ($self, $method, $request_uri, $headers) = @_;
7703
-  
7704
-      return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
7705
-           + $self->write_header_lines($headers);
7706
-  }
7707
-  
7708
-  sub _do_timeout {
7709
-      my ($self, $type, $timeout) = @_;
7710
-      $timeout = $self->{timeout}
7711
-          unless defined $timeout && $timeout >= 0;
7712
-  
7713
-      my $fd = fileno $self->{fh};
7714
-      defined $fd && $fd >= 0
7715
-        or die(qq/select(2): 'Bad file descriptor'\n/);
7716
-  
7717
-      my $initial = time;
7718
-      my $pending = $timeout;
7719
-      my $nfound;
7720
-  
7721
-      vec(my $fdset = '', $fd, 1) = 1;
7722
-  
7723
-      while () {
7724
-          $nfound = ($type eq 'read')
7725
-              ? select($fdset, undef, undef, $pending)
7726
-              : select(undef, $fdset, undef, $pending) ;
7727
-          if ($nfound == -1) {
7728
-              $! == EINTR
7729
-                or die(qq/select(2): '$!'\n/);
7730
-              redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
7731
-              $nfound = 0;
7732
-          }
7733
-          last;
7734
-      }
7735
-      $! = 0;
7736
-      return $nfound;
7737
-  }
7738
-  
7739
-  sub can_read {
7740
-      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
7741
-      my $self = shift;
7742
-      return $self->_do_timeout('read', @_)
7743
-  }
7744
-  
7745
-  sub can_write {
7746
-      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
7747
-      my $self = shift;
7748
-      return $self->_do_timeout('write', @_)
7749
-  }
7750
-  
7751
-  # Try to find a CA bundle to validate the SSL cert,
7752
-  # prefer Mozilla::CA or fallback to a system file
7753
-  sub _find_CA_file {
7754
-      my $self = shift();
7755
-  
7756
-      return $self->{SSL_options}->{SSL_ca_file}
7757
-          if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
7758
-  
7759
-      return Mozilla::CA::SSL_ca_file()
7760
-          if eval { require Mozilla::CA };
7761
-  
7762
-      foreach my $ca_bundle (qw{
7763
-          /etc/ssl/certs/ca-certificates.crt
7764
-          /etc/pki/tls/certs/ca-bundle.crt
7765
-          /etc/ssl/ca-bundle.pem
7766
-          }
7767
-      ) {
7768
-          return $ca_bundle if -e $ca_bundle;
7769
-      }
7770
-  
7771
-      die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
7772
-        . qq/Try installing Mozilla::CA from CPAN\n/;
7773
-  }
7774
-  
7775
-  sub _ssl_args {
7776
-      my ($self, $host) = @_;
7777
-  
7778
-      my %ssl_args = (
7779
-          SSL_hostname        => $host,  # SNI
7780
-      );
7781
-  
7782
-      if ($self->{verify_SSL}) {
7783
-          $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
7784
-          $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
7785
-          $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
7786
-          $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
7787
-      }
7788
-      else {
7789
-          $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
7790
-          $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
7791
-      }
7792
-  
7793
-      # user options override settings from verify_SSL
7794
-      for my $k ( keys %{$self->{SSL_options}} ) {
7795
-          $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
7796
-      }
7797
-  
7798
-      return \%ssl_args;
7799
-  }
7800
-  
7801
-  1;
7802
-  
7803
-  __END__
7804
-  
7805
-HTTP_TINY
7806
-
7807
-$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
7808
-  package JSON::PP;
7809
-  
7810
-  # JSON-2.0
7811
-  
7812
-  use 5.005;
7813
-  use strict;
7814
-  use base qw(Exporter);
7815
-  use overload ();
7816
-  
7817
-  use Carp ();
7818
-  use B ();
7819
-  #use Devel::Peek;
7820
-  
7821
-  $JSON::PP::VERSION = '2.27200';
7822
-  
7823
-  @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
7824
-  
7825
-  # instead of hash-access, i tried index-access for speed.
7826
-  # but this method is not faster than what i expected. so it will be changed.
7827
-  
7828
-  use constant P_ASCII                => 0;
7829
-  use constant P_LATIN1               => 1;
7830
-  use constant P_UTF8                 => 2;
7831
-  use constant P_INDENT               => 3;
7832
-  use constant P_CANONICAL            => 4;
7833
-  use constant P_SPACE_BEFORE         => 5;
7834
-  use constant P_SPACE_AFTER          => 6;
7835
-  use constant P_ALLOW_NONREF         => 7;
7836
-  use constant P_SHRINK               => 8;
7837
-  use constant P_ALLOW_BLESSED        => 9;
7838
-  use constant P_CONVERT_BLESSED      => 10;
7839
-  use constant P_RELAXED              => 11;
7840
-  
7841
-  use constant P_LOOSE                => 12;
7842
-  use constant P_ALLOW_BIGNUM         => 13;
7843
-  use constant P_ALLOW_BAREKEY        => 14;
7844
-  use constant P_ALLOW_SINGLEQUOTE    => 15;
7845
-  use constant P_ESCAPE_SLASH         => 16;
7846
-  use constant P_AS_NONBLESSED        => 17;
7847
-  
7848
-  use constant P_ALLOW_UNKNOWN        => 18;
7849
-  
7850
-  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
7851
-  
7852
-  BEGIN {
7853
-      my @xs_compati_bit_properties = qw(
7854
-              latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
7855
-              allow_blessed convert_blessed relaxed allow_unknown
7856
-      );
7857
-      my @pp_bit_properties = qw(
7858
-              allow_singlequote allow_bignum loose
7859
-              allow_barekey escape_slash as_nonblessed
7860
-      );
7861
-  
7862
-      # Perl version check, Unicode handling is enable?
7863
-      # Helper module sets @JSON::PP::_properties.
7864
-      if ($] < 5.008 ) {
7865
-          my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
7866
-          eval qq| require $helper |;
7867
-          if ($@) { Carp::croak $@; }
7868
-      }
7869
-  
7870
-      for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
7871
-          my $flag_name = 'P_' . uc($name);
7872
-  
7873
-          eval qq/
7874
-              sub $name {
7875
-                  my \$enable = defined \$_[1] ? \$_[1] : 1;
7876
-  
7877
-                  if (\$enable) {
7878
-                      \$_[0]->{PROPS}->[$flag_name] = 1;
7879
-                  }
7880
-                  else {
7881
-                      \$_[0]->{PROPS}->[$flag_name] = 0;
7882
-                  }
7883
-  
7884
-                  \$_[0];
7885
-              }
7886
-  
7887
-              sub get_$name {
7888
-                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
7889
-              }
7890
-          /;
7891
-      }
7892
-  
7893
-  }
7894
-  
7895
-  
7896
-  
7897
-  # Functions
7898
-  
7899
-  my %encode_allow_method
7900
-       = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
7901
-                            allow_blessed convert_blessed indent indent_length allow_bignum
7902
-                            as_nonblessed
7903
-                          /;
7904
-  my %decode_allow_method
7905
-       = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
7906
-                            allow_barekey max_size relaxed/;
7907
-  
7908
-  
7909
-  my $JSON; # cache
7910
-  
7911
-  sub encode_json ($) { # encode
7912
-      ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
7913
-  }
7914
-  
7915
-  
7916
-  sub decode_json { # decode
7917
-      ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
7918
-  }
7919
-  
7920
-  # Obsoleted
7921
-  
7922
-  sub to_json($) {
7923
-     Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
7924
-  }
7925
-  
7926
-  
7927
-  sub from_json($) {
7928
-     Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
7929
-  }
7930
-  
7931
-  
7932
-  # Methods
7933
-  
7934
-  sub new {
7935
-      my $class = shift;
7936
-      my $self  = {
7937
-          max_depth   => 512,
7938
-          max_size    => 0,
7939
-          indent      => 0,
7940
-          FLAGS       => 0,
7941
-          fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
7942
-          indent_length => 3,
7943
-      };
7944
-  
7945
-      bless $self, $class;
7946
-  }
7947
-  
7948
-  
7949
-  sub encode {
7950
-      return $_[0]->PP_encode_json($_[1]);
7951
-  }
7952
-  
7953
-  
7954
-  sub decode {
7955
-      return $_[0]->PP_decode_json($_[1], 0x00000000);
7956
-  }
7957
-  
7958
-  
7959
-  sub decode_prefix {
7960
-      return $_[0]->PP_decode_json($_[1], 0x00000001);
7961
-  }
7962
-  
7963
-  
7964
-  # accessor
7965
-  
7966
-  
7967
-  # pretty printing
7968
-  
7969
-  sub pretty {
7970
-      my ($self, $v) = @_;
7971
-      my $enable = defined $v ? $v : 1;
7972
-  
7973
-      if ($enable) { # indent_length(3) for JSON::XS compatibility
7974
-          $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
7975
-      }
7976
-      else {
7977
-          $self->indent(0)->space_before(0)->space_after(0);
7978
-      }
7979
-  
7980
-      $self;
7981
-  }
7982
-  
7983
-  # etc
7984
-  
7985
-  sub max_depth {
7986
-      my $max  = defined $_[1] ? $_[1] : 0x80000000;
7987
-      $_[0]->{max_depth} = $max;
7988
-      $_[0];
7989
-  }
7990
-  
7991
-  
7992
-  sub get_max_depth { $_[0]->{max_depth}; }
7993
-  
7994
-  
7995
-  sub max_size {
7996
-      my $max  = defined $_[1] ? $_[1] : 0;
7997
-      $_[0]->{max_size} = $max;
7998
-      $_[0];
7999
-  }
8000
-  
8001
-  
8002
-  sub get_max_size { $_[0]->{max_size}; }
8003
-  
8004
-  
8005
-  sub filter_json_object {
8006
-      $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
8007
-      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
8008
-      $_[0];
8009
-  }
8010
-  
8011
-  sub filter_json_single_key_object {
8012
-      if (@_ > 1) {
8013
-          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
8014
-      }
8015
-      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
8016
-      $_[0];
8017
-  }
8018
-  
8019
-  sub indent_length {
8020
-      if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
8021
-          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
8022
-      }
8023
-      else {
8024
-          $_[0]->{indent_length} = $_[1];
8025
-      }
8026
-      $_[0];
8027
-  }
8028
-  
8029
-  sub get_indent_length {
8030
-      $_[0]->{indent_length};
8031
-  }
8032
-  
8033
-  sub sort_by {
8034
-      $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
8035
-      $_[0];
8036
-  }
8037
-  
8038
-  sub allow_bigint {
8039
-      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
8040
-  }
8041
-  
8042
-  ###############################
8043
-  
8044
-  ###
8045
-  ### Perl => JSON
8046
-  ###
8047
-  
8048
-  
8049
-  { # Convert
8050
-  
8051
-      my $max_depth;
8052
-      my $indent;
8053
-      my $ascii;
8054
-      my $latin1;
8055
-      my $utf8;
8056
-      my $space_before;
8057
-      my $space_after;
8058
-      my $canonical;
8059
-      my $allow_blessed;
8060
-      my $convert_blessed;
8061
-  
8062
-      my $indent_length;
8063
-      my $escape_slash;
8064
-      my $bignum;
8065
-      my $as_nonblessed;
8066
-  
8067
-      my $depth;
8068
-      my $indent_count;
8069
-      my $keysort;
8070
-  
8071
-  
8072
-      sub PP_encode_json {
8073
-          my $self = shift;
8074
-          my $obj  = shift;
8075
-  
8076
-          $indent_count = 0;
8077
-          $depth        = 0;
8078
-  
8079
-          my $idx = $self->{PROPS};
8080
-  
8081
-          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
8082
-              $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
8083
-           = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
8084
-                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
8085
-  
8086
-          ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
8087
-  
8088
-          $keysort = $canonical ? sub { $a cmp $b } : undef;
8089
-  
8090
-          if ($self->{sort_by}) {
8091
-              $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
8092
-                       : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
8093
-                       : sub { $a cmp $b };
8094
-          }
8095
-  
8096
-          encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
8097
-               if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
8098
-  
8099
-          my $str  = $self->object_to_json($obj);
8100
-  
8101
-          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
8102
-  
8103
-          unless ($ascii or $latin1 or $utf8) {
8104
-              utf8::upgrade($str);
8105
-          }
8106
-  
8107
-          if ($idx->[ P_SHRINK ]) {
8108
-              utf8::downgrade($str, 1);
8109
-          }
8110
-  
8111
-          return $str;
8112
-      }
8113
-  
8114
-  
8115
-      sub object_to_json {
8116
-          my ($self, $obj) = @_;
8117
-          my $type = ref($obj);
8118
-  
8119
-          if($type eq 'HASH'){
8120
-              return $self->hash_to_json($obj);
8121
-          }
8122
-          elsif($type eq 'ARRAY'){
8123
-              return $self->array_to_json($obj);
8124
-          }
8125
-          elsif ($type) { # blessed object?
8126
-              if (blessed($obj)) {
8127
-  
8128
-                  return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
8129
-  
8130
-                  if ( $convert_blessed and $obj->can('TO_JSON') ) {
8131
-                      my $result = $obj->TO_JSON();
8132
-                      if ( defined $result and ref( $result ) ) {
8133
-                          if ( refaddr( $obj ) eq refaddr( $result ) ) {
8134
-                              encode_error( sprintf(
8135
-                                  "%s::TO_JSON method returned same object as was passed instead of a new one",
8136
-                                  ref $obj
8137
-                              ) );
8138
-                          }
8139
-                      }
8140
-  
8141
-                      return $self->object_to_json( $result );
8142
-                  }
8143
-  
8144
-                  return "$obj" if ( $bignum and _is_bignum($obj) );
8145
-                  return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
8146
-  
8147
-                  encode_error( sprintf("encountered object '%s', but neither allow_blessed "
8148
-                      . "nor convert_blessed settings are enabled", $obj)
8149
-                  ) unless ($allow_blessed);
8150
-  
8151
-                  return 'null';
8152
-              }
8153
-              else {
8154
-                  return $self->value_to_json($obj);
8155
-              }
8156
-          }
8157
-          else{
8158
-              return $self->value_to_json($obj);
8159
-          }
8160
-      }
8161
-  
8162
-  
8163
-      sub hash_to_json {
8164
-          my ($self, $obj) = @_;
8165
-          my @res;
8166
-  
8167
-          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
8168
-                                           if (++$depth > $max_depth);
8169
-  
8170
-          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
8171
-          my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
8172
-  
8173
-          for my $k ( _sort( $obj ) ) {
8174
-              if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
8175
-              push @res, string_to_json( $self, $k )
8176
-                            .  $del
8177
-                            . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
8178
-          }
8179
-  
8180
-          --$depth;
8181
-          $self->_down_indent() if ($indent);
8182
-  
8183
-          return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
8184
-      }
8185
-  
8186
-  
8187
-      sub array_to_json {
8188
-          my ($self, $obj) = @_;
8189
-          my @res;
8190
-  
8191
-          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
8192
-                                           if (++$depth > $max_depth);
8193
-  
8194
-          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
8195
-  
8196
-          for my $v (@$obj){
8197
-              push @res, $self->object_to_json($v) || $self->value_to_json($v);
8198
-          }
8199
-  
8200
-          --$depth;
8201
-          $self->_down_indent() if ($indent);
8202
-  
8203
-          return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
8204
-      }
8205
-  
8206
-  
8207
-      sub value_to_json {
8208
-          my ($self, $value) = @_;
8209
-  
8210
-          return 'null' if(!defined $value);
8211
-  
8212
-          my $b_obj = B::svref_2object(\$value);  # for round trip problem
8213
-          my $flags = $b_obj->FLAGS;
8214
-  
8215
-          return $value # as is 
8216
-              if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
8217
-  
8218
-          my $type = ref($value);
8219
-  
8220
-          if(!$type){
8221
-              return string_to_json($self, $value);
8222
-          }
8223
-          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
8224
-              return $$value == 1 ? 'true' : 'false';
8225
-          }
8226
-          elsif ($type) {
8227
-              if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
8228
-                  return $self->value_to_json("$value");
8229
-              }
8230
-  
8231
-              if ($type eq 'SCALAR' and defined $$value) {
8232
-                  return   $$value eq '1' ? 'true'
8233
-                         : $$value eq '0' ? 'false'
8234
-                         : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
8235
-                         : encode_error("cannot encode reference to scalar");
8236
-              }
8237
-  
8238
-               if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
8239
-                   return 'null';
8240
-               }
8241
-               else {
8242
-                   if ( $type eq 'SCALAR' or $type eq 'REF' ) {
8243
-                      encode_error("cannot encode reference to scalar");
8244
-                   }
8245
-                   else {
8246
-                      encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
8247
-                   }
8248
-               }
8249
-  
8250
-          }
8251
-          else {
8252
-              return $self->{fallback}->($value)
8253
-                   if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
8254
-              return 'null';
8255
-          }
8256
-  
8257
-      }
8258
-  
8259
-  
8260
-      my %esc = (
8261
-          "\n" => '\n',
8262
-          "\r" => '\r',
8263
-          "\t" => '\t',
8264
-          "\f" => '\f',
8265
-          "\b" => '\b',
8266
-          "\"" => '\"',
8267
-          "\\" => '\\\\',
8268
-          "\'" => '\\\'',
8269
-      );
8270
-  
8271
-  
8272
-      sub string_to_json {
8273
-          my ($self, $arg) = @_;
8274
-  
8275
-          $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
8276
-          $arg =~ s/\//\\\//g if ($escape_slash);
8277
-          $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
8278
-  
8279
-          if ($ascii) {
8280
-              $arg = JSON_PP_encode_ascii($arg);
8281
-          }
8282
-  
8283
-          if ($latin1) {
8284
-              $arg = JSON_PP_encode_latin1($arg);
8285
-          }
8286
-  
8287
-          if ($utf8) {
8288
-              utf8::encode($arg);
8289
-          }
8290
-  
8291
-          return '"' . $arg . '"';
8292
-      }
8293
-  
8294
-  
8295
-      sub blessed_to_json {
8296
-          my $reftype = reftype($_[1]) || '';
8297
-          if ($reftype eq 'HASH') {
8298
-              return $_[0]->hash_to_json($_[1]);
8299
-          }
8300
-          elsif ($reftype eq 'ARRAY') {
8301
-              return $_[0]->array_to_json($_[1]);
8302
-          }
8303
-          else {
8304
-              return 'null';
8305
-          }
8306
-      }
8307
-  
8308
-  
8309
-      sub encode_error {
8310
-          my $error  = shift;
8311
-          Carp::croak "$error";
8312
-      }
8313
-  
8314
-  
8315
-      sub _sort {
8316
-          defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
8317
-      }
8318
-  
8319
-  
8320
-      sub _up_indent {
8321
-          my $self  = shift;
8322
-          my $space = ' ' x $indent_length;
8323
-  
8324
-          my ($pre,$post) = ('','');
8325
-  
8326
-          $post = "\n" . $space x $indent_count;
8327
-  
8328
-          $indent_count++;
8329
-  
8330
-          $pre = "\n" . $space x $indent_count;
8331
-  
8332
-          return ($pre,$post);
8333
-      }
8334
-  
8335
-  
8336
-      sub _down_indent { $indent_count--; }
8337
-  
8338
-  
8339
-      sub PP_encode_box {
8340
-          {
8341
-              depth        => $depth,
8342
-              indent_count => $indent_count,
8343
-          };
8344
-      }
8345
-  
8346
-  } # Convert
8347
-  
8348
-  
8349
-  sub _encode_ascii {
8350
-      join('',
8351
-          map {
8352
-              $_ <= 127 ?
8353
-                  chr($_) :
8354
-              $_ <= 65535 ?
8355
-                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
8356
-          } unpack('U*', $_[0])
8357
-      );
8358
-  }
8359
-  
8360
-  
8361
-  sub _encode_latin1 {
8362
-      join('',
8363
-          map {
8364
-              $_ <= 255 ?
8365
-                  chr($_) :
8366
-              $_ <= 65535 ?
8367
-                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
8368
-          } unpack('U*', $_[0])
8369
-      );
8370
-  }
8371
-  
8372
-  
8373
-  sub _encode_surrogates { # from perlunicode
8374
-      my $uni = $_[0] - 0x10000;
8375
-      return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
8376
-  }
8377
-  
8378
-  
8379
-  sub _is_bignum {
8380
-      $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
8381
-  }
8382
-  
8383
-  
8384
-  
8385
-  #
8386
-  # JSON => Perl
8387
-  #
8388
-  
8389
-  my $max_intsize;
8390
-  
8391
-  BEGIN {
8392
-      my $checkint = 1111;
8393
-      for my $d (5..64) {
8394
-          $checkint .= 1;
8395
-          my $int   = eval qq| $checkint |;
8396
-          if ($int =~ /[eE]/) {
8397
-              $max_intsize = $d - 1;
8398
-              last;
8399
-          }
8400
-      }
8401
-  }
8402
-  
8403
-  { # PARSE 
8404
-  
8405
-      my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
8406
-          b    => "\x8",
8407
-          t    => "\x9",
8408
-          n    => "\xA",
8409
-          f    => "\xC",
8410
-          r    => "\xD",
8411
-          '\\' => '\\',
8412
-          '"'  => '"',
8413
-          '/'  => '/',
8414
-      );
8415
-  
8416
-      my $text; # json data
8417
-      my $at;   # offset
8418
-      my $ch;   # 1chracter
8419
-      my $len;  # text length (changed according to UTF8 or NON UTF8)
8420
-      # INTERNAL
8421
-      my $depth;          # nest counter
8422
-      my $encoding;       # json text encoding
8423
-      my $is_valid_utf8;  # temp variable
8424
-      my $utf8_len;       # utf8 byte length
8425
-      # FLAGS
8426
-      my $utf8;           # must be utf8
8427
-      my $max_depth;      # max nest nubmer of objects and arrays
8428
-      my $max_size;
8429
-      my $relaxed;
8430
-      my $cb_object;
8431
-      my $cb_sk_object;
8432
-  
8433
-      my $F_HOOK;
8434
-  
8435
-      my $allow_bigint;   # using Math::BigInt
8436
-      my $singlequote;    # loosely quoting
8437
-      my $loose;          # 
8438
-      my $allow_barekey;  # bareKey
8439
-  
8440
-      # $opt flag
8441
-      # 0x00000001 .... decode_prefix
8442
-      # 0x10000000 .... incr_parse
8443
-  
8444
-      sub PP_decode_json {
8445
-          my ($self, $opt); # $opt is an effective flag during this decode_json.
8446
-  
8447
-          ($self, $text, $opt) = @_;
8448
-  
8449
-          ($at, $ch, $depth) = (0, '', 0);
8450
-  
8451
-          if ( !defined $text or ref $text ) {
8452
-              decode_error("malformed JSON string, neither array, object, number, string or atom");
8453
-          }
8454
-  
8455
-          my $idx = $self->{PROPS};
8456
-  
8457
-          ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
8458
-              = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
8459
-  
8460
-          if ( $utf8 ) {
8461
-              utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
8462
-          }
8463
-          else {
8464
-              utf8::upgrade( $text );
8465
-          }
8466
-  
8467
-          $len = length $text;
8468
-  
8469
-          ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
8470
-               = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
8471
-  
8472
-          if ($max_size > 1) {
8473
-              use bytes;
8474
-              my $bytes = length $text;
8475
-              decode_error(
8476
-                  sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
8477
-                      , $bytes, $max_size), 1
8478
-              ) if ($bytes > $max_size);
8479
-          }
8480
-  
8481
-          # Currently no effect
8482
-          # should use regexp
8483
-          my @octets = unpack('C4', $text);
8484
-          $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
8485
-                      : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
8486
-                      : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
8487
-                      : ( $octets[2]                ) ? 'UTF-16LE'
8488
-                      : (!$octets[2]                ) ? 'UTF-32LE'
8489
-                      : 'unknown';
8490
-  
8491
-          white(); # remove head white space
8492
-  
8493
-          my $valid_start = defined $ch; # Is there a first character for JSON structure?
8494
-  
8495
-          my $result = value();
8496
-  
8497
-          return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
8498
-  
8499
-          decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
8500
-  
8501
-          if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
8502
-                  decode_error(
8503
-                  'JSON text must be an object or array (but found number, string, true, false or null,'
8504
-                         . ' use allow_nonref to allow this)', 1);
8505
-          }
8506
-  
8507
-          Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
8508
-  
8509
-          my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
8510
-  
8511
-          white(); # remove tail white space
8512
-  
8513
-          if ( $ch ) {
8514
-              return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
8515
-              decode_error("garbage after JSON object");
8516
-          }
8517
-  
8518
-          ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
8519
-      }
8520
-  
8521
-  
8522
-      sub next_chr {
8523
-          return $ch = undef if($at >= $len);
8524
-          $ch = substr($text, $at++, 1);
8525
-      }
8526
-  
8527
-  
8528
-      sub value {
8529
-          white();
8530
-          return          if(!defined $ch);
8531
-          return object() if($ch eq '{');
8532
-          return array()  if($ch eq '[');
8533
-          return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
8534
-          return number() if($ch =~ /[0-9]/ or $ch eq '-');
8535
-          return word();
8536
-      }
8537
-  
8538
-      sub string {
8539
-          my ($i, $s, $t, $u);
8540
-          my $utf16;
8541
-          my $is_utf8;
8542
-  
8543
-          ($is_valid_utf8, $utf8_len) = ('', 0);
8544
-  
8545
-          $s = ''; # basically UTF8 flag on
8546
-  
8547
-          if($ch eq '"' or ($singlequote and $ch eq "'")){
8548
-              my $boundChar = $ch;
8549
-  
8550
-              OUTER: while( defined(next_chr()) ){
8551
-  
8552
-                  if($ch eq $boundChar){
8553
-                      next_chr();
8554
-  
8555
-                      if ($utf16) {
8556
-                          decode_error("missing low surrogate character in surrogate pair");
8557
-                      }
8558
-  
8559
-                      utf8::decode($s) if($is_utf8);
8560
-  
8561
-                      return $s;
8562
-                  }
8563
-                  elsif($ch eq '\\'){
8564
-                      next_chr();
8565
-                      if(exists $escapes{$ch}){
8566
-                          $s .= $escapes{$ch};
8567
-                      }
8568
-                      elsif($ch eq 'u'){ # UNICODE handling
8569
-                          my $u = '';
8570
-  
8571
-                          for(1..4){
8572
-                              $ch = next_chr();
8573
-                              last OUTER if($ch !~ /[0-9a-fA-F]/);
8574
-                              $u .= $ch;
8575
-                          }
8576
-  
8577
-                          # U+D800 - U+DBFF
8578
-                          if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
8579
-                              $utf16 = $u;
8580
-                          }
8581
-                          # U+DC00 - U+DFFF
8582
-                          elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
8583
-                              unless (defined $utf16) {
8584
-                                  decode_error("missing high surrogate character in surrogate pair");
8585
-                              }
8586
-                              $is_utf8 = 1;
8587
-                              $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
8588
-                              $utf16 = undef;
8589
-                          }
8590
-                          else {
8591
-                              if (defined $utf16) {
8592
-                                  decode_error("surrogate pair expected");
8593
-                              }
8594
-  
8595
-                              if ( ( my $hex = hex( $u ) ) > 127 ) {
8596
-                                  $is_utf8 = 1;
8597
-                                  $s .= JSON_PP_decode_unicode($u) || next;
8598
-                              }
8599
-                              else {
8600
-                                  $s .= chr $hex;
8601
-                              }
8602
-                          }
8603
-  
8604
-                      }
8605
-                      else{
8606
-                          unless ($loose) {
8607
-                              $at -= 2;
8608
-                              decode_error('illegal backslash escape sequence in string');
8609
-                          }
8610
-                          $s .= $ch;
8611
-                      }
8612
-                  }
8613
-                  else{
8614
-  
8615
-                      if ( ord $ch  > 127 ) {
8616
-                          if ( $utf8 ) {
8617
-                              unless( $ch = is_valid_utf8($ch) ) {
8618
-                                  $at -= 1;
8619
-                                  decode_error("malformed UTF-8 character in JSON string");
8620
-                              }
8621
-                              else {
8622
-                                  $at += $utf8_len - 1;
8623
-                              }
8624
-                          }
8625
-                          else {
8626
-                              utf8::encode( $ch );
8627
-                          }
8628
-  
8629
-                          $is_utf8 = 1;
8630
-                      }
8631
-  
8632
-                      if (!$loose) {
8633
-                          if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
8634
-                              $at--;
8635
-                              decode_error('invalid character encountered while parsing JSON string');
8636
-                          }
8637
-                      }
8638
-  
8639
-                      $s .= $ch;
8640
-                  }
8641
-              }
8642
-          }
8643
-  
8644
-          decode_error("unexpected end of string while parsing JSON string");
8645
-      }
8646
-  
8647
-  
8648
-      sub white {
8649
-          while( defined $ch  ){
8650
-              if($ch le ' '){
8651
-                  next_chr();
8652
-              }
8653
-              elsif($ch eq '/'){
8654
-                  next_chr();
8655
-                  if(defined $ch and $ch eq '/'){
8656
-                      1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
8657
-                  }
8658
-                  elsif(defined $ch and $ch eq '*'){
8659
-                      next_chr();
8660
-                      while(1){
8661
-                          if(defined $ch){
8662
-                              if($ch eq '*'){
8663
-                                  if(defined(next_chr()) and $ch eq '/'){
8664
-                                      next_chr();
8665
-                                      last;
8666
-                                  }
8667
-                              }
8668
-                              else{
8669
-                                  next_chr();
8670
-                              }
8671
-                          }
8672
-                          else{
8673
-                              decode_error("Unterminated comment");
8674
-                          }
8675
-                      }
8676
-                      next;
8677
-                  }
8678
-                  else{
8679
-                      $at--;
8680
-                      decode_error("malformed JSON string, neither array, object, number, string or atom");
8681
-                  }
8682
-              }
8683
-              else{
8684
-                  if ($relaxed and $ch eq '#') { # correctly?
8685
-                      pos($text) = $at;
8686
-                      $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
8687
-                      $at = pos($text);
8688
-                      next_chr;
8689
-                      next;
8690
-                  }
8691
-  
8692
-                  last;
8693
-              }
8694
-          }
8695
-      }
8696
-  
8697
-  
8698
-      sub array {
8699
-          my $a  = $_[0] || []; # you can use this code to use another array ref object.
8700
-  
8701
-          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
8702
-                                                      if (++$depth > $max_depth);
8703
-  
8704
-          next_chr();
8705
-          white();
8706
-  
8707
-          if(defined $ch and $ch eq ']'){
8708
-              --$depth;
8709
-              next_chr();
8710
-              return $a;
8711
-          }
8712
-          else {
8713
-              while(defined($ch)){
8714
-                  push @$a, value();
8715
-  
8716
-                  white();
8717
-  
8718
-                  if (!defined $ch) {
8719
-                      last;
8720
-                  }
8721
-  
8722
-                  if($ch eq ']'){
8723
-                      --$depth;
8724
-                      next_chr();
8725
-                      return $a;
8726
-                  }
8727
-  
8728
-                  if($ch ne ','){
8729
-                      last;
8730
-                  }
8731
-  
8732
-                  next_chr();
8733
-                  white();
8734
-  
8735
-                  if ($relaxed and $ch eq ']') {
8736
-                      --$depth;
8737
-                      next_chr();
8738
-                      return $a;
8739
-                  }
8740
-  
8741
-              }
8742
-          }
8743
-  
8744
-          decode_error(", or ] expected while parsing array");
8745
-      }
8746
-  
8747
-  
8748
-      sub object {
8749
-          my $o = $_[0] || {}; # you can use this code to use another hash ref object.
8750
-          my $k;
8751
-  
8752
-          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
8753
-                                                  if (++$depth > $max_depth);
8754
-          next_chr();
8755
-          white();
8756
-  
8757
-          if(defined $ch and $ch eq '}'){
8758
-              --$depth;
8759
-              next_chr();
8760
-              if ($F_HOOK) {
8761
-                  return _json_object_hook($o);
8762
-              }
8763
-              return $o;
8764
-          }
8765
-          else {
8766
-              while (defined $ch) {
8767
-                  $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
8768
-                  white();
8769
-  
8770
-                  if(!defined $ch or $ch ne ':'){
8771
-                      $at--;
8772
-                      decode_error("':' expected");
8773
-                  }
8774
-  
8775
-                  next_chr();
8776
-                  $o->{$k} = value();
8777
-                  white();
8778
-  
8779
-                  last if (!defined $ch);
8780
-  
8781
-                  if($ch eq '}'){
8782
-                      --$depth;
8783
-                      next_chr();
8784
-                      if ($F_HOOK) {
8785
-                          return _json_object_hook($o);
8786
-                      }
8787
-                      return $o;
8788
-                  }
8789
-  
8790
-                  if($ch ne ','){
8791
-                      last;
8792
-                  }
8793
-  
8794
-                  next_chr();
8795
-                  white();
8796
-  
8797
-                  if ($relaxed and $ch eq '}') {
8798
-                      --$depth;
8799
-                      next_chr();
8800
-                      if ($F_HOOK) {
8801
-                          return _json_object_hook($o);
8802
-                      }
8803
-                      return $o;
8804
-                  }
8805
-  
8806
-              }
8807
-  
8808
-          }
8809
-  
8810
-          $at--;
8811
-          decode_error(", or } expected while parsing object/hash");
8812
-      }
8813
-  
8814
-  
8815
-      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
8816
-          my $key;
8817
-          while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
8818
-              $key .= $ch;
8819
-              next_chr();
8820
-          }
8821
-          return $key;
8822
-      }
8823
-  
8824
-  
8825
-      sub word {
8826
-          my $word =  substr($text,$at-1,4);
8827
-  
8828
-          if($word eq 'true'){
8829
-              $at += 3;
8830
-              next_chr;
8831
-              return $JSON::PP::true;
8832
-          }
8833
-          elsif($word eq 'null'){
8834
-              $at += 3;
8835
-              next_chr;
8836
-              return undef;
8837
-          }
8838
-          elsif($word eq 'fals'){
8839
-              $at += 3;
8840
-              if(substr($text,$at,1) eq 'e'){
8841
-                  $at++;
8842
-                  next_chr;
8843
-                  return $JSON::PP::false;
8844
-              }
8845
-          }
8846
-  
8847
-          $at--; # for decode_error report
8848
-  
8849
-          decode_error("'null' expected")  if ($word =~ /^n/);
8850
-          decode_error("'true' expected")  if ($word =~ /^t/);
8851
-          decode_error("'false' expected") if ($word =~ /^f/);
8852
-          decode_error("malformed JSON string, neither array, object, number, string or atom");
8853
-      }
8854
-  
8855
-  
8856
-      sub number {
8857
-          my $n    = '';
8858
-          my $v;
8859
-  
8860
-          # According to RFC4627, hex or oct digts are invalid.
8861
-          if($ch eq '0'){
8862
-              my $peek = substr($text,$at,1);
8863
-              my $hex  = $peek =~ /[xX]/; # 0 or 1
8864
-  
8865
-              if($hex){
8866
-                  decode_error("malformed number (leading zero must not be followed by another digit)");
8867
-                  ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
8868
-              }
8869
-              else{ # oct
8870
-                  ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
8871
-                  if (defined $n and length $n > 1) {
8872
-                      decode_error("malformed number (leading zero must not be followed by another digit)");
8873
-                  }
8874
-              }
8875
-  
8876
-              if(defined $n and length($n)){
8877
-                  if (!$hex and length($n) == 1) {
8878
-                     decode_error("malformed number (leading zero must not be followed by another digit)");
8879
-                  }
8880
-                  $at += length($n) + $hex;
8881
-                  next_chr;
8882
-                  return $hex ? hex($n) : oct($n);
8883
-              }
8884
-          }
8885
-  
8886
-          if($ch eq '-'){
8887
-              $n = '-';
8888
-              next_chr;
8889
-              if (!defined $ch or $ch !~ /\d/) {
8890
-                  decode_error("malformed number (no digits after initial minus)");
8891
-              }
8892
-          }
8893
-  
8894
-          while(defined $ch and $ch =~ /\d/){
8895
-              $n .= $ch;
8896
-              next_chr;
8897
-          }
8898
-  
8899
-          if(defined $ch and $ch eq '.'){
8900
-              $n .= '.';
8901
-  
8902
-              next_chr;
8903
-              if (!defined $ch or $ch !~ /\d/) {
8904
-                  decode_error("malformed number (no digits after decimal point)");
8905
-              }
8906
-              else {
8907
-                  $n .= $ch;
8908
-              }
8909
-  
8910
-              while(defined(next_chr) and $ch =~ /\d/){
8911
-                  $n .= $ch;
8912
-              }
8913
-          }
8914
-  
8915
-          if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
8916
-              $n .= $ch;
8917
-              next_chr;
8918
-  
8919
-              if(defined($ch) and ($ch eq '+' or $ch eq '-')){
8920
-                  $n .= $ch;
8921
-                  next_chr;
8922
-                  if (!defined $ch or $ch =~ /\D/) {
8923
-                      decode_error("malformed number (no digits after exp sign)");
8924
-                  }
8925
-                  $n .= $ch;
8926
-              }
8927
-              elsif(defined($ch) and $ch =~ /\d/){
8928
-                  $n .= $ch;
8929
-              }
8930
-              else {
8931
-                  decode_error("malformed number (no digits after exp sign)");
8932
-              }
8933
-  
8934
-              while(defined(next_chr) and $ch =~ /\d/){
8935
-                  $n .= $ch;
8936
-              }
8937
-  
8938
-          }
8939
-  
8940
-          $v .= $n;
8941
-  
8942
-          if ($v !~ /[.eE]/ and length $v > $max_intsize) {
8943
-              if ($allow_bigint) { # from Adam Sussman
8944
-                  require Math::BigInt;
8945
-                  return Math::BigInt->new($v);
8946
-              }
8947
-              else {
8948
-                  return "$v";
8949
-              }
8950
-          }
8951
-          elsif ($allow_bigint) {
8952
-              require Math::BigFloat;
8953
-              return Math::BigFloat->new($v);
8954
-          }
8955
-  
8956
-          return 0+$v;
8957
-      }
8958
-  
8959
-  
8960
-      sub is_valid_utf8 {
8961
-  
8962
-          $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
8963
-                    : $_[0] =~ /[\xC2-\xDF]/  ? 2
8964
-                    : $_[0] =~ /[\xE0-\xEF]/  ? 3
8965
-                    : $_[0] =~ /[\xF0-\xF4]/  ? 4
8966
-                    : 0
8967
-                    ;
8968
-  
8969
-          return unless $utf8_len;
8970
-  
8971
-          my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
8972
-  
8973
-          return ( $is_valid_utf8 =~ /^(?:
8974
-               [\x00-\x7F]
8975
-              |[\xC2-\xDF][\x80-\xBF]
8976
-              |[\xE0][\xA0-\xBF][\x80-\xBF]
8977
-              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
8978
-              |[\xED][\x80-\x9F][\x80-\xBF]
8979
-              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
8980
-              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
8981
-              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
8982
-              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
8983
-          )$/x )  ? $is_valid_utf8 : '';
8984
-      }
8985
-  
8986
-  
8987
-      sub decode_error {
8988
-          my $error  = shift;
8989
-          my $no_rep = shift;
8990
-          my $str    = defined $text ? substr($text, $at) : '';
8991
-          my $mess   = '';
8992
-          my $type   = $] >= 5.008           ? 'U*'
8993
-                     : $] <  5.006           ? 'C*'
8994
-                     : utf8::is_utf8( $str ) ? 'U*' # 5.6
8995
-                     : 'C*'
8996
-                     ;
8997
-  
8998
-          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
8999
-              $mess .=  $c == 0x07 ? '\a'
9000
-                      : $c == 0x09 ? '\t'
9001
-                      : $c == 0x0a ? '\n'
9002
-                      : $c == 0x0d ? '\r'
9003
-                      : $c == 0x0c ? '\f'
9004
-                      : $c <  0x20 ? sprintf('\x{%x}', $c)
9005
-                      : $c == 0x5c ? '\\\\'
9006
-                      : $c <  0x80 ? chr($c)
9007
-                      : sprintf('\x{%x}', $c)
9008
-                      ;
9009
-              if ( length $mess >= 20 ) {
9010
-                  $mess .= '...';
9011
-                  last;
9012
-              }
9013
-          }
9014
-  
9015
-          unless ( length $mess ) {
9016
-              $mess = '(end of string)';
9017
-          }
9018
-  
9019
-          Carp::croak (
9020
-              $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
9021
-          );
9022
-  
9023
-      }
9024
-  
9025
-  
9026
-      sub _json_object_hook {
9027
-          my $o    = $_[0];
9028
-          my @ks = keys %{$o};
9029
-  
9030
-          if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
9031
-              my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
9032
-              if (@val == 1) {
9033
-                  return $val[0];
9034
-              }
9035
-          }
9036
-  
9037
-          my @val = $cb_object->($o) if ($cb_object);
9038
-          if (@val == 0 or @val > 1) {
9039
-              return $o;
9040
-          }
9041
-          else {
9042
-              return $val[0];
9043
-          }
9044
-      }
9045
-  
9046
-  
9047
-      sub PP_decode_box {
9048
-          {
9049
-              text    => $text,
9050
-              at      => $at,
9051
-              ch      => $ch,
9052
-              len     => $len,
9053
-              depth   => $depth,
9054
-              encoding      => $encoding,
9055
-              is_valid_utf8 => $is_valid_utf8,
9056
-          };
9057
-      }
9058
-  
9059
-  } # PARSE
9060
-  
9061
-  
9062
-  sub _decode_surrogates { # from perlunicode
9063
-      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
9064
-      my $un  = pack('U*', $uni);
9065
-      utf8::encode( $un );
9066
-      return $un;
9067
-  }
9068
-  
9069
-  
9070
-  sub _decode_unicode {
9071
-      my $un = pack('U', hex shift);
9072
-      utf8::encode( $un );
9073
-      return $un;
9074
-  }
9075
-  
9076
-  #
9077
-  # Setup for various Perl versions (the code from JSON::PP58)
9078
-  #
9079
-  
9080
-  BEGIN {
9081
-  
9082
-      unless ( defined &utf8::is_utf8 ) {
9083
-         require Encode;
9084
-         *utf8::is_utf8 = *Encode::is_utf8;
9085
-      }
9086
-  
9087
-      if ( $] >= 5.008 ) {
9088
-          *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
9089
-          *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
9090
-          *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
9091
-          *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
9092
-      }
9093
-  
9094
-      if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
9095
-          package JSON::PP;
9096
-          require subs;
9097
-          subs->import('join');
9098
-          eval q|
9099
-              sub join {
9100
-                  return '' if (@_ < 2);
9101
-                  my $j   = shift;
9102
-                  my $str = shift;
9103
-                  for (@_) { $str .= $j . $_; }
9104
-                  return $str;
9105
-              }
9106
-          |;
9107
-      }
9108
-  
9109
-  
9110
-      sub JSON::PP::incr_parse {
9111
-          local $Carp::CarpLevel = 1;
9112
-          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
9113
-      }
9114
-  
9115
-  
9116
-      sub JSON::PP::incr_skip {
9117
-          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
9118
-      }
9119
-  
9120
-  
9121
-      sub JSON::PP::incr_reset {
9122
-          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
9123
-      }
9124
-  
9125
-      eval q{
9126
-          sub JSON::PP::incr_text : lvalue {
9127
-              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
9128
-  
9129
-              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
9130
-                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
9131
-              }
9132
-              $_[0]->{_incr_parser}->{incr_text};
9133
-          }
9134
-      } if ( $] >= 5.006 );
9135
-  
9136
-  } # Setup for various Perl versions (the code from JSON::PP58)
9137
-  
9138
-  
9139
-  ###############################
9140
-  # Utilities
9141
-  #
9142
-  
9143
-  BEGIN {
9144
-      eval 'require Scalar::Util';
9145
-      unless($@){
9146
-          *JSON::PP::blessed = \&Scalar::Util::blessed;
9147
-          *JSON::PP::reftype = \&Scalar::Util::reftype;
9148
-          *JSON::PP::refaddr = \&Scalar::Util::refaddr;
9149
-      }
9150
-      else{ # This code is from Sclar::Util.
9151
-          # warn $@;
9152
-          eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
9153
-          *JSON::PP::blessed = sub {
9154
-              local($@, $SIG{__DIE__}, $SIG{__WARN__});
9155
-              ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
9156
-          };
9157
-          my %tmap = qw(
9158
-              B::NULL   SCALAR
9159
-              B::HV     HASH
9160
-              B::AV     ARRAY
9161
-              B::CV     CODE
9162
-              B::IO     IO
9163
-              B::GV     GLOB
9164
-              B::REGEXP REGEXP
9165
-          );
9166
-          *JSON::PP::reftype = sub {
9167
-              my $r = shift;
9168
-  
9169
-              return undef unless length(ref($r));
9170
-  
9171
-              my $t = ref(B::svref_2object($r));
9172
-  
9173
-              return
9174
-                  exists $tmap{$t} ? $tmap{$t}
9175
-                : length(ref($$r)) ? 'REF'
9176
-                :                    'SCALAR';
9177
-          };
9178
-          *JSON::PP::refaddr = sub {
9179
-            return undef unless length(ref($_[0]));
9180
-  
9181
-            my $addr;
9182
-            if(defined(my $pkg = blessed($_[0]))) {
9183
-              $addr .= bless $_[0], 'Scalar::Util::Fake';
9184
-              bless $_[0], $pkg;
9185
-            }
9186
-            else {
9187
-              $addr .= $_[0]
9188
-            }
9189
-  
9190
-            $addr =~ /0x(\w+)/;
9191
-            local $^W;
9192
-            #no warnings 'portable';
9193
-            hex($1);
9194
-          }
9195
-      }
9196
-  }
9197
-  
9198
-  
9199
-  # shamely copied and modified from JSON::XS code.
9200
-  
9201
-  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
9202
-  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
9203
-  
9204
-  sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
9205
-  
9206
-  sub true  { $JSON::PP::true  }
9207
-  sub false { $JSON::PP::false }
9208
-  sub null  { undef; }
9209
-  
9210
-  ###############################
9211
-  
9212
-  package JSON::PP::Boolean;
9213
-  
9214
-  use overload (
9215
-     "0+"     => sub { ${$_[0]} },
9216
-     "++"     => sub { $_[0] = ${$_[0]} + 1 },
9217
-     "--"     => sub { $_[0] = ${$_[0]} - 1 },
9218
-     fallback => 1,
9219
-  );
9220
-  
9221
-  
9222
-  ###############################
9223
-  
9224
-  package JSON::PP::IncrParser;
9225
-  
9226
-  use strict;
9227
-  
9228
-  use constant INCR_M_WS   => 0; # initial whitespace skipping
9229
-  use constant INCR_M_STR  => 1; # inside string
9230
-  use constant INCR_M_BS   => 2; # inside backslash
9231
-  use constant INCR_M_JSON => 3; # outside anything, count nesting
9232
-  use constant INCR_M_C0   => 4;
9233
-  use constant INCR_M_C1   => 5;
9234
-  
9235
-  $JSON::PP::IncrParser::VERSION = '1.01';
9236
-  
9237
-  my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
9238
-  
9239
-  sub new {
9240
-      my ( $class ) = @_;
9241
-  
9242
-      bless {
9243
-          incr_nest    => 0,
9244
-          incr_text    => undef,
9245
-          incr_parsing => 0,
9246
-          incr_p       => 0,
9247
-      }, $class;
9248
-  }
9249
-  
9250
-  
9251
-  sub incr_parse {
9252
-      my ( $self, $coder, $text ) = @_;
9253
-  
9254
-      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
9255
-  
9256
-      if ( defined $text ) {
9257
-          if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
9258
-              utf8::upgrade( $self->{incr_text} ) ;
9259
-              utf8::decode( $self->{incr_text} ) ;
9260
-          }
9261
-          $self->{incr_text} .= $text;
9262
-      }
9263
-  
9264
-  
9265
-      my $max_size = $coder->get_max_size;
9266
-  
9267
-      if ( defined wantarray ) {
9268
-  
9269
-          $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
9270
-  
9271
-          if ( wantarray ) {
9272
-              my @ret;
9273
-  
9274
-              $self->{incr_parsing} = 1;
9275
-  
9276
-              do {
9277
-                  push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
9278
-  
9279
-                  unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
9280
-                      $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
9281
-                  }
9282
-  
9283
-              } until ( length $self->{incr_text} >= $self->{incr_p} );
9284
-  
9285
-              $self->{incr_parsing} = 0;
9286
-  
9287
-              return @ret;
9288
-          }
9289
-          else { # in scalar context
9290
-              $self->{incr_parsing} = 1;
9291
-              my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
9292
-              $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
9293
-              return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
9294
-          }
9295
-  
9296
-      }
9297
-  
9298
-  }
9299
-  
9300
-  
9301
-  sub _incr_parse {
9302
-      my ( $self, $coder, $text, $skip ) = @_;
9303
-      my $p = $self->{incr_p};
9304
-      my $restore = $p;
9305
-  
9306
-      my @obj;
9307
-      my $len = length $text;
9308
-  
9309
-      if ( $self->{incr_mode} == INCR_M_WS ) {
9310
-          while ( $len > $p ) {
9311
-              my $s = substr( $text, $p, 1 );
9312
-              $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
9313
-              $self->{incr_mode} = INCR_M_JSON;
9314
-              last;
9315
-         }
9316
-      }
9317
-  
9318
-      while ( $len > $p ) {
9319
-          my $s = substr( $text, $p++, 1 );
9320
-  
9321
-          if ( $s eq '"' ) {
9322
-              if (substr( $text, $p - 2, 1 ) eq '\\' ) {
9323
-                  next;
9324
-              }
9325
-  
9326
-              if ( $self->{incr_mode} != INCR_M_STR  ) {
9327
-                  $self->{incr_mode} = INCR_M_STR;
9328
-              }
9329
-              else {
9330
-                  $self->{incr_mode} = INCR_M_JSON;
9331
-                  unless ( $self->{incr_nest} ) {
9332
-                      last;
9333
-                  }
9334
-              }
9335
-          }
9336
-  
9337
-          if ( $self->{incr_mode} == INCR_M_JSON ) {
9338
-  
9339
-              if ( $s eq '[' or $s eq '{' ) {
9340
-                  if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
9341
-                      Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
9342
-                  }
9343
-              }
9344
-              elsif ( $s eq ']' or $s eq '}' ) {
9345
-                  last if ( --$self->{incr_nest} <= 0 );
9346
-              }
9347
-              elsif ( $s eq '#' ) {
9348
-                  while ( $len > $p ) {
9349
-                      last if substr( $text, $p++, 1 ) eq "\n";
9350
-                  }
9351
-              }
9352
-  
9353
-          }
9354
-  
9355
-      }
9356
-  
9357
-      $self->{incr_p} = $p;
9358
-  
9359
-      return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
9360
-      return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
9361
-  
9362
-      return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
9363
-  
9364
-      local $Carp::CarpLevel = 2;
9365
-  
9366
-      $self->{incr_p} = $restore;
9367
-      $self->{incr_c} = $p;
9368
-  
9369
-      my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
9370
-  
9371
-      $self->{incr_text} = substr( $self->{incr_text}, $p );
9372
-      $self->{incr_p} = 0;
9373
-  
9374
-      return $obj or '';
9375
-  }
9376
-  
9377
-  
9378
-  sub incr_text {
9379
-      if ( $_[0]->{incr_parsing} ) {
9380
-          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
9381
-      }
9382
-      $_[0]->{incr_text};
9383
-  }
9384
-  
9385
-  
9386
-  sub incr_skip {
9387
-      my $self  = shift;
9388
-      $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
9389
-      $self->{incr_p} = 0;
9390
-  }
9391
-  
9392
-  
9393
-  sub incr_reset {
9394
-      my $self = shift;
9395
-      $self->{incr_text}    = undef;
9396
-      $self->{incr_p}       = 0;
9397
-      $self->{incr_mode}    = 0;
9398
-      $self->{incr_nest}    = 0;
9399
-      $self->{incr_parsing} = 0;
9400
-  }
9401
-  
9402
-  ###############################
9403
-  
9404
-  
9405
-  1;
9406
-  __END__
9407
-  =pod
9408
-  
9409
-JSON_PP
9410
-
9411
-$fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
9412
-  use JSON::PP ();
9413
-  use strict;
9414
-  
9415
-  1;
9416
-  
9417
-JSON_PP_BOOLEAN
9418
-
9419
-$fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
9420
-  package Module::CPANfile;
9421
-  use strict;
9422
-  use warnings;
9423
-  use Cwd;
9424
-  
9425
-  our $VERSION = '0.9010';
9426
-  
9427
-  sub new {
9428
-      my($class, $file) = @_;
9429
-      bless {}, $class;
9430
-  }
9431
-  
9432
-  sub load {
9433
-      my($proto, $file) = @_;
9434
-      my $self = ref $proto ? $proto : $proto->new;
9435
-      $self->{file} = $file || "cpanfile";
9436
-      $self->parse;
9437
-      $self;
9438
-  }
9439
-  
9440
-  sub parse {
9441
-      my $self = shift;
9442
-  
9443
-      my $file = Cwd::abs_path($self->{file});
9444
-      $self->{result} = Module::CPANfile::Environment::parse($file) or die $@;
9445
-  }
9446
-  
9447
-  sub prereqs { shift->prereq }
9448
-  
9449
-  sub prereq {
9450
-      my $self = shift;
9451
-      require CPAN::Meta::Prereqs;
9452
-      CPAN::Meta::Prereqs->new($self->prereq_specs);
9453
-  }
9454
-  
9455
-  sub prereq_specs {
9456
-      my $self = shift;
9457
-      $self->{result}{spec};
9458
-  }
9459
-  
9460
-  sub merge_meta {
9461
-      my($self, $file, $version) = @_;
9462
-  
9463
-      require CPAN::Meta;
9464
-  
9465
-      $version ||= $file =~ /\.yml$/ ? '1.4' : '2';
9466
-  
9467
-      my $prereq = $self->prereqs;
9468
-  
9469
-      my $meta = CPAN::Meta->load_file($file);
9470
-      my $prereqs_hash = $prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;
9471
-      my $struct = { %{$meta->as_struct}, prereqs => $prereqs_hash };
9472
-  
9473
-      CPAN::Meta->new($struct)->save($file, { version => $version });
9474
-  }
9475
-  
9476
-  package Module::CPANfile::Environment;
9477
-  use strict;
9478
-  
9479
-  my @bindings = qw(
9480
-      on requires recommends suggests conflicts
9481
-      osname perl
9482
-      configure_requires build_requires test_requires author_requires
9483
-  );
9484
-  
9485
-  my $file_id = 1;
9486
-  
9487
-  sub import {
9488
-      my($class, $result_ref) = @_;
9489
-      my $pkg = caller;
9490
-  
9491
-      $$result_ref = Module::CPANfile::Result->new;
9492
-      for my $binding (@bindings) {
9493
-          no strict 'refs';
9494
-          *{"$pkg\::$binding"} = sub { $$result_ref->$binding(@_) };
9495
-      }
9496
-  }
9497
-  
9498
-  sub parse {
9499
-      my $file = shift;
9500
-  
9501
-      my $code = do {
9502
-          open my $fh, "<", $file or die "$file: $!";
9503
-          join '', <$fh>;
9504
-      };
9505
-  
9506
-      my($res, $err);
9507
-  
9508
-      {
9509
-          local $@;
9510
-          $res = eval sprintf <<EVAL, $file_id++;
9511
-  package Module::CPANfile::Sandbox%d;
9512
-  no warnings;
9513
-  my \$_result;
9514
-  BEGIN { import Module::CPANfile::Environment \\\$_result };
9515
-  
9516
-  $code;
9517
-  
9518
-  \$_result;
9519
-  EVAL
9520
-          $err = $@;
9521
-      }
9522
-  
9523
-      if ($err) { die "Parsing $file failed: $err" };
9524
-  
9525
-      return $res;
9526
-  }
9527
-  
9528
-  package Module::CPANfile::Result;
9529
-  use strict;
9530
-  
9531
-  sub new {
9532
-      bless {
9533
-          phase => 'runtime', # default phase
9534
-          spec  => {},
9535
-      }, shift;
9536
-  }
9537
-  
9538
-  sub on {
9539
-      my($self, $phase, $code) = @_;
9540
-      local $self->{phase} = $phase;
9541
-      $code->()
9542
-  }
9543
-  
9544
-  sub osname { die "TODO" }
9545
-  sub perl { die "TODO" }
9546
-  
9547
-  sub requires {
9548
-      my($self, $module, $requirement) = @_;
9549
-      $self->{spec}{$self->{phase}}{requires}{$module} = $requirement || 0;
9550
-  }
9551
-  
9552
-  sub recommends {
9553
-      my($self, $module, $requirement) = @_;
9554
-      $self->{spec}->{$self->{phase}}{recommends}{$module} = $requirement || 0;
9555
-  }
9556
-  
9557
-  sub suggests {
9558
-      my($self, $module, $requirement) = @_;
9559
-      $self->{spec}->{$self->{phase}}{suggests}{$module} = $requirement || 0;
9560
-  }
9561
-  
9562
-  sub conflicts {
9563
-      my($self, $module, $requirement) = @_;
9564
-      $self->{spec}->{$self->{phase}}{conflicts}{$module} = $requirement || 0;
9565
-  }
9566
-  
9567
-  # Module::Install compatible shortcuts
9568
-  
9569
-  sub configure_requires {
9570
-      my($self, @args) = @_;
9571
-      $self->on(configure => sub { $self->requires(@args) });
9572
-  }
9573
-  
9574
-  sub build_requires {
9575
-      my($self, @args) = @_;
9576
-      $self->on(build => sub { $self->requires(@args) });
9577
-  }
9578
-  
9579
-  sub test_requires {
9580
-      my($self, @args) = @_;
9581
-      $self->on(test => sub { $self->requires(@args) });
9582
-  }
9583
-  
9584
-  sub author_requires {
9585
-      my($self, @args) = @_;
9586
-      $self->on(develop => sub { $self->requires(@args) });
9587
-  }
9588
-  
9589
-  package Module::CPANfile;
9590
-  
9591
-  1;
9592
-  
9593
-  __END__
9594
-  
9595
-  
9596
-MODULE_CPANFILE
9597
-
9598
-$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
9599
-  # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
9600
-  # vim:ts=8:sw=2:et:sta:sts=2
9601
-  package Module::Metadata;
9602
-  
9603
-  # Adapted from Perl-licensed code originally distributed with
9604
-  # Module-Build by Ken Williams
9605
-  
9606
-  # This module provides routines to gather information about
9607
-  # perl modules (assuming this may be expanded in the distant
9608
-  # parrot future to look at other types of modules).
9609
-  
9610
-  use strict;
9611
-  use vars qw($VERSION);
9612
-  $VERSION = '1.000011';
9613
-  $VERSION = eval $VERSION;
9614
-  
9615
-  use Carp qw/croak/;
9616
-  use File::Spec;
9617
-  use IO::File;
9618
-  use version 0.87;
9619
-  BEGIN {
9620
-    if ($INC{'Log/Contextual.pm'}) {
9621
-      Log::Contextual->import('log_info');
9622
-    } else {
9623
-      *log_info = sub (&) { warn $_[0]->() };
9624
-    }
9625
-  }
9626
-  use File::Find qw(find);
9627
-  
9628
-  my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
9629
-  
9630
-  my $PKG_REGEXP  = qr{   # match a package declaration
9631
-    ^[\s\{;]*             # intro chars on a line
9632
-    package               # the word 'package'
9633
-    \s+                   # whitespace
9634
-    ([\w:]+)              # a package name
9635
-    \s*                   # optional whitespace
9636
-    ($V_NUM_REGEXP)?        # optional version number
9637
-    \s*                   # optional whitesapce
9638
-    [;\{]                 # semicolon line terminator or block start (since 5.16)
9639
-  }x;
9640
-  
9641
-  my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
9642
-    ([\$*])         # sigil - $ or *
9643
-    (
9644
-      (             # optional leading package name
9645
-        (?:::|\')?  # possibly starting like just :: (�  la $::VERSION)
9646
-        (?:\w+(?:::|\'))*  # Foo::Bar:: ...
9647
-      )?
9648
-      VERSION
9649
-    )\b
9650
-  }x;
9651
-  
9652
-  my $VERS_REGEXP = qr{ # match a VERSION definition
9653
-    (?:
9654
-      \(\s*$VARNAME_REGEXP\s*\) # with parens
9655
-    |
9656
-      $VARNAME_REGEXP           # without parens
9657
-    )
9658
-    \s*
9659
-    =[^=~]  # = but not ==, nor =~
9660
-  }x;
9661
-  
9662
-  sub new_from_file {
9663
-    my $class    = shift;
9664
-    my $filename = File::Spec->rel2abs( shift );
9665
-  
9666
-    return undef unless defined( $filename ) && -f $filename;
9667
-    return $class->_init(undef, $filename, @_);
9668
-  }
9669
-  
9670
-  sub new_from_handle {
9671
-    my $class    = shift;
9672
-    my $handle   = shift;
9673
-    my $filename = shift;
9674
-    return undef unless defined($handle) && defined($filename);
9675
-    $filename = File::Spec->rel2abs( $filename );
9676
-  
9677
-    return $class->_init(undef, $filename, @_, handle => $handle);
9678
-  
9679
-  }
9680
-  
9681
-  
9682
-  sub new_from_module {
9683
-    my $class   = shift;
9684
-    my $module  = shift;
9685
-    my %props   = @_;
9686
-  
9687
-    $props{inc} ||= \@INC;
9688
-    my $filename = $class->find_module_by_name( $module, $props{inc} );
9689
-    return undef unless defined( $filename ) && -f $filename;
9690
-    return $class->_init($module, $filename, %props);
9691
-  }
9692
-  
9693
-  {
9694
-    
9695
-    my $compare_versions = sub {
9696
-      my ($v1, $op, $v2) = @_;
9697
-      $v1 = version->new($v1)
9698
-        unless UNIVERSAL::isa($v1,'version');
9699
-    
9700
-      my $eval_str = "\$v1 $op \$v2";
9701
-      my $result   = eval $eval_str;
9702
-      log_info { "error comparing versions: '$eval_str' $@" } if $@;
9703
-    
9704
-      return $result;
9705
-    };
9706
-  
9707
-    my $normalize_version = sub {
9708
-      my ($version) = @_;
9709
-      if ( $version =~ /[=<>!,]/ ) { # logic, not just version
9710
-        # take as is without modification
9711
-      }
9712
-      elsif ( ref $version eq 'version' ) { # version objects
9713
-        $version = $version->is_qv ? $version->normal : $version->stringify;
9714
-      }
9715
-      elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
9716
-        # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
9717
-        $version = "v$version";
9718
-      }
9719
-      else {
9720
-        # leave alone
9721
-      }
9722
-      return $version;
9723
-    };
9724
-  
9725
-    # separate out some of the conflict resolution logic
9726
-  
9727
-    my $resolve_module_versions = sub {
9728
-      my $packages = shift;
9729
-    
9730
-      my( $file, $version );
9731
-      my $err = '';
9732
-        foreach my $p ( @$packages ) {
9733
-          if ( defined( $p->{version} ) ) {
9734
-    	if ( defined( $version ) ) {
9735
-     	  if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
9736
-    	    $err .= "  $p->{file} ($p->{version})\n";
9737
-    	  } else {
9738
-    	    # same version declared multiple times, ignore
9739
-    	  }
9740
-    	} else {
9741
-    	  $file    = $p->{file};
9742
-    	  $version = $p->{version};
9743
-    	}
9744
-          }
9745
-          $file ||= $p->{file} if defined( $p->{file} );
9746
-        }
9747
-    
9748
-      if ( $err ) {
9749
-        $err = "  $file ($version)\n" . $err;
9750
-      }
9751
-    
9752
-      my %result = (
9753
-        file    => $file,
9754
-        version => $version,
9755
-        err     => $err
9756
-      );
9757
-    
9758
-      return \%result;
9759
-    };
9760
-  
9761
-    sub provides {
9762
-      my $class = shift;
9763
-  
9764
-      croak "provides() requires key/value pairs \n" if @_ % 2;
9765
-      my %args = @_;
9766
-  
9767
-      croak "provides() takes only one of 'dir' or 'files'\n"
9768
-        if $args{dir} && $args{files};
9769
-  
9770
-      croak "provides() requires a 'version' argument"
9771
-        unless defined $args{version};
9772
-  
9773
-      croak "provides() does not support version '$args{version}' metadata"
9774
-          unless grep { $args{version} eq $_ } qw/1.4 2/;
9775
-  
9776
-      $args{prefix} = 'lib' unless defined $args{prefix};
9777
-  
9778
-      my $p;
9779
-      if ( $args{dir} ) {
9780
-        $p = $class->package_versions_from_directory($args{dir});
9781
-      }
9782
-      else {
9783
-        croak "provides() requires 'files' to be an array reference\n"
9784
-          unless ref $args{files} eq 'ARRAY';
9785
-        $p = $class->package_versions_from_directory($args{files});
9786
-      }
9787
-  
9788
-      # Now, fix up files with prefix
9789
-      if ( length $args{prefix} ) { # check in case disabled with q{}
9790
-        $args{prefix} =~ s{/$}{};
9791
-        for my $v ( values %$p ) {
9792
-          $v->{file} = "$args{prefix}/$v->{file}";
9793
-        }
9794
-      }
9795
-  
9796
-      return $p
9797
-    }
9798
-  
9799
-    sub package_versions_from_directory {
9800
-      my ( $class, $dir, $files ) = @_;
9801
-  
9802
-      my @files;
9803
-  
9804
-      if ( $files ) {
9805
-        @files = @$files;
9806
-      } else {
9807
-        find( {
9808
-          wanted => sub {
9809
-            push @files, $_ if -f $_ && /\.pm$/;
9810
-          },
9811
-          no_chdir => 1,
9812
-        }, $dir );
9813
-      }
9814
-  
9815
-      # First, we enumerate all packages & versions,
9816
-      # separating into primary & alternative candidates
9817
-      my( %prime, %alt );
9818
-      foreach my $file (@files) {
9819
-        my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
9820
-        my @path = split( /\//, $mapped_filename );
9821
-        (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
9822
-    
9823
-        my $pm_info = $class->new_from_file( $file );
9824
-    
9825
-        foreach my $package ( $pm_info->packages_inside ) {
9826
-          next if $package eq 'main';  # main can appear numerous times, ignore
9827
-          next if $package eq 'DB';    # special debugging package, ignore
9828
-          next if grep /^_/, split( /::/, $package ); # private package, ignore
9829
-    
9830
-          my $version = $pm_info->version( $package );
9831
-    
9832
-          $prime_package = $package if lc($prime_package) eq lc($package);
9833
-          if ( $package eq $prime_package ) {
9834
-            if ( exists( $prime{$package} ) ) {
9835
-              croak "Unexpected conflict in '$package'; multiple versions found.\n";
9836
-            } else {
9837
-              $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
9838
-              $prime{$package}{file} = $mapped_filename;
9839
-              $prime{$package}{version} = $version if defined( $version );
9840
-            }
9841
-          } else {
9842
-            push( @{$alt{$package}}, {
9843
-                                      file    => $mapped_filename,
9844
-                                      version => $version,
9845
-                                     } );
9846
-          }
9847
-        }
9848
-      }
9849
-    
9850
-      # Then we iterate over all the packages found above, identifying conflicts
9851
-      # and selecting the "best" candidate for recording the file & version
9852
-      # for each package.
9853
-      foreach my $package ( keys( %alt ) ) {
9854
-        my $result = $resolve_module_versions->( $alt{$package} );
9855
-    
9856
-        if ( exists( $prime{$package} ) ) { # primary package selected
9857
-    
9858
-          if ( $result->{err} ) {
9859
-    	# Use the selected primary package, but there are conflicting
9860
-    	# errors among multiple alternative packages that need to be
9861
-    	# reported
9862
-            log_info {
9863
-    	    "Found conflicting versions for package '$package'\n" .
9864
-    	    "  $prime{$package}{file} ($prime{$package}{version})\n" .
9865
-    	    $result->{err}
9866
-            };
9867
-    
9868
-          } elsif ( defined( $result->{version} ) ) {
9869
-    	# There is a primary package selected, and exactly one
9870
-    	# alternative package
9871
-    
9872
-    	if ( exists( $prime{$package}{version} ) &&
9873
-    	     defined( $prime{$package}{version} ) ) {
9874
-    	  # Unless the version of the primary package agrees with the
9875
-    	  # version of the alternative package, report a conflict
9876
-    	  if ( $compare_versions->(
9877
-                   $prime{$package}{version}, '!=', $result->{version}
9878
-                 )
9879
-               ) {
9880
-  
9881
-              log_info {
9882
-                "Found conflicting versions for package '$package'\n" .
9883
-    	      "  $prime{$package}{file} ($prime{$package}{version})\n" .
9884
-    	      "  $result->{file} ($result->{version})\n"
9885
-              };
9886
-    	  }
9887
-    
9888
-    	} else {
9889
-    	  # The prime package selected has no version so, we choose to
9890
-    	  # use any alternative package that does have a version
9891
-    	  $prime{$package}{file}    = $result->{file};
9892
-    	  $prime{$package}{version} = $result->{version};
9893
-    	}
9894
-    
9895
-          } else {
9896
-    	# no alt package found with a version, but we have a prime
9897
-    	# package so we use it whether it has a version or not
9898
-          }
9899
-    
9900
-        } else { # No primary package was selected, use the best alternative
9901
-    
9902
-          if ( $result->{err} ) {
9903
-            log_info {
9904
-              "Found conflicting versions for package '$package'\n" .
9905
-    	    $result->{err}
9906
-            };
9907
-          }
9908
-    
9909
-          # Despite possible conflicting versions, we choose to record
9910
-          # something rather than nothing
9911
-          $prime{$package}{file}    = $result->{file};
9912
-          $prime{$package}{version} = $result->{version}
9913
-    	  if defined( $result->{version} );
9914
-        }
9915
-      }
9916
-    
9917
-      # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
9918
-      # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
9919
-      for (grep defined $_->{version}, values %prime) {
9920
-        $_->{version} = $normalize_version->( $_->{version} );
9921
-      }
9922
-    
9923
-      return \%prime;
9924
-    }
9925
-  } 
9926
-    
9927
-  
9928
-  sub _init {
9929
-    my $class    = shift;
9930
-    my $module   = shift;
9931
-    my $filename = shift;
9932
-    my %props = @_;
9933
-  
9934
-    my $handle = delete $props{handle};
9935
-    my( %valid_props, @valid_props );
9936
-    @valid_props = qw( collect_pod inc );
9937
-    @valid_props{@valid_props} = delete( @props{@valid_props} );
9938
-    warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
9939
-  
9940
-    my %data = (
9941
-      module       => $module,
9942
-      filename     => $filename,
9943
-      version      => undef,
9944
-      packages     => [],
9945
-      versions     => {},
9946
-      pod          => {},
9947
-      pod_headings => [],
9948
-      collect_pod  => 0,
9949
-  
9950
-      %valid_props,
9951
-    );
9952
-  
9953
-    my $self = bless(\%data, $class);
9954
-  
9955
-    if ( $handle ) {
9956
-      $self->_parse_fh($handle);
9957
-    }
9958
-    else {
9959
-      $self->_parse_file();
9960
-    }
9961
-  
9962
-    unless($self->{module} and length($self->{module})) {
9963
-      my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
9964
-      if($f =~ /\.pm$/) {
9965
-        $f =~ s/\..+$//;
9966
-        my @candidates = grep /$f$/, @{$self->{packages}};
9967
-        $self->{module} = shift(@candidates); # punt
9968
-      }
9969
-      else {
9970
-        if(grep /main/, @{$self->{packages}}) {
9971
-          $self->{module} = 'main';
9972
-        }
9973
-        else {
9974
-          $self->{module} = $self->{packages}[0] || '';
9975
-        }
9976
-      }
9977
-    }
9978
-  
9979
-    $self->{version} = $self->{versions}{$self->{module}}
9980
-        if defined( $self->{module} );
9981
-  
9982
-    return $self;
9983
-  }
9984
-  
9985
-  # class method
9986
-  sub _do_find_module {
9987
-    my $class   = shift;
9988
-    my $module  = shift || croak 'find_module_by_name() requires a package name';
9989
-    my $dirs    = shift || \@INC;
9990
-  
9991
-    my $file = File::Spec->catfile(split( /::/, $module));
9992
-    foreach my $dir ( @$dirs ) {
9993
-      my $testfile = File::Spec->catfile($dir, $file);
9994
-      return [ File::Spec->rel2abs( $testfile ), $dir ]
9995
-  	if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
9996
-      return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
9997
-  	if -e "$testfile.pm";
9998
-    }
9999
-    return;
10000
-  }
10001
-  
10002
-  # class method
10003
-  sub find_module_by_name {
10004
-    my $found = shift()->_do_find_module(@_) or return;
10005
-    return $found->[0];
10006
-  }
10007
-  
10008
-  # class method
10009
-  sub find_module_dir_by_name {
10010
-    my $found = shift()->_do_find_module(@_) or return;
10011
-    return $found->[1];
10012
-  }
10013
-  
10014
-  
10015
-  # given a line of perl code, attempt to parse it if it looks like a
10016
-  # $VERSION assignment, returning sigil, full name, & package name
10017
-  sub _parse_version_expression {
10018
-    my $self = shift;
10019
-    my $line = shift;
10020
-  
10021
-    my( $sig, $var, $pkg );
10022
-    if ( $line =~ /$VERS_REGEXP/o ) {
10023
-      ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
10024
-      if ( $pkg ) {
10025
-        $pkg = ($pkg eq '::') ? 'main' : $pkg;
10026
-        $pkg =~ s/::$//;
10027
-      }
10028
-    }
10029
-  
10030
-    return ( $sig, $var, $pkg );
10031
-  }
10032
-  
10033
-  sub _parse_file {
10034
-    my $self = shift;
10035
-  
10036
-    my $filename = $self->{filename};
10037
-    my $fh = IO::File->new( $filename )
10038
-      or croak( "Can't open '$filename': $!" );
10039
-  
10040
-    $self->_handle_bom($fh, $filename);
10041
-  
10042
-    $self->_parse_fh($fh);
10043
-  }
10044
-  
10045
-  # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
10046
-  # If there's one, then skip it and set the :encoding layer appropriately.
10047
-  sub _handle_bom {
10048
-    my ($self, $fh, $filename) = @_;
10049
-  
10050
-    my $pos = $fh->getpos;
10051
-    return unless defined $pos;
10052
-  
10053
-    my $buf = ' ' x 2;
10054
-    my $count = $fh->read( $buf, length $buf );
10055
-    return unless defined $count and $count >= 2;
10056
-  
10057
-    my $encoding;
10058
-    if ( $buf eq "\x{FE}\x{FF}" ) {
10059
-      $encoding = 'UTF-16BE';
10060
-    } elsif ( $buf eq "\x{FF}\x{FE}" ) {
10061
-      $encoding = 'UTF-16LE';
10062
-    } elsif ( $buf eq "\x{EF}\x{BB}" ) {
10063
-      $buf = ' ';
10064
-      $count = $fh->read( $buf, length $buf );
10065
-      if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
10066
-        $encoding = 'UTF-8';
10067
-      }
10068
-    }
10069
-  
10070
-    if ( defined $encoding ) {
10071
-      if ( "$]" >= 5.008 ) {
10072
-        # $fh->binmode requires perl 5.10
10073
-        binmode( $fh, ":encoding($encoding)" );
10074
-      }
10075
-    } else {
10076
-      $fh->setpos($pos)
10077
-        or croak( sprintf "Can't reset position to the top of '$filename'" );
10078
-    }
10079
-  
10080
-    return $encoding;
10081
-  }
10082
-  
10083
-  sub _parse_fh {
10084
-    my ($self, $fh) = @_;
10085
-  
10086
-    my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
10087
-    my( @pkgs, %vers, %pod, @pod );
10088
-    my $pkg = 'main';
10089
-    my $pod_sect = '';
10090
-    my $pod_data = '';
10091
-  
10092
-    while (defined( my $line = <$fh> )) {
10093
-      my $line_num = $.;
10094
-  
10095
-      chomp( $line );
10096
-  
10097
-      # From toke.c : any line that begins by "=X", where X is an alphabetic
10098
-      # character, introduces a POD segment.
10099
-      my $is_cut;
10100
-      if ( $line =~ /^=([a-zA-Z].*)/ ) {
10101
-        my $cmd = $1;
10102
-        # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
10103
-        # character (which includes the newline, but here we chomped it away).
10104
-        $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
10105
-        $in_pod = !$is_cut;
10106
-      }
10107
-  
10108
-      if ( $in_pod ) {
10109
-  
10110
-        if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
10111
-  	push( @pod, $1 );
10112
-  	if ( $self->{collect_pod} && length( $pod_data ) ) {
10113
-            $pod{$pod_sect} = $pod_data;
10114
-            $pod_data = '';
10115
-          }
10116
-  	$pod_sect = $1;
10117
-  
10118
-        } elsif ( $self->{collect_pod} ) {
10119
-  	$pod_data .= "$line\n";
10120
-  
10121
-        }
10122
-  
10123
-      } elsif ( $is_cut ) {
10124
-  
10125
-        if ( $self->{collect_pod} && length( $pod_data ) ) {
10126
-          $pod{$pod_sect} = $pod_data;
10127
-          $pod_data = '';
10128
-        }
10129
-        $pod_sect = '';
10130
-  
10131
-      } else {
10132
-  
10133
-        # Skip comments in code
10134
-        next if $line =~ /^\s*#/;
10135
-  
10136
-        # Would be nice if we could also check $in_string or something too
10137
-        last if $line =~ /^__(?:DATA|END)__$/;
10138
-  
10139
-        # parse $line to see if it's a $VERSION declaration
10140
-        my( $vers_sig, $vers_fullname, $vers_pkg ) =
10141
-            ($line =~ /VERSION/)
10142
-                ? $self->_parse_version_expression( $line )
10143
-                : ();
10144
-  
10145
-        if ( $line =~ /$PKG_REGEXP/o ) {
10146
-          $pkg = $1;
10147
-          push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
10148
-          $vers{$pkg} = $2 unless exists( $vers{$pkg} );
10149
-          $need_vers = defined $2 ? 0 : 1;
10150
-  
10151
-        # VERSION defined with full package spec, i.e. $Module::VERSION
10152
-        } elsif ( $vers_fullname && $vers_pkg ) {
10153
-  	push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
10154
-  	$need_vers = 0 if $vers_pkg eq $pkg;
10155
-  
10156
-  	unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
10157
-  	  $vers{$vers_pkg} =
10158
-  	    $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
10159
-  	}
10160
-  
10161
-        # first non-comment line in undeclared package main is VERSION
10162
-        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
10163
-  	$need_vers = 0;
10164
-  	my $v =
10165
-  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
10166
-  	$vers{$pkg} = $v;
10167
-  	push( @pkgs, 'main' );
10168
-  
10169
-        # first non-comment line in undeclared package defines package main
10170
-        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
10171
-  	$need_vers = 1;
10172
-  	$vers{main} = '';
10173
-  	push( @pkgs, 'main' );
10174
-  
10175
-        # only keep if this is the first $VERSION seen
10176
-        } elsif ( $vers_fullname && $need_vers ) {
10177
-  	$need_vers = 0;
10178
-  	my $v =
10179
-  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
10180
-  
10181
-  
10182
-  	unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
10183
-  	  $vers{$pkg} = $v;
10184
-  	} 
10185
-  
10186
-        }
10187
-  
10188
-      }
10189
-  
10190
-    }
10191
-  
10192
-    if ( $self->{collect_pod} && length($pod_data) ) {
10193
-      $pod{$pod_sect} = $pod_data;
10194
-    }
10195
-  
10196
-    $self->{versions} = \%vers;
10197
-    $self->{packages} = \@pkgs;
10198
-    $self->{pod} = \%pod;
10199
-    $self->{pod_headings} = \@pod;
10200
-  }
10201
-  
10202
-  {
10203
-  my $pn = 0;
10204
-  sub _evaluate_version_line {
10205
-    my $self = shift;
10206
-    my( $sigil, $var, $line ) = @_;
10207
-  
10208
-    # Some of this code came from the ExtUtils:: hierarchy.
10209
-  
10210
-    # We compile into $vsub because 'use version' would cause
10211
-    # compiletime/runtime issues with local()
10212
-    my $vsub;
10213
-    $pn++; # everybody gets their own package
10214
-    my $eval = qq{BEGIN { q#  Hide from _packages_inside()
10215
-      #; package Module::Metadata::_version::p$pn;
10216
-      use version;
10217
-      no strict;
10218
-  
10219
-        \$vsub = sub {
10220
-          local $sigil$var;
10221
-          \$$var=undef;
10222
-          $line;
10223
-          \$$var
10224
-        };
10225
-    }};
10226
-  
10227
-    local $^W;
10228
-    # Try to get the $VERSION
10229
-    eval $eval;
10230
-    # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
10231
-    # installed, so we need to hunt in ./lib for it
10232
-    if ( $@ =~ /Can't locate/ && -d 'lib' ) {
10233
-      local @INC = ('lib',@INC);
10234
-      eval $eval;
10235
-    }
10236
-    warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
10237
-      if $@;
10238
-    (ref($vsub) eq 'CODE') or
10239
-      croak "failed to build version sub for $self->{filename}";
10240
-    my $result = eval { $vsub->() };
10241
-    croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
10242
-      if $@;
10243
-  
10244
-    # Upgrade it into a version object
10245
-    my $version = eval { _dwim_version($result) };
10246
-  
10247
-    croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
10248
-      unless defined $version; # "0" is OK!
10249
-  
10250
-    return $version;
10251
-  }
10252
-  }
10253
-  
10254
-  # Try to DWIM when things fail the lax version test in obvious ways
10255
-  {
10256
-    my @version_prep = (
10257
-      # Best case, it just works
10258
-      sub { return shift },
10259
-  
10260
-      # If we still don't have a version, try stripping any
10261
-      # trailing junk that is prohibited by lax rules
10262
-      sub {
10263
-        my $v = shift;
10264
-        $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
10265
-        return $v;
10266
-      },
10267
-  
10268
-      # Activestate apparently creates custom versions like '1.23_45_01', which
10269
-      # cause version.pm to think it's an invalid alpha.  So check for that
10270
-      # and strip them
10271
-      sub {
10272
-        my $v = shift;
10273
-        my $num_dots = () = $v =~ m{(\.)}g;
10274
-        my $num_unders = () = $v =~ m{(_)}g;
10275
-        my $leading_v = substr($v,0,1) eq 'v';
10276
-        if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
10277
-          $v =~ s{_}{}g;
10278
-          $num_unders = () = $v =~ m{(_)}g;
10279
-        }
10280
-        return $v;
10281
-      },
10282
-  
10283
-      # Worst case, try numifying it like we would have before version objects
10284
-      sub {
10285
-        my $v = shift;
10286
-        no warnings 'numeric';
10287
-        return 0 + $v;
10288
-      },
10289
-  
10290
-    );
10291
-  
10292
-    sub _dwim_version {
10293
-      my ($result) = shift;
10294
-  
10295
-      return $result if ref($result) eq 'version';
10296
-  
10297
-      my ($version, $error);
10298
-      for my $f (@version_prep) {
10299
-        $result = $f->($result);
10300
-        $version = eval { version->new($result) };
10301
-        $error ||= $@ if $@; # capture first failure
10302
-        last if defined $version;
10303
-      }
10304
-  
10305
-      croak $error unless defined $version;
10306
-  
10307
-      return $version;
10308
-    }
10309
-  }
10310
-  
10311
-  ############################################################
10312
-  
10313
-  # accessors
10314
-  sub name            { $_[0]->{module}           }
10315
-  
10316
-  sub filename        { $_[0]->{filename}         }
10317
-  sub packages_inside { @{$_[0]->{packages}}      }
10318
-  sub pod_inside      { @{$_[0]->{pod_headings}}  }
10319
-  sub contains_pod    { $#{$_[0]->{pod_headings}} }
10320
-  
10321
-  sub version {
10322
-      my $self = shift;
10323
-      my $mod  = shift || $self->{module};
10324
-      my $vers;
10325
-      if ( defined( $mod ) && length( $mod ) &&
10326
-  	 exists( $self->{versions}{$mod} ) ) {
10327
-  	return $self->{versions}{$mod};
10328
-      } else {
10329
-  	return undef;
10330
-      }
10331
-  }
10332
-  
10333
-  sub pod {
10334
-      my $self = shift;
10335
-      my $sect = shift;
10336
-      if ( defined( $sect ) && length( $sect ) &&
10337
-  	 exists( $self->{pod}{$sect} ) ) {
10338
-  	return $self->{pod}{$sect};
10339
-      } else {
10340
-  	return undef;
10341
-      }
10342
-  }
10343
-  
10344
-  1;
10345
-  
10346
-MODULE_METADATA
10347
-
10348
-$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
10349
-  package Parse::CPAN::Meta;
10350
-  
10351
-  use strict;
10352
-  use Carp 'croak';
10353
-  
10354
-  # UTF Support?
10355
-  sub HAVE_UTF8 () { $] >= 5.007003 }
10356
-  sub IO_LAYER () { $] >= 5.008001 ? ":utf8" : "" }  
10357
-  
10358
-  BEGIN {
10359
-  	if ( HAVE_UTF8 ) {
10360
-  		# The string eval helps hide this from Test::MinimumVersion
10361
-  		eval "require utf8;";
10362
-  		die "Failed to load UTF-8 support" if $@;
10363
-  	}
10364
-  
10365
-  	# Class structure
10366
-  	require 5.004;
10367
-  	require Exporter;
10368
-  	$Parse::CPAN::Meta::VERSION   = '1.4404';
10369
-  	@Parse::CPAN::Meta::ISA       = qw{ Exporter      };
10370
-  	@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
10371
-  }
10372
-  
10373
-  sub load_file {
10374
-    my ($class, $filename) = @_;
10375
-  
10376
-    if ($filename =~ /\.ya?ml$/) {
10377
-      return $class->load_yaml_string(_slurp($filename));
10378
-    }
10379
-  
10380
-    if ($filename =~ /\.json$/) {
10381
-      return $class->load_json_string(_slurp($filename));
10382
-    }
10383
-  
10384
-    croak("file type cannot be determined by filename");
10385
-  }
10386
-  
10387
-  sub load_yaml_string {
10388
-    my ($class, $string) = @_;
10389
-    my $backend = $class->yaml_backend();
10390
-    my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
10391
-    if ( $@ ) { 
10392
-      croak $backend->can('errstr') ? $backend->errstr : $@
10393
-    }
10394
-    return $data || {}; # in case document was valid but empty
10395
-  }
10396
-  
10397
-  sub load_json_string {
10398
-    my ($class, $string) = @_;
10399
-    return $class->json_backend()->new->decode($string);
10400
-  }
10401
-  
10402
-  sub yaml_backend {
10403
-    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
10404
-    if (! defined $ENV{PERL_YAML_BACKEND} ) {
10405
-      _can_load( 'CPAN::Meta::YAML', 0.002 )
10406
-        or croak "CPAN::Meta::YAML 0.002 is not available\n";
10407
-      return "CPAN::Meta::YAML";
10408
-    }
10409
-    else {
10410
-      my $backend = $ENV{PERL_YAML_BACKEND};
10411
-      _can_load( $backend )
10412
-        or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
10413
-      $backend->can("Load")
10414
-        or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
10415
-      return $backend;
10416
-    }
10417
-  }
10418
-  
10419
-  sub json_backend {
10420
-    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
10421
-    if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
10422
-      _can_load( 'JSON::PP' => 2.27103 )
10423
-        or croak "JSON::PP 2.27103 is not available\n";
10424
-      return 'JSON::PP';
10425
-    }
10426
-    else {
10427
-      _can_load( 'JSON' => 2.5 )
10428
-        or croak  "JSON 2.5 is required for " .
10429
-                  "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
10430
-      return "JSON";
10431
-    }
10432
-  }
10433
-  
10434
-  sub _slurp {
10435
-    open my $fh, "<" . IO_LAYER, "$_[0]"
10436
-      or die "can't open $_[0] for reading: $!";
10437
-    return do { local $/; <$fh> };
10438
-  }
10439
-    
10440
-  sub _can_load {
10441
-    my ($module, $version) = @_;
10442
-    (my $file = $module) =~ s{::}{/}g;
10443
-    $file .= ".pm";
10444
-    return 1 if $INC{$file};
10445
-    return 0 if exists $INC{$file}; # prior load failed
10446
-    eval { require $file; 1 }
10447
-      or return 0;
10448
-    if ( defined $version ) {
10449
-      eval { $module->VERSION($version); 1 }
10450
-        or return 0;
10451
-    }
10452
-    return 1;
10453
-  }
10454
-  
10455
-  # Kept for backwards compatibility only
10456
-  # Create an object from a file
10457
-  sub LoadFile ($) {
10458
-    require CPAN::Meta::YAML;
10459
-    return CPAN::Meta::YAML::LoadFile(shift)
10460
-      or die CPAN::Meta::YAML->errstr;
10461
-  }
10462
-  
10463
-  # Parse a document from a string.
10464
-  sub Load ($) {
10465
-    require CPAN::Meta::YAML;
10466
-    return CPAN::Meta::YAML::Load(shift)
10467
-      or die CPAN::Meta::YAML->errstr;
10468
-  }
10469
-  
10470
-  1;
10471
-  
10472
-  __END__
10473
-  
10474
-PARSE_CPAN_META
10475
-
10476
-$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
10477
-  package lib::core::only;
10478
-  
10479
-  use strict;
10480
-  use warnings FATAL => 'all';
10481
-  use Config;
10482
-  
10483
-  sub import {
10484
-    @INC = @Config{qw(privlibexp archlibexp)};
10485
-    return
10486
-  }
10487
-  
10488
-  1;
10489
-LIB_CORE_ONLY
10490
-
10491
-$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
10492
-  use strict;
10493
-  use warnings;
10494
-  
10495
-  package local::lib;
10496
-  
10497
-  use 5.008001; # probably works with earlier versions but I'm not supporting them
10498
-                # (patches would, of course, be welcome)
10499
-  
10500
-  use File::Spec ();
10501
-  use File::Path ();
10502
-  use Config;
10503
-  
10504
-  our $VERSION = '1.008009'; # 1.8.9
10505
-  
10506
-  our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
10507
-  
10508
-  sub DEACTIVATE_ONE () { 1 }
10509
-  sub DEACTIVATE_ALL () { 2 }
10510
-  
10511
-  sub INTERPOLATE_ENV () { 1 }
10512
-  sub LITERAL_ENV     () { 0 }
10513
-  
10514
-  sub import {
10515
-    my ($class, @args) = @_;
10516
-  
10517
-    # Remember what PERL5LIB was when we started
10518
-    my $perl5lib = $ENV{PERL5LIB} || '';
10519
-  
10520
-    my %arg_store;
10521
-    for my $arg (@args) {
10522
-      # check for lethal dash first to stop processing before causing problems
10523
-      if ($arg =~ /−/) {
10524
-        die <<'DEATH';
10525
-  WHOA THERE! It looks like you've got some fancy dashes in your commandline!
10526
-  These are *not* the traditional -- dashes that software recognizes. You
10527
-  probably got these by copy-pasting from the perldoc for this module as
10528
-  rendered by a UTF8-capable formatter. This most typically happens on an OS X
10529
-  terminal, but can happen elsewhere too. Please try again after replacing the
10530
-  dashes with normal minus signs.
10531
-  DEATH
10532
-      }
10533
-      elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
10534
-        (my $flag = $arg) =~ s/--//;
10535
-        $arg_store{$flag} = 1;
10536
-      }
10537
-      elsif($arg =~ /^--/) {
10538
-        die "Unknown import argument: $arg";
10539
-      }
10540
-      else {
10541
-        # assume that what's left is a path
10542
-        $arg_store{path} = $arg;
10543
-      }
10544
-    }
10545
-  
10546
-    if($arg_store{'self-contained'}) {
10547
-      die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
10548
-    }
10549
-  
10550
-    my $deactivating = 0;
10551
-    if ($arg_store{deactivate}) {
10552
-      $deactivating = DEACTIVATE_ONE;
10553
-    }
10554
-    if ($arg_store{'deactivate-all'}) {
10555
-      $deactivating = DEACTIVATE_ALL;
10556
-    }
10557
-  
10558
-    $arg_store{path} = $class->resolve_path($arg_store{path});
10559
-    $class->setup_local_lib_for($arg_store{path}, $deactivating);
10560
-  
10561
-    for (@INC) { # Untaint @INC
10562
-      next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
10563
-      m/(.*)/ and $_ = $1;
10564
-    }
10565
-  }
10566
-  
10567
-  sub pipeline;
10568
-  
10569
-  sub pipeline {
10570
-    my @methods = @_;
10571
-    my $last = pop(@methods);
10572
-    if (@methods) {
10573
-      \sub {
10574
-        my ($obj, @args) = @_;
10575
-        $obj->${pipeline @methods}(
10576
-          $obj->$last(@args)
10577
-        );
10578
-      };
10579
-    } else {
10580
-      \sub {
10581
-        shift->$last(@_);
10582
-      };
10583
-    }
10584
-  }
10585
-  
10586
-  sub _uniq {
10587
-      my %seen;
10588
-      grep { ! $seen{$_}++ } @_;
10589
-  }
10590
-  
10591
-  sub resolve_path {
10592
-    my ($class, $path) = @_;
10593
-    $class->${pipeline qw(
10594
-      resolve_relative_path
10595
-      resolve_home_path
10596
-      resolve_empty_path
10597
-    )}($path);
10598
-  }
10599
-  
10600
-  sub resolve_empty_path {
10601
-    my ($class, $path) = @_;
10602
-    if (defined $path) {
10603
-      $path;
10604
-    } else {
10605
-      '~/perl5';
10606
-    }
10607
-  }
10608
-  
10609
-  sub resolve_home_path {
10610
-    my ($class, $path) = @_;
10611
-    return $path unless ($path =~ /^~/);
10612
-    my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
10613
-    my $tried_file_homedir;
10614
-    my $homedir = do {
10615
-      if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
10616
-        $tried_file_homedir = 1;
10617
-        if (defined $user) {
10618
-          File::HomeDir->users_home($user);
10619
-        } else {
10620
-          File::HomeDir->my_home;
10621
-        }
10622
-      } else {
10623
-        if (defined $user) {
10624
-          (getpwnam $user)[7];
10625
-        } else {
10626
-          if (defined $ENV{HOME}) {
10627
-            $ENV{HOME};
10628
-          } else {
10629
-            (getpwuid $<)[7];
10630
-          }
10631
-        }
10632
-      }
10633
-    };
10634
-    unless (defined $homedir) {
10635
-      require Carp;
10636
-      Carp::croak(
10637
-        "Couldn't resolve homedir for "
10638
-        .(defined $user ? $user : 'current user')
10639
-        .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
10640
-      );
10641
-    }
10642
-    $path =~ s/^~[^\/]*/$homedir/;
10643
-    $path;
10644
-  }
10645
-  
10646
-  sub resolve_relative_path {
10647
-    my ($class, $path) = @_;
10648
-    $path = File::Spec->rel2abs($path);
10649
-  }
10650
-  
10651
-  sub setup_local_lib_for {
10652
-    my ($class, $path, $deactivating) = @_;
10653
-  
10654
-    my $interpolate = LITERAL_ENV;
10655
-    my @active_lls = $class->active_paths;
10656
-  
10657
-    $class->ensure_dir_structure_for($path);
10658
-  
10659
-    # On Win32 directories often contain spaces. But some parts of the CPAN
10660
-    # toolchain don't like that. To avoid this, GetShortPathName() gives us
10661
-    # an alternate representation that has none.
10662
-    # This only works if the directory already exists.
10663
-    $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
10664
-  
10665
-    if (! $deactivating) {
10666
-      if (@active_lls && $active_lls[-1] eq $path) {
10667
-        exit 0 if $0 eq '-';
10668
-        return; # Asked to add what's already at the top of the stack
10669
-      } elsif (grep { $_ eq $path} @active_lls) {
10670
-        # Asked to add a dir that's lower in the stack -- so we remove it from
10671
-        # where it is, and then add it back at the top.
10672
-        $class->setup_env_hash_for($path, DEACTIVATE_ONE);
10673
-        # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff
10674
-        # anymore because we're taking something *out*.
10675
-        $interpolate = INTERPOLATE_ENV;
10676
-      }
10677
-    }
10678
-  
10679
-    if ($0 eq '-') {
10680
-      $class->print_environment_vars_for($path, $deactivating, $interpolate);
10681
-      exit 0;
10682
-    } else {
10683
-      $class->setup_env_hash_for($path, $deactivating);
10684
-      my $arch_dir = $Config{archname};
10685
-      @INC = _uniq(
10686
-    (
10687
-        # Inject $path/$archname for each path in PERL5LIB
10688
-        map { ( File::Spec->catdir($_, $arch_dir), $_ ) }
10689
-        split($Config{path_sep}, $ENV{PERL5LIB})
10690
-    ),
10691
-    @INC
10692
-      );
10693
-    }
10694
-  }
10695
-  
10696
-  sub install_base_bin_path {
10697
-    my ($class, $path) = @_;
10698
-    File::Spec->catdir($path, 'bin');
10699
-  }
10700
-  
10701
-  sub install_base_perl_path {
10702
-    my ($class, $path) = @_;
10703
-    File::Spec->catdir($path, 'lib', 'perl5');
10704
-  }
10705
-  
10706
-  sub install_base_arch_path {
10707
-    my ($class, $path) = @_;
10708
-    File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
10709
-  }
10710
-  
10711
-  sub ensure_dir_structure_for {
10712
-    my ($class, $path) = @_;
10713
-    unless (-d $path) {
10714
-      warn "Attempting to create directory ${path}\n";
10715
-    }
10716
-    File::Path::mkpath($path);
10717
-    return
10718
-  }
10719
-  
10720
-  sub guess_shelltype {
10721
-    my $shellbin = 'sh';
10722
-    if(defined $ENV{'SHELL'}) {
10723
-        my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
10724
-        $shellbin = $shell_bin_path_parts[-1];
10725
-    }
10726
-    my $shelltype = do {
10727
-        local $_ = $shellbin;
10728
-        if(/csh/) {
10729
-            'csh'
10730
-        } else {
10731
-            'bourne'
10732
-        }
10733
-    };
10734
-  
10735
-    # Both Win32 and Cygwin have $ENV{COMSPEC} set.
10736
-    if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
10737
-        my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
10738
-        $shellbin = $shell_bin_path_parts[-1];
10739
-           $shelltype = do {
10740
-                   local $_ = $shellbin;
10741
-                   if(/command\.com/) {
10742
-                           'win32'
10743
-                   } elsif(/cmd\.exe/) {
10744
-                           'win32'
10745
-                   } elsif(/4nt\.exe/) {
10746
-                           'win32'
10747
-                   } else {
10748
-                           $shelltype
10749
-                   }
10750
-           };
10751
-    }
10752
-    return $shelltype;
10753
-  }
10754
-  
10755
-  sub print_environment_vars_for {
10756
-    my ($class, $path, $deactivating, $interpolate) = @_;
10757
-    print $class->environment_vars_string_for($path, $deactivating, $interpolate);
10758
-  }
10759
-  
10760
-  sub environment_vars_string_for {
10761
-    my ($class, $path, $deactivating, $interpolate) = @_;
10762
-    my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate);
10763
-    my $out = '';
10764
-  
10765
-    # rather basic csh detection, goes on the assumption that something won't
10766
-    # call itself csh unless it really is. also, default to bourne in the
10767
-    # pathological situation where a user doesn't have $ENV{SHELL} defined.
10768
-    # note also that shells with funny names, like zoid, are assumed to be
10769
-    # bourne.
10770
-  
10771
-    my $shelltype = $class->guess_shelltype;
10772
-  
10773
-    while (@envs) {
10774
-      my ($name, $value) = (shift(@envs), shift(@envs));
10775
-      $value =~ s/(\\")/\\$1/g if defined $value;
10776
-      $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
10777
-    }
10778
-    return $out;
10779
-  }
10780
-  
10781
-  # simple routines that take two arguments: an %ENV key and a value. return
10782
-  # strings that are suitable for passing directly to the relevant shell to set
10783
-  # said key to said value.
10784
-  sub build_bourne_env_declaration {
10785
-    my $class = shift;
10786
-    my($name, $value) = @_;
10787
-    return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
10788
-  }
10789
-  
10790
-  sub build_csh_env_declaration {
10791
-    my $class = shift;
10792
-    my($name, $value) = @_;
10793
-    return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
10794
-  }
10795
-  
10796
-  sub build_win32_env_declaration {
10797
-    my $class = shift;
10798
-    my($name, $value) = @_;
10799
-    return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
10800
-  }
10801
-  
10802
-  sub setup_env_hash_for {
10803
-    my ($class, $path, $deactivating) = @_;
10804
-    my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
10805
-    @ENV{keys %envs} = values %envs;
10806
-  }
10807
-  
10808
-  sub build_environment_vars_for {
10809
-    my ($class, $path, $deactivating, $interpolate) = @_;
10810
-  
10811
-    if ($deactivating == DEACTIVATE_ONE) {
10812
-      return $class->build_deactivate_environment_vars_for($path, $interpolate);
10813
-    } elsif ($deactivating == DEACTIVATE_ALL) {
10814
-      return $class->build_deact_all_environment_vars_for($path, $interpolate);
10815
-    } else {
10816
-      return $class->build_activate_environment_vars_for($path, $interpolate);
10817
-    }
10818
-  }
10819
-  
10820
-  # Build an environment value for a variable like PATH from a list of paths.
10821
-  # References to existing variables are given as references to the variable name.
10822
-  # Duplicates are removed.
10823
-  #
10824
-  # options:
10825
-  # - interpolate: INTERPOLATE_ENV/LITERAL_ENV
10826
-  # - exists: paths are included only if they exist (default: interpolate == INTERPOLATE_ENV)
10827
-  # - filter: function to apply to each path do decide if it must be included
10828
-  # - empty: the value to return in the case of empty value
10829
-  my %ENV_LIST_VALUE_DEFAULTS = (
10830
-      interpolate => INTERPOLATE_ENV,
10831
-      exists => undef,
10832
-      filter => sub { 1 },
10833
-      empty => undef,
10834
-  );
10835
-  sub _env_list_value {
10836
-    my $options = shift;
10837
-    die(sprintf "unknown option '$_' at %s line %u\n", (caller)[1..2])
10838
-      for grep { !exists $ENV_LIST_VALUE_DEFAULTS{$_} } keys %$options;
10839
-    my %options = (%ENV_LIST_VALUE_DEFAULTS, %{ $options });
10840
-    $options{exists} = $options{interpolate} == INTERPOLATE_ENV
10841
-      unless defined $options{exists};
10842
-  
10843
-    my %seen;
10844
-  
10845
-    my $value = join($Config{path_sep}, map {
10846
-        ref $_ ? ($^O eq 'MSWin32' ? "%${$_}%" : "\$${$_}") : $_
10847
-      } grep {
10848
-        ref $_ || (defined $_
10849
-                   && length($_) > 0
10850
-                   && !$seen{$_}++
10851
-                   && $options{filter}->($_)
10852
-                   && (!$options{exists} || -e $_))
10853
-      } map {
10854
-        if (ref $_ eq 'SCALAR' && $options{interpolate} == INTERPOLATE_ENV) {
10855
-          exists $ENV{${$_}} ? (split /\Q$Config{path_sep}/, $ENV{${$_}}) : ()
10856
-        } else {
10857
-          $_
10858
-        }
10859
-      } @_);
10860
-    return length($value) ? $value : $options{empty};
10861
-  }
10862
-  
10863
-  sub build_activate_environment_vars_for {
10864
-    my ($class, $path, $interpolate) = @_;
10865
-    return (
10866
-      PERL_LOCAL_LIB_ROOT =>
10867
-              _env_list_value(
10868
-                { interpolate => $interpolate, exists => 0, empty => '' },
10869
-                \'PERL_LOCAL_LIB_ROOT',
10870
-                $path,
10871
-              ),
10872
-      PERL_MB_OPT => "--install_base ${path}",
10873
-      PERL_MM_OPT => "INSTALL_BASE=${path}",
10874
-      PERL5LIB =>
10875
-              _env_list_value(
10876
-                { interpolate => $interpolate, exists => 0, empty => '' },
10877
-                $class->install_base_perl_path($path),
10878
-                \'PERL5LIB',
10879
-              ),
10880
-      PATH => _env_list_value(
10881
-                { interpolate => $interpolate, exists => 0, empty => '' },
10882
-          $class->install_base_bin_path($path),
10883
-                \'PATH',
10884
-              ),
10885
-    )
10886
-  }
10887
-  
10888
-  sub active_paths {
10889
-    my ($class) = @_;
10890
-  
10891
-    return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
10892
-    return grep { $_ ne '' } split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT};
10893
-  }
10894
-  
10895
-  sub build_deactivate_environment_vars_for {
10896
-    my ($class, $path, $interpolate) = @_;
10897
-  
10898
-    my @active_lls = $class->active_paths;
10899
-  
10900
-    if (!grep { $_ eq $path } @active_lls) {
10901
-      warn "Tried to deactivate inactive local::lib '$path'\n";
10902
-      return ();
10903
-    }
10904
-  
10905
-    my $perl_path = $class->install_base_perl_path($path);
10906
-    my $arch_path = $class->install_base_arch_path($path);
10907
-    my $bin_path = $class->install_base_bin_path($path);
10908
-  
10909
-  
10910
-    my %env = (
10911
-      PERL_LOCAL_LIB_ROOT => _env_list_value(
10912
-        {
10913
-          exists => 0,
10914
-        },
10915
-        grep { $_ ne $path } @active_lls
10916
-      ),
10917
-      PERL5LIB => _env_list_value(
10918
-        {
10919
-          exists => 0,
10920
-          filter => sub {
10921
-            $_ ne $perl_path && $_ ne $arch_path
10922
-          },
10923
-        },
10924
-        \'PERL5LIB',
10925
-      ),
10926
-      PATH => _env_list_value(
10927
-        {
10928
-          exists => 0,
10929
-          filter => sub { $_ ne $bin_path },
10930
-        },
10931
-        \'PATH',
10932
-      ),
10933
-    );
10934
-  
10935
-    # If removing ourselves from the "top of the stack", set install paths to
10936
-    # correspond with the new top of stack.
10937
-    if ($active_lls[-1] eq $path) {
10938
-      my $new_top = $active_lls[-2];
10939
-      $env{PERL_MB_OPT} = defined($new_top) ? "--install_base ${new_top}" : undef;
10940
-      $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE=${new_top}" : undef;
10941
-    }
10942
-  
10943
-    return %env;
10944
-  }
10945
-  
10946
-  sub build_deact_all_environment_vars_for {
10947
-    my ($class, $path, $interpolate) = @_;
10948
-  
10949
-    my @active_lls = $class->active_paths;
10950
-  
10951
-    my %perl_paths = map { (
10952
-        $class->install_base_perl_path($_) => 1,
10953
-        $class->install_base_arch_path($_) => 1
10954
-      ) } @active_lls;
10955
-    my %bin_paths = map { (
10956
-        $class->install_base_bin_path($_) => 1,
10957
-      ) } @active_lls;
10958
-  
10959
-    my %env = (
10960
-      PERL_LOCAL_LIB_ROOT => undef,
10961
-      PERL_MM_OPT => undef,
10962
-      PERL_MB_OPT => undef,
10963
-      PERL5LIB => _env_list_value(
10964
-        {
10965
-          exists => 0,
10966
-          filter => sub {
10967
-            ! scalar grep { exists $perl_paths{$_} } $_[0]
10968
-          },
10969
-        },
10970
-        \'PERL5LIB'
10971
-      ),
10972
-      PATH => _env_list_value(
10973
-        {
10974
-          exists => 0,
10975
-          filter => sub {
10976
-            ! scalar grep { exists $bin_paths{$_} } $_[0]
10977
-          },
10978
-        },
10979
-        \'PATH'
10980
-      ),
10981
-    );
10982
-  
10983
-    return %env;
10984
-  }
10985
-  
10986
-  1;
10987
-LOCAL_LIB
10988
-
10989
-$fatpacked{"version.pm"} = <<'VERSION';
10990
-  #!perl -w
10991
-  package version;
10992
-  
10993
-  use 5.005_04;
10994
-  use strict;
10995
-  
10996
-  use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
10997
-  
10998
-  $VERSION = 0.9901;
10999
-  
11000
-  $CLASS = 'version';
11001
-  
11002
-  #--------------------------------------------------------------------------#
11003
-  # Version regexp components
11004
-  #--------------------------------------------------------------------------#
11005
-  
11006
-  # Fraction part of a decimal version number.  This is a common part of
11007
-  # both strict and lax decimal versions
11008
-  
11009
-  my $FRACTION_PART = qr/\.[0-9]+/;
11010
-  
11011
-  # First part of either decimal or dotted-decimal strict version number.
11012
-  # Unsigned integer with no leading zeroes (except for zero itself) to
11013
-  # avoid confusion with octal.
11014
-  
11015
-  my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
11016
-  
11017
-  # First part of either decimal or dotted-decimal lax version number.
11018
-  # Unsigned integer, but allowing leading zeros.  Always interpreted
11019
-  # as decimal.  However, some forms of the resulting syntax give odd
11020
-  # results if used as ordinary Perl expressions, due to how perl treats
11021
-  # octals.  E.g.
11022
-  #   version->new("010" ) == 10
11023
-  #   version->new( 010  ) == 8
11024
-  #   version->new( 010.2) == 82  # "8" . "2"
11025
-  
11026
-  my $LAX_INTEGER_PART = qr/[0-9]+/;
11027
-  
11028
-  # Second and subsequent part of a strict dotted-decimal version number.
11029
-  # Leading zeroes are permitted, and the number is always decimal.
11030
-  # Limited to three digits to avoid overflow when converting to decimal
11031
-  # form and also avoid problematic style with excessive leading zeroes.
11032
-  
11033
-  my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
11034
-  
11035
-  # Second and subsequent part of a lax dotted-decimal version number.
11036
-  # Leading zeroes are permitted, and the number is always decimal.  No
11037
-  # limit on the numerical value or number of digits, so there is the
11038
-  # possibility of overflow when converting to decimal form.
11039
-  
11040
-  my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
11041
-  
11042
-  # Alpha suffix part of lax version number syntax.  Acts like a
11043
-  # dotted-decimal part.
11044
-  
11045
-  my $LAX_ALPHA_PART = qr/_[0-9]+/;
11046
-  
11047
-  #--------------------------------------------------------------------------#
11048
-  # Strict version regexp definitions
11049
-  #--------------------------------------------------------------------------#
11050
-  
11051
-  # Strict decimal version number.
11052
-  
11053
-  my $STRICT_DECIMAL_VERSION =
11054
-      qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
11055
-  
11056
-  # Strict dotted-decimal version number.  Must have both leading "v" and
11057
-  # at least three parts, to avoid confusion with decimal syntax.
11058
-  
11059
-  my $STRICT_DOTTED_DECIMAL_VERSION =
11060
-      qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
11061
-  
11062
-  # Complete strict version number syntax -- should generally be used
11063
-  # anchored: qr/ \A $STRICT \z /x
11064
-  
11065
-  $STRICT =
11066
-      qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
11067
-  
11068
-  #--------------------------------------------------------------------------#
11069
-  # Lax version regexp definitions
11070
-  #--------------------------------------------------------------------------#
11071
-  
11072
-  # Lax decimal version number.  Just like the strict one except for
11073
-  # allowing an alpha suffix or allowing a leading or trailing
11074
-  # decimal-point
11075
-  
11076
-  my $LAX_DECIMAL_VERSION =
11077
-      qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
11078
-  	|
11079
-  	$FRACTION_PART $LAX_ALPHA_PART?
11080
-      /x;
11081
-  
11082
-  # Lax dotted-decimal version number.  Distinguished by having either
11083
-  # leading "v" or at least three non-alpha parts.  Alpha part is only
11084
-  # permitted if there are at least two non-alpha parts. Strangely
11085
-  # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
11086
-  # so when there is no "v", the leading part is optional
11087
-  
11088
-  my $LAX_DOTTED_DECIMAL_VERSION =
11089
-      qr/
11090
-  	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
11091
-  	|
11092
-  	$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
11093
-      /x;
11094
-  
11095
-  # Complete lax version number syntax -- should generally be used
11096
-  # anchored: qr/ \A $LAX \z /x
11097
-  #
11098
-  # The string 'undef' is a special case to make for easier handling
11099
-  # of return values from ExtUtils::MM->parse_version
11100
-  
11101
-  $LAX =
11102
-      qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
11103
-  
11104
-  #--------------------------------------------------------------------------#
11105
-  
11106
-  {
11107
-      local $SIG{'__DIE__'};
11108
-      eval "use version::vxs $VERSION";
11109
-      if ( $@ ) { # don't have the XS version installed
11110
-  	eval "use version::vpp $VERSION"; # don't tempt fate
11111
-  	die "$@" if ( $@ );
11112
-  	push @ISA, "version::vpp";
11113
-  	local $^W;
11114
-  	*version::qv = \&version::vpp::qv;
11115
-  	*version::declare = \&version::vpp::declare;
11116
-  	*version::_VERSION = \&version::vpp::_VERSION;
11117
-  	*version::vcmp = \&version::vpp::vcmp;
11118
-  	if ($] >= 5.009000) {
11119
-  	    no strict 'refs';
11120
-  	    *version::stringify = \&version::vpp::stringify;
11121
-  	    *{'version::(""'} = \&version::vpp::stringify;
11122
-  	    *{'version::(<=>'} = \&version::vpp::vcmp;
11123
-  	    *version::new = \&version::vpp::new;
11124
-  	    *version::parse = \&version::vpp::parse;
11125
-  	}
11126
-      }
11127
-      else { # use XS module
11128
-  	push @ISA, "version::vxs";
11129
-  	local $^W;
11130
-  	*version::declare = \&version::vxs::declare;
11131
-  	*version::qv = \&version::vxs::qv;
11132
-  	*version::_VERSION = \&version::vxs::_VERSION;
11133
-  	*version::vcmp = \&version::vxs::VCMP;
11134
-  	if ($] >= 5.009000) {
11135
-  	    no strict 'refs';
11136
-  	    *version::stringify = \&version::vxs::stringify;
11137
-  	    *{'version::(""'} = \&version::vxs::stringify;
11138
-  	    *{'version::(<=>'} = \&version::vxs::VCMP;
11139
-  	    *version::new = \&version::vxs::new;
11140
-  	    *version::parse = \&version::vxs::parse;
11141
-  	}
11142
-  
11143
-      }
11144
-  }
11145
-  
11146
-  # Preloaded methods go here.
11147
-  sub import {
11148
-      no strict 'refs';
11149
-      my ($class) = shift;
11150
-  
11151
-      # Set up any derived class
11152
-      unless ($class eq 'version') {
11153
-  	local $^W;
11154
-  	*{$class.'::declare'} =  \&version::declare;
11155
-  	*{$class.'::qv'} = \&version::qv;
11156
-      }
11157
-  
11158
-      my %args;
11159
-      if (@_) { # any remaining terms are arguments
11160
-  	map { $args{$_} = 1 } @_
11161
-      }
11162
-      else { # no parameters at all on use line
11163
-      	%args = 
11164
-  	(
11165
-  	    qv => 1,
11166
-  	    'UNIVERSAL::VERSION' => 1,
11167
-  	);
11168
-      }
11169
-  
11170
-      my $callpkg = caller();
11171
-      
11172
-      if (exists($args{declare})) {
11173
-  	*{$callpkg.'::declare'} = 
11174
-  	    sub {return $class->declare(shift) }
11175
-  	  unless defined(&{$callpkg.'::declare'});
11176
-      }
11177
-  
11178
-      if (exists($args{qv})) {
11179
-  	*{$callpkg.'::qv'} =
11180
-  	    sub {return $class->qv(shift) }
11181
-  	  unless defined(&{$callpkg.'::qv'});
11182
-      }
11183
-  
11184
-      if (exists($args{'UNIVERSAL::VERSION'})) {
11185
-  	local $^W;
11186
-  	*UNIVERSAL::VERSION 
11187
-  		= \&version::_VERSION;
11188
-      }
11189
-  
11190
-      if (exists($args{'VERSION'})) {
11191
-  	*{$callpkg.'::VERSION'} = \&version::_VERSION;
11192
-      }
11193
-  
11194
-      if (exists($args{'is_strict'})) {
11195
-  	*{$callpkg.'::is_strict'} = \&version::is_strict
11196
-  	  unless defined(&{$callpkg.'::is_strict'});
11197
-      }
11198
-  
11199
-      if (exists($args{'is_lax'})) {
11200
-  	*{$callpkg.'::is_lax'} = \&version::is_lax
11201
-  	  unless defined(&{$callpkg.'::is_lax'});
11202
-      }
11203
-  }
11204
-  
11205
-  sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
11206
-  sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
11207
-  
11208
-  1;
11209
-VERSION
11210
-
11211
-$fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
11212
-  package charstar;
11213
-  # a little helper class to emulate C char* semantics in Perl
11214
-  # so that prescan_version can use the same code as in C
11215
-  
11216
-  use overload (
11217
-      '""'	=> \&thischar,
11218
-      '0+'	=> \&thischar,
11219
-      '++'	=> \&increment,
11220
-      '--'	=> \&decrement,
11221
-      '+'		=> \&plus,
11222
-      '-'		=> \&minus,
11223
-      '*'		=> \&multiply,
11224
-      'cmp'	=> \&cmp,
11225
-      '<=>'	=> \&spaceship,
11226
-      'bool'	=> \&thischar,
11227
-      '='		=> \&clone,
11228
-  );
11229
-  
11230
-  sub new {
11231
-      my ($self, $string) = @_;
11232
-      my $class = ref($self) || $self;
11233
-  
11234
-      my $obj = {
11235
-  	string  => [split(//,$string)],
11236
-  	current => 0,
11237
-      };
11238
-      return bless $obj, $class;
11239
-  }
11240
-  
11241
-  sub thischar {
11242
-      my ($self) = @_;
11243
-      my $last = $#{$self->{string}};
11244
-      my $curr = $self->{current};
11245
-      if ($curr >= 0 && $curr <= $last) {
11246
-  	return $self->{string}->[$curr];
11247
-      }
11248
-      else {
11249
-  	return '';
11250
-      }
11251
-  }
11252
-  
11253
-  sub increment {
11254
-      my ($self) = @_;
11255
-      $self->{current}++;
11256
-  }
11257
-  
11258
-  sub decrement {
11259
-      my ($self) = @_;
11260
-      $self->{current}--;
11261
-  }
11262
-  
11263
-  sub plus {
11264
-      my ($self, $offset) = @_;
11265
-      my $rself = $self->clone;
11266
-      $rself->{current} += $offset;
11267
-      return $rself;
11268
-  }
11269
-  
11270
-  sub minus {
11271
-      my ($self, $offset) = @_;
11272
-      my $rself = $self->clone;
11273
-      $rself->{current} -= $offset;
11274
-      return $rself;
11275
-  }
11276
-  
11277
-  sub multiply {
11278
-      my ($left, $right, $swapped) = @_;
11279
-      my $char = $left->thischar();
11280
-      return $char * $right;
11281
-  }
11282
-  
11283
-  sub spaceship {
11284
-      my ($left, $right, $swapped) = @_;
11285
-      unless (ref($right)) { # not an object already
11286
-  	$right = $left->new($right);
11287
-      }
11288
-      return $left->{current} <=> $right->{current};
11289
-  }
11290
-  
11291
-  sub cmp {
11292
-      my ($left, $right, $swapped) = @_;
11293
-      unless (ref($right)) { # not an object already
11294
-  	if (length($right) == 1) { # comparing single character only
11295
-  	    return $left->thischar cmp $right;
11296
-  	}
11297
-  	$right = $left->new($right);
11298
-      }
11299
-      return $left->currstr cmp $right->currstr;
11300
-  }
11301
-  
11302
-  sub bool {
11303
-      my ($self) = @_;
11304
-      my $char = $self->thischar;
11305
-      return ($char ne '');
11306
-  }
11307
-  
11308
-  sub clone {
11309
-      my ($left, $right, $swapped) = @_;
11310
-      $right = {
11311
-  	string  => [@{$left->{string}}],
11312
-  	current => $left->{current},
11313
-      };
11314
-      return bless $right, ref($left);
11315
-  }
11316
-  
11317
-  sub currstr {
11318
-      my ($self, $s) = @_;
11319
-      my $curr = $self->{current};
11320
-      my $last = $#{$self->{string}};
11321
-      if (defined($s) && $s->{current} < $last) {
11322
-  	$last = $s->{current};
11323
-      }
11324
-  
11325
-      my $string = join('', @{$self->{string}}[$curr..$last]);
11326
-      return $string;
11327
-  }
11328
-  
11329
-  package version::vpp;
11330
-  use strict;
11331
-  
11332
-  use POSIX qw/locale_h/;
11333
-  use locale;
11334
-  use vars qw ($VERSION @ISA @REGEXS);
11335
-  $VERSION = 0.9901;
11336
-  
11337
-  use overload (
11338
-      '""'       => \&stringify,
11339
-      '0+'       => \&numify,
11340
-      'cmp'      => \&vcmp,
11341
-      '<=>'      => \&vcmp,
11342
-      'bool'     => \&vbool,
11343
-      '+'        => \&vnoop,
11344
-      '-'        => \&vnoop,
11345
-      '*'        => \&vnoop,
11346
-      '/'        => \&vnoop,
11347
-      '+='        => \&vnoop,
11348
-      '-='        => \&vnoop,
11349
-      '*='        => \&vnoop,
11350
-      '/='        => \&vnoop,
11351
-      'abs'      => \&vnoop,
11352
-  );
11353
-  
11354
-  eval "use warnings";
11355
-  if ($@) {
11356
-      eval '
11357
-  	package
11358
-  	warnings;
11359
-  	sub enabled {return $^W;}
11360
-  	1;
11361
-      ';
11362
-  }
11363
-  
11364
-  my $VERSION_MAX = 0x7FFFFFFF;
11365
-  
11366
-  # implement prescan_version as closely to the C version as possible
11367
-  use constant TRUE  => 1;
11368
-  use constant FALSE => 0;
11369
-  
11370
-  sub isDIGIT {
11371
-      my ($char) = shift->thischar();
11372
-      return ($char =~ /\d/);
11373
-  }
11374
-  
11375
-  sub isALPHA {
11376
-      my ($char) = shift->thischar();
11377
-      return ($char =~ /[a-zA-Z]/);
11378
-  }
11379
-  
11380
-  sub isSPACE {
11381
-      my ($char) = shift->thischar();
11382
-      return ($char =~ /\s/);
11383
-  }
11384
-  
11385
-  sub BADVERSION {
11386
-      my ($s, $errstr, $error) = @_;
11387
-      if ($errstr) {
11388
-  	$$errstr = $error;
11389
-      }
11390
-      return $s;
11391
-  }
11392
-  
11393
-  sub prescan_version {
11394
-      my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
11395
-      my $qv          = defined $sqv          ? $$sqv          : FALSE;
11396
-      my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
11397
-      my $width       = defined $swidth       ? $$swidth       : 3;
11398
-      my $alpha       = defined $salpha       ? $$salpha       : FALSE;
11399
-  
11400
-      my $d = $s;
11401
-  
11402
-      if ($qv && isDIGIT($d)) {
11403
-  	goto dotted_decimal_version;
11404
-      }
11405
-  
11406
-      if ($d eq 'v') { # explicit v-string
11407
-  	$d++;
11408
-  	if (isDIGIT($d)) {
11409
-  	    $qv = TRUE;
11410
-  	}
11411
-  	else { # degenerate v-string
11412
-  	    # requires v1.2.3
11413
-  	    return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
11414
-  	}
11415
-  
11416
-  dotted_decimal_version:
11417
-  	if ($strict && $d eq '0' && isDIGIT($d+1)) {
11418
-  	    # no leading zeros allowed
11419
-  	    return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
11420
-  	}
11421
-  
11422
-  	while (isDIGIT($d)) { 	# integer part
11423
-  	    $d++;
11424
-  	}
11425
-  
11426
-  	if ($d eq '.')
11427
-  	{
11428
-  	    $saw_decimal++;
11429
-  	    $d++; 		# decimal point
11430
-  	}
11431
-  	else
11432
-  	{
11433
-  	    if ($strict) {
11434
-  		# require v1.2.3
11435
-  		return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
11436
-  	    }
11437
-  	    else {
11438
-  		goto version_prescan_finish;
11439
-  	    }
11440
-  	}
11441
-  
11442
-  	{
11443
-  	    my $i = 0;
11444
-  	    my $j = 0;
11445
-  	    while (isDIGIT($d)) {	# just keep reading
11446
-  		$i++;
11447
-  		while (isDIGIT($d)) {
11448
-  		    $d++; $j++;
11449
-  		    # maximum 3 digits between decimal
11450
-  		    if ($strict && $j > 3) {
11451
-  			return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)");
11452
-  		    }
11453
-  		}
11454
-  		if ($d eq '_') {
11455
-  		    if ($strict) {
11456
-  			return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
11457
-  		    }
11458
-  		    if ( $alpha ) {
11459
-  			return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
11460
-  		    }
11461
-  		    $d++;
11462
-  		    $alpha = TRUE;
11463
-  		}
11464
-  		elsif ($d eq '.') {
11465
-  		    if ($alpha) {
11466
-  			return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
11467
-  		    }
11468
-  		    $saw_decimal++;
11469
-  		    $d++;
11470
-  		}
11471
-  		elsif (!isDIGIT($d)) {
11472
-  		    last;
11473
-  		}
11474
-  		$j = 0;
11475
-  	    }
11476
-  
11477
-  	    if ($strict && $i < 2) {
11478
-  		# requires v1.2.3
11479
-  		return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
11480
-  	    }
11481
-  	}
11482
-      } 					# end if dotted-decimal
11483
-      else
11484
-      {					# decimal versions
11485
-  	my $j = 0;
11486
-  	# special $strict case for leading '.' or '0'
11487
-  	if ($strict) {
11488
-  	    if ($d eq '.') {
11489
-  		return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)");
11490
-  	    }
11491
-  	    if ($d eq '0' && isDIGIT($d+1)) {
11492
-  		return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
11493
-  	    }
11494
-  	}
11495
-  
11496
-  	# and we never support negative version numbers
11497
-  	if ($d eq '-') {
11498
-  	    return BADVERSION($s,$errstr,"Invalid version format (negative version number)");
11499
-  	}
11500
-  
11501
-  	# consume all of the integer part
11502
-  	while (isDIGIT($d)) {
11503
-  	    $d++;
11504
-  	}
11505
-  
11506
-  	# look for a fractional part
11507
-  	if ($d eq '.') {
11508
-  	    # we found it, so consume it
11509
-  	    $saw_decimal++;
11510
-  	    $d++;
11511
-  	}
11512
-  	elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') {
11513
-  	    if ( $d == $s ) {
11514
-  		# found nothing
11515
-  		return BADVERSION($s,$errstr,"Invalid version format (version required)");
11516
-  	    }
11517
-  	    # found just an integer
11518
-  	    goto version_prescan_finish;
11519
-  	}
11520
-  	elsif ( $d == $s ) {
11521
-  	    # didn't find either integer or period
11522
-  	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
11523
-  	}
11524
-  	elsif ($d eq '_') {
11525
-  	    # underscore can't come after integer part
11526
-  	    if ($strict) {
11527
-  		return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
11528
-  	    }
11529
-  	    elsif (isDIGIT($d+1)) {
11530
-  		return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)");
11531
-  	    }
11532
-  	    else {
11533
-  		return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
11534
-  	    }
11535
-  	}
11536
-  	elsif ($d) {
11537
-  	    # anything else after integer part is just invalid data
11538
-  	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
11539
-  	}
11540
-  
11541
-  	# scan the fractional part after the decimal point
11542
-  	if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) {
11543
-  		# $strict or lax-but-not-the-end
11544
-  		return BADVERSION($s,$errstr,"Invalid version format (fractional part required)");
11545
-  	}
11546
-  
11547
-  	while (isDIGIT($d)) {
11548
-  	    $d++; $j++;
11549
-  	    if ($d eq '.' && isDIGIT($d-1)) {
11550
-  		if ($alpha) {
11551
-  		    return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
11552
-  		}
11553
-  		if ($strict) {
11554
-  		    return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
11555
-  		}
11556
-  		$d = $s; # start all over again
11557
-  		$qv = TRUE;
11558
-  		goto dotted_decimal_version;
11559
-  	    }
11560
-  	    if ($d eq '_') {
11561
-  		if ($strict) {
11562
-  		    return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
11563
-  		}
11564
-  		if ( $alpha ) {
11565
-  		    return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
11566
-  		}
11567
-  		if ( ! isDIGIT($d+1) ) {
11568
-  		    return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
11569
-  		}
11570
-  		$width = $j;
11571
-  		$d++;
11572
-  		$alpha = TRUE;
11573
-  	    }
11574
-  	}
11575
-      }
11576
-  
11577
-  version_prescan_finish:
11578
-      while (isSPACE($d)) {
11579
-  	$d++;
11580
-      }
11581
-  
11582
-      if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) {
11583
-  	# trailing non-numeric data
11584
-  	return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
11585
-      }
11586
-  
11587
-      if (defined $sqv) {
11588
-  	$$sqv = $qv;
11589
-      }
11590
-      if (defined $swidth) {
11591
-  	$$swidth = $width;
11592
-      }
11593
-      if (defined $ssaw_decimal) {
11594
-  	$$ssaw_decimal = $saw_decimal;
11595
-      }
11596
-      if (defined $salpha) {
11597
-  	$$salpha = $alpha;
11598
-      }
11599
-      return $d;
11600
-  }
11601
-  
11602
-  sub scan_version {
11603
-      my ($s, $rv, $qv) = @_;
11604
-      my $start;
11605
-      my $pos;
11606
-      my $last;
11607
-      my $errstr;
11608
-      my $saw_decimal = 0;
11609
-      my $width = 3;
11610
-      my $alpha = FALSE;
11611
-      my $vinf = FALSE;
11612
-      my @av;
11613
-  
11614
-      $s = new charstar $s;
11615
-  
11616
-      while (isSPACE($s)) { # leading whitespace is OK
11617
-  	$s++;
11618
-      }
11619
-  
11620
-      $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
11621
-  	\$width, \$alpha);
11622
-  
11623
-      if ($errstr) {
11624
-  	# 'undef' is a special case and not an error
11625
-  	if ( $s ne 'undef') {
11626
-  	    use Carp;
11627
-  	    Carp::croak($errstr);
11628
-  	}
11629
-      }
11630
-  
11631
-      $start = $s;
11632
-      if ($s eq 'v') {
11633
-  	$s++;
11634
-      }
11635
-      $pos = $s;
11636
-  
11637
-      if ( $qv ) {
11638
-  	$$rv->{qv} = $qv;
11639
-      }
11640
-      if ( $alpha ) {
11641
-  	$$rv->{alpha} = $alpha;
11642
-      }
11643
-      if ( !$qv && $width < 3 ) {
11644
-  	$$rv->{width} = $width;
11645
-      }
11646
-  
11647
-      while (isDIGIT($pos)) {
11648
-  	$pos++;
11649
-      }
11650
-      if (!isALPHA($pos)) {
11651
-  	my $rev;
11652
-  
11653
-  	for (;;) {
11654
-  	    $rev = 0;
11655
-  	    {
11656
-    		# this is atoi() that delimits on underscores
11657
-    		my $end = $pos;
11658
-    		my $mult = 1;
11659
-  		my $orev;
11660
-  
11661
-  		#  the following if() will only be true after the decimal
11662
-  		#  point of a version originally created with a bare
11663
-  		#  floating point number, i.e. not quoted in any way
11664
-  		#
11665
-   		if ( !$qv && $s > $start && $saw_decimal == 1 ) {
11666
-  		    $mult *= 100;
11667
-   		    while ( $s < $end ) {
11668
-  			$orev = $rev;
11669
-   			$rev += $s * $mult;
11670
-   			$mult /= 10;
11671
-  			if (   (abs($orev) > abs($rev))
11672
-  			    || (abs($rev) > $VERSION_MAX )) {
11673
-  			    warn("Integer overflow in version %d",
11674
-  					   $VERSION_MAX);
11675
-  			    $s = $end - 1;
11676
-  			    $rev = $VERSION_MAX;
11677
-  			    $vinf = 1;
11678
-  			}
11679
-   			$s++;
11680
-  			if ( $s eq '_' ) {
11681
-  			    $s++;
11682
-  			}
11683
-   		    }
11684
-    		}
11685
-   		else {
11686
-   		    while (--$end >= $s) {
11687
-  			$orev = $rev;
11688
-   			$rev += $end * $mult;
11689
-   			$mult *= 10;
11690
-  			if (   (abs($orev) > abs($rev))
11691
-  			    || (abs($rev) > $VERSION_MAX )) {
11692
-  			    warn("Integer overflow in version");
11693
-  			    $end = $s - 1;
11694
-  			    $rev = $VERSION_MAX;
11695
-  			    $vinf = 1;
11696
-  			}
11697
-   		    }
11698
-   		}
11699
-    	    }
11700
-  
11701
-    	    # Append revision
11702
-  	    push @av, $rev;
11703
-  	    if ( $vinf ) {
11704
-  		$s = $last;
11705
-  		last;
11706
-  	    }
11707
-  	    elsif ( $pos eq '.' ) {
11708
-  		$s = ++$pos;
11709
-  	    }
11710
-  	    elsif ( $pos eq '_' && isDIGIT($pos+1) ) {
11711
-  		$s = ++$pos;
11712
-  	    }
11713
-  	    elsif ( $pos eq ',' && isDIGIT($pos+1) ) {
11714
-  		$s = ++$pos;
11715
-  	    }
11716
-  	    elsif ( isDIGIT($pos) ) {
11717
-  		$s = $pos;
11718
-  	    }
11719
-  	    else {
11720
-  		$s = $pos;
11721
-  		last;
11722
-  	    }
11723
-  	    if ( $qv ) {
11724
-  		while ( isDIGIT($pos) ) {
11725
-  		    $pos++;
11726
-  		}
11727
-  	    }
11728
-  	    else {
11729
-  		my $digits = 0;
11730
-  		while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) {
11731
-  		    if ( $pos ne '_' ) {
11732
-  			$digits++;
11733
-  		    }
11734
-  		    $pos++;
11735
-  		}
11736
-  	    }
11737
-  	}
11738
-      }
11739
-      if ( $qv ) { # quoted versions always get at least three terms
11740
-  	my $len = $#av;
11741
-  	#  This for loop appears to trigger a compiler bug on OS X, as it
11742
-  	#  loops infinitely. Yes, len is negative. No, it makes no sense.
11743
-  	#  Compiler in question is:
11744
-  	#  gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
11745
-  	#  for ( len = 2 - len; len > 0; len-- )
11746
-  	#  av_push(MUTABLE_AV(sv), newSViv(0));
11747
-  	#
11748
-  	$len = 2 - $len;
11749
-  	while ($len-- > 0) {
11750
-  	    push @av, 0;
11751
-  	}
11752
-      }
11753
-  
11754
-      # need to save off the current version string for later
11755
-      if ( $vinf ) {
11756
-  	$$rv->{original} = "v.Inf";
11757
-  	$$rv->{vinf} = 1;
11758
-      }
11759
-      elsif ( $s > $start ) {
11760
-  	$$rv->{original} = $start->currstr($s);
11761
-  	if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
11762
-  	    # need to insert a v to be consistent
11763
-  	    $$rv->{original} = 'v' . $$rv->{original};
11764
-  	}
11765
-      }
11766
-      else {
11767
-  	$$rv->{original} = '0';
11768
-  	push(@av, 0);
11769
-      }
11770
-  
11771
-      # And finally, store the AV in the hash
11772
-      $$rv->{version} = \@av;
11773
-  
11774
-      # fix RT#19517 - special case 'undef' as string
11775
-      if ($s eq 'undef') {
11776
-  	$s += 5;
11777
-      }
11778
-  
11779
-      return $s;
11780
-  }
11781
-  
11782
-  sub new
11783
-  {
11784
-  	my ($class, $value) = @_;
11785
-  	my $self = bless ({}, ref ($class) || $class);
11786
-  	my $qv = FALSE;
11787
-  
11788
-  	if ( ref($value) && eval('$value->isa("version")') ) {
11789
-  	    # Can copy the elements directly
11790
-  	    $self->{version} = [ @{$value->{version} } ];
11791
-  	    $self->{qv} = 1 if $value->{qv};
11792
-  	    $self->{alpha} = 1 if $value->{alpha};
11793
-  	    $self->{original} = ''.$value->{original};
11794
-  	    return $self;
11795
-  	}
11796
-  
11797
-  	my $currlocale = setlocale(LC_ALL);
11798
-  
11799
-  	# if the current locale uses commas for decimal points, we
11800
-  	# just replace commas with decimal places, rather than changing
11801
-  	# locales
11802
-  	if ( localeconv()->{decimal_point} eq ',' ) {
11803
-  	    $value =~ tr/,/./;
11804
-  	}
11805
-  
11806
-  	if ( not defined $value or $value =~ /^undef$/ ) {
11807
-  	    # RT #19517 - special case for undef comparison
11808
-  	    # or someone forgot to pass a value
11809
-  	    push @{$self->{version}}, 0;
11810
-  	    $self->{original} = "0";
11811
-  	    return ($self);
11812
-  	}
11813
-  
11814
-  	if ( $#_ == 2 ) { # must be CVS-style
11815
-  	    $value = $_[2];
11816
-  	    $qv = TRUE;
11817
-  	}
11818
-  
11819
-  	$value = _un_vstring($value);
11820
-  
11821
-  	# exponential notation
11822
-  	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
11823
-  	    $value = sprintf("%.9f",$value);
11824
-  	    $value =~ s/(0+)$//; # trim trailing zeros
11825
-  	}
11826
-  
11827
-  	my $s = scan_version($value, \$self, $qv);
11828
-  
11829
-  	if ($s) { # must be something left over
11830
-  	    warn("Version string '%s' contains invalid data; "
11831
-                         ."ignoring: '%s'", $value, $s);
11832
-  	}
11833
-  
11834
-  	return ($self);
11835
-  }
11836
-  
11837
-  *parse = \&new;
11838
-  
11839
-  sub numify
11840
-  {
11841
-      my ($self) = @_;
11842
-      unless (_verify($self)) {
11843
-  	require Carp;
11844
-  	Carp::croak("Invalid version object");
11845
-      }
11846
-      my $width = $self->{width} || 3;
11847
-      my $alpha = $self->{alpha} || "";
11848
-      my $len = $#{$self->{version}};
11849
-      my $digit = $self->{version}[0];
11850
-      my $string = sprintf("%d.", $digit );
11851
-  
11852
-      for ( my $i = 1 ; $i < $len ; $i++ ) {
11853
-  	$digit = $self->{version}[$i];
11854
-  	if ( $width < 3 ) {
11855
-  	    my $denom = 10**(3-$width);
11856
-  	    my $quot = int($digit/$denom);
11857
-  	    my $rem = $digit - ($quot * $denom);
11858
-  	    $string .= sprintf("%0".$width."d_%d", $quot, $rem);
11859
-  	}
11860
-  	else {
11861
-  	    $string .= sprintf("%03d", $digit);
11862
-  	}
11863
-      }
11864
-  
11865
-      if ( $len > 0 ) {
11866
-  	$digit = $self->{version}[$len];
11867
-  	if ( $alpha && $width == 3 ) {
11868
-  	    $string .= "_";
11869
-  	}
11870
-  	$string .= sprintf("%0".$width."d", $digit);
11871
-      }
11872
-      else # $len = 0
11873
-      {
11874
-  	$string .= sprintf("000");
11875
-      }
11876
-  
11877
-      return $string;
11878
-  }
11879
-  
11880
-  sub normal
11881
-  {
11882
-      my ($self) = @_;
11883
-      unless (_verify($self)) {
11884
-  	require Carp;
11885
-  	Carp::croak("Invalid version object");
11886
-      }
11887
-      my $alpha = $self->{alpha} || "";
11888
-      my $len = $#{$self->{version}};
11889
-      my $digit = $self->{version}[0];
11890
-      my $string = sprintf("v%d", $digit );
11891
-  
11892
-      for ( my $i = 1 ; $i < $len ; $i++ ) {
11893
-  	$digit = $self->{version}[$i];
11894
-  	$string .= sprintf(".%d", $digit);
11895
-      }
11896
-  
11897
-      if ( $len > 0 ) {
11898
-  	$digit = $self->{version}[$len];
11899
-  	if ( $alpha ) {
11900
-  	    $string .= sprintf("_%0d", $digit);
11901
-  	}
11902
-  	else {
11903
-  	    $string .= sprintf(".%0d", $digit);
11904
-  	}
11905
-      }
11906
-  
11907
-      if ( $len <= 2 ) {
11908
-  	for ( $len = 2 - $len; $len != 0; $len-- ) {
11909
-  	    $string .= sprintf(".%0d", 0);
11910
-  	}
11911
-      }
11912
-  
11913
-      return $string;
11914
-  }
11915
-  
11916
-  sub stringify
11917
-  {
11918
-      my ($self) = @_;
11919
-      unless (_verify($self)) {
11920
-  	require Carp;
11921
-  	Carp::croak("Invalid version object");
11922
-      }
11923
-      return exists $self->{original}
11924
-      	? $self->{original}
11925
-  	: exists $self->{qv}
11926
-  	    ? $self->normal
11927
-  	    : $self->numify;
11928
-  }
11929
-  
11930
-  sub vcmp
11931
-  {
11932
-      require UNIVERSAL;
11933
-      my ($left,$right,$swap) = @_;
11934
-      my $class = ref($left);
11935
-      unless ( UNIVERSAL::isa($right, $class) ) {
11936
-  	$right = $class->new($right);
11937
-      }
11938
-  
11939
-      if ( $swap ) {
11940
-  	($left, $right) = ($right, $left);
11941
-      }
11942
-      unless (_verify($left)) {
11943
-  	require Carp;
11944
-  	Carp::croak("Invalid version object");
11945
-      }
11946
-      unless (_verify($right)) {
11947
-  	require Carp;
11948
-  	Carp::croak("Invalid version format");
11949
-      }
11950
-      my $l = $#{$left->{version}};
11951
-      my $r = $#{$right->{version}};
11952
-      my $m = $l < $r ? $l : $r;
11953
-      my $lalpha = $left->is_alpha;
11954
-      my $ralpha = $right->is_alpha;
11955
-      my $retval = 0;
11956
-      my $i = 0;
11957
-      while ( $i <= $m && $retval == 0 ) {
11958
-  	$retval = $left->{version}[$i] <=> $right->{version}[$i];
11959
-  	$i++;
11960
-      }
11961
-  
11962
-      # tiebreaker for alpha with identical terms
11963
-      if ( $retval == 0
11964
-  	&& $l == $r
11965
-  	&& $left->{version}[$m] == $right->{version}[$m]
11966
-  	&& ( $lalpha || $ralpha ) ) {
11967
-  
11968
-  	if ( $lalpha && !$ralpha ) {
11969
-  	    $retval = -1;
11970
-  	}
11971
-  	elsif ( $ralpha && !$lalpha) {
11972
-  	    $retval = +1;
11973
-  	}
11974
-      }
11975
-  
11976
-      # possible match except for trailing 0's
11977
-      if ( $retval == 0 && $l != $r ) {
11978
-  	if ( $l < $r ) {
11979
-  	    while ( $i <= $r && $retval == 0 ) {
11980
-  		if ( $right->{version}[$i] != 0 ) {
11981
-  		    $retval = -1; # not a match after all
11982
-  		}
11983
-  		$i++;
11984
-  	    }
11985
-  	}
11986
-  	else {
11987
-  	    while ( $i <= $l && $retval == 0 ) {
11988
-  		if ( $left->{version}[$i] != 0 ) {
11989
-  		    $retval = +1; # not a match after all
11990
-  		}
11991
-  		$i++;
11992
-  	    }
11993
-  	}
11994
-      }
11995
-  
11996
-      return $retval;
11997
-  }
11998
-  
11999
-  sub vbool {
12000
-      my ($self) = @_;
12001
-      return vcmp($self,$self->new("0"),1);
12002
-  }
12003
-  
12004
-  sub vnoop {
12005
-      require Carp;
12006
-      Carp::croak("operation not supported with version object");
12007
-  }
12008
-  
12009
-  sub is_alpha {
12010
-      my ($self) = @_;
12011
-      return (exists $self->{alpha});
12012
-  }
78
+    --info                    Displays distribution info on CPAN
79
+    --look                    Opens the distribution with your SHELL
80
+    -U,--uninstall            Uninstalls the modules (EXPERIMENTAL)
81
+    -V,--version              Displays software version
12013 82
   
12014
-  sub qv {
12015
-      my $value = shift;
12016
-      my $class = 'version';
12017
-      if (@_) {
12018
-  	$class = ref($value) || $value;
12019
-  	$value = shift;
12020
-      }
83
+  Examples:
12021 84
   
12022
-      $value = _un_vstring($value);
12023
-      $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
12024
-      my $obj = version->new($value);
12025
-      return bless $obj, $class;
12026
-  }
85
+    cpanm Test::More                                          # install Test::More
86
+    cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
87
+    cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
88
+    cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
89
+    cpanm --interactive Task::Kensho                          # Configure interactively
90
+    cpanm .                                                   # install from local directory
91
+    cpanm --installdeps .                                     # install all the deps for the current directory
92
+    cpanm -L extlib Plack                                     # install Plack and all non-core deps into extlib
93
+    cpanm --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
94
+    cpanm -M https://cpan.metacpan.org App::perlbrew          # use only this secure mirror and its index
12027 95
   
12028
-  *declare = \&qv;
96
+  You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
12029 97
   
12030
-  sub is_qv {
12031
-      my ($self) = @_;
12032
-      return (exists $self->{qv});
12033
-  }
98
+    export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
12034 99
   
100
+  Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
12035 101
   
12036
-  sub _verify {
12037
-      my ($self) = @_;
12038
-      if ( ref($self)
12039
-  	&& eval { exists $self->{version} }
12040
-  	&& ref($self->{version}) eq 'ARRAY'
12041
-  	) {
12042
-  	return 1;
12043
-      }
12044
-      else {
12045
-  	return 0;
12046
-      }
12047
-  }
102
+  HELP
103
+  !
104
+  ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
105
+  ! To turn off this warning, you have to do one of the following:
106
+  !   - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
107
+  !   - Configure local::lib in your existing shell to set PERL_MM_OPT etc.
108
+  !   - Install local::lib by running the following commands
109
+  !
110
+  !         cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
111
+  !
112
+  DIAG
113
+  WARNING: Your lib directory name ($base) contains a space in it. It's known to cause issues with perl builder tools such as local::lib and MakeMaker. You're recommended to rename your directory.
114
+  WARN
115
+  $module is not found in the following directories and can't be uninstalled.
12048 116
   
12049
-  sub _is_non_alphanumeric {
12050
-      my $s = shift;
12051
-      $s = new charstar $s;
12052
-      while ($s) {
12053
-  	return 0 if isSPACE($s); # early out
12054
-  	return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
12055
-  	$s++;
12056
-      }
12057
-      return 0;
12058
-  }
117
+  @{[ join("  \n", map "  $_", @inc) ]}
12059 118
   
12060
-  sub _un_vstring {
12061
-      my $value = shift;
12062
-      # may be a v-string
12063
-      if ( length($value) >= 3 && $value !~ /[._]/
12064
-  	&& _is_non_alphanumeric($value)) {
12065
-  	my $tvalue;
12066
-  	if ( $] ge 5.008_001 ) {
12067
-  	    $tvalue = _find_magic_vstring($value);
12068
-  	    $value = $tvalue if length $tvalue;
12069
-  	}
12070
-  	elsif ( $] ge 5.006_000 ) {
12071
-  	    $tvalue = sprintf("v%vd",$value);
12072
-  	    if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
12073
-  		# must be a v-string
12074
-  		$value = $tvalue;
12075
-  	    }
12076
-  	}
12077
-      }
12078
-      return $value;
119
+  DIAG
120
+  package ModuleBuildSkipMan;
121
+  CHECK {
122
+    if (%Module::Build::) {
123
+      no warnings 'redefine';
124
+      *Module::Build::Base::ACTION_manpages = sub {};
125
+      *Module::Build::Base::ACTION_docs     = sub {};
126
+    }
12079 127
   }
12080
-  
12081
-  sub _find_magic_vstring {
12082
-      my $value = shift;
12083
-      my $tvalue = '';
12084
-      require B;
12085
-      my $sv = B::svref_2object(\$value);
12086
-      my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
12087
-      while ( $magic ) {
12088
-  	if ( $magic->TYPE eq 'V' ) {
12089
-  	    $tvalue = $magic->PTR;
12090
-  	    $tvalue =~ s/^v?(.+)$/v$1/;
12091
-  	    last;
12092
-  	}
12093
-  	else {
12094
-  	    $magic = $magic->MOREMAGIC;
12095
-  	}
128
+  1;
129
+  EOF
130
+  ! Configuring $distname failed. See $self->{log} for details.
131
+  ! You might have to install the following modules first to get --scandeps working correctly.
132
+  DIAG
133
+APP_CPANMINUS_SCRIPT
134
+
135
+$fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO';
136
+  package CPAN::DistnameInfo;$VERSION="0.12";use strict;sub distname_info {my$file=shift or return;my ($dist,$version)=$file =~ /^
137
+      ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
138
+       (?:
139
+  	[A-Za-z](?=[^A-Za-z]|$)
140
+  	|
141
+  	\d(?=-)
142
+       )(?<![._-][vV])
143
+      )+)(.*)
144
+    $/xs or return ($file,undef,undef);if ($dist =~ /-undef\z/ and!length$version){$dist =~ s/-undef\z//}$version =~ s/-withoutworldwriteables$//;if ($version =~ /^(-[Vv].*)-(\d.*)/){$dist .= $1;$version=$2}if ($version =~ /(.+_.*)-(\d.*)/){$dist .= $1;$version=$2}$dist =~ s{\.pm$}{};$version=$1 if!length$version and $dist =~ s/-(\d+\w)$//;$version=$1 .$version if$version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;if ($version =~ /\d\.\d/){$version =~ s/^[-_.]+//}else {$version =~ s/^[-_]+//}my$dev;if (length$version){if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/){$dev=1 if (($1 > 6 and $1 & 1)or ($2 and $2 >= 50))or $3}elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/){$dev=1}}else {$version=undef}($dist,$version,$dev)}sub new {my$class=shift;my$distfile=shift;$distfile =~ s,//+,/,g;my%info=(pathname=>$distfile);($info{filename}=$distfile)=~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,, and $info{cpanid}=$6;if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i){$info{distvname}=$1;$info{extension}=$2}@info{qw(dist version beta)}=distname_info($info{distvname});$info{maturity}=delete$info{beta}? 'developer' : 'released';return bless \%info,$class}sub dist {shift->{dist}}sub version {shift->{version}}sub maturity {shift->{maturity}}sub filename {shift->{filename}}sub cpanid {shift->{cpanid}}sub distvname {shift->{distvname}}sub extension {shift->{extension}}sub pathname {shift->{pathname}}sub properties {%{$_[0]}}1;
145
+CPAN_DISTNAMEINFO
146
+
147
+$fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META';
148
+  use 5.006;use strict;use warnings;package CPAN::Meta;our$VERSION='2.150005';use Carp qw(carp croak);use CPAN::Meta::Feature;use CPAN::Meta::Prereqs;use CPAN::Meta::Converter;use CPAN::Meta::Validator;use Parse::CPAN::Meta 1.4414 ();BEGIN {*_dclone=\&CPAN::Meta::Converter::_dclone}BEGIN {my@STRING_READERS=qw(abstract description dynamic_config generated_by name release_status version);no strict 'refs';for my$attr (@STRING_READERS){*$attr=sub {$_[0]{$attr }}}}BEGIN {my@LIST_READERS=qw(author keywords license);no strict 'refs';for my$attr (@LIST_READERS){*$attr=sub {my$value=$_[0]{$attr };croak "$attr must be called in list context" unless wantarray;return @{_dclone($value)}if ref$value;return$value}}}sub authors {$_[0]->author}sub licenses {$_[0]->license}BEGIN {my@MAP_READERS=qw(meta-spec resources provides no_index prereqs optional_features);no strict 'refs';for my$attr (@MAP_READERS){(my$subname=$attr)=~ s/-/_/;*$subname=sub {my$value=$_[0]{$attr };return _dclone($value)if$value;return {}}}}sub custom_keys {return grep {/^x_/i}keys %{$_[0]}}sub custom {my ($self,$attr)=@_;my$value=$self->{$attr};return _dclone($value)if ref$value;return$value}sub _new {my ($class,$struct,$options)=@_;my$self;if ($options->{lazy_validation}){my$cmc=CPAN::Meta::Converter->new($struct);$self=$cmc->convert(version=>2);return bless$self,$class}else {my$cmv=CPAN::Meta::Validator->new($struct);unless ($cmv->is_valid){die "Invalid metadata structure. Errors: " .join(", ",$cmv->errors)."\n"}}my$version=$struct->{'meta-spec'}{version}|| '1.0';if ($version==2){$self=$struct}else {my$cmc=CPAN::Meta::Converter->new($struct);$self=$cmc->convert(version=>2)}return bless$self,$class}sub new {my ($class,$struct,$options)=@_;my$self=eval {$class->_new($struct,$options)};croak($@)if $@;return$self}sub create {my ($class,$struct,$options)=@_;my$version=__PACKAGE__->VERSION || 2;$struct->{generated_by}||= __PACKAGE__ ." version $version" ;$struct->{'meta-spec'}{version}||= int($version);my$self=eval {$class->_new($struct,$options)};croak ($@)if $@;return$self}sub load_file {my ($class,$file,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};croak "load_file() requires a valid, readable filename" unless -r $file;my$self;eval {my$struct=Parse::CPAN::Meta->load_file($file);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_yaml_string {my ($class,$yaml,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my ($struct)=Parse::CPAN::Meta->load_yaml_string($yaml);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_json_string {my ($class,$json,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my$struct=Parse::CPAN::Meta->load_json_string($json);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_string {my ($class,$string,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my$struct=Parse::CPAN::Meta->load_string($string);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub save {my ($self,$file,$options)=@_;my$version=$options->{version}|| '2';my$layer=$] ge '5.008001' ? ':utf8' : '';if ($version ge '2'){carp "'$file' should end in '.json'" unless$file =~ m{\.json$}}else {carp "'$file' should end in '.yml'" unless$file =~ m{\.yml$}}my$data=$self->as_string($options);open my$fh,">$layer",$file or die "Error opening '$file' for writing: $!\n";print {$fh}$data;close$fh or die "Error closing '$file': $!\n";return 1}sub meta_spec_version {my ($self)=@_;return$self->meta_spec->{version}}sub effective_prereqs {my ($self,$features)=@_;$features ||= [];my$prereq=CPAN::Meta::Prereqs->new($self->prereqs);return$prereq unless @$features;my@other=map {;$self->feature($_)->prereqs}@$features;return$prereq->with_merged_prereqs(\@other)}sub should_index_file {my ($self,$filename)=@_;for my$no_index_file (@{$self->no_index->{file}|| []}){return if$filename eq $no_index_file}for my$no_index_dir (@{$self->no_index->{directory}}){$no_index_dir =~ s{$}{/} unless$no_index_dir =~ m{/\z};return if index($filename,$no_index_dir)==0}return 1}sub should_index_package {my ($self,$package)=@_;for my$no_index_pkg (@{$self->no_index->{package}|| []}){return if$package eq $no_index_pkg}for my$no_index_ns (@{$self->no_index->{namespace}}){return if index($package,"${no_index_ns}::")==0}return 1}sub features {my ($self)=@_;my$opt_f=$self->optional_features;my@features=map {;CPAN::Meta::Feature->new($_=>$opt_f->{$_ })}keys %$opt_f;return@features}sub feature {my ($self,$ident)=@_;croak "no feature named $ident" unless my$f=$self->optional_features->{$ident };return CPAN::Meta::Feature->new($ident,$f)}sub as_struct {my ($self,$options)=@_;my$struct=_dclone($self);if ($options->{version}){my$cmc=CPAN::Meta::Converter->new($struct);$struct=$cmc->convert(version=>$options->{version})}return$struct}sub as_string {my ($self,$options)=@_;my$version=$options->{version}|| '2';my$struct;if ($self->meta_spec_version ne $version){my$cmc=CPAN::Meta::Converter->new($self->as_struct);$struct=$cmc->convert(version=>$version)}else {$struct=$self->as_struct}my ($data,$backend);if ($version ge '2'){$backend=Parse::CPAN::Meta->json_backend();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=$backend->new->pretty->canonical->encode($struct)}else {$backend=Parse::CPAN::Meta->yaml_backend();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=eval {no strict 'refs';&{"$backend\::Dump"}($struct)};if ($@){croak$backend->can('errstr')? $backend->errstr : $@}}return$data}sub TO_JSON {return {%{$_[0]}}}1;
149
+CPAN_META
150
+
151
+$fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK';
152
+  package CPAN::Meta::Check;$CPAN::Meta::Check::VERSION='0.012';use strict;use warnings;use base 'Exporter';our@EXPORT=qw//;our@EXPORT_OK=qw/check_requirements requirements_for verify_dependencies/;our%EXPORT_TAGS=(all=>[@EXPORT,@EXPORT_OK ]);use CPAN::Meta::Prereqs '2.132830';use CPAN::Meta::Requirements 2.121;use Module::Metadata 1.000023;sub _check_dep {my ($reqs,$module,$dirs)=@_;$module eq 'perl' and return ($reqs->accepts_module($module,$])? (): sprintf "Your Perl (%s) is not in the range '%s'",$],$reqs->requirements_for_module($module));my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return "Module '$module' is not installed" if not defined$metadata;my$version=eval {$metadata->version};return "Missing version info for module '$module'" if$reqs->requirements_for_module($module)and not $version;return sprintf 'Installed version (%s) of %s is not in range \'%s\'',$version,$module,$reqs->requirements_for_module($module)if not $reqs->accepts_module($module,$version || 0);return}sub _check_conflict {my ($reqs,$module,$dirs)=@_;my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return if not defined$metadata;my$version=eval {$metadata->version};return "Missing version info for module '$module'" if not $version;return sprintf 'Installed version (%s) of %s is in range \'%s\'',$version,$module,$reqs->requirements_for_module($module)if$reqs->accepts_module($module,$version);return}sub requirements_for {my ($meta,$phases,$type)=@_;my$prereqs=ref($meta)eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;return$prereqs->merged_requirements(ref($phases)? $phases : [$phases ],[$type ])}sub check_requirements {my ($reqs,$type,$dirs)=@_;return +{map {$_=>$type ne 'conflicts' ? scalar _check_dep($reqs,$_,$dirs): scalar _check_conflict($reqs,$_,$dirs)}$reqs->required_modules }}sub verify_dependencies {my ($meta,$phases,$type,$dirs)=@_;my$reqs=requirements_for($meta,$phases,$type);my$issues=check_requirements($reqs,$type,$dirs);return grep {defined}values %{$issues}}1;
153
+CPAN_META_CHECK
154
+
155
+$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
156
+  use 5.006;use strict;use warnings;package CPAN::Meta::Converter;our$VERSION='2.150005';use CPAN::Meta::Validator;use CPAN::Meta::Requirements;use Parse::CPAN::Meta 1.4400 ();BEGIN {eval "use version ()";if (my$err=$@){eval "use ExtUtils::MakeMaker::version" or die$err}}*_is_qv=version->can('is_qv')? sub {$_[0]->is_qv}: sub {exists $_[0]->{qv}};sub _dclone {my$ref=shift;no warnings 'once';no warnings 'redefine';local*UNIVERSAL::TO_JSON=sub {"$_[0]"};my$json=Parse::CPAN::Meta->json_backend()->new ->utf8 ->allow_blessed ->convert_blessed;$json->decode($json->encode($ref))}my%known_specs=('2'=>'http://search.cpan.org/perldoc?CPAN::Meta::Spec','1.4'=>'http://module-build.sourceforge.net/META-spec-v1.4.html','1.3'=>'http://module-build.sourceforge.net/META-spec-v1.3.html','1.2'=>'http://module-build.sourceforge.net/META-spec-v1.2.html','1.1'=>'http://module-build.sourceforge.net/META-spec-v1.1.html','1.0'=>'http://module-build.sourceforge.net/META-spec-v1.0.html');my@spec_list=sort {$a <=> $b}keys%known_specs;my ($LOWEST,$HIGHEST)=@spec_list[0,-1];sub _keep {$_[0]}sub _keep_or_one {defined($_[0])? $_[0]: 1}sub _keep_or_zero {defined($_[0])? $_[0]: 0}sub _keep_or_unknown {defined($_[0])&& length($_[0])? $_[0]: "unknown"}sub _generated_by {my$gen=shift;my$sig=__PACKAGE__ ." version " .(__PACKAGE__->VERSION || "<dev>");return$sig unless defined$gen and length$gen;return$gen if$gen =~ /\Q$sig/;return "$gen, $sig"}sub _listify {!defined $_[0]? undef : ref $_[0]eq 'ARRAY' ? $_[0]: [$_[0]]}sub _prefix_custom {my$key=shift;$key =~ s/^(?!x_)   # Unless it already starts with x_
157
+               (?:x-?)? # Remove leading x- or x (if present)
158
+             /x_/ix;return$key}sub _ucfirst_custom {my$key=shift;$key=ucfirst$key unless$key =~ /[A-Z]/;return$key}sub _no_prefix_ucfirst_custom {my$key=shift;$key =~ s/^x_//;return _ucfirst_custom($key)}sub _change_meta_spec {my ($element,undef,undef,$version)=@_;return {version=>$version,url=>$known_specs{$version},}}my@open_source=('perl','gpl','apache','artistic','artistic_2','lgpl','bsd','gpl','mit','mozilla','open_source',);my%is_open_source=map {;$_=>1}@open_source;my@valid_licenses_1=(@open_source,'unrestricted','restrictive','unknown',);my%license_map_1=((map {$_=>$_}@valid_licenses_1),artistic2=>'artistic_2',);sub _license_1 {my ($element)=@_;return 'unknown' unless defined$element;if ($license_map_1{lc$element}){return$license_map_1{lc$element}}else {return 'unknown'}}my@valid_licenses_2=qw(agpl_3 apache_1_1 apache_2_0 artistic_1 artistic_2 bsd freebsd gfdl_1_2 gfdl_1_3 gpl_1 gpl_2 gpl_3 lgpl_2_1 lgpl_3_0 mit mozilla_1_0 mozilla_1_1 openssl perl_5 qpl_1_0 ssleay sun zlib open_source restricted unrestricted unknown);my%license_map_2=((map {$_=>$_}@valid_licenses_2),apache=>'apache_2_0',artistic=>'artistic_1',artistic2=>'artistic_2',gpl=>'open_source',lgpl=>'open_source',mozilla=>'open_source',perl=>'perl_5',restrictive=>'restricted',);sub _license_2 {my ($element)=@_;return ['unknown' ]unless defined$element;$element=[$element ]unless ref$element eq 'ARRAY';my@new_list;for my$lic (@$element){next unless defined$lic;if (my$new=$license_map_2{lc$lic}){push@new_list,$new}}return@new_list ? \@new_list : ['unknown' ]}my%license_downgrade_map=qw(agpl_3 open_source apache_1_1 apache apache_2_0 apache artistic_1 artistic artistic_2 artistic_2 bsd bsd freebsd open_source gfdl_1_2 open_source gfdl_1_3 open_source gpl_1 gpl gpl_2 gpl gpl_3 gpl lgpl_2_1 lgpl lgpl_3_0 lgpl mit mit mozilla_1_0 mozilla mozilla_1_1 mozilla openssl open_source perl_5 perl qpl_1_0 open_source ssleay open_source sun open_source zlib open_source open_source open_source restricted restrictive unrestricted unrestricted unknown unknown);sub _downgrade_license {my ($element)=@_;if (!defined$element){return "unknown"}elsif(ref$element eq 'ARRAY'){if (@$element > 1){if (grep {!$is_open_source{$license_downgrade_map{lc $_}|| 'unknown' }}@$element){return 'unknown'}else {return 'open_source'}}elsif (@$element==1){return$license_downgrade_map{lc$element->[0]}|| "unknown"}}elsif (!ref$element){return$license_downgrade_map{lc$element}|| "unknown"}return "unknown"}my$no_index_spec_1_2={'file'=>\&_listify,'dir'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,};my$no_index_spec_1_3={'file'=>\&_listify,'directory'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,};my$no_index_spec_2={'file'=>\&_listify,'directory'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,':custom'=>\&_prefix_custom,};sub _no_index_1_2 {my (undef,undef,$meta)=@_;my$no_index=$meta->{no_index}|| $meta->{private};return unless$no_index;if (!ref$no_index){my$item=$no_index;$no_index={dir=>[$item ],file=>[$item ]}}elsif (ref$no_index eq 'ARRAY'){my$list=$no_index;$no_index={dir=>[@$list ],file=>[@$list ]}}if (exists$no_index->{files}){$no_index->{file}=delete$no_index->{files}}if (exists$no_index->{modules}){$no_index->{module}=delete$no_index->{modules}}return _convert($no_index,$no_index_spec_1_2)}sub _no_index_directory {my ($element,$key,$meta,$version)=@_;return unless$element;if (!ref$element){my$item=$element;$element={directory=>[$item ],file=>[$item ]}}elsif (ref$element eq 'ARRAY'){my$list=$element;$element={directory=>[@$list ],file=>[@$list ]}}if (exists$element->{dir}){$element->{directory}=delete$element->{dir}}if (exists$element->{files}){$element->{file}=delete$element->{files}}if (exists$element->{modules}){$element->{module}=delete$element->{modules}}my$spec=$version==2 ? $no_index_spec_2 : $no_index_spec_1_3;return _convert($element,$spec)}sub _is_module_name {my$mod=shift;return unless defined$mod && length$mod;return$mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$}}sub _clean_version {my ($element)=@_;return 0 if!defined$element;$element =~ s{^\s*}{};$element =~ s{\s*$}{};$element =~ s{^\.}{0.};return 0 if!length$element;return 0 if ($element eq 'undef' || $element eq '<undef>');my$v=eval {version->new($element)};if (defined$v){return _is_qv($v)? $v->normal : $element}else {return 0}}sub _bad_version_hook {my ($v)=@_;$v =~ s{^\s*}{};$v =~ s{\s*$}{};$v =~ s{[a-z]+$}{};my$vobj=eval {version->new($v)};return defined($vobj)? $vobj : version->new(0)}sub _version_map {my ($element)=@_;return unless defined$element;if (ref$element eq 'HASH'){my$new_map=CPAN::Meta::Requirements->new({bad_version_hook=>\&_bad_version_hook });while (my ($k,$v)=each %$element){next unless _is_module_name($k);if (!defined($v)||!length($v)|| $v eq 'undef' || $v eq '<undef>'){$v=0}if (_is_module_name($v)&&!version::is_lax($v)){$new_map->add_minimum($k=>0);$new_map->add_minimum($v=>0)}$new_map->add_string_requirement($k=>$v)}return$new_map->as_string_hash}elsif (ref$element eq 'ARRAY'){my$hashref={map {$_=>0}@$element };return _version_map($hashref)}elsif (ref$element eq '' && length$element){return {$element=>0 }}return}sub _prereqs_from_1 {my (undef,undef,$meta)=@_;my$prereqs={};for my$phase (qw/build configure/){my$key="${phase}_requires";$prereqs->{$phase}{requires}=_version_map($meta->{$key})if$meta->{$key}}for my$rel (qw/requires recommends conflicts/){$prereqs->{runtime}{$rel}=_version_map($meta->{$rel})if$meta->{$rel}}return$prereqs}my$prereqs_spec={configure=>\&_prereqs_rel,build=>\&_prereqs_rel,test=>\&_prereqs_rel,runtime=>\&_prereqs_rel,develop=>\&_prereqs_rel,':custom'=>\&_prefix_custom,};my$relation_spec={requires=>\&_version_map,recommends=>\&_version_map,suggests=>\&_version_map,conflicts=>\&_version_map,':custom'=>\&_prefix_custom,};sub _cleanup_prereqs {my ($prereqs,$key,$meta,$to_version)=@_;return unless$prereqs && ref$prereqs eq 'HASH';return _convert($prereqs,$prereqs_spec,$to_version)}sub _prereqs_rel {my ($relation,$key,$meta,$to_version)=@_;return unless$relation && ref$relation eq 'HASH';return _convert($relation,$relation_spec,$to_version)}BEGIN {my@old_prereqs=qw(requires configure_requires recommends conflicts);for (@old_prereqs){my$sub="_get_$_";my ($phase,$type)=split qr/_/,$_;if (!defined$type){$type=$phase;$phase='runtime'}no strict 'refs';*{$sub}=sub {_extract_prereqs($_[2]->{prereqs},$phase,$type)}}}sub _get_build_requires {my ($data,$key,$meta)=@_;my$test_h=_extract_prereqs($_[2]->{prereqs},qw(test requires))|| {};my$build_h=_extract_prereqs($_[2]->{prereqs},qw(build requires))|| {};my$test_req=CPAN::Meta::Requirements->from_string_hash($test_h);my$build_req=CPAN::Meta::Requirements->from_string_hash($build_h);$test_req->add_requirements($build_req)->as_string_hash}sub _extract_prereqs {my ($prereqs,$phase,$type)=@_;return unless ref$prereqs eq 'HASH';return scalar _version_map($prereqs->{$phase}{$type})}sub _downgrade_optional_features {my (undef,undef,$meta)=@_;return unless exists$meta->{optional_features};my$origin=$meta->{optional_features};my$features={};for my$name (keys %$origin){$features->{$name}={description=>$origin->{$name}{description},requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),configure_requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),build_requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),recommends=>_extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),conflicts=>_extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),};for my$k (keys %{$features->{$name}}){delete$features->{$name}{$k}unless defined$features->{$name}{$k}}}return$features}sub _upgrade_optional_features {my (undef,undef,$meta)=@_;return unless exists$meta->{optional_features};my$origin=$meta->{optional_features};my$features={};for my$name (keys %$origin){$features->{$name}={description=>$origin->{$name}{description},prereqs=>_prereqs_from_1(undef,undef,$origin->{$name}),};delete$features->{$name}{prereqs}{configure}}return$features}my$optional_features_2_spec={description=>\&_keep,prereqs=>\&_cleanup_prereqs,':custom'=>\&_prefix_custom,};sub _feature_2 {my ($element,$key,$meta,$to_version)=@_;return unless$element && ref$element eq 'HASH';_convert($element,$optional_features_2_spec,$to_version)}sub _cleanup_optional_features_2 {my ($element,$key,$meta,$to_version)=@_;return unless$element && ref$element eq 'HASH';my$new_data={};for my$k (keys %$element){$new_data->{$k}=_feature_2($element->{$k},$k,$meta,$to_version)}return unless keys %$new_data;return$new_data}sub _optional_features_1_4 {my ($element)=@_;return unless$element;$element=_optional_features_as_map($element);for my$name (keys %$element){for my$drop (qw/requires_packages requires_os excluded_os/){delete$element->{$name}{$drop}}}return$element}sub _optional_features_as_map {my ($element)=@_;return unless$element;if (ref$element eq 'ARRAY'){my%map;for my$feature (@$element){my (@parts)=%$feature;$map{$parts[0]}=$parts[1]}$element=\%map}return$element}sub _is_urlish {defined $_[0]&& $_[0]=~ m{\A[-+.a-z0-9]+:.+}i}sub _url_or_drop {my ($element)=@_;return$element if _is_urlish($element);return}sub _url_list {my ($element)=@_;return unless$element;$element=_listify($element);$element=[grep {_is_urlish($_)}@$element ];return unless @$element;return$element}sub _author_list {my ($element)=@_;return ['unknown' ]unless$element;$element=_listify($element);$element=[map {defined $_ && length $_ ? $_ : 'unknown'}@$element ];return ['unknown' ]unless @$element;return$element}my$resource2_upgrade={license=>sub {return _is_urlish($_[0])? _listify($_[0]): undef},homepage=>\&_url_or_drop,bugtracker=>sub {my ($item)=@_;return unless$item;if ($item =~ m{^mailto:(.*)$}){return {mailto=>$1 }}elsif(_is_urlish($item)){return {web=>$item }}else {return}},repository=>sub {return _is_urlish($_[0])? {url=>$_[0]}: undef},':custom'=>\&_prefix_custom,};sub _upgrade_resources_2 {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource2_upgrade)}my$bugtracker2_spec={web=>\&_url_or_drop,mailto=>\&_keep,':custom'=>\&_prefix_custom,};sub _repo_type {my ($element,$key,$meta,$to_version)=@_;return$element if defined$element;return unless exists$meta->{url};my$repo_url=$meta->{url};for my$type (qw/git svn/){return$type if$repo_url =~ m{\A$type}}return}my$repository2_spec={web=>\&_url_or_drop,url=>\&_url_or_drop,type=>\&_repo_type,':custom'=>\&_prefix_custom,};my$resources2_cleanup={license=>\&_url_list,homepage=>\&_url_or_drop,bugtracker=>sub {ref $_[0]? _convert($_[0],$bugtracker2_spec): undef},repository=>sub {my$data=shift;ref$data ? _convert($data,$repository2_spec): undef},':custom'=>\&_prefix_custom,};sub _cleanup_resources_2 {my ($resources,$key,$meta,$to_version)=@_;return unless$resources && ref$resources eq 'HASH';return _convert($resources,$resources2_cleanup,$to_version)}my$resource1_spec={license=>\&_url_or_drop,homepage=>\&_url_or_drop,bugtracker=>\&_url_or_drop,repository=>\&_url_or_drop,':custom'=>\&_keep,};sub _resources_1_3 {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource1_spec)}*_resources_1_4=*_resources_1_3;sub _resources_1_2 {my (undef,undef,$meta)=@_;my$resources=$meta->{resources}|| {};if ($meta->{license_url}&&!$resources->{license}){$resources->{license}=$meta->{license_url}if _is_urlish($meta->{license_url})}return unless keys %$resources;return _convert($resources,$resource1_spec)}my$resource_downgrade_spec={license=>sub {return ref $_[0]? $_[0]->[0]: $_[0]},homepage=>\&_url_or_drop,bugtracker=>sub {return $_[0]->{web}},repository=>sub {return $_[0]->{url}|| $_[0]->{web}},':custom'=>\&_no_prefix_ucfirst_custom,};sub _downgrade_resources {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource_downgrade_spec)}sub _release_status {my ($element,undef,$meta)=@_;return$element if$element && $element =~ m{\A(?:stable|testing|unstable)\z};return _release_status_from_version(undef,undef,$meta)}sub _release_status_from_version {my (undef,undef,$meta)=@_;my$version=$meta->{version}|| '';return ($version =~ /_/)? 'testing' : 'stable'}my$provides_spec={file=>\&_keep,version=>\&_keep,};my$provides_spec_2={file=>\&_keep,version=>\&_keep,':custom'=>\&_prefix_custom,};sub _provides {my ($element,$key,$meta,$to_version)=@_;return unless defined$element && ref$element eq 'HASH';my$spec=$to_version==2 ? $provides_spec_2 : $provides_spec;my$new_data={};for my$k (keys %$element){$new_data->{$k}=_convert($element->{$k},$spec,$to_version);$new_data->{$k}{version}=_clean_version($element->{$k}{version})if exists$element->{$k}{version}}return$new_data}sub _convert {my ($data,$spec,$to_version,$is_fragment)=@_;my$new_data={};for my$key (keys %$spec){next if$key eq ':custom' || $key eq ':drop';next unless my$fcn=$spec->{$key};if ($is_fragment && $key eq 'generated_by'){$fcn=\&_keep}die "spec for '$key' is not a coderef" unless ref$fcn && ref$fcn eq 'CODE';my$new_value=$fcn->($data->{$key},$key,$data,$to_version);$new_data->{$key}=$new_value if defined$new_value}my$drop_list=$spec->{':drop'};my$customizer=$spec->{':custom'}|| \&_keep;for my$key (keys %$data){next if$drop_list && grep {$key eq $_}@$drop_list;next if exists$spec->{$key};$new_data->{$customizer->($key)}=$data->{$key}}return$new_data}my%up_convert=('2-from-1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_2,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'release_status'=>\&_release_status,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_upgrade_optional_features,'provides'=>\&_provides,'resources'=>\&_upgrade_resources_2,'description'=>\&_keep,'prereqs'=>\&_prereqs_from_1,':drop'=>[qw(build_requires configure_requires conflicts distribution_type license_url private recommends requires) ],':custom'=>\&_prefix_custom,},'1.4-from-1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_optional_features_1_4,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_4,'configure_requires'=>\&_keep,':drop'=>[qw(license_url private)],':custom'=>\&_keep },'1.3-from-1.2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_3,':drop'=>[qw(license_url private)],':custom'=>\&_keep },'1.2-from-1.1'=>{'version'=>\&_keep,'license'=>\&_license_1,'name'=>\&_keep,'generated_by'=>\&_generated_by,'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'recommends'=>\&_version_map,'requires'=>\&_version_map,'keywords'=>\&_keep,'no_index'=>\&_no_index_1_2,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'resources'=>\&_resources_1_2,':drop'=>[qw(license_url private)],':custom'=>\&_keep },'1.1-from-1.0'=>{'version'=>\&_keep,'name'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'recommends'=>\&_version_map,'requires'=>\&_version_map,'license_url'=>\&_url_or_drop,'private'=>\&_keep,':custom'=>\&_keep },);my%down_convert=('1.4-from-2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_downgrade_license,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_get_build_requires,'configure_requires'=>\&_get_configure_requires,'conflicts'=>\&_get_conflicts,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_downgrade_optional_features,'provides'=>\&_provides,'recommends'=>\&_get_recommends,'requires'=>\&_get_requires,'resources'=>\&_downgrade_resources,':drop'=>[qw(description prereqs release_status)],':custom'=>\&_keep },'1.3-from-1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_3,':drop'=>[qw(configure_requires)],':custom'=>\&_keep,},'1.2-from-1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_1_2,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_3,':custom'=>\&_keep,},'1.1-from-1.2'=>{'version'=>\&_keep,'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'private'=>\&_keep,'recommends'=>\&_version_map,'requires'=>\&_version_map,':drop'=>[qw(abstract author provides no_index keywords resources)],':custom'=>\&_keep,},'1.0-from-1.1'=>{'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'recommends'=>\&_version_map,'requires'=>\&_version_map,':custom'=>\&_keep,},);my%cleanup=('2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_2,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'release_status'=>\&_release_status,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_cleanup_optional_features_2,'provides'=>\&_provides,'resources'=>\&_cleanup_resources_2,'description'=>\&_keep,'prereqs'=>\&_cleanup_prereqs,':drop'=>[qw(build_requires configure_requires conflicts distribution_type license_url private recommends requires) ],':custom'=>\&_prefix_custom,},'1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_optional_features_1_4,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_4,'configure_requires'=>\&_keep,':custom'=>\&_keep },'1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'recommends'=>\&_version_map,'requires'=>\&_version_map,'resources'=>\&_resources_1_3,':custom'=>\&_keep },'1.2'=>{'version'=>\&_keep,'license'=>\&_license_1,'name'=>\&_keep,'generated_by'=>\&_generated_by,'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'recommends'=>\&_version_map,'requires'=>\&_version_map,'keywords'=>\&_keep,'no_index'=>\&_no_index_1_2,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'resources'=>\&_resources_1_2,':custom'=>\&_keep },'1.1'=>{'version'=>\&_keep,'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'recommends'=>\&_version_map,'requires'=>\&_version_map,'license_url'=>\&_url_or_drop,'private'=>\&_keep,':custom'=>\&_keep },'1.0'=>{'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'version'=>\&_keep,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'recommends'=>\&_version_map,'requires'=>\&_version_map,':custom'=>\&_keep,},);my%fragments_generate=('2'=>{'abstract'=>'abstract','author'=>'author','generated_by'=>'generated_by','license'=>'license','name'=>'name','version'=>'version','dynamic_config'=>'dynamic_config','release_status'=>'release_status','keywords'=>'keywords','no_index'=>'no_index','optional_features'=>'optional_features','provides'=>'provides','resources'=>'resources','description'=>'description','prereqs'=>'prereqs',},'1.4'=>{'abstract'=>'abstract','author'=>'author','generated_by'=>'generated_by','license'=>'license','name'=>'name','version'=>'version','build_requires'=>'prereqs','conflicts'=>'prereqs','distribution_type'=>'distribution_type','dynamic_config'=>'dynamic_config','keywords'=>'keywords','no_index'=>'no_index','optional_features'=>'optional_features','provides'=>'provides','recommends'=>'prereqs','requires'=>'prereqs','resources'=>'resources','configure_requires'=>'prereqs',},);$fragments_generate{$_}=$fragments_generate{'1.4'}for qw/1.3 1.2 1.1 1.0/;sub new {my ($class,$data,%args)=@_;my$self={'data'=>$data,'spec'=>_extract_spec_version($data,$args{default_version}),};return bless$self,$class}sub _extract_spec_version {my ($data,$default)=@_;my$spec=$data->{'meta-spec'};return($default || "1.0")unless defined$spec && ref$spec eq 'HASH';my$v=$spec->{version};if (defined$v && $v =~ /^\d+(?:\.\d+)?$/){return$v if defined$v && grep {$v eq $_}keys%known_specs;return$v+0 if defined$v && grep {$v==$_}keys%known_specs}return "2" if exists$data->{prereqs};return "1.4" if exists$data->{configure_requires};return($default || "1.2")}sub convert {my ($self,%args)=@_;my$args={%args };my$new_version=$args->{version}|| $HIGHEST;my$is_fragment=$args->{is_fragment};my ($old_version)=$self->{spec};my$converted=_dclone($self->{data});if ($old_version==$new_version){$converted=_convert($converted,$cleanup{$old_version},$old_version,$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to clean-up $old_version metadata. Errors:\n$errs\n"}}return$converted}elsif ($old_version > $new_version){my@vers=sort {$b <=> $a}keys%known_specs;for my$i (0 .. $#vers-1){next if$vers[$i]> $old_version;last if$vers[$i+1]< $new_version;my$spec_string="$vers[$i+1]-from-$vers[$i]";$converted=_convert($converted,$down_convert{$spec_string},$vers[$i+1],$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n"}}}return$converted}else {my@vers=sort {$a <=> $b}keys%known_specs;for my$i (0 .. $#vers-1){next if$vers[$i]< $old_version;last if$vers[$i+1]> $new_version;my$spec_string="$vers[$i+1]-from-$vers[$i]";$converted=_convert($converted,$up_convert{$spec_string},$vers[$i+1],$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n"}}}return$converted}}sub upgrade_fragment {my ($self)=@_;my ($old_version)=$self->{spec};my%expected=map {;$_=>1}grep {defined}map {$fragments_generate{$old_version}{$_}}keys %{$self->{data}};my$converted=$self->convert(version=>$HIGHEST,is_fragment=>1);for my$key (keys %$converted){next if$key =~ /^x_/i || $key eq 'meta-spec';delete$converted->{$key}unless$expected{$key}}return$converted}1;
159
+CPAN_META_CONVERTER
160
+
161
+$fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE';
162
+  use 5.006;use strict;use warnings;package CPAN::Meta::Feature;our$VERSION='2.150005';use CPAN::Meta::Prereqs;sub new {my ($class,$identifier,$spec)=@_;my%guts=(identifier=>$identifier,description=>$spec->{description},prereqs=>CPAN::Meta::Prereqs->new($spec->{prereqs}),);bless \%guts=>$class}sub identifier {$_[0]{identifier}}sub description {$_[0]{description}}sub prereqs {$_[0]{prereqs}}1;
163
+CPAN_META_FEATURE
164
+
165
+$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
166
+  use 5.006;use strict;use warnings;package CPAN::Meta::History;our$VERSION='2.150005';1;
167
+CPAN_META_HISTORY
168
+
169
+$fatpacked{"CPAN/Meta/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_MERGE';
170
+  use strict;use warnings;package CPAN::Meta::Merge;our$VERSION='2.150005';use Carp qw/croak/;use Scalar::Util qw/blessed/;use CPAN::Meta::Converter 2.141170;sub _is_identical {my ($left,$right)=@_;return (not defined$left and not defined$right)|| (defined$left and defined$right and $left eq $right)}sub _identical {my ($left,$right,$path)=@_;croak sprintf "Can't merge attribute %s: '%s' does not equal '%s'",join('.',@{$path}),$left,$right unless _is_identical($left,$right);return$left}sub _merge {my ($current,$next,$mergers,$path)=@_;for my$key (keys %{$next}){if (not exists$current->{$key}){$current->{$key}=$next->{$key}}elsif (my$merger=$mergers->{$key}){$current->{$key}=$merger->($current->{$key},$next->{$key},[@{$path},$key ])}elsif ($merger=$mergers->{':default'}){$current->{$key}=$merger->($current->{$key},$next->{$key},[@{$path},$key ])}else {croak sprintf "Can't merge unknown attribute '%s'",join '.',@{$path},$key}}return$current}sub _uniq {my%seen=();return grep {not $seen{$_}++}@_}sub _set_addition {my ($left,$right)=@_;return [+_uniq(@{$left},@{$right})]}sub _uniq_map {my ($left,$right,$path)=@_;for my$key (keys %{$right}){if (not exists$left->{$key}){$left->{$key}=$right->{$key}}elsif (_is_identical($left->{$key},$right->{$key})){1}elsif (ref$left->{$key}eq 'HASH' and ref$right->{$key}eq 'HASH'){$left->{$key}=_uniq_map($left->{$key},$right->{$key},[@{$path},$key ])}else {croak 'Duplication of element ' .join '.',@{$path},$key}}return$left}sub _improvize {my ($left,$right,$path)=@_;my ($name)=reverse @{$path};if ($name =~ /^x_/){if (ref($left)eq 'ARRAY'){return _set_addition($left,$right,$path)}elsif (ref($left)eq 'HASH'){return _uniq_map($left,$right,$path)}else {return _identical($left,$right,$path)}}croak sprintf "Can't merge '%s'",join '.',@{$path}}sub _optional_features {my ($left,$right,$path)=@_;for my$key (keys %{$right}){if (not exists$left->{$key}){$left->{$key}=$right->{$key}}else {for my$subkey (keys %{$right->{$key}}){next if$subkey eq 'prereqs';if (not exists$left->{$key}{$subkey}){$left->{$key}{$subkey}=$right->{$key}{$subkey}}else {Carp::croak "Cannot merge two optional_features named '$key' with different '$subkey' values" if do {no warnings 'uninitialized';$left->{$key}{$subkey}ne $right->{$key}{$subkey}}}}require CPAN::Meta::Prereqs;$left->{$key}{prereqs}=CPAN::Meta::Prereqs->new($left->{$key}{prereqs})->with_merged_prereqs(CPAN::Meta::Prereqs->new($right->{$key}{prereqs}))->as_string_hash}}return$left}my%default=(abstract=>\&_identical,author=>\&_set_addition,dynamic_config=>sub {my ($left,$right)=@_;return$left || $right},generated_by=>sub {my ($left,$right)=@_;return join ', ',_uniq(split(/, /,$left),split(/, /,$right))},license=>\&_set_addition,'meta-spec'=>{version=>\&_identical,url=>\&_identical },name=>\&_identical,release_status=>\&_identical,version=>\&_identical,description=>\&_identical,keywords=>\&_set_addition,no_index=>{map {($_=>\&_set_addition)}qw/file directory package namespace/ },optional_features=>\&_optional_features,prereqs=>sub {require CPAN::Meta::Prereqs;my ($left,$right)=map {CPAN::Meta::Prereqs->new($_)}@_[0,1];return$left->with_merged_prereqs($right)->as_string_hash},provides=>\&_uniq_map,resources=>{license=>\&_set_addition,homepage=>\&_identical,bugtracker=>\&_uniq_map,repository=>\&_uniq_map,':default'=>\&_improvize,},':default'=>\&_improvize,);sub new {my ($class,%arguments)=@_;croak 'default version required' if not exists$arguments{default_version};my%mapping=%default;my%extra=%{$arguments{extra_mappings}|| {}};for my$key (keys%extra){if (ref($mapping{$key})eq 'HASH'){$mapping{$key}={%{$mapping{$key}},%{$extra{$key}}}}else {$mapping{$key}=$extra{$key}}}return bless {default_version=>$arguments{default_version},mapping=>_coerce_mapping(\%mapping,[]),},$class}my%coderef_for=(set_addition=>\&_set_addition,uniq_map=>\&_uniq_map,identical=>\&_identical,improvize=>\&_improvize,);sub _coerce_mapping {my ($orig,$map_path)=@_;my%ret;for my$key (keys %{$orig}){my$value=$orig->{$key};if (ref($orig->{$key})eq 'CODE'){$ret{$key}=$value}elsif (ref($value)eq 'HASH'){my$mapping=_coerce_mapping($value,[@{$map_path},$key ]);$ret{$key}=sub {my ($left,$right,$path)=@_;return _merge($left,$right,$mapping,[@{$path}])}}elsif ($coderef_for{$value}){$ret{$key}=$coderef_for{$value}}else {croak "Don't know what to do with " .join '.',@{$map_path},$key}}return \%ret}sub merge {my ($self,@items)=@_;my$current={};for my$next (@items){if (blessed($next)&& $next->isa('CPAN::Meta')){$next=$next->as_struct}elsif (ref($next)eq 'HASH'){my$cmc=CPAN::Meta::Converter->new($next,default_version=>$self->{default_version});$next=$cmc->upgrade_fragment}else {croak "Don't know how to merge '$next'"}$current=_merge($current,$next,$self->{mapping},[])}return$current}1;
171
+CPAN_META_MERGE
172
+
173
+$fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
174
+  use 5.006;use strict;use warnings;package CPAN::Meta::Prereqs;our$VERSION='2.150005';use Carp qw(confess);use Scalar::Util qw(blessed);use CPAN::Meta::Requirements 2.121;sub __legal_phases {qw(configure build test runtime develop)}sub __legal_types {qw(requires recommends suggests conflicts)}sub new {my ($class,$prereq_spec)=@_;$prereq_spec ||= {};my%is_legal_phase=map {;$_=>1}$class->__legal_phases;my%is_legal_type=map {;$_=>1}$class->__legal_types;my%guts;PHASE: for my$phase (keys %$prereq_spec){next PHASE unless$phase =~ /\Ax_/i or $is_legal_phase{$phase};my$phase_spec=$prereq_spec->{$phase };next PHASE unless keys %$phase_spec;TYPE: for my$type (keys %$phase_spec){next TYPE unless$type =~ /\Ax_/i or $is_legal_type{$type};my$spec=$phase_spec->{$type };next TYPE unless keys %$spec;$guts{prereqs}{$phase}{$type}=CPAN::Meta::Requirements->from_string_hash($spec)}}return bless \%guts=>$class}sub requirements_for {my ($self,$phase,$type)=@_;confess "requirements_for called without phase" unless defined$phase;confess "requirements_for called without type" unless defined$type;unless ($phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases){confess "requested requirements for unknown phase: $phase"}unless ($type =~ /\Ax_/i or grep {$type eq $_}$self->__legal_types){confess "requested requirements for unknown type: $type"}my$req=($self->{prereqs}{$phase}{$type}||= CPAN::Meta::Requirements->new);$req->finalize if$self->is_finalized;return$req}sub with_merged_prereqs {my ($self,$other)=@_;my@other=blessed($other)? $other : @$other;my@prereq_objs=($self,@other);my%new_arg;for my$phase ($self->__legal_phases){for my$type ($self->__legal_types){my$req=CPAN::Meta::Requirements->new;for my$prereq (@prereq_objs){my$this_req=$prereq->requirements_for($phase,$type);next unless$this_req->required_modules;$req->add_requirements($this_req)}next unless$req->required_modules;$new_arg{$phase }{$type }=$req->as_string_hash}}return (ref$self)->new(\%new_arg)}sub merged_requirements {my ($self,$phases,$types)=@_;$phases=[qw/runtime build test/]unless defined$phases;$types=[qw/requires recommends/]unless defined$types;confess "merged_requirements phases argument must be an arrayref" unless ref$phases eq 'ARRAY';confess "merged_requirements types argument must be an arrayref" unless ref$types eq 'ARRAY';my$req=CPAN::Meta::Requirements->new;for my$phase (@$phases){unless ($phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases){confess "requested requirements for unknown phase: $phase"}for my$type (@$types){unless ($type =~ /\Ax_/i or grep {$type eq $_}$self->__legal_types){confess "requested requirements for unknown type: $type"}$req->add_requirements($self->requirements_for($phase,$type))}}$req->finalize if$self->is_finalized;return$req}sub as_string_hash {my ($self)=@_;my%hash;for my$phase ($self->__legal_phases){for my$type ($self->__legal_types){my$req=$self->requirements_for($phase,$type);next unless$req->required_modules;$hash{$phase }{$type }=$req->as_string_hash}}return \%hash}sub is_finalized {$_[0]{finalized}}sub finalize {my ($self)=@_;$self->{finalized}=1;for my$phase (keys %{$self->{prereqs}}){$_->finalize for values %{$self->{prereqs}{$phase}}}}sub clone {my ($self)=@_;my$clone=(ref$self)->new($self->as_string_hash)}1;
175
+CPAN_META_PREREQS
176
+
177
+$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
178
+  use strict;use warnings;package CPAN::Meta::Requirements;our$VERSION='2.133';use Carp ();BEGIN {eval "use version ()";if (my$err=$@){eval "use ExtUtils::MakeMaker::version" or die$err}}*_is_qv=version->can('is_qv')? sub {$_[0]->is_qv}: sub {exists $_[0]->{qv}};my$V0=version->new(0);my@valid_options=qw(bad_version_hook);sub new {my ($class,$options)=@_;$options ||= {};Carp::croak "Argument to $class\->new() must be a hash reference" unless ref$options eq 'HASH';my%self=map {;$_=>$options->{$_}}@valid_options;return bless \%self=>$class}sub _find_magic_vstring {my$value=shift;my$tvalue='';require B;my$sv=B::svref_2object(\$value);my$magic=ref($sv)eq 'B::PVMG' ? $sv->MAGIC : undef;while ($magic){if ($magic->TYPE eq 'V'){$tvalue=$magic->PTR;$tvalue =~ s/^v?(.+)$/v$1/;last}else {$magic=$magic->MOREMAGIC}}return$tvalue}sub _isa_version {UNIVERSAL::isa($_[0],'UNIVERSAL')&& $_[0]->isa('version')}sub _version_object {my ($self,$module,$version)=@_;my ($vobj,$err);if (not defined$version or (!ref($version)&& $version eq '0')){return$V0}elsif (ref($version)eq 'version' || _isa_version($version)){$vobj=$version}else {if ($INC{'version/vpp.pm'}|| $INC{'ExtUtils/MakeMaker/version/vpp.pm'}){my$magic=_find_magic_vstring($version);$version=$magic if length$magic}eval {local$SIG{__WARN__}=sub {die "Invalid version: $_[0]"};$vobj=version->new($version)};if (my$err=$@){my$hook=$self->{bad_version_hook};$vobj=eval {$hook->($version,$module)}if ref$hook eq 'CODE';unless (eval {$vobj->isa("version")}){$err =~ s{ at .* line \d+.*$}{};die "Can't convert '$version': $err"}}}if ($vobj =~ m{\A\.}){$vobj=version->new("0$vobj")}if (_is_qv($vobj)){$vobj=version->new($vobj->normal)}return$vobj}BEGIN {for my$type (qw(maximum exclusion exact_version)){my$method="with_$type";my$to_add=$type eq 'exact_version' ? $type : "add_$type";my$code=sub {my ($self,$name,$version)=@_;$version=$self->_version_object($name,$version);$self->__modify_entry_for($name,$method,$version);return$self};no strict 'refs';*$to_add=$code}}sub add_minimum {my ($self,$name,$version)=@_;if (not defined$version or "$version" eq '0'){return$self if$self->__entry_for($name);Carp::confess("can't add new requirements to finalized requirements")if$self->is_finalized;$self->{requirements}{$name }=CPAN::Meta::Requirements::_Range::Range->with_minimum($V0)}else {$version=$self->_version_object($name,$version);$self->__modify_entry_for($name,'with_minimum',$version)}return$self}sub add_requirements {my ($self,$req)=@_;for my$module ($req->required_modules){my$modifiers=$req->__entry_for($module)->as_modifiers;for my$modifier (@$modifiers){my ($method,@args)=@$modifier;$self->$method($module=>@args)}}return$self}sub accepts_module {my ($self,$module,$version)=@_;$version=$self->_version_object($module,$version);return 1 unless my$range=$self->__entry_for($module);return$range->_accepts($version)}sub clear_requirement {my ($self,$module)=@_;return$self unless$self->__entry_for($module);Carp::confess("can't clear requirements on finalized requirements")if$self->is_finalized;delete$self->{requirements}{$module };return$self}sub requirements_for_module {my ($self,$module)=@_;my$entry=$self->__entry_for($module);return unless$entry;return$entry->as_string}sub required_modules {keys %{$_[0]{requirements}}}sub clone {my ($self)=@_;my$new=(ref$self)->new;return$new->add_requirements($self)}sub __entry_for {$_[0]{requirements}{$_[1]}}sub __modify_entry_for {my ($self,$name,$method,$version)=@_;my$fin=$self->is_finalized;my$old=$self->__entry_for($name);Carp::confess("can't add new requirements to finalized requirements")if$fin and not $old;my$new=($old || 'CPAN::Meta::Requirements::_Range::Range')->$method($version);Carp::confess("can't modify finalized requirements")if$fin and $old->as_string ne $new->as_string;$self->{requirements}{$name }=$new}sub is_simple {my ($self)=@_;for my$module ($self->required_modules){return if$self->__entry_for($module)->as_string =~ /\s/}return 1}sub is_finalized {$_[0]{finalized}}sub finalize {$_[0]{finalized}=1}sub as_string_hash {my ($self)=@_;my%hash=map {;$_=>$self->{requirements}{$_}->as_string}$self->required_modules;return \%hash}my%methods_for_op=('=='=>[qw(exact_version) ],'!='=>[qw(add_exclusion) ],'>='=>[qw(add_minimum) ],'<='=>[qw(add_maximum) ],'>'=>[qw(add_minimum add_exclusion) ],'<'=>[qw(add_maximum add_exclusion) ],);sub add_string_requirement {my ($self,$module,$req)=@_;unless (defined$req && length$req){$req=0;$self->_blank_carp($module)}my$magic=_find_magic_vstring($req);if (length$magic){$self->add_minimum($module=>$magic);return}my@parts=split qr{\s*,\s*},$req;for my$part (@parts){my ($op,$ver)=$part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};if (!defined$op){$self->add_minimum($module=>$part)}else {Carp::confess("illegal requirement string: $req")unless my$methods=$methods_for_op{$op };$self->$_($module=>$ver)for @$methods}}}sub _blank_carp {my ($self,$module)=@_;Carp::carp("Undefined requirement for $module treated as '0'")}sub from_string_hash {my ($class,$hash,$options)=@_;my$self=$class->new($options);for my$module (keys %$hash){my$req=$hash->{$module};unless (defined$req && length$req){$req=0;$class->_blank_carp($module)}$self->add_string_requirement($module,$req)}return$self}{package CPAN::Meta::Requirements::_Range::Exact;sub _new {bless {version=>$_[1]}=>$_[0]}sub _accepts {return $_[0]{version}==$_[1]}sub as_string {return "== $_[0]{version}"}sub as_modifiers {return [[exact_version=>$_[0]{version}]]}sub _clone {(ref $_[0])->_new(version->new($_[0]{version}))}sub with_exact_version {my ($self,$version)=@_;return$self->_clone if$self->_accepts($version);Carp::confess("illegal requirements: unequal exact version specified")}sub with_minimum {my ($self,$minimum)=@_;return$self->_clone if$self->{version}>= $minimum;Carp::confess("illegal requirements: minimum above exact specification")}sub with_maximum {my ($self,$maximum)=@_;return$self->_clone if$self->{version}<= $maximum;Carp::confess("illegal requirements: maximum below exact specification")}sub with_exclusion {my ($self,$exclusion)=@_;return$self->_clone unless$exclusion==$self->{version};Carp::confess("illegal requirements: excluded exact specification")}}{package CPAN::Meta::Requirements::_Range::Range;sub _self {ref($_[0])? $_[0]: (bless {}=>$_[0])}sub _clone {return (bless {}=>$_[0])unless ref $_[0];my ($s)=@_;my%guts=((exists$s->{minimum}? (minimum=>version->new($s->{minimum})): ()),(exists$s->{maximum}? (maximum=>version->new($s->{maximum})): ()),(exists$s->{exclusions}? (exclusions=>[map {version->new($_)}@{$s->{exclusions}}]): ()),);bless \%guts=>ref($s)}sub as_modifiers {my ($self)=@_;my@mods;push@mods,[add_minimum=>$self->{minimum}]if exists$self->{minimum};push@mods,[add_maximum=>$self->{maximum}]if exists$self->{maximum};push@mods,map {;[add_exclusion=>$_ ]}@{$self->{exclusions}|| []};return \@mods}sub as_string {my ($self)=@_;return 0 if!keys %$self;return "$self->{minimum}" if (keys %$self)==1 and exists$self->{minimum};my@exclusions=@{$self->{exclusions}|| []};my@parts;for my$pair ([qw(>= > minimum) ],[qw(<= < maximum) ],){my ($op,$e_op,$k)=@$pair;if (exists$self->{$k}){my@new_exclusions=grep {$_!=$self->{$k }}@exclusions;if (@new_exclusions==@exclusions){push@parts,"$op $self->{ $k }"}else {push@parts,"$e_op $self->{ $k }";@exclusions=@new_exclusions}}}push@parts,map {;"!= $_"}@exclusions;return join q{, },@parts}sub with_exact_version {my ($self,$version)=@_;$self=$self->_clone;Carp::confess("illegal requirements: exact specification outside of range")unless$self->_accepts($version);return CPAN::Meta::Requirements::_Range::Exact->_new($version)}sub _simplify {my ($self)=@_;if (defined$self->{minimum}and defined$self->{maximum}){if ($self->{minimum}==$self->{maximum}){Carp::confess("illegal requirements: excluded all values")if grep {$_==$self->{minimum}}@{$self->{exclusions}|| []};return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})}Carp::confess("illegal requirements: minimum exceeds maximum")if$self->{minimum}> $self->{maximum}}if ($self->{exclusions}){my%seen;@{$self->{exclusions}}=grep {(!defined$self->{minimum}or $_ >= $self->{minimum})and (!defined$self->{maximum}or $_ <= $self->{maximum})and !$seen{$_}++}@{$self->{exclusions}}}return$self}sub with_minimum {my ($self,$minimum)=@_;$self=$self->_clone;if (defined (my$old_min=$self->{minimum})){$self->{minimum}=(sort {$b cmp $a}($minimum,$old_min))[0]}else {$self->{minimum}=$minimum}return$self->_simplify}sub with_maximum {my ($self,$maximum)=@_;$self=$self->_clone;if (defined (my$old_max=$self->{maximum})){$self->{maximum}=(sort {$a cmp $b}($maximum,$old_max))[0]}else {$self->{maximum}=$maximum}return$self->_simplify}sub with_exclusion {my ($self,$exclusion)=@_;$self=$self->_clone;push @{$self->{exclusions}||= []},$exclusion;return$self->_simplify}sub _accepts {my ($self,$version)=@_;return if defined$self->{minimum}and $version < $self->{minimum};return if defined$self->{maximum}and $version > $self->{maximum};return if defined$self->{exclusions}and grep {$version==$_}@{$self->{exclusions}};return 1}}1;
179
+CPAN_META_REQUIREMENTS
180
+
181
+$fatpacked{"CPAN/Meta/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC';
182
+  use 5.006;use strict;use warnings;package CPAN::Meta::Spec;our$VERSION='2.150005';1;
183
+CPAN_META_SPEC
184
+
185
+$fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
186
+  use 5.006;use strict;use warnings;package CPAN::Meta::Validator;our$VERSION='2.150005';my%known_specs=('1.4'=>'http://module-build.sourceforge.net/META-spec-v1.4.html','1.3'=>'http://module-build.sourceforge.net/META-spec-v1.3.html','1.2'=>'http://module-build.sourceforge.net/META-spec-v1.2.html','1.1'=>'http://module-build.sourceforge.net/META-spec-v1.1.html','1.0'=>'http://module-build.sourceforge.net/META-spec-v1.0.html');my%known_urls=map {$known_specs{$_}=>$_}keys%known_specs;my$module_map1={'map'=>{':key'=>{name=>\&module,value=>\&exversion }}};my$module_map2={'map'=>{':key'=>{name=>\&module,value=>\&version }}};my$no_index_2={'map'=>{file=>{list=>{value=>\&string }},directory=>{list=>{value=>\&string }},'package'=>{list=>{value=>\&string }},namespace=>{list=>{value=>\&string }},':key'=>{name=>\&custom_2,value=>\&anything },}};my$no_index_1_3={'map'=>{file=>{list=>{value=>\&string }},directory=>{list=>{value=>\&string }},'package'=>{list=>{value=>\&string }},namespace=>{list=>{value=>\&string }},':key'=>{name=>\&string,value=>\&anything },}};my$no_index_1_2={'map'=>{file=>{list=>{value=>\&string }},dir=>{list=>{value=>\&string }},'package'=>{list=>{value=>\&string }},namespace=>{list=>{value=>\&string }},':key'=>{name=>\&string,value=>\&anything },}};my$no_index_1_1={'map'=>{':key'=>{name=>\&string,list=>{value=>\&string }},}};my$prereq_map={map=>{':key'=>{name=>\&phase,'map'=>{':key'=>{name=>\&relation,%$module_map1,},},}},};my%definitions=('2'=>{'abstract'=>{mandatory=>1,value=>\&string },'author'=>{mandatory=>1,list=>{value=>\&string }},'dynamic_config'=>{mandatory=>1,value=>\&boolean },'generated_by'=>{mandatory=>1,value=>\&string },'license'=>{mandatory=>1,list=>{value=>\&license }},'meta-spec'=>{mandatory=>1,'map'=>{version=>{mandatory=>1,value=>\&version},url=>{value=>\&url },':key'=>{name=>\&custom_2,value=>\&anything },}},'name'=>{mandatory=>1,value=>\&string },'release_status'=>{mandatory=>1,value=>\&release_status },'version'=>{mandatory=>1,value=>\&version },'description'=>{value=>\&string },'keywords'=>{list=>{value=>\&string }},'no_index'=>$no_index_2,'optional_features'=>{'map'=>{':key'=>{name=>\&string,'map'=>{description=>{value=>\&string },prereqs=>$prereq_map,':key'=>{name=>\&custom_2,value=>\&anything },}}}},'prereqs'=>$prereq_map,'provides'=>{'map'=>{':key'=>{name=>\&module,'map'=>{file=>{mandatory=>1,value=>\&file },version=>{value=>\&version },':key'=>{name=>\&custom_2,value=>\&anything },}}}},'resources'=>{'map'=>{license=>{list=>{value=>\&url }},homepage=>{value=>\&url },bugtracker=>{'map'=>{web=>{value=>\&url },mailto=>{value=>\&string},':key'=>{name=>\&custom_2,value=>\&anything },}},repository=>{'map'=>{web=>{value=>\&url },url=>{value=>\&url },type=>{value=>\&string },':key'=>{name=>\&custom_2,value=>\&anything },}},':key'=>{value=>\&string,name=>\&custom_2 },}},':key'=>{name=>\&custom_2,value=>\&anything },},'1.4'=>{'meta-spec'=>{mandatory=>1,'map'=>{version=>{mandatory=>1,value=>\&version},url=>{mandatory=>1,value=>\&urlspec },':key'=>{name=>\&string,value=>\&anything },},},'name'=>{mandatory=>1,value=>\&string },'version'=>{mandatory=>1,value=>\&version },'abstract'=>{mandatory=>1,value=>\&string },'author'=>{mandatory=>1,list=>{value=>\&string }},'license'=>{mandatory=>1,value=>\&license },'generated_by'=>{mandatory=>1,value=>\&string },'distribution_type'=>{value=>\&string },'dynamic_config'=>{value=>\&boolean },'requires'=>$module_map1,'recommends'=>$module_map1,'build_requires'=>$module_map1,'configure_requires'=>$module_map1,'conflicts'=>$module_map2,'optional_features'=>{'map'=>{':key'=>{name=>\&string,'map'=>{description=>{value=>\&string },requires=>$module_map1,recommends=>$module_map1,build_requires=>$module_map1,conflicts=>$module_map2,':key'=>{name=>\&string,value=>\&anything },}}}},'provides'=>{'map'=>{':key'=>{name=>\&module,'map'=>{file=>{mandatory=>1,value=>\&file },version=>{value=>\&version },':key'=>{name=>\&string,value=>\&anything },}}}},'no_index'=>$no_index_1_3,'private'=>$no_index_1_3,'keywords'=>{list=>{value=>\&string }},'resources'=>{'map'=>{license=>{value=>\&url },homepage=>{value=>\&url },bugtracker=>{value=>\&url },repository=>{value=>\&url },':key'=>{value=>\&string,name=>\&custom_1 },}},':key'=>{name=>\&string,value=>\&anything },},'1.3'=>{'meta-spec'=>{mandatory=>1,'map'=>{version=>{mandatory=>1,value=>\&version},url=>{mandatory=>1,value=>\&urlspec },':key'=>{name=>\&string,value=>\&anything },},},'name'=>{mandatory=>1,value=>\&string },'version'=>{mandatory=>1,value=>\&version },'abstract'=>{mandatory=>1,value=>\&string },'author'=>{mandatory=>1,list=>{value=>\&string }},'license'=>{mandatory=>1,value=>\&license },'generated_by'=>{mandatory=>1,value=>\&string },'distribution_type'=>{value=>\&string },'dynamic_config'=>{value=>\&boolean },'requires'=>$module_map1,'recommends'=>$module_map1,'build_requires'=>$module_map1,'conflicts'=>$module_map2,'optional_features'=>{'map'=>{':key'=>{name=>\&string,'map'=>{description=>{value=>\&string },requires=>$module_map1,recommends=>$module_map1,build_requires=>$module_map1,conflicts=>$module_map2,':key'=>{name=>\&string,value=>\&anything },}}}},'provides'=>{'map'=>{':key'=>{name=>\&module,'map'=>{file=>{mandatory=>1,value=>\&file },version=>{value=>\&version },':key'=>{name=>\&string,value=>\&anything },}}}},'no_index'=>$no_index_1_3,'private'=>$no_index_1_3,'keywords'=>{list=>{value=>\&string }},'resources'=>{'map'=>{license=>{value=>\&url },homepage=>{value=>\&url },bugtracker=>{value=>\&url },repository=>{value=>\&url },':key'=>{value=>\&string,name=>\&custom_1 },}},':key'=>{name=>\&string,value=>\&anything },},'1.2'=>{'meta-spec'=>{mandatory=>1,'map'=>{version=>{mandatory=>1,value=>\&version},url=>{mandatory=>1,value=>\&urlspec },':key'=>{name=>\&string,value=>\&anything },},},'name'=>{mandatory=>1,value=>\&string },'version'=>{mandatory=>1,value=>\&version },'license'=>{mandatory=>1,value=>\&license },'generated_by'=>{mandatory=>1,value=>\&string },'author'=>{mandatory=>1,list=>{value=>\&string }},'abstract'=>{mandatory=>1,value=>\&string },'distribution_type'=>{value=>\&string },'dynamic_config'=>{value=>\&boolean },'keywords'=>{list=>{value=>\&string }},'private'=>$no_index_1_2,'$no_index'=>$no_index_1_2,'requires'=>$module_map1,'recommends'=>$module_map1,'build_requires'=>$module_map1,'conflicts'=>$module_map2,'optional_features'=>{'map'=>{':key'=>{name=>\&string,'map'=>{description=>{value=>\&string },requires=>$module_map1,recommends=>$module_map1,build_requires=>$module_map1,conflicts=>$module_map2,':key'=>{name=>\&string,value=>\&anything },}}}},'provides'=>{'map'=>{':key'=>{name=>\&module,'map'=>{file=>{mandatory=>1,value=>\&file },version=>{value=>\&version },':key'=>{name=>\&string,value=>\&anything },}}}},'resources'=>{'map'=>{license=>{value=>\&url },homepage=>{value=>\&url },bugtracker=>{value=>\&url },repository=>{value=>\&url },':key'=>{value=>\&string,name=>\&custom_1 },}},':key'=>{name=>\&string,value=>\&anything },},'1.1'=>{'name'=>{value=>\&string },'version'=>{mandatory=>1,value=>\&version },'license'=>{value=>\&license },'generated_by'=>{value=>\&string },'license_uri'=>{value=>\&url },'distribution_type'=>{value=>\&string },'dynamic_config'=>{value=>\&boolean },'private'=>$no_index_1_1,'requires'=>$module_map1,'recommends'=>$module_map1,'build_requires'=>$module_map1,'conflicts'=>$module_map2,':key'=>{name=>\&string,value=>\&anything },},'1.0'=>{'name'=>{value=>\&string },'version'=>{mandatory=>1,value=>\&version },'license'=>{value=>\&license },'generated_by'=>{value=>\&string },'license_uri'=>{value=>\&url },'distribution_type'=>{value=>\&string },'dynamic_config'=>{value=>\&boolean },'requires'=>$module_map1,'recommends'=>$module_map1,'build_requires'=>$module_map1,'conflicts'=>$module_map2,':key'=>{name=>\&string,value=>\&anything },},);sub new {my ($class,$data)=@_;my$self={'data'=>$data,'spec'=>eval {$data->{'meta-spec'}{'version'}}|| "1.0",'errors'=>undef,};return bless$self,$class}sub is_valid {my$self=shift;my$data=$self->{data};my$spec_version=$self->{spec};$self->check_map($definitions{$spec_version},$data);return!$self->errors}sub errors {my$self=shift;return ()unless(defined$self->{errors});return @{$self->{errors}}}my$spec_error="Missing validation action in specification. " ."Must be one of 'map', 'list', or 'value'";sub check_map {my ($self,$spec,$data)=@_;if(ref($spec)ne 'HASH'){$self->_error("Unknown META specification, cannot validate.");return}if(ref($data)ne 'HASH'){$self->_error("Expected a map structure from string or file.");return}for my$key (keys %$spec){next unless($spec->{$key}->{mandatory});next if(defined$data->{$key});push @{$self->{stack}},$key;$self->_error("Missing mandatory field, '$key'");pop @{$self->{stack}}}for my$key (keys %$data){push @{$self->{stack}},$key;if($spec->{$key}){if($spec->{$key}{value}){$spec->{$key}{value}->($self,$key,$data->{$key})}elsif($spec->{$key}{'map'}){$self->check_map($spec->{$key}{'map'},$data->{$key})}elsif($spec->{$key}{'list'}){$self->check_list($spec->{$key}{'list'},$data->{$key})}else {$self->_error("$spec_error for '$key'")}}elsif ($spec->{':key'}){$spec->{':key'}{name}->($self,$key,$key);if($spec->{':key'}{value}){$spec->{':key'}{value}->($self,$key,$data->{$key})}elsif($spec->{':key'}{'map'}){$self->check_map($spec->{':key'}{'map'},$data->{$key})}elsif($spec->{':key'}{'list'}){$self->check_list($spec->{':key'}{'list'},$data->{$key})}else {$self->_error("$spec_error for ':key'")}}else {$self->_error("Unknown key, '$key', found in map structure")}pop @{$self->{stack}}}}sub check_list {my ($self,$spec,$data)=@_;if(ref($data)ne 'ARRAY'){$self->_error("Expected a list structure");return}if(defined$spec->{mandatory}){if(!defined$data->[0]){$self->_error("Missing entries from mandatory list")}}for my$value (@$data){push @{$self->{stack}},$value || "<undef>";if(defined$spec->{value}){$spec->{value}->($self,'list',$value)}elsif(defined$spec->{'map'}){$self->check_map($spec->{'map'},$value)}elsif(defined$spec->{'list'}){$self->check_list($spec->{'list'},$value)}elsif ($spec->{':key'}){$self->check_map($spec,$value)}else {$self->_error("$spec_error associated with '$self->{stack}[-2]'")}pop @{$self->{stack}}}}sub header {my ($self,$key,$value)=@_;if(defined$value){return 1 if($value && $value =~ /^--- #YAML:1.0/)}$self->_error("file does not have a valid YAML header.");return 0}sub release_status {my ($self,$key,$value)=@_;if(defined$value){my$version=$self->{data}{version}|| '';if ($version =~ /_/){return 1 if ($value =~ /\A(?:testing|unstable)\z/);$self->_error("'$value' for '$key' is invalid for version '$version'")}else {return 1 if ($value =~ /\A(?:stable|testing|unstable)\z/);$self->_error("'$value' for '$key' is invalid")}}else {$self->_error("'$key' is not defined")}return 0}sub _uri_split {return $_[0]=~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,}sub url {my ($self,$key,$value)=@_;if(defined$value){my ($scheme,$auth,$path,$query,$frag)=_uri_split($value);unless (defined$scheme && length$scheme){$self->_error("'$value' for '$key' does not have a URL scheme");return 0}unless (defined$auth && length$auth){$self->_error("'$value' for '$key' does not have a URL authority");return 0}return 1}$value ||= '';$self->_error("'$value' for '$key' is not a valid URL.");return 0}sub urlspec {my ($self,$key,$value)=@_;if(defined$value){return 1 if($value && $known_specs{$self->{spec}}eq $value);if($value && $known_urls{$value}){$self->_error('META specification URL does not match version');return 0}}$self->_error('Unknown META specification');return 0}sub anything {return 1}sub string {my ($self,$key,$value)=@_;if(defined$value){return 1 if($value || $value =~ /^0$/)}$self->_error("value is an undefined string");return 0}sub string_or_undef {my ($self,$key,$value)=@_;return 1 unless(defined$value);return 1 if($value || $value =~ /^0$/);$self->_error("No string defined for '$key'");return 0}sub file {my ($self,$key,$value)=@_;return 1 if(defined$value);$self->_error("No file defined for '$key'");return 0}sub exversion {my ($self,$key,$value)=@_;if(defined$value && ($value || $value =~ /0/)){my$pass=1;for(split(",",$value)){$self->version($key,$_)or ($pass=0)}return$pass}$value='<undef>' unless(defined$value);$self->_error("'$value' for '$key' is not a valid version.");return 0}sub version {my ($self,$key,$value)=@_;if(defined$value){return 0 unless($value || $value =~ /0/);return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/)}else {$value='<undef>'}$self->_error("'$value' for '$key' is not a valid version.");return 0}sub boolean {my ($self,$key,$value)=@_;if(defined$value){return 1 if($value =~ /^(0|1|true|false)$/)}else {$value='<undef>'}$self->_error("'$value' for '$key' is not a boolean value.");return 0}my%v1_licenses=('perl'=>'http://dev.perl.org/licenses/','gpl'=>'http://www.opensource.org/licenses/gpl-license.php','apache'=>'http://apache.org/licenses/LICENSE-2.0','artistic'=>'http://opensource.org/licenses/artistic-license.php','artistic_2'=>'http://opensource.org/licenses/artistic-license-2.0.php','lgpl'=>'http://www.opensource.org/licenses/lgpl-license.php','bsd'=>'http://www.opensource.org/licenses/bsd-license.php','gpl'=>'http://www.opensource.org/licenses/gpl-license.php','mit'=>'http://opensource.org/licenses/mit-license.php','mozilla'=>'http://opensource.org/licenses/mozilla1.1.php','open_source'=>undef,'unrestricted'=>undef,'restrictive'=>undef,'unknown'=>undef,);my%v2_licenses=map {$_=>1}qw(agpl_3 apache_1_1 apache_2_0 artistic_1 artistic_2 bsd freebsd gfdl_1_2 gfdl_1_3 gpl_1 gpl_2 gpl_3 lgpl_2_1 lgpl_3_0 mit mozilla_1_0 mozilla_1_1 openssl perl_5 qpl_1_0 ssleay sun zlib open_source restricted unrestricted unknown);sub license {my ($self,$key,$value)=@_;my$licenses=$self->{spec}< 2 ? \%v1_licenses : \%v2_licenses;if(defined$value){return 1 if($value && exists$licenses->{$value})}else {$value='<undef>'}$self->_error("License '$value' is invalid");return 0}sub custom_1 {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/)}else {$key='<undef>'}$self->_error("Custom resource '$key' must be in CamelCase.");return 0}sub custom_2 {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^x_/i)}else {$key='<undef>'}$self->_error("Custom key '$key' must begin with 'x_' or 'X_'.");return 0}sub identifier {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i)}else {$key='<undef>'}$self->_error("Key '$key' is not a legal identifier.");return 0}sub module {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/)}else {$key='<undef>'}$self->_error("Key '$key' is not a legal module name.");return 0}my@valid_phases=qw/configure build test runtime develop/;sub phase {my ($self,$key)=@_;if(defined$key){return 1 if(length$key && grep {$key eq $_}@valid_phases);return 1 if$key =~ /x_/i}else {$key='<undef>'}$self->_error("Key '$key' is not a legal phase.");return 0}my@valid_relations=qw/requires recommends suggests conflicts/;sub relation {my ($self,$key)=@_;if(defined$key){return 1 if(length$key && grep {$key eq $_}@valid_relations);return 1 if$key =~ /x_/i}else {$key='<undef>'}$self->_error("Key '$key' is not a legal prereq relationship.");return 0}sub _error {my$self=shift;my$mess=shift;$mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack});$mess .= " [Validation: $self->{spec}]";push @{$self->{errors}},$mess}1;
187
+CPAN_META_VALIDATOR
188
+
189
+$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML';
190
+  use 5.008001;use strict;use warnings;package CPAN::Meta::YAML;$CPAN::Meta::YAML::VERSION='0.016';;use Exporter;our@ISA=qw{Exporter};our@EXPORT=qw{Load Dump};our@EXPORT_OK=qw{LoadFile DumpFile freeze thaw};sub Dump {return CPAN::Meta::YAML->new(@_)->_dump_string}sub Load {my$self=CPAN::Meta::YAML->_load_string(@_);if (wantarray){return @$self}else {return$self->[-1]}}BEGIN {*freeze=\&Dump;*thaw=\&Load}sub DumpFile {my$file=shift;return CPAN::Meta::YAML->new(@_)->_dump_file($file)}sub LoadFile {my$file=shift;my$self=CPAN::Meta::YAML->_load_file($file);if (wantarray){return @$self}else {return$self->[-1]}}sub new {my$class=shift;bless [@_ ],$class}sub read_string {my$self=shift;$self->_load_string(@_)}sub write_string {my$self=shift;$self->_dump_string(@_)}sub read {my$self=shift;$self->_load_file(@_)}sub write {my$self=shift;$self->_dump_file(@_)}my@UNPRINTABLE=qw(0 x01 x02 x03 x04 x05 x06 a b t n v f r x0E x0F x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1A e x1C x1D x1E x1F);my%UNESCAPES=(0=>"\x00",z=>"\x00",N=>"\x85",a=>"\x07",b=>"\x08",t=>"\x09",n=>"\x0a",v=>"\x0b",f=>"\x0c",r=>"\x0d",e=>"\x1b",'\\'=>'\\',);my%QUOTE=map {$_=>1}qw{null true false};my$re_capture_double_quoted=qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;my$re_capture_single_quoted=qr/\'([^\']*(?:\'\'[^\']*)*)\'/;my$re_capture_unquoted_key=qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;my$re_trailing_comment=qr/(?:\s+\#.*)?/;my$re_key_value_separator=qr/\s*:(?:\s+(?:\#.*)?|$)/;sub _load_file {my$class=ref $_[0]? ref shift : shift;my$file=shift or $class->_error('You did not specify a file name');$class->_error("File '$file' does not exist")unless -e $file;$class->_error("'$file' is a directory, not a file")unless -f _;$class->_error("Insufficient permissions to read '$file'")unless -r _;open(my$fh,"<:unix:encoding(UTF-8)",$file);unless ($fh){$class->_error("Failed to open file '$file': $!")}if (_can_flock()){flock($fh,Fcntl::LOCK_SH())or warn "Couldn't lock '$file' for reading: $!"}my$contents=eval {use warnings FATAL=>'utf8';local $/;<$fh>};if (my$err=$@){$class->_error("Error reading from file '$file': $err")}unless (close$fh){$class->_error("Failed to close file '$file': $!")}$class->_load_string($contents)}sub _load_string {my$class=ref $_[0]? ref shift : shift;my$self=bless [],$class;my$string=$_[0];eval {unless (defined$string){die \"Did not provide a string to load"}if (utf8::is_utf8($string)&&!utf8::valid($string)){die \<<'...'}utf8::upgrade($string);$string =~ s/^\x{FEFF}//;return$self unless length$string;my@lines=grep {!/^\s*(?:\#.*)?\z/}split /(?:\015{1,2}\012|\015|\012)/,$string;@lines and $lines[0]=~ /^\%YAML[: ][\d\.]+.*\z/ and shift@lines;my$in_document=0;while (@lines){if ($lines[0]=~ /^---\s*(?:(.+)\s*)?\z/){shift@lines;if (defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/){push @$self,$self->_load_scalar("$1",[undef ],\@lines);next}$in_document=1}if (!@lines or $lines[0]=~ /^(?:---|\.\.\.)/){push @$self,undef;while (@lines and $lines[0]!~ /^---/){shift@lines}$in_document=0}elsif (!$in_document && @$self){die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"}elsif ($lines[0]=~ /^\s*\-(?:\s|$|-+$)/){my$document=[];push @$self,$document;$self->_load_array($document,[0 ],\@lines)}elsif ($lines[0]=~ /^(\s*)\S/){my$document={};push @$self,$document;$self->_load_hash($document,[length($1)],\@lines)}else {die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"}}};my$err=$@;if (ref$err eq 'SCALAR'){$self->_error(${$err})}elsif ($err){$self->_error($err)}return$self}sub _unquote_single {my ($self,$string)=@_;return '' unless length$string;$string =~ s/\'\'/\'/g;return$string}sub _unquote_double {my ($self,$string)=@_;return '' unless length$string;$string =~ s/\\"/"/g;$string =~ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
191
+  Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
192
+  Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
193
+  ...
194
+           {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;return$string}sub _load_scalar {my ($self,$string,$indent,$lines)=@_;$string =~ s/\s*\z//;return undef if$string eq '~';if ($string =~ /^$re_capture_single_quoted$re_trailing_comment\z/){return$self->_unquote_single($1)}if ($string =~ /^$re_capture_double_quoted$re_trailing_comment\z/){return$self->_unquote_double($1)}if ($string =~ /^[\'\"!&]/){die \"CPAN::Meta::YAML does not support a feature in line '$string'"}return {}if$string =~ /^{}(?:\s+\#.*)?\z/;return []if$string =~ /^\[\](?:\s+\#.*)?\z/;if ($string !~ /^[>|]/){die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'" if$string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or $string =~ /:(?:\s|$)/;$string =~ s/\s+#.*\z//;return$string}die \"CPAN::Meta::YAML failed to find multi-line scalar content" unless @$lines;$lines->[0]=~ /^(\s*)/;$indent->[-1]=length("$1");if (defined$indent->[-2]and $indent->[-1]<= $indent->[-2]){die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"}my@multiline=();while (@$lines){$lines->[0]=~ /^(\s*)/;last unless length($1)>= $indent->[-1];push@multiline,substr(shift(@$lines),length($1))}my$j=(substr($string,0,1)eq '>')? ' ' : "\n";my$t=(substr($string,1,1)eq '-')? '' : "\n";return join($j,@multiline).$t}sub _load_array {my ($self,$array,$indent,$lines)=@_;while (@$lines){if ($lines->[0]=~ /^(?:---|\.\.\.)/){while (@$lines and $lines->[0]!~ /^---/){shift @$lines}return 1}$lines->[0]=~ /^(\s*)/;if (length($1)< $indent->[-1]){return 1}elsif (length($1)> $indent->[-1]){die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"}if ($lines->[0]=~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/){my$indent2=length("$1");$lines->[0]=~ s/-/ /;push @$array,{};$self->_load_hash($array->[-1],[@$indent,$indent2 ],$lines)}elsif ($lines->[0]=~ /^\s*\-\s*\z/){shift @$lines;unless (@$lines){push @$array,undef;return 1}if ($lines->[0]=~ /^(\s*)\-/){my$indent2=length("$1");if ($indent->[-1]==$indent2){push @$array,undef}else {push @$array,[];$self->_load_array($array->[-1],[@$indent,$indent2 ],$lines)}}elsif ($lines->[0]=~ /^(\s*)\S/){push @$array,{};$self->_load_hash($array->[-1],[@$indent,length("$1")],$lines)}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}}elsif ($lines->[0]=~ /^\s*\-(\s*)(.+?)\s*\z/){shift @$lines;push @$array,$self->_load_scalar("$2",[@$indent,undef ],$lines)}elsif (defined$indent->[-2]and $indent->[-1]==$indent->[-2]){return 1}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}}return 1}sub _load_hash {my ($self,$hash,$indent,$lines)=@_;while (@$lines){if ($lines->[0]=~ /^(?:---|\.\.\.)/){while (@$lines and $lines->[0]!~ /^---/){shift @$lines}return 1}$lines->[0]=~ /^(\s*)/;if (length($1)< $indent->[-1]){return 1}elsif (length($1)> $indent->[-1]){die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"}my$key;if ($lines->[0]=~ s/^\s*$re_capture_single_quoted$re_key_value_separator//){$key=$self->_unquote_single($1)}elsif ($lines->[0]=~ s/^\s*$re_capture_double_quoted$re_key_value_separator//){$key=$self->_unquote_double($1)}elsif ($lines->[0]=~ s/^\s*$re_capture_unquoted_key$re_key_value_separator//){$key=$1;$key =~ s/\s+$//}elsif ($lines->[0]=~ /^\s*\?/){die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'"}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}if (exists$hash->{$key}){warn "CPAN::Meta::YAML found a duplicate key '$key' in line '$lines->[0]'"}if (length$lines->[0]){$hash->{$key}=$self->_load_scalar(shift(@$lines),[@$indent,undef ],$lines)}else {shift @$lines;unless (@$lines){$hash->{$key}=undef;return 1}if ($lines->[0]=~ /^(\s*)-/){$hash->{$key}=[];$self->_load_array($hash->{$key},[@$indent,length($1)],$lines)}elsif ($lines->[0]=~ /^(\s*)./){my$indent2=length("$1");if ($indent->[-1]>= $indent2){$hash->{$key}=undef}else {$hash->{$key}={};$self->_load_hash($hash->{$key},[@$indent,length($1)],$lines)}}}}return 1}sub _dump_file {my$self=shift;require Fcntl;my$file=shift or $self->_error('You did not specify a file name');my$fh;if (_can_flock()){my$flags=Fcntl::O_WRONLY()|Fcntl::O_CREAT();sysopen($fh,$file,$flags);unless ($fh){$self->_error("Failed to open file '$file' for writing: $!")}binmode($fh,":raw:encoding(UTF-8)");flock($fh,Fcntl::LOCK_EX())or warn "Couldn't lock '$file' for reading: $!";truncate$fh,0;seek$fh,0,0}else {open$fh,">:unix:encoding(UTF-8)",$file}print {$fh}$self->_dump_string;unless (close$fh){$self->_error("Failed to close file '$file': $!")}return 1}sub _dump_string {my$self=shift;return '' unless ref$self && @$self;my$indent=0;my@lines=();eval {for my$cursor (@$self){push@lines,'---';if (!defined$cursor){}elsif (!ref$cursor){$lines[-1].= ' ' .$self->_dump_scalar($cursor)}elsif (ref$cursor eq 'ARRAY'){unless (@$cursor){$lines[-1].= ' []';next}push@lines,$self->_dump_array($cursor,$indent,{})}elsif (ref$cursor eq 'HASH'){unless (%$cursor){$lines[-1].= ' {}';next}push@lines,$self->_dump_hash($cursor,$indent,{})}else {die \("Cannot serialize " .ref($cursor))}}};if (ref $@ eq 'SCALAR'){$self->_error(${$@})}elsif ($@){$self->_error($@)}join '',map {"$_\n"}@lines}sub _has_internal_string_value {my$value=shift;my$b_obj=B::svref_2object(\$value);return$b_obj->FLAGS & B::SVf_POK()}sub _dump_scalar {my$string=$_[1];my$is_key=$_[2];my$has_string_flag=_has_internal_string_value($string);return '~' unless defined$string;return "''" unless length$string;if (Scalar::Util::looks_like_number($string)){if ($is_key || $has_string_flag){return qq['$string']}else {return$string}}if ($string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/){$string =~ s/\\/\\\\/g;$string =~ s/"/\\"/g;$string =~ s/\n/\\n/g;$string =~ s/[\x85]/\\N/g;$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;$string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;return qq|"$string"|}if ($string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or $QUOTE{$string}){return "'$string'"}return$string}sub _dump_array {my ($self,$array,$indent,$seen)=@_;if ($seen->{refaddr($array)}++){die \"CPAN::Meta::YAML does not support circular references"}my@lines=();for my$el (@$array){my$line=('  ' x $indent).'-';my$type=ref$el;if (!$type){$line .= ' ' .$self->_dump_scalar($el);push@lines,$line}elsif ($type eq 'ARRAY'){if (@$el){push@lines,$line;push@lines,$self->_dump_array($el,$indent + 1,$seen)}else {$line .= ' []';push@lines,$line}}elsif ($type eq 'HASH'){if (keys %$el){push@lines,$line;push@lines,$self->_dump_hash($el,$indent + 1,$seen)}else {$line .= ' {}';push@lines,$line}}else {die \"CPAN::Meta::YAML does not support $type references"}}@lines}sub _dump_hash {my ($self,$hash,$indent,$seen)=@_;if ($seen->{refaddr($hash)}++){die \"CPAN::Meta::YAML does not support circular references"}my@lines=();for my$name (sort keys %$hash){my$el=$hash->{$name};my$line=('  ' x $indent).$self->_dump_scalar($name,1).":";my$type=ref$el;if (!$type){$line .= ' ' .$self->_dump_scalar($el);push@lines,$line}elsif ($type eq 'ARRAY'){if (@$el){push@lines,$line;push@lines,$self->_dump_array($el,$indent + 1,$seen)}else {$line .= ' []';push@lines,$line}}elsif ($type eq 'HASH'){if (keys %$el){push@lines,$line;push@lines,$self->_dump_hash($el,$indent + 1,$seen)}else {$line .= ' {}';push@lines,$line}}else {die \"CPAN::Meta::YAML does not support $type references"}}@lines}our$errstr='';sub _error {require Carp;$errstr=$_[1];$errstr =~ s/ at \S+ line \d+.*//;Carp::croak($errstr)}my$errstr_warned;sub errstr {require Carp;Carp::carp("CPAN::Meta::YAML->errstr and \$CPAN::Meta::YAML::errstr is deprecated")unless$errstr_warned++;$errstr}use B;my$HAS_FLOCK;sub _can_flock {if (defined$HAS_FLOCK){return$HAS_FLOCK}else {require Config;my$c=\%Config::Config;$HAS_FLOCK=grep {$c->{$_}}qw/d_flock d_fcntl_can_lock d_lockf/;require Fcntl if$HAS_FLOCK;return$HAS_FLOCK}}use Scalar::Util ();BEGIN {local $@;if (eval {Scalar::Util->VERSION(1.18)}){*refaddr=*Scalar::Util::refaddr}else {eval <<'END_PERL'}}delete$CPAN::Meta::YAML::{refaddr};1;
195
+  # Scalar::Util failed to load or too old
196
+  sub refaddr {
197
+      my $pkg = ref($_[0]) or return undef;
198
+      if ( !! UNIVERSAL::can($_[0], 'can') ) {
199
+          bless $_[0], 'Scalar::Util::Fake';
200
+      } else {
201
+          $pkg = undef;
12096 202
       }
12097
-      return $tvalue;
203
+      "$_[0]" =~ /0x(\w+)/;
204
+      my $i = do { no warnings 'portable'; hex $1 };
205
+      bless $_[0], $pkg if defined $pkg;
206
+      $i;
12098 207
   }
12099
-  
12100
-  sub _VERSION {
12101
-      my ($obj, $req) = @_;
12102
-      my $class = ref($obj) || $obj;
12103
-  
12104
-      no strict 'refs';
12105
-      if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
12106
-  	 # file but no package
12107
-  	require Carp;
12108
-  	Carp::croak( "$class defines neither package nor VERSION"
12109
-  	    ."--version check failed");
12110
-      }
12111
-  
12112
-      my $version = eval "\$$class\::VERSION";
12113
-      if ( defined $version ) {
12114
-  	local $^W if $] <= 5.008;
12115
-  	$version = version::vpp->new($version);
208
+  END_PERL
209
+CPAN_META_YAML
210
+
211
+$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
212
+  package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.70';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}sub import {my$pkg=shift;my$callpkg=caller($ExportLevel);if ($pkg eq "Exporter" and @_ and $_[0]eq "import"){*{$callpkg."::import"}=\&import;return}my$exports=\@{"$pkg\::EXPORT"};my$fail=${$pkg .'::'}{EXPORT_FAIL}&& \@{"$pkg\::EXPORT_FAIL"};return export$pkg,$callpkg,@_ if$Verbose or $Debug or $fail && @$fail > 1;my$export_cache=($Cache{$pkg}||= {});my$args=@_ or @_=@$exports;if ($args and not %$export_cache){s/^&//,$export_cache->{$_}=1 foreach (@$exports,@{"$pkg\::EXPORT_OK"})}my$heavy;if ($args or $fail){($heavy=(/\W/ or $args and not exists$export_cache->{$_}or $fail and @$fail and $_ eq $fail->[0]))and last foreach (@_)}else {($heavy=/\W/)and last foreach (@_)}return export$pkg,$callpkg,($args ? @_ : ())if$heavy;local$SIG{__WARN__}=sub {require Carp;&Carp::carp}if not $SIG{__WARN__};*{"$callpkg\::$_"}=\&{"$pkg\::$_"}foreach @_}sub export_fail {my$self=shift;@_}sub export_to_level {goto &{as_heavy()}}sub export_tags {goto &{as_heavy()}}sub export_ok_tags {goto &{as_heavy()}}sub require_version {goto &{as_heavy()}}1;
213
+EXPORTER
214
+
215
+$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
216
+  package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok){s/^&// foreach @$ok;@{$cache}{@$ok}=(1)x @$ok}}sub heavy_export {my$oldwarn=$SIG{__WARN__};local$SIG{__WARN__}=sub {local$SIG{__WARN__}=$oldwarn;my$text=shift;if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//){require Carp;local$Carp::CarpLevel=1;Carp::carp($text)}else {warn$text}};local$SIG{__DIE__}=sub {require Carp;local$Carp::CarpLevel=1;Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")if $_[0]=~ /^Unable to create sub named "(.*?)::"/};my($pkg,$callpkg,@imports)=@_;my($type,$sym,$cache_is_current,$oops);my($exports,$export_cache)=(\@{"${pkg}::EXPORT"},$Exporter::Cache{$pkg}||= {});if (@imports){if (!%$export_cache){_rebuild_cache ($pkg,$exports,$export_cache);$cache_is_current=1}if (grep m{^[/!:]},@imports){my$tagsref=\%{"${pkg}::EXPORT_TAGS"};my$tagdata;my%imports;my($remove,$spec,@names,@allexports);unshift@imports,':DEFAULT' if$imports[0]=~ m/^!/;for$spec (@imports){$remove=$spec =~ s/^!//;if ($spec =~ s/^://){if ($spec eq 'DEFAULT'){@names=@$exports}elsif ($tagdata=$tagsref->{$spec}){@names=@$tagdata}else {warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];++$oops;next}}elsif ($spec =~ m:^/(.*)/$:){my$patn=$1;@allexports=keys %$export_cache unless@allexports;@names=grep(/$patn/,@allexports)}else {@names=($spec)}warn "Import ".($remove ? "del":"add").": @names " if$Exporter::Verbose;if ($remove){for$sym (@names){delete$imports{$sym}}}else {@imports{@names}=(1)x @names}}@imports=keys%imports}my@carp;for$sym (@imports){if (!$export_cache->{$sym}){if ($sym =~ m/^\d/){$pkg->VERSION($sym);if (@imports==1){@imports=@$exports;last}if (@imports==2 and!$imports[1]){@imports=();last}}elsif ($sym !~ s/^&// ||!$export_cache->{$sym}){unless ($cache_is_current){%$export_cache=();_rebuild_cache ($pkg,$exports,$export_cache);$cache_is_current=1}if (!$export_cache->{$sym}){push@carp,qq["$sym" is not exported by the $pkg module\n];$oops++}}}}if ($oops){require Carp;Carp::croak("@{carp}Can't continue after import errors")}}else {@imports=@$exports}my($fail,$fail_cache)=(\@{"${pkg}::EXPORT_FAIL"},$Exporter::FailCache{$pkg}||= {});if (@$fail){if (!%$fail_cache){my@expanded=map {/^\w/ ? ($_,'&'.$_): $_}@$fail;warn "${pkg}::EXPORT_FAIL cached: @expanded" if$Exporter::Verbose;@{$fail_cache}{@expanded}=(1)x @expanded}my@failed;for$sym (@imports){push(@failed,$sym)if$fail_cache->{$sym}}if (@failed){@failed=$pkg->export_fail(@failed);for$sym (@failed){require Carp;Carp::carp(qq["$sym" is not implemented by the $pkg module ],"on this architecture")}if (@failed){require Carp;Carp::croak("Can't continue after import errors")}}}warn "Importing into $callpkg from $pkg: ",join(", ",sort@imports)if$Exporter::Verbose;for$sym (@imports){(*{"${callpkg}::$sym"}=\&{"${pkg}::$sym"},next)unless$sym =~ s/^(\W)//;$type=$1;no warnings 'once';*{"${callpkg}::$sym"}=$type eq '&' ? \&{"${pkg}::$sym"}: $type eq '$' ? \${"${pkg}::$sym"}: $type eq '@' ? \@{"${pkg}::$sym"}: $type eq '%' ? \%{"${pkg}::$sym"}: $type eq '*' ? *{"${pkg}::$sym"}: do {require Carp;Carp::croak("Can't export symbol: $type$sym")}}}sub heavy_export_to_level {my$pkg=shift;my$level=shift;(undef)=shift;my$callpkg=caller($level);$pkg->export($callpkg,@_)}sub _push_tags {my($pkg,$var,$syms)=@_;my@nontag=();my$export_tags=\%{"${pkg}::EXPORT_TAGS"};push(@{"${pkg}::$var"},map {$export_tags->{$_}? @{$export_tags->{$_}}: scalar(push(@nontag,$_),$_)}(@$syms)? @$syms : keys %$export_tags);if (@nontag and $^W){require Carp;Carp::carp(join(", ",@nontag)." are not tags of $pkg")}}sub heavy_require_version {my($self,$wanted)=@_;my$pkg=ref$self || $self;return ${pkg}->VERSION($wanted)}sub heavy_export_tags {_push_tags((caller)[0],"EXPORT",\@_)}sub heavy_export_ok_tags {_push_tags((caller)[0],"EXPORT_OK",\@_)}1;
217
+EXPORTER_HEAVY
218
+
219
+$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
220
+  use strict;use warnings;package File::pushd;our$VERSION='1.009';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;sub pushd {my ($target_dir,$options)=@_;$options->{untaint_pattern}||= qr{^([-+@\w./]+)$};$target_dir="." unless defined$target_dir;croak "Can't locate directory $target_dir" unless -d $target_dir;my$tainted_orig=getcwd;my$orig;if ($tainted_orig =~ $options->{untaint_pattern}){$orig=$1}else {$orig=$tainted_orig}my$tainted_dest;eval {$tainted_dest=$target_dir ? abs_path($target_dir): $orig};croak "Can't locate absolute path for $target_dir: $@" if $@;my$dest;if ($tainted_dest =~ $options->{untaint_pattern}){$dest=$1}else {$dest=$tainted_dest}if ($dest ne $orig){chdir$dest or croak "Can't chdir to $dest\: $!"}my$self=bless {_pushd=>$dest,_original=>$orig },__PACKAGE__;return$self}sub tempd {my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;return$dir}sub preserve {my$self=shift;return 1 if!$self->{"_tempd"};if (@_==0){return$self->{_preserve}=1}else {return$self->{_preserve}=$_[0]? 1 : 0}}sub DESTROY {my ($self)=@_;my$orig=$self->{_original};chdir$orig if$orig;if ($self->{_tempd}&&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1;
221
+FILE_PUSHD
222
+
223
+$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
224
+  package HTTP::Tiny;use strict;use warnings;our$VERSION='0.056';use Carp ();my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);my%persist_ok=map {;$_=>1}qw(cookie_jar default_headers max_redirect max_size);no strict 'refs';no warnings 'uninitialized';for my$accessor (@attributes){*{$accessor}=sub {@_ > 1 ? do {delete $_[0]->{handle}if!$persist_ok{$accessor}&& $_[1]ne $_[0]->{$accessor};$_[0]->{$accessor}=$_[1]}: $_[0]->{$accessor}}}}sub agent {my($self,$agent)=@_;if(@_ > 1){$self->{agent}=(defined$agent && $agent =~ / $/)? $agent .$self->_agent : $agent}return$self->{agent}}sub new {my($class,%args)=@_;my$self={max_redirect=>5,timeout=>60,keep_alive=>1,verify_SSL=>$args{verify_SSL}|| $args{verify_ssl}|| 0,no_proxy=>$ENV{no_proxy},};bless$self,$class;$class->_validate_cookie_jar($args{cookie_jar})if$args{cookie_jar};for my$key (@attributes){$self->{$key}=$args{$key}if exists$args{$key}}$self->agent(exists$args{agent}? $args{agent}: $class->_agent);$self->_set_proxies;return$self}sub _set_proxies {my ($self)=@_;if (!exists$self->{proxy}){$self->{proxy}=$ENV{all_proxy}|| $ENV{ALL_PROXY}}if (defined$self->{proxy}){$self->_split_proxy('generic proxy'=>$self->{proxy})}else {delete$self->{proxy}}if (!exists$self->{http_proxy}){local$ENV{HTTP_PROXY}if$ENV{REQUEST_METHOD};$self->{http_proxy}=$ENV{http_proxy}|| $ENV{HTTP_PROXY}|| $self->{proxy}}if (defined$self->{http_proxy}){$self->_split_proxy(http_proxy=>$self->{http_proxy});$self->{_has_proxy}{http}=1}else {delete$self->{http_proxy}}if (!exists$self->{https_proxy}){$self->{https_proxy}=$ENV{https_proxy}|| $ENV{HTTPS_PROXY}|| $self->{proxy}}if ($self->{https_proxy}){$self->_split_proxy(https_proxy=>$self->{https_proxy});$self->{_has_proxy}{https}=1}else {delete$self->{https_proxy}}unless (ref$self->{no_proxy}eq 'ARRAY'){$self->{no_proxy}=(defined$self->{no_proxy})? [split /\s*,\s*/,$self->{no_proxy}]: []}return}for my$sub_name (qw/get head put post delete/){my$req_method=uc$sub_name;no strict 'refs';eval <<"HERE"}sub post_form {my ($self,$url,$data,$args)=@_;(@_==3 || @_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ ."\n");my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}delete$args->{headers};return$self->request('POST',$url,{%$args,content=>$self->www_form_urlencode($data),headers=>{%$headers,'content-type'=>'application/x-www-form-urlencoded' },})}sub mirror {my ($self,$url,$file,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ ."\n");if (-e $file and my$mtime=(stat($file))[9]){$args->{headers}{'if-modified-since'}||= $self->_http_date($mtime)}my$tempfile=$file .int(rand(2**31));require Fcntl;sysopen my$fh,$tempfile,Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);binmode$fh;$args->{data_callback}=sub {print {$fh}$_[0]};my$response=$self->request('GET',$url,$args);close$fh or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($response->{success}){rename$tempfile,$file or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);my$lm=$response->{headers}{'last-modified'};if ($lm and my$mtime=$self->_parse_http_date($lm)){utime$mtime,$mtime,$file}}$response->{success}||= $response->{status}eq '304';unlink$tempfile;return$response}my%idempotent=map {$_=>1}qw/GET HEAD PUT DELETE OPTIONS TRACE/;sub request {my ($self,$method,$url,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ ."\n");$args ||= {};my$response;for (0 .. 1){$response=eval {$self->_request($method,$url,$args)};last unless $@ && $idempotent{$method}&& $@ =~ m{^(?:Socket closed|Unexpected end)}}if (my$e=$@){if (ref$e eq 'HASH' && exists$e->{status}){return$e}$e="$e";$response={url=>$url,success=>q{},status=>599,reason=>'Internal Exception',content=>$e,headers=>{'content-type'=>'text/plain','content-length'=>length$e,}}}return$response}sub www_form_urlencode {my ($self,$data)=@_;(@_==2 && ref$data)or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ ."\n");(ref$data eq 'HASH' || ref$data eq 'ARRAY')or Carp::croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or Carp::croak("form data reference must have an even number of terms\n");my@terms;while(@params){my ($key,$value)=splice(@params,0,2);if (ref$value eq 'ARRAY'){unshift@params,map {$key=>$_}@$value}else {push@terms,join("=",map {$self->_uri_escape($_)}$key,$value)}}return join("&",(ref$data eq 'ARRAY')? (@terms): (sort@terms))}sub can_ssl {my ($self)=@_;my($ok,$reason)=(1,'');unless (eval {require IO::Socket::SSL;IO::Socket::SSL->VERSION(1.42)}){$ok=0;$reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/}unless (eval {require Net::SSLeay;Net::SSLeay->VERSION(1.49)}){$ok=0;$reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/}if (ref($self)&& ($self->{verify_SSL}|| $self->{SSL_options}{SSL_verify_mode})){my$handle=HTTP::Tiny::Handle->new(SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},);unless (eval {$handle->_find_CA_file;1}){$ok=0;$reason .= "$@"}}wantarray ? ($ok,$reason): $ok}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;return$default_agent ."/" .$class->VERSION}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);my$request={method=>$method,scheme=>$scheme,host=>$host,port=>$port,host_port=>($port==$DefaultPort{$scheme}? $host : "$host:$port"),uri=>$path_query,headers=>{},};my$handle=delete$self->{handle};if ($handle){unless ($handle->can_reuse($scheme,$host,$port)){$handle->close;undef$handle}}$handle ||= $self->_open_handle($request,$scheme,$host,$port);$self->_prepare_headers_and_cb($request,$args,$url,$auth);$handle->write_request($request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');$self->_update_cookie_jar($url,$response)if$self->{cookie_jar};if (my@redir_args=$self->_maybe_redirect($request,$response,$args)){$handle->close;return$self->_request(@redir_args,$args)}my$known_message_length;if ($method eq 'HEAD' || $response->{status}=~ /^[23]04/){$known_message_length=1}else {my$data_cb=$self->_prepare_data_cb($response,$args);$known_message_length=$handle->read_body($data_cb,$response)}if ($self->{keep_alive}&& $known_message_length && $response->{protocol}eq 'HTTP/1.1' && ($response->{headers}{connection}|| '')ne 'close'){$self->{handle}=$handle}else {$handle->close}$response->{success}=substr($response->{status},0,1)eq '2';$response->{url}=$url;return$response}sub _open_handle {my ($self,$request,$scheme,$host,$port)=@_;my$handle=HTTP::Tiny::Handle->new(timeout=>$self->{timeout},SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},local_address=>$self->{local_address},keep_alive=>$self->{keep_alive});if ($self->{_has_proxy}{$scheme}&&!grep {$host =~ /\Q$_\E$/}@{$self->{no_proxy}}){return$self->_proxy_connect($request,$handle)}else {return$handle->connect($scheme,$host,$port)}}sub _proxy_connect {my ($self,$request,$handle)=@_;my@proxy_vars;if ($request->{scheme}eq 'https'){Carp::croak(qq{No https_proxy defined})unless$self->{https_proxy};@proxy_vars=$self->_split_proxy(https_proxy=>$self->{https_proxy});if ($proxy_vars[0]eq 'https'){Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}})}}else {Carp::croak(qq{No http_proxy defined})unless$self->{http_proxy};@proxy_vars=$self->_split_proxy(http_proxy=>$self->{http_proxy})}my ($p_scheme,$p_host,$p_port,$p_auth)=@proxy_vars;if (length$p_auth &&!defined$request->{headers}{'proxy-authorization'}){$self->_add_basic_auth_header($request,'proxy-authorization'=>$p_auth)}$handle->connect($p_scheme,$p_host,$p_port);if ($request->{scheme}eq 'https'){$self->_create_proxy_tunnel($request,$handle)}else {$request->{uri}="$request->{scheme}://$request->{host_port}$request->{uri}"}return$handle}sub _split_proxy {my ($self,$type,$proxy)=@_;my ($scheme,$host,$port,$path_query,$auth)=eval {$self->_split_url($proxy)};unless(defined($scheme)&& length($scheme)&& length($host)&& length($port)&& $path_query eq '/'){Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n})}return ($scheme,$host,$port,$auth)}sub _create_proxy_tunnel {my ($self,$request,$handle)=@_;$handle->_assert_ssl;my$agent=exists($request->{headers}{'user-agent'})? $request->{headers}{'user-agent'}: $self->{agent};my$connect_request={method=>'CONNECT',uri=>"$request->{host}:$request->{port}",headers=>{host=>"$request->{host}:$request->{port}",'user-agent'=>$agent,}};if ($request->{headers}{'proxy-authorization'}){$connect_request->{headers}{'proxy-authorization'}=delete$request->{headers}{'proxy-authorization'}}$handle->write_request($connect_request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');unless (substr($response->{status},0,1)eq '2'){die$response}$handle->start_ssl($request->{host});return}sub _prepare_headers_and_cb {my ($self,$request,$args,$url,$auth)=@_;for ($self->{default_headers},$args->{headers}){next unless defined;while (my ($k,$v)=each %$_){$request->{headers}{lc$k}=$v}}if (exists$request->{headers}{'host'}){die(qq/The 'Host' header must not be provided as header option\n/)}$request->{headers}{'host'}=$request->{host_port};$request->{headers}{'user-agent'}||= $self->{agent};$request->{headers}{'connection'}="close" unless$self->{keep_alive};if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=$args->{content}}elsif (length$args->{content}){my$content=$args->{content};if ($] ge '5.008'){utf8::downgrade($content,1)or die(qq/Wide character in request message body\n/)}$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'content-length'}=length$content unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=sub {substr$content,0,length$content,''}}$request->{trailer_cb}=$args->{trailer_callback}if ref$args->{trailer_callback}eq 'CODE'}if ($self->{cookie_jar}){my$cookies=$self->cookie_jar->cookie_header($url);$request->{headers}{cookie}=$cookies if length$cookies}if (length$auth &&!defined$request->{headers}{authorization}){$self->_add_basic_auth_header($request,'authorization'=>$auth)}return}sub _add_basic_auth_header {my ($self,$request,$header,$auth)=@_;require MIME::Base64;$request->{headers}{$header}="Basic " .MIME::Base64::encode_base64($auth,"");return}sub _prepare_data_cb {my ($self,$response,$args)=@_;my$data_cb=$args->{data_callback};$response->{content}='';if (!$data_cb || $response->{status}!~ /^2/){if (defined$self->{max_size}){$data_cb=sub {$_[1]->{content}.= $_[0];die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)if length $_[1]->{content}> $self->{max_size}}}else {$data_cb=sub {$_[1]->{content}.= $_[0]}}}return$data_cb}sub _update_cookie_jar {my ($self,$url,$response)=@_;my$cookies=$response->{headers}->{'set-cookie'};return unless defined$cookies;my@cookies=ref$cookies ? @$cookies : $cookies;$self->cookie_jar->add($url,$_)for@cookies;return}sub _validate_cookie_jar {my ($class,$jar)=@_;for my$method (qw/add cookie_header/){Carp::croak(qq/Cookie jar must provide the '$method' method\n/)unless ref($jar)&& ref($jar)->can($method)}return}sub _maybe_redirect {my ($self,$request,$response,$args)=@_;my$headers=$response->{headers};my ($status,$method)=($response->{status},$request->{method});if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))and $headers->{location}and ++$args->{redirects}<= $self->{max_redirect}){my$location=($headers->{location}=~ /^\//)? "$request->{scheme}://$request->{host_port}$headers->{location}" : $headers->{location};return (($status eq '303' ? 'GET' : $method),$location)}return}sub _split_url {my$url=pop;my ($scheme,$host,$path_query)=$url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/);$scheme=lc$scheme;$path_query="/$path_query" unless$path_query =~ m<\A/>;my$auth='';if ((my$i=index$host,'@')!=-1){$auth=substr$host,0,$i,'';substr$host,0,1,'';$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}my$port=$host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef;return ($scheme,(length$host ? lc$host : "localhost"),$port,$path_query,$auth)}my$DoW="Sun|Mon|Tue|Wed|Thu|Fri|Sat";my$MoY="Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";sub _http_date {my ($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($_[1]);return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",substr($DoW,$wday*4,3),$mday,substr($MoY,$mon*4,3),$year+1900,$hour,$min,$sec)}sub _parse_http_date {my ($self,$str)=@_;require Time::Local;my@tl_parts;if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/){@tl_parts=($5,$4,$3,$2,(index($MoY,$1)/4),$6)}return eval {my$t=@tl_parts ? Time::Local::timegm(@tl_parts): -1;$t < 0 ? undef : $t}}my%escapes=map {chr($_)=>sprintf("%%%02X",$_)}0..255;$escapes{' '}="+";my$unsafe_char=qr/[^A-Za-z0-9\-\._~]/;sub _uri_escape {my ($self,$str)=@_;if ($] ge '5.008'){utf8::encode($str)}else {$str=pack("U*",unpack("C*",$str))if (length$str==do {use bytes;length$str});$str=pack("C*",unpack("C*",$str))}$str =~ s/($unsafe_char)/$escapes{$1}/ge;return$str}package HTTP::Tiny::Handle;use strict;use warnings;use Errno qw[EINTR EPIPE];use IO::Socket qw[SOCK_STREAM];my$SOCKET_CLASS=$ENV{PERL_HTTP_TINY_IPV4_ONLY}? 'IO::Socket::INET' : eval {require IO::Socket::IP;IO::Socket::IP->VERSION(0.25)}? 'IO::Socket::IP' : 'IO::Socket::INET';sub BUFSIZE () {32768}my$Printable=sub {local $_=shift;s/\r/\\r/g;s/\n/\\n/g;s/\t/\\t/g;s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;$_};my$Token=qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;sub new {my ($class,%args)=@_;return bless {rbuf=>'',timeout=>60,max_line_size=>16384,max_header_lines=>64,verify_SSL=>0,SSL_options=>{},%args },$class}sub connect {@_==4 || die(q/Usage: $handle->connect(scheme, host, port)/ ."\n");my ($self,$scheme,$host,$port)=@_;if ($scheme eq 'https'){$self->_assert_ssl}elsif ($scheme ne 'http'){die(qq/Unsupported URL scheme '$scheme'\n/)}$self->{fh}=$SOCKET_CLASS->new(PeerHost=>$host,PeerPort=>$port,$self->{local_address}? (LocalAddr=>$self->{local_address}): (),Proto=>'tcp',Type=>SOCK_STREAM,Timeout=>$self->{timeout},KeepAlive=>!!$self->{keep_alive})or die(qq/Could not connect to '$host:$port': $@\n/);binmode($self->{fh})or die(qq/Could not binmode() socket: '$!'\n/);$self->start_ssl($host)if$scheme eq 'https';$self->{scheme}=$scheme;$self->{host}=$host;$self->{port}=$port;$self->{pid}=$$;$self->{tid}=_get_tid();return$self}sub start_ssl {my ($self,$host)=@_;if (ref($self->{fh})eq 'IO::Socket::SSL'){unless ($self->{fh}->stop_SSL){my$ssl_err=IO::Socket::SSL->errstr;die(qq/Error halting prior SSL connection: $ssl_err/)}}my$ssl_args=$self->_ssl_args($host);IO::Socket::SSL->start_SSL($self->{fh},%$ssl_args,SSL_create_ctx_callback=>sub {my$ctx=shift;Net::SSLeay::CTX_set_mode($ctx,Net::SSLeay::MODE_AUTO_RETRY())},);unless (ref($self->{fh})eq 'IO::Socket::SSL'){my$ssl_err=IO::Socket::SSL->errstr;die(qq/SSL connection failed for $host: $ssl_err\n/)}}sub close {@_==1 || die(q/Usage: $handle->close()/ ."\n");my ($self)=@_;CORE::close($self->{fh})or die(qq/Could not close socket: '$!'\n/)}sub write {@_==2 || die(q/Usage: $handle->write(buf)/ ."\n");my ($self,$buf)=@_;if ($] ge '5.008'){utf8::downgrade($buf,1)or die(qq/Wide character in write()\n/)}my$len=length$buf;my$off=0;local$SIG{PIPE}='IGNORE';while (){$self->can_write or die(qq/Timed out while waiting for socket to become ready for writing\n/);my$r=syswrite($self->{fh},$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len > 0}elsif ($!==EPIPE){die(qq/Socket closed by remote server: $!\n/)}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not write to SSL socket: '$err'\n /)}else {die(qq/Could not write to socket: '$!'\n/)}}}return$off}sub read {@_==2 || @_==3 || die(q/Usage: $handle->read(len [, allow_partial])/ ."\n");my ($self,$len,$allow_partial)=@_;my$buf='';my$got=length$self->{rbuf};if ($got){my$take=($got < $len)? $got : $len;$buf=substr($self->{rbuf},0,$take,'');$len -= $take}while ($len > 0){$self->can_read or die(q/Timed out while waiting for socket to become ready for reading/ ."\n");my$r=sysread($self->{fh},$buf,$len,length$buf);if (defined$r){last unless$r;$len -= $r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}if ($len &&!$allow_partial){die(qq/Unexpected end of stream\n/)}return$buf}sub readline {@_==1 || die(q/Usage: $handle->readline()/ ."\n");my ($self)=@_;while (){if ($self->{rbuf}=~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x){return $1}if (length$self->{rbuf}>= $self->{max_line_size}){die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/)}$self->can_read or die(qq/Timed out while waiting for socket to become ready for reading\n/);my$r=sysread($self->{fh},$self->{rbuf},BUFSIZE,length$self->{rbuf});if (defined$r){last unless$r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}die(qq/Unexpected end of stream while looking for line\n/)}sub read_header_lines {@_==1 || @_==2 || die(q/Usage: $handle->read_header_lines([headers])/ ."\n");my ($self,$headers)=@_;$headers ||= {};my$lines=0;my$val;while (){my$line=$self->readline;if (++$lines >= $self->{max_header_lines}){die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/)}elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x){my ($field_name)=lc $1;if (exists$headers->{$field_name}){for ($headers->{$field_name}){$_=[$_]unless ref $_ eq "ARRAY";push @$_,$2;$val=\$_->[-1]}}else {$val=\($headers->{$field_name}=$2)}}elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x){$val or die(qq/Unexpected header continuation line\n/);next unless length $1;$$val .= ' ' if length $$val;$$val .= $1}elsif ($line =~ /\A \x0D?\x0A \z/x){last}else {die(q/Malformed header line: / .$Printable->($line)."\n")}}return$headers}sub write_request {@_==2 || die(q/Usage: $handle->write_request(request)/ ."\n");my($self,$request)=@_;$self->write_request_header(@{$request}{qw/method uri headers/});$self->write_body($request)if$request->{cb};return}my%HeaderCase=('content-md5'=>'Content-MD5','etag'=>'ETag','te'=>'TE','www-authenticate'=>'WWW-Authenticate','x-xss-protection'=>'X-XSS-Protection',);sub write_header_lines {(@_==2 || @_==3 && ref $_[1]eq 'HASH')|| die(q/Usage: $handle->write_header_lines(headers[,prefix])/ ."\n");my($self,$headers,$prefix_data)=@_;my$buf=(defined$prefix_data ? $prefix_data : '');while (my ($k,$v)=each %$headers){my$field_name=lc$k;if (exists$HeaderCase{$field_name}){$field_name=$HeaderCase{$field_name}}else {$field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / .$Printable->($field_name)."\n");$field_name =~ s/\b(\w)/\u$1/g;$HeaderCase{lc$field_name}=$field_name}for (ref$v eq 'ARRAY' ? @$v : $v){$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}$buf .= "\x0D\x0A";return$self->write($buf)}sub read_body {@_==3 || die(q/Usage: $handle->read_body(callback, response)/ ."\n");my ($self,$cb,$response)=@_;my$te=$response->{headers}{'transfer-encoding'}|| '';my$chunked=grep {/chunked/i}(ref$te eq 'ARRAY' ? @$te : $te);return$chunked ? $self->read_chunked_body($cb,$response): $self->read_content_body($cb,$response)}sub write_body {@_==2 || die(q/Usage: $handle->write_body(request)/ ."\n");my ($self,$request)=@_;if ($request->{headers}{'content-length'}){return$self->write_content_body($request)}else {return$self->write_chunked_body($request)}}sub read_content_body {@_==3 || @_==4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ ."\n");my ($self,$cb,$response,$content_length)=@_;$content_length ||= $response->{headers}{'content-length'};if (defined$content_length){my$len=$content_length;while ($len > 0){my$read=($len > BUFSIZE)? BUFSIZE : $len;$cb->($self->read($read,0),$response);$len -= $read}return length($self->{rbuf})==0}my$chunk;$cb->($chunk,$response)while length($chunk=$self->read(BUFSIZE,1));return}sub write_content_body {@_==2 || die(q/Usage: $handle->write_content_body(request)/ ."\n");my ($self,$request)=@_;my ($len,$content_length)=(0,$request->{headers}{'content-length'});while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_content()\n/)}$len += $self->write($data)}$len==$content_length or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);return$len}sub read_chunked_body {@_==3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ ."\n");my ($self,$cb,$response)=@_;while (){my$head=$self->readline;$head =~ /\A ([A-Fa-f0-9]+)/x or die(q/Malformed chunk head: / .$Printable->($head)."\n");my$len=hex($1)or last;$self->read_content_body($cb,$response,$len);$self->read(2)eq "\x0D\x0A" or die(qq/Malformed chunk: missing CRLF after chunk data\n/)}$self->read_header_lines($response->{headers});return 1}sub write_chunked_body {@_==2 || die(q/Usage: $handle->write_chunked_body(request)/ ."\n");my ($self,$request)=@_;my$len=0;while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_chunked_body()\n/)}$len += length$data;my$chunk=sprintf '%X',length$data;$chunk .= "\x0D\x0A";$chunk .= $data;$chunk .= "\x0D\x0A";$self->write($chunk)}$self->write("0\x0D\x0A");$self->write_header_lines($request->{trailer_cb}->())if ref$request->{trailer_cb}eq 'CODE';return$len}sub read_response_header {@_==1 || die(q/Usage: $handle->read_response_header()/ ."\n");my ($self)=@_;my$line=$self->readline;$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x or die(q/Malformed Status-Line: / .$Printable->($line)."\n");my ($protocol,$version,$status,$reason)=($1,$2,$3,$4);die (qq/Unsupported HTTP protocol: $protocol\n/)unless$version =~ /0*1\.0*[01]/;return {status=>$status,reason=>$reason,headers=>$self->read_header_lines,protocol=>$protocol,}}sub write_request_header {@_==4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ ."\n");my ($self,$method,$request_uri,$headers)=@_;return$self->write_header_lines($headers,"$method $request_uri HTTP/1.1\x0D\x0A")}sub _do_timeout {my ($self,$type,$timeout)=@_;$timeout=$self->{timeout}unless defined$timeout && $timeout >= 0;my$fd=fileno$self->{fh};defined$fd && $fd >= 0 or die(qq/select(2): 'Bad file descriptor'\n/);my$initial=time;my$pending=$timeout;my$nfound;vec(my$fdset='',$fd,1)=1;while (){$nfound=($type eq 'read')? select($fdset,undef,undef,$pending): select(undef,$fdset,undef,$pending);if ($nfound==-1){$!==EINTR or die(qq/select(2): '$!'\n/);redo if!$timeout || ($pending=$timeout - (time - $initial))> 0;$nfound=0}last}$!=0;return$nfound}sub can_read {@_==1 || @_==2 || die(q/Usage: $handle->can_read([timeout])/ ."\n");my$self=shift;if (ref($self->{fh})eq 'IO::Socket::SSL'){return 1 if$self->{fh}->pending}return$self->_do_timeout('read',@_)}sub can_write {@_==1 || @_==2 || die(q/Usage: $handle->can_write([timeout])/ ."\n");my$self=shift;return$self->_do_timeout('write',@_)}sub _assert_ssl {my($ok,$reason)=HTTP::Tiny->can_ssl();die$reason unless$ok}sub can_reuse {my ($self,$scheme,$host,$port)=@_;return 0 if $self->{pid}!=$$ || $self->{tid}!=_get_tid()|| length($self->{rbuf})|| $scheme ne $self->{scheme}|| $host ne $self->{host}|| $port ne $self->{port}|| eval {$self->can_read(0)}|| $@ ;return 1}sub _find_CA_file {my$self=shift();if ($self->{SSL_options}->{SSL_ca_file}){unless (-r $self->{SSL_options}->{SSL_ca_file}){die qq/SSL_ca_file '$self->{SSL_options}->{SSL_ca_file}' not found or not readable\n/}return$self->{SSL_options}->{SSL_ca_file}}return Mozilla::CA::SSL_ca_file()if eval {require Mozilla::CA;1};for my$ca_bundle ("/etc/ssl/certs/ca-certificates.crt","/etc/pki/tls/certs/ca-bundle.crt","/etc/ssl/ca-bundle.pem","/etc/openssl/certs/ca-certificates.crt","/etc/ssl/cert.pem","/usr/local/share/certs/ca-root-nss.crt","/etc/pki/tls/cacert.pem","/etc/certs/ca-certificates.crt",){return$ca_bundle if -e $ca_bundle}die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/ .qq/Try installing Mozilla::CA from CPAN\n/}sub _get_tid {no warnings 'reserved';return threads->can("tid")? threads->tid : 0}sub _ssl_args {my ($self,$host)=@_;my%ssl_args;if (Net::SSLeay::OPENSSL_VERSION_NUMBER()>= 0x01000000){$ssl_args{SSL_hostname}=$host,}if ($self->{verify_SSL}){$ssl_args{SSL_verifycn_scheme}='http';$ssl_args{SSL_verifycn_name}=$host;$ssl_args{SSL_verify_mode}=0x01;$ssl_args{SSL_ca_file}=$self->_find_CA_file}else {$ssl_args{SSL_verifycn_scheme}='none';$ssl_args{SSL_verify_mode}=0x00}for my$k (keys %{$self->{SSL_options}}){$ssl_args{$k}=$self->{SSL_options}{$k}if$k =~ m/^SSL_/}return \%ssl_args}1;
225
+      sub $sub_name {
226
+          my (\$self, \$url, \$args) = \@_;
227
+          \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
228
+          or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
229
+          return \$self->request('$req_method', \$url, \$args || {});
12116 230
       }
231
+  HERE
232
+HTTP_TINY
233
+
234
+$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
235
+  package JSON::PP;use 5.005;use strict;use base qw(Exporter);use overload ();use Carp ();use B ();$JSON::PP::VERSION='2.27300';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);use constant P_ASCII=>0;use constant P_LATIN1=>1;use constant P_UTF8=>2;use constant P_INDENT=>3;use constant P_CANONICAL=>4;use constant P_SPACE_BEFORE=>5;use constant P_SPACE_AFTER=>6;use constant P_ALLOW_NONREF=>7;use constant P_SHRINK=>8;use constant P_ALLOW_BLESSED=>9;use constant P_CONVERT_BLESSED=>10;use constant P_RELAXED=>11;use constant P_LOOSE=>12;use constant P_ALLOW_BIGNUM=>13;use constant P_ALLOW_BAREKEY=>14;use constant P_ALLOW_SINGLEQUOTE=>15;use constant P_ESCAPE_SLASH=>16;use constant P_AS_NONBLESSED=>17;use constant P_ALLOW_UNKNOWN=>18;use constant OLD_PERL=>$] < 5.008 ? 1 : 0;BEGIN {my@xs_compati_bit_properties=qw(latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink allow_blessed convert_blessed relaxed allow_unknown);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);if ($] < 5.008){my$helper=$] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';eval qq| require $helper |;if ($@){Carp::croak $@}}for my$name (@xs_compati_bit_properties,@pp_bit_properties){my$flag_name='P_' .uc($name);eval qq/
236
+              sub $name {
237
+                  my \$enable = defined \$_[1] ? \$_[1] : 1;
12117 238
   
12118
-      if ( defined $req ) {
12119
-  	unless ( defined $version ) {
12120
-  	    require Carp;
12121
-  	    my $msg =  $] < 5.006
12122
-  	    ? "$class version $req required--this is only version "
12123
-  	    : "$class does not define \$$class\::VERSION"
12124
-  	      ."--version check failed";
12125
-  
12126
-  	    if ( $ENV{VERSION_DEBUG} ) {
12127
-  		Carp::confess($msg);
12128
-  	    }
12129
-  	    else {
12130
-  		Carp::croak($msg);
12131
-  	    }
12132
-  	}
239
+                  if (\$enable) {
240
+                      \$_[0]->{PROPS}->[$flag_name] = 1;
241
+                  }
242
+                  else {
243
+                      \$_[0]->{PROPS}->[$flag_name] = 0;
244
+                  }
12133 245
   
12134
-  	$req = version::vpp->new($req);
246
+                  \$_[0];
247
+              }
12135 248
   
12136
-  	if ( $req > $version ) {
12137
-  	    require Carp;
12138
-  	    if ( $req->is_qv ) {
12139
-  		Carp::croak(
12140
-  		    sprintf ("%s version %s required--".
12141
-  			"this is only version %s", $class,
12142
-  			$req->normal, $version->normal)
12143
-  		);
12144
-  	    }
12145
-  	    else {
12146
-  		Carp::croak(
12147
-  		    sprintf ("%s version %s required--".
12148
-  			"this is only version %s", $class,
12149
-  			$req->stringify, $version->stringify)
12150
-  		);
12151
-  	    }
12152
-  	}
12153
-      }
249
+              sub get_$name {
250
+                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
251
+              }
252
+          /}}my%encode_allow_method =map {($_=>1)}qw/utf8 pretty allow_nonref latin1 self_encode escape_slash allow_blessed convert_blessed indent indent_length allow_bignum as_nonblessed/;my%decode_allow_method =map {($_=>1)}qw/utf8 allow_nonref loose allow_singlequote allow_bignum allow_barekey max_size relaxed/;my$JSON;sub encode_json ($) {($JSON ||= __PACKAGE__->new->utf8)->encode(@_)}sub decode_json {($JSON ||= __PACKAGE__->new->utf8)->decode(@_)}sub to_json($) {Carp::croak ("JSON::PP::to_json has been renamed to encode_json.")}sub from_json($) {Carp::croak ("JSON::PP::from_json has been renamed to decode_json.")}sub new {my$class=shift;my$self={max_depth=>512,max_size=>0,indent=>0,FLAGS=>0,fallback=>sub {encode_error('Invalid value. JSON can only reference.')},indent_length=>3,};bless$self,$class}sub encode {return $_[0]->PP_encode_json($_[1])}sub decode {return $_[0]->PP_decode_json($_[1],0x00000000)}sub decode_prefix {return $_[0]->PP_decode_json($_[1],0x00000001)}sub pretty {my ($self,$v)=@_;my$enable=defined$v ? $v : 1;if ($enable){$self->indent(1)->indent_length(3)->space_before(1)->space_after(1)}else {$self->indent(0)->space_before(0)->space_after(0)}$self}sub max_depth {my$max=defined $_[1]? $_[1]: 0x80000000;$_[0]->{max_depth}=$max;$_[0]}sub get_max_depth {$_[0]->{max_depth}}sub max_size {my$max=defined $_[1]? $_[1]: 0;$_[0]->{max_size}=$max;$_[0]}sub get_max_size {$_[0]->{max_size}}sub filter_json_object {$_[0]->{cb_object}=defined $_[1]? $_[1]: 0;$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_ > 1){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub indent_length {if (!defined $_[1]or $_[1]> 15 or $_[1]< 0){Carp::carp "The acceptable range of indent_length() is 0 to 15."}else {$_[0]->{indent_length}=$_[1]}$_[0]}sub get_indent_length {$_[0]->{indent_length}}sub sort_by {$_[0]->{sort_by}=defined $_[1]? $_[1]: 1;$_[0]}sub allow_bigint {Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.")}{my$max_depth;my$indent;my$ascii;my$latin1;my$utf8;my$space_before;my$space_after;my$canonical;my$allow_blessed;my$convert_blessed;my$indent_length;my$escape_slash;my$bignum;my$as_nonblessed;my$depth;my$indent_count;my$keysort;sub PP_encode_json {my$self=shift;my$obj=shift;$indent_count=0;$depth=0;my$idx=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed)=@{$idx}[P_ASCII .. P_SPACE_AFTER,P_ALLOW_BLESSED,P_CONVERT_BLESSED,P_ESCAPE_SLASH,P_ALLOW_BIGNUM,P_AS_NONBLESSED];($max_depth,$indent_length)=@{$self}{qw/max_depth indent_length/};$keysort=$canonical ? sub {$a cmp $b}: undef;if ($self->{sort_by}){$keysort=ref($self->{sort_by})eq 'CODE' ? $self->{sort_by}: $self->{sort_by}=~ /\D+/ ? $self->{sort_by}: sub {$a cmp $b}}encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")if(!ref$obj and!$idx->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);unless ($ascii or $latin1 or $utf8){utf8::upgrade($str)}if ($idx->[P_SHRINK ]){utf8::downgrade($str,1)}return$str}sub object_to_json {my ($self,$obj)=@_;my$type=ref($obj);if($type eq 'HASH'){return$self->hash_to_json($obj)}elsif($type eq 'ARRAY'){return$self->array_to_json($obj)}elsif ($type){if (blessed($obj)){return$self->value_to_json($obj)if ($obj->isa('JSON::PP::Boolean'));if ($convert_blessed and $obj->can('TO_JSON')){my$result=$obj->TO_JSON();if (defined$result and ref($result)){if (refaddr($obj)eq refaddr($result)){encode_error(sprintf("%s::TO_JSON method returned same object as was passed instead of a new one",ref$obj))}}return$self->object_to_json($result)}return "$obj" if ($bignum and _is_bignum($obj));return$self->blessed_to_json($obj)if ($allow_blessed and $as_nonblessed);encode_error(sprintf("encountered object '%s', but neither allow_blessed " ."nor convert_blessed settings are enabled",$obj))unless ($allow_blessed);return 'null'}else {return$self->value_to_json($obj)}}else{return$self->value_to_json($obj)}}sub hash_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');my$del=($space_before ? ' ' : '').':' .($space_after ? ' ' : '');for my$k (_sort($obj)){if (OLD_PERL){utf8::decode($k)}push@res,string_to_json($self,$k).$del .($self->object_to_json($obj->{$k})|| $self->value_to_json($obj->{$k}))}--$depth;$self->_down_indent()if ($indent);return '{' .(@res ? $pre : '').(@res ? join(",$pre",@res).$post : '').'}'}sub array_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');for my$v (@$obj){push@res,$self->object_to_json($v)|| $self->value_to_json($v)}--$depth;$self->_down_indent()if ($indent);return '[' .(@res ? $pre : '').(@res ? join(",$pre",@res).$post : '').']'}sub value_to_json {my ($self,$value)=@_;return 'null' if(!defined$value);my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return$value if$flags & (B::SVp_IOK | B::SVp_NOK)and!($flags & B::SVp_POK);my$type=ref($value);if(!$type){return string_to_json($self,$value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}elsif ($type){if ((overload::StrVal($value)=~ /=(\w+)/)[0]){return$self->value_to_json("$value")}if ($type eq 'SCALAR' and defined $$value){return $$value eq '1' ? 'true' : $$value eq '0' ? 'false' : $self->{PROPS}->[P_ALLOW_UNKNOWN ]? 'null' : encode_error("cannot encode reference to scalar")}if ($self->{PROPS}->[P_ALLOW_UNKNOWN ]){return 'null'}else {if ($type eq 'SCALAR' or $type eq 'REF'){encode_error("cannot encode reference to scalar")}else {encode_error("encountered $value, but JSON can only represent references to arrays or hashes")}}}else {return$self->{fallback}->($value)if ($self->{fallback}and ref($self->{fallback})eq 'CODE');return 'null'}}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($self,$arg)=@_;$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/\//\\\//g if ($escape_slash);$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;if ($ascii){$arg=JSON_PP_encode_ascii($arg)}if ($latin1){$arg=JSON_PP_encode_latin1($arg)}if ($utf8){utf8::encode($arg)}return '"' .$arg .'"'}sub blessed_to_json {my$reftype=reftype($_[1])|| '';if ($reftype eq 'HASH'){return $_[0]->hash_to_json($_[1])}elsif ($reftype eq 'ARRAY'){return $_[0]->array_to_json($_[1])}else {return 'null'}}sub encode_error {my$error=shift;Carp::croak "$error"}sub _sort {defined$keysort ? (sort$keysort (keys %{$_[0]})): keys %{$_[0]}}sub _up_indent {my$self=shift;my$space=' ' x $indent_length;my ($pre,$post)=('','');$post="\n" .$space x $indent_count;$indent_count++;$pre="\n" .$space x $indent_count;return ($pre,$post)}sub _down_indent {$indent_count--}sub PP_encode_box {{depth=>$depth,indent_count=>$indent_count,}}}sub _encode_ascii {join('',map {$_ <= 127 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_latin1 {join('',map {$_ <= 255 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_surrogates {my$uni=$_[0]- 0x10000;return ($uni / 0x400 + 0xD800,$uni % 0x400 + 0xDC00)}sub _is_bignum {$_[0]->isa('Math::BigInt')or $_[0]->isa('Math::BigFloat')}my$max_intsize;BEGIN {my$checkint=1111;for my$d (5..64){$checkint .= 1;my$int=eval qq| $checkint |;if ($int =~ /[eE]/){$max_intsize=$d - 1;last}}}{my%escapes=(b=>"\x8",t=>"\x9",n=>"\xA",f=>"\xC",r=>"\xD",'\\'=>'\\','"'=>'"','/'=>'/',);my$text;my$at;my$ch;my$len;my$depth;my$encoding;my$is_valid_utf8;my$utf8_len;my$utf8;my$max_depth;my$max_size;my$relaxed;my$cb_object;my$cb_sk_object;my$F_HOOK;my$allow_bigint;my$singlequote;my$loose;my$allow_barekey;sub PP_decode_json {my ($self,$opt);($self,$text,$opt)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$idx=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bigint,$allow_barekey,$singlequote)=@{$idx}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE];if ($utf8){utf8::downgrade($text,1)or Carp::croak("Wide character in subroutine entry")}else {utf8::upgrade($text);utf8::encode($text)}$len=length$text;($max_depth,$max_size,$cb_object,$cb_sk_object,$F_HOOK)=@{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};if ($max_size > 1){use bytes;my$bytes=length$text;decode_error(sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s" ,$bytes,$max_size),1)if ($bytes > $max_size)}my@octets=unpack('C4',$text);$encoding=($octets[0]and $octets[1])? 'UTF-8' : (!$octets[0]and $octets[1])? 'UTF-16BE' : (!$octets[0]and!$octets[1])? 'UTF-32BE' : ($octets[2])? 'UTF-16LE' : (!$octets[2])? 'UTF-32LE' : 'unknown';white();my$valid_start=defined$ch;my$result=value();return undef if (!$result && ($opt & 0x10000000));decode_error("malformed JSON string, neither array, object, number, string or atom")unless$valid_start;if (!$idx->[P_ALLOW_NONREF ]and!ref$result){decode_error('JSON text must be an object or array (but found number, string, true, false or null,' .' use allow_nonref to allow this)',1)}Carp::croak('something wrong.')if$len < $at;my$consumed=defined$ch ? $at - 1 : $at;white();if ($ch){return ($result,$consumed)if ($opt & 0x00000001);decode_error("garbage after JSON object")}($opt & 0x00000001)? ($result,$consumed): $result}sub next_chr {return$ch=undef if($at >= $len);$ch=substr($text,$at++,1)}sub value {white();return if(!defined$ch);return object()if($ch eq '{');return array()if($ch eq '[');return string()if($ch eq '"' or ($singlequote and $ch eq "'"));return number()if($ch =~ /[0-9]/ or $ch eq '-');return word()}sub string {my ($i,$s,$t,$u);my$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);$s='';if($ch eq '"' or ($singlequote and $ch eq "'")){my$boundChar=$ch;OUTER: while(defined(next_chr())){if($ch eq $boundChar){next_chr();if ($utf16){decode_error("missing low surrogate character in surrogate pair")}utf8::decode($s)if($is_utf8);return$s}elsif($ch eq '\\'){next_chr();if(exists$escapes{$ch}){$s .= $escapes{$ch}}elsif($ch eq 'u'){my$u='';for(1..4){$ch=next_chr();last OUTER if($ch !~ /[0-9a-fA-F]/);$u .= $ch}if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/){$utf16=$u}elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/){unless (defined$utf16){decode_error("missing high surrogate character in surrogate pair")}$is_utf8=1;$s .= JSON_PP_decode_surrogates($utf16,$u)|| next;$utf16=undef}else {if (defined$utf16){decode_error("surrogate pair expected")}if ((my$hex=hex($u))> 127){$is_utf8=1;$s .= JSON_PP_decode_unicode($u)|| next}else {$s .= chr$hex}}}else{unless ($loose){$at -= 2;decode_error('illegal backslash escape sequence in string')}$s .= $ch}}else{if (ord$ch > 127){unless($ch=is_valid_utf8($ch)){$at -= 1;decode_error("malformed UTF-8 character in JSON string")}else {$at += $utf8_len - 1}$is_utf8=1}if (!$loose){if ($ch =~ /[\x00-\x1f\x22\x5c]/){$at--;decode_error('invalid character encountered while parsing JSON string')}}$s .= $ch}}}decode_error("unexpected end of string while parsing JSON string")}sub white {while(defined$ch){if($ch le ' '){next_chr()}elsif($ch eq '/'){next_chr();if(defined$ch and $ch eq '/'){1 while(defined(next_chr())and $ch ne "\n" and $ch ne "\r")}elsif(defined$ch and $ch eq '*'){next_chr();while(1){if(defined$ch){if($ch eq '*'){if(defined(next_chr())and $ch eq '/'){next_chr();last}}else{next_chr()}}else{decode_error("Unterminated comment")}}next}else{$at--;decode_error("malformed JSON string, neither array, object, number, string or atom")}}else{if ($relaxed and $ch eq '#'){pos($text)=$at;$text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;$at=pos($text);next_chr;next}last}}}sub array {my$a=$_[0]|| [];decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq ']'){--$depth;next_chr();return$a}else {while(defined($ch)){push @$a,value();white();if (!defined$ch){last}if($ch eq ']'){--$depth;next_chr();return$a}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq ']'){--$depth;next_chr();return$a}}}decode_error(", or ] expected while parsing array")}sub object {my$o=$_[0]|| {};my$k;decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}else {while (defined$ch){$k=($allow_barekey and $ch ne '"' and $ch ne "'")? bareKey(): string();white();if(!defined$ch or $ch ne ':'){$at--;decode_error("':' expected")}next_chr();$o->{$k}=value();white();last if (!defined$ch);if($ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}}}$at--;decode_error(", or } expected while parsing object/hash")}sub bareKey {my$key;while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){$key .= $ch;next_chr()}return$key}sub word {my$word=substr($text,$at-1,4);if($word eq 'true'){$at += 3;next_chr;return$JSON::PP::true}elsif($word eq 'null'){$at += 3;next_chr;return undef}elsif($word eq 'fals'){$at += 3;if(substr($text,$at,1)eq 'e'){$at++;next_chr;return$JSON::PP::false}}$at--;decode_error("'null' expected")if ($word =~ /^n/);decode_error("'true' expected")if ($word =~ /^t/);decode_error("'false' expected")if ($word =~ /^f/);decode_error("malformed JSON string, neither array, object, number, string or atom")}sub number {my$n='';my$v;if($ch eq '0'){my$peek=substr($text,$at,1);my$hex=$peek =~ /[xX]/;if($hex){decode_error("malformed number (leading zero must not be followed by another digit)");($n)=(substr($text,$at+1)=~ /^([0-9a-fA-F]+)/)}else{($n)=(substr($text,$at)=~ /^([0-7]+)/);if (defined$n and length$n > 1){decode_error("malformed number (leading zero must not be followed by another digit)")}}if(defined$n and length($n)){if (!$hex and length($n)==1){decode_error("malformed number (leading zero must not be followed by another digit)")}$at += length($n)+ $hex;next_chr;return$hex ? hex($n): oct($n)}}if($ch eq '-'){$n='-';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after initial minus)")}}while(defined$ch and $ch =~ /\d/){$n .= $ch;next_chr}if(defined$ch and $ch eq '.'){$n .= '.';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after decimal point)")}else {$n .= $ch}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}if(defined$ch and ($ch eq 'e' or $ch eq 'E')){$n .= $ch;next_chr;if(defined($ch)and ($ch eq '+' or $ch eq '-')){$n .= $ch;next_chr;if (!defined$ch or $ch =~ /\D/){decode_error("malformed number (no digits after exp sign)")}$n .= $ch}elsif(defined($ch)and $ch =~ /\d/){$n .= $ch}else {decode_error("malformed number (no digits after exp sign)")}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}$v .= $n;if ($v !~ /[.eE]/ and length$v > $max_intsize){if ($allow_bigint){require Math::BigInt;return Math::BigInt->new($v)}else {return "$v"}}elsif ($allow_bigint){require Math::BigFloat;return Math::BigFloat->new($v)}return 0+$v}sub is_valid_utf8 {$utf8_len=$_[0]=~ /[\x00-\x7F]/ ? 1 : $_[0]=~ /[\xC2-\xDF]/ ? 2 : $_[0]=~ /[\xE0-\xEF]/ ? 3 : $_[0]=~ /[\xF0-\xF4]/ ? 4 : 0 ;return unless$utf8_len;my$is_valid_utf8=substr($text,$at - 1,$utf8_len);return ($is_valid_utf8 =~ /^(?:
253
+               [\x00-\x7F]
254
+              |[\xC2-\xDF][\x80-\xBF]
255
+              |[\xE0][\xA0-\xBF][\x80-\xBF]
256
+              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
257
+              |[\xED][\x80-\x9F][\x80-\xBF]
258
+              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
259
+              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
260
+              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
261
+              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
262
+          )$/x)? $is_valid_utf8 : ''}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type=$] >= 5.008 ? 'U*' : $] < 5.006 ? 'C*' : utf8::is_utf8($str)? 'U*' : 'C*' ;for my$c (unpack($type,$str)){$mess .= $c==0x07 ? '\a' : $c==0x09 ? '\t' : $c==0x0a ? '\n' : $c==0x0d ? '\r' : $c==0x0c ? '\f' : $c < 0x20 ? sprintf('\x{%x}',$c): $c==0x5c ? '\\\\' : $c < 0x80 ? chr($c): sprintf('\x{%x}',$c);if (length$mess >= 20){$mess .= '...';last}}unless (length$mess){$mess='(end of string)'}Carp::croak ($no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")")}sub _json_object_hook {my$o=$_[0];my@ks=keys %{$o};if ($cb_sk_object and @ks==1 and exists$cb_sk_object->{$ks[0]}and ref$cb_sk_object->{$ks[0]}){my@val=$cb_sk_object->{$ks[0]}->($o->{$ks[0]});if (@val==1){return$val[0]}}my@val=$cb_object->($o)if ($cb_object);if (@val==0 or @val > 1){return$o}else {return$val[0]}}sub PP_decode_box {{text=>$text,at=>$at,ch=>$ch,len=>$len,depth=>$depth,encoding=>$encoding,is_valid_utf8=>$is_valid_utf8,}}}sub _decode_surrogates {my$uni=0x10000 + (hex($_[0])- 0xD800)* 0x400 + (hex($_[1])- 0xDC00);my$un=pack('U*',$uni);utf8::encode($un);return$un}sub _decode_unicode {my$un=pack('U',hex shift);utf8::encode($un);return$un}BEGIN {unless (defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}if ($] >= 5.008){*JSON::PP::JSON_PP_encode_ascii=\&_encode_ascii;*JSON::PP::JSON_PP_encode_latin1=\&_encode_latin1;*JSON::PP::JSON_PP_decode_surrogates=\&_decode_surrogates;*JSON::PP::JSON_PP_decode_unicode=\&_decode_unicode}if ($] >= 5.008 and $] < 5.008003){package JSON::PP;require subs;subs->import('join');eval q|
263
+              sub join {
264
+                  return '' if (@_ < 2);
265
+                  my $j   = shift;
266
+                  my $str = shift;
267
+                  for (@_) { $str .= $j . $_; }
268
+                  return $str;
269
+              }
270
+          |}sub JSON::PP::incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub JSON::PP::incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub JSON::PP::incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}eval q{
271
+          sub JSON::PP::incr_text : lvalue {
272
+              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
12154 273
   
12155
-      return defined $version ? $version->stringify : undef;
12156
-  }
274
+              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
275
+                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
276
+              }
277
+              $_[0]->{_incr_parser}->{incr_text};
278
+          }
279
+      } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*JSON::PP::reftype=sub {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*JSON::PP::refaddr=sub {return undef unless length(ref($_[0]));my$addr;if(defined(my$pkg=blessed($_[0]))){$addr .= bless $_[0],'Scalar::Util::Fake';bless $_[0],$pkg}else {$addr .= $_[0]}$addr =~ /0x(\w+)/;local $^W;hex($1)}}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {defined $_[0]and UNIVERSAL::isa($_[0],"JSON::PP::Boolean")}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package JSON::PP::Boolean;use overload ("0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);package JSON::PP::IncrParser;use strict;use constant INCR_M_WS=>0;use constant INCR_M_STR=>1;use constant INCR_M_BS=>2;use constant INCR_M_JSON=>3;use constant INCR_M_C0=>4;use constant INCR_M_C1=>5;$JSON::PP::IncrParser::VERSION='1.01';my$unpack_format=$] < 5.006 ? 'C*' : 'U*';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_parsing=>0,incr_p=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){if (utf8::is_utf8($text)and!utf8::is_utf8($self->{incr_text})){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}$self->{incr_text}.= $text}my$max_size=$coder->get_max_size;if (defined wantarray){$self->{incr_mode}=INCR_M_WS unless defined$self->{incr_mode};if (wantarray){my@ret;$self->{incr_parsing}=1;do {push@ret,$self->_incr_parse($coder,$self->{incr_text});unless (!$self->{incr_nest}and $self->{incr_mode}==INCR_M_JSON){$self->{incr_mode}=INCR_M_WS if$self->{incr_mode}!=INCR_M_STR}}until (length$self->{incr_text}>= $self->{incr_p});$self->{incr_parsing}=0;return@ret}else {$self->{incr_parsing}=1;my$obj=$self->_incr_parse($coder,$self->{incr_text});$self->{incr_parsing}=0 if defined$obj;return$obj ? $obj : undef}}}sub _incr_parse {my ($self,$coder,$text,$skip)=@_;my$p=$self->{incr_p};my$restore=$p;my@obj;my$len=length$text;if ($self->{incr_mode}==INCR_M_WS){while ($len > $p){my$s=substr($text,$p,1);$p++ and next if (0x20 >= unpack($unpack_format,$s));$self->{incr_mode}=INCR_M_JSON;last}}while ($len > $p){my$s=substr($text,$p++,1);if ($s eq '"'){if (substr($text,$p - 2,1)eq '\\'){next}if ($self->{incr_mode}!=INCR_M_STR){$self->{incr_mode}=INCR_M_STR}else {$self->{incr_mode}=INCR_M_JSON;unless ($self->{incr_nest}){last}}}if ($self->{incr_mode}==INCR_M_JSON){if ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}}elsif ($s eq ']' or $s eq '}'){last if (--$self->{incr_nest}<= 0)}elsif ($s eq '#'){while ($len > $p){last if substr($text,$p++,1)eq "\n"}}}}$self->{incr_p}=$p;return if ($self->{incr_mode}==INCR_M_STR and not $self->{incr_nest});return if ($self->{incr_mode}==INCR_M_JSON and $self->{incr_nest}> 0);return '' unless (length substr($self->{incr_text},0,$p));local$Carp::CarpLevel=2;$self->{incr_p}=$restore;$self->{incr_c}=$p;my ($obj,$tail)=$coder->PP_decode_json(substr($self->{incr_text},0,$p),0x10000001);$self->{incr_text}=substr($self->{incr_text},$p);$self->{incr_p}=0;return$obj || ''}sub incr_text {if ($_[0]->{incr_parsing}){Carp::croak("incr_text can not be called when the incremental parser already started parsing")}$_[0]->{incr_text}}sub incr_skip {my$self=shift;$self->{incr_text}=substr($self->{incr_text},$self->{incr_c});$self->{incr_p}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_p}=0;$self->{incr_mode}=0;$self->{incr_nest}=0;$self->{incr_parsing}=0}1;
280
+JSON_PP
281
+
282
+$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
283
+  use JSON::PP ();use strict;1;
284
+JSON_PP_BOOLEAN
285
+
286
+$fatpacked{"Module/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE';
287
+  package Module::CPANfile;use strict;use warnings;use Cwd;use Carp ();use Module::CPANfile::Environment;use Module::CPANfile::Requirement;our$VERSION='1.1000';sub new {my($class,$file)=@_;bless {},$class}sub load {my($proto,$file)=@_;my$self=ref$proto ? $proto : $proto->new;$self->parse($file || Cwd::abs_path('cpanfile'));$self}sub save {my($self,$path)=@_;open my$out,">",$path or die "$path: $!";print {$out}$self->to_string}sub parse {my($self,$file)=@_;my$code=do {open my$fh,"<",$file or die "$file: $!";join '',<$fh>};my$env=Module::CPANfile::Environment->new($file);$env->parse($code)or die $@;$self->{_mirrors}=$env->mirrors;$self->{_prereqs}=$env->prereqs}sub from_prereqs {my($proto,$prereqs)=@_;my$self=$proto->new;$self->{_prereqs}=Module::CPANfile::Prereqs->from_cpan_meta($prereqs);$self}sub mirrors {my$self=shift;$self->{_mirrors}|| []}sub features {my$self=shift;map$self->feature($_),$self->{_prereqs}->identifiers}sub feature {my($self,$identifier)=@_;$self->{_prereqs}->feature($identifier)}sub prereq {shift->prereqs}sub prereqs {my$self=shift;$self->{_prereqs}->as_cpan_meta}sub merged_requirements {my$self=shift;$self->{_prereqs}->merged_requirements}sub effective_prereqs {my($self,$features)=@_;$self->prereqs_with(@{$features || []})}sub prereqs_with {my($self,@feature_identifiers)=@_;my$prereqs=$self->prereqs;my@others=map {$self->feature($_)->prereqs}@feature_identifiers;$prereqs->with_merged_prereqs(\@others)}sub prereq_specs {my$self=shift;$self->prereqs->as_string_hash}sub prereq_for_module {my($self,$module)=@_;$self->{_prereqs}->find($module)}sub options_for_module {my($self,$module)=@_;my$prereq=$self->prereq_for_module($module)or return;$prereq->requirement->options}sub merge_meta {my($self,$file,$version)=@_;require CPAN::Meta;$version ||= $file =~ /\.yml$/ ? '1.4' : '2';my$prereq=$self->prereqs;my$meta=CPAN::Meta->load_file($file);my$prereqs_hash=$prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;my$struct={%{$meta->as_struct},prereqs=>$prereqs_hash };CPAN::Meta->new($struct)->save($file,{version=>$version })}sub _dump {my$str=shift;require Data::Dumper;chomp(my$value=Data::Dumper->new([$str])->Terse(1)->Dump);$value}sub to_string {my($self,$include_empty)=@_;my$mirrors=$self->mirrors;my$prereqs=$self->prereq_specs;my$code='';$code .= $self->_dump_mirrors($mirrors);$code .= $self->_dump_prereqs($prereqs,$include_empty);for my$feature ($self->features){$code .= sprintf "feature %s, %s => sub {\n",_dump($feature->{identifier}),_dump($feature->{description});$code .= $self->_dump_prereqs($feature->{spec},$include_empty,4);$code .= "}\n\n"}$code =~ s/\n+$/\n/s;$code}sub _dump_mirrors {my($self,$mirrors)=@_;my$code="";for my$url (@$mirrors){$code .= "mirror '$url';\n"}$code =~ s/\n+$/\n/s;$code}sub _dump_prereqs {my($self,$prereqs,$include_empty,$base_indent)=@_;my$code='';for my$phase (qw(runtime configure build test develop)){my$indent=$phase eq 'runtime' ? '' : '    ';$indent=(' ' x ($base_indent || 0)).$indent;my($phase_code,$requirements);$phase_code .= "on $phase => sub {\n" unless$phase eq 'runtime';for my$type (qw(requires recommends suggests conflicts)){for my$mod (sort keys %{$prereqs->{$phase}{$type}}){my$ver=$prereqs->{$phase}{$type}{$mod};$phase_code .= $ver eq '0' ? "${indent}$type '$mod';\n" : "${indent}$type '$mod', '$ver';\n";$requirements++}}$phase_code .= "\n" unless$requirements;$phase_code .= "};\n" unless$phase eq 'runtime';$code .= $phase_code ."\n" if$requirements or $include_empty}$code =~ s/\n+$/\n/s;$code}1;
288
+MODULE_CPANFILE
289
+
290
+$fatpacked{"Module/CPANfile/Environment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_ENVIRONMENT';
291
+  package Module::CPANfile::Environment;use strict;use warnings;use Module::CPANfile::Prereqs;use Carp ();my@bindings=qw(on requires recommends suggests conflicts feature osname mirror configure_requires build_requires test_requires author_requires);my$file_id=1;sub new {my($class,$file)=@_;bless {file=>$file,phase=>'runtime',feature=>undef,features=>{},prereqs=>Module::CPANfile::Prereqs->new,mirrors=>[],},$class}sub bind {my$self=shift;my$pkg=caller;for my$binding (@bindings){no strict 'refs';*{"$pkg\::$binding"}=sub {$self->$binding(@_)}}}sub parse {my($self,$code)=@_;my$err;{local $@;$file_id++;$self->_evaluate(<<EVAL);$err=$@}if ($err){die "Parsing $self->{file} failed: $err"};return 1}sub _evaluate {my$_environment=$_[0];eval $_[1]}sub prereqs {$_[0]->{prereqs}}sub mirrors {$_[0]->{mirrors}}sub on {my($self,$phase,$code)=@_;local$self->{phase}=$phase;$code->()}sub feature {my($self,$identifier,$description,$code)=@_;if (@_==3 && ref($description)eq 'CODE'){$code=$description;$description=$identifier}unless (ref$description eq '' && ref$code eq 'CODE'){Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }")}local$self->{feature}=$identifier;$self->prereqs->add_feature($identifier,$description);$code->()}sub osname {die "TODO"}sub mirror {my($self,$url)=@_;push @{$self->{mirrors}},$url}sub requirement_for {my($self,$module,@args)=@_;my$requirement=0;$requirement=shift@args if@args % 2;return Module::CPANfile::Requirement->new(name=>$module,version=>$requirement,@args,)}sub requires {my$self=shift;$self->add_prereq(requires=>@_)}sub recommends {my$self=shift;$self->add_prereq(recommends=>@_)}sub suggests {my$self=shift;$self->add_prereq(suggests=>@_)}sub conflicts {my$self=shift;$self->add_prereq(conflicts=>@_)}sub add_prereq {my($self,$type,$module,@args)=@_;$self->prereqs->add_prereq(feature=>$self->{feature},phase=>$self->{phase},type=>$type,module=>$module,requirement=>$self->requirement_for($module,@args),)}sub configure_requires {my($self,@args)=@_;$self->on(configure=>sub {$self->requires(@args)})}sub build_requires {my($self,@args)=@_;$self->on(build=>sub {$self->requires(@args)})}sub test_requires {my($self,@args)=@_;$self->on(test=>sub {$self->requires(@args)})}sub author_requires {my($self,@args)=@_;$self->on(develop=>sub {$self->requires(@args)})}1;
292
+  package Module::CPANfile::Sandbox$file_id;
293
+  no warnings;
294
+  BEGIN { \$_environment->bind }
12157 295
   
12158
-  1; #this line is important and will help the module return a true value
296
+  # line 1 "$self->{file}"
297
+  $code;
298
+  EVAL
299
+MODULE_CPANFILE_ENVIRONMENT
300
+
301
+$fatpacked{"Module/CPANfile/Prereq.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQ';
302
+  package Module::CPANfile::Prereq;use strict;sub new {my($class,%options)=@_;bless \%options,$class}sub feature {$_[0]->{feature}}sub phase {$_[0]->{phase}}sub type {$_[0]->{type}}sub module {$_[0]->{module}}sub requirement {$_[0]->{requirement}}sub match_feature {my($self,$identifier)=@_;no warnings 'uninitialized';$self->feature eq $identifier}1;
303
+MODULE_CPANFILE_PREREQ
304
+
305
+$fatpacked{"Module/CPANfile/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQS';
306
+  package Module::CPANfile::Prereqs;use strict;use Carp ();use CPAN::Meta::Feature;use Module::CPANfile::Prereq;sub from_cpan_meta {my($class,$prereqs)=@_;my$self=$class->new;for my$phase (keys %$prereqs){for my$type (keys %{$prereqs->{$phase}}){while (my($module,$requirement)=each %{$prereqs->{$phase}{$type}}){$self->add_prereq(phase=>$phase,type=>$type,module=>$module,requirement=>Module::CPANfile::Requirement->new(name=>$module,version=>$requirement),)}}}$self}sub new {my$class=shift;bless {prereqs=>[],features=>{},},$class}sub add_feature {my($self,$identifier,$description)=@_;$self->{features}{$identifier}={description=>$description }}sub add_prereq {my($self,%args)=@_;$self->add(Module::CPANfile::Prereq->new(%args))}sub add {my($self,$prereq)=@_;push @{$self->{prereqs}},$prereq}sub as_cpan_meta {my$self=shift;$self->{cpanmeta}||= $self->build_cpan_meta}sub build_cpan_meta {my($self,$identifier)=@_;my$prereq_spec={};$self->prereq_each($identifier,sub {my$prereq=shift;$prereq_spec->{$prereq->phase}{$prereq->type}{$prereq->module}=$prereq->requirement->version});CPAN::Meta::Prereqs->new($prereq_spec)}sub prereq_each {my($self,$identifier,$code)=@_;for my$prereq (@{$self->{prereqs}}){next unless$prereq->match_feature($identifier);$code->($prereq)}}sub merged_requirements {my$self=shift;my$reqs=CPAN::Meta::Requirements->new;for my$prereq (@{$self->{prereqs}}){$reqs->add_string_requirement($prereq->module,$prereq->requirement->version)}$reqs}sub find {my($self,$module)=@_;for my$prereq (@{$self->{prereqs}}){return$prereq if$prereq->module eq $module}return}sub identifiers {my$self=shift;keys %{$self->{features}}}sub feature {my($self,$identifier)=@_;my$data=$self->{features}{$identifier}or Carp::croak("Unknown feature '$identifier'");my$prereqs=$self->build_cpan_meta($identifier);CPAN::Meta::Feature->new($identifier,{description=>$data->{description},prereqs=>$prereqs->as_string_hash,})}1;
307
+MODULE_CPANFILE_PREREQS
308
+
309
+$fatpacked{"Module/CPANfile/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_REQUIREMENT';
310
+  package Module::CPANfile::Requirement;use strict;sub new {my ($class,%args)=@_;$args{version}||= 0;bless +{name=>delete$args{name},version=>delete$args{version},options=>\%args,},$class}sub name {$_[0]->{name}}sub version {$_[0]->{version}}sub options {$_[0]->{options}}sub has_options {keys %{$_[0]->{options}}> 0}1;
311
+MODULE_CPANFILE_REQUIREMENT
312
+
313
+$fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA';
314
+  package Module::Metadata;sub __clean_eval {eval $_[0]}use strict;use warnings;our$VERSION='1.000027';use Carp qw/croak/;use File::Spec;BEGIN {eval {require Fcntl;Fcntl->import('SEEK_SET');1}or *SEEK_SET=sub {0}}use version 0.87;BEGIN {if ($INC{'Log/Contextual.pm'}){require "Log/Contextual/WarnLogger.pm";Log::Contextual->import('log_info','-default_logger'=>Log::Contextual::WarnLogger->new({env_prefix=>'MODULE_METADATA',}),)}else {*log_info=sub (&) {warn $_[0]->()}}}use File::Find qw(find);my$V_NUM_REGEXP=qr{v?[0-9._]+};my$PKG_FIRST_WORD_REGEXP=qr{ # the FIRST word in a package name
315
+    [a-zA-Z_]                     # the first word CANNOT start with a digit
316
+      (?:
317
+        [\w']?                    # can contain letters, digits, _, or ticks
318
+        \w                        # But, NO multi-ticks or trailing ticks
319
+      )*
320
+  }x;my$PKG_ADDL_WORD_REGEXP=qr{ # the 2nd+ word in a package name
321
+    \w                           # the 2nd+ word CAN start with digits
322
+      (?:
323
+        [\w']?                   # and can contain letters or ticks
324
+        \w                       # But, NO multi-ticks or trailing ticks
325
+      )*
326
+  }x;my$PKG_NAME_REGEXP=qr{ # match a package name
327
+    (?: :: )?               # a pkg name can start with arisdottle
328
+    $PKG_FIRST_WORD_REGEXP  # a package word
329
+    (?:
330
+      (?: :: )+             ### arisdottle (allow one or many times)
331
+      $PKG_ADDL_WORD_REGEXP ### a package word
332
+    )*                      # ^ zero, one or many times
333
+    (?:
334
+      ::                    # allow trailing arisdottle
335
+    )?
336
+  }x;my$PKG_REGEXP=qr{   # match a package declaration
337
+    ^[\s\{;]*             # intro chars on a line
338
+    package               # the word 'package'
339
+    \s+                   # whitespace
340
+    ($PKG_NAME_REGEXP)    # a package name
341
+    \s*                   # optional whitespace
342
+    ($V_NUM_REGEXP)?        # optional version number
343
+    \s*                   # optional whitesapce
344
+    [;\{]                 # semicolon line terminator or block start (since 5.16)
345
+  }x;my$VARNAME_REGEXP=qr{ # match fully-qualified VERSION name
346
+    ([\$*])         # sigil - $ or *
347
+    (
348
+      (             # optional leading package name
349
+        (?:::|\')?  # possibly starting like just :: (a la $::VERSION)
350
+        (?:\w+(?:::|\'))*  # Foo::Bar:: ...
351
+      )?
352
+      VERSION
353
+    )\b
354
+  }x;my$VERS_REGEXP=qr{ # match a VERSION definition
355
+    (?:
356
+      \(\s*$VARNAME_REGEXP\s*\) # with parens
357
+    |
358
+      $VARNAME_REGEXP           # without parens
359
+    )
360
+    \s*
361
+    =[^=~>]  # = but not ==, nor =~, nor =>
362
+  }x;sub new_from_file {my$class=shift;my$filename=File::Spec->rel2abs(shift);return undef unless defined($filename)&& -f $filename;return$class->_init(undef,$filename,@_)}sub new_from_handle {my$class=shift;my$handle=shift;my$filename=shift;return undef unless defined($handle)&& defined($filename);$filename=File::Spec->rel2abs($filename);return$class->_init(undef,$filename,@_,handle=>$handle)}sub new_from_module {my$class=shift;my$module=shift;my%props=@_;$props{inc}||= \@INC;my$filename=$class->find_module_by_name($module,$props{inc});return undef unless defined($filename)&& -f $filename;return$class->_init($module,$filename,%props)}{my$compare_versions=sub {my ($v1,$op,$v2)=@_;$v1=version->new($v1)unless UNIVERSAL::isa($v1,'version');my$eval_str="\$v1 $op \$v2";my$result=eval$eval_str;log_info {"error comparing versions: '$eval_str' $@"}if $@;return$result};my$normalize_version=sub {my ($version)=@_;if ($version =~ /[=<>!,]/){}elsif (ref$version eq 'version'){$version=$version->is_qv ? $version->normal : $version->stringify}elsif ($version =~ /^[^v][^.]*\.[^.]+\./){$version="v$version"}else {}return$version};my$resolve_module_versions=sub {my$packages=shift;my($file,$version);my$err='';for my$p (@$packages){if (defined($p->{version})){if (defined($version)){if ($compare_versions->($version,'!=',$p->{version})){$err .= "  $p->{file} ($p->{version})\n"}else {}}else {$file=$p->{file};$version=$p->{version}}}$file ||= $p->{file}if defined($p->{file})}if ($err){$err="  $file ($version)\n" .$err}my%result=(file=>$file,version=>$version,err=>$err);return \%result};sub provides {my$class=shift;croak "provides() requires key/value pairs \n" if @_ % 2;my%args=@_;croak "provides() takes only one of 'dir' or 'files'\n" if$args{dir}&& $args{files};croak "provides() requires a 'version' argument" unless defined$args{version};croak "provides() does not support version '$args{version}' metadata" unless grep {$args{version}eq $_}qw/1.4 2/;$args{prefix}='lib' unless defined$args{prefix};my$p;if ($args{dir}){$p=$class->package_versions_from_directory($args{dir})}else {croak "provides() requires 'files' to be an array reference\n" unless ref$args{files}eq 'ARRAY';$p=$class->package_versions_from_directory($args{files})}if (length$args{prefix}){$args{prefix}=~ s{/$}{};for my$v (values %$p){$v->{file}="$args{prefix}/$v->{file}"}}return$p}sub package_versions_from_directory {my ($class,$dir,$files)=@_;my@files;if ($files){@files=@$files}else {find({wanted=>sub {push@files,$_ if -f $_ && /\.pm$/},no_chdir=>1,},$dir)}my(%prime,%alt);for my$file (@files){my$mapped_filename=File::Spec::Unix->abs2rel($file,$dir);my@path=split(/\//,$mapped_filename);(my$prime_package=join('::',@path))=~ s/\.pm$//;my$pm_info=$class->new_from_file($file);for my$package ($pm_info->packages_inside){next if$package eq 'main';next if$package eq 'DB';next if grep /^_/,split(/::/,$package);my$version=$pm_info->version($package);$prime_package=$package if lc($prime_package)eq lc($package);if ($package eq $prime_package){if (exists($prime{$package})){croak "Unexpected conflict in '$package'; multiple versions found.\n"}else {$mapped_filename="$package.pm" if lc("$package.pm")eq lc($mapped_filename);$prime{$package}{file}=$mapped_filename;$prime{$package}{version}=$version if defined($version)}}else {push(@{$alt{$package}},{file=>$mapped_filename,version=>$version,})}}}for my$package (keys(%alt)){my$result=$resolve_module_versions->($alt{$package});if (exists($prime{$package})){if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" ."  $prime{$package}{file} ($prime{$package}{version})\n" .$result->{err}}}elsif (defined($result->{version})){if (exists($prime{$package}{version})&& defined($prime{$package}{version})){if ($compare_versions->($prime{$package}{version},'!=',$result->{version})){log_info {"Found conflicting versions for package '$package'\n" ."  $prime{$package}{file} ($prime{$package}{version})\n" ."  $result->{file} ($result->{version})\n"}}}else {$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}}}else {}}else {if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" .$result->{err}}}$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}if defined($result->{version})}}for (grep defined $_->{version},values%prime){$_->{version}=$normalize_version->($_->{version})}return \%prime}}sub _init {my$class=shift;my$module=shift;my$filename=shift;my%props=@_;my$handle=delete$props{handle};my(%valid_props,@valid_props);@valid_props=qw(collect_pod inc);@valid_props{@valid_props}=delete(@props{@valid_props});warn "Unknown properties: @{[keys %props]}\n" if scalar(%props);my%data=(module=>$module,filename=>$filename,version=>undef,packages=>[],versions=>{},pod=>{},pod_headings=>[],collect_pod=>0,%valid_props,);my$self=bless(\%data,$class);if (not $handle){my$filename=$self->{filename};open$handle,'<',$filename or croak("Can't open '$filename': $!");$self->_handle_bom($handle,$filename)}$self->_parse_fh($handle);unless($self->{module}and length($self->{module})){my ($v,$d,$f)=File::Spec->splitpath($self->{filename});if($f =~ /\.pm$/){$f =~ s/\..+$//;my@candidates=grep /$f$/,@{$self->{packages}};$self->{module}=shift(@candidates)}else {if(grep /main/,@{$self->{packages}}){$self->{module}='main'}else {$self->{module}=$self->{packages}[0]|| ''}}}$self->{version}=$self->{versions}{$self->{module}}if defined($self->{module});return$self}sub _do_find_module {my$class=shift;my$module=shift || croak 'find_module_by_name() requires a package name';my$dirs=shift || \@INC;my$file=File::Spec->catfile(split(/::/,$module));for my$dir (@$dirs){my$testfile=File::Spec->catfile($dir,$file);return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile and!-d _;$testfile .= '.pm';return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile}return}sub find_module_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[0]}sub find_module_dir_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[1]}sub _parse_version_expression {my$self=shift;my$line=shift;my($sigil,$variable_name,$package);if ($line =~ /$VERS_REGEXP/o){($sigil,$variable_name,$package)=$2 ? ($1,$2,$3): ($4,$5,$6);if ($package){$package=($package eq '::')? 'main' : $package;$package =~ s/::$//}}return ($sigil,$variable_name,$package)}sub _handle_bom {my ($self,$fh,$filename)=@_;my$pos=tell$fh;return unless defined$pos;my$buf=' ' x 2;my$count=read$fh,$buf,length$buf;return unless defined$count and $count >= 2;my$encoding;if ($buf eq "\x{FE}\x{FF}"){$encoding='UTF-16BE'}elsif ($buf eq "\x{FF}\x{FE}"){$encoding='UTF-16LE'}elsif ($buf eq "\x{EF}\x{BB}"){$buf=' ';$count=read$fh,$buf,length$buf;if (defined$count and $count >= 1 and $buf eq "\x{BF}"){$encoding='UTF-8'}}if (defined$encoding){if ("$]" >= 5.008){binmode($fh,":encoding($encoding)")}}else {seek$fh,$pos,SEEK_SET or croak(sprintf "Can't reset position to the top of '$filename'")}return$encoding}sub _parse_fh {my ($self,$fh)=@_;my($in_pod,$seen_end,$need_vers)=(0,0,0);my(@packages,%vers,%pod,@pod);my$package='main';my$pod_sect='';my$pod_data='';my$in_end=0;while (defined(my$line=<$fh>)){my$line_num=$.;chomp($line);my$is_cut;if ($line =~ /^=([a-zA-Z].*)/){my$cmd=$1;$is_cut=$cmd =~ /^cut(?:[^a-zA-Z]|$)/;$in_pod=!$is_cut}if ($in_pod){if ($line =~ /^=head[1-4]\s+(.+)\s*$/){push(@pod,$1);if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect=$1}elsif ($self->{collect_pod}){$pod_data .= "$line\n"}}elsif ($is_cut){if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect=''}else {next if$in_end;next if$line =~ /^\s*#/;if ($line eq '__END__'){$in_end++;next}last if$line eq '__DATA__';my($version_sigil,$version_fullname,$version_package)=index($line,'VERSION')>= 1 ? $self->_parse_version_expression($line): ();if ($line =~ /$PKG_REGEXP/o){$package=$1;my$version=$2;push(@packages,$package)unless grep($package eq $_,@packages);$need_vers=defined$version ? 0 : 1;if (not exists$vers{$package}and defined$version){my$dwim_version=eval {_dwim_version($version)};croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" unless defined$dwim_version;$vers{$package}=$dwim_version}}elsif ($version_fullname && $version_package){push(@packages,$version_package)unless grep($version_package eq $_,@packages);$need_vers=0 if$version_package eq $package;unless (defined$vers{$version_package}&& length$vers{$version_package}){$vers{$version_package}=$self->_evaluate_version_line($version_sigil,$version_fullname,$line)}}elsif ($package eq 'main' && $version_fullname &&!exists($vers{main})){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);$vers{$package}=$v;push(@packages,'main')}elsif ($package eq 'main' &&!exists($vers{main})&& $line =~ /\w/){$need_vers=1;$vers{main}='';push(@packages,'main')}elsif ($version_fullname && $need_vers){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);unless (defined$vers{$package}&& length$vers{$package}){$vers{$package}=$v}}}}if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data}$self->{versions}=\%vers;$self->{packages}=\@packages;$self->{pod}=\%pod;$self->{pod_headings}=\@pod}{my$pn=0;sub _evaluate_version_line {my$self=shift;my($sigil,$variable_name,$line)=@_;$pn++;my$eval=qq{ my \$dummy = q#  Hide from _packages_inside()
363
+      #; package Module::Metadata::_version::p${pn};
364
+      use version;
365
+      sub {
366
+        local $sigil$variable_name;
367
+        $line;
368
+        \$$variable_name
369
+      };
370
+    };$eval=$1 if$eval =~ m{^(.+)}s;local $^W;my$vsub=__clean_eval($eval);if ($@ =~ /Can't locate/ && -d 'lib'){local@INC=('lib',@INC);$vsub=__clean_eval($eval)}warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;(ref($vsub)eq 'CODE')or croak "failed to build version sub for $self->{filename}";my$result=eval {$vsub->()};croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;my$version=eval {_dwim_version($result)};croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" unless defined$version;return$version}}{my@version_prep=(sub {return shift},sub {my$v=shift;$v =~ s{([0-9])[a-z-].*$}{$1}i;return$v},sub {my$v=shift;my$num_dots=()=$v =~ m{(\.)}g;my$num_unders=()=$v =~ m{(_)}g;my$leading_v=substr($v,0,1)eq 'v';if (!$leading_v && $num_dots < 2 && $num_unders > 1){$v =~ s{_}{}g;$num_unders=()=$v =~ m{(_)}g}return$v},sub {my$v=shift;no warnings 'numeric';return 0 + $v},);sub _dwim_version {my ($result)=shift;return$result if ref($result)eq 'version';my ($version,$error);for my$f (@version_prep){$result=$f->($result);$version=eval {version->new($result)};$error ||= $@ if $@;last if defined$version}croak$error unless defined$version;return$version}}sub name {$_[0]->{module}}sub filename {$_[0]->{filename}}sub packages_inside {@{$_[0]->{packages}}}sub pod_inside {@{$_[0]->{pod_headings}}}sub contains_pod {0+@{$_[0]->{pod_headings}}}sub version {my$self=shift;my$mod=shift || $self->{module};my$vers;if (defined($mod)&& length($mod)&& exists($self->{versions}{$mod})){return$self->{versions}{$mod}}else {return undef}}sub pod {my$self=shift;my$sect=shift;if (defined($sect)&& length($sect)&& exists($self->{pod}{$sect})){return$self->{pod}{$sect}}else {return undef}}sub is_indexable {my ($self,$package)=@_;my@indexable_packages=grep {$_ ne 'main'}$self->packages_inside;return!!grep {$_ eq $package}@indexable_packages if$package;return!!@indexable_packages}1;
371
+MODULE_METADATA
372
+
373
+$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
374
+  use 5.008001;use strict;package Parse::CPAN::Meta;our$VERSION='1.4414';use Exporter;use Carp 'croak';our@ISA=qw/Exporter/;our@EXPORT_OK=qw/Load LoadFile/;sub load_file {my ($class,$filename)=@_;my$meta=_slurp($filename);if ($filename =~ /\.ya?ml$/){return$class->load_yaml_string($meta)}elsif ($filename =~ /\.json$/){return$class->load_json_string($meta)}else {$class->load_string($meta)}}sub load_string {my ($class,$string)=@_;if ($string =~ /^---/){return$class->load_yaml_string($string)}elsif ($string =~ /^\s*\{/){return$class->load_json_string($string)}else {return$class->load_yaml_string($string)}}sub load_yaml_string {my ($class,$string)=@_;my$backend=$class->yaml_backend();my$data=eval {no strict 'refs';&{"$backend\::Load"}($string)};croak $@ if $@;return$data || {}}sub load_json_string {my ($class,$string)=@_;my$data=eval {$class->json_backend()->new->decode($string)};croak $@ if $@;return$data || {}}sub yaml_backend {if (!defined$ENV{PERL_YAML_BACKEND}){_can_load('CPAN::Meta::YAML',0.011)or croak "CPAN::Meta::YAML 0.011 is not available\n";return "CPAN::Meta::YAML"}else {my$backend=$ENV{PERL_YAML_BACKEND};_can_load($backend)or croak "Could not load PERL_YAML_BACKEND '$backend'\n";$backend->can("Load")or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";return$backend}}sub json_backend {if (!$ENV{PERL_JSON_BACKEND}or $ENV{PERL_JSON_BACKEND}eq 'JSON::PP'){_can_load('JSON::PP'=>2.27103)or croak "JSON::PP 2.27103 is not available\n";return 'JSON::PP'}else {_can_load('JSON'=>2.5)or croak "JSON 2.5 is required for " ."\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";return "JSON"}}sub _slurp {require Encode;open my$fh,"<:raw","$_[0]" or die "can't open $_[0] for reading: $!";my$content=do {local $/;<$fh>};$content=Encode::decode('UTF-8',$content,Encode::PERLQQ());return$content}sub _can_load {my ($module,$version)=@_;(my$file=$module)=~ s{::}{/}g;$file .= ".pm";return 1 if$INC{$file};return 0 if exists$INC{$file};eval {require$file;1}or return 0;if (defined$version){eval {$module->VERSION($version);1}or return 0}return 1}sub LoadFile ($) {return Load(_slurp(shift))}sub Load ($) {require CPAN::Meta::YAML;my$object=eval {CPAN::Meta::YAML::Load(shift)};croak $@ if $@;return$object}1;
375
+PARSE_CPAN_META
376
+
377
+$fatpacked{"Parse/PMFile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_PMFILE';
378
+  package Parse::PMFile;sub __clean_eval {eval $_[0]}use strict;use warnings;use Safe;use JSON::PP ();use Dumpvalue;use version ();use File::Spec ();our$VERSION='0.36';our$VERBOSE=0;our$ALLOW_DEV_VERSION=0;our$FORK=0;our$UNSAFE=$] < 5.010000 ? 1 : 0;sub new {my ($class,$meta,$opts)=@_;bless {%{$opts || {}},META_CONTENT=>$meta},$class}sub parse {my ($self,$pmfile)=@_;$pmfile =~ s|\\|/|g;my($filemtime)=(stat$pmfile)[9];$self->{MTIME}=$filemtime;$self->{PMFILE}=$pmfile;unless ($self->_version_from_meta_ok){my$version;unless (eval {$version=$self->_parse_version;1}){$self->_verbose(1,"error with version in $pmfile: $@");return}$self->{VERSION}=$version;if ($self->{VERSION}=~ /^\{.*\}$/){}elsif ($self->{VERSION}=~ /[_\s]/ &&!$self->{ALLOW_DEV_VERSION}&&!$ALLOW_DEV_VERSION){return}}my($ppp)=$self->_packages_per_pmfile;my@keys_ppp=$self->_filter_ppps(sort keys %$ppp);$self->_verbose(1,"Will check keys_ppp[@keys_ppp]\n");my ($package,%errors);my%checked_in;DBPACK: foreach$package (@keys_ppp){if ($package !~ /^\w[\w\:\']*\w?\z/ || $package !~ /\w\z/ || $package =~ /:/ && $package !~ /::/ || $package =~ /\w:\w/ || $package =~ /:::/){$self->_verbose(1,"Package[$package] did not pass the ultimate sanity check");delete$ppp->{$package};next}if ($self->{USERID}&& $self->{PERMISSIONS}&&!$self->_perm_check($package)){delete$ppp->{$package};next}{my (undef,$module)=split m{/lib/},$self->{PMFILE},2;if ($module){$module =~ s{\.pm\z}{};$module =~ s{/}{::}g;if (lc$module eq lc$package && $module ne $package){$errors{$package}={indexing_warning=>"Capitalization of package ($package) does not match filename!",infile=>$self->{PMFILE},}}}}my$pp=$ppp->{$package};if ($pp->{version}&& $pp->{version}=~ /^\{.*\}$/){my$err=JSON::PP::decode_json($pp->{version});if ($err->{x_normalize}){$errors{$package}={normalize=>$err->{version},infile=>$pp->{infile},};$pp->{version}="undef"}elsif ($err->{openerr}){$pp->{version}="undef";$self->_verbose(1,qq{Parse::PMFile was not able to
379
+          read the file. It issued the following error: C< $err->{r} >},);$errors{$package}={open=>$err->{r},infile=>$pp->{infile},}}else {$pp->{version}="undef";$self->_verbose(1,qq{Parse::PMFile was not able to
380
+          parse the following line in that file: C< $err->{line} >
381
+  
382
+          Note: the indexer is running in a Safe compartement and cannot
383
+          provide the full functionality of perl in the VERSION line. It
384
+          is trying hard, but sometime it fails. As a workaround, please
385
+          consider writing a META.yml that contains a 'provides'
386
+          attribute or contact the CPAN admins to investigate (yet
387
+          another) workaround against "Safe" limitations.)},);$errors{$package}={parse_version=>$err->{line},infile=>$err->{file},}}}for ($package,$pp->{version},){if (!defined || /^\s*$/ || /\s/){delete$ppp->{$package};next}}$checked_in{$package}=$ppp->{$package}}return (wantarray && %errors)? (\%checked_in,\%errors): \%checked_in}sub _perm_check {my ($self,$package)=@_;my$userid=$self->{USERID};my$module=$self->{PERMISSIONS}->module_permissions($package);return 1 if!$module;return 1 if defined$module->m && $module->m eq $userid;return 1 if defined$module->f && $module->f eq $userid;return 1 if defined$module->c && grep {$_ eq $userid}@{$module->c};return}sub _parse_version {my$self=shift;use strict;my$pmfile=$self->{PMFILE};my$tmpfile=File::Spec->catfile(File::Spec->tmpdir,"ParsePMFile$$" .rand(1000));my$pmcp=$pmfile;for ($pmcp){s/([^\\](\\\\)*)@/$1\\@/g}my($v);{package main;my$pid;if ($self->{FORK}|| $FORK){$pid=fork();die "Can't fork: $!" unless defined$pid}if ($pid){waitpid($pid,0);if (open my$fh,'<',$tmpfile){$v=<$fh>}}else {my($comp)=Safe->new;my$eval=qq{
388
+                  local(\$^W) = 0;
389
+                  Parse::PMFile::_parse_version_safely("$pmcp");
390
+              };$comp->permit("entereval");$comp->share("*Parse::PMFile::_parse_version_safely");$comp->share("*version::new");$comp->share("*version::numify");$comp->share_from('main',['*version::','*charstar::','*Exporter::','*DynaLoader::']);$comp->share_from('version',['&qv']);$comp->permit(":base_math");$comp->deny(qw/enteriter iter unstack goto/);version->import('qv')if$self->{UNSAFE}|| $UNSAFE;{no strict;$v=($self->{UNSAFE}|| $UNSAFE)? eval$eval : $comp->reval($eval)}if ($@){my$err=$@;if (ref$err){if ($err->{line}=~ /([\$*])([\w\:\']*)\bVERSION\b.*?\=(.*)/){local($^W)=0;my ($sigil,$vstr)=($1,$3);$self->_restore_overloaded_stuff(1)if$err->{line}=~ /use\s+version\b|version\->|qv\(/;$v=($self->{UNSAFE}|| $UNSAFE)? eval$vstr : $comp->reval($vstr);$v=$$v if$sigil eq '*' && ref$v}if ($@ or!$v){$self->_verbose(1,sprintf("reval failed: err[%s] for eval[%s]",JSON::PP::encode_json($err),$eval,));$v=JSON::PP::encode_json($err)}}else {$v=JSON::PP::encode_json({openerr=>$err })}}if (defined$v){$v=$v->numify if ref($v)=~ /^version(::vpp)?$/}else {$v=""}if ($self->{FORK}|| $FORK){open my$fh,'>:utf8',$tmpfile;print$fh $v;exit 0}else {utf8::encode($v);$v=undef if defined$v &&!length$v;$comp->erase;$self->_restore_overloaded_stuff}}}unlink$tmpfile if ($self->{FORK}|| $FORK)&& -e $tmpfile;return$self->_normalize_version($v)}sub _restore_overloaded_stuff {my ($self,$used_version_in_safe)=@_;return if$self->{UNSAFE}|| $UNSAFE;no strict 'refs';no warnings 'redefine';my$restored;if ($INC{'version/vxs.pm'}){*{'version::(""'}=\&version::vxs::stringify;*{'version::(0+'}=\&version::vxs::numify;*{'version::(cmp'}=\&version::vxs::VCMP;*{'version::(<=>'}=\&version::vxs::VCMP;*{'version::(bool'}=\&version::vxs::boolean;$restored=1}if ($INC{'version/vpp.pm'}){{package charstar;overload->import}if (!$used_version_in_safe){package version::vpp;overload->import}unless ($restored){*{'version::(""'}=\&version::vpp::stringify;*{'version::(0+'}=\&version::vpp::numify;*{'version::(cmp'}=\&version::vpp::vcmp;*{'version::(<=>'}=\&version::vpp::vcmp;*{'version::(bool'}=\&version::vpp::vbool}*{'version::vpp::(""'}=\&version::vpp::stringify;*{'version::vpp::(0+'}=\&version::vpp::numify;*{'version::vpp::(cmp'}=\&version::vpp::vcmp;*{'version::vpp::(<=>'}=\&version::vpp::vcmp;*{'version::vpp::(bool'}=\&version::vpp::vbool;*{'charstar::(""'}=\&charstar::thischar;*{'charstar::(0+'}=\&charstar::thischar;*{'charstar::(++'}=\&charstar::increment;*{'charstar::(--'}=\&charstar::decrement;*{'charstar::(+'}=\&charstar::plus;*{'charstar::(-'}=\&charstar::minus;*{'charstar::(*'}=\&charstar::multiply;*{'charstar::(cmp'}=\&charstar::cmp;*{'charstar::(<=>'}=\&charstar::spaceship;*{'charstar::(bool'}=\&charstar::thischar;*{'charstar::(='}=\&charstar::clone;$restored=1}if (!$restored){*{'version::(""'}=\&version::stringify;*{'version::(0+'}=\&version::numify;*{'version::(cmp'}=\&version::vcmp;*{'version::(<=>'}=\&version::vcmp;*{'version::(bool'}=\&version::boolean}}sub _packages_per_pmfile {my$self=shift;my$ppp={};my$pmfile=$self->{PMFILE};my$filemtime=$self->{MTIME};my$version=$self->{VERSION};open my$fh,"<","$pmfile" or return$ppp;local $/="\n";my$inpod=0;PLINE: while (<$fh>){chomp;my($pline)=$_;$inpod=$pline =~ /^=(?!cut)/ ? 1 : $pline =~ /^=cut/ ? 0 : $inpod;next if$inpod;next if substr($pline,0,4)eq "=cut";$pline =~ s/\#.*//;next if$pline =~ /^\s*$/;if ($pline =~ /^__(?:END|DATA)__\b/ and $pmfile !~ /\.PL$/){last PLINE}my$pkg;my$strict_version;if ($pline =~ m{
391
+                        # (.*) # takes too much time if $pline is long
392
+                        (?<![*\$\\@%&]) # no sigils
393
+                        \bpackage\s+
394
+                        ([\w\:\']+)
395
+                        \s*
396
+                        (?: $ | [\}\;] | \{ | \s+($version::STRICT) )
397
+                      }x){$pkg=$1;$strict_version=$2;if ($pkg eq "DB"){next PLINE}}if ($pkg){$pkg =~ s/\'/::/;next PLINE unless$pkg =~ /^[A-Za-z]/;next PLINE unless$pkg =~ /\w$/;next PLINE if$pkg eq "main";next PLINE if length($pkg)> 128;$ppp->{$pkg}{parsed}++;$ppp->{$pkg}{infile}=$pmfile;if ($self->_simile($pmfile,$pkg)){$ppp->{$pkg}{simile}=$pmfile;if ($self->_version_from_meta_ok){my$provides=$self->{META_CONTENT}{provides};if (exists$provides->{$pkg}){if (defined$provides->{$pkg}{version}){my$v=$provides->{$pkg}{version};if ($v =~ /[_\s]/ &&!$self->{ALLOW_DEV_VERSION}&&!$ALLOW_DEV_VERSION){next PLINE}unless (eval {$version=$self->_normalize_version($v);1}){$self->_verbose(1,"error with version in $pmfile: $@");next}$ppp->{$pkg}{version}=$version}else {$ppp->{$pkg}{version}="undef"}}}else {if (defined$strict_version){$ppp->{$pkg}{version}=$strict_version }else {$ppp->{$pkg}{version}=defined$version ? $version : ""}no warnings;if ($version eq 'undef'){$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}}else {$ppp->{$pkg}{version}=$version if$version > $ppp->{$pkg}{version}|| $version gt $ppp->{$pkg}{version}}}}else {$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}&& length($ppp->{$pkg}{version})}$ppp->{$pkg}{filemtime}=$filemtime}else {}}close$fh;$ppp}{no strict;sub _parse_version_safely {my($parsefile)=@_;my$result;local*FH;local $/="\n";open(FH,$parsefile)or die "Could not open '$parsefile': $!";my$inpod=0;while (<FH>){$inpod=/^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;next if$inpod || /^\s*#/;last if /^__(?:END|DATA)__\b/;chop;if (my ($ver)=/package \s+ \S+ \s+ (\S+) \s* [;{]/x){return$ver if version::is_lax($ver)}next unless /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*(?<![!><=])\=(?![=>])/;my$current_parsed_line=$_;my$eval=qq{
398
+                  package #
399
+                      ExtUtils::MakeMaker::_version;
400
+  
401
+                  local $1$2;
402
+                  \$$2=undef; do {
403
+                      $_
404
+                  }; \$$2
405
+              };local $^W=0;local$SIG{__WARN__}=sub {};$result=__clean_eval($eval);if ($@ or!defined$result){die +{eval=>$eval,line=>$current_parsed_line,file=>$parsefile,err=>$@,}}last}close FH;$result="undef" unless defined$result;if ((ref$result)=~ /^version(?:::vpp)?\b/){$result=$result->numify}return$result}}sub _filter_ppps {my($self,@ppps)=@_;my@res;MANI: for my$ppp (@ppps){if ($self->{META_CONTENT}){my$no_index=$self->{META_CONTENT}{no_index}|| $self->{META_CONTENT}{private};if (ref($no_index)eq 'HASH'){my%map=(package=>qr{\z},namespace=>qr{::},);for my$k (qw(package namespace)){next unless my$v=$no_index->{$k};my$rest=$map{$k};if (ref$v eq "ARRAY"){for my$ve (@$v){$ve =~ s|::$||;if ($ppp =~ /^$ve$rest/){$self->_verbose(1,"Skipping ppp[$ppp] due to ve[$ve]");next MANI}else {$self->_verbose(1,"NOT skipping ppp[$ppp] due to ve[$ve]")}}}else {$v =~ s|::$||;if ($ppp =~ /^$v$rest/){$self->_verbose(1,"Skipping ppp[$ppp] due to v[$v]");next MANI}else {$self->_verbose(1,"NOT skipping ppp[$ppp] due to v[$v]")}}}}else {$self->_verbose(1,"No keyword 'no_index' or 'private' in META_CONTENT")}}else {}push@res,$ppp}$self->_verbose(1,"Result of filter_ppps: res[@res]");@res}sub _simile {my($self,$file,$package)=@_;$file =~ s|.*/||;$file =~ s|\.pm(?:\.PL)?||;my$ret=$package =~ m/\b\Q$file\E$/;$ret ||= 0;unless ($ret){$ret=1 if lc$file eq 'version'}$self->_verbose(1,"Result of simile(): file[$file] package[$package] ret[$ret]\n");$ret}sub _normalize_version {my($self,$v)=@_;$v="undef" unless defined$v;my$dv=Dumpvalue->new;my$sdv=$dv->stringify($v,1);$self->_verbose(1,"Result of normalize_version: sdv[$sdv]\n");return$v if$v eq "undef";return$v if$v =~ /^\{.*\}$/;$v =~ s/^\s+//;$v =~ s/\s+\z//;if ($v =~ /_/){return$v }if (!version::is_lax($v)){return JSON::PP::encode_json({x_normalize=>'version::is_lax failed',version=>$v })}my$vv=eval {no warnings;version->new($v)->numify};if ($@){return JSON::PP::encode_json({x_normalize=>$@,version=>$v })}if ($vv eq $v){}else {my$forced=$self->_force_numeric($v);if ($forced eq $vv){}elsif ($forced =~ /^v(.+)/){$vv=version->new($1)->numify}else {if ($forced==$vv){$vv=$forced}}}return$vv}sub _force_numeric {my($self,$v)=@_;$v=$self->_readable($v);if ($v =~ /^(\+?)(\d*)(\.(\d*))?/ && (defined $2 && length $2 || defined $4 && length $4)){my$two=defined $2 ? $2 : "";my$three=defined $3 ? $3 : "";$v="$two$three"}$v}sub _version_from_meta_ok {my($self)=@_;return$self->{VERSION_FROM_META_OK}if exists$self->{VERSION_FROM_META_OK};my$c=$self->{META_CONTENT};return($self->{VERSION_FROM_META_OK}=0)unless$c->{provides};my ($mb_v)=(defined$c->{generated_by}? $c->{generated_by}: '')=~ /Module::Build version ([\d\.]+)/;return($self->{VERSION_FROM_META_OK}=1)unless$mb_v;return($self->{VERSION_FROM_META_OK}=1)if$mb_v eq '0.250.0';if ($mb_v >= 0.19 && $mb_v < 0.26 &&!keys %{$c->{provides}}){return($self->{VERSION_FROM_META_OK}=0)}return($self->{VERSION_FROM_META_OK}=1)}sub _verbose {my($self,$level,@what)=@_;warn@what if$level <= ((ref$self && $self->{VERBOSE})|| $VERBOSE)}sub _vcmp {my($self,$l,$r)=@_;local($^W)=0;$self->_verbose(9,"l[$l] r[$r]");return 0 if$l eq $r;for ($l,$r){s/_//g}$self->_verbose(9,"l[$l] r[$r]");for ($l,$r){next unless tr/.// > 1 || /^v/;s/^v?/v/;1 while s/\.0+(\d)/.$1/}$self->_verbose(9,"l[$l] r[$r]");if ($l=~/^v/ <=> $r=~/^v/){for ($l,$r){next if /^v/;$_=$self->_float2vv($_)}}$self->_verbose(9,"l[$l] r[$r]");my$lvstring="v0";my$rvstring="v0";if ($] >= 5.006 && $l =~ /^v/ && $r =~ /^v/){$lvstring=$self->_vstring($l);$rvstring=$self->_vstring($r);$self->_verbose(9,sprintf "lv[%vd] rv[%vd]",$lvstring,$rvstring)}return (($l ne "undef")<=> ($r ne "undef")|| $lvstring cmp $rvstring || $l <=> $r || $l cmp $r)}sub _vgt {my($self,$l,$r)=@_;$self->_vcmp($l,$r)> 0}sub _vlt {my($self,$l,$r)=@_;$self->_vcmp($l,$r)< 0}sub _vge {my($self,$l,$r)=@_;$self->_vcmp($l,$r)>= 0}sub _vle {my($self,$l,$r)=@_;$self->_vcmp($l,$r)<= 0}sub _vstring {my($self,$n)=@_;$n =~ s/^v// or die "Parse::PMFile::_vstring() called with invalid arg [$n]";pack "U*",split /\./,$n}sub _float2vv {my($self,$n)=@_;my($rev)=int($n);$rev ||= 0;my($mantissa)=$n =~ /\.(\d{1,12})/;$mantissa ||= 0;$mantissa .= "0" while length($mantissa)%3;my$ret="v" .$rev;while ($mantissa){$mantissa =~ s/(\d{1,3})// or die "Panic: length>0 but not a digit? mantissa[$mantissa]";$ret .= ".".int($1)}$ret =~ s/(\.0)+/.0/;$ret}sub _readable {my($self,$n)=@_;$n =~ /^([\w\-\+\.]+)/;return $1 if defined $1 && length($1)>0;if ($] < 5.006){$self->_verbose(9,"Suspicious version string seen [$n]\n");return$n}my$better=sprintf "v%vd",$n;$self->_verbose(9,"n[$n] better[$better]");return$better}1;
406
+PARSE_PMFILE
407
+
408
+$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE';
409
+  package String::ShellQuote;use strict;use vars qw($VERSION @ISA @EXPORT);require Exporter;$VERSION='1.04';@ISA=qw(Exporter);@EXPORT=qw(shell_quote shell_quote_best_effort shell_comment_quote);sub croak {require Carp;goto&Carp::croak}sub _shell_quote_backend {my@in=@_;my@err=();if (0){require RS::Handy;print RS::Handy::data_dump(\@in)}return \@err,'' unless@in;my$ret='';my$saw_non_equal=0;for (@in){if (!defined $_ or $_ eq ''){$_="''";next}if (s/\x00//g){push@err,"No way to quote string containing null (\\000) bytes"}my$escape=0;if (/=/){if (!$saw_non_equal){$escape=1}}else {$saw_non_equal=1}if (m|[^\w!%+,\-./:=@^]|){$escape=1}if ($escape || (!$saw_non_equal && /=/)){s/'/'\\''/g;s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;$_="'$_'";s/^''//;s/''$//}}continue {$ret .= "$_ "}chop$ret;return \@err,$ret}sub shell_quote {my ($rerr,$s)=_shell_quote_backend @_;if (@$rerr){my%seen;@$rerr=grep {!$seen{$_}++}@$rerr;my$s=join '',map {"shell_quote(): $_\n"}@$rerr;chomp$s;croak$s}return$s}sub shell_quote_best_effort {my ($rerr,$s)=_shell_quote_backend @_;return$s}sub shell_comment_quote {return '' unless @_;unless (@_==1){croak "Too many arguments to shell_comment_quote " ."(got " .@_ ." expected 1)"}local $_=shift;s/\n/\n#/g;return $_}1;
410
+STRING_SHELLQUOTE
411
+
412
+$fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY';
413
+  package lib::core::only;use strict;use warnings FATAL=>'all';use Config;sub import {@INC=@Config{qw(privlibexp archlibexp)};return}1;
414
+LIB_CORE_ONLY
415
+
416
+$fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB';
417
+  package local::lib;use 5.006;use strict;use warnings;use Config;our$VERSION='2.000015';$VERSION=eval$VERSION;BEGIN {*_WIN32=($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian')? sub(){1}: sub(){0};*_USE_FSPEC=($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'})? sub(){1}: sub(){0}}our$_DIR_JOIN=_WIN32 ? '\\' : '/';our$_DIR_SPLIT=(_WIN32 || $^O eq 'cygwin')? qr{[\\/]} : qr{/};our$_ROOT=_WIN32 ? do {my$UNC=qr{[\\/]{2}[^\\/]+[\\/][^\\/]+};qr{^(?:$UNC|[A-Za-z]:|)$_DIR_SPLIT}}: qr{^/};our$_PERL;sub _cwd {my$drive=shift;if (!$_PERL){($_PERL)=$^X =~ /(.+)/;if (_is_abs($_PERL)){}elsif (-x $Config{perlpath}){$_PERL=$Config{perlpath}}else {($_PERL)=map {/(.*)/}grep {-x $_}map {join($_DIR_JOIN,$_,$_PERL)}split /\Q$Config{path_sep}\E/,$ENV{PATH}}}local@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};my$cmd=$drive ? "eval { Cwd::getdcwd(q($drive)) }" : 'getcwd';my$cwd=`"$_PERL" -MCwd -le "print $cmd"`;chomp$cwd;if (!length$cwd && $drive){$cwd=$drive}$cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/;$cwd}sub _catdir {if (_USE_FSPEC){require File::Spec;File::Spec->catdir(@_)}else {my$dir=join($_DIR_JOIN,@_);$dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g;$dir}}sub _is_abs {if (_USE_FSPEC){require File::Spec;File::Spec->file_name_is_absolute($_[0])}else {$_[0]=~ $_ROOT}}sub _rel2abs {my ($dir,$base)=@_;return$dir if _is_abs($dir);$base=_WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1"): $base ? $base : _cwd;return _catdir($base,$dir)}sub import {my ($class,@args)=@_;push@args,@ARGV if $0 eq '-';my@steps;my%opts;my$shelltype;while (@args){my$arg=shift@args;if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/){die <<'DEATH'}elsif ($arg eq '--self-contained'){die <<'DEATH'}elsif($arg =~ /^--deactivate(?:=(.*))?$/){my$path=defined $1 ? $1 : shift@args;push@steps,['deactivate',$path]}elsif ($arg eq '--deactivate-all'){push@steps,['deactivate_all']}elsif ($arg =~ /^--shelltype(?:=(.*))?$/){$shelltype=defined $1 ? $1 : shift@args}elsif ($arg eq '--no-create'){$opts{no_create}=1}elsif ($arg =~ /^--/){die "Unknown import argument: $arg"}else {push@steps,['activate',$arg]}}if (!@steps){push@steps,['activate',undef]}my$self=$class->new(%opts);for (@steps){my ($method,@args)=@$_;$self=$self->$method(@args)}if ($0 eq '-'){print$self->environment_vars_string($shelltype);exit 0}else {$self->setup_local_lib}}sub new {my$class=shift;bless {@_},$class}sub clone {my$self=shift;bless {%$self,@_},ref$self}sub inc {$_[0]->{inc}||= \@INC}sub libs {$_[0]->{libs}||= [\'PERL5LIB' ]}sub bins {$_[0]->{bins}||= [\'PATH' ]}sub roots {$_[0]->{roots}||= [\'PERL_LOCAL_LIB_ROOT' ]}sub extra {$_[0]->{extra}||= {}}sub no_create {$_[0]->{no_create}}my$_archname=$Config{archname};my$_version=$Config{version};my@_inc_version_list=reverse split / /,$Config{inc_version_list};my$_path_sep=$Config{path_sep};sub _as_list {my$list=shift;grep length,map {!(ref $_ && ref $_ eq 'SCALAR')? $_ : (defined$ENV{$$_}? split(/\Q$_path_sep/,$ENV{$$_}): ())}ref$list ? @$list : $list}sub _remove_from {my ($list,@remove)=@_;return @$list if!@remove;my%remove=map {$_=>1}@remove;grep!$remove{$_},_as_list($list)}my@_lib_subdirs=([$_version,$_archname],[$_version],[$_archname],(@_inc_version_list ? \@_inc_version_list : ()),[],);sub install_base_bin_path {my ($class,$path)=@_;return _catdir($path,'bin')}sub install_base_perl_path {my ($class,$path)=@_;return _catdir($path,'lib','perl5')}sub install_base_arch_path {my ($class,$path)=@_;_catdir($class->install_base_perl_path($path),$_archname)}sub lib_paths_for {my ($class,$path)=@_;my$base=$class->install_base_perl_path($path);return map {_catdir($base,@$_)}@_lib_subdirs}sub _mm_escape_path {my$path=shift;$path =~ s/\\/\\\\/g;if ($path =~ s/ /\\ /g){$path=qq{"$path"}}return$path}sub _mb_escape_path {my$path=shift;$path =~ s/\\/\\\\/g;return qq{"$path"}}sub installer_options_for {my ($class,$path)=@_;return (PERL_MM_OPT=>defined$path ? "INSTALL_BASE="._mm_escape_path($path): undef,PERL_MB_OPT=>defined$path ? "--install_base "._mb_escape_path($path): undef,)}sub active_paths {my ($self)=@_;$self=ref$self ? $self : $self->new;return grep {my$active_ll=$self->install_base_perl_path($_);grep {$_ eq $active_ll}@{$self->inc}}_as_list($self->roots)}sub deactivate {my ($self,$path)=@_;$self=$self->new unless ref$self;$path=$self->resolve_path($path);$path=$self->normalize_path($path);my@active_lls=$self->active_paths;if (!grep {$_ eq $path}@active_lls){warn "Tried to deactivate inactive local::lib '$path'\n";return$self}my%args=(bins=>[_remove_from($self->bins,$self->install_base_bin_path($path))],libs=>[_remove_from($self->libs,$self->install_base_perl_path($path))],inc=>[_remove_from($self->inc,$self->lib_paths_for($path))],roots=>[_remove_from($self->roots,$path)],);$args{extra}={$self->installer_options_for($args{roots}[0])};$self->clone(%args)}sub deactivate_all {my ($self)=@_;$self=$self->new unless ref$self;my@active_lls=$self->active_paths;my%args;if (@active_lls){%args=(bins=>[_remove_from($self->bins,map$self->install_base_bin_path($_),@active_lls)],libs=>[_remove_from($self->libs,map$self->install_base_perl_path($_),@active_lls)],inc=>[_remove_from($self->inc,map$self->lib_paths_for($_),@active_lls)],roots=>[_remove_from($self->roots,@active_lls)],)}$args{extra}={$self->installer_options_for(undef)};$self->clone(%args)}sub activate {my ($self,$path)=@_;$self=$self->new unless ref$self;$path=$self->resolve_path($path);$self->ensure_dir_structure_for($path)unless$self->no_create;$path=$self->normalize_path($path);my@active_lls=$self->active_paths;if (grep {$_ eq $path}@active_lls[1 .. $#active_lls]){$self=$self->deactivate($path)}my%args;if (!@active_lls || $active_lls[0]ne $path){%args=(bins=>[$self->install_base_bin_path($path),@{$self->bins}],libs=>[$self->install_base_perl_path($path),@{$self->libs}],inc=>[$self->lib_paths_for($path),@{$self->inc}],roots=>[$path,@{$self->roots}],)}$args{extra}={$self->installer_options_for($path)};$self->clone(%args)}sub normalize_path {my ($self,$path)=@_;$path=(Win32::GetShortPathName($path)|| $path)if $^O eq 'MSWin32';return$path}sub build_environment_vars_for {my$self=$_[0]->new->activate($_[1]);$self->build_environment_vars}sub build_activate_environment_vars_for {my$self=$_[0]->new->activate($_[1]);$self->build_environment_vars}sub build_deactivate_environment_vars_for {my$self=$_[0]->new->deactivate($_[1]);$self->build_environment_vars}sub build_deact_all_environment_vars_for {my$self=$_[0]->new->deactivate_all;$self->build_environment_vars}sub build_environment_vars {my$self=shift;(PATH=>join($_path_sep,_as_list($self->bins)),PERL5LIB=>join($_path_sep,_as_list($self->libs)),PERL_LOCAL_LIB_ROOT=>join($_path_sep,_as_list($self->roots)),%{$self->extra},)}sub setup_local_lib_for {my$self=$_[0]->new->activate($_[1]);$self->setup_local_lib}sub setup_local_lib {my$self=shift;require Carp::Heavy if$INC{'Carp.pm'};$self->setup_env_hash;@INC=@{$self->inc}}sub setup_env_hash_for {my$self=$_[0]->new->activate($_[1]);$self->setup_env_hash}sub setup_env_hash {my$self=shift;my%env=$self->build_environment_vars;for my$key (keys%env){if (defined$env{$key}){$ENV{$key}=$env{$key}}else {delete$ENV{$key}}}}sub print_environment_vars_for {print $_[0]->environment_vars_string_for(@_[1..$#_])}sub environment_vars_string_for {my$self=$_[0]->new->activate($_[1]);$self->environment_vars_string}sub environment_vars_string {my ($self,$shelltype)=@_;$shelltype ||= $self->guess_shelltype;my$extra=$self->extra;my@envs=(PATH=>$self->bins,PERL5LIB=>$self->libs,PERL_LOCAL_LIB_ROOT=>$self->roots,map {$_=>$extra->{$_}}sort keys %$extra,);$self->_build_env_string($shelltype,\@envs)}sub _build_env_string {my ($self,$shelltype,$envs)=@_;my@envs=@$envs;my$build_method="build_${shelltype}_env_declaration";my$out='';while (@envs){my ($name,$value)=(shift(@envs),shift(@envs));if (ref$value && @$value==1 && ref$value->[0]&& ref$value->[0]eq 'SCALAR' && ${$value->[0]}eq $name){next}$out .= $self->$build_method($name,$value)}my$wrap_method="wrap_${shelltype}_output";if ($self->can($wrap_method)){return$self->$wrap_method($out)}return$out}sub build_bourne_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'${%s}',qr/["\\\$!`]/,'\\%s');if (!defined$value){return qq{unset $name;\n}}$value =~ s/(^|\G|$_path_sep)\$\{$name\}$_path_sep/$1\${$name}\${$name+$_path_sep}/g;$value =~ s/$_path_sep\$\{$name\}$/\${$name+$_path_sep}\${$name}/;qq{${name}="$value"; export ${name};\n}}sub build_csh_env_declaration {my ($class,$name,$args)=@_;my ($value,@vars)=$class->_interpolate($args,'${%s}','"','"\\%s"');if (!defined$value){return qq{unsetenv $name;\n}}my$out='';for my$var (@vars){$out .= qq{if ! \$?$name setenv $name '';\n}}my$value_without=$value;if ($value_without =~ s/(?:^|$_path_sep)\$\{$name\}(?:$_path_sep|$)//g){$out .= qq{if "\${$name}" != '' setenv $name "$value";\n};$out .= qq{if "\${$name}" == '' }}$out .= qq{setenv $name "$value_without";\n};return$out}sub build_cmd_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'%%%s%%',qr(%),'%s');if (!$value){return qq{\@set $name=\n}}my$out='';my$value_without=$value;if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g){$out .= qq{\@if not "%$name%"=="" set "$name=$value"\n};$out .= qq{\@if "%$name%"=="" }}$out .= qq{\@set "$name=$value_without"\n};return$out}sub build_powershell_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'$env:%s','"','`%s');if (!$value){return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n}}my$maybe_path_sep=qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})};$value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g;$value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/;qq{\$env:$name = \$("$value");\n}}sub wrap_powershell_output {my ($class,$out)=@_;return$out || " \n"}sub build_fish_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'$%s',qr/[\\"' ]/,'\\%s');if (!defined$value){return qq{set -e $name;\n}}$value =~ s/$_path_sep/ /g;qq{set -x $name $value;\n}}sub _interpolate {my ($class,$args,$var_pat,$escape,$escape_pat)=@_;return unless defined$args;my@args=ref$args ? @$args : $args;return unless@args;my@vars=map {$$_}grep {ref $_ eq 'SCALAR'}@args;my$string=join$_path_sep,map {ref $_ eq 'SCALAR' ? sprintf($var_pat,$$_): do {s/($escape)/sprintf($escape_pat, $1)/ge;$_}}@args;return wantarray ? ($string,\@vars): $string}sub pipeline;sub pipeline {my@methods=@_;my$last=pop(@methods);if (@methods){\sub {my ($obj,@args)=@_;$obj->${pipeline@methods}($obj->$last(@args))}}else {\sub {shift->$last(@_)}}}sub resolve_path {my ($class,$path)=@_;$path=$class->${pipeline qw(resolve_relative_path resolve_home_path resolve_empty_path)}($path);$path}sub resolve_empty_path {my ($class,$path)=@_;if (defined$path){$path}else {'~/perl5'}}sub resolve_home_path {my ($class,$path)=@_;$path =~ /^~([^\/]*)/ or return$path;my$user=$1;my$homedir=do {if (!length($user)&& defined$ENV{HOME}){$ENV{HOME}}else {require File::Glob;File::Glob::bsd_glob("~$user",File::Glob::GLOB_TILDE())}};unless (defined$homedir){require Carp;require Carp::Heavy;Carp::croak("Couldn't resolve homedir for " .(defined$user ? $user : 'current user'))}$path =~ s/^~[^\/]*/$homedir/;$path}sub resolve_relative_path {my ($class,$path)=@_;_rel2abs($path)}sub ensure_dir_structure_for {my ($class,$path)=@_;unless (-d $path){warn "Attempting to create directory ${path}\n"}require File::Basename;my@dirs;while(!-d $path){push@dirs,$path;$path=File::Basename::dirname($path)}mkdir $_ for reverse@dirs;return}sub guess_shelltype {my$shellbin =defined$ENV{SHELL}? ($ENV{SHELL}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' && exists$ENV{'!EXITCODE'})? 'bash' : ($^O eq 'MSWin32' && $ENV{PROMPT}&& $ENV{COMSPEC})? ($ENV{COMSPEC}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' &&!$ENV{PROMPT})? 'powershell.exe' : 'sh';for ($shellbin){return /csh$/ ? 'csh' : /fish/ ? 'fish' : /command(?:\.com)?$/i ? 'cmd' : /cmd(?:\.exe)?$/i ? 'cmd' : /4nt(?:\.exe)?$/i ? 'cmd' : /powershell(?:\.exe)?$/i ? 'powershell' : 'bourne'}}1;
418
+  WHOA THERE! It looks like you've got some fancy dashes in your commandline!
419
+  These are *not* the traditional -- dashes that software recognizes. You
420
+  probably got these by copy-pasting from the perldoc for this module as
421
+  rendered by a UTF8-capable formatter. This most typically happens on an OS X
422
+  terminal, but can happen elsewhere too. Please try again after replacing the
423
+  dashes with normal minus signs.
424
+  DEATH
425
+  FATAL: The local::lib --self-contained flag has never worked reliably and the
426
+  original author, Mark Stosberg, was unable or unwilling to maintain it. As
427
+  such, this flag has been removed from the local::lib codebase in order to
428
+  prevent misunderstandings and potentially broken builds. The local::lib authors
429
+  recommend that you look at the lib::core::only module shipped with this
430
+  distribution in order to create a more robust environment that is equivalent to
431
+  what --self-contained provided (although quite possibly not what you originally
432
+  thought it provided due to the poor quality of the documentation, for which we
433
+  apologise).
434
+  DEATH
435
+LOCAL_LIB
436
+
437
+$fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT';
438
+  package parent;use strict;use vars qw($VERSION);$VERSION='0.228';sub import {my$class=shift;my$inheritor=caller(0);if (@_ and $_[0]eq '-norequire'){shift @_}else {for (my@filename=@_){if ($_ eq $inheritor){warn "Class '$inheritor' tried to inherit from itself\n"};s{::|'}{/}g;require "$_.pm"}}{no strict 'refs';push @{"$inheritor\::ISA"},@_}};"All your base are belong to us" 
439
+PARENT
440
+
441
+$fatpacked{"version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION';
442
+  package version;use 5.006002;use strict;use warnings::register;if ($] >= 5.015){warnings::register_categories(qw/version/)}use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);$VERSION=0.9912;$CLASS='version';{local$SIG{'__DIE__'};if (1){eval "use version::vpp $VERSION";die "$@" if ($@);push@ISA,"version::vpp";local $^W;*version::qv=\&version::vpp::qv;*version::declare=\&version::vpp::declare;*version::_VERSION=\&version::vpp::_VERSION;*version::vcmp=\&version::vpp::vcmp;*version::new=\&version::vpp::new;*version::numify=\&version::vpp::numify;*version::normal=\&version::vpp::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vpp::stringify;*{'version::(""'}=\&version::vpp::stringify;*{'version::(<=>'}=\&version::vpp::vcmp;*version::parse=\&version::vpp::parse}}else {push@ISA,"version::vxs";local $^W;*version::declare=\&version::vxs::declare;*version::qv=\&version::vxs::qv;*version::_VERSION=\&version::vxs::_VERSION;*version::vcmp=\&version::vxs::VCMP;*version::new=\&version::vxs::new;*version::numify=\&version::vxs::numify;*version::normal=\&version::vxs::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vxs::stringify;*{'version::(""'}=\&version::vxs::stringify;*{'version::(<=>'}=\&version::vxs::VCMP;*version::parse=\&version::vxs::parse}}}require version::regex;*version::is_lax=\&version::regex::is_lax;*version::is_strict=\&version::regex::is_strict;*LAX=\$version::regex::LAX;*STRICT=\$version::regex::STRICT;sub import {no strict 'refs';my ($class)=shift;unless ($class eq $CLASS){local $^W;*{$class.'::declare'}=\&{$CLASS.'::declare'};*{$class.'::qv'}=\&{$CLASS.'::qv'}}my%args;if (@_){map {$args{$_}=1}@_}else {%args=(qv=>1,'UNIVERSAL::VERSION'=>1,)}my$callpkg=caller();if (exists($args{declare})){*{$callpkg.'::declare'}=sub {return$class->declare(shift)}unless defined(&{$callpkg.'::declare'})}if (exists($args{qv})){*{$callpkg.'::qv'}=sub {return$class->qv(shift)}unless defined(&{$callpkg.'::qv'})}if (exists($args{'UNIVERSAL::VERSION'})){local $^W;*UNIVERSAL::VERSION =\&{$CLASS.'::_VERSION'}}if (exists($args{'VERSION'})){*{$callpkg.'::VERSION'}=\&{$CLASS.'::_VERSION'}}if (exists($args{'is_strict'})){*{$callpkg.'::is_strict'}=\&{$CLASS.'::is_strict'}unless defined(&{$callpkg.'::is_strict'})}if (exists($args{'is_lax'})){*{$callpkg.'::is_lax'}=\&{$CLASS.'::is_lax'}unless defined(&{$callpkg.'::is_lax'})}}1;
443
+VERSION
444
+
445
+$fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX';
446
+  package version::regex;use strict;use vars qw($VERSION $CLASS $STRICT $LAX);$VERSION=0.9912;my$FRACTION_PART=qr/\.[0-9]+/;my$STRICT_INTEGER_PART=qr/0|[1-9][0-9]*/;my$LAX_INTEGER_PART=qr/[0-9]+/;my$STRICT_DOTTED_DECIMAL_PART=qr/\.[0-9]{1,3}/;my$LAX_DOTTED_DECIMAL_PART=qr/\.[0-9]+/;my$LAX_ALPHA_PART=qr/_[0-9]+/;my$STRICT_DECIMAL_VERSION=qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;my$STRICT_DOTTED_DECIMAL_VERSION=qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;$STRICT=qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;my$LAX_DECIMAL_VERSION=qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
447
+  	|
448
+  	$FRACTION_PART $LAX_ALPHA_PART?
449
+      /x;my$LAX_DOTTED_DECIMAL_VERSION=qr/
450
+  	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
451
+  	|
452
+  	$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
453
+      /x;$LAX=qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;sub is_strict {defined $_[0]&& $_[0]=~ qr/ \A $STRICT \z /x}sub is_lax {defined $_[0]&& $_[0]=~ qr/ \A $LAX \z /x}1;
454
+VERSION_REGEX
455
+
456
+$fatpacked{"version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VPP';
457
+  package charstar;use overload ('""'=>\&thischar,'0+'=>\&thischar,'++'=>\&increment,'--'=>\&decrement,'+'=>\&plus,'-'=>\&minus,'*'=>\&multiply,'cmp'=>\&cmp,'<=>'=>\&spaceship,'bool'=>\&thischar,'='=>\&clone,);sub new {my ($self,$string)=@_;my$class=ref($self)|| $self;my$obj={string=>[split(//,$string)],current=>0,};return bless$obj,$class}sub thischar {my ($self)=@_;my$last=$#{$self->{string}};my$curr=$self->{current};if ($curr >= 0 && $curr <= $last){return$self->{string}->[$curr]}else {return ''}}sub increment {my ($self)=@_;$self->{current}++}sub decrement {my ($self)=@_;$self->{current}--}sub plus {my ($self,$offset)=@_;my$rself=$self->clone;$rself->{current}+= $offset;return$rself}sub minus {my ($self,$offset)=@_;my$rself=$self->clone;$rself->{current}-= $offset;return$rself}sub multiply {my ($left,$right,$swapped)=@_;my$char=$left->thischar();return$char * $right}sub spaceship {my ($left,$right,$swapped)=@_;unless (ref($right)){$right=$left->new($right)}return$left->{current}<=> $right->{current}}sub cmp {my ($left,$right,$swapped)=@_;unless (ref($right)){if (length($right)==1){return$left->thischar cmp $right}$right=$left->new($right)}return$left->currstr cmp $right->currstr}sub bool {my ($self)=@_;my$char=$self->thischar;return ($char ne '')}sub clone {my ($left,$right,$swapped)=@_;$right={string=>[@{$left->{string}}],current=>$left->{current},};return bless$right,ref($left)}sub currstr {my ($self,$s)=@_;my$curr=$self->{current};my$last=$#{$self->{string}};if (defined($s)&& $s->{current}< $last){$last=$s->{current}}my$string=join('',@{$self->{string}}[$curr..$last]);return$string}package version::vpp;use 5.006002;use strict;use warnings::register;use Config;use vars qw($VERSION $CLASS @ISA $LAX $STRICT $WARN_CATEGORY);$VERSION=0.9912;$CLASS='version::vpp';if ($] > 5.015){warnings::register_categories(qw/version/);$WARN_CATEGORY='version'}else {$WARN_CATEGORY='numeric'}require version::regex;*version::vpp::is_strict=\&version::regex::is_strict;*version::vpp::is_lax=\&version::regex::is_lax;*LAX=\$version::regex::LAX;*STRICT=\$version::regex::STRICT;use overload ('""'=>\&stringify,'0+'=>\&numify,'cmp'=>\&vcmp,'<=>'=>\&vcmp,'bool'=>\&vbool,'+'=>\&vnoop,'-'=>\&vnoop,'*'=>\&vnoop,'/'=>\&vnoop,'+='=>\&vnoop,'-='=>\&vnoop,'*='=>\&vnoop,'/='=>\&vnoop,'abs'=>\&vnoop,);sub import {no strict 'refs';my ($class)=shift;unless ($class eq $CLASS){local $^W;*{$class.'::declare'}=\&{$CLASS.'::declare'};*{$class.'::qv'}=\&{$CLASS.'::qv'}}my%args;if (@_){map {$args{$_}=1}@_}else {%args=(qv=>1,'UNIVERSAL::VERSION'=>1,)}my$callpkg=caller();if (exists($args{declare})){*{$callpkg.'::declare'}=sub {return$class->declare(shift)}unless defined(&{$callpkg.'::declare'})}if (exists($args{qv})){*{$callpkg.'::qv'}=sub {return$class->qv(shift)}unless defined(&{$callpkg.'::qv'})}if (exists($args{'UNIVERSAL::VERSION'})){no warnings qw/redefine/;*UNIVERSAL::VERSION =\&{$CLASS.'::_VERSION'}}if (exists($args{'VERSION'})){*{$callpkg.'::VERSION'}=\&{$CLASS.'::_VERSION'}}if (exists($args{'is_strict'})){*{$callpkg.'::is_strict'}=\&{$CLASS.'::is_strict'}unless defined(&{$callpkg.'::is_strict'})}if (exists($args{'is_lax'})){*{$callpkg.'::is_lax'}=\&{$CLASS.'::is_lax'}unless defined(&{$callpkg.'::is_lax'})}}my$VERSION_MAX=0x7FFFFFFF;use constant TRUE=>1;use constant FALSE=>0;sub isDIGIT {my ($char)=shift->thischar();return ($char =~ /\d/)}sub isALPHA {my ($char)=shift->thischar();return ($char =~ /[a-zA-Z]/)}sub isSPACE {my ($char)=shift->thischar();return ($char =~ /\s/)}sub BADVERSION {my ($s,$errstr,$error)=@_;if ($errstr){$$errstr=$error}return$s}sub prescan_version {my ($s,$strict,$errstr,$sqv,$ssaw_decimal,$swidth,$salpha)=@_;my$qv=defined$sqv ? $$sqv : FALSE;my$saw_decimal=defined$ssaw_decimal ? $$ssaw_decimal : 0;my$width=defined$swidth ? $$swidth : 3;my$alpha=defined$salpha ? $$salpha : FALSE;my$d=$s;if ($qv && isDIGIT($d)){goto dotted_decimal_version}if ($d eq 'v'){$d++;if (isDIGIT($d)){$qv=TRUE}else {return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)")}dotted_decimal_version: if ($strict && $d eq '0' && isDIGIT($d+1)){return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)")}while (isDIGIT($d)){$d++}if ($d eq '.'){$saw_decimal++;$d++}else {if ($strict){return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)")}else {goto version_prescan_finish}}{my$i=0;my$j=0;while (isDIGIT($d)){$i++;while (isDIGIT($d)){$d++;$j++;if ($strict && $j > 3){return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)")}}if ($d eq '_'){if ($strict){return BADVERSION($s,$errstr,"Invalid version format (no underscores)")}if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)")}$d++;$alpha=TRUE}elsif ($d eq '.'){if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)")}$saw_decimal++;$d++}elsif (!isDIGIT($d)){last}$j=0}if ($strict && $i < 2){return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)")}}}else {my$j=0;if ($strict){if ($d eq '.'){return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)")}if ($d eq '0' && isDIGIT($d+1)){return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)")}}if ($d eq '-'){return BADVERSION($s,$errstr,"Invalid version format (negative version number)")}while (isDIGIT($d)){$d++}if ($d eq '.'){$saw_decimal++;$d++}elsif (!$d || $d eq ';' || isSPACE($d)|| $d eq '}'){if ($d==$s){return BADVERSION($s,$errstr,"Invalid version format (version required)")}goto version_prescan_finish}elsif ($d==$s){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}elsif ($d eq '_'){if ($strict){return BADVERSION($s,$errstr,"Invalid version format (no underscores)")}elsif (isDIGIT($d+1)){return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)")}else {return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)")}}elsif ($d){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}if ($d &&!isDIGIT($d)&& ($strict ||!($d eq ';' || isSPACE($d)|| $d eq '}'))){return BADVERSION($s,$errstr,"Invalid version format (fractional part required)")}while (isDIGIT($d)){$d++;$j++;if ($d eq '.' && isDIGIT($d-1)){if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)")}if ($strict){return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')")}$d=$s;$qv=TRUE;goto dotted_decimal_version}if ($d eq '_'){if ($strict){return BADVERSION($s,$errstr,"Invalid version format (no underscores)")}if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)")}if (!isDIGIT($d+1)){return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)")}$width=$j;$d++;$alpha=TRUE}}}version_prescan_finish: while (isSPACE($d)){$d++}if ($d &&!isDIGIT($d)&& (!($d eq ';' || $d eq '}'))){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}if ($saw_decimal > 1 && ($d-1)eq '.'){return BADVERSION($s,$errstr,"Invalid version format (trailing decimal)")}if (defined$sqv){$$sqv=$qv}if (defined$swidth){$$swidth=$width}if (defined$ssaw_decimal){$$ssaw_decimal=$saw_decimal}if (defined$salpha){$$salpha=$alpha}return$d}sub scan_version {my ($s,$rv,$qv)=@_;my$start;my$pos;my$last;my$errstr;my$saw_decimal=0;my$width=3;my$alpha=FALSE;my$vinf=FALSE;my@av;$s=new charstar$s;while (isSPACE($s)){$s++}$last=prescan_version($s,FALSE,\$errstr,\$qv,\$saw_decimal,\$width,\$alpha);if ($errstr){if ($s ne 'undef'){require Carp;Carp::croak($errstr)}}$start=$s;if ($s eq 'v'){$s++}$pos=$s;if ($qv){$$rv->{qv}=$qv}if ($alpha){$$rv->{alpha}=$alpha}if (!$qv && $width < 3){$$rv->{width}=$width}while (isDIGIT($pos)){$pos++}if (!isALPHA($pos)){my$rev;for (;;){$rev=0;{my$end=$pos;my$mult=1;my$orev;if (!$qv && $s > $start && $saw_decimal==1){$mult *= 100;while ($s < $end){$orev=$rev;$rev += $s * $mult;$mult /= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version %d",$VERSION_MAX);$s=$end - 1;$rev=$VERSION_MAX;$vinf=1}$s++;if ($s eq '_'){$s++}}}else {while (--$end >= $s){$orev=$rev;$rev += $end * $mult;$mult *= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version");$end=$s - 1;$rev=$VERSION_MAX;$vinf=1}}}}push@av,$rev;if ($vinf){$s=$last;last}elsif ($pos eq '.'){$pos++;if ($qv){while ($pos eq '0'){$pos++}}$s=$pos}elsif ($pos eq '_' && isDIGIT($pos+1)){$s=++$pos}elsif ($pos eq ',' && isDIGIT($pos+1)){$s=++$pos}elsif (isDIGIT($pos)){$s=$pos}else {$s=$pos;last}if ($qv){while (isDIGIT($pos)){$pos++}}else {my$digits=0;while ((isDIGIT($pos)|| $pos eq '_')&& $digits < 3){if ($pos ne '_'){$digits++}$pos++}}}}if ($qv){my$len=$#av;$len=2 - $len;while ($len-- > 0){push@av,0}}if ($vinf){$$rv->{original}="v.Inf";$$rv->{vinf}=1}elsif ($s > $start){$$rv->{original}=$start->currstr($s);if ($qv && $saw_decimal==1 && $start ne 'v'){$$rv->{original}='v' .$$rv->{original}}}else {$$rv->{original}='0';push(@av,0)}$$rv->{version}=\@av;if ($s eq 'undef'){$s += 5}return$s}sub new {my$class=shift;unless (defined$class or $#_ > 1){require Carp;Carp::croak('Usage: version::new(class, version)')}my$self=bless ({},ref ($class)|| $class);my$qv=FALSE;if ($#_==1){$qv=TRUE}my$value=pop;if (ref($value)&& eval('$value->isa("version")')){$self->{version}=[@{$value->{version}}];$self->{qv}=1 if$value->{qv};$self->{alpha}=1 if$value->{alpha};$self->{original}=''.$value->{original};return$self}if (not defined$value or $value =~ /^undef$/){push @{$self->{version}},0;$self->{original}="0";return ($self)}if (ref($value)=~ m/ARRAY|HASH/){require Carp;Carp::croak("Invalid version format (non-numeric data)")}$value=_un_vstring($value);if ($Config{d_setlocale}){use POSIX qw/locale_h/;use if$Config{d_setlocale},'locale';my$currlocale=setlocale(LC_ALL);if (localeconv()->{decimal_point}eq ','){$value =~ tr/,/./}}if ($value =~ /\d+.?\d*e[-+]?\d+/){$value=sprintf("%.9f",$value);$value =~ s/(0+)$//}my$s=scan_version($value,\$self,$qv);if ($s){warn("Version string '%s' contains invalid data; " ."ignoring: '%s'",$value,$s)}return ($self)}*parse=\&new;sub numify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$width=$self->{width}|| 3;my$alpha=$self->{alpha}|| "";my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("%d.",$digit);if ($alpha and warnings::enabled()){warnings::warn($WARN_CATEGORY,'alpha->numify() is lossy')}for (my$i=1 ;$i < $len ;$i++ ){$digit=$self->{version}[$i];if ($width < 3){my$denom=10**(3-$width);my$quot=int($digit/$denom);my$rem=$digit - ($quot * $denom);$string .= sprintf("%0".$width."d_%d",$quot,$rem)}else {$string .= sprintf("%03d",$digit)}}if ($len > 0){$digit=$self->{version}[$len];if ($alpha && $width==3){$string .= "_"}$string .= sprintf("%0".$width."d",$digit)}else {$string .= sprintf("000")}return$string}sub normal {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$alpha=$self->{alpha}|| "";my$qv=$self->{qv}|| "";my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("v%d",$digit);for (my$i=1 ;$i < $len ;$i++ ){$digit=$self->{version}[$i];$string .= sprintf(".%d",$digit)}if ($len > 0){$digit=$self->{version}[$len];if ($alpha){$string .= sprintf("_%0d",$digit)}else {$string .= sprintf(".%0d",$digit)}}if ($len <= 2){for ($len=2 - $len;$len!=0;$len-- ){$string .= sprintf(".%0d",0)}}return$string}sub stringify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}return exists$self->{original}? $self->{original}: exists$self->{qv}? $self->normal : $self->numify}sub vcmp {require UNIVERSAL;my ($left,$right,$swap)=@_;my$class=ref($left);unless (UNIVERSAL::isa($right,$class)){$right=$class->new($right)}if ($swap){($left,$right)=($right,$left)}unless (_verify($left)){require Carp;Carp::croak("Invalid version object")}unless (_verify($right)){require Carp;Carp::croak("Invalid version format")}my$l=$#{$left->{version}};my$r=$#{$right->{version}};my$m=$l < $r ? $l : $r;my$lalpha=$left->is_alpha;my$ralpha=$right->is_alpha;my$retval=0;my$i=0;while ($i <= $m && $retval==0){$retval=$left->{version}[$i]<=> $right->{version}[$i];$i++}if ($retval==0 && $l==$r && $left->{version}[$m]==$right->{version}[$m]&& ($lalpha || $ralpha)){if ($lalpha &&!$ralpha){$retval=-1}elsif ($ralpha &&!$lalpha){$retval=+1}}if ($retval==0 && $l!=$r){if ($l < $r){while ($i <= $r && $retval==0){if ($right->{version}[$i]!=0){$retval=-1}$i++}}else {while ($i <= $l && $retval==0){if ($left->{version}[$i]!=0){$retval=+1}$i++}}}return$retval}sub vbool {my ($self)=@_;return vcmp($self,$self->new("0"),1)}sub vnoop {require Carp;Carp::croak("operation not supported with version object")}sub is_alpha {my ($self)=@_;return (exists$self->{alpha})}sub qv {my$value=shift;my$class=$CLASS;if (@_){$class=ref($value)|| $value;$value=shift}$value=_un_vstring($value);$value='v'.$value unless$value =~ /(^v|\d+\.\d+\.\d)/;my$obj=$CLASS->new($value);return bless$obj,$class}*declare=\&qv;sub is_qv {my ($self)=@_;return (exists$self->{qv})}sub _verify {my ($self)=@_;if (ref($self)&& eval {exists$self->{version}}&& ref($self->{version})eq 'ARRAY'){return 1}else {return 0}}sub _is_non_alphanumeric {my$s=shift;$s=new charstar$s;while ($s){return 0 if isSPACE($s);return 1 unless (isALPHA($s)|| isDIGIT($s)|| $s =~ /[.-]/);$s++}return 0}sub _un_vstring {my$value=shift;if (length($value)>= 1 && $value !~ /[,._]/ && _is_non_alphanumeric($value)){my$tvalue;if ($] >= 5.008_001){$tvalue=_find_magic_vstring($value);$value=$tvalue if length$tvalue}elsif ($] >= 5.006_000){$tvalue=sprintf("v%vd",$value);if ($tvalue =~ /^v\d+(\.\d+)*$/){$value=$tvalue}}}return$value}sub _find_magic_vstring {my$value=shift;my$tvalue='';require B;my$sv=B::svref_2object(\$value);my$magic=ref($sv)eq 'B::PVMG' ? $sv->MAGIC : undef;while ($magic){if ($magic->TYPE eq 'V'){$tvalue=$magic->PTR;$tvalue =~ s/^v?(.+)$/v$1/;last}else {$magic=$magic->MOREMAGIC}}return$tvalue}sub _VERSION {my ($obj,$req)=@_;my$class=ref($obj)|| $obj;no strict 'refs';if (exists$INC{"$class.pm"}and not %{"$class\::"}and $] >= 5.008){require Carp;Carp::croak("$class defines neither package nor VERSION" ."--version check failed")}my$version=eval "\$$class\::VERSION";if (defined$version){local $^W if $] <= 5.008;$version=version::vpp->new($version)}if (defined$req){unless (defined$version){require Carp;my$msg=$] < 5.006 ? "$class version $req required--this is only version " : "$class does not define \$$class\::VERSION" ."--version check failed";if ($ENV{VERSION_DEBUG}){Carp::confess($msg)}else {Carp::croak($msg)}}$req=version::vpp->new($req);if ($req > $version){require Carp;if ($req->is_qv){Carp::croak(sprintf ("%s version %s required--"."this is only version %s",$class,$req->normal,$version->normal))}else {Carp::croak(sprintf ("%s version %s required--"."this is only version %s",$class,$req->stringify,$version->stringify))}}}return defined$version ? $version->stringify : undef}1;
12159 458
 VERSION_VPP
12160 459
 
12161 460
 s/^  //mg for values %fatpacked;
12162 461
 
12163
-unshift @INC, sub {
12164
-  if (my $fat = $fatpacked{$_[1]}) {
12165
-    if ($] < 5.008) {
12166
-      return sub {
12167
-        return 0 unless length $fat;
12168
-        $fat =~ s/^([^\n]*\n?)//;
12169
-        $_ = $1;
462
+my $class = 'FatPacked::'.(0+\%fatpacked);
463
+no strict 'refs';
464
+*{"${class}::files"} = sub { keys %{$_[0]} };
465
+
466
+if ($] < 5.008) {
467
+  *{"${class}::INC"} = sub {
468
+    if (my $fat = $_[0]{$_[1]}) {
469
+      my $pos = 0;
470
+      my $last = length $fat;
471
+      return (sub {
472
+        return 0 if $pos == $last;
473
+        my $next = (1 + index $fat, "\n", $pos) || $last;
474
+        $_ .= substr $fat, $pos, $next - $pos;
475
+        $pos = $next;
12170 476
         return 1;
12171
-      };
477
+      });
12172 478
     }
12173
-    open my $fh, '<', \$fat
12174
-      or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
12175
-    return $fh;
12176
-  }
12177
-  return
12178
-};
479
+  };
480
+}
481
+
482
+else {
483
+  *{"${class}::INC"} = sub {
484
+    if (my $fat = $_[0]{$_[1]}) {
485
+      open my $fh, '<', \$fat
486
+        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
487
+      return $fh;
488
+    }
489
+    return;
490
+  };
491
+}
492
+
493
+unshift @INC, bless \%fatpacked, $class;
494
+  } # END OF FATPACK CODE
495
+
12179 496
 
12180
-} # END OF FATPACK CODE
12181 497
 
12182 498
 use strict;
12183 499
 use App::cpanminus::script;
12184 500
 
501
+
12185 502
 unless (caller) {
12186 503
     my $app = App::cpanminus::script->new;
12187 504
     $app->parse_options(@ARGV);
12188
-    $app->doit or exit(1);
505
+    exit $app->doit;
12189 506
 }
12190 507
 
12191 508
 __END__
... ...
@@ -12205,7 +522,7 @@ cpanm - get, unpack build and install modules from CPAN
12205 522
   cpanm --installdeps .                            # install all the deps for the current directory
12206 523
   cpanm -L extlib Plack                            # install Plack and all non-core deps into extlib
12207 524
   cpanm --mirror http://cpan.cpantesters.org/ DBI  # use the fast-syncing mirror
12208
-  cpanm --scandeps Moose                           # See what modules will be installed for Moose
525
+  cpanm --from https://cpan.metacpan.org/ Plack    # use only the HTTPS mirror
12209 526
 
12210 527
 =head1 COMMANDS
12211 528
 
... ...
@@ -12222,7 +539,7 @@ will all work as you expect.
12222 539
     cpanm MIYAGAWA/Plack-1.0000.tar.gz
12223 540
     cpanm /path/to/Plack-1.0000.tar.gz
12224 541
     cpanm http://cpan.metacpan.org/authors/id/M/MI/MIYAGAWA/Plack-0.9990.tar.gz
12225
-    cpanm git://github.com/miyagawa/Plack.git
542
+    cpanm git://github.com/plack/Plack.git
12226 543
 
12227 544
 Additionally, you can use the notation using C<~> and C<@> to specify
12228 545
 version for a given module. C<~> specifies the version requirement in
... ...
@@ -12241,8 +558,8 @@ which case, archived versions will be filtered out.
12241 558
 For a git repository, you can specify a branch, tag, or commit SHA to
12242 559
 build. The default is C<master>
12243 560
 
12244
-    cpanm git://github.com/miyagawa/Plack.git@1.0000        # tag
12245
-    cpanm git://github.com/miyagawa/Plack.git@devel         # branch
561
+    cpanm git://github.com/plack/Plack.git@1.0000        # tag
562
+    cpanm git://github.com/plack/Plack.git@devel         # branch
12246 563
 
12247 564
 =item -i, --install
12248 565
 
... ...
@@ -12328,8 +645,8 @@ configuration. (See --interactive)
12328 645
 
12329 646
 =item -q, --quiet
12330 647
 
12331
-Makes the output even more quiet than the default. It doesn't print
12332
-anything to the STDERR.
648
+Makes the output even more quiet than the default. It only shows the
649
+successful/failed dependencies to the output.
12333 650
 
12334 651
 =item -l, --local-lib
12335 652
 
... ...
@@ -12340,10 +657,9 @@ as well.
12340 657
 
12341 658
 =item -L, --local-lib-contained
12342 659
 
12343
-Same with C<--local-lib> but when examining the dependencies, it
12344
-assumes no non-core modules are installed on the system. It's handy if
12345
-you want to bundle application dependencies in one directory so you
12346
-can distribute to other machines.
660
+Same with C<--local-lib> but with L<--self-contained> set.  All
661
+non-core dependencies will be installed even if they're already
662
+installed.
12347 663
 
12348 664
 For instance,
12349 665
 
... ...
@@ -12354,6 +670,24 @@ directory C<extlib>, which can be loaded from your application with:
12354 670
 
12355 671
   use local::lib '/path/to/extlib';
12356 672
 
673
+Note that this option does B<NOT> reliably work with perl installations
674
+supplied by operating system vendors that strips standard modules from perl,
675
+such as RHEL, Fedora and CentOS, B<UNLESS> you also install packages supplying
676
+all the modules that have been stripped.  For these systems you will probably
677
+want to install the C<perl-core> meta-package which does just that.
678
+
679
+=item --self-contained
680
+
681
+When examining the dependencies, assume no non-core modules are
682
+installed on the system. Handy if you want to bundle application
683
+dependencies in one directory so you can distribute to other machines.
684
+
685
+=item --exclude-vendor
686
+
687
+Don't include modules installed under the 'vendor' paths when searching for
688
+core modules when the C<--self-contained> flag is in effect.  This restores
689
+the behaviour from before version 1.7023
690
+
12357 691
 =item --mirror
12358 692
 
12359 693
 Specifies the base URL for the CPAN mirror to use, such as
... ...
@@ -12368,28 +702,58 @@ scheme), it is considered as a file scheme as well.
12368 702
   cpanm --mirror file:///path/to/mirror
12369 703
   cpanm --mirror ~/minicpan      # Because shell expands ~ to /home/user
12370 704
 
12371
-Defaults to C<http://search.cpan.org/CPAN> which is a geo location
12372
-aware redirector.
705
+Defaults to C<http://www.cpan.org/>.
12373 706
 
12374 707
 =item --mirror-only
12375 708
 
12376 709
 Download the mirror's 02packages.details.txt.gz index file instead of
12377
-querying the CPAN Meta DB.
710
+querying the CPAN Meta DB. This will also effectively opt out sending
711
+your local perl versions to backend database servers such as CPAN Meta
712
+DB and MetaCPAN.
12378 713
 
12379 714
 Select this option if you are using a local mirror of CPAN, such as
12380 715
 minicpan when you're offline, or your own CPAN index (a.k.a darkpan).
12381 716
 
12382
-B<Tip:> It might be useful if you name these mirror options with your
12383
-shell aliases, like:
717
+=item --from, -M
718
+
719
+  cpanm -M https://cpan.metacpan.org/
720
+  cpanm --from https://cpan.metacpan.org/
721
+
722
+Use the given mirror URL and its index as the I<only> source to search
723
+and download modules from.
12384 724
 
12385
-  alias minicpanm='cpanm --mirror ~/minicpan --mirror-only'
12386
-  alias darkpan='cpanm --mirror http://mycompany.example.com/DPAN --mirror-only'
725
+It works similar to C<--mirror> and C<--mirror-only> combined, with a
726
+small difference: unlike C<--mirror> which I<appends> the URL to the
727
+list of mirrors, C<--from> (or C<-M> for short) uses the specified URL
728
+as its I<only> source to download index and modules from. This makes
729
+the option always override the default mirror, which might have been
730
+set via global options such as the one set by C<PERL_CPANM_OPT>
731
+environment variable.
732
+
733
+B<Tip:> It might be useful if you name these options with your shell
734
+aliases, like:
735
+
736
+  alias minicpanm='cpanm --from ~/minicpan'
737
+  alias darkpan='cpanm --from http://mycompany.example.com/DPAN'
12387 738
 
12388 739
 =item --mirror-index
12389 740
 
12390 741
 B<EXPERIMENTAL>: Specifies the file path to C<02packages.details.txt>
12391 742
 for module search index.
12392 743
 
744
+=item --cpanmetadb
745
+
746
+B<EXPERIMENTAL>: Specifies an alternate URI for CPAN MetaDB index lookups.
747
+
748
+=item --metacpan
749
+
750
+Prefers MetaCPAN API over CPAN MetaDB.
751
+
752
+=item --cpanfile
753
+
754
+B<EXPERIMENTAL>: Specified an alternate path for cpanfile to search for,
755
+when C<--installdeps> command is in use. Defaults to C<cpanfile>.
756
+
12393 757
 =item --prompt
12394 758
 
12395 759
 Prompts when a test fails so that you can skip, force install, retry
... ...
@@ -12426,10 +790,67 @@ requires custom configuration or Task:: distributions.
12426 790
 Defaults to false, and you can say C<--no-interactive> to override
12427 791
 when it's set in the default options in C<PERL_CPANM_OPT>.
12428 792
 
793
+=item --pp, --pureperl
794
+
795
+Prefer Pure perl build of modules by setting C<PUREPERL_ONLY=1> for
796
+MakeMaker and C<--pureperl-only> for Build.PL based
797
+distributions. Note that not all of the CPAN modules support this
798
+convention yet.
799
+
800
+=item --with-recommends, --with-suggests
801
+
802
+B<EXPERIMENTAL>: Installs dependencies declared as C<recommends> and
803
+C<suggests> respectively, per META spec. When these dependencies fail
804
+to install, cpanm continues the installation, since they're just
805
+recommendation/suggestion.
806
+
807
+Enabling this could potentially make a circular dependency for a few
808
+modules on CPAN, when C<recommends> adds a module that C<recommends>
809
+back the module in return.
810
+
811
+There's also C<--without-recommend> and C<--without-suggests> to
812
+override the default decision made earlier in C<PERL_CPANM_OPT>.
813
+
814
+Defaults to false for both.
815
+
816
+=item --with-develop
817
+
818
+B<EXPERIMENTAL>: Installs develop phase dependencies in META files or
819
+C<cpanfile> when used with C<--installdeps>. Defaults to false.
820
+
821
+=item --with-feature, --without-feature, --with-all-features
822
+
823
+B<EXPERIMENTAL>: Specifies the feature to enable, if a module supports
824
+optional features per META spec 2.0.
825
+
826
+    cpanm --with-feature=opt_csv Spreadsheet::Read
827
+
828
+the features can also be interactively chosen when C<--interactive>
829
+option is enabled.
830
+
831
+C<--with-all-features> enables all the optional features, and
832
+C<--without-feature> can select a feature to disable.
833
+
834
+=item --configure-timeout, --build-timeout, --test-timeout
835
+
836
+Specify the timeout length (in seconds) to wait for the configure,
837
+build and test process. Current default values are: 60 for configure,
838
+3600 for build and 1800 for test.
839
+
840
+=item --configure-args, --build-args, --test-args, --install-args
841
+
842
+B<EXPERIMENTAL>: Pass arguments for configure/build/test/install
843
+commands respectively, for a given module to install.
844
+
845
+    cpanm DBD::mysql --configure-args="--cflags=... --libs=..."
846
+
847
+The argument is only enabled for the module passed as a command line
848
+argument, not dependencies.
849
+
12429 850
 =item --scandeps
12430 851
 
12431
-Scans the depencencies of given modules and output the tree in a text
12432
-format. (See C<--format> below for more options)
852
+B<DEPRECATED>: Scans the depencencies of given modules and output the
853
+tree in a text format. (See C<--format> below for more options)
12433 854
 
12434 855
 Because this command doesn't actually install any distributions, it
12435 856
 will be useful that by typing:
... ...
@@ -12445,8 +866,9 @@ combine it with C<-L> option.
12445 866
 
12446 867
 =item --format
12447 868
 
12448
-Determines what format to display the scanned dependency
12449
-tree. Available options are C<tree>, C<json>, C<yaml> and C<dists>.
869
+B<DEPRECATED>: Determines what format to display the scanned
870
+dependency tree. Available options are C<tree>, C<json>, C<yaml> and
871
+C<dists>.
12450 872
 
12451 873
 =over 8
12452 874
 
... ...
@@ -12490,6 +912,10 @@ Specifies the optional directory path to copy downloaded tarballs in
12490 912
 the CPAN mirror compatible directory structure
12491 913
 i.e. I<authors/id/A/AU/AUTHORS/Foo-Bar-version.tar.gz>
12492 914
 
915
+If the distro tarball did not come from CPAN, for example from a local
916
+file or from GitHub, then it will be saved under
917
+I<vendor/Foo-Bar-version.tar.gz>.
918
+
12493 919
 =item --uninst-shadows
12494 920
 
12495 921
 Uninstalls the shadow files of the distribution that you're
... ...
@@ -12512,6 +938,22 @@ I<before> the perl core library path, and uninstalling shadows is not
12512 938
 necessary anymore and does more harm by deleting files from the core
12513 939
 library path.
12514 940
 
941
+=item --uninstall, -U
942
+
943
+Uninstalls a module from the library path. It finds a packlist for
944
+given modules, and removes all the files included in the same
945
+distribution.
946
+
947
+If you enable local::lib, it only removes files from the local::lib
948
+directory.
949
+
950
+If you try to uninstall a module in C<perl> directory (i.e. core
951
+module), an error will be thrown.
952
+
953
+A dialog will be prompted to confirm the files to be deleted. If you pass
954
+C<-f> option as well, the dialog will be skipped and uninstallation
955
+will be forced.
956
+
12515 957
 =item --cascade-search
12516 958
 
12517 959
 B<EXPERIMENTAL>: Specifies whether to cascade search when you specify
... ...
@@ -12523,8 +965,9 @@ version of the module than requested. Defaults to false.
12523 965
 Specifies whether a module given in the command line is skipped if its latest
12524 966
 version is already installed. Defaults to true.
12525 967
 
12526
-B<NOTE>: The C<PERL5LIB> environment variable have to be correctly set for this
12527
-to work with modules installed using L<local::lib>.
968
+B<NOTE>: The C<PERL5LIB> environment variable have to be correctly set
969
+for this to work with modules installed using L<local::lib>, unless
970
+you always use the C<-l> option.
12528 971
 
12529 972
 =item --skip-satisfied
12530 973
 
... ...
@@ -12548,6 +991,13 @@ Defaults to false.
12548 991
 Verify the integrity of distribution files retrieved from PAUSE using
12549 992
 CHECKSUMS and SIGNATURES (if found). Defaults to false.
12550 993
 
994
+=item --report-perl-version
995
+
996
+Whether it reports the locally installed perl version to the various
997
+web server as part of User-Agent. Defaults to true unless CI related
998
+environment variables such as C<TRAVIS>, C<CI> or C<AUTOMATED_TESTING>
999
+is enabled. You can disable it by using C<--no-report-perl-version>.
1000
+
12551 1001
 =item --auto-cleanup
12552 1002
 
12553 1003
 Specifies the number of days in which cpanm's work directories
... ...
@@ -12561,9 +1011,9 @@ directories.
12561 1011
 
12562 1012
 Generates man pages for executables (man1) and libraries (man3).
12563 1013
 
12564
-Defaults to false (no man pages generated) if
12565
-C<-L|--local-lib-contained> option is supplied. Otherwise, defaults to
12566
-true, and you can disable it with C<--no-man-pages>.
1014
+Defaults to true (man pages generated) unless C<-L|--local-lib-contained>
1015
+option is supplied in which case it's set to false. You can disable
1016
+it with C<--no-man-pages>.
12567 1017
 
12568 1018
 =item --lwp
12569 1019
 
... ...
@@ -12594,7 +1044,7 @@ L<App::cpanminus>
12594 1044
 
12595 1045
 =head1 COPYRIGHT
12596 1046
 
12597
-Copyright 2010 Tatsuhiko Miyagawa.
1047
+Copyright 2010- Tatsuhiko Miyagawa.
12598 1048
 
12599 1049
 =head1 AUTHOR
12600 1050
 
+2 -2
setup.sh
... ...
@@ -2,5 +2,5 @@
2 2
 CUR_DIR_ABS=$(cd $(dirname $0); pwd)
3 3
 export PERL_CPANM_HOME=$CUR_DIR_ABS/setup
4 4
 perl cpanm -n -l extlib Module::CoreList
5
-perl -Iextlib/lib/perl5 cpanm -nf -L extlib Mojolicious@6.57
6
-perl -Iextlib/lib/perl5 cpanm -n -L extlib --installdeps .
5
+perl -Iextlib/lib/perl5 cpanm -f -L extlib ExtUtils::MakeMaker
6
+perl -Iextlib/lib/perl5 cpanm -L extlib --installdeps .