Moving old tlperl prior to committing new one

git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 272 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl0/bin/cpandb b/Master/tlpkg/tlperl0/bin/cpandb
new file mode 100755
index 00000000000..46c07b939a1
--- /dev/null
+++ b/Master/tlpkg/tlperl0/bin/cpandb
@@ -0,0 +1,272 @@
+#!C:\strawberry\perl\bin\perl.exe 

+use strict;

+use warnings;

+use CPAN::SQLite;

+use CPAN::SQLite::Util qw(%chaps);

+use Getopt::Long;

+my ($CPAN, $setup, $help, $reindex, $index, $query,

+    $db_name, $db_dir, $module, $dist, $cpanid, $update);

+

+my $rc = GetOptions('CPAN=s' => \$CPAN,

+                    'db_name=s' => \$db_name,

+                    'db_dir=s' => \$db_dir,

+                    'setup' => \$setup,

+                    'update' => \$update,

+                    'help' => \$help,

+                    'module=s' => \$module,

+                    'dist=s' => \$dist,

+                    'cpanid=s' => \$cpanid,

+                    'reindex=s' => \$reindex);

+

+$query = ($module or $dist or $cpanid);

+$index = ($update or $reindex or $setup);

+

+if ($help or not $rc or not ($index or $query)) {

+    print <<"END";

+

+Setup, maintain, and search the CPAN::SQLite database

+Usage:

+   $^X $0 --setup

+   $^X $0 --update

+   $^X $0 --reindex dist_name

+

+   $^X $0 --module  Mod::Name

+   $^X $0 --dist  Distname

+   $^X $0 --cpanid  CPANID

+

+   $^X $0 --help

+END

+    exit(1);

+}

+

+if (defined $setup and defined $reindex) {

+  die "Must reindex on an exisiting database";

+}

+

+if ($index) {

+  my $obj = CPAN::SQLite->new(CPAN => $CPAN,

+                              setup => $setup,

+                              db_name => $db_name,

+                              db_dir => $db_dir,

+                              reindex => $reindex,

+                             );

+  $obj->index();

+}

+else {

+

+  my $max_results = 100;

+  my $obj = CPAN::SQLite->new(CPAN => $CPAN,

+                              db_name => $db_name,

+                              db_dir => $db_dir,

+                              max_results => $max_results);

+  my $results;

+

+  RESULTS : {

+    $module and do {

+      $obj->query(mode => 'module', name => $module);

+      $results = $obj->{results};

+      if (not $results) {

+        print qq{\nNo module by name of "$module" was found.\n};

+        print qq{Error: $obj->{error}\n} if $obj->{error};

+      }

+      else {

+        my $abs = $results->{mod_abs} || '';

+        my $dslip = '';

+        if (my $dslip_info = $results->{dslip_info}) {

+          foreach my $entry (@$dslip_info) {

+            $dslip .= "  $entry->{desc}: $entry->{what}\n";

+          }

+        }

+        my $chapter_desc = $results->{chapter_desc} || '';

+        print << "EOI";

+

+Module: $results->{mod_name}

+Abstract: $abs

+Version: $results->{mod_vers}

+Chapter: $chapter_desc

+Distribution: $results->{dist_name}

+CPAN author: $results->{cpanid}

+CPAN file: $results->{dist_file}

+Download: $results->{download}

+dslip info:

+$dslip

+EOI

+      }

+      last RESULTS;

+    };

+    $dist and do {

+      $obj->query(mode => 'dist', name => $dist);

+      $results = $obj->{results};

+      if (not $results) {

+        print qq{\nNo distribution by name of "$dist" was found.\n};

+        print qq{Error: $obj->{error}\n} if $obj->{error};

+      }

+      else {

+        my $abs = $results->{dist_abs} || '';

+        my $dslip = '';

+        if (my $dslip_info = $results->{dslip_info}) {

+          foreach my $entry (@$dslip_info) {

+            $dslip .= "  $entry->{desc}: $entry->{what}\n";

+          }

+        }

+        print << "EOI";

+

+Distribution: $results->{dist_name}

+Abstract: $abs

+Version: $results->{dist_vers}

+CPAN author: $results->{cpanid}

+CPAN file: $results->{dist_file}

+Download: $results->{download}

+dslip info:

+$dslip

+EOI

+      }

+      my $mods = $results->{mods};

+      if ($mods and (ref($mods) eq 'ARRAY')) {

+	print qq{\nProvided modules:\n};

+	foreach my $item(@$mods) {

+	  my $abs = $item->{mod_abs} || '';

+	  print qq{  $item->{mod_name}: $abs\n};

+	}

+      }

+      last RESULTS;

+    };

+    $cpanid and do {

+      $obj->query(mode => 'author', name => $cpanid);

+      $results = $obj->{results};

+      if (not $results) {

+        print qq{\nNo cpanid by name of "$cpanid" was found.\n};

+        print qq{Error: $obj->{error}\n} if $obj->{error};

+      }

+      else {

+        print << "EOI";

+

+CPANID: $results->{cpanid}

+Full Name: $results->{fullname}

+email: $results->{email}

+EOI

+      }

+      my $dists = $results->{dists};

+      if ($dists and (ref($dists) eq 'ARRAY')) {

+	print qq{\nAvailable distributions:\n};

+	foreach my $item(@$dists) {

+	  my $abs = $item->{dist_abs} || '';

+	  print qq{  $item->{dist_file}: $abs\n};

+	}

+      }

+      last RESULTS;

+    };

+  }

+}

