Upgrade to CPAN-1.83_66.

p4raw-id: //depot/perl@29625

7 files changed, 363 insertions, 15 deletions

diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 724895820d..9490934b95 100644
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -2,7 +2,7 @@
 package CPAN::Mirrored::By;
 use strict;
 
-sub new { 
+sub new {
     my($self,@arg) = @_;
     bless [@arg], $self;
 }
@@ -19,7 +19,7 @@ use File::Basename ();
 use File::Path ();
 use File::Spec ();
 use vars qw($VERSION $urllist);
-$VERSION = sprintf "%.6f", substr(q$Rev: 1257 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 1379 $,4)/1000000 + 5.4;
 
 =head1 NAME
 
@@ -264,6 +264,7 @@ Shall we use it as the general CPAN build and cache directory?
     #
 
     my_yn_prompt(cache_metadata => 1, $matcher);
+    my_yn_prompt(use_sqlite => 0, $matcher);
 
     #
     #= Do we follow PREREQ_PM?
@@ -1064,10 +1065,23 @@ To considerably speed up the initial CPAN shell startup, it is
 possible to use Storable to create a cache of metadata. If Storable
 is not available, the normal index mechanism will be used.
 
+Note: this mechanism is not used when use_sqlite is on and SQLLite is
+running.
+
 },
 
 cache_metadata => qq{Cache metadata (yes/no)?},
 
