diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/bin/cpandb')
| -rwxr-xr-x | Master/tlpkg/tlperl0/bin/cpandb | 272 |
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
+
|