[Cpan-forum-commit] rev 137 - trunk/bin

[svn at pti.co.il]

Author: gabor
Date: 2005-03-23 00:59:38 +0200 (Wed, 23 Mar 2005)
New Revision: 137

Added:
   trunk/bin/cpanratings.pl
Modified:
   trunk/bin/populate.pl
Log:
improve the populate script to sent out e-mails as well, add script to check the cpanratings names

Added: trunk/bin/cpanratings.pl
===================================================================
--- trunk/bin/cpanratings.pl	2005-03-22 21:25:13 UTC (rev 136)
+++ trunk/bin/cpanratings.pl	2005-03-22 22:59:38 UTC (rev 137)
@@ -0,0 +1,53 @@
+#!/opt/perl584/bin/perl
+use strict;
+use warnings;
+
+
+use lib "lib";
+use Text::CSV_XS;
+use CPAN::Forum::DBI;
+use CPAN::Forum::Groups;
+use FindBin qw ($Bin);
+
+my $dir = "$Bin/../db";
+
+my $csv    = Text::CSV_XS->new();
+my $file   = "$dir/cpan_ratings.csv";
+my $cnt    = 1;
+my $dbfile = "$dir/forum.db";
+
+CPAN::Forum::DBI->myinit($dbfile);
+
+
+open my $fh, $file or die "Could not open '$file'\n";
+my $line = <$fh>;
+chomp $line;
+
+die "File format changed\n" if $line ne '"distribution","rating","review_count"';
+my @header = ("distribution","rating","review_count");
+
+#my @groups = CPAN::Forum::Groups->retrieve_all();
+
+while (my $line = <$fh>) {
+	$cnt++;
+	if (not $csv->parse($line)) {
+		warn "ERROR in line $cnt " . $csv->error_input();
+		next;
+	}
+	my %field;
+	@field{@header} = $csv->fields();
+	my ($g) = CPAN::Forum::Groups->search(name => $field{distribution});
+	if ($g) {
+		#print "    FOUND\n";
+	} else {
+		print "$field{distribution}\n";
+		#print "    MISSING\n";
+	}
+
+	#<STDIN>;
+}
+
+sleep 10;
+
+
+

Modified: trunk/bin/populate.pl
===================================================================
--- trunk/bin/populate.pl	2005-03-22 21:25:13 UTC (rev 136)
+++ trunk/bin/populate.pl	2005-03-22 22:59:38 UTC (rev 137)
@@ -3,18 +3,28 @@
 use strict;
 use warnings;
 use lib "lib";
-use CPAN::Forum::DBI;
 use Parse::CPAN::Packages;
 use LWP::Simple;
 use FindBin qw ($Bin);
+use Text::CSV_XS;
+use Mail::Sendmail qw(sendmail);
 
+use CPAN::Forum::DBI;
+use CPAN::Forum::Groups;
 
-my $dir = "$Bin/../db";
-my $dbfile = "$dir/forum.db";
+
+
+
+my $dir          = "$Bin/../db";
+my $dbfile       = "$dir/forum.db";
+my $version_file = "$dir/cpan_versions.txt";
+
+my $csv    = Text::CSV_XS->new();
+
 CPAN::Forum::DBI->myinit($dbfile);
 
-use CPAN::Forum::Groups;
 
+
 my $source = shift @ARGV;
 print "This operation can take a couple of minutes\n";
 
@@ -39,12 +49,21 @@
 my @distributions = $p->distributions;
 
 
-#my @distributions = ("WWW::Mechanzie", "CGI::Upload", "CGI", "Class::DBI", "CGI::Application", "HTML::Template");  
-#my $global = CPAN::Forum::Groups->create({
-#	name => "Global",
-#	gtype => $CPAN::Forum::DBI::group_types{Global},
-#	});
+my %versions;
+open my $in, "<", $version_file or die "Could not open '$version_file' for reading $!\n";
+my $cnt = 0;
+while (my $line = <$in>) {
+	$cnt++;
+	if (not $csv->parse($line)) {
+		warn "ERROR in line $cnt " . $csv->error_input();
+		next;
+	}
+	my ($name, $version) = $csv->fields();
+	$versions{$name} = $version;
+}
 
+my $version_message = "";
+my $new_message = "";
 foreach my $d (@distributions) {
 
 	# skip scripts
@@ -56,20 +75,56 @@
 		#warn "No name: " . $d->prefix . "\n";
 		next;
 	}
-	#$name =~ s/-/::/g;
 	
-	# skip Acme ?
-	
 	# skip names that start with lower case
 	next if $name =~ /^[a-z]/;
 	
-	# skip existing names
-	#next if CPAN::Forum::Groups->search(name => $name);
+	my ($g) = CPAN::Forum::Groups->search(name => $name);
+	my $version = $d->version();
+
+	if ($g) {
+		if ($versions{$name} ne $version) {
+			# send e-mail to whoever asked for it.
+			$version_message .= "The version of $name has changed from $versions{$name} to $version\n";
+		}
+	} else {
+		$new_message .= "$name      $version\n";
+	}
+	$versions{$name} = $version;
+
+	next if $g;
 	eval {
 		my $dist = CPAN::Forum::Groups->create({
 			name => $name,
 			gtype => $CPAN::Forum::DBI::group_types{Distribution}, 
 		});
 	};
+	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 %versions) {
+	print $out qq("$name","$versions{$name}"\n);
+}
+
+my %mail = (
+	To       => 'gabor at pti.co.il',
+	From     => 'cpanforum at cpanforum.com',
+	Subject  => 'CPAN Version Update',
+	Message  => $version_message,
+);
+sendmail(%mail);
+
+%mail = (
+	To       => 'gabor at pti.co.il',
+	From     => 'cpanforum at cpanforum.com',
+	Subject  => 'New CPAN Distros',
+	Message  => $new_message,
+);
+sendmail(%mail);
+
+
+