[Cpan-forum-commit] rev 284 - in trunk: . lib/CPAN lib/CPAN/Forum/DB lib/CPAN/Forum/RM
svn at pti.co.il
svn at pti.co.il
Sat Jul 21 18:18:47 EEST 2007
Author: gabor
Date: 2007-07-21 18:18:46 +0300 (Sat, 21 Jul 2007)
New Revision: 284
Modified:
trunk/
trunk/lib/CPAN/Forum.pm
trunk/lib/CPAN/Forum/DB/Authors.pm
trunk/lib/CPAN/Forum/DB/Groups.pm
trunk/lib/CPAN/Forum/RM/Dist.pm
trunk/lib/CPAN/Forum/RM/Other.pm
trunk/lib/CPAN/Forum/RM/Tags.pm
Log:
refactor the Forum::process_missing_dist code and replace database
calls with plain SQL queries.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 7bc34947-122d-0410-bc5a-f898d2bb5f81:/local/cpan-forum:4276
8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:12752
+ 7bc34947-122d-0410-bc5a-f898d2bb5f81:/local/cpan-forum:4277
8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:12752
Modified: trunk/lib/CPAN/Forum/DB/Authors.pm
===================================================================
--- trunk/lib/CPAN/Forum/DB/Authors.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum/DB/Authors.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -16,4 +16,13 @@
return $self->_fetch_single_hashref($sql, uc $pauseid);
}
+sub add {
+ my ($self, $pauseid) = @_;
+ my $sql = "INSERT INTO authors (pauseid) VALUES (?)";
+ my $dbh = CPAN::Forum::DBI::db_Main();
+ $dbh->do($sql, undef, $pauseid);
+
+ return $self->get_author_by_pauseid($pauseid);
+}
+
1;
Modified: trunk/lib/CPAN/Forum/DB/Groups.pm
===================================================================
--- trunk/lib/CPAN/Forum/DB/Groups.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum/DB/Groups.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -14,8 +14,6 @@
__PACKAGE__->set_sql(count_like => "SELECT count(*) FROM __TABLE__ WHERE %s LIKE '%s'");
__PACKAGE__->set_sql(count => "SELECT count(*) FROM __TABLE__ WHERE %s = '%s'");
-#use Data::Dumper;
-#__PACKAGE__->add_trigger(before_update => sub {warn Dumper $_[0]});
sub info_by {
my ($self, $field, $value) = @_;
@@ -47,6 +45,15 @@
return $self->_fetch_hashref($sql, $value);
}
+sub add {
+ my ($self, %args) = @_;
+ my $sql = "INSERT INTO groups (name, version, gtype, pauseid) VALUES (?, ?, ?, ?)";
+ my $dbh = CPAN::Forum::DBI::db_Main();
+ $dbh->do($sql, undef, @args{qw(name version gtype pauseid)});
+ return $self->info_by(name => $args{name});
+}
+
+
1;
Modified: trunk/lib/CPAN/Forum/RM/Dist.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Dist.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum/RM/Dist.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -34,7 +34,7 @@
$t->param(group => $group_name);
$t->param(title => "CPAN Forum - $group_name");
- my ($gr) = CPAN::Forum::DB::Groups->search(name => $group_name);
+ my $gr = CPAN::Forum::DB::Groups->info_by(name => $group_name);
if (not $gr) {
$self->log->warning("Invalid group '$group_name'");
$gr = $self->process_missing_dist($group_name);
@@ -45,7 +45,7 @@
);
}
}
- my $gid = $gr->id;
+ my $gid = $gr->{id};
if ($gid =~ /^(\d+)$/) {
$gid = $1;
} else {
Modified: trunk/lib/CPAN/Forum/RM/Other.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Other.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum/RM/Other.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -39,7 +39,7 @@
sub stats {
my $self = shift;
my $t = $self->load_tmpl("stats.tmpl");
- my $groups = CPAN::Forum::DB::Posts->stat_posts_by_group(50);
+ my $groups = CPAN::Forum::DB::Posts->stat_posts_by_group(50); # SQL
#my @users = CPAN::Forum::DB::Posts->search_stat_posts_by_user(10);
#
# TODO: user stats removed as it was extreamly slow..
Modified: trunk/lib/CPAN/Forum/RM/Tags.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Tags.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum/RM/Tags.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -22,7 +22,7 @@
loop_context_vars => 1,
global_vars => 1,
);
- my $tags = CPAN::Forum::DB::Tags->get_all_tags();
+ my $tags = CPAN::Forum::DB::Tags->get_all_tags(); # SQL
# maximize tag size to 24
foreach my $t (@$tags) {
@@ -40,7 +40,7 @@
loop_context_vars => 1,
global_vars => 1,
);
- my $modules = CPAN::Forum::DB::Tags->get_modules_with_tag($value);
+ my $modules = CPAN::Forum::DB::Tags->get_modules_with_tag($value); # SQL
$t->param(tag => $value);
$t->param(modules => $modules);
return $t->output;
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2007-07-21 15:18:10 UTC (rev 283)
+++ trunk/lib/CPAN/Forum.pm 2007-07-21 15:18:46 UTC (rev 284)
@@ -12,6 +12,8 @@
use Mail::Sendmail qw(sendmail);
use CGI ();
use List::MoreUtils qw(any);
+use WWW::Mechanize;
+use CPAN::DistnameInfo;
use CPAN::Forum::INC;
use CPAN::Forum::DBI;
@@ -1578,7 +1580,63 @@
my ($self, $dist_name) = @_;
$self->log->debug("Fetch info regarding $dist_name from search.cpan.org");
- # Cehck if client is approved
+ return if not $self->_approved_client();
+
+ my $download_url = $self->_check_on_search_cpan_org($dist_name);
+ return if not $download_url;
+
+ my ($version, $pauseid) = $self->_check_dist_info($download_url, $dist_name);
+
+ my $author = CPAN::Forum::DB::Authors->get_author_by_pauseid($pauseid); # SQL
+ if (not $author) {
+ $author = eval { CPAN::Forum::DB::Authors->add( pauseid => $pauseid ) }; # SQL
+ }
+ if (not $author) {
+ $self->log->debug("Could not find or add author: '$pauseid'");
+ return;
+ }
+
+ my $group = eval { CPAN::Forum::DB::Groups->add( # SQL
+ name => $dist_name,
+ gtype => $CPAN::Forum::DBI::group_types{Distribution},
+ version => $version,
+ pauseid => $author->{id},
+ ); };
+ if ($group) {
+ $self->log->notice("Distribution $dist_name added");
+ return $group;
+ }
+ else {
+ $self->log->debug("Could not add distribution $dist_name: $@");
+ return;
+ }
+}
+
+sub _check_dist_info {
+ my ($self, $download_url, $dist_name) = @_;
+ my $d = CPAN::DistnameInfo->new($download_url);
+ if (not $d) {
+ $self->log->debug("Could not parse download URL");
+ return;
+ }
+ if ($dist_name ne $d->dist) {
+ $self->log->debug("Distname '$dist_name' is different from '" . $d->dist . "'");
+ return; # this was not here!!
+ }
+
+ my $pauseid = $d->cpanid;
+ if (not $pauseid) {
+ $self->log->debug("Could not get PAUSEID from download_url");
+ return;
+ }
+ return ($d->version, $pauseid);
+}
+
+
+sub _approved_client {
+ my ($self) = @_;
+
+ # Check if client is approved
my %IPS = (
'66.249.66.3' => 1, # GoogleBot
'65.55.213.74' => 1, # msnbot
@@ -1588,9 +1646,14 @@
$self->log->debug("Client $ENV{REMOTE_ADDR} is not in the approved list");
return;
}
+ return 1;
+}
+
+sub _check_on_search_cpan_org {
+ my ($self, $dist_name) = @_;
+
# Fetch page from search.cpan.org and do a sanity check
- require WWW::Mechanize;
my $w = WWW::Mechanize->new;
my $url = "http://search.cpan.org/dist/$dist_name/";
$self->log->debug("URL: '$url'");
@@ -1614,46 +1677,9 @@
}
my $download_url = $download_link->url;
$self->log->debug("Download url: $download_url");
- require CPAN::DistnameInfo;
- my $d = CPAN::DistnameInfo->new($download_url);
- if (not $d) {
- $self->log->debug("Could not parse download URL");
- return;
- }
- if ($dist_name ne $d->dist) {
- $self->log->debug("Distname $dist_name is different from " . $d->dist);
- }
-
- my $pauseid = $d->cpanid;
- if (not $pauseid) {
- $self->log->debug("Could not get PAUSEID from download_url");
- return;
- }
- my $author = eval { CPAN::Forum::DB::Authors->find_or_create({
- pauseid => $pauseid,
- }); };
- if (not $author) {
- $self->log->debug("Could not find_or_create author: '$pauseid'");
- return;
- }
-
- my $group = eval { CPAN::Forum::DB::Groups->create({
- name => $dist_name,
- gtype => $CPAN::Forum::DBI::group_types{Distribution},
- version => $d->version,
- pauseid => $author->id,
- }); };
- if ($group) {
- $self->log->notice("Distribution $dist_name added");
- return $group;
- }
- else {
- $self->log->debug("Could not add distribution $dist_name: $@");
- return;
- }
+ return $download_url;
}
-
sub version {
return $VERSION;
}
More information about the Cpan-forum-commit
mailing list