[Cpan-forum-commit] rev 159 - in trunk: . bin lib/CPAN t t/lib/CPAN/Forum
svn at pti.co.il
svn at pti.co.il
Fri Aug 25 18:14:14 IDT 2006
Author: gabor
Date: 2006-08-25 18:14:12 +0300 (Fri, 25 Aug 2006)
New Revision: 159
Modified:
trunk/
trunk/bin/populate.pl
trunk/bin/setup.pl
trunk/lib/CPAN/Forum.pm
trunk/t/001-users.t
trunk/t/lib/CPAN/Forum/Test.pm
Log:
bin/populate.pl now gets all its arguments using --options
bin/setup.pl now uses --options
improve the basic test
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
+ 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:10980
Modified: trunk/bin/populate.pl
===================================================================
--- trunk/bin/populate.pl 2006-08-20 20:28:03 UTC (rev 158)
+++ trunk/bin/populate.pl 2006-08-25 15:14:12 UTC (rev 159)
@@ -2,6 +2,7 @@
use strict;
use warnings;
+
use lib "lib";
use Parse::CPAN::Packages;
use LWP::Simple;
@@ -14,131 +15,133 @@
use CPAN::Forum::Groups;
-my $dir = "$Bin/../db";
-my $dbfile = "$dir/forum.db";
-my $csv = Text::CSV_XS->new();
-my %opts;
+my %opts = (
+ dir => "$Bin/../db",
+);
+GetOptions(\%opts, "sendmail", "source=s", "dir=s") or die;
+
+
+my $dbfile = "$opts{dir}/forum.db";
CPAN::Forum::DBI->myinit($dbfile);
-GetOptions(\%opts, "sendmail");
+my $csv = Text::CSV_XS->new();
-my $source = shift @ARGV;
print "This operation can take a couple of minutes\n";
-if (not $source) {
- my $file = "02packages.details.txt";
- $source = "$dir/$file";
+if (not $opts{source}) {
+ my $file = "02packages.details.txt";
+ $opts{source} = "$opts{dir}/$file";
- unlink $source if -e $source;
- # must have downloaded and un-gzip-ed
- # ~/mirror/cpan/modules/02packages.details.txt.gz
- print "Fecthing $file from CPAN\n";
- getstore("http://www.cpan.org/modules/02packages.details.txt.gz", "$source.gz");
- print "Unzipping $file\n";
- system("gunzip $source.gz");
+ unlink $opts{source} if -e $opts{source};
+ # must have downloaded and un-gzip-ed
+ # ~/mirror/cpan/modules/02packages.details.txt.gz
+ print "Fecthing $file from CPAN\n";
+ getstore("http://www.cpan.org/modules/02packages.details.txt.gz", "$opts{source}.gz");
+ print "Unzipping $file\n";
+ system("gunzip $opts{source}.gz");
}
-print "Processing $source file, adding distros to database, will take a few minutes\n";
+print "Processing $opts{source} file, adding distros to database, will take a few minutes\n";
print "Go get a beer\n";
-my $p = Parse::CPAN::Packages->new($source);
+my $p = Parse::CPAN::Packages->new($opts{source});
my @distributions = $p->distributions;
my %message = (
- version => "",
- pauseid => "",
- new => "",
+ version => "",
+ pauseid => "",
+ new => "",
);
foreach my $d (@distributions) {
- # skip scripts
- next if not $d->prefix or $d->prefix =~ m{^\w/\w\w/\w+/scripts/};
+ # skip scripts
+ next if not $d->prefix or $d->prefix =~ m{^\w/\w\w/\w+/scripts/};
- my $name = $d->dist;
- if (not $name) {
- #warn "No name: " . $d->prefix . "\n";
- next;
- }
-
- # for now skip names that start with lower case
- #next if $name =~ /^[a-z]/;
+ my $name = $d->dist;
+ if (not $name) {
+ #warn "No name: " . $d->prefix . "\n";
+ next;
+ }
+
+ # for now skip names that start with lower case
+ #next if $name =~ /^[a-z]/;
- my %new = (
- version => ($d->version() || ""),
- pauseid => ($d->cpanid() || ""),
- );
+ my %new = (
+ version => ($d->version() || ""),
+ pauseid => ($d->cpanid() || ""),
+ );
- my ($g) = CPAN::Forum::Groups->search(name => $name);
- if ($g) {
- my $changed;
- foreach my $field (qw(version pauseid)) {
- #print "$name\n";
- #print "NEW: $new{$field}\n";
- #print "OLD: " . $g->$field, "\n";
- #<STDIN>;
- if (not defined $g->$field or $g->$field ne $new{$field}) {
- #print "change\n";
- $message{$field} .= sprintf "The %s of %s has changed from %s to %s\n",
- $field, $name, ($g->$field || ""), $new{$field};
- $g->$field($new{$field});
- $changed++;
- }
- }
+ my ($g) = CPAN::Forum::Groups->search(name => $name);
+ if ($g) {
+ my $changed;
+ foreach my $field (qw(version pauseid)) {
+ #print "$name\n";
+ #print "NEW: $new{$field}\n";
+ #print "OLD: " . $g->$field, "\n";
+ #<STDIN>;
+ if (not defined $g->$field or $g->$field ne $new{$field}) {
+ #print "change\n";
+ $message{$field} .= sprintf "The %s of %s has changed from %s to %s\n",
+ $field, $name, ($g->$field || ""), $new{$field};
+ $g->$field($new{$field});
+ $changed++;
+ }
+ }
- $g->update if $changed;
- next;
- }
+ $g->update if $changed;
+ next;
+ }
- $message{new} .= sprintf "%s %s\n", $name, $new{version}, $new{pauseid};
- eval {
- my $g = CPAN::Forum::Groups->create({
- name => $name,
- gtype => $CPAN::Forum::DBI::group_types{Distribution},
- version => $new{version},
- pauseid => $new{pauseid},
- });
- };
- if ($@) {
- warn "$name\n";
- warn $@;
- }
+ $message{new} .= sprintf "%s %s\n", $name, $new{version}, $new{pauseid};
+ eval {
+ my $g = CPAN::Forum::Groups->create({
+ name => $name,
+ gtype => $CPAN::Forum::DBI::group_types{Distribution},
+ version => $new{version},
+ pauseid => $new{pauseid},
+ });
+ };
+ if ($@) {
+ warn "$name\n";
+ warn $@;
+ }
}
#open my $out, ">", $version_file or die "Could not open '$version_file' for writing $!\n";
#foreach my $name (sort keys %version) {
-# print $out qq("$name","$version{$name}"\n);
+# print $out qq("$name","$version{$name}"\n);
#}
my %mail = (
- To => 'gabor at pti.co.il',
- From => 'cpanforum at cpanforum.com',
- Subject => 'CPAN Version Update',
- Message => $message{version},
+ To => 'gabor at pti.co.il',
+ From => 'cpanforum at cpanforum.com',
+ Subject => 'CPAN Version Update',
+ Message => $message{version},
);
if ($opts{sendmail}) {
- sendmail(%mail);
+ sendmail(%mail);
} else {
- open my $fh, ">", "$Bin/../cpan_version_update";
- print $fh $message{version};
+ open my $fh, ">", "$Bin/../cpan_version_update";
+ print $fh $message{version};
}
%mail = (
- To => 'gabor at pti.co.il',
- From => 'cpanforum at cpanforum.com',
- Subject => 'New CPAN Distros',
- Message => $message{new},
+ To => 'gabor at pti.co.il',
+ From => 'cpanforum at cpanforum.com',
+ Subject => 'New CPAN Distros',
+ Message => $message{new},
);
if ($opts{sendmail}) {
- sendmail(%mail);
+ sendmail(%mail);
} else {
- open my $fh, ">", "$Bin/../cpan_new_distros";
- print $fh $message{new};
+ open my $fh, ">", "$Bin/../cpan_new_distros";
+ print $fh $message{new};
}
Modified: trunk/bin/setup.pl
===================================================================
--- trunk/bin/setup.pl 2006-08-20 20:28:03 UTC (rev 158)
+++ trunk/bin/setup.pl 2006-08-25 15:14:12 UTC (rev 159)
@@ -5,12 +5,15 @@
use lib "lib";
use CPAN::Forum::INC;
use Cwd qw(cwd);
+use Getopt::Long qw(GetOptions);
-my $config_file = shift;
-my $dir = shift or die "$0 CONFIG DB_DIR\n";
+my %opts;
+GetOptions(\%opts, "config=s", "dir=s") or die;
+die "$0 --config CONFIG --dir DB_DIR\n"
+ if not $opts{config} or not $opts{dir};
my %opt;
-open my $opt, $config_file or die "You need to create a CONFIG file. See README.\n";
+open my $opt, $opts{config} or die "You need to create a CONFIG file. See README.\n";
while (<$opt>) {
chomp ;
my ($k, $v) = split /=/;
@@ -31,9 +34,9 @@
}
-my $dbfile = "$dir/forum.db";
+my $dbfile = "$opts{dir}/forum.db";
unlink $dbfile if -e $dbfile;
-mkdir $dir if not -e $dir;
+mkdir $opts{dir} if not -e $opts{dir};
CPAN::Forum::DBI->myinit($dbfile);
CPAN::Forum::DBI->init_db("schema/schema.sql", $dbfile);
chmod 0755, $dbfile;
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2006-08-20 20:28:03 UTC (rev 158)
+++ trunk/lib/CPAN/Forum.pm 2006-08-25 15:14:12 UTC (rev 159)
@@ -180,6 +180,11 @@
=head2 Changes
+ bin/populate.pl now gets all its arguments using --options
+ bin/setup.pl now uses --options
+
+
+
Enable people to subscribe to all messages or all thread starters or all followups
Add a table called "subscription_all"
Modified: trunk/t/001-users.t
===================================================================
--- trunk/t/001-users.t 2006-08-20 20:28:03 UTC (rev 158)
+++ trunk/t/001-users.t 2006-08-25 15:14:12 UTC (rev 159)
@@ -15,7 +15,6 @@
ok(-e "blib/db/forum.db");
BEGIN { $tests += 1; }
}
-use CPAN::Forum;
my $w = CPAN::Forum::Test::get_mech();
my $url = CPAN::Forum::Test::get_url();
Modified: trunk/t/lib/CPAN/Forum/Test.pm
===================================================================
--- trunk/t/lib/CPAN/Forum/Test.pm 2006-08-20 20:28:03 UTC (rev 158)
+++ trunk/t/lib/CPAN/Forum/Test.pm 2006-08-25 15:14:12 UTC (rev 159)
@@ -11,22 +11,22 @@
my $ROOT = "blib";
our @users = (
- {
- username => 'abcder',
- email => 'qqrq at banana.com',
- },
+ {
+ username => 'abcder',
+ email => 'qqrq at banana.com',
+ },
);
sub setup_database {
- chdir "blib";
- copy "../t/CONFIG", ".";
- mkdir "schema";
- copy "../schema/schema.sql", "schema";
+ chdir "blib";
+ copy "../t/CONFIG", ".";
+ mkdir "schema";
+ copy "../schema/schema.sql", "schema";
- system "$^X ../bin/setup.pl CONFIG db";
- system "$^X ../bin/populate.pl ../t/02packages.details.txt";
+ system "$^X ../bin/setup.pl --config CONFIG --dir db";
+ system "$^X ../bin/populate.pl --source ../t/02packages.details.txt --dir db";
- chdir "..";
+ chdir "..";
}
sub get_mech {
More information about the Cpan-forum-commit
mailing list