+

+__END__

+

+=head1 NAME

+

+cpandb - interface to C<CPAN::SQLite>

+

+=head1 DESCRIPTION

+

+This script is an interface to the routines of

+L<CPAN::SQLite> for setting up, maintaining and

+searching a C<DBD::SQLite> database

+of CPAN. Available options can be grouped into

+three categories.

+

+=head2 Common options

+

+These are options which are common to both setting up

+and maintaining the database or performing queries on it.

+These are

+

+=over 3

+

+=item * C<--CPAN  '/path/to/CPAN'>

+

+This specifies the path to where the index files are

+to be stored. This could be a local CPAN mirror,

+defined here by the presence of a F<MIRRORED.BY> file beneath

+this directory, or a local directory in which to store

+these files from a remote CPAN mirror. In the latter case,

+the index files are fetched from a remote CPAN mirror,

+using the same list that C<CPAN.pm> uses, if this is

+configured, and are updated if they are more than one

+day old.

+

+If the C<CPAN> option is not given, it will default

+to C<cpan_home> of L<CPAN>, if this is configured,

+with the sources being found under C<keep_source_where>.

+A fatal error results if such a directory isn't found.

+Updates to these index files are assumed here to be

+handled by C<CPAN.pm>.

+

+=item * C<--db_name  'cpan-sqlite'>

+

+This is the name of the database that C<DBD::SQLite>

+will use. If not given, this defaults to C<cpandb-sqlite>.

+

+=item * C<--db_dir  '/path/to/db/dir'>

+

+This specifies the path to where the database file is

+found. If not given, it defaults to the

+C<cpan_home> directory of C<CPAN.pm>, if present, or to

+the directory in which the script was invoked.

+

+=back

+

+=head2 Indexing options

+

+These are options which are used for setting up and

+maintaining the database. These include

+

+=over 3

+

+=item * C<--setup>

+

+This specifies that the database is to be created and

+populated from the CPAN indices; any exisiting database

+will be overwritten.

+

+=item * C<--update>

+

+This is used to update an exisiting database,

+which must have first been created with the C<setup>

+option.

+

+=item * C<--reindex 'dist_name'>

+

+This specifies that the CPAN distribution C<dist_name>

+is to be reindexed.

+

+=back

+

+=head2 Querying options

+

+These options are used to query the database. Available

+options are

+

+=over 3

+

+=item * C<--module Mod::Name>

+

+This provides information on the specified module name.

+

+=item * C<--dist Dist-Name>

+

+This provides information on the specified distribution name.

+

+=item * C<--cpanid CPANID>

+

+This provides information on the specified CPAN author id

+

+=back

+

+All search terms are assumed to be exact matches in a

+case-insensitive manner.

+

+=head1 SEE ALSO

+

+L<CPAN::SQLite>.

+

+=cut

+