+use_sqlite_intro => qq{
+
+CPAN::SQLite is a layer between the index files that are downloaded
+from the CPAN and CPAN.pm that speeds up metadata queries and reduces
+memory consumption of CPAN.pm considereably.
+
+},
+
+use_sqlite => qq{Use CPAN::SQLite if available? (yes/no)?},
+
 term_is_latin_intro => qq{
 
 The next option deals with the charset (aka character set) your
diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm
index cdd276a3a3..3d03b56cf0 100644
--- a/lib/CPAN/HandleConfig.pm
+++ b/lib/CPAN/HandleConfig.pm
@@ -2,7 +2,7 @@ package CPAN::HandleConfig;
 use strict;
 use vars qw(%can %keys $VERSION);
 
-$VERSION = sprintf "%.6f", substr(q$Rev: 1315 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 1379 $,4)/1000000 + 5.4;
 
 %can = (
         commit   => "Commit changes to disk",
@@ -76,6 +76,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev: 1315 $,4)/1000000 + 5.4;
      "test_report",
      "unzip",
      "urllist",
+     "use_sqlite",
      "username",
      "wait_list",
      "wget",
@@ -333,7 +334,7 @@ sub defaults {
     for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) {
         if ($INC{$config}) {
             CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG;
-            CPAN::Shell->reload_this($config,{force => 1});
+            CPAN::Shell->_reload_this($config,{reloforce => 1});
             $CPAN::Frontend->myprint("'$INC{$config}' reread\n");
             last;
         }
@@ -652,7 +653,7 @@ sub prefs_lookup {
 
     use strict;
     use vars qw($AUTOLOAD $VERSION);
-    $VERSION = sprintf "%.2f", substr(q$Rev: 1315 $,4)/100;
+    $VERSION = sprintf "%.2f", substr(q$Rev: 1379 $,4)/100;
 
     # formerly CPAN::HandleConfig was known as CPAN::Config
     sub AUTOLOAD {
diff --git a/lib/CPAN/Kwalify.pm b/lib/CPAN/Kwalify.pm
new file mode 100644
index 0000000000..b2dfcf64ea
--- /dev/null
+++ b/lib/CPAN/Kwalify.pm
@@ -0,0 +1,126 @@
+=head1 NAME
+
+CPAN::Kwalify - Interface between CPAN.pm and Kwalify.pm
+
+=head1 SYNOPSIS
+
+  use CPAN::Kwalify;
+  validate($schema_name, $data, $file, $doc);
+
+=head1 DESCRIPTION
+
+=over
+
+=item _validate($schema_name, $data, $file, $doc)
+
+$schema_name is the name of a supported schema. Currently only
+C<distroprefs> is supported. $data is the data to be validated. $file
+is the absolute path to the file the data are coming from. $doc is the
+index of the document within $doc that is to be validated. The last
+two arguments are only there for better error reporting.
+
+Relies on being called from within CPAN.pm.
+
+Dies if something fails. Does not return anything useful.
+
+=item yaml($schema_name)
+
+Returns the YAML text of that schema. Dies if something fails.
+
+=back
+
+=head1 AUTHOR
+
+Andreas Koenig C<< <andk@cpan.org> >>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+
+
+=cut
+
+
+use strict;
+
+package CPAN::Kwalify;
+use vars qw($VERSION);
+$VERSION = sprintf "%.6f", substr(q$Rev: 1418 $,4)/1000000 + 5.4;
+
+use File::Spec ();
+
+my %vcache = ();
+
+my $schema_loaded = {};
+
+sub _validate {
+    my($schema_name,$data,$abs,$y) = @_;
+    my $yaml_module = CPAN->_yaml_module;
+    if (
+        $CPAN::META->has_inst($yaml_module)
+        &&
+        $CPAN::META->has_inst("Kwalify")
+       ) {
+        my $load = UNIVERSAL::can($yaml_module,"Load");
+        unless ($schema_loaded->{$schema_name}) {
+            eval {
+                my $schema_yaml = yaml($schema_name);
+                $schema_loaded->{$schema_name} = $load->($schema_yaml);
+            };
+            if ($@) {
+                # we know that YAML.pm 0.62 cannot parse the schema,
+                # so we try a fallback
+                my $content = do {
+                    my $path = __FILE__;
+                    $path =~ s/\.pm$//;
+                    $path = File::Spec->catfile($path, "$schema_name.dd");
+                    local *FH;
+                    open FH, $path or die "Could not open '$path': $!";
+                    local $/;
+                    <FH>;
+                };
+                our $VAR1 = undef;
+                eval $content;
+                die "parsing of '$schema_name.dd' failed: $@" if $@;
+                $schema_loaded->{$schema_name} = $VAR1;
+            }
+        }
+    }
+    if (my $schema = $schema_loaded->{$schema_name}) {
+        my $mtime = (stat $abs)[9];
+        for my $k (keys %{$vcache{$abs}}) {
+            delete $vcache{$abs}{$k} unless $k eq $mtime;
+        }
+        return if $vcache{$abs}{$mtime}{$y}++;
+        eval { Kwalify::validate($schema, $data) };
+        if ($@) {
+            die "validation of distropref '$abs'[$y] failed: $@";
+        }
+    }
+}
+
+sub yaml {
+    my($schema_name) = @_;
+    my $content = do {
+        my $path = __FILE__;
+        $path =~ s/\.pm$//;
+        $path = File::Spec->catfile($path, "$schema_name.yml");
+        local *FH;
+        open FH, $path or die "Could not open '$path': $!";
+        local $/;
+        <FH>;
+    };
+    return $content;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# End:
+
diff --git a/lib/CPAN/Kwalify/distroprefs.dd b/lib/CPAN/Kwalify/distroprefs.dd
new file mode 100644
index 0000000000..480e7d99ea
--- /dev/null
+++ b/lib/CPAN/Kwalify/distroprefs.dd
@@ -0,0 +1,121 @@
+$VAR1 = {
+  "mapping" => {
+    "disabled" => {
+      "enum" => [
+        0,
+        1
+      ],
+      "type" => "int"
+    },
+    "test" => {
+      "mapping" => {
+        "eexpect" => {
+          "mapping" => {
+            "talk" => {
+              "sequence" => [
+                {
+                  "type" => "text"
+                }
+              ],
+              "type" => "seq"
+            },
+            "timeout" => {
+              "type" => "number"
+            },
+            "mode" => {
+              "enum" => [
+                "deterministic",
+                "anyorder"
+              ],
+              "type" => "text"
+            }
+          },
+          "type" => "map"
+        },
+        "env" => {
+          "mapping" => {
+            "=" => {
+              "type" => "text"
+            }
+          },
+          "type" => "map"
+        },
+        "args" => {
+          "sequence" => [
+            {
+              "type" => "text"
+            }
+          ],
+          "type" => "seq"
+        },
+        "expect" => {
+          "sequence" => [
+            {
+              "type" => "text"
+            }
+          ],
+          "type" => "seq"
+        },
+        "commandline" => {
+          "type" => "text"
+        }
+      },
+      "type" => "map"
+    },
+    "make" => {},
+    "cpan_config" => {
+      "mapping" => {
+        "prefer_installer" => {
+          "enum" => [
+            "EUMM",
+            "MB"
+          ],
+          "type" => "text"
+        }
+      },
+      "type" => "map"
+    },
+    "install" => {},
+    "match" => {
+      "mapping" => {
+        "perl" => {
+          "type" => "text"
+        },
+        "module" => {
+          "type" => "text"
+        },
+        "distribution" => {
+          "type" => "text"
+        }
+      },
+      "type" => "map"
+    },
+    "pl" => {},
+    "comment" => {
+      "type" => "text"
+    },
+    "cpanconfig" => {
+      "mapping" => {
+        "=" => {
+          "type" => "text"
+        }
+      },
+      "type" => "map"
+    },
+    "goto" => {
+      "type" => "text"
+    },
+    "patches" => {
+      "sequence" => [
+        {
+          "type" => "text"
+        }
+      ],
+      "type" => "seq"
+    }
+  },
+  "type" => "map"
+};
+$VAR1->{"mapping"}{"make"} = $VAR1->{"mapping"}{"test"};
+$VAR1->{"mapping"}{"install"} = $VAR1->{"mapping"}{"test"};
+$VAR1->{"mapping"}{"pl"} = $VAR1->{"mapping"}{"test"};
diff --git a/lib/CPAN/Kwalify/distroprefs.yml b/lib/CPAN/Kwalify/distroprefs.yml
new file mode 100644
index 0000000000..234bdb0b12
--- /dev/null
+++ b/lib/CPAN/Kwalify/distroprefs.yml
@@ -0,0 +1,74 @@
+--- 
+type: map
+mapping:
+  comment:
+    type: text
+  match:
+    type: map
+    mapping:
+      distribution:
+        type: text
+      module:
+        type: text
+      perl:
+        type: text
+  cpan_config:
+    type: map
+    mapping:
+      prefer_installer:
+        type: text
+        enum:
+          - EUMM
+          - MB
+  install:
+    &args_env_expect
+    type: map
+    mapping:
+      args:
+        type: seq
+        sequence:
+          - type: text
+      commandline:
+        type: text
+      env:
+        type: map
+        mapping:
+          =:
+            type: text
+      expect:
+        type: seq
+        sequence:
+          - type: text
+      eexpect:
+        type: map
+        mapping:
+          mode:
+            type: text
+            enum:
+              - deterministic
+              - anyorder
+          timeout:
+            type: number
+          talk:
+            type: seq
+            sequence:
+              - type: text
+  make: *args_env_expect
+  pl:   *args_env_expect
+  test: *args_env_expect
+  patches:
+    type: seq
+    sequence:
+      - type: text
+  disabled:
+    type: int
+    enum:
+      - 0
+      - 1
+  goto:
+    type: text
+  cpanconfig:
+    type: map
+    mapping:
+      =:
+        type: text
diff --git a/lib/CPAN/Version.pm b/lib/CPAN/Version.pm
index 68ab9c168e..d2791349be 100644
--- a/lib/CPAN/Version.pm
+++ b/lib/CPAN/Version.pm
@@ -2,7 +2,7 @@ package CPAN::Version;
 
 use strict;
 use vars qw($VERSION);
-$VERSION = sprintf "%.6f", substr(q$Rev: 950 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 1387 $,4)/1000000 + 5.4;
 
 # CPAN::Version::vcmp courtesy Jost Krieger
 sub vcmp {
@@ -19,7 +19,7 @@ sub vcmp {
   for ($l,$r) {
       next unless tr/.// > 1;
       s/^v?/v/;
-      1 while s/\.0+(\d)/.$1/;
+      1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
   }
   CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
   if ($l=~/^v/ <=> $r=~/^v/) {
@@ -29,16 +29,23 @@ sub vcmp {
       }
   }
   CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
+  my $lvstring = "v0";
+  my $rvstring = "v0";
+  if ($] >= 5.006
+      && $l =~ /^v/
+      && $r =~ /^v/) {
+    $lvstring = $self->vstring($l);
+    $rvstring = $self->vstring($r);
+    CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG;
+  }
 
   return (
-          ($l ne "undef") <=> ($r ne "undef") ||
-          (
-           $] >= 5.006 &&
-           $l =~ /^v/ &&
-           $r =~ /^v/ &&
-           $self->vstring($l) cmp $self->vstring($r)
-          ) ||
-          $l <=> $r ||
+          ($l ne "undef") <=> ($r ne "undef")
+          ||
+          $lvstring cmp $rvstring
+          ||
+          $l <=> $r
+          ||
           $l cmp $r
          );
 }
diff --git a/lib/CPAN/t/10version.t b/lib/CPAN/t/10version.t
index 0827633df8..c61ff0d91a 100644
--- a/lib/CPAN/t/10version.t
+++ b/lib/CPAN/t/10version.t
@@ -4,6 +4,10 @@ use strict;
 use CPAN::Version;
 use vars qw($D $N);
 
+# for debugging uncomment the next two lines
+# use CPAN;
+# $CPAN::DEBUG = 16384;
+
 while (<DATA>) {
   next if tr/.// > 1 && $]<5.006; # multidot tests are not for pre-5.6.0
   last if /^__END__$/;
@@ -92,6 +96,7 @@ v1.0.22 122 -1
 0.005.018 0.005018 0
 4.008.000 4.008000 0
 4.008.000 4.008 1
+v1.99.1_1 1.98 -1
 __END__
 
 # Local Variables: