Skip to content

Commit ffa8a91

Browse files
perlpunkperlpunk
committed
Add support for YAML::PP(::LibYAML)
Also enable $LoadBlessed because they were set to false by default in YAML::XS/Syck/.pm
1 parent 869ebb8 commit ffa8a91

File tree

2 files changed

+68
-37
lines changed

2 files changed

+68
-37
lines changed

‎lib/CPAN.pm‎

Lines changed: 66 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -523,6 +523,9 @@ sub _flock {
523523

524524
sub _yaml_module () {
525525
my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
526+
# only for testing
527+
# $yaml_module = 'YAML::PP';
528+
# $yaml_module = 'YAML::PP::LibYAML';
526529
if (
527530
$yaml_module ne "YAML"
528531
&&
@@ -553,35 +556,53 @@ sub _yaml_loadfile {
553556
return +[] unless -s $local_file;
554557
my $yaml_module = _yaml_module;
555558
if ($CPAN::META->has_inst($yaml_module)) {
556-
# temporarily enable yaml code deserialisation
557-
no strict 'refs';
558-
# 5.6.2 could not do the local() with the reference
559-
# so we do it manually instead
560-
my $old_loadcode = ${"$yaml_module\::LoadCode"};
561-
${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
562-
563-
my ($code, @yaml);
564-
if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
565-
eval { @yaml = $code->($local_file); };
566-
if ($@) {
567-
# this shall not be done by the frontend
568-
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
569-
}
570-
} elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
571-
local *FH;
572-
unless (open FH, $local_file) {
573-
$CPAN::Frontend->mywarn("Could not open '$local_file': $!");
574-
return +[];
575-
}
576-
local $/;
577-
my $ystream = <FH>;
578-
eval { @yaml = $code->($ystream); };
579-
if ($@) {
580-
# this shall not be done by the frontend
581-
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
559+
560+
my @yaml;
561+
if ($yaml_module eq 'YAML::PP' or $yaml_module eq 'YAML::PP::LibYAML') {
562+
require YAML::PP::Schema::Perl;
563+
my $perl = YAML::PP::Schema::Perl->new(
564+
classes => [qw/ CPAN::URL CPAN::Distribution CPAN::Distrostatus CPAN::DeferredCode /],
565+
loadcode => $CPAN::Config->{yaml_load_code},
566+
tags => ['!perl', '!!perl'],
567+
);
568+
my $yp = $yaml_module->new(
569+
schema => ['+', $perl],
570+
);
571+
eval { @yaml = $yp->load_file($local_file) };
572+
}
573+
else {
574+
# temporarily enable yaml code deserialisation
575+
no strict 'refs';
576+
# 5.6.2 could not do the local() with the reference
577+
# so we do it manually instead
578+
my $old_loadcode = ${"$yaml_module\::LoadCode"};
579+
my $old_loadblessed = ${"$yaml_module\::LoadBlessed"};
580+
${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;
581+
${ "$yaml_module\::LoadBlessed" } = 1;
582+
my $code;
583+
if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
584+
eval { @yaml = $code->($local_file); };
585+
if ($@) {
586+
# this shall not be done by the frontend
587+
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
588+
}
589+
} elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
590+
local *FH;
591+
unless (open FH, $local_file) {
592+
$CPAN::Frontend->mywarn("Could not open '$local_file': $!");
593+
return +[];
594+
}
595+
local $/;
596+
my $ystream = <FH>;
597+
eval { @yaml = $code->($ystream); };
598+
if ($@) {
599+
# this shall not be done by the frontend
600+
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
601+
}
582602
}
603+
${"$yaml_module\::LoadCode"} = $old_loadcode;
604+
${"$yaml_module\::LoadBlessed"} = $old_loadblessed;
583605
}
584-
${"$yaml_module\::LoadCode"} = $old_loadcode;
585606
return \@yaml;
586607
} else {
587608
# this shall not be done by the frontend
@@ -595,16 +616,24 @@ sub _yaml_dumpfile {
595616
my($self,$local_file,@what) = @_;
596617
my $yaml_module = _yaml_module;
597618
if ($CPAN::META->has_inst($yaml_module)) {
598-
my $code;
599-
if (UNIVERSAL::isa($local_file, "FileHandle")) {
600-
$code = UNIVERSAL::can($yaml_module, "Dump");
601-
eval { print $local_file $code->(@what) };
602-
} elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
603-
eval { $code->($local_file,@what); };
604-
} elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
605-
local *FH;
606-
open FH, ">$local_file" or die "Could not open '$local_file': $!";
607-
print FH $code->(@what);
619+
if ($yaml_module eq 'YAML::PP' or $yaml_module eq 'YAML::PP::LibYAML') {
620+
my $yp = $yaml_module->new(
621+
schema => [qw/ + Perl /],
622+
);
623+
eval { $yp->dump_file($local_file, @what) };
624+
}
625+
else {
626+
my $code;
627+
if (UNIVERSAL::isa($local_file, "FileHandle")) {
628+
$code = UNIVERSAL::can($yaml_module, "Dump");
629+
eval { print $local_file $code->(@what) };
630+
} elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
631+
eval { $code->($local_file,@what); };
632+
} elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
633+
local *FH;
634+
open FH, ">$local_file" or die "Could not open '$local_file': $!";
635+
print FH $code->(@what);
636+
}
608637
}
609638
if ($@) {
610639
die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);

‎t/31sessions.t‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -357,6 +357,8 @@ EOF
357357
"get CPAN::Test::Dummy::Perl5::Build::Fails" => "Has already been unwrapped",
358358
"make CPAN::Test::Dummy::Perl5::Build::Fails" => "Has.already.been.unwrapped",
359359
"test CPAN::Test::Dummy::Perl5::Build::Fails" => "(?i:t/00_load.+FAILED)",
360+
"o conf dontload_list push YAML::PP" => ".",
361+
"o conf dontload_list push YAML::PP::LibYAML" => ".",
360362
"o conf dontload_list push YAML" => ".",
361363
"o conf dontload_list push YAML::Syck" => ".",
362364
"o conf dontload_list push Parse::CPAN::Meta" => ".",

0 commit comments

Comments
 (0)