forked from OreosLab/checkinpanel
-
Notifications
You must be signed in to change notification settings - Fork 0
/
cpm
1542 lines (1333 loc) · 759 KB
/
cpm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/env perl
use 5.8.1;
# The following distributions are embedded into this script:
#
# [
# {
# "copyright" : "Infinity Interactive, Inc.",
# "license" : "the same as Perl 5",
# "name" : "Algorithm-C3",
# "url" : "https://metacpan.org/release/Algorithm-C3"
# },
# {
# "copyright" : "Shoichi Kaji",
# "license" : "the same as Perl 5",
# "name" : "CPAN-02Packages-Search",
# "url" : "https://metacpan.org/release/CPAN-02Packages-Search"
# },
# {
# "copyright" : "Graham Barr",
# "license" : "the same as Perl 5",
# "name" : "CPAN-DistnameInfo",
# "url" : "https://metacpan.org/release/CPAN-DistnameInfo"
# },
# {
# "copyright" : "David Golden, Ricardo Signes, Adam Kennedy and Contributors",
# "license" : "the same as Perl 5",
# "name" : "CPAN-Meta",
# "url" : "https://metacpan.org/release/CPAN-Meta"
# },
# {
# "copyright" : "Leon Timmermans",
# "license" : "the same as Perl 5",
# "name" : "CPAN-Meta-Check",
# "url" : "https://metacpan.org/release/CPAN-Meta-Check"
# },
# {
# "copyright" : "David Golden and Ricardo Signes",
# "license" : "the same as Perl 5",
# "name" : "CPAN-Meta-Requirements",
# "url" : "https://metacpan.org/release/CPAN-Meta-Requirements"
# },
# {
# "copyright" : "Adam Kennedy",
# "license" : "the same as Perl 5",
# "name" : "CPAN-Meta-YAML",
# "url" : "https://metacpan.org/release/CPAN-Meta-YAML"
# },
# {
# "copyright" : "David Golden",
# "license" : "Apache 2.0",
# "name" : "Capture-Tiny",
# "url" : "https://metacpan.org/release/Capture-Tiny"
# },
# {
# "copyright" : "Infinity Interactive, Inc.",
# "license" : "the same as Perl 5",
# "name" : "Class-C3",
# "url" : "https://metacpan.org/release/Class-C3"
# },
# {
# "copyright" : "David Golden",
# "license" : "Apache 2.0",
# "name" : "Class-Tiny",
# "url" : "https://metacpan.org/release/Class-Tiny"
# },
# {
# "copyright" : "Shoichi Kaji",
# "license" : "the same as Perl 5",
# "name" : "Command-Runner",
# "url" : "https://metacpan.org/release/Command-Runner"
# },
# {
# "copyright" : "Yuval Kogman",
# "license" : "the same as Perl 5",
# "name" : "Devel-GlobalDestruction",
# "url" : "https://metacpan.org/release/Devel-GlobalDestruction"
# },
# {
# "copyright" : "Unknown",
# "license" : "the same as Perl 5",
# "name" : "Exporter",
# "url" : "https://metacpan.org/release/Exporter"
# },
# {
# "copyright" : "Ken Williams, Leon Timmermans",
# "license" : "the same as Perl 5",
# "name" : "ExtUtils-Config",
# "url" : "https://metacpan.org/release/ExtUtils-Config"
# },
# {
# "copyright" : "Ken Williams, Leon Timmermans",
# "license" : "the same as Perl 5",
# "name" : "ExtUtils-Helpers",
# "url" : "https://metacpan.org/release/ExtUtils-Helpers"
# },
# {
# "copyright" : "Yves Orton, Michael Schwern, Alan Burlison, Randy W. Sims and others",
# "license" : "the same as Perl 5",
# "name" : "ExtUtils-Install",
# "url" : "https://metacpan.org/release/ExtUtils-Install"
# },
# {
# "copyright" : "Ken Williams, Leon Timmermans.",
# "license" : "the same as Perl 5",
# "name" : "ExtUtils-InstallPaths",
# "url" : "https://metacpan.org/release/ExtUtils-InstallPaths"
# },
# {
# "copyright" : "Leon Timmermans.",
# "license" : "the same as Perl 5",
# "name" : "ExtUtils-PL2Bat",
# "url" : "https://metacpan.org/release/ExtUtils-PL2Bat"
# },
# {
# "copyright" : "Daniel Muey",
# "license" : "the same as Perl 5",
# "name" : "File-Copy-Recursive",
# "url" : "https://metacpan.org/release/File-Copy-Recursive"
# },
# {
# "copyright" : "Charles Bailey, Tim Bunce, David Landgren, James Keenan, and Richard Elberger",
# "license" : "the same as Perl 5",
# "name" : "File-Path",
# "url" : "https://metacpan.org/release/File-Path"
# },
# {
# "copyright" : "Tim Jenness and the UK Particle Physics and Astronomy Research Council",
# "license" : "the same as Perl 5",
# "name" : "File-Temp",
# "url" : "https://metacpan.org/release/File-Temp"
# },
# {
# "copyright" : "Per Einar Ellefsen",
# "license" : "the same as Perl 5",
# "name" : "File-Which",
# "url" : "https://metacpan.org/release/File-Which"
# },
# {
# "copyright" : "David A Golden",
# "license" : "the same as Perl 5",
# "name" : "File-pushd",
# "url" : "https://metacpan.org/release/File-pushd"
# },
# {
# "copyright" : "Johan Vromans",
# "license" : "the terms of the Perl Artistic License or the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version",
# "name" : "Getopt-Long",
# "url" : "https://metacpan.org/release/Getopt-Long"
# },
# {
# "copyright" : "Christian Hansen",
# "license" : "the same as Perl 5",
# "name" : "HTTP-Tiny",
# "url" : "https://metacpan.org/release/HTTP-Tiny"
# },
# {
# "copyright" : "Tatsuhiko Miyagawa",
# "license" : "the same as Perl 5",
# "name" : "HTTP-Tinyish",
# "url" : "https://metacpan.org/release/HTTP-Tinyish"
# },
# {
# "copyright" : "Jos Boumans",
# "license" : "the same as Perl 5",
# "name" : "IPC-Cmd",
# "url" : "https://metacpan.org/release/IPC-Cmd"
# },
# {
# "copyright" : "R. Barrie Slaymaker, Jr.",
# "license" : "the BSD, Artistic, or GPL licenses, any version",
# "name" : "IPC-Run3",
# "url" : "https://metacpan.org/release/IPC-Run3"
# },
# {
# "copyright" : "Makamaka Hannyaharamitu",
# "license" : "the same as Perl 5",
# "name" : "JSON-PP",
# "url" : "https://metacpan.org/release/JSON-PP"
# },
# {
# "copyright" : "Audrey Tang",
# "license" : "MIT",
# "name" : "Locale-Maketext-Simple",
# "url" : "https://metacpan.org/release/Locale-Maketext-Simple"
# },
# {
# "copyright" : "Brandon L. Black",
# "license" : "the same as Perl 5",
# "name" : "MRO-Compat",
# "url" : "https://metacpan.org/release/MRO-Compat"
# },
# {
# "copyright" : "Tatsuhiko Miyagawa",
# "license" : "the same as Perl 5",
# "name" : "Menlo",
# "url" : "https://metacpan.org/release/Menlo"
# },
# {
# "copyright" : "Tatsuhiko Miyagawa",
# "license" : "the same as Perl 5",
# "name" : "Menlo-Legacy",
# "url" : "https://metacpan.org/release/Menlo-Legacy"
# },
# {
# "copyright" : "Tatsuhiko Miyagawa",
# "license" : "the same as Perl 5",
# "name" : "Module-CPANfile",
# "url" : "https://metacpan.org/release/Module-CPANfile"
# },
# {
# "copyright" : "Jos Boumans",
# "license" : "the same as Perl 5",
# "name" : "Module-Load",
# "url" : "https://metacpan.org/release/Module-Load"
# },
# {
# "copyright" : "Ken Williams, Matt Trout and David Golden",
# "license" : "the same as Perl 5",
# "name" : "Module-Metadata",
# "url" : "https://metacpan.org/release/Module-Metadata"
# },
# {
# "copyright" : "Shoichi Kaji",
# "license" : "the same as Perl 5",
# "name" : "Module-cpmfile",
# "url" : "https://metacpan.org/release/Module-cpmfile"
# },
# {
# "copyright" : "Shoichi Kaji",
# "license" : "the same as Perl 5",
# "name" : "Parallel-Pipes",
# "url" : "https://metacpan.org/release/Parallel-Pipes"
# },
# {
# "copyright" : "Andreas Koenig, Kenichi Ishigaki",
# "license" : "the same as Perl 5",
# "name" : "Parse-PMFile",
# "url" : "https://metacpan.org/release/Parse-PMFile"
# },
# {
# "copyright" : "The Perl 5 Porters",
# "license" : "the same as Perl 5",
# "name" : "Search-Dict",
# "url" : "https://metacpan.org/release/Search-Dict"
# },
# {
# "copyright" : "Roderick Schertler",
# "license" : "the same as Perl 5",
# "name" : "String-ShellQuote",
# "url" : "https://metacpan.org/release/String-ShellQuote"
# },
# {
# "copyright" : "Arthur Axel \"fREW\" Schmidt",
# "license" : "the same as Perl 5",
# "name" : "Sub-Exporter-Progressive",
# "url" : "https://metacpan.org/release/Sub-Exporter-Progressive"
# },
# {
# "copyright" : "Alexandr Ciornii",
# "license" : "the same as Perl 5",
# "name" : "Text-ParseWords",
# "url" : "https://metacpan.org/release/Text-ParseWords"
# },
# {
# "copyright" : "David Golden",
# "license" : "Apache 2.0",
# "name" : "Tie-Handle-Offset",
# "url" : "https://metacpan.org/release/Tie-Handle-Offset"
# },
# {
# "copyright" : "Tina Müller",
# "license" : "the same as Perl 5",
# "name" : "YAML-PP",
# "url" : "https://metacpan.org/release/YAML-PP"
# },
# {
# "copyright" : "Graham Knop, CONTRIBUTORS",
# "license" : "the same as Perl 5",
# "name" : "Win32-ShellQuote",
# "url" : "https://metacpan.org/release/Win32-ShellQuote"
# },
# {
# "copyright" : "Matt S Trout, CONTRIBUTORS",
# "license" : "the same as Perl 5",
# "name" : "local-lib",
# "url" : "https://metacpan.org/release/local-lib"
# },
# {
# "copyright" : "John Peacock",
# "license" : "the same as Perl 5",
# "name" : "version",
# "url" : "https://metacpan.org/release/version"
# }
# ]
# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;
$fatpacked{"Algorithm/C3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_C3';
package Algorithm::C3;use strict;use warnings;use Carp 'confess';our$VERSION='0.11';sub merge {my ($root,$parent_fetcher,$cache)=@_;$cache ||= {};my@STACK;my$pfetcher_is_coderef=ref($parent_fetcher)eq 'CODE';unless ($pfetcher_is_coderef or $root->can($parent_fetcher)){confess "Could not find method $parent_fetcher in $root"}my$current_root=$root;my$current_parents=[$root->$parent_fetcher ];my$recurse_mergeout=[];my$i=0;my%seen=($root=>1);my ($new_root,$mergeout,%tails);while(1){if($i < @$current_parents){$new_root=$current_parents->[$i++];if($seen{$new_root}){my@isastack;my$reached;for(my$i=0;$i < $#STACK;$i += 4){if($reached || ($reached=($STACK[$i]eq $new_root))){push(@isastack,$STACK[$i])}}my$isastack=join(q{ -> },@isastack,$current_root,$new_root);die "Infinite loop detected in parents of '$root': $isastack"}$seen{$new_root}=1;unless ($pfetcher_is_coderef or $new_root->can($parent_fetcher)){confess "Could not find method $parent_fetcher in $new_root"}push(@STACK,$current_root,$current_parents,$recurse_mergeout,$i);$current_root=$new_root;$current_parents=$cache->{pfetch}->{$current_root}||= [$current_root->$parent_fetcher ];$recurse_mergeout=[];$i=0;next}$seen{$current_root}=0;$mergeout=$cache->{merge}->{$current_root}||= do {my@seqs=map {[@$_]}@$recurse_mergeout;push(@seqs,[@$current_parents])if @$current_parents;for my$seq (@seqs){$tails{$seq->[$_]}++ for (1..$#$seq)}my@res=($current_root);while (1){my$cand;my$winner;for (@seqs){next if!@$_;if(!$winner){$cand=$_->[0];next if$tails{$cand};push@res=>$winner=$cand;shift @$_;$tails{$_->[0]}-- if @$_}elsif($_->[0]eq $winner){shift @$_;$tails{$_->[0]}-- if @$_}}last if!$cand;die q{Inconsistent hierarchy found while merging '} .$current_root .qq{':\n\t} .qq{current merge results [\n\t\t} .(join ",\n\t\t"=>@res).qq{\n\t]\n\t} .qq{merging failed on '$cand'\n} if!$winner}\@res};return @$mergeout if!@STACK;$i=pop(@STACK);$recurse_mergeout=pop(@STACK);$current_parents=pop(@STACK);$current_root=pop(@STACK);push(@$recurse_mergeout,$mergeout)}}1;
ALGORITHM_C3
$fatpacked{"App/cpm.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM';
package App::cpm;use strict;use warnings;our$VERSION='0.997009';our ($GIT_DESCRIBE,$GIT_URL);1;
APP_CPM
$fatpacked{"App/cpm/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_CLI';
package App::cpm::CLI;use 5.008001;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::Distribution;use App::cpm::Logger::File;use App::cpm::Logger;use App::cpm::Master;use App::cpm::Requirement;use App::cpm::Resolver::Cascade;use App::cpm::Resolver::MetaCPAN;use App::cpm::Resolver::MetaDB;use App::cpm::Util qw(WIN32 determine_home maybe_abs);use App::cpm::Worker;use App::cpm::version;use App::cpm;use Config;use Cwd ();use File::Copy ();use File::Path ();use File::Spec;use Getopt::Long qw(:config no_auto_abbrev no_ignore_case bundling);use List::Util ();use Module::CPANfile;use Module::cpmfile;use Parallel::Pipes::App;use Pod::Text ();sub new {my ($class,%option)=@_;my$prebuilt=exists$ENV{PERL_CPM_PREBUILT}&&!$ENV{PERL_CPM_PREBUILT}? 0 : 1;bless {argv=>undef,home=>determine_home,cwd=>Cwd::cwd(),workers=>WIN32 ? 1 : 5,snapshot=>"cpanfile.snapshot",dependency_file=>undef,local_lib=>"local",cpanmetadb=>"https://cpanmetadb.plackperl.org/v1.0/",_default_mirror=>'https://cpan.metacpan.org/',retry=>1,configure_timeout=>60,build_timeout=>3600,test_timeout=>1800,with_requires=>1,with_recommends=>0,with_suggests=>0,with_configure=>0,with_build=>1,with_test=>1,with_runtime=>1,with_develop=>0,feature=>[],notest=>1,prebuilt=>$] >= 5.012 && $prebuilt,pureperl_only=>0,static_install=>1,%option },$class}sub parse_options {my$self=shift;local@ARGV=@_;my ($mirror,@resolver,@feature);my$with_option=sub {my$n=shift;("with-$n",\$self->{"with_$n"},"without-$n",sub {$self->{"with_$n"}=0})};my@type=qw(requires recommends suggests);my@phase=qw(configure build test runtime develop);GetOptions "L|local-lib-contained=s"=>\($self->{local_lib}),"color!"=>\($self->{color}),"g|global"=>\($self->{global}),"mirror=s"=>\$mirror,"v|verbose"=>\($self->{verbose}),"w|workers=i"=>\($self->{workers}),"target-perl=s"=>\my$target_perl,"test!"=>sub {$self->{notest}=$_[1]? 0 : 1},"cpanfile=s"=>sub {$self->{dependency_file}={type=>"cpanfile",path=>$_[1]}},"cpmfile=s"=>sub {$self->{dependency_file}={type=>"cpmfile",path=>$_[1]}},"snapshot=s"=>\($self->{snapshot}),"sudo"=>\($self->{sudo}),"r|resolver=s@"=>\@resolver,"mirror-only"=>\($self->{mirror_only}),"dev"=>\($self->{dev}),"man-pages"=>\($self->{man_pages}),"home=s"=>\($self->{home}),"retry!"=>\($self->{retry}),"exclude-vendor!"=>\($self->{exclude_vendor}),"configure-timeout=i"=>\($self->{configure_timeout}),"build-timeout=i"=>\($self->{build_timeout}),"test-timeout=i"=>\($self->{test_timeout}),"show-progress!"=>\($self->{show_progress}),"prebuilt!"=>\($self->{prebuilt}),"reinstall"=>\($self->{reinstall}),"pp|pureperl|pureperl-only"=>\($self->{pureperl_only}),"static-install!"=>\($self->{static_install}),"with-all"=>sub {map {$self->{"with_$_"}=1}@type,@phase},(map$with_option->($_),@type),(map$with_option->($_),@phase),"feature=s@"=>\@feature,"show-build-log-on-failure"=>\($self->{show_build_log_on_failure}),or return 0;$self->{local_lib}=maybe_abs($self->{local_lib},$self->{cwd})unless$self->{global};$self->{home}=maybe_abs($self->{home},$self->{cwd});$self->{resolver}=\@resolver;$self->{feature}=\@feature if@feature;$self->{mirror}=$self->normalize_mirror($mirror)if$mirror;$self->{color}=1 if!defined$self->{color}&& -t STDOUT;$self->{show_progress}=1 if!WIN32 &&!defined$self->{show_progress}&& -t STDOUT;if ($target_perl){die "--target-perl option conflicts with --global option\n" if$self->{global};die "--target-perl option can be used only if perl version >= 5.18.0\n" if $] < 5.018;$target_perl="v$target_perl" if$target_perl =~ /^5\.[1-9]\d*$/;$target_perl=sprintf '%0.6f',App::cpm::version->parse($target_perl)->numify;$target_perl='5.008' if$target_perl eq '5.008000';$self->{target_perl}=$target_perl}if (WIN32 and $self->{workers}!=1){die "The number of workers must be 1 under WIN32 environment.\n"}if ($self->{sudo}){!system "sudo",$^X,"-e1" or exit 1}if ($self->{pureperl_only}or $self->{sudo}or!$self->{notest}or $self->{man_pages}or $] < 5.012){$self->{prebuilt}=0}$App::cpm::Logger::COLOR=1 if$self->{color};$App::cpm::Logger::VERBOSE=1 if$self->{verbose};$App::cpm::Logger::SHOW_PROGRESS=1 if$self->{show_progress};if (@ARGV){if ($ARGV[0]eq "-"){my$argv=$self->read_argv_from_stdin;return -1 if @$argv==0;$self->{argv}=$argv}else {$self->{argv}=\@ARGV}}elsif (!$self->{dependency_file}){if (-f "cpm.yml"){$self->{dependency_file}={type=>"cpmfile",path=>"cpm.yml" }}elsif (-f "cpanfile"){$self->{dependency_file}={type=>"cpanfile",path=>"cpanfile" }}}return 1}sub read_argv_from_stdin {my$self=shift;my@argv;while (my$line=<STDIN>){next if$line !~ /\S/;next if$line =~ /^\s*#/;$line =~ s/^\s*//;$line =~ s/\s*$//;push@argv,split /\s+/,$line}return \@argv}sub _core_inc {my$self=shift;[(!$self->{exclude_vendor}? grep {$_}@Config{qw(vendorarch vendorlibexp)}: ()),@Config{qw(archlibexp privlibexp)},]}sub _search_inc {my$self=shift;return \@INC if$self->{global};my$base=$self->{local_lib};require local::lib;my@local_lib=(local::lib->resolve_path(local::lib->install_base_arch_path($base)),local::lib->resolve_path(local::lib->install_base_perl_path($base)),);if ($self->{target_perl}){return [@local_lib]}else {return [@local_lib,@{$self->_core_inc}]}}sub normalize_mirror {my ($self,$mirror)=@_;$mirror =~ s{/*$}{/};return$mirror if$mirror =~ m{^https?://};$mirror =~ s{^file://}{};die "$mirror: No such directory.\n" unless -d $mirror;"file://" .maybe_abs($mirror,$self->{cwd})}sub run {my ($self,@argv)=@_;my$cmd=shift@argv or die "Need subcommand, try `cpm --help`\n";$cmd="help" if$cmd =~ /^(-h|--help)$/;$cmd="version" if$cmd =~ /^(-V|--version)$/;if (my$sub=$self->can("cmd_$cmd")){return$self->$sub(@argv)if$cmd eq "exec";my$ok=$self->parse_options(@argv);return 1 if!$ok;return 0 if$ok==-1;return$self->$sub}else {my$message=$cmd =~ /^-/ ? "Missing subcommand" : "Unknown subcommand '$cmd'";die "$message, try `cpm --help`\n"}}sub cmd_help {open my$fh,">",\my$out;Pod::Text->new->parse_from_file($0,$fh);$out =~ s/^[ ]{6}/ /mg;print$out;return 0}sub cmd_version {print "cpm $App::cpm::VERSION ($0)\n";if ($App::cpm::GIT_DESCRIBE){print "This is a self-contained version, $App::cpm::GIT_DESCRIBE ($App::cpm::GIT_URL)\n"}printf "perl version v%vd ($^X)\n\n",$^V;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 0}sub cmd_install {my$self=shift;die "Need arguments or cpm.yml/cpanfile\n" if!$self->{argv}&&!$self->{dependency_file};local%ENV=%ENV;File::Path::mkpath($self->{home})unless -d $self->{home};my$logger=App::cpm::Logger::File->new("$self->{home}/build.log.@{[time]}");$logger->symlink_to("$self->{home}/build.log");$logger->log("Running cpm $App::cpm::VERSION ($0) on perl $Config{version} built for $Config{archname} ($^X)");$logger->log("This is a self-contained version, $App::cpm::GIT_DESCRIBE ($App::cpm::GIT_URL)")if$App::cpm::GIT_DESCRIBE;$logger->log("Command line arguments are: @ARGV");my$master=App::cpm::Master->new(logger=>$logger,core_inc=>$self->_core_inc,search_inc=>$self->_search_inc,global=>$self->{global},show_progress=>$self->{show_progress},(exists$self->{target_perl}? (target_perl=>$self->{target_perl}): ()),);my ($packages,$dists,$resolver)=$self->initial_task($master);return 0 unless$packages;my$worker=App::cpm::Worker->new(verbose=>$self->{verbose},home=>$self->{home},logger=>$logger,notest=>$self->{notest},sudo=>$self->{sudo},resolver=>$self->generate_resolver($resolver),man_pages=>$self->{man_pages},retry=>$self->{retry},prebuilt=>$self->{prebuilt},pureperl_only=>$self->{pureperl_only},static_install=>$self->{static_install},configure_timeout=>$self->{configure_timeout},build_timeout=>$self->{build_timeout},test_timeout=>$self->{test_timeout},($self->{global}? (): (local_lib=>$self->{local_lib})),);{last if $] >= 5.018;my$requirement=App::cpm::Requirement->new('ExtUtils::MakeMaker'=>'6.64','ExtUtils::ParseXS'=>'3.16');for my$name ('ExtUtils::MakeMaker','ExtUtils::ParseXS'){if (my ($i)=grep {$packages->[$_]{package}eq $name}0..$#{$packages}){$requirement->add($name,$packages->[$i]{version_range})or die sprintf "We have to install newer $name first: $@\n";splice @$packages,$i,1}}my ($is_satisfied,@need_resolve)=$master->is_satisfied($requirement->as_array);last if$is_satisfied;$master->add_task(type=>"resolve",%$_)for@need_resolve;$self->install($master,$worker,1);if (my$fail=$master->fail){local$App::cpm::Logger::VERBOSE=0;for my$type (qw(install resolve)){App::cpm::Logger->log(result=>"FAIL",type=>$type,message=>$_)for @{$fail->{$type}}}print STDERR "\r" if$self->{show_progress};warn sprintf "%d distribution%s installed.\n",$master->installed_distributions,$master->installed_distributions > 1 ? "s" : "";if ($self->{show_build_log_on_failure}){File::Copy::copy($logger->file,\*STDERR)}else {warn "See $self->{home}/build.log for details.\n";warn "You may want to execute cpm with --show-build-log-on-failure,\n";warn "so that the build.log is automatically dumped on failure.\n"}return 1}}$master->add_task(type=>"resolve",%$_)for @$packages;$master->add_distribution($_)for @$dists;$self->install($master,$worker,$self->{workers});my$fail=$master->fail;if ($fail){local$App::cpm::Logger::VERBOSE=0;for my$type (qw(install resolve)){App::cpm::Logger->log(result=>"FAIL",type=>$type,message=>$_)for @{$fail->{$type}}}}print STDERR "\r" if$self->{show_progress};warn sprintf "%d distribution%s installed.\n",$master->installed_distributions,$master->installed_distributions > 1 ? "s" : "";$self->cleanup;if ($fail){if ($self->{show_build_log_on_failure}){File::Copy::copy($logger->file,\*STDERR)}else {warn "See $self->{home}/build.log for details.\n";warn "You may want to execute cpm with --show-build-log-on-failure,\n";warn "so that the build.log is automatically dumped on failure.\n"}return 1}else {return 0}}sub install {my ($self,$master,$worker,$num)=@_;my@task=$master->get_task;Parallel::Pipes::App->run(num=>$num,before_work=>sub {my$task=shift;$task->in_charge(1)},work=>sub {my$task=shift;return$worker->work($task)},after_work=>sub {my$result=shift;$master->register_result($result);@task=$master->get_task},tasks=>\@task,)}sub cleanup {my$self=shift;my$week=time - 7*24*60*60;my@entry=glob "$self->{home}/build.log.*";if (opendir my$dh,"$self->{home}/work"){push@entry,map File::Spec->catdir("$self->{home}/work",$_),grep!/^\.{1,2}$/,readdir$dh}for my$entry (@entry){my$mtime=(stat$entry)[9];if ($mtime < $week){if (-d $entry){File::Path::rmtree($entry)}else {unlink$entry}}}}sub initial_task {my ($self,$master)=@_;if (!$self->{argv}){my ($requirement,$reinstall,$resolver)=$self->load_dependency_file;my ($is_satisfied,@need_resolve)=$master->is_satisfied($requirement);if (!@$reinstall and $is_satisfied){warn "All requirements are satisfied.\n";return}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$requirement;die sprintf "%s requires perl %s, but you have only %s\n",$self->{dependency_file}{path},$req->{version_range},$self->{target_perl}|| $]}my@package=(@need_resolve,@$reinstall);return (\@package,[],$resolver)}$self->{mirror}||= $self->{_default_mirror};my (@package,@dist);for (@{$self->{argv}}){my$arg=$_;my ($package,$dist);if (-d $arg || -f $arg || $arg =~ s{^file://}{}){$arg=maybe_abs($arg,$self->{cwd});$dist=App::cpm::Distribution->new(source=>"local",uri=>"file://$arg",provides=>[])}elsif ($arg =~ /(?:^git:|\.git(?:@.+)?$)/){my%ref=$arg =~ s/(?<=\.git)@(.+)$// ? (ref=>$1): ();$dist=App::cpm::Distribution->new(source=>"git",uri=>$arg,provides=>[],%ref)}elsif ($arg =~ m{^(https?|file)://}){my ($source,$distfile)=($1 eq "file" ? "local" : "http",undef);if (my$d=App::cpm::DistNotation->new_from_uri($arg)){($source,$distfile)=("cpan",$d->distfile)}$dist=App::cpm::Distribution->new(source=>$source,uri=>$arg,$distfile ? (distfile=>$distfile): (),provides=>[],)}elsif (my$d=App::cpm::DistNotation->new_from_dist($arg)){$dist=App::cpm::Distribution->new(source=>"cpan",uri=>$d->cpan_uri($self->{mirror}),distfile=>$d->distfile,provides=>[],)}else {my ($name,$version_range,$dev);$arg =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;if ($arg =~ /\~[v\d\._,\!<>= ]+$/){($name,$version_range)=split '~',$arg,2}else {$arg =~ s/[~@]dev$// and $dev++;$name=$arg}$package=+{package=>$name,version_range=>$version_range || 0,dev=>$dev,reinstall=>$self->{reinstall},}}push@package,$package if$package;push@dist,$dist if$dist}return (\@package,\@dist,undef)}sub load_dependency_file {my$self=shift;my$cpmfile;if ($self->{dependency_file}{type}eq "cpmfile"){$cpmfile=Module::cpmfile->load($self->{dependency_file}{path})}else {my$cpanfile=Module::CPANfile->load($self->{dependency_file}{path});$cpmfile=Module::cpmfile->from_cpanfile($cpanfile)}if (!$self->{mirror}){my$mirrors=$cpmfile->{_mirrors}|| [];if (@$mirrors){$self->{mirror}=$self->normalize_mirror($mirrors->[0])}else {$self->{mirror}=$self->{_default_mirror}}}my@phase=grep$self->{"with_$_"},qw(configure build test runtime develop);my@type=grep$self->{"with_$_"},qw(requires recommends suggests);my$reqs=$cpmfile->effective_requirements($self->{feature},\@phase,\@type);my (@package,@reinstall);for my$package (sort keys %$reqs){my$options=$reqs->{$package};my$req={package=>$package,version_range=>$options->{version},dev=>$options->{dev},reinstall=>$options->{git}? 1 : 0,};if ($options->{git}){push@reinstall,$req}else {push@package,$req}}require App::cpm::Resolver::Custom;my$resolver=App::cpm::Resolver::Custom->new(requirements=>$reqs,mirror=>$self->{mirror},from=>$self->{dependency_file}{type},);return (\@package,\@reinstall,$resolver->effective ? $resolver : undef)}sub generate_resolver {my ($self,$initial)=@_;my$cascade=App::cpm::Resolver::Cascade->new;$cascade->add($initial)if$initial;if (@{$self->{resolver}}){for (@{$self->{resolver}}){my ($klass,@arg)=split /,/,$_;my$resolver;if ($klass =~ /^metadb$/i){my ($uri,$mirror);if (@arg > 1){($uri,$mirror)=@arg}elsif (@arg==1){$mirror=$arg[0]}else {$mirror=$self->{mirror}}$resolver=App::cpm::Resolver::MetaDB->new($uri ? (uri=>$uri): (),mirror=>$self->normalize_mirror($mirror),)}elsif ($klass =~ /^metacpan$/i){$resolver=App::cpm::Resolver::MetaCPAN->new(dev=>$self->{dev})}elsif ($klass =~ /^02packages?$/i){require App::cpm::Resolver::02Packages;my ($path,$mirror);if (@arg > 1){($path,$mirror)=@arg}elsif (@arg==1){$mirror=$arg[0]}else {$mirror=$self->{mirror}}$resolver=App::cpm::Resolver::02Packages->new($path ? (path=>$path): (),cache=>"$self->{home}/sources",mirror=>$self->normalize_mirror($mirror),)}elsif ($klass =~ /^snapshot$/i){require App::cpm::Resolver::Snapshot;$resolver=App::cpm::Resolver::Snapshot->new(path=>$self->{snapshot},mirror=>@arg ? $self->normalize_mirror($arg[0]): $self->{mirror},)}else {my$full_klass=$klass =~ s/^\+// ? $klass : "App::cpm::Resolver::$klass";(my$file=$full_klass)=~ s{::}{/}g;require "$file.pm";$resolver=$full_klass->new(@arg)}$cascade->add($resolver)}return$cascade}if ($self->{mirror_only}){require App::cpm::Resolver::02Packages;my$resolver=App::cpm::Resolver::02Packages->new(mirror=>$self->{mirror},cache=>"$self->{home}/sources",);$cascade->add($resolver);return$cascade}if (!$self->{argv}and -f $self->{snapshot}){if (!eval {require App::cpm::Resolver::Snapshot}){die "To load $self->{snapshot}, you need to install Carton::Snapshot.\n"}warn "Loading distributions from $self->{snapshot}...\n";my$resolver=App::cpm::Resolver::Snapshot->new(path=>$self->{snapshot},mirror=>$self->{mirror},);$cascade->add($resolver)}my$resolver=App::cpm::Resolver::MetaCPAN->new($self->{dev}? (dev=>1): (only_dev=>1));$cascade->add($resolver);$resolver=App::cpm::Resolver::MetaDB->new(uri=>$self->{cpanmetadb},mirror=>$self->{mirror},);$cascade->add($resolver);if (!$self->{dev}){$resolver=App::cpm::Resolver::MetaCPAN->new;$cascade->add($resolver)}$cascade}1;
APP_CPM_CLI
$fatpacked{"App/cpm/CircularDependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_CIRCULARDEPENDENCY';
package App::cpm::CircularDependency;use strict;use warnings;{package App::cpm::CircularDependency::OrderedSet;sub new {my$class=shift;bless {index=>0,hash=>+{}},$class}sub add {my ($self,$name)=@_;$self->{hash}{$name}=$self->{index}++}sub exists {my ($self,$name)=@_;exists$self->{hash}{$name}}sub values {my$self=shift;sort {$self->{hash}{$a}<=> $self->{hash}{$b}}keys %{$self->{hash}}}sub clone {my$self=shift;my$new=(ref$self)->new;$new->add($_)for$self->values;$new}}sub _uniq {my%u;grep!$u{$_}++,@_}sub new {my$class=shift;bless {_tmp=>{}},$class}sub add {my ($self,$distfile,$provides,$requirements)=@_;$self->{_tmp}{$distfile}=+{provides=>[map $_->{package},@$provides ],requirements=>[map $_->{package},@$requirements ],}}sub finalize {my$self=shift;for my$distfile (sort keys %{$self->{_tmp}}){$self->{$distfile}=[_uniq map$self->_find($_),@{$self->{_tmp}{$distfile}{requirements}}]}delete$self->{_tmp};return}sub _find {my ($self,$package)=@_;for my$distfile (sort keys %{$self->{_tmp}}){if (grep {$_ eq $package}@{$self->{_tmp}{$distfile}{provides}}){return$distfile}}return}sub detect {my$self=shift;my%result;for my$distfile (sort keys %$self){my$seen=App::cpm::CircularDependency::OrderedSet->new;$seen->add($distfile);if (my$detected=$self->_detect($distfile,$seen)){$result{$distfile}=$detected}}return \%result}sub _detect {my ($self,$distfile,$seen)=@_;for my$req (@{$self->{$distfile}}){if ($seen->exists($req)){return [$seen->values,$req]}my$clone=$seen->clone;$clone->add($req);if (my$detected=$self->_detect($req,$clone)){return$detected}}return}1;
APP_CPM_CIRCULARDEPENDENCY
$fatpacked{"App/cpm/DistNotation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_DISTNOTATION';
package App::cpm::DistNotation;use strict;use warnings;my$A1=q{[A-Z]};my$A2=q{[A-Z]{2}};my$AUTHOR=qr{[A-Z]{2}[\-A-Z0-9]*};our$CPAN_URI=qr{^(.*)/authors/id/($A1/$A2/$AUTHOR/.*)$}o;our$DISTFILE=qr{^(?:$A1/$A2/)?($AUTHOR)/(.*)$}o;sub new {my$class=shift;bless {mirror=>'',distfile=>'',},$class}sub new_from_dist {my$self=shift->new;my$dist=shift;if ($dist =~ $DISTFILE){my$author=$1;my$rest=$2;$self->{distfile}=sprintf "%s/%s/%s/%s",substr($author,0,1),substr($author,0,2),$author,$rest;return$self}return}sub new_from_uri {my$self=shift->new;my$uri=shift;if ($uri =~ $CPAN_URI){$self->{mirror}=$1;$self->{distfile}=$2;return$self}return}sub cpan_uri {my$self=shift;my$mirror=shift || $self->{mirror};$mirror =~ s{/+$}{};sprintf "%s/authors/id/%s",$mirror,$self->{distfile}}sub distfile {shift->{distfile}}1;
APP_CPM_DISTNOTATION
$fatpacked{"App/cpm/Distribution.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_DISTRIBUTION';
package App::cpm::Distribution;use strict;use warnings;use App::cpm::Logger;use App::cpm::Requirement;use App::cpm::version;use CPAN::DistnameInfo;use constant STATE_REGISTERED=>0b000001;use constant STATE_DEPS_REGISTERED=>0b000010;use constant STATE_RESOLVED=>0b000100;use constant STATE_FETCHED=>0b001000;use constant STATE_CONFIGURED=>0b010000;use constant STATE_INSTALLED=>0b100000;sub new {my ($class,%option)=@_;my$uri=delete$option{uri};my$distfile=delete$option{distfile};my$source=delete$option{source}|| "cpan";my$provides=delete$option{provides}|| [];bless {%option,provides=>$provides,uri=>$uri,distfile=>$distfile,source=>$source,_state=>STATE_RESOLVED,requirements=>{},},$class}sub requirements {my ($self,$phase,$req)=@_;if (ref$phase){my$req=App::cpm::Requirement->new;for my$p (@$phase){if (my$r=$self->{requirements}{$p}){$req->merge($r)}}return$req}$self->{requirements}{$phase}=$req if$req;$self->{requirements}{$phase}|| App::cpm::Requirement->new}for my$attr (qw(source directory distdata meta uri provides ref static_builder prebuilt)){no strict 'refs';*$attr=sub {my$self=shift;$self->{$attr}=shift if @_;$self->{$attr}}}sub distfile {my$self=shift;$self->{distfile}=shift if @_;$self->{distfile}|| $self->{uri}}sub distvname {my$self=shift;$self->{distvname}||= do {CPAN::DistnameInfo->new($self->{distfile})->distvname || $self->distfile}}sub overwrite_provide {my ($self,$provide)=@_;my$overwrote;for my$exist (@{$self->{provides}}){if ($exist->{package}eq $provide->{package}){$exist=$provide;$overwrote++}}if (!$overwrote){push @{$self->{provides}},$provide}return 1}sub registered {my$self=shift;if (@_ && $_[0]){$self->{_state}|= STATE_REGISTERED}$self->{_state}& STATE_REGISTERED}sub deps_registered {my$self=shift;if (@_ && $_[0]){$self->{_state}|= STATE_DEPS_REGISTERED}$self->{_state}& STATE_DEPS_REGISTERED}sub resolved {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_RESOLVED}$self->{_state}& STATE_RESOLVED}sub fetched {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_FETCHED}$self->{_state}& STATE_FETCHED}sub configured {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_CONFIGURED}$self->{_state}& STATE_CONFIGURED}sub installed {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_INSTALLED}$self->{_state}& STATE_INSTALLED}sub providing {my ($self,$package,$version_range)=@_;for my$provide (@{$self->provides}){if ($provide->{package}eq $package){if (!$version_range or App::cpm::version->parse($provide->{version})->satisfy($version_range)){return 1}else {my$message=sprintf "%s provides %s (%s), but needs %s\n",$self->distfile,$package,$provide->{version}|| 0,$version_range;App::cpm::Logger->log(result=>"WARN",message=>$message);last}}}return}sub equals {my ($self,$that)=@_;$self->distfile && $that->distfile and $self->distfile eq $that->distfile}1;
APP_CPM_DISTRIBUTION
$fatpacked{"App/cpm/HTTP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_HTTP';
package App::cpm::HTTP;use strict;use warnings;use App::cpm;use HTTP::Tinyish;sub create {my ($class,%args)=@_;my$wantarray=wantarray;my@try=$args{prefer}? @{$args{prefer}}: qw(HTTPTiny LWP Curl Wget);my ($backend,$tool,$desc);for my$try (map "HTTP::Tinyish::$_",@try){my$meta=HTTP::Tinyish->configure_backend($try)or next;$try->supports("https")or next;($tool)=sort keys %$meta;($desc=$meta->{$tool})=~ s/^(.*?)\n.*/$1/s;$backend=$try,last}die "Couldn't find HTTP Clients that support https" unless$backend;my$http=$backend->new(agent=>"App::cpm/$App::cpm::VERSION",timeout=>60,verify_SSL=>1,%args,);my$keep_alive=exists$args{keep_alive}? $args{keep_alive}: 1;if ($keep_alive and $backend =~ /LWP$/){$http->{ua}->conn_cache({total_capacity=>1 })}$wantarray ? ($http,"$tool $desc"): $http}1;
APP_CPM_HTTP
$fatpacked{"App/cpm/Installer/Unpacker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_INSTALLER_UNPACKER';
package App::cpm::Installer::Unpacker;use strict;use warnings;use File::Basename ();use File::Temp ();use File::Which ();use IPC::Run3 ();sub run3 {my ($cmd,$outfile)=@_;my$out;IPC::Run3::run3$cmd,\undef,($outfile ? $outfile : \$out),\my$err;return ($?,$out,$err)}sub new {my ($class,%argv)=@_;my$self=bless \%argv,$class;$self->_init_untar;$self->_init_unzip;$self}sub unpack {my ($self,$file)=@_;my$method=$file =~ /\.zip$/ ? $self->{method}{unzip}: $self->{method}{untar};$self->$method($file)}sub describe {my$self=shift;my%describe=(map {($_,$self->{$_})}grep$self->{$_},qw(gzip bzip2 Archive::Tar unzip Archive::Zip),);if ($self->{tar}){$describe{tar}=sprintf "%s (%s%s)",$self->{tar},$self->{tar_kind},$self->{tar_bad}? ", will be used together with gzip/bzip2" : "",}\%describe}sub _init_untar {my$self=shift;my$tar=$self->{tar}=File::Which::which('gtar')|| File::Which::which("tar");if ($tar){my ($exit,$out,$err)=run3 [$tar,'--version'];if ($out =~ /bsdtar/){$self->{tar_kind}='bsd'}elsif ($out =~ /GNU/){$self->{tar_kind}='gnu'}elsif ($^O eq 'openbsd'){$self->{tar_kind}='openbsd'}else {$self->{tar_kind}='unknown'}$self->{tar_bad}=1 if$out =~ /GNU.*1\.13/i || $^O eq 'MSWin32' || $^O eq 'solaris' || $^O eq 'hpux'}if ($tar and!$self->{tar_bad}){$self->{method}{untar}=*_untar;return if!$self->{_init_all}}my$gzip=$self->{gzip}=File::Which::which("gzip");my$bzip2=$self->{bzip2}=File::Which::which("bzip2");if ($tar && $gzip && $bzip2){$self->{method}{untar}=*_untar_bad;return if!$self->{_init_all}}if (eval {require Archive::Tar}){$self->{"Archive::Tar"}=Archive::Tar->VERSION;$self->{method}{untar}=*_untar_module;return if!$self->{_init_all}}return if$self->{_init_all};$self->{method}{untar}=sub {die "There is no backend for untar"}}sub _init_unzip {my$self=shift;my$unzip=$self->{unzip}=File::Which::which("unzip");if ($unzip){$self->{method}{unzip}=*_unzip;return if!$self->{_init_all}}if (eval {require Archive::Zip}){$self->{"Archive::Zip"}=Archive::Zip->VERSION;$self->{method}{unzip}=*_unzip_module;return if!$self->{_init_all}}return if$self->{_init_all};$self->{method}{unzip}=sub {die "There is no backend for unzip"}}sub _untar {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{my$ar=$file =~ /\.bz2$/ ? 'j' : 'z';($exit,$out,$err)=run3 [$self->{tar},"${ar}tf",$file];last if$exit!=0;my$root=$self->_find_tarroot(split /\r?\n/,$out);my@no_same_owner=$self->{tar_kind}eq 'openbsd' ? (): ('-o');($exit,$out,$err)=run3 [$self->{tar},"${ar}xf",$file,@no_same_owner];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _untar_bad {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{my$ar=$file =~ /\.bz2$/ ? $self->{bzip2}: $self->{gzip};my$temp=File::Temp->new(SUFFIX=>'.tar',EXLOCK=>0);($exit,$out,$err)=run3 [$ar,"-dc",$file],$temp->filename;last if$exit!=0;my@opt=$^O eq 'MSWin32' && $self->{tar_kind}ne "bsd" ? ('--force-local'): ();($exit,$out,$err)=run3 [$self->{tar},@opt,"-tf",$temp->filename];last if$exit!=0 ||!$out;my$root=$self->_find_tarroot(split /\r?\n/,$out);($exit,$out,$err)=run3 [$self->{tar},@opt,"-xf",$temp->filename,"-o"];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _untar_module {my ($self,$file)=@_;my$wantarray=wantarray;no warnings 'once';local$Archive::Tar::WARN=0;my$t=Archive::Tar->new;{my$ok=$t->read($file);last if!$ok;my$root=$self->_find_tarroot($t->list_files);my@file=$t->extract;return$root if@file and -d $root}return if!$wantarray;return (undef,$t->error)}sub _find_tarroot {my ($self,$root,@others)=@_;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length$root){$root=shift@others;redo FILE if$root}}$root}sub _unzip {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{($exit,$out,$err)=run3 [$self->{unzip},'-t',$file];last if$exit!=0;my$root=$self->_find_ziproot(split /\r?\n/,$out);($exit,$out,$err)=run3 [$self->{unzip},'-q',$file];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _unzip_module {my ($self,$file)=@_;my$wantarray=wantarray;no warnings 'once';my$err='';local$Archive::Zip::ErrorHandler=sub {$err .= "@_"};my$zip=Archive::Zip->new;UNZIP: {my$status=$zip->read($file);last UNZIP if$status!=Archive::Zip::AZ_OK();for my$member ($zip->members){my$af=$member->fileName;next if$af =~ m!^(/|\.\./)!;my$status=$member->extractToFileNamed($af);last UNZIP if$status!=Archive::Zip::AZ_OK()}my ($root)=$zip->membersMatching(qr{^[^/]+/$});last UNZIP if!$root;$root=$root->fileName;$root =~ s{/$}{};return$root if -d $root}return if!$wantarray;return (undef,$err)}sub _find_ziproot {my ($self,undef,$root,@others)=@_;FILE: {chomp$root;if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}){$root=shift@others;redo FILE if$root}}$root}1;
APP_CPM_INSTALLER_UNPACKER
$fatpacked{"App/cpm/Logger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_LOGGER';
package App::cpm::Logger;use strict;use warnings;use App::cpm::Util 'WIN32';use List::Util 'max';our$COLOR;our$VERBOSE;our$SHOW_PROGRESS;my%color=(resolve=>33,fetch=>34,configure=>35,install=>36,FAIL=>31,DONE=>32,WARN=>33,);our$HAS_WIN32_COLOR;sub new {my$class=shift;bless {@_},$class}sub log {my ($self,%option)=@_;my$type=$option{type}|| "";my$message=$option{message};chomp$message;my$optional=$option{optional}? " ($option{optional})" : "";my$result=$option{result};my$is_color=ref$self ? $self->{color}: $COLOR;my$verbose=ref$self ? $self->{verbose}: $VERBOSE;my$show_progress=ref$self ? $self->{show_progress}: $SHOW_PROGRESS;if ($is_color and WIN32){if (!defined$HAS_WIN32_COLOR){$HAS_WIN32_COLOR=eval {require Win32::Console::ANSI;1}? 1 : 0}$is_color=0 unless$HAS_WIN32_COLOR}if ($is_color){$type="\e[$color{$type}m$type\e[m" if$type && $color{$type};$result="\e[$color{$result}m$result\e[m" if$result && $color{$result};$optional="\e[1;37m$optional\e[m" if$optional}my$r=$show_progress ? "\r" : "";if ($verbose){$type=$is_color && $type ? sprintf("%-17s",$type): sprintf("%-9s",$type || "");warn$r .sprintf "%d %s %s %s%s\n",$option{pid}|| $$,$result,$type,$message,$optional}else {warn$r .join(" ",$result,$type ? $type : (),$message .$optional)."\n"}}1;
APP_CPM_LOGGER
$fatpacked{"App/cpm/Logger/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_LOGGER_FILE';
package App::cpm::Logger::File;use strict;use warnings;use App::cpm::Util 'WIN32';use File::Temp ();use POSIX ();sub new {my ($class,$file)=@_;my$fh;if (WIN32){require IO::File;$file ||= File::Temp::tmpnam()}elsif ($file){open$fh,">>:unix",$file or die "$file: $!"}else {($fh,$file)=File::Temp::tempfile(UNLINK=>1)}bless {context=>'',fh=>$fh,file=>$file,pid=>'',},$class}sub symlink_to {my ($self,$dest)=@_;unlink$dest;if (!eval {symlink$self->file,$dest}){$self->{file}=$dest}}sub file {shift->{file}}sub prefix {my$self=shift;my$pid=$self->{pid}|| $$;$self->{context}? "$pid,$self->{context}" : $pid}sub log {my ($self,@line)=@_;my$now=POSIX::strftime('%Y-%m-%dT%H:%M:%S',localtime);my$prefix=$self->prefix;local$self->{fh}=IO::File->new($self->{file},'a')if WIN32;for my$line (@line){chomp$line;print {$self->{fh}}"$now,$prefix| $_\n" for split /\n/,$line}}sub log_with_fh {my ($self,$fh)=@_;my$prefix=$self->prefix;local$self->{fh}=IO::File->new($self->{file},'a')if WIN32;while (my$line=<$fh>){chomp$line;print {$self->{fh}}"@{[POSIX::strftime('%Y-%m-%dT%H:%M:%S', localtime)]},$prefix| $line\n"}}1;
APP_CPM_LOGGER_FILE
$fatpacked{"App/cpm/Master.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_MASTER';
package App::cpm::Master;use strict;use warnings;use App::cpm::CircularDependency;use App::cpm::Distribution;use App::cpm::Logger;use App::cpm::Task;use App::cpm::version;use CPAN::DistnameInfo;use IO::Handle;use Module::Metadata;sub new {my ($class,%option)=@_;my$self=bless {%option,installed_distributions=>0,tasks=>+{},distributions=>+{},_fail_resolve=>+{},_fail_install=>+{},_is_installed=>+{},},$class;if ($self->{target_perl}){require Module::CoreList;if (!exists$Module::CoreList::version{$self->{target_perl}}){die "Module::CoreList does not have target perl $self->{target_perl} entry, abort.\n"}if (!exists$Module::CoreList::version{$]}){die "Module::CoreList does not have our perl $] entry, abort.\n"}}if (!$self->{global}){if (eval {require Module::CoreList}){if (!exists$Module::CoreList::version{$]}){die "Module::CoreList does not have our perl $] entry, abort.\n"}$self->{_has_corelist}=1}else {my$msg="You don't have Module::CoreList. " ."The local-lib may result in incomplete self-contained directory.";App::cpm::Logger->log(result=>"WARN",message=>$msg)}}$self}sub fail {my$self=shift;my@fail_resolve=sort keys %{$self->{_fail_resolve}};my@fail_install=sort keys %{$self->{_fail_install}};my@not_installed=grep {!$self->{_fail_install}{$_->distfile}&&!$_->installed}$self->distributions;return if!@fail_resolve &&!@fail_install &&!@not_installed;my$detector=App::cpm::CircularDependency->new;for my$dist (@not_installed){my$req=$dist->requirements([qw(configure build test runtime)])->as_array;$detector->add($dist->distfile,$dist->provides,$req)}$detector->finalize;my$detected=$detector->detect;for my$distfile (sort keys %$detected){my$distvname=$self->distribution($distfile)->distvname;my@circular=@{$detected->{$distfile}};my$msg=join " -> ",map {$self->distribution($_)->distvname}@circular;local$self->{logger}{context}=$distvname;$self->{logger}->log("Detected circular dependencies $msg");$self->{logger}->log("Failed to install distribution")}for my$dist (sort {$a->distvname cmp $b->distvname}grep {!$detected->{$_->distfile}}@not_installed){local$self->{logger}{context}=$dist->distvname;$self->{logger}->log("Failed to install distribution, " ."because of installing some dependencies failed")}my@fail_install_name=map {CPAN::DistnameInfo->new($_)->distvname || $_}@fail_install;my@not_installed_name=map {$_->distvname}@not_installed;if (@fail_resolve || @fail_install_name){$self->{logger}->log("--");$self->{logger}->log("Installation failed. " ."The direct cause of the failure comes from the following packages/distributions; " ."you may want to grep this log file by them:");$self->{logger}->log(" * $_")for@fail_resolve,sort@fail_install_name}{resolve=>\@fail_resolve,install=>[sort@fail_install_name,@not_installed_name]}}sub tasks {values %{shift->{tasks}}}sub add_task {my ($self,%task)=@_;my$new=App::cpm::Task->new(%task);if (grep {$_->equals($new)}$self->tasks){return 0}else {$self->{tasks}{$new->uid}=$new;return 1}}sub get_task {my$self=shift;if (my@task=grep {!$_->in_charge}$self->tasks){return@task}$self->_calculate_tasks;return unless$self->tasks;if (my@task=grep {!$_->in_charge}$self->tasks){return@task}return}sub register_result {my ($self,$result)=@_;my ($task)=grep {$_->uid eq $result->{uid}}$self->tasks;die "Missing task that has uid=$result->{uid}" unless$task;%{$task}=%{$result};my$logged=$self->info($task);my$method="_register_@{[$task->{type}]}_result";$self->$method($task);$self->remove_task($task);$self->_show_progress if$logged && $self->{show_progress};return 1}sub info {my ($self,$task)=@_;my$type=$task->type;return if!$App::cpm::Logger::VERBOSE && $type ne "install";my$name=$task->distvname;my ($message,$optional);if ($type eq "resolve"){$message=$task->{package};$message .= " -> $name" .($task->{ref}? "\@$task->{ref}" : "")if$task->{ok};$optional="from $task->{from}" if$task->{ok}and $task->{from}}else {$message=$name;$optional="using cache" if$type eq "fetch" and $task->{using_cache};$optional="using prebuilt" if$task->{prebuilt}}my$elapsed=defined$task->{elapsed}? sprintf "(%.3fsec) ",$task->{elapsed}: "";App::cpm::Logger->log(pid=>$task->{pid},type=>$type,result=>$task->{ok}? "DONE" : "FAIL",message=>"$elapsed$message",optional=>$optional,);return 1}sub _show_progress {my$self=shift;my$all=keys %{$self->{distributions}};my$num=$self->installed_distributions;print STDERR "--- $num/$all ---";STDERR->flush}sub remove_task {my ($self,$task)=@_;delete$self->{tasks}{$task->uid}}sub distributions {values %{shift->{distributions}}}sub distribution {my ($self,$distfile)=@_;$self->{distributions}{$distfile}}sub _calculate_tasks {my$self=shift;my@distributions =grep {!$self->{_fail_install}{$_->distfile}}$self->distributions;if (my@dists=grep {$_->resolved &&!$_->registered}@distributions){for my$dist (@dists){$dist->registered(1);$self->add_task(type=>"fetch",distfile=>$dist->{distfile},source=>$dist->source,uri=>$dist->uri,ref=>$dist->ref,)}}if (my@dists=grep {$_->fetched &&!$_->registered}@distributions){for my$dist (@dists){local$self->{logger}->{context}=$dist->distvname;my$dist_requirements=$dist->requirements('configure')->as_array;my ($is_satisfied,@need_resolve)=$self->is_satisfied($dist_requirements);if ($is_satisfied){$dist->registered(1);$self->add_task(type=>"configure",meta=>$dist->meta,directory=>$dist->directory,distfile=>$dist->{distfile},source=>$dist->source,uri=>$dist->uri,distvname=>$dist->distvname,)}elsif (@need_resolve and!$dist->deps_registered){$dist->deps_registered(1);my$msg=sprintf "Found configure dependencies: %s",join(", ",map {sprintf "%s (%s)",$_->{package},$_->{version_range}|| 0}@need_resolve);$self->{logger}->log($msg);my$ok=$self->_register_resolve_task(@need_resolve);$self->{_fail_install}{$dist->distfile}++ unless$ok}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$dist_requirements;my$msg=sprintf "%s requires perl %s, but you have only %s",$dist->distvname,$req->{version_range},$self->{target_perl}|| $];$self->{logger}->log($msg);App::cpm::Logger->log(result=>"FAIL",message=>$msg);$self->{_fail_install}{$dist->distfile}++}}}if (my@dists=grep {$_->configured &&!$_->registered}@distributions){for my$dist (@dists){local$self->{logger}->{context}=$dist->distvname;my@phase=qw(build test runtime);push@phase,'configure' if$dist->prebuilt;my$dist_requirements=$dist->requirements(\@phase)->as_array;my ($is_satisfied,@need_resolve)=$self->is_satisfied($dist_requirements);if ($is_satisfied){$dist->registered(1);$self->add_task(type=>"install",meta=>$dist->meta,distdata=>$dist->distdata,directory=>$dist->directory,distfile=>$dist->{distfile},uri=>$dist->uri,static_builder=>$dist->static_builder,prebuilt=>$dist->prebuilt,)}elsif (@need_resolve and!$dist->deps_registered){$dist->deps_registered(1);my$msg=sprintf "Found dependencies: %s",join(", ",map {sprintf "%s (%s)",$_->{package},$_->{version_range}|| 0}@need_resolve);$self->{logger}->log($msg);my$ok=$self->_register_resolve_task(@need_resolve);$self->{_fail_install}{$dist->distfile}++ unless$ok}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$dist_requirements;my$msg=sprintf "%s requires perl %s, but you have only %s",$dist->distvname,$req->{version_range},$self->{target_perl}|| $];$self->{logger}->log($msg);App::cpm::Logger->log(result=>"FAIL",message=>$msg);$self->{_fail_install}{$dist->distfile}++}}}}sub _register_resolve_task {my ($self,@package)=@_;my$ok=1;for my$package (@package){if ($self->{_fail_resolve}{$package->{package}}|| $self->{_fail_install}{$package->{package}}){$ok=0;next}$self->add_task(type=>"resolve",package=>$package->{package},version_range=>$package->{version_range},)}return$ok}sub is_satisfied_perl_version {my ($self,$version_range)=@_;App::cpm::version->parse($self->{target_perl}|| $])->satisfy($version_range)}sub is_installed {my ($self,$package,$version_range)=@_;my$wantarray=wantarray;if (exists$self->{_is_installed}{$package}){if ($self->{_is_installed}{$package}->satisfy($version_range)){return$wantarray ? (1,$self->{_is_installed}{$package}): 1}}my$info=Module::Metadata->new_from_module($package,inc=>$self->{search_inc});return unless$info;if (!$self->{global}and $self->{_has_corelist}and $self->_in_core_inc($info->filename)){return if!exists$Module::CoreList::version{$]}{$info->name}}my$current_version=$self->{_is_installed}{$package}=App::cpm::version->parse($info->version);my$ok=$current_version->satisfy($version_range);$wantarray ? ($ok,$current_version): $ok}sub _in_core_inc {my ($self,$file)=@_;!!grep {$file =~ /^\Q$_/}@{$self->{core_inc}}}sub is_core {my ($self,$package,$version_range)=@_;my$target_perl=$self->{target_perl};if (exists$Module::CoreList::version{$target_perl}{$package}){if (!exists$Module::CoreList::version{$]}{$package}){if (!$self->{_removed_core}{$package}++){my$t=App::cpm::version->parse($target_perl)->normal;my$v=App::cpm::version->parse($])->normal;App::cpm::Logger->log(result=>"WARN",message=>"$package used to be core in $t, but not in $v, so will be installed",)}return}return 1 unless$version_range;my$core_version=$Module::CoreList::version{$target_perl}{$package};return App::cpm::version->parse($core_version)->satisfy($version_range)}return}sub is_satisfied {my ($self,$requirements)=@_;my$is_satisfied=1;my@need_resolve;my@distributions=$self->distributions;for my$req (@$requirements){my ($package,$version_range)=@{$req}{qw(package version_range)};if ($package eq "perl"){$is_satisfied=undef if!$self->is_satisfied_perl_version($version_range);next}next if$self->{target_perl}and $self->is_core($package,$version_range);next if$self->is_installed($package,$version_range);my ($resolved)=grep {$_->providing($package,$version_range)}@distributions;next if$resolved && $resolved->installed;$is_satisfied=0 if defined$is_satisfied;if (!$resolved){push@need_resolve,$req}}return ($is_satisfied,@need_resolve)}sub add_distribution {my ($self,$distribution)=@_;my$distfile=$distribution->distfile;if (my$already=$self->{distributions}{$distfile}){$already->overwrite_provide($_)for @{$distribution->provides};return 0}else {$self->{distributions}{$distfile}=$distribution;return 1}}sub _register_resolve_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_resolve}{$task->{package}}++;return}local$self->{logger}{context}=$task->{package};if ($task->{distfile}and $task->{distfile}=~ m{/perl-5[^/]+$}){my$message="Cannot upgrade core module $task->{package}.";$self->{logger}->log($message);App::cpm::Logger->log(result=>"FAIL",type=>"install",message=>$message,);$self->{_fail_install}{$task->{package}}++;return}if (!$task->{reinstall}){my$want=$task->{version_range}|| $task->{version};my ($ok,$local)=$self->is_installed($task->{package},$want);if ($ok){my$message=$task->{package}.(App::cpm::version->parse($task->{version})!=$local ? ", you already have $local" : " is up to date. ($local)");$self->{logger}->log($message);App::cpm::Logger->log(result=>"DONE",type=>"install",message=>$message,);return}}my$provides=$task->{provides};if (!$provides or @$provides==0){my$version=App::cpm::version->parse($task->{version})|| 0;$provides=[{package=>$task->{package},version=>$version}]}my$distribution=App::cpm::Distribution->new(source=>$task->{source},uri=>$task->{uri},provides=>$provides,distfile=>$task->{distfile},ref=>$task->{ref},);$self->add_distribution($distribution)}sub _register_fetch_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->directory($task->{directory});$distribution->meta($task->{meta});$distribution->provides($task->{provides});if ($task->{prebuilt}){$distribution->configured(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}};$distribution->prebuilt(1);local$self->{logger}{context}=$distribution->distvname;my$msg=join ", ",map {sprintf "%s (%s)",$_->{package},$_->{version}|| 0}@{$distribution->provides};$self->{logger}->log("Distribution provides: $msg")}else {$distribution->fetched(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}}}return 1}sub _register_configure_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->configured(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}};$distribution->static_builder($task->{static_builder});$distribution->distdata($task->{distdata});my$p=$task->{distdata}{provides};my@provide=map +{package=>$_,version=>$p->{$_}{version}},sort keys %$p;$distribution->provides(\@provide);local$self->{logger}{context}=$distribution->distvname;my$msg=join ", ",map {sprintf "%s (%s)",$_->{package},$_->{version}|| 0}@{$distribution->provides};$self->{logger}->log("Distribution provides: $msg");return 1}sub _register_install_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->installed(1);$self->{installed_distributions}++;return 1}sub installed_distributions {shift->{installed_distributions}}1;
APP_CPM_MASTER
$fatpacked{"App/cpm/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_REQUIREMENT';
package App::cpm::Requirement;use strict;use warnings;use App::cpm::version;sub new {my$class=shift;my$self=bless {requirement=>[]},$class;$self->add(@_)if @_;$self}sub empty {my$self=shift;@{$self->{requirement}}==0}sub has {my ($self,$package)=@_;my ($found)=grep {$_->{package}eq $package}@{$self->{requirement}};$found}sub add {my$self=shift;my%package=(@_,@_ % 2 ? (0): ());for my$package (sort keys%package){my$version_range=$package{$package};if (my ($found)=grep {$_->{package}eq $package}@{$self->{requirement}}){my$merged=eval {App::cpm::version::range_merge($found->{version_range},$version_range)};if (my$err=$@){if ($err =~ /illegal requirements/){$@="Couldn't merge version range '$version_range' with '$found->{version_range}' for package '$package'";warn $@;return}else {die$err}}$found->{version_range}=$merged}else {push @{$self->{requirement}},{package=>$package,version_range=>$version_range }}}return 1}sub merge {my ($self,$other)=@_;$self->add(map {($_->{package},$_->{version_range})}@{$other->as_array})}sub delete :method {my ($self,@package)=@_;for my$i (reverse 0 .. $#{$self->{requirement}}){my$current=$self->{requirement}[$i]{package};if (grep {$current eq $_}@package){splice @{$self->{requirement}},$i,1}}}sub as_array {my$self=shift;$self->{requirement}}1;
APP_CPM_REQUIREMENT
$fatpacked{"App/cpm/Resolver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER';
package App::cpm::Resolver;use strict;use warnings;1;
APP_CPM_RESOLVER
$fatpacked{"App/cpm/Resolver/02Packages.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_02PACKAGES';
package App::cpm::Resolver::02Packages;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use App::cpm::version;use CPAN::02Packages::Search;use Cwd ();use File::Basename ();use File::Copy ();use File::Path ();use File::Spec;use File::Which ();use IPC::Run3 ();sub new {my ($class,%option)=@_;my$cache_dir_base=$option{cache}or die "cache option is required\n";my$mirror=$option{mirror}or die "mirror option is required\n";$mirror =~ s{/*$}{/};my$path=$option{path}|| "${mirror}modules/02packages.details.txt.gz";my$cache_dir=$class->_cache_dir($mirror,$cache_dir_base);my$local_path=$class->_fetch($path=>$cache_dir);my$index=CPAN::02Packages::Search->new(file=>$local_path);bless {mirror=>$mirror,local_path=>$local_path,index=>$index },$class}sub _cache_dir {my ($class,$mirror,$base)=@_;if ($mirror !~ m{^https?://}){$mirror =~ s{^file://}{};$mirror=Cwd::abs_path($mirror);$mirror =~ s{^/}{}}$mirror =~ s{/$}{};$mirror =~ s/[^\w\.\-]+/%/g;my$dir="$base/$mirror";File::Path::mkpath([$dir],0,0777);return$dir}sub _fetch {my ($class,$path,$cache_dir)=@_;my$dest=File::Spec->catfile($cache_dir,File::Basename::basename($path));if ($path =~ m{^https?://}){my$res=App::cpm::HTTP->create->mirror($path=>$dest);die "$res->{status} $res->{reason}, $path\n" if!$res->{success}}else {$path =~ s{^file://}{};die "$path: No such file.\n" if!-f $path;if (!-f $dest or (stat$dest)[9]<= (stat$path)[9]){File::Copy::copy($path,$dest)or die "Copy $path $dest: $!\n";my$mtime=(stat$path)[9];utime$mtime,$mtime,$dest}}return$dest if$dest !~ /\.gz$/;my$plain=$dest;$plain =~ s/\.gz$//;if (!-f $plain or (stat$plain)[9]<= (stat$dest)[9]){my$gzip=File::Which::which('gzip');die "Need gzip command to decompress $dest\n" if!$gzip;my@cmd=($gzip,"-dc",$dest);IPC::Run3::run3 \@cmd,undef,$plain,\my$err;if ($?!=0){chomp$err;$err ||= "exit status $?";die "@cmd: $err\n"}}return$plain}sub resolve {my ($self,$task)=@_;my$res=$self->{index}->search($task->{package});if (!$res){return {error=>"not found, @{[$self->{local_path}]}" }}if (my$version_range=$task->{version_range}){my$version=$res->{version}|| 0;if (!App::cpm::version->parse($version)->satisfy($version_range)){return {error=>"found version $version, but it does not satisfy $version_range, @{[$self->{local_path}]}" }}}my$dist=App::cpm::DistNotation->new_from_dist($res->{path});return +{source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$res->{version}|| 0,package=>$task->{package},}}1;
APP_CPM_RESOLVER_02PACKAGES
$fatpacked{"App/cpm/Resolver/Cascade.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_CASCADE';
package App::cpm::Resolver::Cascade;use strict;use warnings;sub new {my$class=shift;bless {backends=>[]},$class}sub add {my ($self,$resolver)=@_;push @{$self->{backends}},$resolver;$self}sub resolve {my ($self,$task)=@_;my@error;for my$backend (@{$self->{backends}}){my$result=$backend->resolve($task);next unless$result;my$klass=ref$backend;$klass=$1 if$klass =~ /^App::cpm::Resolver::(.*)$/;if (my$error=$result->{error}){push@error,"$klass, $error"}else {$result->{from}=$klass;return$result}}return {error=>join("\n",@error)}}1;
APP_CPM_RESOLVER_CASCADE
$fatpacked{"App/cpm/Resolver/Custom.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_CUSTOM';
package App::cpm::Resolver::Custom;use strict;use warnings;use App::cpm::DistNotation;sub new {my ($class,%argv)=@_;my$from=$argv{from};my$requirements=$argv{requirements};my$mirror=$argv{mirror}|| 'https://cpan.metacpan.org/';$mirror =~ s{/*$}{/};my$self=bless {from=>$from,mirror=>$mirror,requirements=>$requirements,},$class;$self->_load;$self}sub _load {my$self=shift;my%resolve;for my$package (sort keys %{$self->{requirements}}){my$options=$self->{requirements}{$package};my$uri;if ($uri=$options->{git}){$resolve{$package}={source=>'git',uri=>$uri,ref=>$options->{ref},provides=>[{package=>$package}],}}elsif ($uri=$options->{dist}){my$dist=App::cpm::DistNotation->new_from_dist($uri);die "Unsupported dist '$uri' found in $self->{from}\n" if!$dist;my$cpan_uri=$dist->cpan_uri($options->{mirror}|| $self->{mirror});$resolve{$package}={source=>'cpan',uri=>$cpan_uri,distfile=>$dist->distfile,provides=>[{package=>$package}],}}elsif ($uri=$options->{url}){die "Unsupported url '$uri' found in $self->{from}\n" if$uri !~ m{^(?:https?|file)://};my$dist=App::cpm::DistNotation->new_from_uri($uri);my$source=$dist ? 'cpan' : $uri =~ m{^file://} ? 'local' : 'http';$resolve{$package}={source=>$source,uri=>$dist ? $dist->cpan_uri : $uri,($dist ? (distfile=>$dist->distfile): ()),provides=>[{package=>$package}],}}}$self->{resolve}=\%resolve}sub effective {my$self=shift;%{$self->{resolve}}? 1 : 0}sub resolve {my ($self,$task)=@_;my$found=$self->{resolve}{$task->{package}};if (!$found){return {error=>"not found in $self->{from}" }}$found}1;
APP_CPM_RESOLVER_CUSTOM
$fatpacked{"App/cpm/Resolver/MetaCPAN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_METACPAN';
package App::cpm::Resolver::MetaCPAN;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use JSON::PP ();sub new {my ($class,%option)=@_;my$uri=$option{uri}|| "https://fastapi.metacpan.org/v1/download_url/";$uri =~ s{/*$}{/};my$http=App::cpm::HTTP->create;bless {%option,uri=>$uri,http=>$http },$class}sub _encode {my$str=shift;$str =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$str}sub resolve {my ($self,$task)=@_;if ($self->{only_dev}and!$task->{dev}){return {error=>"skip, because MetaCPAN is configured to resolve dev releases only" }}my%query=((($self->{dev}|| $task->{dev})? (dev=>1): ()),($task->{version_range}? (version=>$task->{version_range}): ()),);my$query=join "&",map {"$_=" ._encode($query{$_})}sort keys%query;my$uri="$self->{uri}$task->{package}" .($query ? "?$query" : "");my$res;for (1..2){$res=$self->{http}->get($uri);last if$res->{success}or $res->{status}==404}if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my$hash=eval {JSON::PP::decode_json($res->{content})}or return;my$dist=App::cpm::DistNotation->new_from_uri($hash->{download_url});return {source=>"cpan",distfile=>$dist->distfile,package=>$task->{package},version=>$hash->{version}|| 0,uri=>$hash->{download_url},}}1;
APP_CPM_RESOLVER_METACPAN
$fatpacked{"App/cpm/Resolver/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_METADB';
package App::cpm::Resolver::MetaDB;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use App::cpm::version;use CPAN::Meta::YAML;sub new {my ($class,%option)=@_;my$uri=$option{uri}|| "https://cpanmetadb.plackperl.org/v1.0/";my$mirror=$option{mirror}|| "https://cpan.metacpan.org/";s{/*$}{/} for$uri,$mirror;my$http=App::cpm::HTTP->create;bless {%option,http=>$http,uri=>$uri,mirror=>$mirror,},$class}sub _get {my ($self,$uri)=@_;my$res;for (1..2){$res=$self->{http}->get($uri);last if$res->{success}or $res->{status}==404}$res}sub _uniq {my%x;grep {!$x{$_ || ""}++}@_}sub resolve {my ($self,$task)=@_;if (defined$task->{version_range}and $task->{version_range}=~ /(?:<|!=|==)/){my$uri="$self->{uri}history/$task->{package}";my$res=$self->_get($uri);if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my@found;for my$line (split /\r?\n/,$res->{content}){if ($line =~ /^$task->{package}\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_o=>App::cpm::version->parse($1),distfile=>$2,}}}$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_o}<=> $a->{version_o}}@found){if ($try->{version_o}->satisfy($task->{version_range})){$match=$try,last}}if ($match){my$dist=App::cpm::DistNotation->new_from_dist($match->{distfile});return {source=>"cpan",package=>$task->{package},version=>$match->{version},uri=>$dist->cpan_uri($self->{mirror}),distfile=>$dist->distfile,}}else {return {error=>"found versions @{[join ',', _uniq map $_->{version}, @found]}, but they do not satisfy $task->{version_range}, $uri" }}}else {my$uri="$self->{uri}package/$task->{package}";my$res=$self->_get($uri);if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my$yaml=CPAN::Meta::YAML->read_string($res->{content});my$meta=$yaml->[0];if (!App::cpm::version->parse($meta->{version})->satisfy($task->{version_range})){return {error=>"found version $meta->{version}, but it does not satisfy $task->{version_range}, $uri" }}my@provides=map {my$package=$_;my$version=$meta->{provides}{$_};$version=undef if$version eq "undef";+{package=>$package,version=>$version }}sort keys %{$meta->{provides}};my$dist=App::cpm::DistNotation->new_from_dist($meta->{distfile});return {source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$meta->{version},provides=>\@provides,}}return}1;
APP_CPM_RESOLVER_METADB
$fatpacked{"App/cpm/Resolver/Snapshot.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_SNAPSHOT';
package App::cpm::Resolver::Snapshot;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::version;use Carton::Snapshot;sub new {my ($class,%option)=@_;my$snapshot=Carton::Snapshot->new(path=>$option{path}|| "cpanfile.snapshot");$snapshot->load;my$mirror=$option{mirror}|| "https://cpan.metacpan.org/";$mirror =~ s{/*$}{/};bless {%option,mirror=>$mirror,snapshot=>$snapshot },$class}sub snapshot {shift->{snapshot}}sub resolve {my ($self,$task)=@_;my$package=$task->{package};my$found=$self->snapshot->find($package);if (!$found){return {error=>"not found, @{[$self->snapshot->path]}" }}my$version=$found->version_for($package);if (my$version_range=$task->{version_range}){if (!App::cpm::version->parse($version)->satisfy($version_range)){return {error=>"found version $version, but it does not satisfy $version_range, @{[$self->snapshot->path]}" }}}my@provides=map {my$package=$_;my$version=$found->provides->{$_}{version};+{package=>$package,version=>$version }}sort keys %{$found->provides};my$dist=App::cpm::DistNotation->new_from_dist($found->distfile);return {source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$version || 0,provides=>\@provides,}}1;
APP_CPM_RESOLVER_SNAPSHOT
$fatpacked{"App/cpm/Task.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_TASK';
package App::cpm::Task;use strict;use warnings;use CPAN::DistnameInfo;sub new {my ($class,%option)=@_;my$self=bless {%option},$class;$self->{uid}=$self->_uid;$self}sub uid {shift->{uid}}sub _uid {my$self=shift;my$type=$self->type;if (grep {$type eq $_}qw(fetch configure install)){"$type " .$self->distfile}elsif ($type eq "resolve"){"$type " .$self->{package}}else {die "unknown type: " .($type || "(undef)")}}sub distfile {my$self=shift;$self->{distfile}|| $self->{uri}}sub distvname {my$self=shift;return$self->{_distvname}if$self->{_distvname};if ($self->{distfile}){$self->{_distvname}||= CPAN::DistnameInfo->new($self->{distfile})->distvname}elsif ($self->{uri}){$self->{uri}}elsif ($self->{package}){$self->{package}}else {"UNKNOWN"}}sub distname {my$self=shift;$self->{_distname}||= CPAN::DistnameInfo->new($self->distfile)->dist || 'UNKNOWN'}sub cpanid {my$self=shift;$self->{_cpanid}||= CPAN::DistnameInfo->new($self->distfile)->cpanid || 'UNKNOWN'}sub type {my$self=shift;$self->{type}}sub in_charge {my$self=shift;@_ ? $self->{in_charge}=shift : $self->{in_charge}}sub is_success {my$self=shift;$self->{ok}}sub equals {my ($self,$that)=@_;$self->uid eq $that->uid}sub merge {my ($self,$that)=@_;for my$key (keys %$that){$self->{$key}=$that->{$key}}$self}1;
APP_CPM_TASK
$fatpacked{"App/cpm/Tutorial.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_TUTORIAL';
package App::cpm::Tutorial;use strict;use warnings;1;
APP_CPM_TUTORIAL
$fatpacked{"App/cpm/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_UTIL';
package App::cpm::Util;use strict;use warnings;use Config;use Cwd ();use Digest::MD5 ();use File::Spec;use Exporter 'import';our@EXPORT_OK=qw(perl_identity maybe_abs WIN32 determine_home);use constant WIN32=>$^O eq 'MSWin32';sub perl_identity {my$digest=Digest::MD5::md5_hex($Config{perlpath}.Config->myconfig);$digest=substr$digest,0,8;join '-',$Config{version},$Config{archname},$digest}sub maybe_abs {my$path=shift;if (File::Spec->file_name_is_absolute($path)){return$path}my$cwd=shift || Cwd::cwd();File::Spec->canonpath(File::Spec->catdir($cwd,$path))}sub determine_home {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)}File::Spec->catdir($homedir,".perl-cpm")}1;
APP_CPM_UTIL
$fatpacked{"App/cpm/Worker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER';
package App::cpm::Worker;use strict;use warnings;use App::cpm::Logger::File;use App::cpm::Util;use App::cpm::Worker::Installer;use App::cpm::Worker::Resolver;use Config;use File::Path ();use File::Spec;use Time::HiRes qw(gettimeofday tv_interval);sub new {my ($class,%option)=@_;my$home=$option{home};my$logger=$option{logger}|| App::cpm::Logger::File->new("$home/build.log.@{[time]}");my$prebuilt_base;if ($option{prebuilt}){$prebuilt_base=$class->prebuilt_base($home);File::Path::mkpath($prebuilt_base)if!-d $prebuilt_base;my$file="$prebuilt_base/version";if (!-f $file){open my$fh,">",$file or die "$file: $!";print {$fh}"$Config{perlpath}\n"}}%option=(%option,logger=>$logger,base=>"$home/work/" .time .".$$",cache=>"$home/cache",$prebuilt_base ? (prebuilt_base=>$prebuilt_base): (),);my$installer=App::cpm::Worker::Installer->new(%option);my$resolver=App::cpm::Worker::Resolver->new(%option,impl=>$option{resolver});bless {%option,installer=>$installer,resolver=>$resolver },$class}sub prebuilt_base {my ($class,$home)=@_;my$identity=App::cpm::Util::perl_identity;File::Spec->catdir($home,"builds",$identity)}sub work {my ($self,$task)=@_;my$type=$task->{type}|| "(undef)";my$result;my$start=$self->{verbose}? [gettimeofday]: undef;if (grep {$type eq $_}qw(fetch configure install)){$result=eval {$self->{installer}->work($task)};warn $@ if $@}elsif ($type eq "resolve"){$result=eval {$self->{resolver}->work($task)};warn $@ if $@}else {die "Unknown type: $type\n"}my$elapsed=$start ? tv_interval($start): undef;$result ||= {ok=>0 };$task->merge({%$result,pid=>$$,elapsed=>$elapsed});return$task}1;
APP_CPM_WORKER
$fatpacked{"App/cpm/Worker/Installer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER';
package App::cpm::Worker::Installer;use strict;use warnings;use App::cpm::Logger::File;use App::cpm::Requirement;use App::cpm::Worker::Installer::Menlo;use App::cpm::Worker::Installer::Prebuilt;use App::cpm::version;use CPAN::DistnameInfo;use CPAN::Meta;use Config;use ExtUtils::Install ();use ExtUtils::InstallPaths ();use File::Basename 'basename';use File::Copy ();use File::Copy::Recursive ();use File::Path qw(mkpath rmtree);use File::Spec;use File::Temp ();use File::pushd 'pushd';use JSON::PP ();use Time::HiRes ();use constant NEED_INJECT_TOOLCHAIN_REQUIREMENTS=>$] < 5.018;my$TRUSTED_MIRROR=sub {my$uri=shift;!!($uri =~ m{^https?://(?:www.cpan.org|backpan.perl.org|cpan.metacpan.org)})};sub work {my ($self,$task)=@_;my$type=$task->{type}|| "(undef)";local$self->{logger}{context}=$task->distvname;if ($type eq "fetch"){if (my$result=$self->fetch($task)){return +{ok=>1,directory=>$result->{directory},meta=>$result->{meta},requirements=>$result->{requirements},provides=>$result->{provides},using_cache=>$result->{using_cache},prebuilt=>$result->{prebuilt},}}else {$self->{logger}->log("Failed to fetch/configure distribution")}}elsif ($type eq "configure"){if (my$result=$self->configure($task)){return +{ok=>1,distdata=>$result->{distdata},requirements=>$result->{requirements},static_builder=>$result->{static_builder},}}else {$self->{logger}->log("Failed to configure distribution")}}elsif ($type eq "install"){my$ok=$self->install($task);my$message=$ok ? "Successfully installed distribution" : "Failed to install distribution";$self->{logger}->log($message);return {ok=>$ok,directory=>$task->{directory}}}else {die "Unknown type: $type\n"}return {ok=>0 }}sub new {my ($class,%option)=@_;$option{logger}||= App::cpm::Logger::File->new;$option{base}or die "base option is required\n";$option{cache}or die "cache option is required\n";mkpath $_ for grep!-d,$option{base},$option{cache};$option{logger}->log("Work directory is $option{base}");my$menlo=App::cpm::Worker::Installer::Menlo->new(static_install=>$option{static_install},base=>$option{base},logger=>$option{logger},quiet=>1,pod2man=>$option{man_pages},notest=>$option{notest},sudo=>$option{sudo},mirrors=>["https://cpan.metacpan.org/"],configure_timeout=>$option{configure_timeout},build_timeout=>$option{build_timeout},test_timeout=>$option{test_timeout},);if ($option{local_lib}){my$local_lib=$option{local_lib}=$menlo->maybe_abs($option{local_lib});$menlo->{self_contained}=1;$menlo->log("Setup local::lib $local_lib");$menlo->setup_local_lib($local_lib)}$menlo->log("--",`$^X -V`,"--");$option{prebuilt}=App::cpm::Worker::Installer::Prebuilt->new if$option{prebuilt};bless {%option,menlo=>$menlo },$class}sub menlo {shift->{menlo}}sub _fetch_git {my ($self,$uri,$ref)=@_;my$basename=File::Basename::basename($uri);$basename =~ s/\.git$//;$basename =~ s/[^a-zA-Z0-9_.-]/-/g;my$dir=File::Temp::tempdir("$basename-XXXXX",CLEANUP=>0,DIR=>$self->menlo->{base},);$self->menlo->mask_output(diag_progress=>"Cloning $uri");$self->menlo->run_command(['git','clone',$uri,$dir ]);unless (-e "$dir/.git"){$self->menlo->diag_fail("Failed cloning git repository $uri",1);return}my$guard=pushd$dir;if ($ref){unless ($self->menlo->run_command(['git','checkout',$ref ])){$self->menlo->diag_fail("Failed to checkout '$ref' in git repository $uri\n");return}}$self->menlo->diag_ok;chomp(my$rev=`git rev-parse --short HEAD`);($dir,$rev)}sub enable_prebuilt {my ($self,$uri)=@_;$self->{prebuilt}&&!$self->{prebuilt}->skip($uri)&& $TRUSTED_MIRROR->($uri)}sub fetch {my ($self,$task)=@_;my$guard=pushd;my$source=$task->{source};my$distfile=$task->{distfile};my$uri=$task->{uri};if ($self->enable_prebuilt($uri)){if (my$result=$self->find_prebuilt($uri)){$self->{logger}->log("Using prebuilt $result->{directory}");return$result}}my ($dir,$rev,$using_cache);if ($source eq "git"){($dir,$rev)=$self->_fetch_git($uri,$task->{ref})}elsif ($source eq "local"){$self->{logger}->log("Copying $uri");$uri =~ s{^file://}{};$uri=$self->menlo->maybe_abs($uri);my$basename=basename$uri;my$g=pushd$self->menlo->{base};if (-d $uri){my$dest=File::Temp::tempdir("$basename-XXXXX",CLEANUP=>0,DIR=>$self->menlo->{base},);File::Copy::Recursive::dircopy($uri,$dest);$dir=$dest}elsif (-f $uri){my$dest=$basename;File::Copy::copy($uri,$dest);$dir=$self->menlo->unpack($basename);$dir=File::Spec->catdir($self->menlo->{base},$dir)if$dir}}elsif ($source =~ /^(?:cpan|https?)$/){my$g=pushd$self->menlo->{base};FETCH: {my$basename=basename$uri;if ($uri =~ s{^file://}{}){$self->{logger}->log("Copying $uri");File::Copy::copy($uri,$basename)or last FETCH;$dir=$self->menlo->unpack($basename)}else {local$self->menlo->{save_dists};if ($distfile and $TRUSTED_MIRROR->($uri)){my$cache=File::Spec->catfile($self->{cache},"authors/id/$distfile");if (-f $cache){$self->{logger}->log("Using cache $cache");File::Copy::copy($cache,$basename);$dir=$self->menlo->unpack($basename);if ($dir){$using_cache++;last FETCH}unlink$cache}$self->menlo->{save_dists}=$self->{cache}}$dir=$self->menlo->fetch_module({uris=>[$uri],pathname=>$distfile})}}$dir=File::Spec->catdir($self->menlo->{base},$dir)if$dir}return unless$dir;chdir$dir or die;my$meta=$self->_load_metafile($distfile,'META.json','META.yml');if (!$meta){$self->{logger}->log("Distribution does not have META.json nor META.yml");return}my$p=$meta->{provides}|| $self->menlo->extract_packages($meta,".");my$provides=[map +{package=>$_,version=>$p->{$_}{version}},sort keys %$p ];my$req={configure=>App::cpm::Requirement->new };if ($self->menlo->opts_in_static_install($meta)){$self->{logger}->log("Distribution opts in x_static_install: $meta->{x_static_install}")}else {$req={configure=>$self->_extract_configure_requirements($meta,$distfile)}}return +{directory=>$dir,meta=>$meta,requirements=>$req,provides=>$provides,using_cache=>$using_cache,}}sub find_prebuilt {my ($self,$uri)=@_;my$info=CPAN::DistnameInfo->new($uri);my$dir=File::Spec->catdir($self->{prebuilt_base},$info->cpanid,$info->distvname);return unless -f File::Spec->catfile($dir,".prebuilt");my$guard=pushd$dir;my$meta=$self->_load_metafile($uri,'META.json','META.yml');my$mymeta=$self->_load_metafile($uri,'blib/meta/MYMETA.json');my$phase=$self->{notest}? [qw(build runtime)]: [qw(build test runtime)];my%req;if (!$self->menlo->opts_in_static_install($meta)){%req=(configure=>$self->_extract_configure_requirements($meta,$uri))}%req=(%req,%{$self->_extract_requirements($mymeta,$phase)});my$provides=do {open my$fh,"<",'blib/meta/install.json' or die;my$json=JSON::PP::decode_json(do {local $/;<$fh>});my$provides=$json->{provides};[map +{package=>$_,version=>$provides->{$_}{version}},sort keys %$provides ]};return +{directory=>$dir,meta=>$meta->as_struct,provides=>$provides,prebuilt=>1,requirements=>\%req,}}sub save_prebuilt {my ($self,$task)=@_;my$dir=File::Spec->catdir($self->{prebuilt_base},$task->cpanid,$task->distvname);if (-d $dir and!File::Path::rmtree($dir)){return}my$parent=File::Basename::dirname($dir);for (1..3){last if -d $parent;eval {File::Path::mkpath($parent)}}return unless -d $parent;$self->{logger}->log("Saving the build $task->{directory} in $dir");if (File::Copy::Recursive::dircopy($task->{directory},$dir)){open my$fh,">",File::Spec->catfile($dir,".prebuilt")or die $!}else {warn "dircopy $task->{directory} $dir: $!"}}sub _inject_toolchain_requirements {my ($self,$distfile,$requirement)=@_;$distfile ||= "";if (-f "Makefile.PL" and!$requirement->has('ExtUtils::MakeMaker')and!-f "Build.PL" and $distfile !~ m{/ExtUtils-MakeMaker-[0-9v]}){$requirement->add('ExtUtils::MakeMaker')}if ($requirement->has('Module::Build')){$requirement->add('ExtUtils::Install')}my%inject=('Module::Build'=>'0.38','ExtUtils::MakeMaker'=>'6.64','ExtUtils::Install'=>'1.46',);for my$package (sort keys%inject){$requirement->has($package)or next;$requirement->add($package,$inject{$package})}$requirement}sub _load_metafile {my ($self,$distfile,@file)=@_;my$meta;if (my ($file)=grep -f,@file){$meta=eval {CPAN::Meta->load_file($file)};$self->{logger}->log("Invalid $file: $@")if $@}if (!$meta and $distfile){my$d=CPAN::DistnameInfo->new($distfile);$meta=CPAN::Meta->new({name=>$d->dist,version=>$d->version})}$meta}sub _extract_configure_requirements {my ($self,$meta,$distfile)=@_;my$requirement=$self->_extract_requirements($meta,[qw(configure)])->{configure};if ($requirement->empty and -f "Build.PL" and ($distfile || "")!~ m{/Module-Build-[0-9v]}){$requirement->add("Module::Build"=>"0.38")}if (NEED_INJECT_TOOLCHAIN_REQUIREMENTS){$self->_inject_toolchain_requirements($distfile,$requirement)}return$requirement}sub _extract_requirements {my ($self,$meta,$phases)=@_;$phases=[$phases]unless ref$phases;my$hash=$meta->effective_prereqs->as_string_hash;my%req;for my$phase (@$phases){my$req=App::cpm::Requirement->new;my$from=($hash->{$phase}|| +{})->{requires}|| +{};for my$package (sort keys %$from){$req->add($package,$from->{$package})}$req{$phase}=$req}\%req}sub _retry {my ($self,$sub)=@_;return 1 if$sub->();return unless$self->{retry};Time::HiRes::sleep(0.1);$self->{logger}->log("! Retrying (you can turn off this behavior by --no-retry)");return$sub->()}sub configure {my ($self,$task)=@_;my ($dir,$distfile,$meta,$source)=@{$task}{qw(directory distfile meta source)};my$guard=pushd$dir;my$menlo=$self->menlo;my$menlo_dist={meta=>$meta,cpanmeta=>$meta };$self->{logger}->log("Configuring distribution");my ($static_builder,$configure_ok);{if ($menlo->opts_in_static_install($meta)){my$state={};$menlo->static_install_configure($state,$menlo_dist,1);$static_builder=$state->{static_install};++$configure_ok and last}if (-f 'Build.PL'){my@cmd=($menlo->{perl},'Build.PL');push@cmd,'--pureperl-only' if$self->{pureperl_only};$self->_retry(sub {$menlo->configure(\@cmd,$menlo_dist,1);-f 'Build'})and ++$configure_ok and last}if (-f 'Makefile.PL'){if (!$menlo->{make}){$self->{logger}->log("There is Makefile.PL, but you don't have 'make' command; you should install 'make' command first");last}my@cmd=($menlo->{perl},'Makefile.PL');push@cmd,'PUREPERL_ONLY=1' if$self->{pureperl_only};$self->_retry(sub {$menlo->configure(\@cmd,$menlo_dist,1);-f 'Makefile'})and ++$configure_ok and last}}return unless$configure_ok;my$distdata=$self->_build_distdata($source,$distfile,$meta);my$phase=$self->{notest}? [qw(build runtime)]: [qw(build test runtime)];my$mymeta=$self->_load_metafile($distfile,'MYMETA.json','MYMETA.yml');my$req=$self->_extract_requirements($mymeta,$phase);return +{distdata=>$distdata,requirements=>$req,static_builder=>$static_builder,}}sub _build_distdata {my ($self,$source,$distfile,$meta)=@_;my$menlo=$self->menlo;my$fake_state={configured_ok=>1,use_module_build=>-f "Build" };my$module_name=$menlo->find_module_name($fake_state)|| $meta->{name};$module_name =~ s/-/::/g;my$distvname=CPAN::DistnameInfo->new($distfile)->distvname;my$provides=$meta->{provides}|| $menlo->extract_packages($meta,".");+{distvname=>$distvname,pathname=>$distfile,provides=>$provides,version=>$meta->{version}|| 0,source=>$source,module_name=>$module_name,}}sub install {my ($self,$task)=@_;return$self->install_prebuilt($task)if$task->{prebuilt};my ($dir,$distdata,$static_builder,$distvname,$meta)=@{$task}{qw(directory distdata static_builder distvname meta)};my$guard=pushd$dir;my$menlo=$self->menlo;my$menlo_dist={meta=>$meta };$self->{logger}->log("Building " .($menlo->{notest}? "" : "and testing ")."distribution");my$installed;if ($static_builder){$menlo->build(sub {$static_builder->build},$distvname,$menlo_dist)&& $menlo->test(sub {$static_builder->build("test")},$distvname,$menlo_dist)&& $menlo->install(sub {$static_builder->build("install")},[],$distvname,$menlo_dist)&& $installed++}elsif (-f 'Build'){$self->_retry(sub {$menlo->build([$menlo->{perl},"./Build" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->test([$menlo->{perl},"./Build","test" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->install([$menlo->{perl},"./Build","install" ],[],$distvname,$menlo_dist)})&& $installed++}else {$self->_retry(sub {$menlo->build([$menlo->{make}],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->test([$menlo->{make},"test" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->install([$menlo->{make},"install" ],[],$distvname,$menlo_dist)})&& $installed++}if ($installed && $distdata){$menlo->save_meta($distdata->{module_name},$distdata,$distdata->{module_name},);$self->save_prebuilt($task)if$self->enable_prebuilt($task->{uri})}return$installed}sub install_prebuilt {my ($self,$task)=@_;my$install_base=$self->{local_lib};if (!$install_base && ($ENV{PERL_MM_OPT}|| '')=~ /INSTALL_BASE=(\S+)/){$install_base=$1}$self->{logger}->log("Copying prebuilt $task->{directory}/blib");my$guard=pushd$task->{directory};my$paths=ExtUtils::InstallPaths->new(dist_name=>$task->distname,$install_base ? (install_base=>$install_base): (),);my$install_base_meta=$install_base ? "$install_base/lib/perl5" : $Config{sitelibexp};my$distvname=$task->distvname;open my$fh,">",\my$stdout;{local*STDOUT=$fh;ExtUtils::Install::install([from_to=>$paths->install_map,verbose=>0,dry_run=>0,uninstall_shadows=>0,skip=>undef,always_copy=>1,result=>\my%result,]);ExtUtils::Install::install({'blib/meta'=>"$install_base_meta/$Config{archname}/.meta/$distvname",})}$self->{logger}->log($stdout);return 1}1;
APP_CPM_WORKER_INSTALLER
$fatpacked{"App/cpm/Worker/Installer/Menlo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER_MENLO';
package App::cpm::Worker::Installer::Menlo;use strict;use warnings;use parent 'Menlo::CLI::Compat';use App::cpm::HTTP;use App::cpm::Installer::Unpacker;use App::cpm::Logger::File;use App::cpm::Util 'WIN32';use Command::Runner;use Config;use File::Which ();use Menlo::Builder::Static;sub new {my ($class,%option)=@_;$option{log}||= $option{logger}->file;my$self=$class->SUPER::new(%option);if ($self->{make}=File::Which::which($Config{make})){$self->{logger}->log("You have make $self->{make}")}{my ($http,$desc)=App::cpm::HTTP->create;$self->{http}=$http;$self->{logger}->log("You have $desc")}{$self->{unpacker}=App::cpm::Installer::Unpacker->new;my$desc=$self->{unpacker}->describe;for my$key (sort keys %$desc){$self->{logger}->log("You have $key $desc->{$key}")}}$self->{initialized}=1;$self}sub unpack {my ($self,$file)=@_;$self->{logger}->log("Unpacking $file");my ($dir,$err)=$self->{unpacker}->unpack($file);$self->{logger}->log($err)if!$dir && $err;$dir}sub mirror {my ($self,$uri,$local)=@_;if ($uri =~ /^file:/){return$self->file_mirror($uri,$local)}my$res=$self->{http}->mirror($uri,$local);$self->{logger}->log($res->{status}.($res->{reason}? " $res->{reason}" : ""));return 1 if$res->{success};unlink$local;$self->{logger}->log($res->{content})if$res->{status}==599;return}sub log {my$self=shift;$self->{logger}->log(@_)}sub run_command {my ($self,$cmd)=@_;$self->run_timeout($cmd,0)}sub run_timeout {my ($self,$cmd,$timeout)=@_;my$str=ref$cmd eq 'CODE' ? '' : ref$cmd eq 'ARRAY' ? "@$cmd" : $cmd;$self->{logger}->log("Executing $str")if$str;my$runner=Command::Runner->new(command=>$cmd,keep=>0,redirect=>1,timeout=>$timeout,stdout=>sub {$self->log(@_)},);my$res=$runner->run;if ($res->{timeout}){$self->diag_fail("Timed out (> ${timeout}s).");return}my$result=$res->{result};ref$cmd eq 'CODE' ? $result : $result==0}1;
APP_CPM_WORKER_INSTALLER_MENLO
$fatpacked{"App/cpm/Worker/Installer/Prebuilt.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER_PREBUILT';
package App::cpm::Worker::Installer::Prebuilt;use strict;use warnings;my@SKIP=(qr{/XML-SAX-v?[0-9\.]+\.tar\.gz$},);sub new {my$class=shift;bless {},$class}sub skip {my ($self,$uri)=@_;!!grep {$uri =~ $_}@SKIP}1;
APP_CPM_WORKER_INSTALLER_PREBUILT
$fatpacked{"App/cpm/Worker/Resolver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_RESOLVER';
package App::cpm::Worker::Resolver;use strict;use warnings;use App::cpm::Logger::File;sub new {my ($class,%option)=@_;my$logger=$option{logger}|| App::cpm::Logger::File->new;bless {impl=>$option{impl},logger=>$logger },$class}sub work {my ($self,$task)=@_;local$self->{logger}->{context}=$task->{package};my$result=$self->{impl}->resolve($task);if ($result and!$result->{error}){$result->{ok}=1;my$msg=sprintf "Resolved %s (%s) -> %s",$task->{package},$task->{version_range}|| 0,$result->{uri}.($result->{from}? " from $result->{from}" : "");$self->{logger}->log($msg);return$result}else {$self->{logger}->log($result->{error})if$result and $result->{error};$self->{logger}->log(sprintf "Failed to resolve %s",$task->{package});return {ok=>0 }}}1;
APP_CPM_WORKER_RESOLVER
$fatpacked{"App/cpm/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_VERSION';
package App::cpm::version;use strict;use warnings;use CPAN::Meta::Requirements;use parent 'version';sub satisfy {my ($self,$version_range)=@_;return 1 unless$version_range;return$self >= (ref$self)->parse($version_range)if$version_range =~ /^v?[\d_.]+$/;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement('DummyModule',$version_range);$requirements->accepts_module('DummyModule',$self->numify)}sub numify {local$SIG{__WARN__}=sub {};shift->SUPER::numify(@_)}sub parse {local$SIG{__WARN__}=sub {};shift->SUPER::parse(@_)}sub range_merge {my ($range1,$range2)=@_;my$req=CPAN::Meta::Requirements->new;$req->add_string_requirement('DummyModule',$_)for$range1,$range2;$req->requirements_for_module('DummyModule')}1;
APP_CPM_VERSION
$fatpacked{"CPAN/02Packages/Search.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_02PACKAGES_SEARCH';
package CPAN::02Packages::Search;use strict;use warnings;use IO::Handle;use Search::Dict ();use Tie::Handle::SkipHeader;our$VERSION='0.001';sub new {my ($class,%argv)=@_;my$file=$argv{file};my$skip_header=exists$argv{skip_header}? $argv{skip_header}: 1;my$self=bless {file=>$file,skip_header=>$skip_header },$class;$self->_fh;$self}sub _fh {my$self=shift;return$self->{fh}if defined$self->{pid}&& $self->{pid}==$$;my$file=$self->{file};if ($self->{skip_header}){my$fh=IO::Handle->new;tie *$fh,'Tie::Handle::SkipHeader','<',$file or die "$!: $file\n";$self->{fh}=$fh}else {open my$fh,"<",$file or die "$!: $file\n";$self->{fh}=$fh}$self->{pid}=$$;$self->{fh}}sub search {my ($self,$package)=@_;my$fh=$self->_fh;seek$fh,0,0;my$pos=Search::Dict::look$fh,$package,{xfrm=>\&_xform_package,fold=>1 };return if$pos==-1 || eof$fh;while (my$line=<$fh>){last if$line !~ /\A\Q$package\E\s+/i;chomp$line;my ($_package,$version,$path)=split /\s+/,$line,4;if ($package eq $_package){$version=undef if$version eq 'undef';return {version=>$version,path=>$path }}}return}sub _xform_package {(split " ",$_[0],2)[0]}1;
CPAN_02PACKAGES_SEARCH
$fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO';
package CPAN::DistnameInfo;$VERSION="0.12";use strict;sub distname_info {my$file=shift or return;my ($dist,$version)=$file =~ /^
((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
(?:
[A-Za-z](?=[^A-Za-z]|$)
|
\d(?=-)
)(?<![._-][vV])
)+)(.*)
$/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;
CPAN_DISTNAMEINFO
$fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META';
use 5.006;use strict;use warnings;package CPAN::Meta;our$VERSION='2.150010';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;
CPAN_META
$fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK';
package CPAN::Meta::Check;$CPAN::Meta::Check::VERSION='0.014';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 sprintf 'Installed version (%s) of %s is not in range \'%s\'',(defined$version ? $version : 'undef'),$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 sprintf 'Installed version (%s) of %s is in range \'%s\'',(defined$version ? $version : 'undef'),$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;
CPAN_META_CHECK
$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
use 5.006;use strict;use warnings;package CPAN::Meta::Converter;our$VERSION='2.150010';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}};our$DCLONE_MAXDEPTH=1024;our$_CLONE_DEPTH;sub _dclone {my ($ref)=@_;return$ref unless my$reftype=ref$ref;local$_CLONE_DEPTH=defined$_CLONE_DEPTH ? $_CLONE_DEPTH - 1 : $DCLONE_MAXDEPTH;die "Depth Limit $DCLONE_MAXDEPTH Exceeded" if$_CLONE_DEPTH==0;return [map {_dclone($_)}@{$ref}]if 'ARRAY' eq $reftype;return {map {$_=>_dclone($ref->{$_})}keys %{$ref}}if 'HASH' eq $reftype;if ('SCALAR' eq $reftype){my$new=_dclone(${$ref});return \$new}if (eval {$ref->can('TO_JSON')}){my$data=$ref->TO_JSON;return ref$data ? _dclone($data): $data}return "$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_
(?:x-?)? # Remove leading x- or x (if present)
/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;
CPAN_META_CONVERTER
$fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE';
use 5.006;use strict;use warnings;package CPAN::Meta::Feature;our$VERSION='2.150010';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;
CPAN_META_FEATURE
$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
use 5.006;use strict;use warnings;package CPAN::Meta::History;our$VERSION='2.150010';1;
CPAN_META_HISTORY
$fatpacked{"CPAN/Meta/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_MERGE';
use strict;use warnings;package CPAN::Meta::Merge;our$VERSION='2.150010';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 _improvise {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'=>\&_improvise,},':default'=>\&_improvise,);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,improvise=>\&_improvise,improvize=>\&_improvise,);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;
CPAN_META_MERGE
$fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
use 5.006;use strict;use warnings;package CPAN::Meta::Prereqs;our$VERSION='2.150010';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 phases {my ($self)=@_;my%is_legal_phase=map {;$_=>1}$self->__legal_phases;grep {/\Ax_/i or $is_legal_phase{$_}}keys %{$self->{prereqs}}}sub types_in {my ($self,$phase)=@_;return unless$phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases;my%is_legal_type=map {;$_=>1}$self->__legal_types;grep {/\Ax_/i or $is_legal_type{$_}}keys %{$self->{prereqs}{$phase}}}sub with_merged_prereqs {my ($self,$other)=@_;my@other=blessed($other)? $other : @$other;my@prereq_objs=($self,@other);my%new_arg;for my$phase (__uniq(map {$_->phases}@prereq_objs)){for my$type (__uniq(map {$_->types_in($phase)}@prereq_objs)){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->phases){for my$type ($self->types_in($phase)){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)}sub __uniq {my (%s,$u);grep {defined($_)?!$s{$_}++ :!$u++}@_}1;
CPAN_META_PREREQS
$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
use 5.006;use strict;use warnings;package CPAN::Meta::Requirements;our$VERSION='2.140';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' || (ref($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}if ($] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1)ne 'v' && length($version)< 3){$version .= "\0" x (3 - length($version))}eval {local$SIG{__WARN__}=sub {die "Invalid version: $_[0]"};die "Invalid version: $version" if$version eq 'version';$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,$name)}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 structured_requirements_for_module {my ($self,$module)=@_;my$entry=$self->__entry_for($module);return unless$entry;return$entry->as_struct}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,$name);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_struct {return [['==',"$_[0]{version}" ]]}sub as_modifiers {return [[exact_version=>$_[0]{version}]]}sub _reject_requirements {my ($self,$module,$error)=@_;Carp::confess("illegal requirements for $module: $error")}sub _clone {(ref $_[0])->_new(version->new($_[0]{version}))}sub with_exact_version {my ($self,$version,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->_accepts($version);$self->_reject_requirements($module,"can't be exactly $version when exact requirement is already $self->{version}",)}sub with_minimum {my ($self,$minimum,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->{version}>= $minimum;$self->_reject_requirements($module,"minimum $minimum exceeds exact specification $self->{version}",)}sub with_maximum {my ($self,$maximum,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->{version}<= $maximum;$self->_reject_requirements($module,"maximum $maximum below exact specification $self->{version}",)}sub with_exclusion {my ($self,$exclusion,$module)=@_;$module='module' unless defined$module;return$self->_clone unless$exclusion==$self->{version};$self->_reject_requirements($module,"tried to exclude $exclusion, which is already exactly specified",)}}{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_struct {my ($self)=@_;return 0 if!keys %$self;my@exclusions=@{$self->{exclusions}|| []};my@parts;for my$tuple ([qw(>= > minimum) ],[qw(<= < maximum) ],){my ($op,$e_op,$k)=@$tuple;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 \@parts}sub as_string {my ($self)=@_;my@parts=@{$self->as_struct};return$parts[0][1]if@parts==1 and $parts[0][0]eq '>=';return join q{, },map {;join q{ },@$_}@parts}sub _reject_requirements {my ($self,$module,$error)=@_;Carp::confess("illegal requirements for $module: $error")}sub with_exact_version {my ($self,$version,$module)=@_;$module='module' unless defined$module;$self=$self->_clone;unless ($self->_accepts($version)){$self->_reject_requirements($module,"exact specification $version outside of range " .$self->as_string)}return CPAN::Meta::Requirements::_Range::Exact->_new($version)}sub _simplify {my ($self,$module)=@_;if (defined$self->{minimum}and defined$self->{maximum}){if ($self->{minimum}==$self->{maximum}){if (grep {$_==$self->{minimum}}@{$self->{exclusions}|| []}){$self->_reject_requirements($module,"minimum and maximum are both $self->{minimum}, which is excluded",)}return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})}if ($self->{minimum}> $self->{maximum}){$self->_reject_requirements($module,"minimum $self->{minimum} exceeds maximum $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,$module)=@_;$module='module' unless defined$module;$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($module)}sub with_maximum {my ($self,$maximum,$module)=@_;$module='module' unless defined$module;$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($module)}sub with_exclusion {my ($self,$exclusion,$module)=@_;$module='module' unless defined$module;$self=$self->_clone;push @{$self->{exclusions}||= []},$exclusion;return$self->_simplify($module)}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;
CPAN_META_REQUIREMENTS
$fatpacked{"CPAN/Meta/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC';
use 5.006;use strict;use warnings;package CPAN::Meta::Spec;our$VERSION='2.150010';1;
CPAN_META_SPEC
$fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
use 5.006;use strict;use warnings;package CPAN::Meta::Validator;our$VERSION='2.150010';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)$/)}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;
CPAN_META_VALIDATOR
$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML';
use 5.008001;use strict;use warnings;package CPAN::Meta::YAML;$CPAN::Meta::YAML::VERSION='0.018';;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}))}
Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
...
{(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;
# Scalar::Util failed to load or too old
sub refaddr {
my $pkg = ref($_[0]) or return undef;
if ( !! UNIVERSAL::can($_[0], 'can') ) {
bless $_[0], 'Scalar::Util::Fake';
} else {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
my $i = do { no warnings 'portable'; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
END_PERL
CPAN_META_YAML
$fatpacked{"Capture/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CAPTURE_TINY';
use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.48';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,1,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,1,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-C0','-e',<<'HERE');sub _relayer {my ($fh,$apply_layers)=@_;binmode($fh,":raw");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")}my@to_apply=@$apply_layers;shift@to_apply;binmode($fh,":" .join(":",@to_apply))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles;for my$h (qw/stdout stderr stdin/){next if$h eq 'stdin' &&!$IS_WIN32;my$redir=$h eq 'stdin' ? "<&" : ">&";_open$handles{$h}=IO::Handle->new(),$redir .uc($h)}return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin}if defined$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout}if defined$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}if defined$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar(tmpnam()).$$;if ($IS_WIN32){my$old_eval_err=$@;undef $@;eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});my$result=SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0);_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which});$@=$old_eval_err}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){close($_)for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT,output=>1)],stderr=>[PerlIO::get_layers(\*STDERR,output=>1)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdin}++,local(*STDIN),_open(\*STDIN,"<&=0")if tied*STDIN && $] >= 5.008;$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdout}=[PerlIO::get_layers(\*STDOUT,output=>1)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR,output=>1)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||= File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,$orig_pid,@result);{$orig_pid=$$;local*STDIN=*CT_ORIG_STDIN if$localize{stdin};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;my$old_eval_err=$@;undef $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@;STDOUT->flush if$do_stdout;STDERR->flush if$do_stderr;$@=$old_eval_err}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;if ($orig_pid==$$ and (defined wantarray or ($do_tee && keys%localize))){for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr}}$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;return unless defined wantarray;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr &&!$do_merge;push@return,@result;return wantarray ? @return : $return[0]}1;
use Fcntl;
$SIG{HUP}=sub{exit};
if ( my $fn=shift ) {
sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
print {$fh} $$;
close $fh;
}
my $buf; while (sysread(STDIN, $buf, 2048)) {
syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
}
HERE
CAPTURE_TINY
$fatpacked{"Class/C3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_C3';
package Class::C3;use strict;use warnings;our$VERSION='0.35';our$C3_IN_CORE;our$C3_XS;BEGIN {if($] > 5.009_004){$C3_IN_CORE=1;require mro}elsif($C3_XS or not defined$C3_XS){my$error=do {local $@;eval {require Class::C3::XS};$@};if ($error){die$error if$error !~ /\blocate\b/;if ($C3_XS){require Carp;Carp::croak("XS explicitly requested but Class::C3::XS is not available")}require Algorithm::C3;require Class::C3::next}else {$C3_XS=1}}}our%MRO;sub _dump_MRO_table {%MRO}our$TURN_OFF_C3=0;our$_initialized=0;sub import {my$class=caller();return if$class eq 'main';return if$TURN_OFF_C3;mro::set_mro($class,'c3')if$C3_IN_CORE;$MRO{$class}=undef unless exists$MRO{$class}}{no warnings 'redefine';sub initialize {%next::METHOD_CACHE=();return unless keys%MRO;if($C3_IN_CORE){mro::set_mro($_,'c3')for keys%MRO}else {if($_initialized){uninitialize();$MRO{$_}=undef foreach keys%MRO}_calculate_method_dispatch_tables();_apply_method_dispatch_tables();$_initialized=1}}sub uninitialize {%next::METHOD_CACHE=();return unless keys%MRO;if($C3_IN_CORE){mro::set_mro($_,'dfs')for keys%MRO}else {_remove_method_dispatch_tables();$_initialized=0}}sub reinitialize {goto&initialize}}sub _calculate_method_dispatch_tables {return if$C3_IN_CORE;my%merge_cache;for my$class (keys%MRO){_calculate_method_dispatch_table($class,\%merge_cache)}}sub _calculate_method_dispatch_table {return if$C3_IN_CORE;my ($class,$merge_cache)=@_;no strict 'refs';my@MRO=calculateMRO($class,$merge_cache);$MRO{$class}={MRO=>\@MRO };my$has_overload_fallback;my%methods;for my$local (@MRO[1 .. $#MRO]){$has_overload_fallback=${"${local}::()"}if!defined$has_overload_fallback && defined ${"${local}::()"};for my$method (grep {defined &{"${local}::$_"}}keys %{"${local}::"}){next unless!defined *{"${class}::$method"}{CODE};$methods{$method}={orig=>"${local}::$method",code=>\&{"${local}::$method"}}unless exists$methods{$method}}}$MRO{$class}->{methods}=\%methods;$MRO{$class}->{has_overload_fallback}=$has_overload_fallback}sub _apply_method_dispatch_tables {return if$C3_IN_CORE;for my$class (keys%MRO){_apply_method_dispatch_table($class)}}sub _apply_method_dispatch_table {return if$C3_IN_CORE;my$class=shift;no strict 'refs';${"${class}::()"}=$MRO{$class}->{has_overload_fallback}if!defined &{"${class}::()"}&& defined$MRO{$class}->{has_overload_fallback};for my$method (keys %{$MRO{$class}->{methods}}){if ($method =~ /^\(/){my$orig=$MRO{$class}->{methods}->{$method}->{orig};${"${class}::$method"}=$$orig if defined $$orig}*{"${class}::$method"}=$MRO{$class}->{methods}->{$method}->{code}}}sub _remove_method_dispatch_tables {return if$C3_IN_CORE;for my$class (keys%MRO){_remove_method_dispatch_table($class)}}sub _remove_method_dispatch_table {return if$C3_IN_CORE;my$class=shift;no strict 'refs';delete ${"${class}::"}{"()"}if$MRO{$class}->{has_overload_fallback};for my$method (keys %{$MRO{$class}->{methods}}){delete ${"${class}::"}{$method}if defined *{"${class}::${method}"}{CODE}&& (*{"${class}::${method}"}{CODE}eq $MRO{$class}->{methods}->{$method}->{code})}}sub calculateMRO {my ($class,$merge_cache)=@_;return Algorithm::C3::merge($class,sub {no strict 'refs';@{$_[0].'::ISA'}},$merge_cache)}sub _core_calculateMRO {@{mro::get_linear_isa($_[0],'c3')}}if($C3_IN_CORE){no warnings 'redefine';*Class::C3::calculateMRO=\&_core_calculateMRO}elsif($C3_XS){no warnings 'redefine';*Class::C3::calculateMRO=\&Class::C3::XS::calculateMRO;*Class::C3::_calculate_method_dispatch_table =\&Class::C3::XS::_calculate_method_dispatch_table}1;
CLASS_C3
$fatpacked{"Class/C3/next.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_C3_NEXT';
package next;use strict;use warnings;no warnings 'redefine';use Scalar::Util 'blessed';our$VERSION='0.35';our%METHOD_CACHE;sub method {my$self=$_[0];my$class=blessed($self)|| $self;my$indirect=caller()=~ /^(?:next|maybe::next)$/;my$level=$indirect ? 2 : 1;my ($method_caller,$label,@label);while ($method_caller=(caller($level++))[3]){@label=(split '::',$method_caller);$label=pop@label;last unless $label eq '(eval)' || $label eq '__ANON__'}my$method;my$caller=join '::'=>@label;$method=$METHOD_CACHE{"$class|$caller|$label"}||= do {my@MRO=Class::C3::calculateMRO($class);my$current;while ($current=shift@MRO){last if$caller eq $current}no strict 'refs';my$found;for my$class (@MRO){next if (defined$Class::C3::MRO{$class}&& defined$Class::C3::MRO{$class}{methods}{$label});last if (defined ($found=*{$class .'::' .$label}{CODE}))}$found};return$method if$indirect;die "No next::method '$label' found for $self" if!$method;goto &{$method}}sub can {method($_[0])}package maybe::next;use strict;use warnings;no warnings 'redefine';our$VERSION='0.35';sub method {(next::method($_[0])|| return)->(@_)}1;
CLASS_C3_NEXT
$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY';
use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.008';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.008';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1;
sub $name {
return (
( \@_ == 1 && exists \$_[0]{$name} )
? ( \$_[0]{$name} )
: ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) )
);
}
HERE
sub $name {
return (
( \@_ == 1 && exists \$_[0]{$name} )
? ( \$_[0]{$name} )
: ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default )
);
}
HERE
sub $name {
return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] );
}
HERE
CLASS_TINY
$fatpacked{"Command/Runner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER';
package Command::Runner;use strict;use warnings;use Capture::Tiny ();use Command::Runner::Format ();use Command::Runner::LineBuffer;use Command::Runner::Quote ();use Command::Runner::Timeout;use Config ();use IO::Select;use POSIX ();use Time::HiRes ();use constant WIN32=>$^O eq 'MSWin32';our$VERSION='0.103';our$TICK=0.02;sub new {my ($class,%option)=@_;my$command=delete$option{command};my$commandf=delete$option{commandf};die "Cannot specify both command and commandf" if$command && $commandf;if (!$command && $commandf){$command=Command::Runner::Format::commandf @$commandf}bless {keep=>1,_buffer=>{},%option,($command ? (command=>$command): ()),},$class}for my$attr (qw(command redirect timeout keep stdout stderr env)){no strict 'refs';*$attr=sub {my$self=shift;$self->{$attr}=$_[0];$self}}sub commandf {my ($self,$format,@args)=@_;$self->{command}=Command::Runner::Format::commandf$format,@args;$self}sub run {my$self=shift;local%ENV=%{$self->{env}}if$self->{env};my$command=$self->{command};if (ref$command eq 'CODE'){$self->_wrap(sub {$self->_run_code($command)})}elsif (WIN32){$self->_wrap(sub {$self->_system_win32($command)})}else {$self->_exec($command)}}sub _wrap {my ($self,$code)=@_;my ($stdout,$stderr,$res);if ($self->{redirect}){($stdout,$res)=&Capture::Tiny::capture_merged($code)}else {($stdout,$stderr,$res)=&Capture::Tiny::capture($code)}if (length$stdout and my$sub=$self->{stdout}){my$buffer=Command::Runner::LineBuffer->new(buffer=>$stdout);my@line=$buffer->get(1);$sub->($_)for@line}if (!$self->{redirect}and length$stderr and my$sub=$self->{stderr}){my$buffer=Command::Runner::LineBuffer->new(buffer=>$stderr);my@line=$buffer->get(1);$sub->($_)for@line}if ($self->{keep}){$res->{stdout}=$stdout;$res->{stderr}=$stderr}return$res}sub _run_code {my ($self,$code)=@_;if (!$self->{timeout}){my$result=$code->();return {pid=>$$,result=>$result }}my ($result,$err);{local$SIG{__DIE__}='DEFAULT';local$SIG{ALRM}=sub {die "__TIMEOUT__\n"};eval {alarm$self->{timeout};$result=$code->()};$err=$@;alarm 0}if (!$err){return {pid=>$$,result=>$result,}}elsif ($err eq "__TIMEOUT__\n"){return {pid=>$$,result=>$result,timeout=>1 }}else {die$err}}sub _system_win32 {my ($self,$command)=@_;my$pid;if (ref$command){my@cmd=map {Command::Runner::Quote::quote_win32($_)}@$command;$pid=system {$command->[0]}1,@cmd}else {$pid=system 1,$command}my$timeout=$self->{timeout}? Command::Runner::Timeout->new($self->{timeout},1): undef;my$INT;local$SIG{INT}=sub {$INT++};my$result;while (1){if ($INT){kill INT=>$pid;$INT=0}my$res=waitpid$pid,POSIX::WNOHANG();if ($res==-1){warn "waitpid($pid, POSIX::WNOHANG()) returns unexpectedly -1";last}elsif ($res > 0){$result=$?;last}else {if ($timeout and my$signal=$timeout->signal){kill$signal=>$pid}Time::HiRes::sleep($TICK)}}return {pid=>$pid,result=>$result,timeout=>$timeout && $timeout->signaled }}sub _exec {my ($self,$command)=@_;pipe my$stdout_read,my$stdout_write;$self->{_buffer}{stdout}=Command::Runner::LineBuffer->new(keep=>$self->{keep});my ($stderr_read,$stderr_write);if (!$self->{redirect}){pipe$stderr_read,$stderr_write;$self->{_buffer}{stderr}=Command::Runner::LineBuffer->new(keep=>$self->{keep})}my$pid=fork;die "fork: $!" unless defined$pid;if ($pid==0){close $_ for grep $_,$stdout_read,$stderr_read;open STDOUT,">&",$stdout_write;if ($self->{redirect}){open STDERR,">&",\*STDOUT}else {open STDERR,">&",$stderr_write}if ($Config::Config{d_setpgrp}){POSIX::setpgid(0,0)or die "setpgid: $!"}if (ref$command){exec {$command->[0]}@$command}else {exec$command}exit 127}close $_ for grep $_,$stdout_write,$stderr_write;my$signal_pid=$Config::Config{d_setpgrp}? -$pid : $pid;my$INT;local$SIG{INT}=sub {$INT++};my$timeout=$self->{timeout}? Command::Runner::Timeout->new($self->{timeout},1): undef;my$select=IO::Select->new(grep $_,$stdout_read,$stderr_read);while ($select->count){if ($INT){kill INT=>$signal_pid;$INT=0}if ($timeout and my$signal=$timeout->signal){kill$signal=>$signal_pid}for my$ready ($select->can_read($TICK)){my$type=$ready==$stdout_read ? "stdout" : "stderr";my$len=sysread$ready,my$buf,64*1024;if ($len){my$buffer=$self->{_buffer}{$type};$buffer->add($buf);next unless my@line=$buffer->get;next unless my$sub=$self->{$type};$sub->($_)for@line}else {warn "sysread $type pipe failed: $!" unless defined$len;$select->remove($ready);close$ready}}}for my$type (qw(stdout stderr)){next unless my$sub=$self->{$type};my$buffer=$self->{_buffer}{$type}or next;my@line=$buffer->get(1)or next;$sub->($_)for@line}close $_ for$select->handles;waitpid$pid,0;my$res={pid=>$pid,result=>$?,timeout=>$timeout && $timeout->signaled,stdout=>$self->{_buffer}{stdout}? $self->{_buffer}{stdout}->raw : "",stderr=>$self->{_buffer}{stderr}? $self->{_buffer}{stderr}->raw : "",};$self->{_buffer}=+{};return$res}1;
COMMAND_RUNNER
$fatpacked{"Command/Runner/Format.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_FORMAT';
package Command::Runner::Format;use strict;use warnings;use Command::Runner::Quote 'quote';use Exporter 'import';our@EXPORT_OK=qw(commandf);my$regex=qr/
(% # leading '%' $1
(-)? # left-align, rather than right $2
(\d*)? # (optional) minimum field width $3
(?:\.(\d*))? # (optional) maximum field width $4
(\{.*?\})? # (optional) stuff inside $5
(\S) # actual format character $6
)/x;sub commandf {my ($format,@args)=@_;my$i=0;$format =~ s{$regex}{
$6 eq '%' ? '%' : _replace($args[$i++], $1, $6)
}ge;$format}sub _replace {my ($arg,$all,$char)=@_;if ($char eq 'q'){return quote$arg}else {return sprintf$all,$arg}}1;
COMMAND_RUNNER_FORMAT
$fatpacked{"Command/Runner/LineBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_LINEBUFFER';
package Command::Runner::LineBuffer;use strict;use warnings;sub new {my ($class,%args)=@_;my$buffer=exists$args{buffer}? $args{buffer}: "";bless {buffer=>$buffer,$args{keep}? (keep=>$buffer): (),},$class}sub raw {my$self=shift;exists$self->{keep}? $self->{keep}: undef}sub add {my ($self,$buffer)=@_;$self->{buffer}.= $buffer;$self->{keep}.= $buffer if exists$self->{keep};$self}sub get {my ($self,$drain)=@_;if ($drain){if (length$self->{buffer}){my@line=$self->get;if (length$self->{buffer}and $self->{buffer}ne "\x0d"){$self->{buffer}=~ s/[\x0d\x0a]+\z//;push@line,$self->{buffer}}$self->{buffer}="";return@line}else {return}}my@line;while ($self->{buffer}=~ s/\A(.*?(?:\x0d\x0a|\x0d|\x0a))//sm){my$line=$1;next if$line eq "\x0d";$line =~ s/[\x0d\x0a]+\z//;push@line,$line}return@line}1;
COMMAND_RUNNER_LINEBUFFER
$fatpacked{"Command/Runner/Quote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_QUOTE';
package Command::Runner::Quote;use strict;use warnings;use Win32::ShellQuote ();use String::ShellQuote ();use Exporter 'import';our@EXPORT_OK=qw(quote quote_win32 quote_unix);sub quote_win32 {my$str=shift;Win32::ShellQuote::quote_literal($str,1)}sub quote_unix {my$str=shift;String::ShellQuote::shell_quote_best_effort($str)}if ($^O eq 'MSWin32'){*quote=\"e_win32}else {*quote=\"e_unix}1;
COMMAND_RUNNER_QUOTE
$fatpacked{"Command/Runner/Timeout.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_TIMEOUT';
package Command::Runner::Timeout;use strict;use warnings;use Time::HiRes ();sub new {my ($class,$at,$kill)=@_;my$now=Time::HiRes::time();bless {signaled=>0,at=>$now + $at,at_kill=>$now + $at + $kill },$class}sub signal {my$self=shift;return if!$self->{at}&&!$self->{at_kill};my$now=Time::HiRes::time();if ($self->{at}and $now >= $self->{at}){$self->{at}=undef;$self->{signaled}=1;return 'TERM'}if ($now >= $self->{at_kill}){$self->{at_kill}=undef;$self->{signaled}=1;return 'KILL'}return}sub signaled {my$self=shift;$self->{signaled}}1;
COMMAND_RUNNER_TIMEOUT
$fatpacked{"Devel/GlobalDestruction.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_GLOBALDESTRUCTION';
package Devel::GlobalDestruction;use strict;use warnings;our$VERSION='0.14';use Sub::Exporter::Progressive -setup=>{exports=>[qw(in_global_destruction) ],groups=>{default=>[-all ]},};if (defined ${^GLOBAL_PHASE}){eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' or die $@}elsif (eval {require Devel::GlobalDestruction::XS;no warnings 'once';*in_global_destruction=\&Devel::GlobalDestruction::XS::in_global_destruction;1}){}else {require B;eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1' or die $@}1;
DEVEL_GLOBALDESTRUCTION
$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.74';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;
EXPORTER
$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
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];$oops++}}}}if ($oops){require Carp;Carp::croak(join("\n",@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;
EXPORTER_HEAVY
$fatpacked{"ExtUtils/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG';
package ExtUtils::Config;$ExtUtils::Config::VERSION='0.008';use strict;use warnings;use Config;use Data::Dumper ();sub new {my ($pack,$args)=@_;return bless {values=>($args ? {%$args }: {}),},$pack}sub get {my ($self,$key)=@_;return exists$self->{values}{$key}? $self->{values}{$key}: $Config{$key}}sub exists {my ($self,$key)=@_;return exists$self->{values}{$key}|| exists$Config{$key}}sub values_set {my$self=shift;return {%{$self->{values}}}}sub all_config {my$self=shift;return {%Config,%{$self->{values}}}}sub serialize {my$self=shift;return$self->{serialized}||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump}1;
EXTUTILS_CONFIG
$fatpacked{"ExtUtils/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS';
package ExtUtils::Helpers;$ExtUtils::Helpers::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';use Config;use File::Basename qw/basename/;use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;use Text::ParseWords 3.24 ();our@EXPORT_OK=qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;BEGIN {my%impl_for=(MSWin32=>'Windows',VMS=>'VMS');my$package='ExtUtils::Helpers::' .($impl_for{$^O}|| 'Unix');my$impl=$impl_for{$^O}|| 'Unix';require "ExtUtils/Helpers/$impl.pm";"ExtUtils::Helpers::$impl"->import()}sub split_like_shell {my ($string)=@_;return if not defined$string;$string =~ s/^\s+|\s+$//g;return if not length$string;return Text::ParseWords::shellwords($string)}sub man1_pagename {my$filename=shift;return basename($filename).".$Config{man1ext}"}my%separator=(MSWin32=>'.',VMS=>'__',os2=>'.',cygwin=>'.',);my$separator=$separator{$^O}|| '::';sub man3_pagename {my ($filename,$base)=@_;$base ||= 'lib';my ($vols,$dirs,$file)=splitpath(canonpath(abs2rel($filename,$base)));$file=basename($file,qw/.pm .pod/);my@dirs=grep {length}splitdir($dirs);return join$separator,@dirs,"$file.$Config{man3ext}"}1;
EXTUTILS_HELPERS
$fatpacked{"ExtUtils/Helpers/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_UNIX';
package ExtUtils::Helpers::Unix;$ExtUtils::Helpers::Unix::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Carp qw/croak/;use Config;my$layer=$] >= 5.008001 ? ":raw" : "";sub make_executable {my$filename=shift;my$current_mode=(stat$filename)[2]+ 0;if (-T $filename){open my$fh,"<$layer",$filename;my@lines=<$fh>;if (@lines and $lines[0]=~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms){open my$out,">$layer","$filename.new" or croak "Couldn't open $filename.new: $!";print$out @lines;close$out;rename$filename,"$filename.bak" or croak "Couldn't rename $filename to $filename.bak";rename "$filename.new",$filename or croak "Couldn't rename $filename.new to $filename";unlink "$filename.bak"}}chmod$current_mode | oct(111),$filename;return}sub detildefy {my$value=shift;for ($value){s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex}return$value}1;
EXTUTILS_HELPERS_UNIX
$fatpacked{"ExtUtils/Helpers/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_VMS';
package ExtUtils::Helpers::VMS;$ExtUtils::Helpers::VMS::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use File::Copy qw/copy/;sub make_executable {my$filename=shift;my$batchname="$filename.com";copy($filename,$batchname);ExtUtils::Helpers::Unix::make_executable($batchname);return}sub detildefy {my$arg=shift;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg}
EXTUTILS_HELPERS_VMS
$fatpacked{"ExtUtils/Helpers/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_WINDOWS';
package ExtUtils::Helpers::Windows;$ExtUtils::Helpers::Windows::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Config;use Carp qw/carp croak/;use ExtUtils::PL2Bat 'pl2bat';sub make_executable {my$script=shift;if (-T $script && $script !~ / \. (?:bat|cmd) $ /x){pl2bat(in=>$script,update=>1)}return}sub detildefy {my$value=shift;$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if$ENV{USERPROFILE};return$value}1;
EXTUTILS_HELPERS_WINDOWS
$fatpacked{"ExtUtils/Install.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALL';
package ExtUtils::Install;use strict;use Config qw(%Config);use Cwd qw(cwd);use Exporter ();use File::Basename qw(dirname);use File::Copy;use File::Path;use File::Spec;our@ISA=('Exporter');our@EXPORT=('install','uninstall','pm_to_blib','install_default');our$MUST_REBOOT;our$VERSION='2.20';$VERSION=eval$VERSION;BEGIN {*_Is_VMS=$^O eq 'VMS' ? sub(){1}: sub(){0};*_Is_Win32=$^O eq 'MSWin32' ? sub(){1}: sub(){0};*_Is_cygwin=$^O eq 'cygwin' ? sub(){1}: sub(){0};*_CanMoveAtBoot=($^O eq 'MSWin32' || $^O eq 'cygwin')? sub(){1}: sub(){0}}my$Inc_uninstall_warn_handler;my$INSTALL_ROOT=$ENV{PERL_INSTALL_ROOT};my$INSTALL_QUIET=$ENV{PERL_INSTALL_QUIET};$INSTALL_QUIET=1 if (!exists$ENV{PERL_INSTALL_QUIET}and defined$ENV{MAKEFLAGS}and $ENV{MAKEFLAGS}=~ /\b(s|silent|quiet)\b/);my$Curdir=File::Spec->curdir;sub _estr(@) {return join "\n",'!' x 72,@_,'!' x 72,''}{my%warned;sub _warnonce(@) {my$first=shift;my$msg=_estr "WARNING: $first",@_;warn$msg unless$warned{$msg}++}}sub _choke(@) {my$first=shift;my$msg=_estr "ERROR: $first",@_;require Carp;Carp::croak($msg)}sub _croak {require Carp;Carp::croak(@_)}sub _confess {require Carp;Carp::confess(@_)}sub _compare {if (-f $_[1]&& -s _==-s $_[0]){require File::Compare;return File::Compare::compare(@_)}return 1}sub _chmod($$;$) {my ($mode,$item,$verbose)=@_;$verbose ||= 0;if (chmod$mode,$item){printf "chmod(0%o, %s)\n",$mode,$item if$verbose > 1}else {my$err="$!";_warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",$mode,$item,$err if -e $item}}{my$Has_Win32API_File;sub _move_file_at_boot {my ($file,$target,$moan)=@_;_confess("Panic: Can't _move_file_at_boot on this platform!")unless _CanMoveAtBoot;my$descr=ref$target ? "'$file' for deletion" : "'$file' for installation as '$target'";$Has_Win32API_File=(_Is_Win32 || _Is_cygwin)? (eval {require Win32API::File;1}|| 0): 0 unless defined$Has_Win32API_File;if (!$Has_Win32API_File){my@msg=("Cannot schedule $descr at reboot.","Try installing Win32API::File to allow operations on locked files","to be scheduled during reboot. Or try to perform the operation by","hand yourself. (You may need to close other perl processes first)");if ($moan){_warnonce(@msg)}else {_choke(@msg)}return 0}my$opts=Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();$opts=$opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()unless ref$target;_chmod(0666,$file);_chmod(0666,$target)unless ref$target;if (Win32API::File::MoveFileEx($file,$target,$opts)){$MUST_REBOOT ||= ref$target ? 0 : 1;return 1}else {my@msg=("MoveFileEx $descr at reboot failed: $^E","You may try to perform the operation by hand yourself. ","(You may need to close other perl processes first).",);if ($moan){_warnonce(@msg)}else {_choke(@msg)}}return 0}}sub _unlink_or_rename {my ($file,$tryhard,$installing)=@_;if ($^O =~ /^(dos|os2|MSWin32|VMS)$/){_chmod(0666,$file)}my$unlink_count=0;while (unlink$file){$unlink_count++}return$file if$unlink_count > 0;my$error="$!";_choke("Cannot unlink '$file': $!")unless _CanMoveAtBoot && $tryhard;my$tmp="AAA";++$tmp while -e "$file.$tmp";$tmp="$file.$tmp";warn "WARNING: Unable to unlink '$file': $error\n","Going to try to rename it to '$tmp'.\n";if (rename$file,$tmp){warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n";_move_file_at_boot($tmp,[],$installing);return$file}elsif ($installing){_warnonce("Rename failed: $!. Scheduling '$tmp'\nfor"." installation as '$file' at reboot.\n");_move_file_at_boot($tmp,$file);return$tmp}else {_choke("Rename failed:$!","Cannot proceed.")}}sub _get_install_skip {my ($skip,$verbose)=@_;if ($ENV{EU_INSTALL_IGNORE_SKIP}){print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n" if$verbose>2;return []}if (!defined$skip){print "Looking for install skip list\n" if$verbose>2;for my$file ('INSTALL.SKIP',$ENV{EU_INSTALL_SITE_SKIPFILE}){next unless$file;print "\tChecking for $file\n" if$verbose>2;if (-e $file){$skip=$file;last}}}if ($skip &&!ref$skip){print "Reading skip patterns from '$skip'.\n" if$verbose;if (open my$fh,$skip){my@patterns;while (<$fh>){chomp;next if /^\s*(?:#|$)/;print "\tSkip pattern: $_\n" if$verbose>3;push@patterns,$_}$skip=\@patterns}else {warn "Can't read skip file:'$skip':$!\n";$skip=[]}}elsif (UNIVERSAL::isa($skip,'ARRAY')){print "Using array for skip list\n" if$verbose>2}elsif ($verbose){print "No skip list found.\n" if$verbose>1;$skip=[]}warn "Got @{[0+@$skip]} skip patterns.\n" if$verbose>3;return$skip}{my$has_posix;sub _have_write_access {my$dir=shift;unless (defined$has_posix){$has_posix=(!_Is_cygwin &&!_Is_Win32 && eval {local $^W;require POSIX;1})|| 0}if ($has_posix){return POSIX::access($dir,POSIX::W_OK())}else {return -w $dir}}}sub _can_write_dir {my$dir=shift;return unless defined$dir and length$dir;my ($vol,$dirs,$file)=File::Spec->splitpath($dir,1);my@dirs=File::Spec->splitdir($dirs);unshift@dirs,File::Spec->curdir unless File::Spec->file_name_is_absolute($dir);my$path='';my@make;while (@dirs){if (_Is_VMS){$dir=File::Spec->catdir($vol,@dirs)}else {$dir=File::Spec->catdir(@dirs);$dir=File::Spec->catpath($vol,$dir,'')if defined$vol and length$vol}next if ($dir eq $path);if (!-e $dir){unshift@make,$dir;next}if (_have_write_access($dir)){return 1,$dir,@make}else {return 0,$dir,@make}}continue {pop@dirs}return 0}sub _mkpath {my ($dir,$show,$mode,$verbose,$dry_run)=@_;if ($verbose && $verbose > 1 &&!-d $dir){$show=1;printf "mkpath(%s,%d,%#o)\n",$dir,$show,$mode}if (!$dry_run){my@created;eval {@created=File::Path::mkpath($dir,$show,$mode);1}or _choke("Can't create '$dir'","$@");if (@created){return}}my ($can,$root,@make)=_can_write_dir($dir);if (!$can){my@msg=("Can't create '$dir'",$root ? "Do not have write permissions on '$root'" : "Unknown Error");if ($dry_run){_warnonce@msg}else {_choke@msg}}elsif ($show and $dry_run){print "$_\n" for@make}}sub _copy {my ($from,$to,$verbose,$dry_run)=@_;if ($verbose && $verbose>1){printf "copy(%s,%s)\n",$from,$to}if (!$dry_run){File::Copy::copy($from,$to)or _croak(_estr "ERROR: Cannot copy '$from' to '$to': $!")}}sub _chdir {my ($dir)=@_;my$ret;if (defined wantarray){$ret=cwd}chdir$dir or _choke("Couldn't chdir to '$dir': $!");return$ret}sub install {my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result)=@_;if (@_==1 and eval {1+@$from_to}){my%opts=@$from_to;$from_to=$opts{from_to}or _confess("from_to is a mandatory parameter");$verbose=$opts{verbose};$dry_run=$opts{dry_run};$uninstall_shadows=$opts{uninstall_shadows};$skip=$opts{skip};$always_copy=$opts{always_copy};$result=$opts{result}}$result ||= {};$verbose ||= 0;$dry_run ||= 0;$skip=_get_install_skip($skip,$verbose);$always_copy=$ENV{EU_INSTALL_ALWAYS_COPY}|| $ENV{EU_ALWAYS_COPY}|| 0 unless defined$always_copy;my(%from_to)=%$from_to;my(%pack,$dir,%warned);require ExtUtils::Packlist;my($packlist)=ExtUtils::Packlist->new();local(*DIR);for (qw/read write/){$pack{$_}=$from_to{$_};delete$from_to{$_}}my$tmpfile=install_rooted_file($pack{"read"});$packlist->read($tmpfile)if (-f $tmpfile);my$cwd=cwd();my@found_files;my%check_dirs;require File::Find;my$blib_lib=File::Spec->catdir('blib','lib');my$blib_arch=File::Spec->catdir('blib','arch');my$current_directory=$^O eq 'MacOS' ? $Curdir : '.';MOD_INSTALL: foreach my$source (sort keys%from_to){my$targetroot=install_rooted_dir($from_to{$source});if ($source eq $blib_lib and exists$from_to{$blib_arch}and directory_not_empty($blib_arch)){$targetroot=install_rooted_dir($from_to{$blib_arch});print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n"}next unless -d $source;_chdir($source);File::Find::find(sub {my ($mode,$size,$atime,$mtime)=(stat)[2,7,8,9];return if!-f _;my$origfile=$_;return if$origfile eq ".exists";my$targetdir=File::Spec->catdir($targetroot,$File::Find::dir);my$targetfile=File::Spec->catfile($targetdir,$origfile);my$sourcedir=File::Spec->catdir($source,$File::Find::dir);my$sourcefile=File::Spec->catfile($sourcedir,$origfile);for my$pat (@$skip){if ($sourcefile=~/$pat/){print "Skipping $targetfile (filtered)\n" if$verbose>1;$result->{install_filtered}{$sourcefile}=$pat;return}}my$save_cwd=File::Spec->catfile($cwd,$sourcedir);_chdir($cwd);my$diff=$always_copy || _compare($sourcefile,$targetfile);$check_dirs{$targetdir}++ unless -w $targetfile;push@found_files,[$diff,$File::Find::dir,$origfile,$mode,$size,$atime,$mtime,$targetdir,$targetfile,$sourcedir,$sourcefile,];_chdir($save_cwd)},$current_directory);_chdir($cwd)}for my$targetdir (sort keys%check_dirs){_mkpath($targetdir,0,0755,$verbose,$dry_run)}for my$found (@found_files){my ($diff,$ffd,$origfile,$mode,$size,$atime,$mtime,$targetdir,$targetfile,$sourcedir,$sourcefile)=@$found;my$realtarget=$targetfile;if ($diff){eval {if (-f $targetfile){print "_unlink_or_rename($targetfile)\n" if$verbose>1;$targetfile=_unlink_or_rename($targetfile,'tryhard','install')unless$dry_run}elsif (!-d $targetdir){_mkpath($targetdir,0,0755,$verbose,$dry_run)}print "Installing $targetfile\n";_copy($sourcefile,$targetfile,$verbose,$dry_run,);print "utime($atime,$mtime,$targetfile)\n" if$verbose>1;utime($atime,$mtime + _Is_VMS,$targetfile)unless$dry_run>1;$mode=0444 | ($mode & 0111 ? 0111 : 0);$mode=$mode | 0222 if$realtarget ne $targetfile;_chmod($mode,$targetfile,$verbose);$result->{install}{$targetfile}=$sourcefile;1}or do {$result->{install_fail}{$targetfile}=$sourcefile;die $@}}else {$result->{install_unchanged}{$targetfile}=$sourcefile;print "Skipping $targetfile (unchanged)\n" if$verbose}if ($uninstall_shadows){inc_uninstall($sourcefile,$ffd,$verbose,$dry_run,$realtarget ne $targetfile ? $realtarget : "",$result)}$packlist->{$targetfile}++}if ($pack{'write'}){$dir=install_rooted_dir(dirname($pack{'write'}));_mkpath($dir,0,0755,$verbose,$dry_run);print "Writing $pack{'write'}\n" if$verbose;$packlist->write(install_rooted_file($pack{'write'}))unless$dry_run}_do_cleanup($verbose);return$result}sub _do_cleanup {my ($verbose)=@_;if ($MUST_REBOOT){die _estr "Operation not completed! ","You must reboot to complete the installation.","Sorry."}elsif (defined$MUST_REBOOT & $verbose){warn _estr "Installation will be completed at the next reboot.\n","However it is not necessary to reboot immediately.\n"}}sub install_rooted_file {if (defined$INSTALL_ROOT){File::Spec->catfile($INSTALL_ROOT,$_[0])}else {$_[0]}}sub install_rooted_dir {if (defined$INSTALL_ROOT){File::Spec->catdir($INSTALL_ROOT,$_[0])}else {$_[0]}}sub forceunlink {my ($file,$tryhard)=@_;_unlink_or_rename($file,$tryhard,not("installing"))}sub directory_not_empty ($) {my($dir)=@_;my$files=0;require File::Find;File::Find::find(sub {return if $_ eq ".exists";if (-f){$File::Find::prune++;$files=1}},$dir);return$files}sub install_default {@_ < 2 or _croak("install_default should be called with 0 or 1 argument");my$FULLEXT=@_ ? shift : $ARGV[0];defined$FULLEXT or die "Do not know to where to write install log";my$INST_LIB=File::Spec->catdir($Curdir,"blib","lib");my$INST_ARCHLIB=File::Spec->catdir($Curdir,"blib","arch");my$INST_BIN=File::Spec->catdir($Curdir,'blib','bin');my$INST_SCRIPT=File::Spec->catdir($Curdir,'blib','script');my$INST_MAN1DIR=File::Spec->catdir($Curdir,'blib','man1');my$INST_MAN3DIR=File::Spec->catdir($Curdir,'blib','man3');my@INST_HTML;if($Config{installhtmldir}){my$INST_HTMLDIR=File::Spec->catdir($Curdir,'blib','html');@INST_HTML=($INST_HTMLDIR=>$Config{installhtmldir})}install({read=>"$Config{sitearchexp}/auto/$FULLEXT/.packlist",write=>"$Config{installsitearch}/auto/$FULLEXT/.packlist",$INST_LIB=>(directory_not_empty($INST_ARCHLIB))? $Config{installsitearch}: $Config{installsitelib},$INST_ARCHLIB=>$Config{installsitearch},$INST_BIN=>$Config{installbin},$INST_SCRIPT=>$Config{installscript},$INST_MAN1DIR=>$Config{installman1dir},$INST_MAN3DIR=>$Config{installman3dir},@INST_HTML,},1,0,0)}sub uninstall {my($fil,$verbose,$dry_run)=@_;$verbose ||= 0;$dry_run ||= 0;die _estr "ERROR: no packlist file found: '$fil'" unless -f $fil;require ExtUtils::Packlist;my ($packlist)=ExtUtils::Packlist->new($fil);for (sort(keys(%$packlist))){chomp;print "unlink $_\n" if$verbose;forceunlink($_,'tryhard')unless$dry_run}print "unlink $fil\n" if$verbose;forceunlink($fil,'tryhard')unless$dry_run;_do_cleanup($verbose)}sub inc_uninstall {my($filepath,$libdir,$verbose,$dry_run,$ignore,$results)=@_;my($dir);$ignore||="";my$file=(File::Spec->splitpath($filepath))[2];my%seen_dir=();my@PERL_ENV_LIB=split$Config{path_sep},defined$ENV{'PERL5LIB'}? $ENV{'PERL5LIB'}: $ENV{'PERLLIB'}|| '';my@dirs=(@PERL_ENV_LIB,@INC,@Config{qw(archlibexp privlibexp sitearchexp sitelibexp)});my$seen_ours;for$dir (@dirs){my$canonpath=_Is_VMS ? $dir : File::Spec->canonpath($dir);next if$canonpath eq $Curdir;next if$seen_dir{$canonpath}++;my$targetfile=File::Spec->catfile($canonpath,$libdir,$file);next unless -f $targetfile;my$diff=_compare($filepath,$targetfile);print "#$file and $targetfile differ\n" if$diff && $verbose > 1;if (!$diff or $targetfile eq $ignore){$seen_ours=1;next}if ($dry_run){$results->{uninstall}{$targetfile}=$filepath;if ($verbose){$Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();$libdir =~ s|^\./||s ;$Inc_uninstall_warn_handler->add(File::Spec->catfile($libdir,$file),$targetfile)}}else {print "Unlinking $targetfile (shadowing?)\n" if$verbose;eval {die "Fake die for testing" if$ExtUtils::Install::Testing and ucase(File::Spec->canonpath($ExtUtils::Install::Testing))eq ucase($targetfile);forceunlink($targetfile,'tryhard');$results->{uninstall}{$targetfile}=$filepath;1}or do {$results->{fail_uninstall}{$targetfile}=$filepath;if ($seen_ours){warn "Failed to remove probably harmless shadow file '$targetfile'\n"}else {die "$@\n"}}}}}sub run_filter {my ($cmd,$src,$dest)=@_;local(*CMD,*SRC);open(CMD,"|$cmd >$dest")|| die "Cannot fork: $!";open(SRC,$src)|| die "Cannot open $src: $!";my$buf;my$sz=1024;while (my$len=sysread(SRC,$buf,$sz)){syswrite(CMD,$buf,$len)}close SRC;close CMD or die "Filter command '$cmd' failed for $src"}sub pm_to_blib {my($fromto,$autodir,$pm_filter)=@_;my%dirs;_mkpath($autodir,0,0755)if defined$autodir;while(my($from,$to)=each %$fromto){if(-f $to && -s $from==-s $to && -M $to < -M $from){print "Skip $to (unchanged)\n" unless$INSTALL_QUIET;next}my$need_filtering=defined$pm_filter && length$pm_filter && $from =~ /\.pm$/;if (!$need_filtering &&!_compare($from,$to)){print "Skip $to (unchanged)\n" unless$INSTALL_QUIET;next}if (-f $to){forceunlink($to)}else {my$dirname=dirname($to);if (!$dirs{$dirname}++){_mkpath($dirname,0,0755)}}if ($need_filtering){run_filter($pm_filter,$from,$to);print "$pm_filter <$from >$to\n"}else {_copy($from,$to);print "cp $from $to\n" unless$INSTALL_QUIET}my($mode,$atime,$mtime)=(stat$from)[2,8,9];utime($atime,$mtime+_Is_VMS,$to);_chmod(0444 | ($mode & 0111 ? 0111 : 0),$to);next unless$from =~ /\.pm$/;_autosplit($to,$autodir)if defined$autodir}}sub _autosplit {require AutoSplit;my$retval=AutoSplit::autosplit(@_);close*AutoSplit::IN if defined*AutoSplit::IN{IO};return$retval}package ExtUtils::Install::Warn;sub new {bless {},shift}sub add {my($self,$file,$targetfile)=@_;push @{$self->{$file}},$targetfile}sub DESTROY {unless(defined$INSTALL_ROOT){my$self=shift;my($file,$i,$plural);for$file (sort keys %$self){$plural=@{$self->{$file}}> 1 ? "s" : "";print "## Differing version$plural of $file found. You might like to\n";for (0..$#{$self->{$file}}){print "rm ",$self->{$file}[$_],"\n";$i++}}$plural=$i>1 ? "all those files" : "this file";my$inst=(_invokant()eq 'ExtUtils::MakeMaker')? ($Config::Config{make}|| 'make').' install' .(ExtUtils::Install::_Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1'): './Build install uninst=1';print "## Running '$inst' will unlink $plural for you.\n"}}sub _invokant {my@stack;my$frame=0;while (my$file=(caller($frame++))[1]){push@stack,(File::Spec->splitpath($file))[2]}my$builder;my$top=pop@stack;if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})){$builder='Module::Build'}else {$builder='ExtUtils::MakeMaker'}return$builder}1;
EXTUTILS_INSTALL
$fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS';
package ExtUtils::InstallPaths;$ExtUtils::InstallPaths::VERSION='0.012';use 5.006;use strict;use warnings;use File::Spec ();use Carp ();use ExtUtils::Config 0.002;my%complex_accessors=map {$_=>1}qw/prefix_relpaths install_sets/;my%hash_accessors=map {$_=>1}qw/install_path install_base_relpaths original_prefix/;my%defaults=(installdirs=>'site',install_base=>undef,prefix=>undef,verbose=>0,create_packlist=>1,dist_name=>undef,module_name=>undef,destdir=>undef,install_path=>sub {{}},install_sets=>\&_default_install_sets,original_prefix=>\&_default_original_prefix,install_base_relpaths=>\&_default_base_relpaths,prefix_relpaths=>\&_default_prefix_relpaths,);sub _merge_shallow {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);$filter->($_)for grep$filter,values %$override;return {%$defaults,%$override }}}sub _merge_deep {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);my$pair_for=sub {my$key=shift;my%override=%{$override->{$key}|| {}};$filter && $filter->($_)for values%override;return$key=>{%{$defaults->{$key}},%override }};return {map {$pair_for->($_)}keys %$defaults }}}my%allowed_installdir=map {$_=>1}qw/core site vendor/;my$must_be_relative=sub {Carp::croak('Value must be a relative path')if File::Spec->file_name_is_absolute($_[0])};my%deep_filter=map {$_=>$must_be_relative}qw/install_base_relpaths prefix_relpaths/;my%filter=(installdirs=>sub {my$value=shift;$value='core',Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?')if$value eq 'perl';Carp::croak('installdirs must be one of "core", "site", or "vendor"')if not $allowed_installdir{$value};return$value},(map {$_=>_merge_shallow($_,$deep_filter{$_})}qw/original_prefix install_base_relpaths/),(map {$_=>_merge_deep($_,$deep_filter{$_})}qw/install_sets prefix_relpaths/),);sub new {my ($class,%args)=@_;my$config=$args{config}|| ExtUtils::Config->new;my%self=(config=>$config,map {$_=>exists$args{$_}? $filter{$_}? $filter{$_}->($args{$_},$config): $args{$_}: ref$defaults{$_}? $defaults{$_}->($config): $defaults{$_}}keys%defaults,);$self{module_name}||= do {my$module_name=$self{dist_name};$module_name =~ s/-/::/g;$module_name}if defined$self{dist_name};return bless \%self,$class}for my$attribute (keys%defaults){no strict qw/refs/;*{$attribute}=$hash_accessors{$attribute}? sub {my ($self,$key)=@_;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$key}}: $complex_accessors{$attribute}? sub {my ($self,$installdirs,$key)=@_;Carp::confess("$attribute needs installdir")if not defined$installdirs;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$installdirs}{$key}}: sub {my$self=shift;return$self->{$attribute}}}my$script=$] > 5.008000 ? 'script' : 'bin';my@install_sets_keys=qw/lib arch bin script bindoc libdoc binhtml libhtml/;my@install_sets_tail=('bin',$script,qw/man1dir man3dir html1dir html3dir/);my%install_sets_values=(core=>[qw/privlib archlib/,@install_sets_tail ],site=>[map {"site$_"}qw/lib arch/,@install_sets_tail ],vendor=>[map {"vendor$_"}qw/lib arch/,@install_sets_tail ],);sub _default_install_sets {my$c=shift;my%ret;for my$installdir (qw/core site vendor/){@{$ret{$installdir}}{@install_sets_keys}=map {$c->get("install$_")}@{$install_sets_values{$installdir}}}return \%ret}sub _default_base_relpaths {my$config=shift;return {lib=>['lib','perl5'],arch=>['lib','perl5',$config->get('archname')],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],}}my%common_prefix_relpaths=(bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],);sub _default_prefix_relpaths {my$c=shift;my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');return {core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],%common_prefix_relpaths,},}}sub _default_original_prefix {my$c=shift;my%ret=(core=>$c->get('installprefixexp'),site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',);return \%ret}sub _log_verbose {my$self=shift;print @_ if$self->verbose;return}sub is_default_installable {my$self=shift;my$type=shift;my$installable=$self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs,$type));return$installable ? 1 : 0}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->_log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return File::Spec->catdir(@{$default})}}sub _prefixify_novms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m{/$};$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined$path && length$path;if (not defined$path or length$path==0){$self->_log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->_log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->_log_verbose(" now $path in $rprefix\n");return$path}sub _catprefix_vms {my ($self,$rprefix,$default)=@_;my ($rvol,$rdirs)=File::Spec->splitpath($rprefix);if ($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify_vms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n");require VMS::Filespec;$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->_log_verbose(" rprefix translated to $rprefix\n sprefix translated to $sprefix\n");if (length($path)==0){$self->_log_verbose(" no path to prefixify.\n")}elsif (!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif ($sprefix eq $rprefix){$self->_log_verbose(" no new prefix.\n")}else {my ($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config->get('vms_prefix');if ($path_vol eq $vms_prefix.':'){$self->_log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix_vms($rprefix,$path_dirs)}else {$self->_log_verbose(" cannot prefixify.\n");return File::Spec->catdir($self->prefix_relpaths($self->installdirs,$type))}}$self->_log_verbose(" now $path\n");return$path}BEGIN {*_prefixify=$^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms}sub prefix_relative {my ($self,$installdirs,$type)=@_;my$relpath=$self->install_sets($installdirs,$type);return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type)}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,@{$relpath}): undef}if ($self->prefix){my$relpath=$self->prefix_relative($self->installdirs,$type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs,$type)}sub install_types {my$self=shift;my%types=(%{$self->{install_path}},$self->install_base ? %{$self->{install_base_relpaths}}: $self->prefix ? %{$self->{prefix_relpaths}{$self->installdirs }}: %{$self->{install_sets}{$self->installdirs }});return sort keys%types}sub install_map {my ($self,$dirs)=@_;my%localdir_for;if ($dirs && %$dirs){%localdir_for=%$dirs}else {for my$type ($self->install_types){$localdir_for{$type}=File::Spec->catdir('blib',$type)}}my (%map,@skipping);for my$type (keys%localdir_for){next if not -e $localdir_for{$type};if (my$dest=$self->install_destination($type)){$map{$localdir_for{$type}}=$dest}else {push@skipping,$type}}warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}1;
EXTUTILS_INSTALLPATHS
$fatpacked{"ExtUtils/Installed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLED';
use strict;package ExtUtils::Installed;use Carp qw();use ExtUtils::Packlist;use ExtUtils::MakeMaker;use Config;use File::Find;use File::Basename;use File::Spec;my$Is_VMS=$^O eq 'VMS';my$DOSISH=($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);require VMS::Filespec if$Is_VMS;our$VERSION='2.20';$VERSION=eval$VERSION;sub _is_prefix {my ($self,$path,$prefix)=@_;return unless defined$prefix && defined$path;if($Is_VMS){$prefix=VMS::Filespec::unixify($prefix);$path=VMS::Filespec::unixify($path)}$prefix=File::Spec->canonpath($prefix);return 1 if substr($path,0,length($prefix))eq $prefix;if ($DOSISH){$path =~ s|\\|/|g;$prefix =~ s|\\|/|g;return 1 if$path =~ m{^\Q$prefix\E}i}return(0)}sub _is_doc {my ($self,$path)=@_;my$man1dir=$self->{':private:'}{Config}{man1direxp};my$man3dir=$self->{':private:'}{Config}{man3direxp};return(($man1dir && $self->_is_prefix($path,$man1dir))|| ($man3dir && $self->_is_prefix($path,$man3dir))? 1 : 0)}sub _is_type {my ($self,$path,$type)=@_;return 1 if$type eq "all";return($self->_is_doc($path))if$type eq "doc";my$conf=$self->{':private:'}{Config};if ($type eq "prog"){return($self->_is_prefix($path,$conf->{prefix}|| $conf->{prefixexp})&&!($self->_is_doc($path))? 1 : 0)}return(0)}sub _is_under {my ($self,$path,@under)=@_;$under[0]="" if (!@under);for my$dir (@under){return(1)if ($self->_is_prefix($path,$dir))}return(0)}sub _fix_dirs {my ($self,@dirs)=@_;if($Is_VMS){$_=VMS::Filespec::unixify($_)for@dirs}if ($DOSISH){s|\\|/|g for@dirs}return wantarray ? @dirs : $dirs[0]}sub _make_entry {my ($self,$module,$packlist_file,$modfile)=@_;my$data={module=>$module,packlist=>scalar(ExtUtils::Packlist->new($packlist_file)),packlist_file=>$packlist_file,};if (!$modfile){$data->{version}=$self->{':private:'}{Config}{version}}else {$data->{modfile}=$modfile;$data->{version}='';for my$dir (@{$self->{':private:'}{INC}}){my$p=File::Spec->catfile($dir,$modfile);if (-r $p){$module=_module_name($p,$module)if$Is_VMS;$data->{version}=MM->parse_version($p);$data->{version_from}=$p;$data->{packlist_valid}=exists$data->{packlist}{$p};last}}}$self->{$module}=$data}our$INSTALLED;sub new {my ($class)=shift(@_);$class=ref($class)|| $class;my%args=@_;return$INSTALLED if$INSTALLED and ($args{default_get}|| $args{default});my$self=bless {},$class;$INSTALLED=$self if$args{default_set}|| $args{default};if ($args{config_override}){eval {$self->{':private:'}{Config}={%{$args{config_override}}}}or Carp::croak("The 'config_override' parameter must be a hash reference.")}else {$self->{':private:'}{Config}=\%Config}for my$tuple ([inc_override=>INC=>[@INC ]],[extra_libs=>EXTRA=>[]]){my ($arg,$key,$val)=@$tuple;if ($args{$arg}){eval {$self->{':private:'}{$key}=[@{$args{$arg}}]}or Carp::croak("The '$arg' parameter must be an array reference.")}elsif ($val){$self->{':private:'}{$key}=$val}}{my%dupe;@{$self->{':private:'}{LIBDIRS}}=grep {$_ ne '.' ||!$args{skip_cwd}}grep {-e $_ &&!$dupe{$_}++}@{$self->{':private:'}{EXTRA}},@{$self->{':private:'}{INC}}}my@dirs=$self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});my$archlib=$self->_fix_dirs($self->{':private:'}{Config}{archlibexp});$self->_make_entry("Perl",File::Spec->catfile($archlib,'.packlist'));my$root;my$sub=sub {return if $_ ne ".packlist" || $File::Find::dir eq $archlib;my$module=$File::Find::name;my$found=$module =~ s!^.*?/auto/(.*)/.packlist!$1!s or do {return};my$modfile="$module.pm";$module =~ s!/!::!g;return if$self->{$module};$self->_make_entry($module,$File::Find::name,$modfile)};while (@dirs){$root=shift@dirs;next if!-d $root;find($sub,$root)}return$self}sub _module_name {my($file,$orig_module)=@_;my$module='';if (open PACKFH,$file){while (<PACKFH>){if (/package\s+(\S+)\s*;/){my$pack=$1;if (lc($pack)eq lc($orig_module)){$module=$pack;last}}}close PACKFH}print STDERR "Couldn't figure out the package name for $file\n" unless$module;return$module}sub modules {my ($self)=@_;$self=$self->new(default=>1)if!ref$self;return wantarray ? sort grep {not /^:private:$/}keys %$self : grep {not /^:private:$/}keys %$self}sub files {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));$type="all" if (!defined($type));Carp::croak('type must be "all", "prog" or "doc"')if ($type ne "all" && $type ne "prog" && $type ne "doc");my (@files);for my$file (keys(%{$self->{$module}{packlist}})){push(@files,$file)if ($self->_is_type($file,$type)&& $self->_is_under($file,@under))}return(@files)}sub directories {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;my (%dirs);for my$file ($self->files($module,$type,@under)){$dirs{dirname($file)}++}return sort keys%dirs}sub directory_tree {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;my (%dirs);for my$dir ($self->directories($module,$type,@under)){$dirs{$dir}++;my ($last)=("");while ($last ne $dir){$last=$dir;$dir=dirname($dir);last if!$self->_is_under($dir,@under);$dirs{$dir}++}}return(sort(keys(%dirs)))}sub validate {my ($self,$module,$remove)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{packlist}->validate($remove))}sub packlist {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{packlist})}sub version {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{version})}sub _debug_dump {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;local$self->{":private:"}{Config};require Data::Dumper;print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump()}1;
EXTUTILS_INSTALLED
$fatpacked{"ExtUtils/PL2Bat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PL2BAT';
package ExtUtils::PL2Bat;$ExtUtils::PL2Bat::VERSION='0.004';use strict;use warnings;use 5.006;use Config;use Carp qw/croak/;sub import {my ($self,@functions)=@_;@functions='pl2bat' if not @functions;my$caller=caller;for my$function (@functions){no strict 'refs';*{"$caller\::$function"}=\&{$function}}}sub pl2bat {my%opts=@_;$opts{ntargs}='-x -S %0 %*' unless exists$opts{ntargs};$opts{otherargs}='-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists$opts{otherargs};$opts{stripsuffix}=qr/\.plx?/ unless exists$opts{stripsuffix};if (not exists$opts{out}){$opts{out}=$opts{in};$opts{out}=~ s/$opts{stripsuffix}$//i;$opts{out}.= '.bat' unless$opts{in}=~ /\.bat$/i or $opts{in}eq '-'}my$head=<<"EOT";$head =~ s/^\s+//gm;my$headlines=2 + ($head =~ tr/\n/\n/);my$tail=<<'EOT';$tail =~ s/^\s+//gm;my$linedone=0;my$taildone=0;my$linenum=0;my$skiplines=0;my$start=$Config{startperl};$start='#!perl' unless$start =~ /^#!.*perl/;open my$in,'<',$opts{in}or croak "Can't open $opts{in}: $!";my@file=<$in>;close$in;for my$line (@file){$linenum++;if ($line =~ /^:endofperl\b/){if (!exists$opts{update}){warn "$opts{in} has already been converted to a batch file!\n";return}$taildone++}if (not $linedone and $line =~ /^#!.*perl/){if (exists$opts{update}){$skiplines=$linenum - 1;$line .= '#line '.(1+$headlines)."\n"}else {$line .= '#line '.($linenum+$headlines)."\n"}$linedone++}if ($line =~ /^#\s*line\b/ and $linenum==2 + $skiplines){$line=''}}open my$out,'>',$opts{out}or croak "Can't open $opts{out}: $!";print$out $head;print$out $start,($opts{usewarnings}? ' -w' : ''),"\n#line ",($headlines+1),"\n" unless$linedone;print$out @file[$skiplines..$#file];print$out $tail unless$taildone;close$out;return$opts{out}}1;
\@rem = '--*-Perl-*--
\@set "ErrorLevel="
\@if "%OS%" == "Windows_NT" \@goto WinNT
\@perl $opts{otherargs}
\@set ErrorLevel=%ErrorLevel%
\@goto endofperl
:WinNT
\@perl $opts{ntargs}
\@set ErrorLevel=%ErrorLevel%
\@if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" \@goto endofperl
\@if %ErrorLevel% == 9009 \@echo You do not have Perl in your PATH.
\@goto endofperl
\@rem ';
EOT
__END__
:endofperl
@set "ErrorLevel=" & @goto _undefined_label_ 2>NUL || @"%COMSPEC%" /d/c @exit %ErrorLevel%
EOT
EXTUTILS_PL2BAT
$fatpacked{"ExtUtils/Packlist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PACKLIST';
package ExtUtils::Packlist;use strict;use Carp qw();use Config;our$Relocations;our$VERSION='2.20';$VERSION=eval$VERSION;my$fhname="FH1";sub mkfh() {no strict;local $^W;my$fh=\*{$fhname++};use strict;return($fh)}sub __find_relocations {my%paths;while (my ($raw_key,$raw_val)=each%Config){my$exp_key=$raw_key ."exp";next unless exists$Config{$exp_key};next unless$raw_val =~ m!\.\.\./!;$paths{$Config{$exp_key}}++}my$alternations=join "|",map {quotemeta $_}sort {length$b <=> length$a}keys%paths;qr/^($alternations)/o}sub new($$) {my ($class,$packfile)=@_;$class=ref($class)|| $class;my%self;tie(%self,$class,$packfile);return(bless(\%self,$class))}sub TIEHASH {my ($class,$packfile)=@_;my$self={packfile=>$packfile };bless($self,$class);$self->read($packfile)if (defined($packfile)&& -f $packfile);return($self)}sub STORE {$_[0]->{data}->{$_[1]}=$_[2]}sub FETCH {return($_[0]->{data}->{$_[1]})}sub FIRSTKEY {my$reset=scalar(keys(%{$_[0]->{data}}));return(each(%{$_[0]->{data}}))}sub NEXTKEY {return(each(%{$_[0]->{data}}))}sub EXISTS {return(exists($_[0]->{data}->{$_[1]}))}sub DELETE {return(delete($_[0]->{data}->{$_[1]}))}sub CLEAR {%{$_[0]->{data}}=()}sub DESTROY {}sub read($;$) {my ($self,$packfile)=@_;$self=tied(%$self)|| $self;if (defined($packfile)){$self->{packfile}=$packfile}else {$packfile=$self->{packfile}}Carp::croak("No packlist filename specified")if (!defined($packfile));my$fh=mkfh();open($fh,"<$packfile")|| Carp::croak("Can't open file $packfile: $!");$self->{data}={};my ($line);while (defined($line=<$fh>)){chomp$line;my ($key,$data)=$line;if ($key =~ /^(.*?)( \w+=.*)$/){$key=$1;$data={map {split('=',$_)}split(' ',$2)};if ($Config{userelocatableinc}&& $data->{relocate_as}){require File::Spec;require Cwd;my ($vol,$dir)=File::Spec->splitpath($packfile);my$newpath=File::Spec->catpath($vol,$dir,$data->{relocate_as});$key=Cwd::realpath($newpath)}}$key =~ s!/\./!/!g;$self->{data}->{$key}=$data}close($fh)}sub write($;$) {my ($self,$packfile)=@_;$self=tied(%$self)|| $self;if (defined($packfile)){$self->{packfile}=$packfile}else {$packfile=$self->{packfile}}Carp::croak("No packlist filename specified")if (!defined($packfile));my$fh=mkfh();open($fh,">$packfile")|| Carp::croak("Can't open file $packfile: $!");for my$key (sort(keys(%{$self->{data}}))){my$data=$self->{data}->{$key};if ($Config{userelocatableinc}){$Relocations ||= __find_relocations();if ($packfile =~ $Relocations){my$prefix=$1;if (File::Spec->no_upwards(File::Spec->abs2rel($key,$prefix))){my$packfile_prefix;(undef,$packfile_prefix)=File::Spec->splitpath($packfile);my$relocate_as =File::Spec->abs2rel($key,$packfile_prefix);if (!ref$data){$data={}}$data->{relocate_as}=$relocate_as}}}print$fh ("$key");if (ref($data)){for my$k (sort(keys(%$data))){print$fh (" $k=$data->{$k}")}}print$fh ("\n")}close($fh)}sub validate($;$) {my ($self,$remove)=@_;$self=tied(%$self)|| $self;my@missing;for my$key (sort(keys(%{$self->{data}}))){if (!-e $key){push(@missing,$key);delete($self->{data}{$key})if ($remove)}}return(@missing)}sub packlist_file($) {my ($self)=@_;$self=tied(%$self)|| $self;return($self->{packfile})}1;
EXTUTILS_PACKLIST
$fatpacked{"File/Copy/Recursive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_COPY_RECURSIVE';
package File::Copy::Recursive;use strict;BEGIN {$INC{'warnings.pm'}="fake warnings entry for < 5.6 perl ($])" if $] < 5.006}use warnings;use Carp;use File::Copy;use File::Spec;use Cwd ();use vars qw(@ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink $PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir $CondCopy $BdTrgWrn $SkipFlop $DirPerms);require Exporter;@ISA=qw(Exporter);@EXPORT_OK=qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir rcopy_glob rmove_glob);$VERSION='0.45';$MaxDepth=0;$KeepMode=1;$CPRFComp=0;$CopyLink=eval {local$SIG{'__DIE__'};symlink '','';1}|| 0;$PFSCheck=1;$RemvBase=0;$NoFtlPth=0;$ForcePth=0;$CopyLoop=0;$RMTrgFil=0;$RMTrgDir=0;$CondCopy={};$BdTrgWrn=0;$SkipFlop=0;$DirPerms=0777;my$samecheck=sub {return 1 if $^O eq 'MSWin32';return if @_!=2 ||!defined $_[0]||!defined $_[1];return if $_[0]eq $_[1];my$one='';if ($PFSCheck){$one=join('-',(stat $_[0])[0,1 ])|| '';my$two=join('-',(stat $_[1])[0,1 ])|| '';if ($one eq $two && $one){carp "$_[0] and $_[1] are identical";return}}if (-d $_[0]&&!$CopyLoop){$one=join('-',(stat $_[0])[0,1 ])if!$one;my$abs=File::Spec->rel2abs($_[1]);my@pth=File::Spec->splitdir($abs);while (@pth){if ($pth[-1]eq '..'){pop@pth;pop@pth unless -l File::Spec->catdir(@pth);next}my$cur=File::Spec->catdir(@pth);last if!$cur;my$two=join('-',(stat$cur)[0,1 ])|| '';if ($one eq $two && $one){carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";return}pop@pth}}return 1};my$glob=sub {my ($do,$src_glob,@args)=@_;local$CPRFComp=1;require File::Glob;my@rt;for my$path (File::Glob::bsd_glob($src_glob)){my@call=[$do->($path,@args)]or return;push@rt,\@call}return@rt};my$move=sub {my$fl=shift;my@x;if ($fl){@x=fcopy(@_)or return}else {@x=dircopy(@_)or return}if (@x){if ($fl){unlink $_[0]or return}else {pathrmdir($_[0])or return}if ($RemvBase){my ($volm,$path)=File::Spec->splitpath($_[0]);pathrm(File::Spec->catpath($volm,$path,''),$ForcePth,$NoFtlPth)or return}}return wantarray ? @x : $x[0]};my$ok_todo_asper_condcopy=sub {my$org=shift;my$copy=1;if (exists$CondCopy->{$org}){if ($CondCopy->{$org}{'md5'}){}if ($copy){}}return$copy};sub fcopy {$samecheck->(@_)or return;if ($RMTrgFil && (-d $_[1]|| -e $_[1])){my$trg=$_[1];if (-d $trg){my@trgx=File::Spec->splitpath($_[0]);$trg=File::Spec->catfile($_[1],$trgx[$#trgx])}$samecheck->($_[0],$trg)or return;if (-e $trg){if ($RMTrgFil==1){unlink$trg or carp "\$RMTrgFil failed: $!"}else {unlink$trg or return}}}my ($volm,$path)=File::Spec->splitpath($_[1]);if ($path &&!-d $path){pathmk(File::Spec->catpath($volm,$path,''),$NoFtlPth)}if (-l $_[0]&& $CopyLink){my$target=readlink(shift());($target)=$target =~ m/(.*)/;carp "Copying a symlink ($_[0]) whose target does not exist" if!-e $target && $BdTrgWrn;my$new=shift();unlink$new if -l $new;symlink($target,$new)or return}elsif (-d $_[0]&& -f $_[1]){return}else {return if -d $_[0];copy(@_)or return;my@base_file=File::Spec->splitpath($_[0]);my$mode_trg=-d $_[1]? File::Spec->catfile($_[1],$base_file[$#base_file]): $_[1];chmod scalar((stat($_[0]))[2]),$mode_trg if$KeepMode}return wantarray ? (1,0,0): 1}sub rcopy {if (-l $_[0]&& $CopyLink){goto&fcopy}goto&dircopy if -d $_[0]|| substr($_[0],(1 * -1),1)eq '*';goto&fcopy}sub rcopy_glob {$glob->(\&rcopy,@_)}sub dircopy {if ($RMTrgDir && -d $_[1]){if ($RMTrgDir==1){pathrmdir($_[1])or carp "\$RMTrgDir failed: $!"}else {pathrmdir($_[1])or return}}my$globstar=0;my$_zero=$_[0];my$_one=$_[1];if (substr($_zero,(1 * -1),1)eq '*'){$globstar=1;$_zero=substr($_zero,0,(length($_zero)- 1))}$samecheck->($_zero,$_[1])or return;if (!-d $_zero || (-e $_[1]&&!-d $_[1])){$!=20;return}if (!-d $_[1]){pathmk($_[1],$NoFtlPth)or return}else {if ($CPRFComp &&!$globstar){my@parts=File::Spec->splitdir($_zero);while ($parts[$#parts]eq ''){pop@parts}$_one=File::Spec->catdir($_[1],$parts[$#parts])}}my$baseend=$_one;my$level=0;my$filen=0;my$dirn=0;my$recurs;$recurs=sub {my ($str,$end,$buf)=@_;$filen++ if$end eq $baseend;$dirn++ if$end eq $baseend;$DirPerms=oct($DirPerms)if substr($DirPerms,0,1)eq '0';mkdir($end,$DirPerms)or return if!-d $end;if ($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth){chmod scalar((stat($str))[2]),$end if$KeepMode;return ($filen,$dirn,$level)if wantarray;return$filen}$level++;my@files;if ($] < 5.006){opendir(STR_DH,$str)or return;@files=grep($_ ne '.' && $_ ne '..',readdir(STR_DH));closedir STR_DH}else {opendir(my$str_dh,$str)or return;@files=grep($_ ne '.' && $_ ne '..',readdir($str_dh));closedir$str_dh}for my$file (@files){my ($file_ut)=$file =~ m{ (.*) }xms;my$org=File::Spec->catfile($str,$file_ut);my$new=File::Spec->catfile($end,$file_ut);if (-l $org && $CopyLink){my$target=readlink($org);($target)=$target =~ m/(.*)/;carp "Copying a symlink ($org) whose target does not exist" if!-e $target && $BdTrgWrn;unlink$new if -l $new;symlink($target,$new)or return}elsif (-d $org){my$rc;if (!-w $org && $KeepMode){local$KeepMode=0;$rc=$recurs->($org,$new,$buf)if defined$buf;$rc=$recurs->($org,$new)if!defined$buf;chmod scalar((stat($org))[2]),$new}else {$rc=$recurs->($org,$new,$buf)if defined$buf;$rc=$recurs->($org,$new)if!defined$buf}if (!$rc){if ($SkipFlop){next}else {return}}$filen++;$dirn++}else {if ($ok_todo_asper_condcopy->($org)){if ($SkipFlop){fcopy($org,$new,$buf)or next if defined$buf;fcopy($org,$new)or next if!defined$buf}else {fcopy($org,$new,$buf)or return if defined$buf;fcopy($org,$new)or return if!defined$buf}chmod scalar((stat($org))[2]),$new if$KeepMode;$filen++}}}$level--;chmod scalar((stat($str))[2]),$end if$KeepMode;1};$recurs->($_zero,$_one,$_[2])or return;return wantarray ? ($filen,$dirn,$level): $filen}sub fmove {$move->(1,@_)}sub rmove {if (-l $_[0]&& $CopyLink){goto&fmove}goto&dirmove if -d $_[0]|| substr($_[0],(1 * -1),1)eq '*';goto&fmove}sub rmove_glob {$glob->(\&rmove,@_)}sub dirmove {$move->(0,@_)}sub pathmk {my ($vol,$dir,$file)=File::Spec->splitpath(shift());my$nofatal=shift;$DirPerms=oct($DirPerms)if substr($DirPerms,0,1)eq '0';if (defined($dir)){my (@dirs)=File::Spec->splitdir($dir);for (my$i=0;$i < scalar(@dirs);$i++ ){my$newdir=File::Spec->catdir(@dirs[0 .. $i ]);my$newpth=File::Spec->catpath($vol,$newdir,"");mkdir($newpth,$DirPerms)or return if!-d $newpth &&!$nofatal;mkdir($newpth,$DirPerms)if!-d $newpth && $nofatal}}if (defined($file)){my$newpth=File::Spec->catpath($vol,$dir,$file);mkdir($newpth,$DirPerms)or return if!-d $newpth &&!$nofatal;mkdir($newpth,$DirPerms)if!-d $newpth && $nofatal}1}sub pathempty {my$pth=shift;my ($orig_dev,$orig_ino)=(lstat$pth)[0,1 ];return 2 if!-d _ ||!defined($orig_dev)|| ($^O ne 'MSWin32' &&!$orig_ino);my$starting_point=Cwd::cwd();my ($starting_dev,$starting_ino)=(lstat$starting_point)[0,1 ];chdir($pth)or Carp::croak("Failed to change directory to “$pth”: $!");$pth='.';_bail_if_changed($pth,$orig_dev,$orig_ino);my@names;my$pth_dh;if ($] < 5.006){opendir(PTH_DH,$pth)or return;@names=grep!/^\.\.?$/,readdir(PTH_DH);closedir PTH_DH}else {opendir($pth_dh,$pth)or return;@names=grep!/^\.\.?$/,readdir($pth_dh);closedir$pth_dh}_bail_if_changed($pth,$orig_dev,$orig_ino);for my$name (@names){my ($name_ut)=$name =~ m{ (.*) }xms;my$flpth=File::Spec->catdir($pth,$name_ut);if (-l $flpth){_bail_if_changed($pth,$orig_dev,$orig_ino);unlink$flpth or return}elsif (-d $flpth){_bail_if_changed($pth,$orig_dev,$orig_ino);pathrmdir($flpth)or return}else {_bail_if_changed($pth,$orig_dev,$orig_ino);unlink$flpth or return}}chdir($starting_point)or Carp::croak("Failed to change directory to “$starting_point”: $!");_bail_if_changed(".",$starting_dev,$starting_ino);return 1}sub pathrm {my ($path,$force,$nofail)=@_;my ($orig_dev,$orig_ino)=(lstat$path)[0,1 ];return 2 if!-d _ ||!defined($orig_dev)||!$orig_ino;if ($force && File::Spec->file_name_is_absolute($path)){Carp::croak("pathrm() w/ force on abspath is not allowed")}my@pth=File::Spec->splitdir($path);my%fs_check;my$aggregate_path;for my$part (@pth){$aggregate_path=defined$aggregate_path ? File::Spec->catdir($aggregate_path,$part): $part;$fs_check{$aggregate_path}=[(lstat$aggregate_path)[0,1 ]]}while (@pth){my$cur=File::Spec->catdir(@pth);last if!$cur;if ($force){_bail_if_changed($cur,$fs_check{$cur}->[0],$fs_check{$cur}->[1]);if (!pathempty($cur)){return unless$nofail}}_bail_if_changed($cur,$fs_check{$cur}->[0],$fs_check{$cur}->[1]);if ($nofail){rmdir$cur}else {rmdir$cur or return}pop@pth}return 1}sub pathrmdir {my$dir=shift;if (-e $dir){return if!-d $dir}else {return 2}my ($orig_dev,$orig_ino)=(lstat$dir)[0,1 ];return 2 if!defined($orig_dev)|| ($^O ne 'MSWin32' &&!$orig_ino);pathempty($dir)or return;_bail_if_changed($dir,$orig_dev,$orig_ino);rmdir$dir or return;return 1}sub _bail_if_changed {my ($path,$orig_dev,$orig_ino)=@_;my ($cur_dev,$cur_ino)=(lstat$path)[0,1 ];if (!defined$cur_dev ||!defined$cur_ino){$cur_dev ||= "undef(path went away?)";$cur_ino ||= "undef(path went away?)"}else {$path=Cwd::abs_path($path)}if ($orig_dev ne $cur_dev || $orig_ino ne $cur_ino){local$Carp::CarpLevel += 1;Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting")}}1;
FILE_COPY_RECURSIVE
$fatpacked{"File/Path.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PATH';
package File::Path;use 5.005_04;use strict;use Cwd 'getcwd';use File::Basename ();use File::Spec ();BEGIN {if ($] < 5.006){eval 'use Symbol'}}use Exporter ();use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);$VERSION='2.18';$VERSION=eval$VERSION;@ISA=qw(Exporter);@EXPORT=qw(mkpath rmtree);@EXPORT_OK=qw(make_path remove_tree);BEGIN {for (qw(VMS MacOS MSWin32 os2)){no strict 'refs';*{"_IS_\U$_"}=$^O eq $_ ? sub () {1}: sub () {0}}*_FORCE_WRITABLE=(grep {$^O eq $_}qw(amigaos dos epoc MSWin32 MacOS os2))? sub () {1}: sub () {0};*_NEED_STAT_CHECK=!(_IS_MSWIN32())? sub () {1}: sub () {0}}sub _carp {require Carp;goto&Carp::carp}sub _croak {require Carp;goto&Carp::croak}sub _error {my$arg=shift;my$message=shift;my$object=shift;if ($arg->{error}){$object='' unless defined$object;$message .= ": $!" if $!;push @{${$arg->{error}}},{$object=>$message }}else {_carp(defined($object)? "$message for $object: $!" : "$message: $!")}}sub __is_arg {my ($arg)=@_;return (ref$arg eq 'HASH')}sub make_path {push @_,{}unless @_ and __is_arg($_[-1]);goto&mkpath}sub mkpath {my$old_style=!(@_ and __is_arg($_[-1]));my$data;my$paths;if ($old_style){my ($verbose,$mode);($paths,$verbose,$mode)=@_;$paths=[$paths]unless UNIVERSAL::isa($paths,'ARRAY');$data->{verbose}=$verbose;$data->{mode}=defined$mode ? $mode : oct '777'}else {my%args_permitted=map {$_=>1}(qw|chmod error group mask mode owner uid user verbose|);my%not_on_win32_args=map {$_=>1}(qw|group owner uid user|);my@bad_args=();my@win32_implausible_args=();my$arg=pop @_;for my$k (sort keys %{$arg}){if (!$args_permitted{$k}){push@bad_args,$k}elsif ($not_on_win32_args{$k}and _IS_MSWIN32){push@win32_implausible_args,$k}else {$data->{$k}=$arg->{$k}}}_carp("Unrecognized option(s) passed to mkpath() or make_path(): @bad_args")if@bad_args;_carp("Option(s) implausible on Win32 passed to mkpath() or make_path(): @win32_implausible_args")if@win32_implausible_args;$data->{mode}=delete$data->{mask}if exists$data->{mask};$data->{mode}=oct '777' unless exists$data->{mode};${$data->{error}}=[]if exists$data->{error};unless (@win32_implausible_args){$data->{owner}=delete$data->{user}if exists$data->{user};$data->{owner}=delete$data->{uid}if exists$data->{uid};if (exists$data->{owner}and $data->{owner}=~ /\D/){my$uid=(getpwnam$data->{owner})[2];if (defined$uid){$data->{owner}=$uid}else {_error($data,"unable to map $data->{owner} to a uid, ownership not changed");delete$data->{owner}}}if (exists$data->{group}and $data->{group}=~ /\D/){my$gid=(getgrnam$data->{group})[2];if (defined$gid){$data->{group}=$gid}else {_error($data,"unable to map $data->{group} to a gid, group ownership not changed");delete$data->{group}}}if (exists$data->{owner}and not exists$data->{group}){$data->{group}=-1}if (exists$data->{group}and not exists$data->{owner}){$data->{owner}=-1}}$paths=[@_]}return _mkpath($data,$paths)}sub _mkpath {my$data=shift;my$paths=shift;my (@created);for my$path (@{$paths}){next unless defined($path)and length($path);$path .= '/' if _IS_OS2 and $path =~ /^\w:\z/s;if (_IS_VMS){next if$path eq '/';$path=VMS::Filespec::unixify($path)}next if -d $path;my$parent=File::Basename::dirname($path);unless (-d $parent or $path eq $parent){push(@created,_mkpath($data,[$parent]))}print "mkdir $path\n" if$data->{verbose};if (mkdir($path,$data->{mode})){push(@created,$path);if (exists$data->{owner}){if (!chown$data->{owner},$data->{group},$path){_error($data,"Cannot change ownership of $path to $data->{owner}:$data->{group}")}}if (exists$data->{chmod}){if (!chmod$data->{chmod},$path){_error($data,"Cannot change permissions of $path to $data->{chmod}")}}}else {my$save_bang=$!;my ($e,$e1)=($save_bang,$^E);$e .= "; $e1" if$e ne $e1;if (!-d $path){$!=$save_bang;if ($data->{error}){push @{${$data->{error}}},{$path=>$e }}else {_croak("mkdir $path: $e")}}}}return@created}sub remove_tree {push @_,{}unless @_ and __is_arg($_[-1]);goto&rmtree}sub _is_subdir {my ($dir,$test)=@_;my ($dv,$dd)=File::Spec->splitpath($dir,1);my ($tv,$td)=File::Spec->splitpath($test,1);return 0 if$dv ne $tv;my@d=File::Spec->splitdir($dd);my@t=File::Spec->splitdir($td);return 0 if@t < @d;return join('/',@d)eq join('/',splice@t,0,+@d)}sub rmtree {my$old_style=!(@_ and __is_arg($_[-1]));my ($arg,$data,$paths);if ($old_style){my ($verbose,$safe);($paths,$verbose,$safe)=@_;$data->{verbose}=$verbose;$data->{safe}=defined$safe ? $safe : 0;if (defined($paths)and length($paths)){$paths=[$paths]unless UNIVERSAL::isa($paths,'ARRAY')}else {_carp("No root path(s) specified\n");return 0}}else {my%args_permitted=map {$_=>1}(qw|error keep_root result safe verbose|);my@bad_args=();my$arg=pop @_;for my$k (sort keys %{$arg}){if (!$args_permitted{$k}){push@bad_args,$k}else {$data->{$k}=$arg->{$k}}}_carp("Unrecognized option(s) passed to remove_tree(): @bad_args")if@bad_args;${$data->{error}}=[]if exists$data->{error};${$data->{result}}=[]if exists$data->{result};$paths=[@_]}$data->{prefix}='';$data->{depth}=0;my@clean_path;$data->{cwd}=getcwd()or do {_error($data,"cannot fetch initial working directory");return 0};for ($data->{cwd}){/\A(.*)\Z/s;$_=$1}for my$p (@$paths){my$ortho_root=_IS_MSWIN32 ? _slash_lc($p): $p;my$ortho_cwd=_IS_MSWIN32 ? _slash_lc($data->{cwd}): $data->{cwd};my$ortho_root_length=length($ortho_root);$ortho_root_length-- if _IS_VMS;if ($ortho_root_length && _is_subdir($ortho_root,$ortho_cwd)){local $!=0;_error($data,"cannot remove path when cwd is $data->{cwd}",$p);next}if (_IS_MACOS){$p=":$p" unless$p =~ /:/;$p .= ":" unless$p =~ /:\z/}elsif (_IS_MSWIN32){$p =~ s{[/\\]\z}{}}else {$p =~ s{/\z}{}}push@clean_path,$p}@{$data}{qw(device inode)}=(lstat$data->{cwd})[0,1 ]or do {_error($data,"cannot stat initial working directory",$data->{cwd});return 0};return _rmtree($data,\@clean_path)}sub _rmtree {my$data=shift;my$paths=shift;my$count=0;my$curdir=File::Spec->curdir();my$updir=File::Spec->updir();my (@files,$root);ROOT_DIR: foreach my$root (@$paths){my$canon=$data->{prefix}? File::Spec->catfile($data->{prefix},$root): $root;my ($ldev,$lino,$perm)=(lstat$root)[0,1,2 ]or next ROOT_DIR;if (-d _){$root=VMS::Filespec::vmspath(VMS::Filespec::pathify($root))if _IS_VMS;if (!chdir($root)){my$root_fh;if (open($root_fh,'<',$root)){my ($fh_dev,$fh_inode)=(stat$root_fh)[0,1];$perm &= oct '7777';my$nperm=$perm | oct '700';local $@;if (!($data->{safe}or $nperm==$perm or!-d _ or $fh_dev ne $ldev or $fh_inode ne $lino or eval {chmod($nperm,$root_fh)})){_error($data,"cannot make child directory read-write-exec",$canon);next ROOT_DIR}close$root_fh}if (!chdir($root)){_error($data,"cannot chdir to child",$canon);next ROOT_DIR}}my ($cur_dev,$cur_inode,$perm)=(stat$curdir)[0,1,2 ]or do {_error($data,"cannot stat current working directory",$canon);next ROOT_DIR};if (_NEED_STAT_CHECK){($ldev eq $cur_dev and $lino eq $cur_inode)or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.")}$perm &= oct '7777';my$nperm=$perm | oct '700';if (!($data->{safe}or $nperm==$perm or chmod($nperm,$curdir))){_error($data,"cannot make directory read+writeable",$canon);$nperm=$perm}my$d;$d=gensym()if $] < 5.006;if (!opendir$d,$curdir){_error($data,"cannot opendir",$canon);@files=()}else {if (!defined ${^TAINT} or ${^TAINT}){@files=map {/\A(.*)\z/s;$1}readdir$d}else {@files=readdir$d}closedir$d}if (_IS_VMS){@files=map {$_ eq '.' ? '.;' : $_}reverse@files}@files=grep {$_ ne $updir and $_ ne $curdir}@files;if (@files){my$narg={%$data};@{$narg}{qw(device inode cwd prefix depth)}=($cur_dev,$cur_inode,$updir,$canon,$data->{depth}+ 1);$count += _rmtree($narg,\@files)}if ($nperm!=$perm and not chmod($perm,$curdir)){_error($data,"cannot reset chmod",$canon)}chdir($data->{cwd})or _croak("cannot chdir to $data->{cwd} from $canon: $!, aborting.");($cur_dev,$cur_inode)=(stat$curdir)[0,1 ]or _croak("cannot stat prior working directory $data->{cwd}: $!, aborting.");if (_NEED_STAT_CHECK){($data->{device}eq $cur_dev and $data->{inode}eq $cur_inode)or _croak("previous directory $data->{cwd} " ."changed before entering $canon, " ."expected dev=$ldev ino=$lino, " ."actual dev=$cur_dev ino=$cur_inode, aborting.")}if ($data->{depth}or!$data->{keep_root}){if ($data->{safe}&& (_IS_VMS ?!&VMS::Filespec::candelete($root):!-w $root)){print "skipped $root\n" if$data->{verbose};next ROOT_DIR}if (_FORCE_WRITABLE and!chmod$perm | oct '700',$root){_error($data,"cannot make directory writeable",$canon)}print "rmdir $root\n" if$data->{verbose};if (rmdir$root){push @{${$data->{result}}},$root if$data->{result};++$count}else {_error($data,"cannot remove directory",$canon);if (_FORCE_WRITABLE &&!chmod($perm,(_IS_VMS ? VMS::Filespec::fileify($root): $root))){_error($data,sprintf("cannot restore permissions to 0%o",$perm),$canon)}}}}else {$root=VMS::Filespec::vmsify("./$root")if _IS_VMS &&!File::Spec->file_name_is_absolute($root)&& ($root !~ m/(?<!\^)[\]>]+/);if ($data->{safe}&& (_IS_VMS ?!&VMS::Filespec::candelete($root):!(-l $root || -w $root))){print "skipped $root\n" if$data->{verbose};next ROOT_DIR}my$nperm=$perm & oct '7777' | oct '600';if (_FORCE_WRITABLE and $nperm!=$perm and not chmod$nperm,$root){_error($data,"cannot make file writeable",$canon)}print "unlink $canon\n" if$data->{verbose};for (;;){if (unlink$root){push @{${$data->{result}}},$root if$data->{result}}else {_error($data,"cannot unlink file",$canon);_FORCE_WRITABLE and chmod($perm,$root)or _error($data,sprintf("cannot restore permissions to 0%o",$perm),$canon);last}++$count;last unless _IS_VMS && lstat$root}}}return$count}sub _slash_lc {my$path=shift;$path =~ tr{\\}{/};return lc($path)}1;
FILE_PATH
$fatpacked{"File/Temp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_TEMP';
package File::Temp;our$VERSION='0.2311';use 5.006;use strict;use Carp;use File::Spec 0.8;use Cwd ();use File::Path 2.06 qw/rmtree/;use Fcntl 1.03;use IO::Seekable;use Errno;use Scalar::Util 'refaddr';require VMS::Stdio if $^O eq 'VMS';eval {require Carp::Heavy};require Symbol if $] < 5.006;use parent 0.221 qw/IO::Handle IO::Seekable/;use overload '""'=>"STRINGIFY",'0+'=>"NUMIFY",fallback=>1;our$DEBUG=0;our$KEEP_ALL=0;use Exporter 5.57 'import';our@EXPORT_OK=qw{tempfile tempdir tmpnam tmpfile mktemp mkstemp mkstemps mkdtemp unlink0 cleanup SEEK_SET SEEK_CUR SEEK_END};our%EXPORT_TAGS=('POSIX'=>[qw/tmpnam tmpfile/],'mktemp'=>[qw/mktemp mkstemp mkstemps mkdtemp/],'seekable'=>[qw/SEEK_SET SEEK_CUR SEEK_END/],);Exporter::export_tags('POSIX','mktemp','seekable');my@CHARS=(qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 _/);use constant MAX_TRIES=>1000;use constant MINX=>4;use constant TEMPXXX=>'X' x 10;use constant STANDARD=>0;use constant MEDIUM=>1;use constant HIGH=>2;my$OPENFLAGS=O_CREAT | O_EXCL | O_RDWR;my$LOCKFLAG;unless ($^O eq 'MacOS'){for my$oflag (qw/NOFOLLOW BINARY LARGEFILE NOINHERIT/){my ($bit,$func)=(0,"Fcntl::O_" .$oflag);no strict 'refs';$OPENFLAGS |= $bit if eval {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};$bit=&$func();1}}$LOCKFLAG=eval {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};&Fcntl::O_EXLOCK()}}my$OPENTEMPFLAGS=$OPENFLAGS;unless ($^O eq 'MacOS'){for my$oflag (qw/TEMPORARY/){my ($bit,$func)=(0,"Fcntl::O_" .$oflag);local($@);no strict 'refs';$OPENTEMPFLAGS |= $bit if eval {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};$bit=&$func();1}}}my%FILES_CREATED_BY_OBJECT;sub _gettemp {croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);' unless scalar(@_)>= 1;my$tempErrStr;my%options=("open"=>0,"mkdir"=>0,"suffixlen"=>0,"unlink_on_close"=>0,"use_exlock"=>0,"ErrStr"=>\$tempErrStr,"file_permissions"=>undef,);my$template=shift;if (ref($template)){carp "File::Temp::_gettemp: template must not be a reference";return ()}if (scalar(@_)% 2!=0){carp "File::Temp::_gettemp: Must have even number of options";return ()}%options=(%options,@_)if @_;${$options{ErrStr}}=undef;if ($options{"open"}&& $options{"mkdir"}){${$options{ErrStr}}="doopen and domkdir can not both be true\n";return ()}my$start=length($template)- 1 - $options{"suffixlen"};if (substr($template,$start - MINX + 1,MINX)ne 'X' x MINX){${$options{ErrStr}}="The template must end with at least ".MINX ." 'X' characters\n";return ()}my$path=_replace_XX($template,$options{"suffixlen"});my ($volume,$directories,$file);my$parent;if ($options{"mkdir"}){($volume,$directories,$file)=File::Spec->splitpath($path,1);my@dirs=File::Spec->splitdir($directories);if ($#dirs==0){$parent=File::Spec->curdir}else {if ($^O eq 'VMS'){$parent=File::Spec->catdir($volume,@dirs[0..$#dirs-1]);$parent='sys$disk:[]' if$parent eq ''}else {$parent=File::Spec->catdir(@dirs[0..$#dirs-1]);$parent=File::Spec->catpath($volume,$parent,'')}}}else {($volume,$directories,$file)=File::Spec->splitpath($path);$parent=File::Spec->catpath($volume,$directories,'');$parent=File::Spec->curdir unless$directories ne ''}unless (-e $parent){${$options{ErrStr}}="Parent directory ($parent) does not exist";return ()}unless (-d $parent){${$options{ErrStr}}="Parent directory ($parent) is not a directory";return ()}if (File::Temp->safe_level==MEDIUM){my$safeerr;unless (_is_safe($parent,\$safeerr)){${$options{ErrStr}}="Parent directory ($parent) is not safe ($safeerr)";return ()}}elsif (File::Temp->safe_level==HIGH){my$safeerr;unless (_is_verysafe($parent,\$safeerr)){${$options{ErrStr}}="Parent directory ($parent) is not safe ($safeerr)";return ()}}my$perms=$options{file_permissions};my$has_perms=defined$perms;$perms=0600 unless$has_perms;for (my$i=0;$i < MAX_TRIES;$i++){if ($options{"open"}){my$fh;if ($] < 5.006){$fh=&Symbol::gensym}local $^F=2;my$open_success=undef;if ($^O eq 'VMS' and $options{"unlink_on_close"}&&!$KEEP_ALL){$fh=VMS::Stdio::vmssysopen($path,$OPENFLAGS,$perms,'fop=dlt');$open_success=$fh}else {my$flags=(($options{"unlink_on_close"}&&!$KEEP_ALL)? $OPENTEMPFLAGS : $OPENFLAGS);$flags |= $LOCKFLAG if (defined$LOCKFLAG && $options{use_exlock});$open_success=sysopen($fh,$path,$flags,$perms)}if ($open_success){chmod($perms,$path)unless$has_perms;return ($fh,$path)}else {unless ($!{EEXIST}){${$options{ErrStr}}="Could not create temp file $path: $!";return ()}}}elsif ($options{"mkdir"}){if (mkdir($path,0700)){chmod(0700,$path);return undef,$path}else {unless ($!{EEXIST}){${$options{ErrStr}}="Could not create directory $path: $!";return ()}}}else {return (undef,$path)unless -e $path}my$original=$path;my$counter=0;my$MAX_GUESS=50;do {$path=_replace_XX($template,$options{"suffixlen"});$counter++}until ($path ne $original || $counter > $MAX_GUESS);if ($counter > $MAX_GUESS){${$options{ErrStr}}="Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";return ()}}${$options{ErrStr}}="Have exceeded the maximum number of attempts (" .MAX_TRIES .") to open temp file/dir";return ()}sub _replace_XX {croak 'Usage: _replace_XX($template, $ignore)' unless scalar(@_)==2;my ($path,$ignore)=@_;my$end=($] >= 5.006 ? "\\z" : "\\Z");if ($ignore){substr($path,0,- $ignore)=~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge}else {$path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge}return$path}sub _force_writable {my$file=shift;chmod 0600,$file}sub _is_safe {my$path=shift;my$err_ref=shift;my@info=stat($path);unless (scalar(@info)){$$err_ref="stat(path) returned no values";return 0};return 1 if $^O eq 'VMS';if ($info[4]> File::Temp->top_system_uid()&& $info[4]!=$>){Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",File::Temp->top_system_uid());$$err_ref="Directory owned neither by root nor the current user" if ref($err_ref);return 0}if (($info[2]& &Fcntl::S_IWGRP)|| ($info[2]& &Fcntl::S_IWOTH)){unless (-d $path){$$err_ref="Path ($path) is not a directory" if ref($err_ref);return 0}unless (-k $path){$$err_ref="Sticky bit not set on $path when dir is group|world writable" if ref($err_ref);return 0}}return 1}sub _is_verysafe {require POSIX;my$path=shift;print "_is_verysafe testing $path\n" if$DEBUG;return 1 if $^O eq 'VMS';my$err_ref=shift;local($@);my$chown_restricted;$chown_restricted=&POSIX::_PC_CHOWN_RESTRICTED()if eval {&POSIX::_PC_CHOWN_RESTRICTED();1};if (defined$chown_restricted){return _is_safe($path,$err_ref)if POSIX::sysconf($chown_restricted)}unless (File::Spec->file_name_is_absolute($path)){$path=File::Spec->rel2abs($path)}my ($volume,$directories,undef)=File::Spec->splitpath($path,1);my@dirs=File::Spec->splitdir($directories);for my$pos (0.. $#dirs){my$dir=File::Spec->catpath($volume,File::Spec->catdir(@dirs[0.. $#dirs - $pos]),'');print "TESTING DIR $dir\n" if$DEBUG;return 0 unless _is_safe($dir,$err_ref)}return 1}sub _can_unlink_opened_file {if (grep $^O eq $_,qw/MSWin32 os2 VMS dos MacOS haiku/){return 0}else {return 1}}sub _can_do_level {my$level=shift;return 1 if$level==STANDARD;if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix'){return 0}else {return 1}}{my (%files_to_unlink,%dirs_to_unlink);END {local($.,$@,$!,$^E,$?);cleanup(at_exit=>1)}sub cleanup {my%h=@_;my$at_exit=delete$h{at_exit};$at_exit=0 if not defined$at_exit;{my@k=sort keys%h;die "unrecognized parameters: @k" if@k}if (!$KEEP_ALL){my@files=(exists$files_to_unlink{$$}? @{$files_to_unlink{$$}}: ());for my$file (@files){close($file->[0]);if (-f $file->[1]){_force_writable($file->[1]);unlink$file->[1]or warn "Error removing ".$file->[1]}}my@dirs=(exists$dirs_to_unlink{$$}? @{$dirs_to_unlink{$$}}: ());my ($cwd,$cwd_to_remove);for my$dir (@dirs){if (-d $dir){if ($at_exit){$cwd=Cwd::abs_path(File::Spec->curdir)if not defined$cwd;my$abs=Cwd::abs_path($dir);if ($abs eq $cwd){$cwd_to_remove=$dir;next}}eval {rmtree($dir,$DEBUG,0)};warn $@ if ($@ && $^W)}}if (defined$cwd_to_remove){chdir$cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";my$updir=File::Spec->updir;chdir$updir or die "cannot chdir to $updir: $!";eval {rmtree($cwd_to_remove,$DEBUG,0)};warn $@ if ($@ && $^W)}@{$files_to_unlink{$$}}=()if exists$files_to_unlink{$$};@{$dirs_to_unlink{$$}}=()if exists$dirs_to_unlink{$$}}}sub _deferred_unlink {croak 'Usage: _deferred_unlink($fh, $fname, $isdir)' unless scalar(@_)==3;my ($fh,$fname,$isdir)=@_;warn "Setting up deferred removal of $fname\n" if$DEBUG;$fname=Cwd::abs_path($fname);($fname)=$fname =~ /^(.*)$/;if ($isdir){if (-d $fname){$fname=VMS::Filespec::vmspath($fname)if $^O eq 'VMS';$dirs_to_unlink{$$}=[]unless exists$dirs_to_unlink{$$};push (@{$dirs_to_unlink{$$}},$fname)}else {carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W}}else {if (-f $fname){$files_to_unlink{$$}=[]unless exists$files_to_unlink{$$};push(@{$files_to_unlink{$$}},[$fh,$fname])}else {carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W}}}}sub _parse_args {my$leading_template=(scalar(@_)% 2==1 ? shift(@_): '');my%args=@_;%args=map +(uc($_)=>$args{$_}),keys%args;my@template=(exists$args{TEMPLATE}? $args{TEMPLATE}: $leading_template ? $leading_template : ());delete$args{TEMPLATE};return(\@template,\%args)}sub new {my$proto=shift;my$class=ref($proto)|| $proto;my ($maybe_template,$args)=_parse_args(@_);my$unlink=(exists$args->{UNLINK}? $args->{UNLINK}: 1);delete$args->{UNLINK};delete$args->{OPEN};my ($fh,$path)=tempfile(@$maybe_template,%$args);print "Tmp: $fh - $path\n" if$DEBUG;${*$fh}=$path;$FILES_CREATED_BY_OBJECT{$$}{$path}=1;%{*$fh}=%$args;bless$fh,$class;$fh->unlink_on_destroy($unlink);return$fh}sub newdir {my$self=shift;my ($maybe_template,$args)=_parse_args(@_);my$cleanup=(exists$args->{CLEANUP}? $args->{CLEANUP}: 1);delete$args->{CLEANUP};my$tempdir=tempdir(@$maybe_template,%$args);my$real_dir=Cwd::abs_path($tempdir);($real_dir)=$real_dir =~ /^(.*)$/;return bless {DIRNAME=>$tempdir,REALNAME=>$real_dir,CLEANUP=>$cleanup,LAUNCHPID=>$$,},"File::Temp::Dir"}sub filename {my$self=shift;return ${*$self}}sub STRINGIFY {my$self=shift;return$self->filename}sub NUMIFY {return refaddr($_[0])}sub unlink_on_destroy {my$self=shift;if (@_){${*$self}{UNLINK}=shift}return ${*$self}{UNLINK}}sub DESTROY {local($.,$@,$!,$^E,$?);my$self=shift;my$file=$self->filename;my$was_created_by_proc;if (exists$FILES_CREATED_BY_OBJECT{$$}{$file}){$was_created_by_proc=1;delete$FILES_CREATED_BY_OBJECT{$$}{$file}}if (${*$self}{UNLINK}&&!$KEEP_ALL){print "# ---------> Unlinking $self\n" if$DEBUG;return unless$was_created_by_proc;_force_writable($file);unlink1($self,$file)or unlink($file)}}sub tempfile {if (@_ && $_[0]eq 'File::Temp'){croak "'tempfile' can't be called as a method"}my%options=("DIR"=>undef,"SUFFIX"=>'',"UNLINK"=>0,"OPEN"=>1,"TMPDIR"=>0,"EXLOCK"=>0,"PERMS"=>undef,);my ($maybe_template,$args)=_parse_args(@_);my$template=@$maybe_template ? $maybe_template->[0]: undef;%options=(%options,%$args);if (!$options{"OPEN"}){warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n" if $^W}if ($options{"DIR"}and $^O eq 'VMS'){$options{"DIR"}=VMS::Filespec::vmspath($options{"DIR"})}if (defined$template){if ($options{"DIR"}){$template=File::Spec->catfile($options{"DIR"},$template)}elsif ($options{TMPDIR}){$template=File::Spec->catfile(_wrap_file_spec_tmpdir(),$template)}}else {if ($options{"DIR"}){$template=File::Spec->catfile($options{"DIR"},TEMPXXX)}else {$template=File::Spec->catfile(_wrap_file_spec_tmpdir(),TEMPXXX)}}$template .= $options{"SUFFIX"};my$unlink_on_close=(wantarray ? 0 : 1);my ($fh,$path,$errstr);croak "Error in tempfile() using template $template: $errstr" unless (($fh,$path)=_gettemp($template,"open"=>$options{OPEN},"mkdir"=>0,"unlink_on_close"=>$unlink_on_close,"suffixlen"=>length($options{SUFFIX}),"ErrStr"=>\$errstr,"use_exlock"=>$options{EXLOCK},"file_permissions"=>$options{PERMS},));_deferred_unlink($fh,$path,0)if$options{"UNLINK"};if (wantarray()){if ($options{'OPEN'}){return ($fh,$path)}else {return (undef,$path)}}else {unlink0($fh,$path)or croak "Error unlinking file $path using unlink0";return$fh}}{my ($alt_tmpdir,$checked);sub _wrap_file_spec_tmpdir {return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};if ($checked){return$alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir}my$xxpath=_replace_XX("X" x 10,0);my$tmpdir=File::Spec->tmpdir;my$testpath=File::Spec->catdir($tmpdir,$xxpath);if (mkdir($testpath,0700)){$checked=1;rmdir$testpath;return$tmpdir}require Win32;my$local_app=File::Spec->catdir(Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA()),'Temp');$testpath=File::Spec->catdir($local_app,$xxpath);if (-e $local_app or mkdir($local_app,0700)){if (mkdir($testpath,0700)){$checked=1;rmdir$testpath;return$alt_tmpdir=$local_app}}croak << "HERE"}}sub tempdir {if (@_ && $_[0]eq 'File::Temp'){croak "'tempdir' can't be called as a method"}my%options=("CLEANUP"=>0,"DIR"=>'',"TMPDIR"=>0,);my ($maybe_template,$args)=_parse_args(@_);my$template=@$maybe_template ? $maybe_template->[0]: undef;%options=(%options,%$args);if (defined$template){if ($options{'TMPDIR'}|| $options{'DIR'}){$template=VMS::Filespec::vmspath($template)if $^O eq 'VMS';my ($volume,$directories,undef)=File::Spec->splitpath($template,1);$template=(File::Spec->splitdir($directories))[-1];if ($options{"DIR"}){$template=File::Spec->catdir($options{"DIR"},$template)}elsif ($options{TMPDIR}){$template=File::Spec->catdir(_wrap_file_spec_tmpdir(),$template)}}}else {if ($options{"DIR"}){$template=File::Spec->catdir($options{"DIR"},TEMPXXX)}else {$template=File::Spec->catdir(_wrap_file_spec_tmpdir(),TEMPXXX)}}my$tempdir;my$suffixlen=0;if ($^O eq 'VMS'){$template =~ m/([\.\]:>]+)$/;$suffixlen=length($1)}if (($^O eq 'MacOS')&& (substr($template,-1)eq ':')){++$suffixlen}my$errstr;croak "Error in tempdir() using $template: $errstr" unless ((undef,$tempdir)=_gettemp($template,"open"=>0,"mkdir"=>1,"suffixlen"=>$suffixlen,"ErrStr"=>\$errstr,));if ($options{'CLEANUP'}&& -d $tempdir){_deferred_unlink(undef,$tempdir,1)}return$tempdir}sub mkstemp {croak "Usage: mkstemp(template)" if scalar(@_)!=1;my$template=shift;my ($fh,$path,$errstr);croak "Error in mkstemp using $template: $errstr" unless (($fh,$path)=_gettemp($template,"open"=>1,"mkdir"=>0,"suffixlen"=>0,"ErrStr"=>\$errstr,));if (wantarray()){return ($fh,$path)}else {return$fh}}sub mkstemps {croak "Usage: mkstemps(template, suffix)" if scalar(@_)!=2;my$template=shift;my$suffix=shift;$template .= $suffix;my ($fh,$path,$errstr);croak "Error in mkstemps using $template: $errstr" unless (($fh,$path)=_gettemp($template,"open"=>1,"mkdir"=>0,"suffixlen"=>length($suffix),"ErrStr"=>\$errstr,));if (wantarray()){return ($fh,$path)}else {return$fh}}sub mkdtemp {croak "Usage: mkdtemp(template)" if scalar(@_)!=1;my$template=shift;my$suffixlen=0;if ($^O eq 'VMS'){$template =~ m/([\.\]:>]+)$/;$suffixlen=length($1)}if (($^O eq 'MacOS')&& (substr($template,-1)eq ':')){++$suffixlen}my ($junk,$tmpdir,$errstr);croak "Error creating temp directory from template $template\: $errstr" unless (($junk,$tmpdir)=_gettemp($template,"open"=>0,"mkdir"=>1,"suffixlen"=>$suffixlen,"ErrStr"=>\$errstr,));return$tmpdir}sub mktemp {croak "Usage: mktemp(template)" if scalar(@_)!=1;my$template=shift;my ($tmpname,$junk,$errstr);croak "Error getting name to temp file from template $template: $errstr" unless (($junk,$tmpname)=_gettemp($template,"open"=>0,"mkdir"=>0,"suffixlen"=>0,"ErrStr"=>\$errstr,));return$tmpname}sub tmpnam {my$tmpdir=_wrap_file_spec_tmpdir();croak "Error temporary directory is not writable" if$tmpdir eq '';my$template=File::Spec->catfile($tmpdir,TEMPXXX);if (wantarray()){return mkstemp($template)}else {return mktemp($template)}}sub tmpfile {my ($fh,$file)=tmpnam();unlink0($fh,$file)or return undef;return$fh}sub tempnam {croak 'Usage tempnam($dir, $prefix)' unless scalar(@_)==2;my ($dir,$prefix)=@_;$prefix .= 'XXXXXXXX';my$template=File::Spec->catfile($dir,$prefix);return mktemp($template)}sub unlink0 {croak 'Usage: unlink0(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;cmpstat($fh,$path)or return 0;if (_can_unlink_opened_file()){return 1 if$KEEP_ALL;croak "unlink0: $path has become a directory!" if -d $path;unlink($path)or return 0;my@fh=stat$fh;print "Link count = $fh[3] \n" if$DEBUG;return 1 if$fh[3]==0 || $^O eq 'cygwin'}_deferred_unlink($fh,$path,0);return 1}sub cmpstat {croak 'Usage: cmpstat(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;warn "Comparing stat\n" if$DEBUG;my@fh;{local ($^W)=0;@fh=stat$fh}return unless@fh;if ($fh[3]> 1 && $^W){carp "unlink0: fstat found too many links; SB=@fh" if $^W}my@path=stat$path;unless (@path){carp "unlink0: $path is gone already" if $^W;return}unless (-f $path){confess "panic: $path is no longer a file: SB=@fh"}my@okstat=(0..$#fh);if ($^O eq 'MSWin32'){@okstat=(1,2,3,4,5,7,8,9,10)}elsif ($^O eq 'os2'){@okstat=(0,2..$#fh)}elsif ($^O eq 'VMS'){@okstat=(0,1)}elsif ($^O eq 'dos'){@okstat=(0,2..7,11..$#fh)}elsif ($^O eq 'mpeix'){@okstat=(0..4,8..10)}for (@okstat){print "Comparing: $_ : $fh[$_] and $path[$_]\n" if$DEBUG;unless ($fh[$_]eq $path[$_]){warn "Did not match $_ element of stat\n" if$DEBUG;return 0}}return 1}sub unlink1 {croak 'Usage: unlink1(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;cmpstat($fh,$path)or return 0;close($fh)or return 0;_force_writable($path);return 1 if$KEEP_ALL;return unlink($path)}{my$LEVEL=STANDARD;sub safe_level {my$self=shift;if (@_){my$level=shift;if (($level!=STANDARD)&& ($level!=MEDIUM)&& ($level!=HIGH)){carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W}else {if ($] < 5.006 && $level!=STANDARD){croak "Currently requires perl 5.006 or newer to do the safe checks"}$LEVEL=$level if _can_do_level($level)}}return$LEVEL}}{my$TopSystemUID=10;$TopSystemUID=197108 if $^O eq 'interix';sub top_system_uid {my$self=shift;if (@_){my$newuid=shift;croak "top_system_uid: UIDs should be numeric" unless$newuid =~ /^\d+$/s;$TopSystemUID=$newuid}return$TopSystemUID}}package File::Temp::Dir;our$VERSION='0.2311';use File::Path qw/rmtree/;use strict;use overload '""'=>"STRINGIFY",'0+'=>\&File::Temp::NUMIFY,fallback=>1;sub dirname {my$self=shift;return$self->{DIRNAME}}sub STRINGIFY {my$self=shift;return$self->dirname}sub unlink_on_destroy {my$self=shift;if (@_){$self->{CLEANUP}=shift}return$self->{CLEANUP}}sub DESTROY {my$self=shift;local($.,$@,$!,$^E,$?);if ($self->unlink_on_destroy && $$==$self->{LAUNCHPID}&&!$File::Temp::KEEP_ALL){if (-d $self->{REALNAME}){eval {rmtree($self->{REALNAME},$File::Temp::DEBUG,0)};warn $@ if ($@ && $^W)}}}1;
Couldn't find a writable temp directory in taint mode. Tried:
$tmpdir
$local_app
Try setting and untainting the TMPDIR environment variable.
HERE
FILE_TEMP
$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH';
package File::Which;use strict;use warnings;use base qw(Exporter);use File::Spec ();our$VERSION='1.27';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_WIN=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_DOS=>IS_WIN();use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');our$IMPLICIT_CURRENT_DIR=IS_WIN || IS_VMS || IS_MAC;my@PATHEXT=('');if (IS_WIN){if ($ENV{PATHEXT}){push@PATHEXT,split /;/,$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_WIN and $exec =~ /\// and -f $exec and -x $exec;my@path;if($^O eq 'MSWin32'){@path=split /;/,$ENV{PATH};s/"//g for@path;@path=grep length,@path}else {@path=File::Spec->path}if ($IMPLICIT_CURRENT_DIR){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_WIN or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1;
FILE_WHICH
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.016';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 {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::pushd in void context');return}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 {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::tempd in void context');return}my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;$dir->{_owner}=$$;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->{_owner}==$$ &&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1;
FILE_PUSHD
$fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG';
use 5.004;use strict;use warnings;package Getopt::Long;use vars qw($VERSION);$VERSION=2.52;use vars qw($VERSION_STRING);$VERSION_STRING="2.52";use Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK);@ISA=qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);BEGIN {@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}use vars@EXPORT,@EXPORT_OK;use vars qw($error $debug $major_version $minor_version);use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough);use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);my$bundling_values;sub config(@);sub ConfigDefaults();sub ParseOptionSpec($$);sub OptCtl($);sub FindOption($$$$$);sub ValidValue ($$$$$);my$requested_version=0;sub ConfigDefaults() {if (defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";$autoabbrev=0;$bundling=0;$getopt_compat=0;$order=$REQUIRE_ORDER}else {$genprefix="(--|-|\\+)";$autoabbrev=1;$bundling=0;$getopt_compat=1;$order=$PERMUTE}$debug=0;$error=0;$ignorecase=1;$passthrough=0;$gnu_compat=0;$longprefix="(--)";$bundling_values=0}sub import {my$pkg=shift;my@syms=();my@config=();my$dest=\@syms;for (@_){if ($_ eq ':config'){$dest=\@config;next}push(@$dest,$_)}local$Exporter::ExportLevel=1;push(@syms,qw(&GetOptions))if@syms;$requested_version=0;$pkg->SUPER::import(@syms);Configure(@config)if@config}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();package Getopt::Long::Parser;my$default_config=do {Getopt::Long::Configure ()};sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);if (defined$atts{config}){my$save=Getopt::Long::Configure ($default_config,@{$atts{config}});$self->{settings}=Getopt::Long::Configure ($save);delete ($atts{config})}else {$self->{settings}=$default_config}if (%atts){die(__PACKAGE__.": unhandled attributes: ".join(" ",sort(keys(%atts)))."\n")}$self}sub configure {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings},@_);$self->{settings}=Getopt::Long::Configure ($save)}sub getoptions {my ($self)=shift;return$self->getoptionsfromarray(\@ARGV,@_)}sub getoptionsfromarray {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings});my$ret=0;$Getopt::Long::caller=$self->{caller_pkg};eval {local ($SIG{__DIE__})='DEFAULT';$ret=Getopt::Long::GetOptionsFromArray (@_)};Getopt::Long::Configure ($save);die ($@)if $@;return$ret}package Getopt::Long;use constant CTL_TYPE=>0;use constant CTL_CNAME=>1;use constant CTL_DEFAULT=>2;use constant CTL_DEST=>3;use constant CTL_DEST_SCALAR=>0;use constant CTL_DEST_ARRAY=>1;use constant CTL_DEST_HASH=>2;use constant CTL_DEST_CODE=>3;use constant CTL_AMIN=>4;use constant CTL_AMAX=>5;use constant PAT_INT=>"[-+]?_*[0-9][0-9_]*";use constant PAT_XINT=>"(?:"."[-+]?_*[1-9][0-9_]*"."|"."0x_*[0-9a-f][0-9a-f_]*"."|"."0b_*[01][01_]*"."|"."0[0-7_]*".")";use constant PAT_FLOAT=>"[-+]?"."(?=[0-9.])"."[0-9_]*"."(\.[0-9_]+)?"."([eE][-+]?[0-9_]+)?";sub GetOptions(@) {unshift(@_,\@ARGV);goto&GetOptionsFromArray}sub GetOptionsFromString(@) {my ($string)=shift;require Text::ParseWords;my$args=[Text::ParseWords::shellwords($string)];$caller ||= (caller)[0];my$ret=GetOptionsFromArray($args,@_);return ($ret,$args)if wantarray;if (@$args){$ret=0;warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n")}$ret}sub GetOptionsFromArray(@) {my ($argv,@optionlist)=@_;my$argend='--';my%opctl=();my$pkg=$caller || (caller)[0];my@ret=();my%linkage;my$userlinkage;my$opt;my$prefix=$genprefix;$error='';if ($debug){local ($^W)=0;print STDERR ("Getopt::Long $Getopt::Long::VERSION_STRING ","called from package \"$pkg\".","\n ","argv: ",defined($argv)? UNIVERSAL::isa($argv,'ARRAY')? "(@$argv)" : $argv : "<undef>","\n ","autoabbrev=$autoabbrev,"."bundling=$bundling,","bundling_values=$bundling_values,","getopt_compat=$getopt_compat,","gnu_compat=$gnu_compat,","order=$order,","\n ","ignorecase=$ignorecase,","requested_version=$requested_version,","passthrough=$passthrough,","genprefix=\"$genprefix\",","longprefix=\"$longprefix\".","\n")}$userlinkage=undef;if (@optionlist && ref($optionlist[0])and UNIVERSAL::isa($optionlist[0],'HASH')){$userlinkage=shift (@optionlist);print STDERR ("=> user linkage: $userlinkage\n")if$debug}if (@optionlist && $optionlist[0]=~ /^\W+$/ &&!($optionlist[0]eq '<>' && @optionlist > 0 && ref($optionlist[1]))){$prefix=shift (@optionlist);$prefix =~ s/(\W)/\\$1/g;$prefix="([" .$prefix ."])";print STDERR ("=> prefix=\"$prefix\"\n")if$debug}%opctl=();while (@optionlist){my$opt=shift (@optionlist);unless (defined($opt)){$error .= "Undefined argument in option spec\n";next}$opt=$+ if$opt =~ /^$prefix+(.*)$/s;if ($opt eq '<>'){if ((defined$userlinkage)&&!(@optionlist > 0 && ref($optionlist[0]))&& (exists$userlinkage->{$opt})&& ref($userlinkage->{$opt})){unshift (@optionlist,$userlinkage->{$opt})}unless (@optionlist > 0 && ref($optionlist[0])&& ref($optionlist[0])eq 'CODE'){$error .= "Option spec <> requires a reference to a subroutine\n";shift (@optionlist)if@optionlist && ref($optionlist[0]);next}$linkage{'<>'}=shift (@optionlist);next}my ($name,$orig)=ParseOptionSpec ($opt,\%opctl);unless (defined$name){$error .= $orig;shift (@optionlist)if@optionlist && ref($optionlist[0]);next}if (defined$userlinkage){unless (@optionlist > 0 && ref($optionlist[0])){if (exists$userlinkage->{$orig}&& ref($userlinkage->{$orig})){print STDERR ("=> found userlinkage for \"$orig\": ","$userlinkage->{$orig}\n")if$debug;unshift (@optionlist,$userlinkage->{$orig})}else {next}}}if (@optionlist > 0 && ref($optionlist[0])){print STDERR ("=> link \"$orig\" to $optionlist[0]\n")if$debug;my$rl=ref($linkage{$orig}=shift (@optionlist));if ($rl eq "ARRAY"){$opctl{$name}[CTL_DEST]=CTL_DEST_ARRAY}elsif ($rl eq "HASH"){$opctl{$name}[CTL_DEST]=CTL_DEST_HASH}elsif ($rl eq "SCALAR" || $rl eq "REF"){}elsif ($rl eq "CODE"){}else {$error .= "Invalid option linkage for \"$opt\"\n"}}else {my$ov=$orig;$ov =~ s/\W/_/g;if ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;")}elsif ($opctl{$name}[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;")}else {print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;")}}if ($opctl{$name}[CTL_TYPE]eq 'I' && ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST]==CTL_DEST_HASH)){$error .= "Invalid option linkage for \"$opt\"\n"}}$error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless$argv && UNIVERSAL::isa($argv,'ARRAY');die ($error)if$error;$error=0;if (defined($auto_version)? $auto_version : ($requested_version >= 2.3203)){if (!defined($opctl{version})){$opctl{version}=['','version',0,CTL_DEST_CODE,undef];$linkage{version}=\&VersionMessage}$auto_version=1}if (defined($auto_help)? $auto_help : ($requested_version >= 2.3203)){if (!defined($opctl{help})&&!defined($opctl{'?'})){$opctl{help}=$opctl{'?'}=['','help',0,CTL_DEST_CODE,undef];$linkage{help}=\&HelpMessage}$auto_help=1}if ($debug){my ($arrow,$k,$v);$arrow="=> ";while (($k,$v)=each(%opctl)){print STDERR ($arrow,"\$opctl{$k} = $v ",OptCtl($v),"\n");$arrow=" "}}my$goon=1;while ($goon && @$argv > 0){$opt=shift (@$argv);print STDERR ("=> arg \"",$opt,"\"\n")if$debug;if (defined($opt)&& $opt eq $argend){push (@ret,$argend)if$passthrough;last}my$tryopt=$opt;my$found;my$key;my$arg;my$ctl;($found,$opt,$ctl,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){my$given=$opt;print STDERR ("=> cname for \"$opt\" is ")if$debug;$opt=$ctl->[CTL_CNAME];print STDERR ("\"$ctl->[CTL_CNAME]\"\n")if$debug;if (defined$linkage{$opt}){print STDERR ("=> ref(\$L{$opt}) -> ",ref($linkage{$opt}),"\n")if$debug;if (ref($linkage{$opt})eq 'SCALAR' || ref($linkage{$opt})eq 'REF'){if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")if$debug;if (defined ${$linkage{$opt}}){${$linkage{$opt}}+= $arg}else {${$linkage{$opt}}=$arg}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to ARRAY\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}=[];print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to HASH\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}={};print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}else {print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")if$debug;${$linkage{$opt}}=$arg}}elsif (ref($linkage{$opt})eq 'ARRAY'){print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif (ref($linkage{$opt})eq 'HASH'){print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}elsif (ref($linkage{$opt})eq 'CODE'){print STDERR ("=> &L{$opt}(\"$opt\"",$ctl->[CTL_DEST]==CTL_DEST_HASH ? ", \"$key\"" : "",", \"$arg\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&{$linkage{$opt}}(Getopt::Long::CallBack->new (name=>$opt,given=>$given,ctl=>$ctl,opctl=>\%opctl,linkage=>\%linkage,prefix=>$prefix,),$ctl->[CTL_DEST]==CTL_DEST_HASH ? ($key): (),$arg)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("Invalid REF type \"",ref($linkage{$opt}),"\" in linkage\n");die("Getopt::Long -- internal error!\n")}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){if (defined$userlinkage->{$opt}){print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")if$debug;push (@{$userlinkage->{$opt}},$arg)}else {print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")if$debug;$userlinkage->{$opt}=[$arg]}}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){if (defined$userlinkage->{$opt}){print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")if$debug;$userlinkage->{$opt}->{$key}=$arg}else {print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")if$debug;$userlinkage->{$opt}={$key=>$arg}}}else {if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$L{$opt} += \"$arg\"\n")if$debug;if (defined$userlinkage->{$opt}){$userlinkage->{$opt}+= $arg}else {$userlinkage->{$opt}=$arg}}else {print STDERR ("=>\$L{$opt} = \"$arg\"\n")if$debug;$userlinkage->{$opt}=$arg}}$argcnt++;last if$argcnt >= $ctl->[CTL_AMAX]&& $ctl->[CTL_AMAX]!=-1;undef($arg);if ($argcnt < $ctl->[CTL_AMIN]){if (@$argv){if (ValidValue($ctl,$argv->[0],1,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}warn("Value \"$$argv[0]\" invalid for option $opt\n");$error++}else {warn("Insufficient arguments for option $opt\n");$error++}}if (@$argv && ValidValue($ctl,$argv->[0],0,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}}}elsif ($order==$PERMUTE){my$cb;if (defined ($cb=$linkage{'<>'})){print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&$cb($tryopt)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;push (@ret,$tryopt)}next}else {unshift (@$argv,$tryopt);return ($error==0)}}if (@ret && ($order==$PERMUTE || $passthrough)){print STDERR ("=> restoring \"",join('" "',@ret),"\"\n")if$debug;unshift (@$argv,@ret)}return ($error==0)}sub OptCtl ($) {my ($v)=@_;my@v=map {defined($_)? ($_): ("<undef>")}@$v;"[".join(",","\"$v[CTL_TYPE]\"","\"$v[CTL_CNAME]\"","\"$v[CTL_DEFAULT]\"",("\$","\@","\%","\&")[$v[CTL_DEST]|| 0],$v[CTL_AMIN]|| '',$v[CTL_AMAX]|| '',)."]"}sub ParseOptionSpec ($$) {my ($opt,$opctl)=@_;if ($opt !~ m;^
(
# Option name
(?: \w+[-\w]* )
# Aliases
(?: \| (?: . [^|!+=:]* )? )*
)?
(
# Either modifiers ...
[!+]
|
# ... or a value/dest/repeat specification
[=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
|
# ... or an optional-with-default spec
: (?: -?\d+ | \+ ) [@%]?
)?
$;x){return (undef,"Error in option spec: \"$opt\"\n")}my ($names,$spec)=($1,$2);$spec='' unless defined$spec;my$orig;my@names;if (defined$names){@names=split (/\|/,$names);$orig=$names[0]}else {@names=('');$orig=''}my$entry;if ($spec eq '' || $spec eq '+' || $spec eq '!'){$entry=[$spec,$orig,undef,CTL_DEST_SCALAR,0,0]}elsif ($spec =~ /^:(-?\d+|\+)([@%])?$/){my$def=$1;my$dest=$2;my$type=$def eq '+' ? 'I' : 'i';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$entry=[$type,$orig,$def eq '+' ? undef : $def,$dest,0,1]}else {my ($mand,$type,$dest)=$spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;return (undef,"Cannot repeat while bundling: \"$opt\"\n")if$bundling && defined($4);my ($mi,$cm,$ma)=($5,$6,$7);return (undef,"{0} is useless in option spec: \"$opt\"\n")if defined($mi)&&!$mi &&!defined($ma)&&!defined($cm);$type='i' if$type eq 'n';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$mi=$mand eq '=' ? 1 : 0 unless defined$mi;$mand=$mi ? '=' : ':';$ma=$mi ? $mi : 1 unless defined$ma || defined$cm;return (undef,"Max must be greater than zero in option spec: \"$opt\"\n")if defined($ma)&&!$ma;return (undef,"Max less than min in option spec: \"$opt\"\n")if defined($ma)&& $ma < $mi;$entry=[$type,$orig,undef,$dest,$mi,$ma||-1]}my$dups='';for (@names){$_=lc ($_)if$ignorecase > (($bundling && length($_)==1)? 1 : 0);if (exists$opctl->{$_}){$dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"}if ($spec eq '!'){$opctl->{"no$_"}=$entry;$opctl->{"no-$_"}=$entry;$opctl->{$_}=[@$entry];$opctl->{$_}->[CTL_TYPE]=''}else {$opctl->{$_}=$entry}}if ($dups && $^W){for (split(/\n+/,$dups)){warn($_."\n")}}($names[0],$orig)}sub FindOption ($$$$$) {my ($argv,$prefix,$argend,$opt,$opctl)=@_;print STDERR ("=> find \"$opt\"\n")if$debug;return (0)unless defined($opt);return (0)unless$opt =~ /^($prefix)(.*)$/s;return (0)if$opt eq "-" &&!defined$opctl->{''};$opt=substr($opt,length($1));my$starter=$1;print STDERR ("=> split \"$starter\"+\"$opt\"\n")if$debug;my$optarg;my$rest;if (($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling==0 || $bundling==2)))&& (my$oppos=index($opt,'=',1))> 0){my$optorg=$opt;$opt=substr($optorg,0,$oppos);$optarg=substr($optorg,$oppos + 1);print STDERR ("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug}my$tryopt=$opt;if (($bundling || $bundling_values)&& $starter eq '-'){$tryopt=$ignorecase ? lc($opt): $opt;if ($bundling==2 && length($tryopt)> 1 && defined ($opctl->{$tryopt})){print STDERR ("=> $starter$tryopt overrides unbundling\n")if$debug}elsif ($bundling_values){$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$optarg=$rest eq '' ? undef : $rest;$rest=undef}else {$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$rest=undef unless$rest ne ''}}elsif ($autoabbrev && $opt ne ""){my@names=sort(keys (%$opctl));$opt=lc ($opt)if$ignorecase;$tryopt=$opt;my$pat=quotemeta ($opt);my@hits=grep (/^$pat/,@names);print STDERR ("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@names),"\n")if$debug;unless ((@hits <= 1)|| (grep ($_ eq $opt,@hits)==1)){my%hit;for (@hits){my$hit=$opctl->{$_}->[CTL_CNAME]if defined$opctl->{$_}->[CTL_CNAME];$hit="no" .$hit if$opctl->{$_}->[CTL_TYPE]eq '!';$hit{$hit}=1}if (keys(%hit)==2){if ($auto_version && exists($hit{version})){delete$hit{version}}elsif ($auto_help && exists($hit{help})){delete$hit{help}}}unless (keys(%hit)==1){return (0)if$passthrough;warn ("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");$error++;return (1,undef)}@hits=keys(%hit)}if (@hits==1 && $hits[0]ne $opt){$tryopt=$hits[0];$tryopt=lc ($tryopt)if$ignorecase > (($bundling && length($tryopt)==1)? 1 : 0);print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")if$debug}}elsif ($ignorecase){$tryopt=lc ($opt)}my$ctl=$opctl->{$tryopt};unless (defined$ctl){return (0)if$passthrough;if ($bundling==1 && length($starter)==1){$opt=substr($opt,0,1);unshift (@$argv,$starter.$rest)if defined$rest}if ($opt eq ""){warn ("Missing option after ",$starter,"\n")}else {warn ("Unknown option: ",$opt,"\n")}$error++;return (1,undef)}$opt=$tryopt;print STDERR ("=> found ",OptCtl($ctl)," for \"",$opt,"\"\n")if$debug;my$type=$ctl->[CTL_TYPE];my$arg;if ($type eq '' || $type eq '!' || $type eq '+'){if (defined$optarg){return (0)if$passthrough;warn ("Option ",$opt," does not take an argument\n");$error++;undef$opt;undef$optarg if$bundling_values}elsif ($type eq '' || $type eq '+'){$arg=1}else {$opt =~ s/^no-?//i;$arg=0}unshift (@$argv,$starter.$rest)if defined$rest;return (1,$opt,$ctl,$arg)}my$mand=$ctl->[CTL_AMIN];if ($gnu_compat){my$optargtype=0;if (defined($optarg)){$optargtype=(length($optarg)==0)? 1 : 2}elsif (defined$rest || @$argv > 0){$optargtype=3}if(($optargtype==0)&&!$mand){if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}my$val =defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$val)}return (1,$opt,$ctl,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand || $ctl->[CTL_DEST]==CTL_DEST_HASH){return (0)if$passthrough;warn ("Option ",$opt," requires an argument\n");$error++;return (1,undef)}if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}return (1,$opt,$ctl,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0)}$arg=(defined$rest ? $rest : (defined$optarg ? $optarg : shift (@$argv)));my$key;if ($ctl->[CTL_DEST]==CTL_DEST_HASH && defined$arg){($key,$arg)=($arg =~ /^([^=]*)=(.*)$/s)? ($1,$2): ($arg,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: ($mand ? undef : ($type eq 's' ? "" : 1)));if (!defined$arg){warn ("Option $opt, key \"$key\", requires a value\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}}my$key_valid=$ctl->[CTL_DEST]==CTL_DEST_HASH ? "[^=]+=" : "";if ($type eq 's'){return (1,$opt,$ctl,$arg,$key)if$mand;return (1,$opt,$ctl,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$arg,$key)if$arg eq "-";if ($arg eq $argend || $arg =~ /^$prefix.+/){unshift (@$argv,$arg);$arg=''}}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/si){($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/si){$arg =~ tr/_//d;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (",$type eq 'o' ? "extended " : '',"number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}$arg=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: 0}}}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/s){$arg =~ tr/_//d;($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/){$arg =~ tr/_//d}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (real number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);$arg=0.0}}}else {die("Getopt::Long internal error (Can't happen)\n")}return (1,$opt,$ctl,$arg,$key)}sub ValidValue ($$$$$) {my ($ctl,$arg,$mand,$argend,$prefix)=@_;if ($ctl->[CTL_DEST]==CTL_DEST_HASH){return 0 unless$arg =~ /[^=]+=(.*)/;$arg=$1}my$type=$ctl->[CTL_TYPE];if ($type eq 's'){return (1)if$mand;return (1)if$arg eq "-";return 0 if$arg eq $argend || $arg =~ /^$prefix.+/;return 1}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;return$arg =~ /^$o_valid$/si}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;return$arg =~ /^$o_valid$/}die("ValidValue: Cannot happen\n")}sub Configure (@) {my (@options)=@_;my$prevconfig=[$error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values ];if (ref($options[0])eq 'ARRAY'){($error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values)=@{shift(@options)}}my$opt;for$opt (@options){my$try=lc ($opt);my$action=1;if ($try =~ /^no_?(.*)$/s){$action=0;$try=$+}if (($try eq 'default' or $try eq 'defaults')&& $action){ConfigDefaults ()}elsif (($try eq 'posix_default' or $try eq 'posix_defaults')){local$ENV{POSIXLY_CORRECT};$ENV{POSIXLY_CORRECT}=1 if$action;ConfigDefaults ()}elsif ($try eq 'auto_abbrev' or $try eq 'autoabbrev'){$autoabbrev=$action}elsif ($try eq 'getopt_compat'){$getopt_compat=$action;$genprefix=$action ? "(--|-|\\+)" : "(--|-)"}elsif ($try eq 'gnu_getopt'){if ($action){$gnu_compat=1;$bundling=1;$getopt_compat=0;$genprefix="(--|-)";$order=$PERMUTE;$bundling_values=0}}elsif ($try eq 'gnu_compat'){$gnu_compat=$action;$bundling=0;$bundling_values=1}elsif ($try =~ /^(auto_?)?version$/){$auto_version=$action}elsif ($try =~ /^(auto_?)?help$/){$auto_help=$action}elsif ($try eq 'ignorecase' or $try eq 'ignore_case'){$ignorecase=$action}elsif ($try eq 'ignorecase_always' or $try eq 'ignore_case_always'){$ignorecase=$action ? 2 : 0}elsif ($try eq 'bundling'){$bundling=$action;$bundling_values=0 if$action}elsif ($try eq 'bundling_override'){$bundling=$action ? 2 : 0;$bundling_values=0 if$action}elsif ($try eq 'bundling_values'){$bundling_values=$action;$bundling=0 if$action}elsif ($try eq 'require_order'){$order=$action ? $REQUIRE_ORDER : $PERMUTE}elsif ($try eq 'permute'){$order=$action ? $PERMUTE : $REQUIRE_ORDER}elsif ($try eq 'pass_through' or $try eq 'passthrough'){$passthrough=$action}elsif ($try =~ /^prefix=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .quotemeta($genprefix).")";eval {'' =~ /$genprefix/};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^prefix_pattern=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .$genprefix .")" unless$genprefix =~ /^\(.*\)$/;eval {'' =~ m"$genprefix"};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^long_prefix_pattern=(.+)$/ && $action){$longprefix=$1;$longprefix="(" .$longprefix .")" unless$longprefix =~ /^\(.*\)$/;eval {'' =~ m"$longprefix"};die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n")if $@}elsif ($try eq 'debug'){$debug=$action}else {die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")}}$prevconfig}sub config (@) {Configure (@_)}sub VersionMessage(@) {my$pa=setup_pa_args("version",@_);my$v=$main::VERSION;my$fh=$pa->{-output}|| (($pa->{-exitval}eq "NOEXIT" || $pa->{-exitval}< 2)? \*STDOUT : \*STDERR);print$fh (defined($pa->{-message})? $pa->{-message}: (),$0,defined$v ? " version $v" : (),"\n","(",__PACKAGE__,"::","GetOptions"," version ",defined($Getopt::Long::VERSION_STRING)? $Getopt::Long::VERSION_STRING : $VERSION,";"," Perl version ",$] >= 5.006 ? sprintf("%vd",$^V): $],")\n");exit($pa->{-exitval})unless$pa->{-exitval}eq "NOEXIT"}sub HelpMessage(@) {eval {require Pod::Usage;import Pod::Usage;1}|| die("Cannot provide help: cannot load Pod::Usage\n");pod2usage(setup_pa_args("help",@_))}sub setup_pa_args($@) {my$tag=shift;@_=()if @_==2 && $_[0]eq $tag;my$pa;if (@_ > 1){$pa={@_ }}else {$pa=shift || {}}if (UNIVERSAL::isa($pa,'HASH')){$pa->{-message}=$pa->{-msg};delete($pa->{-msg})}elsif ($pa =~ /^-?\d+$/){$pa={-exitval=>$pa }}else {$pa={-message=>$pa }}$pa->{-verbose}=0 unless exists($pa->{-verbose});$pa->{-exitval}=0 unless exists($pa->{-exitval});$pa}sub VERSION {$requested_version=$_[1]if @_ > 1;shift->SUPER::VERSION(@_)}package Getopt::Long::CallBack;sub new {my ($pkg,%atts)=@_;bless {%atts },$pkg}sub name {my$self=shift;''.$self->{name}}sub given {my$self=shift;$self->{given}}use overload '""'=>\&name,fallback=>1;1;
GETOPT_LONG
$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
package HTTP::Tiny;use strict;use warnings;our$VERSION='0.080';sub _croak {require Carp;Carp::croak(@_)}my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy 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 timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{handle}){$self->{handle}->timeout($timeout)}}return$self->{timeout}}sub new {my($class,%args)=@_;my$self={max_redirect=>5,timeout=>defined$args{timeout}? $args{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}=($ENV{CGI_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 patch 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 _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 _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ ."\n");if (exists$args->{headers}){my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}$args->{headers}=$headers}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 _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 _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($response->{success}){rename$tempfile,$file or _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 _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|SSL read error)}}if (my$e=$@){if (ref$e eq 'HASH' && exists$e->{status}){$e->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}|| []};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,},(@{$args->{_redirects}|| []}? (redirects=>delete$args->{_redirects}): ()),}}return$response}sub www_form_urlencode {my ($self,$data)=@_;(@_==2 && ref$data)or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ ."\n");(ref$data eq 'HASH' || ref$data eq 'ARRAY')or _croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or _croak("form data reference must have an even number of terms\n");my@terms;while(@params){my ($key,$value)=splice(@params,0,2);_croak("form data keys must not be undef")if!defined($key);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,'');local@INC=@INC;pop@INC if$INC[-1]eq '.';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}sub connected {my ($self)=@_;if ($self->{handle}){return$self->{handle}->connected}return}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;my$version=$class->VERSION;$default_agent .= "/$version" if defined$version;return$default_agent}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);if ($scheme ne 'http' && $scheme ne 'https'){die(qq/Unsupported URL scheme '$scheme'\n/)}my$request={method=>$method,scheme=>$scheme,host=>$host,port=>$port,host_port=>($port==$DefaultPort{$scheme}? $host : "$host:$port"),uri=>$path_query,headers=>{},};my$peer=$args->{peer}|| $host;if ('CODE' eq ref$peer){$peer=$peer->($host)}my$handle=delete$self->{handle};if ($handle){unless ($handle->can_reuse($scheme,$host,$port,$peer)){$handle->close;undef$handle}}$handle ||= $self->_open_handle($request,$scheme,$host,$port,$peer);$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};my@redir_args=$self->_maybe_redirect($request,$response,$args);my$known_message_length;if ($method eq 'HEAD' || $response->{status}=~ /^[23]04/){$known_message_length=1}else {my$cb_args=@redir_args ? +{}: $args;my$data_cb=$self->_prepare_data_cb($response,$cb_args);$known_message_length=$handle->read_body($data_cb,$response)}if ($self->{keep_alive}&& $handle->connected && $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;if (@redir_args){push @{$args->{_redirects}},$response;return$self->_request(@redir_args,$args)}$response->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}};return$response}sub _open_handle {my ($self,$request,$scheme,$host,$port,$peer)=@_;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,$peer)}}sub _proxy_connect {my ($self,$request,$handle)=@_;my@proxy_vars;if ($request->{scheme}eq 'https'){_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'){_croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}})}}else {_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,$p_host);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 '/'){_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;$request->{header_case}{lc$k}=$k}}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 ($request->{method}eq 'PUT' || $request->{method}eq 'POST'){if (!defined($args->{content})||!length($args->{content})){$request->{headers}{'content-length'}=0}}if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){if (exists$request->{'content-length'}&& $request->{'content-length'}==0){$request->{cb}=sub {""}}else {$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless exists$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/){_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});$args->{_redirects}||= [];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)=@_;return "" if!defined$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}/g;return$str}package HTTP::Tiny::Handle;use strict;use warnings;use Errno qw[EINTR EPIPE];use IO::Socket qw[SOCK_STREAM];use Socket qw[SOL_SOCKET SO_KEEPALIVE];my$SOCKET_CLASS=$ENV{PERL_HTTP_TINY_IPV4_ONLY}? 'IO::Socket::INET' : eval {require IO::Socket::IP;IO::Socket::IP->VERSION(0.32)}? '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]/;my$Field_Content=qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;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 timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{fh}&& $self->{fh}->can('timeout')){$self->{fh}->timeout($timeout)}}return$self->{timeout}}sub connect {@_==5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ ."\n");my ($self,$scheme,$host,$port,$peer)=@_;if ($scheme eq 'https'){$self->_assert_ssl}$self->{fh}=$SOCKET_CLASS->new(PeerHost=>$peer,PeerPort=>$port,$self->{local_address}? (LocalAddr=>$self->{local_address}): (),Proto=>'tcp',Type=>SOCK_STREAM,Timeout=>$self->{timeout},)or die(qq/Could not connect to '$host:$port': $@\n/);binmode($self->{fh})or die(qq/Could not binmode() socket: '$!'\n/);if ($self->{keep_alive}){unless (defined($self->{fh}->setsockopt(SOL_SOCKET,SO_KEEPALIVE,1))){CORE::close($self->{fh});die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/)}}$self->start_ssl($host)if$scheme eq 'https';$self->{scheme}=$scheme;$self->{host}=$host;$self->{peer}=$peer;$self->{port}=$port;$self->{pid}=$$;$self->{tid}=_get_tid();return$self}sub connected {my ($self)=@_;if ($self->{fh}&& $self->{fh}->connected){return wantarray ? ($self->{fh}->peerhost,$self->{fh}->peerport): join(':',$self->{fh}->peerhost,$self->{fh}->peerport)}return}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}local$SIG{PIPE}='IGNORE';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 header_case/});$self->write_body($request)if$request->{cb};return}my@rfc_request_headers=qw(Accept Accept-Charset Accept-Encoding Accept-Language Authorization Cache-Control Connection Content-Length Expect From Host If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer Transfer-Encoding Upgrade User-Agent Via);my@other_request_headers=qw(Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin X-XSS-Protection);my%HeaderCase=map {lc($_)=>$_}@rfc_request_headers,@other_request_headers;sub write_header_lines {(@_ >= 2 && @_ <= 4 && ref $_[1]eq 'HASH')|| die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ ."\n");my($self,$headers,$header_case,$prefix_data)=@_;$header_case ||= {};my$buf=(defined$prefix_data ? $prefix_data : '');my%seen;for my$k (qw/host cache-control expect max-forwards pragma range te/){next unless exists$headers->{$k};$seen{$k}++;my$field_name=$HeaderCase{$k};my$v=$headers->{$k};for (ref$v eq 'ARRAY' ? @$v : $v){$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}while (my ($k,$v)=each %$headers){my$field_name=lc$k;next if$seen{$field_name};if (exists$HeaderCase{$field_name}){$field_name=$HeaderCase{$field_name}}else {if (exists$header_case->{$field_name}){$field_name=$header_case->{$field_name}}else {$field_name =~ s/\b(\w)/\u$1/g}$field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / .$Printable->($field_name)."\n");$HeaderCase{lc$field_name}=$field_name}for (ref$v eq 'ARRAY' ? @$v : $v){s/\x0D?\x0A\s+/ /g;die(qq/Invalid HTTP header field value ($field_name): / .$Printable->($_)."\n")unless $_ eq '' || /\A $Field_Content \z/xo;$_='' 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 (exists$request->{headers}{'content-length'}){return unless$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");if (ref$request->{trailer_cb}eq 'CODE'){$self->write_header_lines($request->{trailer_cb}->())}else {$self->write("\x0D\x0A")}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);$reason="" unless defined$reason;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 {@_==5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ ."\n");my ($self,$method,$request_uri,$headers,$header_case)=@_;return$self->write_header_lines($headers,$header_case,"$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,$peer)=@_;return 0 if $self->{pid}!=$$ || $self->{tid}!=_get_tid()|| length($self->{rbuf})|| $scheme ne $self->{scheme}|| $host ne $self->{host}|| $port ne $self->{port}|| $peer ne $self->{peer}|| eval {$self->can_read(0)}|| $@ ;return 1}sub _find_CA_file {my$self=shift();my$ca_file=defined($self->{SSL_options}->{SSL_ca_file})? $self->{SSL_options}->{SSL_ca_file}: $ENV{SSL_CERT_FILE};if (defined$ca_file){unless (-r $ca_file){die qq/SSL_ca_file '$ca_file' not found or not readable\n/}return$ca_file}local@INC=@INC;pop@INC if$INC[-1]eq '.';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;
sub $sub_name {
my (\$self, \$url, \$args) = \@_;
\@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
return \$self->request('$req_method', \$url, \$args || {});
}
HERE
HTTP_TINY
$fatpacked{"HTTP/Tinyish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH';
package HTTP::Tinyish;use strict;use warnings;use Carp ();our$VERSION='0.17';our$PreferredBackend;our@Backends=map "HTTP::Tinyish::$_",qw(LWP HTTPTiny Curl Wget);my%configured;sub new {my($class,%attr)=@_;bless \%attr,$class}for my$method (qw/get head put post delete mirror patch/){no strict 'refs';eval <<"HERE"}sub request {my$self=shift;$self->_backend_for($_[1])->request(@_)}sub _backend_for {my($self,$url)=@_;my($scheme)=$url =~ m!^(https?):!;Carp::croak "URL Scheme '$url' not supported." unless$scheme;for my$backend ($self->backends){$self->configure_backend($backend)or next;if ($backend->supports($scheme)){return$backend->new(%$self)}}Carp::croak "No backend configured for scheme $scheme"}sub backends {$PreferredBackend ? ($PreferredBackend): @Backends}sub configure_backend {my($self,$backend)=@_;unless (exists$configured{$backend}){$configured{$backend}=eval {require_module($backend);$backend->configure}}$configured{$backend}}sub require_module {local $_=shift;s!::!/!g;require "$_.pm"}1;
sub $method {
my \$self = shift;
\$self->_backend_for(\$_[0])->$method(\@_);
}
HERE
HTTP_TINYISH
$fatpacked{"HTTP/Tinyish/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_BASE';
package HTTP::Tinyish::Base;use strict;use warnings;for my$sub_name (qw/get head put post delete patch/){my$req_method=uc$sub_name;eval <<"HERE"}sub parse_http_header {my($self,$header,$res)=@_;$header =~ s/.*^(HTTP\/\d(?:\.\d)?)/$1/ms;if ($header =~ /^(.*?\x0d?\x0a\x0d?\x0a)/){$header=$1}my@header=split /\x0d?\x0a/,$header;my$status_line=shift@header;my@out;for (@header){if(/^[ \t]+/){return -1 unless@out;$out[-1].= $_}else {push@out,$_}}my($proto,$status,$reason)=split / /,$status_line,3;return unless$proto and $proto =~ /^HTTP\/(\d+)(\.(\d+))?$/i;$res->{status}=$status;$res->{reason}=$reason;$res->{success}=$status =~ /^(?:2|304)/;$res->{protocol}=$proto;my$token=qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/;my$k;for my$header (@out){if ($header =~ s/^($token): ?//){$k=lc $1}elsif ($header =~ /^\s+/){}else {return -1}if (exists$res->{headers}{$k}){$res->{headers}{$k}=[$res->{headers}{$k}]unless ref$res->{headers}{$k};push @{$res->{headers}{$k}},$header}else {$res->{headers}{$k}=$header}}}sub internal_error {my($self,$url,$message)=@_;return {content=>$message,headers=>{"content-length"=>length($message),"content-type"=>"text/plain" },reason=>"Internal Exception",status=>599,success=>"",url=>$url,}}1;
sub $sub_name {
my (\$self, \$url, \$args) = \@_;
\@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
return \$self->request('$req_method', \$url, \$args || {});
}
HERE
HTTP_TINYISH_BASE
$fatpacked{"HTTP/Tinyish/Curl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_CURL';
package HTTP::Tinyish::Curl;use strict;use warnings;use parent qw(HTTP::Tinyish::Base);use IPC::Run3 qw(run3);use File::Which qw(which);use File::Temp ();my%supports;my$curl;sub _slurp {open my$fh,"<",shift or die $!;local $/;<$fh>}sub configure {my$class=shift;my%meta;$curl=which('curl');eval {run3([$curl,'--version'],\undef,\my$version,\my$error);if ($version =~ /^Protocols: (.*)/m){my%protocols=map {$_=>1}split /\s/,$1;$supports{http}=1 if$protocols{http};$supports{https}=1 if$protocols{https}}$meta{$curl}=$version};\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;bless \%attr,$class}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my(undef,$temp)=File::Temp::tempfile(UNLINK=>1);my($output,$error);eval {run3 [$curl,'-X',$method,($method eq 'HEAD' ? ('--head'): ()),$self->build_options($url,$opts),'--dump-header',$temp,$url,],\undef,\$output,\$error};if ($@ or $?){return$self->internal_error($url,$@ || $error)}my$res={url=>$url,content=>$output };$self->parse_http_header(_slurp($temp),$res);$res}sub mirror {my($self,$url,$file,$opts)=@_;$opts ||= {};my(undef,$temp)=File::Temp::tempfile(UNLINK=>1);my($output,$error);eval {run3 [$curl,$self->build_options($url,$opts),'-z',$file,'-o',$file,'--dump-header',$temp,'--remote-time',$url,],\undef,\$output,\$error};if ($@ or $?){return$self->internal_error($url,$@ || $error)}my$res={url=>$url,content=>$output };$self->parse_http_header(_slurp($temp),$res);$res}sub build_options {my($self,$url,$opts)=@_;my@options=('--location','--silent','--show-error','--max-time',($self->{timeout}|| 60),'--max-redirs',($self->{max_redirect}|| 5),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);my%headers;if ($self->{default_headers}){%headers=%{$self->{default_headers}}}if ($opts->{headers}){%headers=(%headers,%{$opts->{headers}})}$self->_translate_headers(\%headers,\@options);unless ($self->{verify_SSL}){push@options,'--insecure'}if ($opts->{content}){my$content;if (ref$opts->{content}eq 'CODE'){while (my$chunk=$opts->{content}->()){$content .= $chunk}}else {$content=$opts->{content}}push@options,'--data',$content}@options}sub _translate_headers {my($self,$headers,$options)=@_;for my$field (keys %$headers){my$value=$headers->{$field};if (ref$value eq 'ARRAY'){push @$options,map {('-H',"$field:$_")}@$value}else {push @$options,'-H',"$field:$value"}}}1;
HTTP_TINYISH_CURL
$fatpacked{"HTTP/Tinyish/HTTPTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_HTTPTINY';
package HTTP::Tinyish::HTTPTiny;use strict;use parent qw(HTTP::Tinyish::Base);use HTTP::Tiny;my%supports=(http=>1);sub configure {my%meta=("HTTP::Tiny"=>$HTTP::Tiny::VERSION);$supports{https}=HTTP::Tiny->can_ssl;\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attrs)=@_;bless {tiny=>HTTP::Tiny->new(%attrs),},$class}sub request {my$self=shift;$self->{tiny}->request(@_)}sub mirror {my$self=shift;$self->{tiny}->mirror(@_)}1;
HTTP_TINYISH_HTTPTINY
$fatpacked{"HTTP/Tinyish/LWP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_LWP';
package HTTP::Tinyish::LWP;use strict;use parent qw(HTTP::Tinyish::Base);use LWP 5.802;use LWP::UserAgent;my%supports=(http=>1);sub configure {my%meta=(LWP=>$LWP::VERSION,);if (eval {require LWP::Protocol::https;require Mozilla::CA;1}){$supports{https}=1;$meta{"LWP::Protocol::https"}=$LWP::Protocol::https::VERSION}\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;my$ua=LWP::UserAgent->new;bless {ua=>$class->translate_lwp($ua,%attr),},$class}sub _headers_to_hashref {my($self,$hdrs)=@_;my%headers;for my$field ($hdrs->header_field_names){$headers{lc$field}=$hdrs->header($field)}\%headers}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my$req=HTTP::Request->new($method=>$url);if ($opts->{headers}){$req->header(%{$opts->{headers}})}if ($opts->{content}){$req->content($opts->{content})}my$res=$self->{ua}->request($req);if ($self->is_internal_response($res)){return$self->internal_error($url,$res->content)}return {url=>$url,content=>$res->decoded_content(charset=>'none'),success=>$res->is_success,status=>$res->code,reason=>$res->message,headers=>$self->_headers_to_hashref($res->headers),protocol=>$res->protocol,}}sub mirror {my($self,$url,$file)=@_;my$res=$self->{ua}->mirror($url,$file);if ($self->is_internal_response($res)){return$self->internal_error($url,$res->content)}return {url=>$url,content=>$res->decoded_content,success=>$res->is_success || $res->code==304,status=>$res->code,reason=>$res->message,headers=>$self->_headers_to_hashref($res->headers),protocol=>$res->protocol,}}sub translate_lwp {my($class,$agent,%attr)=@_;$agent->parse_head(0);$agent->env_proxy;$agent->timeout(delete$attr{timeout}|| 60);$agent->max_redirect(delete$attr{max_redirect}|| 5);$agent->agent(delete$attr{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION");unless ($attr{verify_SSL}){if ($agent->can("ssl_opts")){$agent->ssl_opts(verify_hostname=>0)}}if ($attr{default_headers}){$agent->default_headers(HTTP::Headers->new(%{$attr{default_headers}}))}$agent}sub is_internal_response {my($self,$res)=@_;$res->code==500 && ($res->header('Client-Warning')|| '')eq 'Internal response'}1;
HTTP_TINYISH_LWP
$fatpacked{"HTTP/Tinyish/Wget.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_WGET';
package HTTP::Tinyish::Wget;use strict;use warnings;use parent qw(HTTP::Tinyish::Base);use IPC::Run3 qw(run3);use File::Which qw(which);my%supports;my$wget;my$method_supported;sub _run_wget {run3([$wget,@_],\undef,\my$out,\my$err);wantarray ? ($out,$err): $out}sub configure {my$class=shift;my%meta;$wget=which('wget');eval {local$ENV{LC_ALL}='en_US';$meta{$wget}=_run_wget('--version');unless ($meta{$wget}=~ /GNU Wget 1\.(\d+)/ and $1 >= 12){die "Wget version is too old. $meta{$wget}"}my$config=$class->new(agent=>__PACKAGE__);my@options=grep {$_ ne '--quiet'}$config->build_options("GET");my(undef,$err)=_run_wget(@options,'https://');if ($err && $err =~ /HTTPS support not compiled/){$supports{http}=1}elsif ($err && $err =~ /Invalid host/){$supports{http}=$supports{https}=1}(undef,$err)=_run_wget('--method','GET','http://');if ($err && $err =~ /Invalid host/){$method_supported=$meta{method_supported}=1}};\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;bless \%attr,$class}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my($stdout,$stderr);eval {run3 [$wget,$self->build_options($method,$url,$opts),$url,'-O','-',],\undef,\$stdout,\$stderr};if ($@ or $? && ($? >> 8)<= 5){return$self->internal_error($url,$@ || $stderr)}my$header='';$stderr =~ s{^ (\S.*)$}{ $header .= $1."\n" }gem;my$res={url=>$url,content=>$stdout };$self->parse_http_header($header,$res);$res}sub mirror {my($self,$url,$file,$opts)=@_;$opts ||= {};my($stdout,$stderr);eval {run3 [$wget,$self->build_options("GET",$url,$opts),$url,'-O',$file],\undef,\$stdout,\$stderr};if ($@ or $?){return$self->internal_error($url,$@ || $stderr)}$stderr =~ s/^ //gm;my$res={url=>$url,content=>$stdout };$self->parse_http_header($stderr,$res);$res}sub build_options {my($self,$method,$url,$opts)=@_;my@options=('--retry-connrefused','--server-response','--timeout',($self->{timeout}|| 60),'--tries',1,'--max-redirect',($self->{max_redirect}|| 5),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);if ($method_supported){push@options,"--method",$method}else {if ($method eq 'GET' or $method eq 'POST'){}elsif ($method eq 'HEAD'){push@options,'--spider'}else {die "This version of wget doesn't support specifying HTTP method '$method'"}}if ($self->{agent}){push@options,'--user-agent',$self->{agent}}my%headers;if ($self->{default_headers}){%headers=%{$self->{default_headers}}}if ($opts->{headers}){%headers=(%headers,%{$opts->{headers}})}$self->_translate_headers(\%headers,\@options);if ($supports{https}&&!$self->{verify_SSL}){push@options,'--no-check-certificate'}if ($opts->{content}){my$content;if (ref$opts->{content}eq 'CODE'){while (my$chunk=$opts->{content}->()){$content .= $chunk}}else {$content=$opts->{content}}if ($method_supported){push@options,'--body-data',$content}else {push@options,'--post-data',$content}}@options}sub _translate_headers {my($self,$headers,$options)=@_;for my$field (keys %$headers){my$value=$headers->{$field};if (ref$value eq 'ARRAY'){push @$options,'--header',"$field:" .join(",",@$value)}else {push @$options,'--header',"$field:$value"}}}1;
HTTP_TINYISH_WGET
$fatpacked{"IPC/Cmd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_CMD';
package IPC::Cmd;use strict;BEGIN {use constant IS_VMS=>$^O eq 'VMS' ? 1 : 0;use constant IS_WIN32=>$^O eq 'MSWin32' ? 1 : 0;use constant IS_HPUX=>$^O eq 'hpux' ? 1 : 0;use constant IS_WIN98=>(IS_WIN32 and!Win32::IsWinNT())? 1 : 0;use constant ALARM_CLASS=>__PACKAGE__ .'::TimeOut';use constant SPECIAL_CHARS=>qw[< > | &];use constant QUOTE=>do {IS_WIN32 ? q["] : q[']};use Exporter ();use vars qw[@ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN $INSTANCES $ALLOW_NULL_ARGS $HAVE_MONOTONIC];$VERSION='1.04';$VERBOSE=0;$DEBUG=0;$WARN=1;$USE_IPC_RUN=IS_WIN32 &&!IS_WIN98;$USE_IPC_OPEN3=not IS_VMS;$ALLOW_NULL_ARGS=0;$CAN_USE_RUN_FORKED=0;eval {require POSIX;POSIX->import();require IPC::Open3;IPC::Open3->import();require IO::Select;IO::Select->import();require IO::Handle;IO::Handle->import();require FileHandle;FileHandle->import();require Socket;require Time::HiRes;Time::HiRes->import();require Win32 if IS_WIN32};$CAN_USE_RUN_FORKED=$@ ||!IS_VMS &&!IS_WIN32;eval {my$wait_start_time=Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC)};if ($@){$HAVE_MONOTONIC=0}else {$HAVE_MONOTONIC=1}@ISA=qw[Exporter];@EXPORT_OK=qw[can_run run run_forked QUOTE]}require Carp;use File::Spec;use Params::Check qw[check];use Text::ParseWords ();use Module::Load::Conditional qw[can_load];use Locale::Maketext::Simple Style=>'gettext';local$Module::Load::Conditional::FORCE_SAFE_INC=1;sub can_use_ipc_run {my$self=shift;my$verbose=shift || 0;return if IS_WIN98;return unless can_load(modules=>{'IPC::Run'=>'0.55' },verbose=>($WARN && $verbose),);return$IPC::Run::VERSION}sub can_use_ipc_open3 {my$self=shift;my$verbose=shift || 0;return if IS_VMS;return unless can_load(modules=>{map {$_=>'0.0'}qw|IPC::Open3 IO::Select Symbol| },verbose=>($WARN && $verbose),);return$IPC::Open3::VERSION}sub can_capture_buffer {my$self=shift;return 1 if$USE_IPC_RUN && $self->can_use_ipc_run;return 1 if$USE_IPC_OPEN3 && $self->can_use_ipc_open3;return}sub can_run {my$command=shift;if ($^O eq 'VMS'){require VMS::DCLsym;my$syms=VMS::DCLsym->new;return$command if scalar$syms->getsym(uc$command)}require File::Spec;require ExtUtils::MakeMaker;my@possibles;if(File::Spec->file_name_is_absolute($command)){return MM->maybe_command($command)}else {for my$dir (File::Spec->path,(IS_WIN32 ? File::Spec->curdir : ())){next if!$dir ||!-d $dir;my$abs=File::Spec->catfile(IS_WIN32 ? Win32::GetShortPathName($dir): $dir,$command);push@possibles,$abs if$abs=MM->maybe_command($abs)}}return@possibles if wantarray and $INSTANCES;return shift@possibles}{my@acc=qw[ok error _fds];for my$key (@acc){no strict 'refs';*{__PACKAGE__."::$key"}=sub {$_[0]->{$key}=$_[1]if @_ > 1;return $_[0]->{$key}}}}sub can_use_run_forked {return$CAN_USE_RUN_FORKED eq "1"}sub get_monotonic_time {if ($HAVE_MONOTONIC){return Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC)}else {return time()}}sub adjust_monotonic_start_time {my ($ref_vars,$now,$previous)=@_;return if$HAVE_MONOTONIC;return unless$previous;my$time_diff=$now - $previous;if ($time_diff > 5 || $time_diff < 0){for my$ref_var (@{$ref_vars}){if (defined($$ref_var)){$$ref_var=$$ref_var + $time_diff}}}}sub uninstall_signals {return unless defined($IPC::Cmd::{'__old_signals'});for my$sig_name (keys %{$IPC::Cmd::{'__old_signals'}}){$SIG{$sig_name}=$IPC::Cmd::{'__old_signals'}->{$sig_name}}}sub install_layered_signal {my ($s,$handler_code)=@_;my%available_signals=map {$_=>1}keys%SIG;Carp::confess("install_layered_signal got nonexistent signal name [$s]")unless defined($available_signals{$s});Carp::confess("install_layered_signal expects coderef")if!ref($handler_code)|| ref($handler_code)ne 'CODE';$IPC::Cmd::{'__old_signals'}={}unless defined($IPC::Cmd::{'__old_signals'});$IPC::Cmd::{'__old_signals'}->{$s}=$SIG{$s};my$previous_handler=$SIG{$s};my$sig_handler=sub {my ($called_sig_name,@sig_param)=@_;my$signal_name=$s;if ($called_sig_name eq $signal_name){$handler_code->($signal_name)}if (ref($previous_handler)){$previous_handler->($called_sig_name,@sig_param)}};$SIG{$s}=$sig_handler}sub kill_gently {my ($pid,$opts)=@_;require POSIX;$opts={}unless$opts;$opts->{'wait_time'}=2 unless defined($opts->{'wait_time'});$opts->{'first_kill_type'}='just_process' unless$opts->{'first_kill_type'};$opts->{'final_kill_type'}='just_process' unless$opts->{'final_kill_type'};if ($opts->{'first_kill_type'}eq 'just_process'){kill(15,$pid)}elsif ($opts->{'first_kill_type'}eq 'process_group'){kill(-15,$pid)}my$do_wait=1;my$child_finished=0;my$wait_start_time=get_monotonic_time();my$now;my$previous_monotonic_value;while ($do_wait){$previous_monotonic_value=$now;$now=get_monotonic_time();adjust_monotonic_start_time([\$wait_start_time],$now,$previous_monotonic_value);if ($now > $wait_start_time + $opts->{'wait_time'}){$do_wait=0;next}my$waitpid=waitpid($pid,POSIX::WNOHANG);if ($waitpid eq -1){$child_finished=1;$do_wait=0;next}Time::HiRes::usleep(250000)}if (!$child_finished){if ($opts->{'final_kill_type'}eq 'just_process'){kill(9,$pid)}elsif ($opts->{'final_kill_type'}eq 'process_group'){kill(-9,$pid)}}}sub open3_run {my ($cmd,$opts)=@_;$opts={}unless$opts;my$child_in=FileHandle->new;my$child_out=FileHandle->new;my$child_err=FileHandle->new;$child_out->autoflush(1);$child_err->autoflush(1);my$pid=open3($child_in,$child_out,$child_err,$cmd);Time::HiRes::usleep(1)if IS_HPUX;my$original_ppid=$opts->{'original_ppid'};if ($opts->{'parent_info'}){my$ps=$opts->{'parent_info'};print$ps "spawned $pid\n"}if ($child_in && $child_out->opened && $opts->{'child_stdin'}){local$SIG{'PIPE'}=sub {1};print$child_in $opts->{'child_stdin'}}close($child_in);my$child_output={'out'=>$child_out->fileno,'err'=>$child_err->fileno,$child_out->fileno=>{'parent_socket'=>$opts->{'parent_stdout'},'scalar_buffer'=>"",'child_handle'=>$child_out,'block_size'=>($child_out->stat)[11]|| 1024,},$child_err->fileno=>{'parent_socket'=>$opts->{'parent_stderr'},'scalar_buffer'=>"",'child_handle'=>$child_err,'block_size'=>($child_err->stat)[11]|| 1024,},};my$select=IO::Select->new();$select->add($child_out,$child_err);SIGNAL: foreach my$s (keys%SIG){next SIGNAL if$s eq '__WARN__' or $s eq '__DIE__';my$sig_handler;$sig_handler=sub {kill("$s",$pid);$SIG{$s}=$sig_handler};$SIG{$s}=$sig_handler}my$child_finished=0;my$real_exit;my$exit_value;while(!$child_finished){if (getppid()!=$original_ppid){kill(-9,$$);POSIX::_exit 1}my$waitpid=waitpid($pid,POSIX::WNOHANG);if ($waitpid ne 0 && $waitpid ne -1){$real_exit=$?;$exit_value=$? >> 8}if ($waitpid eq -1){$child_finished=1}my$ready_fds=[];push @{$ready_fds},$select->can_read(1/100);READY_FDS: while (scalar(@{$ready_fds})){my$fd=shift @{$ready_fds};$ready_fds=[grep {$_ ne $fd}@{$ready_fds}];my$str=$child_output->{$fd->fileno};Carp::confess("child stream not found: $fd")unless$str;my$data;my$count=$fd->sysread($data,$str->{'block_size'});if ($count){if ($str->{'parent_socket'}){my$ph=$str->{'parent_socket'};print$ph $data}else {$str->{'scalar_buffer'}.= $data}}elsif ($count eq 0){$select->remove($fd);$fd->close()}else {Carp::confess("error during sysread: " .$!)}push @{$ready_fds},$select->can_read(1/100)if$child_finished}Time::HiRes::usleep(1)}if ($opts->{'parent_info'}){my$ps=$opts->{'parent_info'};if ($real_exit & 127){print$ps "$pid killed with " .($real_exit & 127)."\n"}print$ps "reaped $pid\n"}if ($opts->{'parent_stdout'}|| $opts->{'parent_stderr'}){return$exit_value}else {return {'stdout'=>$child_output->{$child_output->{'out'}}->{'scalar_buffer'},'stderr'=>$child_output->{$child_output->{'err'}}->{'scalar_buffer'},'exit_code'=>$exit_value,}}}sub run_forked {my$self=bless {},__PACKAGE__;if (!can_use_run_forked()){Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED");return}require POSIX;my ($cmd,$opts)=@_;if (ref($cmd)eq 'ARRAY'){$cmd=join(" ",@{$cmd})}if (!$cmd){Carp::carp("run_forked expects command to run");return}$opts={}unless$opts;$opts->{'timeout'}=0 unless$opts->{'timeout'};$opts->{'terminate_wait_time'}=2 unless defined($opts->{'terminate_wait_time'});$opts->{'clean_up_children'}=1 unless defined($opts->{'clean_up_children'});my$child_stdout_socket;my$parent_stdout_socket;my$child_stderr_socket;my$parent_stderr_socket;my$child_info_socket;my$parent_info_socket;socketpair($child_stdout_socket,$parent_stdout_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("socketpair: $!");socketpair($child_stderr_socket,$parent_stderr_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("socketpair: $!");socketpair($child_info_socket,$parent_info_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("socketpair: $!");$child_stdout_socket->autoflush(1);$parent_stdout_socket->autoflush(1);$child_stderr_socket->autoflush(1);$parent_stderr_socket->autoflush(1);$child_info_socket->autoflush(1);$parent_info_socket->autoflush(1);my$start_time=get_monotonic_time();my$pid;my$ppid=$$;if ($pid=fork){close($parent_stdout_socket);close($parent_stderr_socket);close($parent_info_socket);my$flags;$flags=fcntl($child_stdout_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_stdout_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";$flags=fcntl($child_stderr_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_stderr_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";$flags=fcntl($child_info_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_info_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";my$child_output={$child_stdout_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_stdout_socket,'block_size'=>($child_stdout_socket->stat)[11]|| 1024,'protocol'=>'stdout',},$child_stderr_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_stderr_socket,'block_size'=>($child_stderr_socket->stat)[11]|| 1024,'protocol'=>'stderr',},$child_info_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_info_socket,'block_size'=>($child_info_socket->stat)[11]|| 1024,'protocol'=>'info',},};my$select=IO::Select->new();$select->add($child_stdout_socket,$child_stderr_socket,$child_info_socket);my$child_timedout=0;my$child_finished=0;my$child_stdout='';my$child_stderr='';my$child_merged='';my$child_exit_code=0;my$child_killed_by_signal=0;my$parent_died=0;my$last_parent_check=0;my$got_sig_child=0;my$got_sig_quit=0;my$orig_sig_child=$SIG{'CHLD'};$SIG{'CHLD'}=sub {$got_sig_child=get_monotonic_time()};if ($opts->{'terminate_on_signal'}){install_layered_signal($opts->{'terminate_on_signal'},sub {$got_sig_quit=time()})}my$child_child_pid;my$now;my$previous_monotonic_value;while (!$child_finished){$previous_monotonic_value=$now;$now=get_monotonic_time();adjust_monotonic_start_time([\$start_time,\$last_parent_check,\$got_sig_child],$now,$previous_monotonic_value);if ($opts->{'terminate_on_parent_sudden_death'}){if ($now > $last_parent_check + 5){if (getppid()eq "1"){kill_gently ($pid,{'first_kill_type'=>'process_group','final_kill_type'=>'process_group','wait_time'=>$opts->{'terminate_wait_time'}});$parent_died=1}$last_parent_check=$now}}if ($opts->{'timeout'}){if ($now > $start_time + $opts->{'timeout'}){kill_gently ($pid,{'first_kill_type'=>'process_group','final_kill_type'=>'process_group','wait_time'=>$opts->{'terminate_wait_time'}});$child_timedout=1}}if ($got_sig_child){if ($now > $got_sig_child + 10){print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n";kill (-9,$pid);$child_finished=1}}if ($got_sig_quit){kill_gently ($pid,{'first_kill_type'=>'process_group','final_kill_type'=>'process_group','wait_time'=>$opts->{'terminate_wait_time'}});$child_finished=1}my$waitpid=waitpid($pid,POSIX::WNOHANG);if ($waitpid ne 0 && $waitpid ne -1){$child_exit_code=$? >> 8}if ($waitpid eq -1){$child_finished=1}my$ready_fds=[];push @{$ready_fds},$select->can_read(1/100);READY_FDS: while (scalar(@{$ready_fds})){my$fd=shift @{$ready_fds};$ready_fds=[grep {$_ ne $fd}@{$ready_fds}];my$str=$child_output->{$fd->fileno};Carp::confess("child stream not found: $fd")unless$str;my$data="";my$count=$fd->sysread($data,$str->{'block_size'});if ($count){if ($data =~ /(.+\n)([^\n]*)/so){$data=$str->{'scalar_buffer'}.$1;$str->{'scalar_buffer'}=$2 || ""}else {$str->{'scalar_buffer'}.= $data;$data=""}}elsif ($count eq 0){$select->remove($fd);$fd->close();if ($str->{'scalar_buffer'}){$data=$str->{'scalar_buffer'}."\n"}}else {Carp::confess("error during sysread on [$fd]: " .$!)}if ($str->{'protocol'}eq 'info'){if ($data =~ /^spawned ([0-9]+?)\n(.*?)/so){$child_child_pid=$1;$data=$2}if ($data =~ /^reaped ([0-9]+?)\n(.*?)/so){$child_child_pid=undef;$data=$2}if ($data =~ /^[\d]+ killed with ([0-9]+?)\n(.*?)/so){$child_killed_by_signal=$1;$data=$2}if ($data){Carp::confess("info protocol violation: [$data]")}}if ($str->{'protocol'}eq 'stdout'){if (!$opts->{'discard_output'}){$child_stdout .= $data;$child_merged .= $data}if ($opts->{'stdout_handler'}&& ref($opts->{'stdout_handler'})eq 'CODE'){$opts->{'stdout_handler'}->($data)}}if ($str->{'protocol'}eq 'stderr'){if (!$opts->{'discard_output'}){$child_stderr .= $data;$child_merged .= $data}if ($opts->{'stderr_handler'}&& ref($opts->{'stderr_handler'})eq 'CODE'){$opts->{'stderr_handler'}->($data)}}push @{$ready_fds},$select->can_read(1/100)if$child_finished}if ($opts->{'wait_loop_callback'}&& ref($opts->{'wait_loop_callback'})eq 'CODE'){$opts->{'wait_loop_callback'}->()}Time::HiRes::usleep(1)}if ($child_child_pid){kill_gently($child_child_pid)}if ($opts->{'clean_up_children'}){kill(-9,$pid)}close($child_stdout_socket);close($child_stderr_socket);close($child_info_socket);my$o={'stdout'=>$child_stdout,'stderr'=>$child_stderr,'merged'=>$child_merged,'timeout'=>$child_timedout ? $opts->{'timeout'}: 0,'exit_code'=>$child_exit_code,'parent_died'=>$parent_died,'killed_by_signal'=>$child_killed_by_signal,'child_pgid'=>$pid,'cmd'=>$cmd,};my$err_msg='';if ($o->{'exit_code'}){$err_msg .= "exited with code [$o->{'exit_code'}]\n"}if ($o->{'timeout'}){$err_msg .= "ran more than [$o->{'timeout'}] seconds\n"}if ($o->{'parent_died'}){$err_msg .= "parent died\n"}if ($o->{'stdout'}&&!$opts->{'non_empty_stdout_ok'}){$err_msg .= "stdout:\n" .$o->{'stdout'}."\n"}if ($o->{'stderr'}){$err_msg .= "stderr:\n" .$o->{'stderr'}."\n"}if ($o->{'killed_by_signal'}){$err_msg .= "killed by signal [" .$o->{'killed_by_signal'}."]\n"}$o->{'err_msg'}=$err_msg;if ($orig_sig_child){$SIG{'CHLD'}=$orig_sig_child}else {delete($SIG{'CHLD'})}uninstall_signals();return$o}else {Carp::confess("cannot fork: $!")unless defined($pid);POSIX::setsid()==-1 and Carp::confess("Error running setsid: " .$!);if ($opts->{'child_BEGIN'}&& ref($opts->{'child_BEGIN'})eq 'CODE'){$opts->{'child_BEGIN'}->()}close($child_stdout_socket);close($child_stderr_socket);close($child_info_socket);my$child_exit_code;if (!ref($cmd)){$child_exit_code=open3_run($cmd,{'parent_info'=>$parent_info_socket,'parent_stdout'=>$parent_stdout_socket,'parent_stderr'=>$parent_stderr_socket,'child_stdin'=>$opts->{'child_stdin'},'original_ppid'=>$ppid,})}elsif (ref($cmd)eq 'CODE'){open STDOUT,'>&',$parent_stdout_socket || Carp::confess("Unable to reopen STDOUT: $!\n");open STDERR,'>&',$parent_stderr_socket || Carp::confess("Unable to reopen STDERR: $!\n");$child_exit_code=$cmd->({'opts'=>$opts,'parent_info'=>$parent_info_socket,'parent_stdout'=>$parent_stdout_socket,'parent_stderr'=>$parent_stderr_socket,'child_stdin'=>$opts->{'child_stdin'},})}else {print$parent_stderr_socket "Invalid command reference: " .ref($cmd)."\n";$child_exit_code=1}close($parent_stdout_socket);close($parent_stderr_socket);close($parent_info_socket);if ($opts->{'child_END'}&& ref($opts->{'child_END'})eq 'CODE'){$opts->{'child_END'}->()}$|=1;POSIX::_exit$child_exit_code}}sub run {my$self=bless {},__PACKAGE__;my%hash=@_;my$def_buf='';my($verbose,$cmd,$buffer,$timeout);my$tmpl={verbose=>{default=>$VERBOSE,store=>\$verbose },buffer=>{default=>\$def_buf,store=>\$buffer },command=>{required=>1,store=>\$cmd,allow=>sub {!ref($_[0])or ref($_[0])eq 'ARRAY'},},timeout=>{default=>0,store=>\$timeout },};unless(check($tmpl,\%hash,$VERBOSE)){Carp::carp(loc("Could not validate input: %1",Params::Check->last_error));return};$cmd=_quote_args_vms($cmd)if IS_VMS;if ($ALLOW_NULL_ARGS){$cmd=[grep {defined}@$cmd ]if ref$cmd}else {$cmd=[grep {defined && length}@$cmd ]if ref$cmd}my$pp_cmd=(ref$cmd ? "@$cmd" : $cmd);print loc("Running [%1]...\n",$pp_cmd)if$verbose;my(@buffer,@buff_err,@buff_out);my$_out_handler=sub {my$buf=shift;return unless defined$buf;print STDOUT$buf if$verbose;push@buffer,$buf;push@buff_out,$buf};my$_err_handler=sub {my$buf=shift;return unless defined$buf;print STDERR$buf if$verbose;push@buffer,$buf;push@buff_err,$buf};my$have_buffer=$self->can_capture_buffer ? 1 : 0;my$ok;local $?;local $@;local $!;eval {local$SIG{ALRM}=sub {die bless sub {ALARM_CLASS .qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds]},ALARM_CLASS}if$timeout;alarm$timeout || 0;if(!IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run(1)){$self->_debug("# Using IPC::Run. Have buffer: $have_buffer")if$DEBUG;$ok=$self->_ipc_run($cmd,$_out_handler,$_err_handler)}elsif ($USE_IPC_OPEN3 and $self->can_use_ipc_open3(1)){$self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")if$DEBUG;my$method=IS_WIN32 ? '_open3_run_win32' : '_open3_run';$ok=$self->$method($cmd,$_out_handler,$_err_handler,$verbose)}else {$self->_debug("# Using system(). Have buffer: $have_buffer")if$DEBUG;$ok=$self->_system_run($cmd,$verbose)}alarm 0};$self->__reopen_fds(@{$self->_fds})if$self->_fds;my$err;unless($ok){if ($@ and ref $@ and $@->isa(ALARM_CLASS)){$err=$@->()}else {$err=$self->error}}$$buffer=join '',@buffer if@buffer;return wantarray ? $have_buffer ? ($ok,$err,\@buffer,\@buff_out,\@buff_err): ($ok,$err): $ok}sub _open3_run_win32 {my$self=shift;my$cmd=shift;my$outhand=shift;my$errhand=shift;require Socket;my$pipe=sub {socketpair($_[0],$_[1],&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)or return undef;shutdown($_[0],1);shutdown($_[1],0);return 1};my$open3=sub {local (*TO_CHLD_R,*TO_CHLD_W);local (*FR_CHLD_R,*FR_CHLD_W);local (*FR_CHLD_ERR_R,*FR_CHLD_ERR_W);$pipe->(*TO_CHLD_R,*TO_CHLD_W)or die $^E;$pipe->(*FR_CHLD_R,*FR_CHLD_W)or die $^E;$pipe->(*FR_CHLD_ERR_R,*FR_CHLD_ERR_W)or die $^E;my$pid=IPC::Open3::open3('>&TO_CHLD_R','<&FR_CHLD_W','<&FR_CHLD_ERR_W',@_);return ($pid,*TO_CHLD_W,*FR_CHLD_R,*FR_CHLD_ERR_R)};$cmd=[grep {defined && length}@$cmd ]if ref$cmd;$cmd=$self->__fix_cmd_whitespace_and_special_chars($cmd);my ($pid,$to_chld,$fr_chld,$fr_chld_err)=$open3->((ref$cmd ? @$cmd : $cmd));my$in_sel=IO::Select->new();my$out_sel=IO::Select->new();my%objs;$objs{fileno($fr_chld)}=$outhand;$objs{fileno($fr_chld_err)}=$errhand;$in_sel->add($fr_chld);$in_sel->add($fr_chld_err);close($to_chld);while ($in_sel->count()+ $out_sel->count()){my ($ins,$outs)=IO::Select::select($in_sel,$out_sel,undef);for my$fh (@$ins){my$obj=$objs{fileno($fh)};my$buf;my$bytes_read=sysread($fh,$buf,64*1024);if (!$bytes_read){$in_sel->remove($fh)}else {$obj->("$buf")}}for my$fh (@$outs){}}waitpid($pid,0);if($?){$self->error($self->_pp_child_error($cmd,$?));$self->ok(0);return}else {return$self->ok(1)}}sub _open3_run {my$self=shift;my$cmd=shift;my$_out_handler=shift;my$_err_handler=shift;my$verbose=shift || 0;use Symbol;my$kidout=Symbol::gensym();my$kiderror=Symbol::gensym();my@fds_to_dup=(IS_WIN32 &&!$verbose ? qw[STDIN STDOUT STDERR] : qw[STDIN]);$self->_fds(\@fds_to_dup);$self->__dup_fds(@fds_to_dup);$cmd=$self->__fix_cmd_whitespace_and_special_chars($cmd);my$pid=eval {IPC::Open3::open3('<&STDIN',(IS_WIN32 ? '>&STDOUT' : $kidout),(IS_WIN32 ? '>&STDERR' : $kiderror),(ref$cmd ? @$cmd : $cmd),)};if($@ and $@ =~ /^open3:/){$self->ok(0);$self->error($@);return};my$selector=IO::Select->new((IS_WIN32 ? \*STDERR : $kiderror),\*STDIN,(IS_WIN32 ? \*STDOUT : $kidout));STDOUT->autoflush(1);STDERR->autoflush(1);STDIN->autoflush(1);$kidout->autoflush(1)if UNIVERSAL::can($kidout,'autoflush');$kiderror->autoflush(1)if UNIVERSAL::can($kiderror,'autoflush');my$stdout_done=0;my$stderr_done=0;OUTER: while (my@ready=$selector->can_read){for my$h (@ready){my$buf;my$len=sysread($h,$buf,4096);if(not defined$len){warn(loc("Error reading from process: %1",$!));last OUTER}$_out_handler->("$buf")if$len && $h==$kidout;$_err_handler->("$buf")if$len && $h==$kiderror;$stdout_done=1 if$h==$kidout and $len==0;$stderr_done=1 if$h==$kiderror and $len==0;last OUTER if ($stdout_done && $stderr_done)}}waitpid$pid,0;if($?){$self->error($self->_pp_child_error($cmd,$?));$self->ok(0);return}else {return$self->ok(1)}}{my$parse_sub=IS_WIN32 ? __PACKAGE__->can('_split_like_shell_win32'): Text::ParseWords->can('shellwords');sub _ipc_run {my$self=shift;my$cmd=shift;my$_out_handler=shift;my$_err_handler=shift;STDOUT->autoflush(1);STDERR->autoflush(1);my@command;my$special_chars;my$re=do {my$x=join '',SPECIAL_CHARS;qr/([$x])/};if(ref$cmd){my$aref=[];for my$item (@$cmd){if($item =~ $re){push@command,$aref,$item;$aref=[];$special_chars .= $1}else {push @$aref,$item}}push@command,$aref}else {@command=map {if($_ =~ $re){$special_chars .= $1;$_}else {[map {m/[ ]/ ? qq{'$_'} : $_}$parse_sub->($_)]}}split(/\s*$re\s*/,$cmd)}my$ok=eval {IPC::Run::run(@command,fileno(STDOUT).'>',$_out_handler,fileno(STDERR).'>',$_err_handler)};if($ok){return$self->ok($ok)}else {$self->ok(0);if($@ and not UNIVERSAL::isa($@,ALARM_CLASS)){$self->error($@)}elsif($@){die $@}else {$self->error($self->_pp_child_error($cmd,$?))}return}}}sub _system_run {my$self=shift;my$cmd=shift;my$verbose=shift || 0;$cmd=$self->__fix_cmd_whitespace_and_special_chars($cmd);my@fds_to_dup=$verbose ? (): qw[STDOUT STDERR];$self->_fds(\@fds_to_dup);$self->__dup_fds(@fds_to_dup);$self->ok(1);system(ref$cmd ? @$cmd : $cmd)==0 or do {$self->error($self->_pp_child_error($cmd,$?));$self->ok(0)};return unless$self->ok;return$self->ok}{my%sc_lookup=map {$_=>$_}SPECIAL_CHARS;sub __fix_cmd_whitespace_and_special_chars {my$self=shift;my$cmd=shift;if(ref$cmd and grep {$sc_lookup{$_}}@$cmd){my$fixed;my@cmd=map {/ / ? do {$fixed++;QUOTE.$_.QUOTE}: $_}@$cmd;$self->_debug("# Quoted $fixed arguments containing whitespace")if$DEBUG && $fixed;$cmd=join ' ',@cmd}return$cmd}}sub _quote_args_vms {my@args=@_;my$got_arrayref=(scalar(@args)==1 && UNIVERSAL::isa($args[0],'ARRAY'))? 1 : 0;@args=split(/\s+/,$args[0])unless$got_arrayref || scalar(@args)> 1;my$cmd=$got_arrayref ? shift @{$args[0]}: shift@args;map {if (/^[^\/\"]/){$_ =~ s/\"/""/g;$_=q(").$_.q(")}}($got_arrayref ? @{$args[0]}: @args);$got_arrayref ? unshift(@{$args[0]},$cmd): unshift(@args,$cmd);return$got_arrayref ? $args[0]: join(' ',@args)}sub _split_like_shell_win32 {local $_=shift;my@argv;return@argv unless defined()&& length();my$arg='';my($i,$quote_mode)=(0,0);while ($i < length()){my$ch=substr($_,$i,1);my$next_ch=substr($_,$i+1,1);if ($ch eq '\\' && $next_ch eq '"'){$arg .= '"';$i++}elsif ($ch eq '\\' && $next_ch eq '\\'){$arg .= '\\';$i++}elsif ($ch eq '"' && $next_ch eq '"' && $quote_mode){$quote_mode=!$quote_mode;$arg .= '"';$i++}elsif ($ch eq '"' && $next_ch eq '"' &&!$quote_mode && ($i + 2==length()|| substr($_,$i + 2,1)eq ' ')){push(@argv,$arg);$arg='';$i += 2}elsif ($ch eq '"'){$quote_mode=!$quote_mode}elsif ($ch eq ' ' &&!$quote_mode){push(@argv,$arg)if defined($arg)&& length($arg);$arg='';++$i while substr($_,$i + 1,1)eq ' '}else {$arg .= $ch}$i++}push(@argv,$arg)if defined($arg)&& length($arg);return@argv}{use File::Spec;use Symbol;my%Map=(STDOUT=>[qw|>&|,\*STDOUT,Symbol::gensym()],STDERR=>[qw|>&|,\*STDERR,Symbol::gensym()],STDIN=>[qw|<&|,\*STDIN,Symbol::gensym()],);sub __dup_fds {my$self=shift;my@fds=@_;__PACKAGE__->_debug("# Closing the following fds: @fds")if$DEBUG;for my$name (@fds){my($redir,$fh,$glob)=@{$Map{$name}}or (Carp::carp(loc("No such FD: '%1'",$name)),next);open$glob,$redir .fileno($fh)or (Carp::carp(loc("Could not dup '$name': %1",$!)),return);if($redir eq '>&'){open($fh,'>' .File::Spec->devnull)or (Carp::carp(loc("Could not reopen '$name': %1",$!)),return)}}return 1}sub __reopen_fds {my$self=shift;my@fds=@_;__PACKAGE__->_debug("# Reopening the following fds: @fds")if$DEBUG;for my$name (@fds){my($redir,$fh,$glob)=@{$Map{$name}}or (Carp::carp(loc("No such FD: '%1'",$name)),next);open($fh,$redir .fileno($glob))or (Carp::carp(loc("Could not restore '$name': %1",$!)),return);close$glob}return 1}}sub _debug {my$self=shift;my$msg=shift or return;my$level=shift || 0;local$Carp::CarpLevel += $level;Carp::carp($msg);return 1}sub _pp_child_error {my$self=shift;my$cmd=shift or return;my$ce=shift or return;my$pp_cmd=ref$cmd ? "@$cmd" : $cmd;my$str;if($ce==-1){$str="Failed to execute '$pp_cmd': $!"}elsif ($ce & 127){$str=loc("'%1' died with signal %2, %3 coredump",$pp_cmd,($ce & 127),($ce & 128)? 'with' : 'without')}else {$str="'$pp_cmd' exited with value " .($ce >> 8)}$self->_debug("# Child error '$ce' translated to: $str")if$DEBUG;return$str}1;
IPC_CMD
$fatpacked{"IPC/Run3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3';
package IPC::Run3;BEGIN {require 5.006_000}use strict;our$VERSION='0.048';use Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(run3);our%EXPORT_TAGS=(all=>\@EXPORT);use constant debugging=>$ENV{IPCRUN3DEBUG}|| $ENV{IPCRUNDEBUG}|| 0;use constant profiling=>$ENV{IPCRUN3PROFILE}|| $ENV{IPCRUNPROFILE}|| 0;use constant is_win32=>0 <= index $^O,"Win32";BEGIN {if (is_win32){eval "use Win32 qw( GetOSName ); use Win32::ShellQuote qw(quote_native); 1" or die $@}}use Carp qw(croak);use File::Temp qw(tempfile);use POSIX qw(dup dup2);my%fh_cache;my$fh_cache_pid=$$;my$profiler;sub _profiler {$profiler}BEGIN {if (profiling){eval "use Time::HiRes qw( gettimeofday ); 1" or die $@;if ($ENV{IPCRUN3PROFILE}=~ /\A\d+\z/){require IPC::Run3::ProfPP;IPC::Run3::ProfPP->import;$profiler=IPC::Run3::ProfPP->new(Level=>$ENV{IPCRUN3PROFILE})}else {my ($dest,undef,$class)=reverse split /(=)/,$ENV{IPCRUN3PROFILE},2;$class="IPC::Run3::ProfLogger" unless defined$class && length$class;if (not eval "require $class"){my$e=$@;$class="IPC::Run3::$class";eval "require IPC::Run3::$class" or die$e}$profiler=$class->new(Destination=>$dest)}$profiler->app_call([$0,@ARGV ],scalar gettimeofday())}}END {$profiler->app_exit(scalar gettimeofday())if profiling}sub _binmode {my ($fh,$mode,$what)=@_;my$layer=!$mode ? (is_win32 ? ":crlf" : ":raw"): ($mode =~ /^:/ ? $mode : ":raw");warn "binmode $what, $layer\n" if debugging >= 2;binmode$fh,":raw" unless$layer eq ":raw";binmode$fh,$layer or croak "binmode $layer failed: $!"}sub _spool_data_to_child {my ($type,$source,$binmode_it)=@_;return undef unless defined$source;my$fh;if (!$type){open$fh,"<",$source or croak "$!: $source";_binmode($fh,$binmode_it,"STDIN");warn "run3(): feeding file '$source' to child STDIN\n" if debugging >= 2}elsif ($type eq "FH"){$fh=$source;warn "run3(): feeding filehandle '$source' to child STDIN\n" if debugging >= 2}else {$fh=$fh_cache{in}||= tempfile;truncate$fh,0;seek$fh,0,0;_binmode($fh,$binmode_it,"STDIN");my$seekit;if ($type eq "SCALAR"){return$fh unless defined $$source;warn "run3(): feeding SCALAR to child STDIN",debugging >= 3 ? (": '",$$source,"' (",length $$source," chars)"): (),"\n" if debugging >= 2;$seekit=length $$source;print$fh $$source or die "$! writing to temp file"}elsif ($type eq "ARRAY"){warn "run3(): feeding ARRAY to child STDIN",debugging >= 3 ? (": '",@$source,"'"): (),"\n" if debugging >= 2;print$fh @$source or die "$! writing to temp file";$seekit=grep length,@$source}elsif ($type eq "CODE"){warn "run3(): feeding output of CODE ref '$source' to child STDIN\n" if debugging >= 2;my$parms=[];while (1){my$data=$source->(@$parms);last unless defined$data;print$fh $data or die "$! writing to temp file";$seekit=length$data}}seek$fh,0,0 or croak "$! seeking on temp file for child's stdin" if$seekit}croak "run3() can't redirect $type to child stdin" unless defined$fh;return$fh}sub _fh_for_child_output {my ($what,$type,$dest,$options)=@_;my$fh;if ($type eq "SCALAR" && $dest==\undef){warn "run3(): redirecting child $what to oblivion\n" if debugging >= 2;$fh=$fh_cache{nul}||= do {open$fh,">",File::Spec->devnull;$fh}}elsif ($type eq "FH"){$fh=$dest;warn "run3(): redirecting $what to filehandle '$dest'\n" if debugging >= 3}elsif (!$type){warn "run3(): feeding child $what to file '$dest'\n" if debugging >= 2;open$fh,$options->{"append_$what"}? ">>" : ">",$dest or croak "$!: $dest"}else {warn "run3(): capturing child $what\n" if debugging >= 2;$fh=$fh_cache{$what}||= tempfile;seek$fh,0,0;truncate$fh,0}my$binmode_it=$options->{"binmode_$what"};_binmode($fh,$binmode_it,uc$what);return$fh}sub _read_child_output_fh {my ($what,$type,$dest,$fh,$options)=@_;return if$type eq "SCALAR" && $dest==\undef;seek$fh,0,0 or croak "$! seeking on temp file for child $what";if ($type eq "SCALAR"){warn "run3(): reading child $what to SCALAR\n" if debugging >= 3;my$count=read$fh,$$dest,10_000,$options->{"append_$what"}? length $$dest : 0;while (1){croak "$! reading child $what from temp file" unless defined$count;last unless$count;warn "run3(): read $count bytes from child $what",debugging >= 3 ? (": '",substr($$dest,-$count),"'"): (),"\n" if debugging >= 2;$count=read$fh,$$dest,10_000,length $$dest}}elsif ($type eq "ARRAY"){if ($options->{"append_$what"}){push @$dest,<$fh>}else {@$dest=<$fh>}if (debugging >= 2){my$count=0;$count += length for @$dest;warn "run3(): read ",scalar @$dest," records, $count bytes from child $what",debugging >= 3 ? (": '",@$dest,"'"): (),"\n"}}elsif ($type eq "CODE"){warn "run3(): capturing child $what to CODE ref\n" if debugging >= 3;local $_;while (<$fh>){warn "run3(): read ",length," bytes from child $what",debugging >= 3 ? (": '",$_,"'"): (),"\n" if debugging >= 2;$dest->($_)}}else {croak "run3() can't redirect child $what to a $type"}}sub _type {my ($redir)=@_;return "FH" if eval {local$SIG{'__DIE__'};$redir->isa("IO::Handle")};my$type=ref$redir;return$type eq "GLOB" ? "FH" : $type}sub _max_fd {my$fd=dup(0);POSIX::close$fd;return$fd}my$run_call_time;my$sys_call_time;my$sys_exit_time;sub run3 {$run_call_time=gettimeofday()if profiling;my$options=@_ && ref $_[-1]eq "HASH" ? pop : {};my ($cmd,$stdin,$stdout,$stderr)=@_;print STDERR "run3(): running ",join(" ",map "'$_'",ref$cmd ? @$cmd : $cmd),"\n" if debugging;if (ref$cmd){croak "run3(): empty command" unless @$cmd;croak "run3(): undefined command" unless defined$cmd->[0];croak "run3(): command name ('')" unless length$cmd->[0]}else {croak "run3(): missing command" unless @_;croak "run3(): undefined command" unless defined$cmd;croak "run3(): command ('')" unless length$cmd}for (qw/binmode_stdin binmode_stdout binmode_stderr/){if (my$mode=$options->{$_}){croak qq[option $_ must be a number or a proper layer string: "$mode"] unless$mode =~ /^(:|\d+$)/}}my$in_type=_type$stdin;my$out_type=_type$stdout;my$err_type=_type$stderr;if ($fh_cache_pid!=$$){close $_ foreach values%fh_cache;%fh_cache=();$fh_cache_pid=$$}my$in_fh=_spool_data_to_child$in_type,$stdin,$options->{binmode_stdin}if defined$stdin;my$out_fh=_fh_for_child_output "stdout",$out_type,$stdout,$options if defined$stdout;my$tie_err_to_out=defined$stderr && defined$stdout && $stderr eq $stdout;my$err_fh=$tie_err_to_out ? $out_fh : _fh_for_child_output "stderr",$err_type,$stderr,$options if defined$stderr;local*STDOUT_SAVE;local*STDERR_SAVE;my$saved_fd0=dup(0)if defined$in_fh;open STDOUT_SAVE,">&STDOUT" or croak "run3(): $! saving STDOUT" if defined$out_fh;open STDERR_SAVE,">&STDERR" or croak "run3(): $! saving STDERR" if defined$err_fh;my$errno;my$ok=eval {dup2(fileno$in_fh,0)or croak "run3(): $! redirecting STDIN" if defined$in_fh;open STDOUT,">&" .fileno$out_fh or croak "run3(): $! redirecting STDOUT" if defined$out_fh;open STDERR,">&" .fileno$err_fh or croak "run3(): $! redirecting STDERR" if defined$err_fh;$sys_call_time=gettimeofday()if profiling;my$r=ref$cmd ? system {$cmd->[0]}is_win32 ? quote_native(@$cmd): @$cmd : system$cmd;$errno=$!;$sys_exit_time=gettimeofday()if profiling;if (debugging){my$err_fh=defined$err_fh ? \*STDERR_SAVE : \*STDERR;if (defined$r && $r!=-1){print$err_fh "run3(): \$? is $?\n"}else {print$err_fh "run3(): \$? is $?, \$! is $errno\n"}}if (defined$r && ($r==-1 || (is_win32 && $r==0xFF00))&&!$options->{return_if_system_error}){croak($errno)}1};my$x=$@;my@errs;if (defined$saved_fd0){dup2($saved_fd0,0);POSIX::close($saved_fd0)}open STDOUT,">&STDOUT_SAVE" or push@errs,"run3(): $! restoring STDOUT" if defined$out_fh;open STDERR,">&STDERR_SAVE" or push@errs,"run3(): $! restoring STDERR" if defined$err_fh;croak join ", ",@errs if@errs;die$x unless$ok;_read_child_output_fh "stdout",$out_type,$stdout,$out_fh,$options if defined$out_fh && $out_type && $out_type ne "FH";_read_child_output_fh "stderr",$err_type,$stderr,$err_fh,$options if defined$err_fh && $err_type && $err_type ne "FH" &&!$tie_err_to_out;$profiler->run_exit($cmd,$run_call_time,$sys_call_time,$sys_exit_time,scalar gettimeofday())if profiling;$!=$errno;return 1}1;
IPC_RUN3
$fatpacked{"IPC/Run3/ProfArrayBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFARRAYBUFFER';
package IPC::Run3::ProfArrayBuffer;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Events}=[];return$self}for my$subname (qw(app_call app_exit run_exit)){no strict 'refs';*{$subname}=sub {push @{shift->{Events}},[$subname=>@_ ]}}sub get_events {my$self=shift;@{$self->{Events}}}1;
IPC_RUN3_PROFARRAYBUFFER
$fatpacked{"IPC/Run3/ProfLogReader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGREADER';
package IPC::Run3::ProfLogReader;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Source}="run3.out" unless defined$self->{Source}&& length$self->{Source};my$source=$self->{Source};if (ref$source eq "GLOB" || UNIVERSAL::isa($source,"IO::Handle")){$self->{FH}=$source}elsif ($source eq "-"){$self->{FH}=\*STDIN}else {open PROFILE,"<$self->{Source}" or die "$!: $self->{Source}\n";$self->{FH}=*PROFILE{IO}}return$self}sub set_handler {$_[0]->{Handler}=$_[1]}sub get_handler {$_[0]->{Handler}}sub read {my$self=shift;my$fh=$self->{FH};my@ln=split / /,<$fh>;return 0 unless@ln;return 1 unless$self->{Handler};chomp$ln[-1];return 1 if@ln==1 &&!length$ln[0]|| 0==index$ln[0],"#";if ($ln[0]eq "\\app_call"){shift@ln;my@times=split /,/,pop@ln;$self->{Handler}->app_call([map {s/\\\\/\\/g;s/\\_/ /g;$_}@ln ],@times)}elsif ($ln[0]eq "\\app_exit"){shift@ln;$self->{Handler}->app_exit(pop@ln,@ln)}else {my@times=split /,/,pop@ln;$self->{Handler}->run_exit([map {s/\\\\/\\/g;s/\\_/ /g;$_}@ln ],@times)}return 1}sub read_all {my$self=shift;1 while$self->read;return 1}1;
IPC_RUN3_PROFLOGREADER
$fatpacked{"IPC/Run3/ProfLogger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGGER';
package IPC::Run3::ProfLogger;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Destination}="run3.out" unless defined$self->{Destination}&& length$self->{Destination};open PROFILE,">$self->{Destination}" or die "$!: $self->{Destination}\n";binmode PROFILE;$self->{FH}=*PROFILE{IO};$self->{times}=[];return$self}sub run_exit {my$self=shift;my$fh=$self->{FH};print($fh join(" ",(map {my$s=$_;$s =~ s/\\/\\\\/g;$s =~ s/ /_/g;$s}@{shift()}),join(",",@{$self->{times}},@_,),),"\n")}sub app_exit {my$self=shift;my$fh=$self->{FH};print$fh "\\app_exit ",shift,"\n"}sub app_call {my$self=shift;my$fh=$self->{FH};my$t=shift;print($fh join(" ","\\app_call",(map {my$s=$_;$s =~ s/\\\\/\\/g;$s =~ s/ /\\_/g;$s}@_),$t,),"\n")}1;
IPC_RUN3_PROFLOGGER
$fatpacked{"IPC/Run3/ProfPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFPP';
package IPC::Run3::ProfPP;$VERSION=0.048;require IPC::Run3::ProfReporter;@ISA=qw(IPC::Run3::ProfReporter);use strict;use POSIX qw(floor);sub _emit {shift;warn @_}sub _t {sprintf "%10.6f secs",@_}sub _r {my ($num,$denom)=@_;return ()unless$denom;sprintf "%10.6f",$num / $denom}sub _pct {my ($num,$denom)=@_;return ()unless$denom;sprintf " (%3d%%)",floor(100 * $num / $denom + 0.5)}sub handle_app_call {my$self=shift;$self->_emit("IPC::Run3 parent: ",join(" ",@{$self->get_app_cmd}),"\n",);$self->{NeedNL}=1}sub handle_app_exit {my$self=shift;$self->_emit("\n")if$self->{NeedNL}&& $self->{NeedNL}!=1;$self->_emit("IPC::Run3 total elapsed: ",_t($self->get_app_cumulative_time),"\n");$self->_emit("IPC::Run3 calls to run3(): ",sprintf("%10d",$self->get_run_count),"\n");$self->_emit("IPC::Run3 total spent in run3(): ",_t($self->get_run_cumulative_time),_pct($self->get_run_cumulative_time,$self->get_app_cumulative_time),", ",_r($self->get_run_cumulative_time,$self->get_run_count)," per call","\n");my$exclusive=$self->get_app_cumulative_time - $self->get_run_cumulative_time;$self->_emit("IPC::Run3 total spent not in run3(): ",_t($exclusive),_pct($exclusive,$self->get_app_cumulative_time),"\n");$self->_emit("IPC::Run3 total spent in children: ",_t($self->get_sys_cumulative_time),_pct($self->get_sys_cumulative_time,$self->get_app_cumulative_time),", ",_r($self->get_sys_cumulative_time,$self->get_run_count)," per call","\n");my$overhead=$self->get_run_cumulative_time - $self->get_sys_cumulative_time;$self->_emit("IPC::Run3 total overhead: ",_t($overhead),_pct($overhead,$self->get_sys_cumulative_time),", ",_r($overhead,$self->get_run_count)," per call","\n")}sub handle_run_exit {my$self=shift;my$overhead=$self->get_run_time - $self->get_sys_time;$self->_emit("\n")if$self->{NeedNL}&& $self->{NeedNL}!=2;$self->{NeedNL}=3;$self->_emit("IPC::Run3 child: ",join(" ",@{$self->get_run_cmd}),"\n");$self->_emit("IPC::Run3 run3() : ",_t($self->get_run_time),"\n","IPC::Run3 child : ",_t($self->get_sys_time),"\n","IPC::Run3 overhead: ",_t($overhead),_pct($overhead,$self->get_sys_time),"\n")}1;
IPC_RUN3_PROFPP
$fatpacked{"IPC/Run3/ProfReporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFREPORTER';
package IPC::Run3::ProfReporter;$VERSION=0.048;use strict;my$loaded_by;sub import {$loaded_by=shift}END {my@caller;for (my$i=0;;++$i ){my@c=caller$i;last unless@c;@caller=@c}if ($caller[0]eq "main" && $caller[1]eq "-e"){require IPC::Run3::ProfLogReader;require Getopt::Long;my ($app,$run);Getopt::Long::GetOptions("app"=>\$app,"run"=>\$run,);$app=1,$run=1 unless$app || $run;for (@ARGV ? @ARGV : ""){my$r=IPC::Run3::ProfLogReader->new(Source=>$_,Handler=>$loaded_by->new(Source=>$_,app_report=>$app,run_report=>$run,),);$r->read_all}}}sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{app_report}=1,$self->{run_report}=1 unless$self->{app_report}|| $self->{run_report};return$self}sub handle_app_call {}sub handle_app_exit {}sub handle_run_exit {}sub app_call {my$self=shift;($self->{app_cmd},$self->{app_call_time})=@_;$self->handle_app_call if$self->{app_report}}sub app_exit {my$self=shift;$self->{app_exit_time}=shift;$self->handle_app_exit if$self->{app_report}}sub run_exit {my$self=shift;@{$self}{qw(run_cmd run_call_time sys_call_time sys_exit_time run_exit_time)}=@_;++$self->{run_count};$self->{run_cumulative_time}+= $self->get_run_time;$self->{sys_cumulative_time}+= $self->get_sys_time;$self->handle_run_exit if$self->{run_report}}sub get_run_count {shift->{run_count}}sub get_app_call_time {shift->{app_call_time}}sub get_app_exit_time {shift->{app_exit_time}}sub get_app_cmd {shift->{app_cmd}}sub get_app_time {my$self=shift;$self->get_app_exit_time - $self->get_app_call_time}sub get_app_cumulative_time {my$self=shift;$self->get_app_exit_time - $self->get_app_call_time}sub get_run_call_time {shift->{run_call_time}}sub get_run_exit_time {shift->{run_exit_time}}sub get_run_time {my$self=shift;$self->get_run_exit_time - $self->get_run_call_time}sub get_run_cumulative_time {shift->{run_cumulative_time}}sub get_sys_call_time {shift->{sys_call_time}}sub get_sys_exit_time {shift->{sys_exit_time}}sub get_sys_time {my$self=shift;$self->get_sys_exit_time - $self->get_sys_call_time}sub get_sys_cumulative_time {shift->{sys_cumulative_time}}sub get_run_cmd {shift->{run_cmd}}1;
IPC_RUN3_PROFREPORTER
$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
package JSON::PP;use 5.005;use strict;use Exporter ();BEGIN {@JSON::PP::ISA=('Exporter')}use overload ();use JSON::PP::Boolean;use Carp ();$JSON::PP::VERSION='4.07';@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 P_ALLOW_TAGS=>19;use constant OLD_PERL=>$] < 5.008 ? 1 : 0;use constant USE_B=>$ENV{PERL_JSON_PP_USE_B}|| 0;BEGIN {if (USE_B){require B}}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 allow_tags);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);if (OLD_PERL){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$property_id='P_' .uc($name);eval qq/
sub $name {
my \$enable = defined \$_[1] ? \$_[1] : 1;
if (\$enable) {
\$_[0]->{PROPS}->[$property_id] = 1;
}
else {
\$_[0]->{PROPS}->[$property_id] = 0;
}
\$_[0];
}
sub get_$name {
\$_[0]->{PROPS}->[$property_id] ? 1 : '';
}
/}}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_length=>3,};$self->{PROPS}[P_ALLOW_NONREF]=1;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)->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 boolean_values {my$self=shift;if (@_){my ($false,$true)=@_;$self->{false}=$false;$self->{true}=$true}else {delete$self->{false};delete$self->{true}}return$self}sub get_boolean_values {my$self=shift;if (exists$self->{true}and exists$self->{false}){return @$self{qw/false true/}}return}sub filter_json_object {if (defined $_[1]and ref $_[1]eq 'CODE'){$_[0]->{cb_object}=$_[1]}else {delete $_[0]->{cb_object}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_==1 or @_ > 3){Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)")}if (defined $_[2]and ref $_[2]eq 'CODE'){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}else {delete $_[0]->{cb_sk_object}->{$_[1]};delete $_[0]->{cb_sk_object}unless %{$_[0]->{cb_sk_object}|| {}}}$_[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() instead.");$_[0]->allow_bignum}{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$allow_tags;my$depth;my$indent_count;my$keysort;sub PP_encode_json {my$self=shift;my$obj=shift;$indent_count=0;$depth=0;my$props=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed,$allow_tags)=@{$props}[P_ASCII .. P_SPACE_AFTER,P_ALLOW_BLESSED,P_CONVERT_BLESSED,P_ESCAPE_SLASH,P_ALLOW_BIGNUM,P_AS_NONBLESSED,P_ALLOW_TAGS];($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!$props->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);unless ($ascii or $latin1 or $utf8){utf8::upgrade($str)}if ($props->[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 ($allow_tags and $obj->can('FREEZE')){my$obj_class=ref$obj || $obj;$obj=bless$obj,$obj_class;my@results=$obj->FREEZE('JSON');if (@results and ref$results[0]){if (refaddr($obj)eq refaddr($results[0])){encode_error(sprintf("%s::FREEZE method returned same object as was passed instead of a new one",ref$obj))}}return '("'.$obj_class.'")['.join(',',@results).']'}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));if ($allow_blessed){return$self->blessed_to_json($obj)if ($as_nonblessed);return 'null'}encode_error(sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)",$obj))}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,$self->string_to_json($k).$del .(ref$obj->{$k}? $self->object_to_json($obj->{$k}): $self->value_to_json($obj->{$k}))}--$depth;$self->_down_indent()if ($indent);return '{}' unless@res;return '{' .$pre .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,ref($v)? $self->object_to_json($v): $self->value_to_json($v)}--$depth;$self->_down_indent()if ($indent);return '[]' unless@res;return '[' .$pre .join(",$pre",@res).$post .']'}sub _looks_like_number {my$value=shift;if (USE_B){my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return 1 if$flags & (B::SVp_IOK()| B::SVp_NOK())and!($flags & B::SVp_POK());return}else {no warnings 'numeric';return if utf8::is_utf8($value);return unless length((my$dummy="")& $value);return unless 0 + $value eq $value;return 1 if$value * 0==0;return -1}}sub value_to_json {my ($self,$value)=@_;return 'null' if(!defined$value);my$type=ref($value);if (!$type){if (_looks_like_number($value)){return$value}return$self->string_to_json($value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}else {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")}}}}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_bignum;my$singlequote;my$loose;my$allow_barekey;my$allow_tags;my$alt_true;my$alt_false;sub _detect_utf_encoding {my$text=shift;my@octets=unpack('C4',$text);return 'unknown' unless defined$octets[3];return ($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'}sub PP_decode_json {my ($self,$want_offset);($self,$text,$want_offset)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$props=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bignum,$allow_barekey,$singlequote,$allow_tags)=@{$props}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE,P_ALLOW_TAGS];($alt_true,$alt_false)=@$self{qw/true false/};if ($utf8){$encoding=_detect_utf_encoding($text);if ($encoding ne 'UTF-8' and $encoding ne 'unknown'){require Encode;Encode::from_to($text,$encoding,'utf-8')}else {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)}white();decode_error("malformed JSON string, neither array, object, number, string or atom")unless defined$ch;my$result=value();if (!$props->[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();return ($result,$consumed)if$want_offset;decode_error("garbage after JSON object")if defined$ch;$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 tag()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$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);my$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]/){if (!$relaxed or $ch ne "\t"){$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 eq '' or $ch =~ /\A[ \t\r\n]\z/){next_chr()}elsif($relaxed and $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}}}$at-- if defined$ch and $ch ne '';decode_error(", or ] expected while parsing array")}sub tag {decode_error('malformed JSON string, neither array, object, number, string or atom')unless$allow_tags;next_chr();white();my$tag=value();return unless defined$tag;decode_error('malformed JSON string, (tag) must be a string')if ref$tag;white();if (!defined$ch or $ch ne ')'){decode_error(') expected after tag')}next_chr();white();my$val=value();return unless defined$val;decode_error('malformed JSON string, tag value must be an array')unless ref$val eq 'ARRAY';if (!eval {$tag->can('THAW')}){decode_error('cannot decode perl-object (package does not exist)')if $@;decode_error('cannot decode perl-object (package does not have a THAW method)')}$tag->THAW('JSON',@$val)}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-- if defined$ch and $ch ne '';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 defined$alt_true ? $alt_true : $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 defined$alt_false ? $alt_false : $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;my$is_dec;my$is_exp;if($ch eq '-'){$n='-';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after initial minus)")}}if($ch eq '0'){my$peek=substr($text,$at,1);if($peek =~ /^[0-9a-dfA-DF]/){decode_error("malformed number (leading zero must not be followed by another digit)")}$n .= $ch;next_chr}while(defined$ch and $ch =~ /\d/){$n .= $ch;next_chr}if(defined$ch and $ch eq '.'){$n .= '.';$is_dec=1;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;$is_exp=1;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 ($is_dec or $is_exp){if ($allow_bignum){require Math::BigFloat;return Math::BigFloat->new($v)}}else {if (length$v > $max_intsize){if ($allow_bignum){require Math::BigInt;return Math::BigInt->new($v)}else {return "$v"}}}return$is_dec ? $v/1.0 : 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 =~ /^(?:
[\x00-\x7F]
|[\xC2-\xDF][\x80-\xBF]
|[\xE0][\xA0-\xBF][\x80-\xBF]
|[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
|[\xED][\x80-\x9F][\x80-\xBF]
|[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
|[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
|[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
|[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
)$/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='U*';if (OLD_PERL){my$type=$] < 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==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar")}}my@val=$cb_object->($o)if ($cb_object);if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_object callbacks must not return more than one scalar")}}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 (!OLD_PERL){*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.008003){package JSON::PP;require subs;subs->import('join');eval q|
sub join {
return '' if (@_ < 2);
my $j = shift;
my $str = shift;
for (@_) { $str .= $j . $_; }
return $str;
}
|}}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{
sub JSON::PP::incr_text : lvalue {
$_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
if ( $_[0]->{_incr_parser}->{incr_pos} ) {
Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
}
$_[0]->{_incr_parser}->{incr_text};
}
} 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};require B;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 {blessed $_[0]and ($_[0]->isa("JSON::PP::Boolean")or $_[0]->isa("Types::Serialiser::BooleanBase")or $_[0]->isa("JSON::XS::Boolean"))}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}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;use constant INCR_M_TFN=>6;use constant INCR_M_NUM=>7;$JSON::PP::IncrParser::VERSION='1.01';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_pos=>0,incr_mode=>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}if (defined wantarray){my$max_size=$coder->get_max_size;my$p=$self->{incr_pos};my@ret;{do {unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){$self->_incr_parse($coder);if ($max_size and $self->{incr_pos}> $max_size){Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size")}unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){if ($self->{incr_mode}==INCR_M_WS and $self->{incr_pos}){$self->{incr_pos}=0;$self->{incr_text}=''}last}}unless ($coder->get_utf8){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}my ($obj,$offset)=$coder->PP_decode_json($self->{incr_text},0x00000001);push@ret,$obj;use bytes;$self->{incr_text}=substr($self->{incr_text},$offset || 0);$self->{incr_pos}=0;$self->{incr_nest}=0;$self->{incr_mode}=0;last unless wantarray}while (wantarray)}if (wantarray){return@ret}else {return defined$ret[0]? $ret[0]: undef}}}sub _incr_parse {my ($self,$coder)=@_;my$text=$self->{incr_text};my$len=length$text;my$p=$self->{incr_pos};INCR_PARSE: while ($len > $p){my$s=substr($text,$p,1);last INCR_PARSE unless defined$s;my$mode=$self->{incr_mode};if ($mode==INCR_M_WS){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if (ord($s)> 0x20){if ($s eq '#'){$self->{incr_mode}=INCR_M_C0;redo INCR_PARSE}else {$self->{incr_mode}=INCR_M_JSON;redo INCR_PARSE}}$p++}}elsif ($mode==INCR_M_BS){$p++;$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($mode==INCR_M_C0 or $mode==INCR_M_C1){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq "\n"){$self->{incr_mode}=$self->{incr_mode}==INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;last}$p++}next}elsif ($mode==INCR_M_TFN){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[rueals]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_NUM){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[0-9eE.+\-]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_STR){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq '"'){$p++;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($s eq '\\'){$p++;if (!defined substr($text,$p,1)){$self->{incr_mode}=INCR_M_BS;last INCR_PARSE}}$p++}}elsif ($mode==INCR_M_JSON){while ($len > $p){$s=substr($text,$p++,1);if ($s eq "\x00"){$p--;last INCR_PARSE}elsif ($s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20"){if (!$self->{incr_nest}){$p--;last INCR_PARSE}next}elsif ($s eq 't' or $s eq 'f' or $s eq 'n'){$self->{incr_mode}=INCR_M_TFN;redo INCR_PARSE}elsif ($s =~ /^[0-9\-]$/){$self->{incr_mode}=INCR_M_NUM;redo INCR_PARSE}elsif ($s eq '"'){$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($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?)')}next}elsif ($s eq ']' or $s eq '}'){if (--$self->{incr_nest}<= 0){last INCR_PARSE}}elsif ($s eq '#'){$self->{incr_mode}=INCR_M_C1;redo INCR_PARSE}}}}$self->{incr_pos}=$p;$self->{incr_parsing}=$p ? 1 : 0}sub incr_text {if ($_[0]->{incr_pos}){Carp::croak("incr_text cannot 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_pos});$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}1;
JSON_PP
$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
package JSON::PP::Boolean;use strict;require overload;local $^W;overload::import('overload',"0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);$JSON::PP::Boolean::VERSION='4.07';1;
JSON_PP_BOOLEAN
$fatpacked{"Locale/Maketext/Simple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCALE_MAKETEXT_SIMPLE';
package Locale::Maketext::Simple;$Locale::Maketext::Simple::VERSION='0.21';use strict;use 5.005;sub import {my ($class,%args)=@_;$args{Class}||= caller;$args{Style}||= 'maketext';$args{Export}||= 'loc';$args{Subclass}||= 'I18N';my ($loc,$loc_lang)=$class->load_loc(%args);$loc ||= $class->default_loc(%args);no strict 'refs';*{caller(0)."::$args{Export}"}=$loc if$args{Export};*{caller(0)."::$args{Export}_lang"}=$loc_lang || sub {1}}my%Loc;sub reload_loc {%Loc=()}sub load_loc {my ($class,%args)=@_;my$pkg=join('::',grep {defined and length}$args{Class},$args{Subclass});return$Loc{$pkg}if exists$Loc{$pkg};eval {require Locale::Maketext::Lexicon;1}or return;$Locale::Maketext::Lexicon::VERSION > 0.20 or return;eval {require File::Spec;1}or return;my$path=$args{Path}|| $class->auto_path($args{Class})or return;my$pattern=File::Spec->catfile($path,'*.[pm]o');my$decode=$args{Decode}|| 0;my$encoding=$args{Encoding}|| undef;$decode=1 if$encoding;$pattern =~ s{\\}{/}g;eval "
package $pkg;
use base 'Locale::Maketext';
Locale::Maketext::Lexicon->import({
'i-default' => [ 'Auto' ],
'*' => [ Gettext => \$pattern ],
_decode => \$decode,
_encoding => \$encoding,
});
*${pkg}::Lexicon = \\%${pkg}::i_default::Lexicon;
*tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') }
unless defined &tense;
1;
" or die $@;my$lh=eval {$pkg->get_handle}or return;my$style=lc($args{Style});if ($style eq 'maketext'){$Loc{$pkg}=sub {$lh->maketext(@_)}}elsif ($style eq 'gettext'){$Loc{$pkg}=sub {my$str=shift;$str =~ s{([\~\[\]])}{~$1}g;$str =~ s{
([%\\]%) # 1 - escaped sequence
|
% (?:
([A-Za-z#*]\w*) # 2 - function call
\(([^\)]*)\) # 3 - arguments
|
([1-9]\d*|\*) # 4 - variable
)
}{
$1 ? $1
: $2 ? "\[$2,"._unescape($3)."]"
: "[_$4]"
}egx;return$lh->maketext($str,@_)}}else {die "Unknown Style: $style"}return$Loc{$pkg},sub {$lh=$pkg->get_handle(@_)}}sub default_loc {my ($self,%args)=@_;my$style=lc($args{Style});if ($style eq 'maketext'){return sub {my$str=shift;$str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]}
{$1%$2}g;$str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]}
{"$1%$2(" . _escape($3) . ')'}eg;_default_gettext($str,@_)}}elsif ($style eq 'gettext'){return \&_default_gettext}else {die "Unknown Style: $style"}}sub _default_gettext {my$str=shift;$str =~ s{
% # leading symbol
(?: # either one of
\d+ # a digit, like %1
| # or
(\w+)\( # a function call -- 1
(?: # either
%\d+ # an interpolation
| # or
([^,]*) # some string -- 2
) # end either
(?: # maybe followed
, # by a comma
([^),]*) # and a param -- 3
)? # end maybe
(?: # maybe followed
, # by another comma
([^),]*) # and a param -- 4
)? # end maybe
[^)]* # and other ignorable params
\) # closing function call
) # closing either one of
}{
my $digit = $2 || shift;
$digit . (
$1 ? (
($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') :
($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) :
''
) : ''
);
}egx;return$str};sub _escape {my$text=shift;$text =~ s/\b_([1-9]\d*)/%$1/g;return$text}sub _unescape {join(',',map {/\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_}split(/,/,$_[0]))}sub auto_path {my ($self,$calldir)=@_;$calldir =~ s#::#/#g;my$path=$INC{$calldir .'.pm'}or return;if ($^O eq 'MacOS'){(my$malldir=$calldir)=~ tr#/#:#;$path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s}else {$path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#}return$path if -d $path;$path="auto/$calldir/";for my$inc (@INC){return "$inc/$path" if -d "$inc/$path"}return}1;
LOCALE_MAKETEXT_SIMPLE
$fatpacked{"MRO/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MRO_COMPAT';
package MRO::Compat;use strict;use warnings;require 5.006_000;our$VERSION='0.15';BEGIN {if($] < 5.009_005){$mro::VERSION =$VERSION;$INC{'mro.pm'}=__FILE__;*mro::import=\&__import;*mro::get_linear_isa=\&__get_linear_isa;*mro::set_mro=\&__set_mro;*mro::get_mro=\&__get_mro;*mro::get_isarev=\&__get_isarev;*mro::is_universal=\&__is_universal;*mro::method_changed_in=\&__method_changed_in;*mro::invalidate_all_method_caches =\&__invalidate_all_method_caches;require Class::C3;if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03){*mro::get_pkg_gen=\&__get_pkg_gen_c3xs}else {*mro::get_pkg_gen=\&__get_pkg_gen_pp}}else {require mro;no warnings 'redefine';*Class::C3::initialize=sub {1};*Class::C3::reinitialize=sub {1};*Class::C3::uninitialize=sub {1}}}sub __get_linear_isa_dfs {my@check=shift;my@lin;my%found;while (defined(my$check=shift@check)){push@lin,$check;no strict 'refs';unshift@check,grep!$found{$_}++,@{"$check\::ISA"}}return \@lin}sub __get_linear_isa ($;$) {my ($classname,$type)=@_;die "mro::get_mro requires a classname" if!defined$classname;$type ||= __get_mro($classname);if($type eq 'dfs'){return __get_linear_isa_dfs($classname)}elsif($type eq 'c3'){return [Class::C3::calculateMRO($classname)]}die "type argument must be 'dfs' or 'c3'"}sub __import {if($_[1]){goto&Class::C3::import if $_[1]eq 'c3';__set_mro(scalar(caller),$_[1])}}sub __set_mro ($$) {my ($classname,$type)=@_;if(!defined$classname ||!$type){die q{Usage: mro::set_mro($classname, $type)}}if($type eq 'c3'){eval "package $classname; use Class::C3";die $@ if $@}elsif($type eq 'dfs'){if(defined$Class::C3::MRO{$classname}){Class::C3::_remove_method_dispatch_table($classname)}delete$Class::C3::MRO{$classname}}else {die qq{Invalid mro type "$type"}}return}sub __get_mro ($) {my$classname=shift;die "mro::get_mro requires a classname" if!defined$classname;return 'c3' if exists$Class::C3::MRO{$classname};return 'dfs'}sub __get_all_pkgs_with_isas {no strict 'refs';no warnings 'recursion';my@retval;my$search=shift;my$pfx;my$isa;if(defined$search){$isa=\@{"$search\::ISA"};$pfx="$search\::"}else {$search='main';$isa=\@main::ISA;$pfx=''}push(@retval,$search)if scalar(@$isa);for my$cand (keys %{"$search\::"}){if($cand =~ s/::$//){next if$cand eq $search;push(@retval,@{__get_all_pkgs_with_isas($pfx .$cand)})}}return \@retval}sub __get_isarev_recurse {no strict 'refs';my ($class,$all_isas,$level)=@_;die "Recursive inheritance detected" if$level > 100;my%retval;for my$cand (@$all_isas){my$found_me;for (@{"$cand\::ISA"}){if($_ eq $class){$found_me=1;last}}if($found_me){$retval{$cand}=1;map {$retval{$_}=1}@{__get_isarev_recurse($cand,$all_isas,$level+1)}}}return [keys%retval]}sub __get_isarev ($) {my$classname=shift;die "mro::get_isarev requires a classname" if!defined$classname;__get_isarev_recurse($classname,__get_all_pkgs_with_isas(),0)}sub __is_universal ($) {my$classname=shift;die "mro::is_universal requires a classname" if!defined$classname;my$lin=__get_linear_isa('UNIVERSAL');for (@$lin){return 1 if$classname eq $_}return 0}sub __invalidate_all_method_caches () {@f845a9c1ac41be33::ISA=@f845a9c1ac41be33::ISA;return}sub __method_changed_in ($) {my$classname=shift;die "mro::method_changed_in requires a classname" if!defined$classname;__invalidate_all_method_caches()}{my$__pkg_gen=2;sub __get_pkg_gen_pp ($) {my$classname=shift;die "mro::get_pkg_gen requires a classname" if!defined$classname;return$__pkg_gen++}}sub __get_pkg_gen_c3xs ($) {my$classname=shift;die "mro::get_pkg_gen requires a classname" if!defined$classname;return Class::C3::XS::_plsubgen()}1;
MRO_COMPAT
$fatpacked{"Menlo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO';
package Menlo;our$VERSION="1.9019";1;
MENLO
$fatpacked{"Menlo/Builder/Static.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_BUILDER_STATIC';
package Menlo::Builder::Static;use strict;use warnings;use CPAN::Meta;use ExtUtils::Config 0.003;use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;use ExtUtils::Install qw/pm_to_blib install/;use ExtUtils::InstallPaths 0.002;use File::Basename qw/dirname/;use File::Find ();use File::Path qw/mkpath/;use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;use Getopt::Long 2.36 qw/GetOptionsFromArray/;sub new {my($class,%args)=@_;bless {meta=>$args{meta},},$class}sub meta {my$self=shift;$self->{meta}}sub manify {my ($input_file,$output_file,$section,$opts)=@_;return if -e $output_file && -M $input_file <= -M $output_file;my$dirname=dirname($output_file);mkpath($dirname,$opts->{verbose})if not -d $dirname;require Pod::Man;Pod::Man->new(section=>$section)->parse_from_file($input_file,$output_file);print "Manifying $output_file\n" if$opts->{verbose}&& $opts->{verbose}> 0;return}sub find {my ($pattern,$dir)=@_;my@ret;File::Find::find(sub {push@ret,$File::Find::name if /$pattern/ && -f},$dir)if -d $dir;return@ret}my%actions=(build=>sub {my%opt=@_;my%modules=map {$_=>catfile('blib',$_)}find(qr/\.p(?:m|od)$/,'lib');my%scripts=map {$_=>catfile('blib',$_)}find(qr//,'script');my%shared=map {$_=>catfile(qw/blib lib auto share dist/,$opt{meta}->name,abs2rel($_,'share'))}find(qr//,'share');pm_to_blib({%modules,%scripts,%shared },catdir(qw/blib lib auto/));make_executable($_)for values%scripts;mkpath(catdir(qw/blib arch/),$opt{verbose});if ($opt{install_paths}->install_destination('bindoc')&& $opt{install_paths}->is_default_installable('bindoc')){manify($_,catfile('blib','bindoc',man1_pagename($_)),$opt{config}->get('man1ext'),\%opt)for keys%scripts}if ($opt{install_paths}->install_destination('libdoc')&& $opt{install_paths}->is_default_installable('libdoc')){manify($_,catfile('blib','libdoc',man3_pagename($_)),$opt{config}->get('man3ext'),\%opt)for keys%modules}1},test=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';require TAP::Harness::Env;my%test_args=((verbosity=>$opt{verbose})x!!exists$opt{verbose},(jobs=>$opt{jobs})x!!exists$opt{jobs},(color=>1)x!!-t STDOUT,lib=>[map {rel2abs(catdir(qw/blib/,$_))}qw/arch lib/ ],);my$tester=TAP::Harness::Env->create(\%test_args);$tester->runtests(sort +find(qr/\.t$/,'t'))->has_errors and return;1},install=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';install($opt{install_paths}->install_map,@opt{qw/verbose dry_run uninst/});1},);sub build {my$self=shift;my$action=@_ && $_[0]=~ /\A\w+\z/ ? shift @_ : 'build';die "No such action '$action'\n" if not $actions{$action};my%opt;GetOptionsFromArray([@$_],\%opt,qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/)for ($self->{env},$self->{configure_args},\@_);$_=detildefy($_)for grep {defined}@opt{qw/install_base destdir prefix/},values %{$opt{install_path}};@opt{'config','meta' }=(ExtUtils::Config->new($opt{config}),$self->meta);$actions{$action}->(%opt,install_paths=>ExtUtils::InstallPaths->new(%opt,dist_name=>$opt{meta}->name))}sub configure {my$self=shift;$self->{env}=defined$ENV{PERL_MB_OPT}? [split_like_shell($ENV{PERL_MB_OPT})]: [];$self->{configure_args}=[@_];$self->meta->save(@$_)for ['MYMETA.json'],['MYMETA.yml'=>{version=>1.4 }]}1;
MENLO_BUILDER_STATIC
$fatpacked{"Menlo/CLI/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_CLI_COMPAT';
package Menlo::CLI::Compat;use strict;use Config;use Cwd ();use Menlo;use Menlo::Dependency;use Menlo::Util qw(WIN32);use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use File::Which qw(which);use Getopt::Long ();use Symbol ();use version ();use constant BAD_TAR=>($^O eq 'solaris' || $^O eq 'hpux');use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION='1.9022';if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}sub qs($) {Menlo::Util::shell_quote($_[0])}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;my$self=bless {name=>"Menlo",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,static_install=>1,auto_cleanup=>7,pod2man=>1,installed_dists=>0,install_types=>['requires'],with_develop=>0,with_configure=>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;$self}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},'static-install!'=>\$self->{static_install},'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-configure'=>\$self->{with_configure},'without-configure'=>sub {$self->{with_configure}=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}=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 run {my$self=shift;my$code;eval {$code=($self->_doit==0)};if (my$e=$@){warn$e;$code=1}$self->{status}=$code}sub status {$_[0]->{status}}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 ($self->{name}) $Menlo::VERSION on perl $] built for $Config{archname}\n" ."Work directory is $self->{base}\n")}sub search_mirror_index_local {my ($self,$local,$module,$version)=@_;require CPAN::Common::Index::LocalPackage;my$index=CPAN::Common::Index::LocalPackage->new({source=>$local });$self->search_common($index,{package=>$module },$version)}sub search_mirror_index {my ($self,$mirror,$module,$version)=@_;require Menlo::Index::Mirror;my$index=Menlo::Index::Mirror->new({mirror=>$mirror,cache=>$self->source_for($mirror),fetcher=>sub {$self->mirror(@_)},});$self->search_common($index,{package=>$module },$version)}sub search_common {my($self,$index,$search_args,$want_version)=@_;$index->refresh_index;my$found=$index->search_packages($search_args);$found=$self->cpan_module_common($found)if$found;return$found unless$self->{cascade_search};if ($found){if ($self->satisfy_version($found->{module},$found->{module_version},$want_version)){return$found}else {$self->chat("Found $found->{module} $found->{module_version} which doesn't satisfy $want_version.\n")}}return}sub with_version_range {my($self,$version)=@_;defined($version)&& $version =~ /(?:<|!=|==)/}sub search_metacpan {my($self,$module,$version,$dev_release)=@_;require Menlo::Index::MetaCPAN;$self->chat("Searching $module ($version) on metacpan ...\n");my$index=Menlo::Index::MetaCPAN->new({include_dev=>$self->{dev_release}});my$pkg=$self->search_common($index,{package=>$module,version_range=>$version },$version);return$pkg if$pkg;$self->diag_fail("Finding $module ($version) 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,$self->{dev_release})and return$found;$found=$self->search_cpanmetadb($module,$version,$self->{dev_release})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,$dev_release)=@_;require Menlo::Index::MetaDB;$self->chat("Searching $module ($version) on cpanmetadb ...\n");my$args={package=>$module };if ($self->with_version_range($version)){$args->{version_range}=$version}my$index=Menlo::Index::MetaDB->new({uri=>$self->{cpanmetadb}});my$pkg=$self->search_common($index,$args,$version);return$pkg if$pkg;$self->diag_fail("Finding $module 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_local($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$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 ($self->{name}) 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"}||= Menlo::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 _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_command {my($self,$cmd)=@_;if (ref$cmd eq 'CODE'){if ($self->{verbose}){return$cmd->()}else {require Capture::Tiny;open my$logfh,">>",$self->{log};my$ret;Capture::Tiny::capture(sub {$ret=$cmd->()},stdout=>$logfh,stderr=>$logfh);return$ret}}if (WIN32){$cmd=Menlo::Util::shell_quote(@$cmd)if ref$cmd eq 'ARRAY';unless ($self->{verbose}){$cmd .= " >> " .Menlo::Util::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 .= " >> " .Menlo::Util::shell_quote($self->{log})." 2>&1"}exec$cmd}}sub run_timeout {my($self,$cmd,$timeout)=@_;return$self->run_command($cmd)if ref($cmd)eq 'CODE' || 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_command($cmd)}}sub append_args {my($self,$cmd,$phase)=@_;return$cmd if ref$cmd ne 'ARRAY';if (my$args=$self->{build_args}{$phase}){$cmd=join ' ',Menlo::Util::shell_quote(@$cmd),$args}$cmd}sub _use_unsafe_inc {my($self,$dist)=@_;if (exists$ENV{PERL_USE_UNSAFE_INC}){return$ENV{PERL_USE_UNSAFE_INC}}if (exists$dist->{meta}{x_use_unsafe_inc}){$self->chat("Distribution opts in x_use_unsafe_inc: $dist->{meta}{x_use_unsafe_inc}\n");return$dist->{meta}{x_use_unsafe_inc}}return 1}sub configure {my($self,$cmd,$dist,$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"}local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$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,$dist,$depth)=@_;local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$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,$dist,$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,$dist,$depth)=@_;return 1 if$self->{notest};local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{NONINTERACTIVE_TESTING}=!$self->{interactive};local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$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,$dist,$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,$dist,$depth)=@_;if ($depth==0 && $self->{test_only}){return 1}return$self->run_command($cmd)if ref$cmd eq 'CODE';local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);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_command($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=which($pager);next unless$pager;last}if ($pager){if (WIN32){system "@{[ qs $pager ]} < @{[ qs $self->{log}]}"}else {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}=['Menlo' ];return}sub install_module {my($self,$module,$depth,$version,$dep)=@_;$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,$dep);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->sha_for(256,$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 sha_for {my($self,$alg,$file)=@_;require Digest::SHA;open my$fh,"<",$file or die "$file: $!";my$dg=Digest::SHA->new($alg);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=`@{[ qs $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 verification for $dist->{filename} failed\n");return}}sub resolve_name {my($self,$module,$version,$dep)=@_;if ($dep && $dep->url){if ($dep->url =~ m!authors/id/(.*)!){return$self->cpan_dist($1,$dep->url)}else {return {uris=>[$dep->url ]}}}if ($dep && $dep->dist){return$self->cpan_dist($dep->dist,undef,$dep->mirror)}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_common {my($self,$match)=@_;(my$distfile=$match->{uri})=~ s!^cpan:///distfile/!!;my$mirrors=$self->{mirrors};if ($match->{download_uri}){(my$mirror=$match->{download_uri})=~ s!/authors/id/.*$!!;$mirrors=[$mirror]}local$self->{mirrors}=$mirrors;return$self->cpan_module($match->{package},$distfile,$match->{version})}sub cpan_module {my($self,$module,$dist_file,$version)=@_;my$dist=$self->cpan_dist($dist_file);$dist->{module}=$module;$dist->{module_version}=$version if$version && $version ne 'undef';return$dist}sub cpan_dist {my($self,$dist,$url,$mirror)=@_;$mirror =~ s!/$!! if$mirror;$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=$mirror ? ($mirror): @{$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_command(['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_command(['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 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,$dep)}$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 : {};if ($self->opts_in_static_install($dist->{cpanmeta})){$dist->{static_install}=1}my@config_deps;if ($dist->{cpanmeta}){push@config_deps,Menlo::Dependency->from_prereqs($dist->{cpanmeta}->effective_prereqs,['configure'],$self->{install_types},)}if (-e 'Build.PL' &&!@config_deps){push@config_deps,Menlo::Dependency->from_versions({'Module::Build'=>'0.38' },'configure',)}$self->merge_with_cpanfile($dist,\@config_deps);$self->upgrade_toolchain(\@config_deps);my$target=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};unless ($self->skip_configure($dist,$depth)){$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$deps_only=$self->deps_only($depth);$dist->{want_phases}=$self->{notest}&&!$self->deps_only($depth)? [qw(build runtime)]: [qw(build test runtime)];push @{$dist->{want_phases}},'develop' if$self->{with_develop}&& $depth==0;push @{$dist->{want_phases}},'configure' if$self->{with_configure}&& $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->{static_install}){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build(sub {$configure_state->{static_install}->build},$distname,$dist,$depth)&& $self->test(sub {$configure_state->{static_install}->build("test")},$distname,$dist,$depth)&& $self->install(sub {$configure_state->{static_install}->build("install")},[],$dist,$depth)&& $installed++}elsif ($configure_state->{use_module_build}&& -e 'Build' && -f _){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{perl},"./Build" ],$distname,$dist,$depth)&& $self->test([$self->{perl},"./Build","test" ],$distname,$dist,$depth)&& $self->install([$self->{perl},"./Build","install" ],["--uninst",1 ],$dist,$depth)&& $installed++}elsif ($self->{make}&& -e 'Makefile'){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{make}],$distname,$dist,$depth)&& $self->test([$self->{make},"test" ],$distname,$dist,$depth)&& $self->install([$self->{make},"install" ],["UNINST=1" ],$dist,$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->is_downgrade($version,$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 is_downgrade {my($self,$va,$vb)=@_;eval {version::->new($va)< $vb}}sub opts_in_static_install {my($self,$meta)=@_;return if!$self->{static_install};return if$self->{sudo}or $self->{uninstall_shadows};return$meta->{x_static_install}&& $meta->{x_static_install}==1}sub skip_configure {my($self,$dist,$depth)=@_;return 1 if$self->{skip_configure};return 1 if$dist->{static_install};return 1 if$self->no_dynamic_config($dist->{meta})&& $self->deps_only($depth);return}sub no_dynamic_config {my($self,$meta)=@_;exists$meta->{dynamic_config}&& $meta->{dynamic_config}==0}sub deps_only {my($self,$depth)=@_;($self->{installdeps}&& $depth==0)or $self->{showdeps}or $self->{scandeps}}sub perl_requirements {my($self,@requires)=@_;my@perl;for my$requires (grep defined,@requires){if (exists$requires->{perl}){push@perl,Menlo::Dependency->new(perl=>$requires->{perl})}}return@perl}sub configure_this {my($self,$dist,$depth)=@_;my$deps_only=$self->deps_only($depth);if (-e $self->{cpanfile_path}&& $deps_only){require Module::CPANfile;$dist->{cpanfile}=eval {Module::CPANfile->load($self->{cpanfile_path})};$self->diag_fail($@,1)if $@;$self->{cpanfile_global}||= $dist->{cpanfile};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,}}if ($deps_only && $self->no_dynamic_config($dist->{meta})){return {configured=>1,configured_ok=>exists$dist->{meta}{prereqs},use_module_build=>0,}}my$state={};my$try_static=sub {if ($dist->{static_install}){$self->chat("Distribution opts in x_static_install: $dist->{meta}{x_static_install}\n");$self->static_install_configure($state,$dist,$depth)}};my$try_eumm=sub {if (-e 'Makefile.PL'){$self->chat("Running Makefile.PL\n");if ($self->configure([$self->{perl},"Makefile.PL" ],$dist,$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" ],$dist,$depth)){$state->{configured_ok}=-e 'Build' && -f _}$state->{use_module_build}++;$state->{configured}++}};for my$try ($try_static,$try_mb,$try_eumm){$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 static_install_configure {my($self,$state,$dist,$depth)=@_;my$args=$depth==0 ? $self->{build_args}{configure}: [];require Menlo::Builder::Static;my$builder=Menlo::Builder::Static->new(meta=>$dist->{cpanmeta});$self->configure(sub {$builder->configure($args || [])},$dist,$depth);$state->{configured_ok}=1;$state->{static_install}=$builder;$state->{configured}++}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";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 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);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_command(\@cmd)}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 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)}$self->merge_with_cpanfile($dist,\@deps);return@deps}sub merge_with_cpanfile {my($self,$dist,$deps)=@_;if ($self->{cpanfile_requirements}&&!$dist->{cpanfile}){for my$dep (@$deps){$dep->merge_with($self->{cpanfile_requirements})}}if ($self->{cpanfile_global}){for my$dep (@$deps){my$opts=$self->{cpanfile_global}->options_for_module($dep->module)or next;$dep->dist($opts->{dist})if$opts->{dist};$dep->mirror($opts->{mirror})if$opts->{mirror};$dep->url($opts->{url})if$opts->{url}}}}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 Menlo::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}require CPAN::Meta;my@meta=qw(MYMETA.json MYMETA.yml);if ($self->no_dynamic_config($dist->{meta})){push@meta,qw(META.json META.yml)}my@deps;my($meta_file)=grep -f,@meta;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)}}$self->diag_fail("No MYMETA file is found after configure. Your toolchain is too old?");return}sub bundle_deps {my($self,$dist)=@_;my$match;if ($dist->{module}){$match=sub {my$meta=Module::Metadata->new_from_file($_[0]);$meta && ($meta->name eq $dist->{module})}}else {$match=sub {1}}my@files;File::Find::find({wanted=>sub {push@files,File::Spec->rel2abs($_)if /\.pm$/i && $match->($_)},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,Menlo::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=$meta->effective_prereqs(\@features)->clone;$self->adjust_prereqs($dist,$prereqs);return Menlo::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}sub adjust_prereqs {my($self,$dist,$prereqs)=@_;if (-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)}}}if ($dist->{static_install}){my$reqs=$prereqs->requirements_for('test'=>'requires');$reqs->add_minimum('TAP::Harness::Env'=>0)}}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 CPAN::Meta::YAML;print CPAN::Meta::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 mirror {my($self,$uri,$local)=@_;if ($uri =~ /^file:/){$self->file_mirror($uri,$local)}else {$self->{http}->mirror($uri,$local)}}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);my$source_mtime=(stat$file)[9];return 1 if -e $path && (stat$path)[9]>= $source_mtime;File::Copy::copy($file,$path);utime$source_mtime,$source_mtime,$path}sub configure_http {my$self=shift;require HTTP::Tinyish;my@try=qw(HTTPTiny);unshift@try,'Wget' if$self->{try_wget};unshift@try,'Curl' if$self->{try_curl};unshift@try,'LWP' if$self->{try_lwp};my@protocol=('http');push@protocol,'https' if grep /^https:/,@{$self->{mirrors}};my$backend;for my$try (map "HTTP::Tinyish::$_",@try){if (my$meta=HTTP::Tinyish->configure_backend($try)){if ((grep$try->supports($_),@protocol)==@protocol){for my$tool (sort keys %$meta){(my$desc=$meta->{$tool})=~ s/^(.*?)\n.*/$1/s;$self->chat("You have $tool: $desc\n")}$backend=$try;last}}}$backend->new(agent=>"Menlo/$Menlo::VERSION",verify_SSL=>1)}sub init_tools {my$self=shift;return if$self->{initialized}++;if ($self->{make}=which($Config{make})){$self->chat("You have make $self->{make}\n")}$self->{http}=$self->configure_http;my$tar=which('tar');my$tar_ver;my$maybe_bad_tar=sub {WIN32 || BAD_TAR || (($tar_ver=`@{[ qs $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)=`@{[ qs $tar ]} ${ar}tf @{[ qs $tarfile ]}` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}$self->run_command([$tar,$ar.$xf,$tarfile ]);return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif ($tar and my$gzip=which('gzip')and my$bzip2=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)=`@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $tar ]} tf -` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $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=which('unzip')){$self->chat("You have $unzip\n");$self->{_backends}{unzip}=sub {my($self,$zipfile)=@_;my@opt=$self->{verbose}? (): ('-q');my(undef,$root,@others)=`@{[ qs $unzip ]} -t @{[ qs $zipfile ]}` or return undef;FILE: {chomp$root;if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}){$root=shift(@others);redo FILE if$root}}$self->run_command([$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 mask_uri_passwords {my($self,@strings)=@_;s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:********@}gx for@strings;return@strings}1;
It appears your cpanm executable was installed via `perlbrew install-cpanm`.
cpanm --self-upgrade won't upgrade the version of cpanm you're running.
Run the following command to get it upgraded.
perlbrew install-cpanm
DIE
You are running cpanm from the path where your current perl won't install executables to.
Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running.
cpanm path : $0
Install path : $Config{installsitebin}
It means you either installed cpanm globally with system perl, or use distro packages such
as rpm or apt-get, and you have to use them again to upgrade cpanm.
DIE
Usage: cpanm [options] Module [...]
Try `cpanm --help` or `man cpanm` for more options.
USAGE
Usage: cpanm [options] Module [...]
Options:
-v,--verbose Turns on chatty output
-q,--quiet Turns off the most output
--interactive Turns on interactive configure (required for Task:: modules)
-f,--force force install
-n,--notest Do not run unit tests
--test-only Run tests only, do not install
-S,--sudo sudo to run install commands
--installdeps Only install dependencies
--showdeps Only display direct dependencies
--reinstall Reinstall the distribution even if you already have the latest version installed
--mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
--mirror-only Use the mirror's index file instead of the CPAN Meta DB
-M,--from Use only this mirror base URL and its index file
--prompt Prompt when configure/build/test fails
-l,--local-lib Specify the install base to install modules
-L,--local-lib-contained Specify the install base to install all non-core modules
--self-contained Install all non-core modules, even if they're already installed.
--auto-cleanup Number of days that cpanm's work directories expire in. Defaults to 7
Commands:
--self-upgrade upgrades itself
--info Displays distribution info on CPAN
--look Opens the distribution with your SHELL
-U,--uninstall Uninstalls the modules (EXPERIMENTAL)
-V,--version Displays software version
Examples:
cpanm Test::More # install Test::More
cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path
cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file
cpanm --interactive Task::Kensho # Configure interactively
cpanm . # install from local directory
cpanm --installdeps . # install all the deps for the current directory
cpanm -L extlib Plack # install Plack and all non-core deps into extlib
cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
cpanm -M https://cpan.metacpan.org App::perlbrew # use only this secure mirror and its index
You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
HELP
!
! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
! To turn off this warning, you have to do one of the following:
! - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
! - Configure local::lib in your existing shell to set PERL_MM_OPT etc.
! - Install local::lib by running the following commands
!
! cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
!
DIAG
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.
WARN
$module is not found in the following directories and can't be uninstalled.
@{[ join(" \n", map " $_", @inc) ]}
DIAG
! Configuring $distname failed. See $self->{log} for details.
! You might have to install the following modules first to get --scandeps working correctly.
DIAG
MENLO_CLI_COMPAT
$fatpacked{"Menlo/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_DEPENDENCY';
package Menlo::Dependency;use strict;use CPAN::Meta::Requirements;use Class::Tiny qw(module version type original_version dist mirror url);sub BUILDARGS {my($class,$module,$version,$type)=@_;return {module=>$module,version=>$version,type=>$type || 'requires',}}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 requires_version {my$self=shift;if (defined$self->original_version){return$self->original_version}$self->version}sub is_requirement {$_[0]->type eq 'requires'}1;
MENLO_DEPENDENCY
$fatpacked{"Menlo/Index/MetaCPAN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METACPAN';
use 5.008001;use strict;use warnings;package Menlo::Index::MetaCPAN;use parent 'CPAN::Common::Index';use Class::Tiny qw/uri include_dev/;use Carp;use HTTP::Tinyish;use JSON::PP ();use Time::Local ();sub BUILD {my$self=shift;my$uri=$self->uri;$uri="https://fastapi.metacpan.org/v1/download_url/" unless defined$uri;$uri =~ s{/?$}{/};$self->uri($uri);return}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';my$range;if ($args->{version}){$range="== $args->{version}"}elsif ($args->{version_range}){$range=$args->{version_range}}my%query=(($self->include_dev ? (dev=>1): ()),($range ? (version=>$range): ()),);my$query=join "&",map {"$_=" .$self->_uri_escape($query{$_})}sort keys%query;my$uri=$self->uri .$args->{package}.($query ? "?$query" : "");my$res=HTTP::Tinyish->new->get($uri);return unless$res->{success};my$dist_meta=eval {JSON::PP::decode_json($res->{content})};if ($dist_meta && $dist_meta->{download_url}){(my$distfile=$dist_meta->{download_url})=~ s!.+/authors/id/\w/\w\w/!!;return {package=>$args->{package},version=>$dist_meta->{version},uri=>"cpan:///distfile/$distfile",download_uri=>$self->_download_uri("http://cpan.metacpan.org",$distfile),}}return}sub _parse_date {my($self,$date)=@_;my@date=$date =~ /^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/;Time::Local::timegm($date[5],$date[4],$date[3],$date[2],$date[1]- 1,$date[0]- 1900)}sub _uri_escape {my($self,$string)=@_;$string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$string}sub _download_uri {my($self,$base,$distfile)=@_;join "/",$base,"authors/id",substr($distfile,0,1),substr($distfile,0,2),$distfile}sub index_age {return time}sub search_authors {return}1;
MENLO_INDEX_METACPAN
$fatpacked{"Menlo/Index/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METADB';
use 5.008001;use strict;use warnings;package Menlo::Index::MetaDB;our$VERSION="1.9019";use parent 'CPAN::Common::Index';use Class::Tiny qw/uri/;use Carp;use CPAN::Meta::YAML;use CPAN::Meta::Requirements;use HTTP::Tiny;sub BUILD {my$self=shift;my$uri=$self->uri;$uri="http://cpanmetadb.plackperl.org/v1.0/" unless defined$uri;$uri =~ s{/?$}{/};$self->uri($uri);return}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';return unless exists$args->{package}&& ref$args->{package}eq '';my$mod=$args->{package};if ($args->{version}|| $args->{version_range}){my$res=HTTP::Tiny->new->get($self->uri ."history/$mod");return unless$res->{success};my$range=defined$args->{version}? "== $args->{version}" : $args->{version_range};my$reqs=CPAN::Meta::Requirements->from_string_hash({$mod=>$range });my@found;for my$line (split /\r?\n/,$res->{content}){if ($line =~ /^$mod\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_o=>version::->parse($1),distfile=>$2,}}}return unless@found;$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_o}<=> $a->{version_o}}@found){if ($reqs->accepts_module($mod=>$try->{version_o})){$match=$try,last}}if ($match){my$file=$match->{distfile};$file =~ s{^./../}{};return {package=>$mod,version=>$match->{version},uri=>"cpan:///distfile/$file",($match->{latest}? (): (download_uri=>"http://backpan.perl.org/authors/id/$match->{distfile}")),}}}else {my$res=HTTP::Tiny->new->get($self->uri ."package/$mod");return unless$res->{success};if (my$yaml=CPAN::Meta::YAML->read_string($res->{content})){my$meta=$yaml->[0];if ($meta && $meta->{distfile}){my$file=$meta->{distfile};$file =~ s{^./../}{};return {package=>$mod,version=>$meta->{version},uri=>"cpan:///distfile/$file",}}}}return}sub index_age {return time};sub search_authors {return};1;
MENLO_INDEX_METADB
$fatpacked{"Menlo/Index/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_MIRROR';
package Menlo::Index::Mirror;use strict;use parent qw(CPAN::Common::Index::Mirror);use Class::Tiny qw(fetcher);use File::Basename ();use File::Spec ();use URI ();our$HAS_IO_UNCOMPRESS_GUNZIP=eval {require IO::Uncompress::Gunzip};my%INDICES=(packages=>'modules/02packages.details.txt.gz',);sub refresh_index {my$self=shift;for my$file (values%INDICES){my$remote=URI->new_abs($file,$self->mirror);$remote =~ s/\.gz$// unless$HAS_IO_UNCOMPRESS_GUNZIP;my$local=File::Spec->catfile($self->cache,File::Basename::basename($file));$self->fetcher->($remote,$local)or Carp::croak("Cannot fetch $remote to $local");if ($HAS_IO_UNCOMPRESS_GUNZIP){(my$uncompressed=$local)=~ s/\.gz$//;IO::Uncompress::Gunzip::gunzip($local,$uncompressed)or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"}}}1;
MENLO_INDEX_MIRROR