[Bps-public-commit] cpan2rt branch, master, updated. 3a35d83c09f4e4951c60860766346ae3fe63d589
Ruslan Zakirov
ruz at bestpractical.com
Mon Jun 7 20:04:28 EDT 2010
The branch, master has been updated
via 3a35d83c09f4e4951c60860766346ae3fe63d589 (commit)
via eb08758165a1b85f82ff43a73525e49c5e0b1181 (commit)
via 5900ab692918f55ae55b14941e56ea244bbd9f8d (commit)
via ba5a50b4addf2ad442ac64ce48fb31ea90aa2082 (commit)
via 8c2581f8ef64b7833ab0e79df646b5ebd6cbf362 (commit)
via 2ca1a45a1726faf5c3675e7f375deb4a0364c606 (commit)
via dedd1e05b695435ed5ba871b0466cd1a7b73320a (commit)
via d82ea762cf254684005aac4517ea14b66e0025ce (commit)
from 4a5e320350da6bc48438d8703bce424b29dfe07b (commit)
Summary of changes:
lib/CPAN2RT.pm | 155 +++++++++++++++++++++++++++++++------------
lib/CPAN2RT/Test.pm | 40 +++++++++++
t/basics.t | 8 ++
t/fix_users.t | 183 +++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 342 insertions(+), 44 deletions(-)
create mode 100644 lib/CPAN2RT/Test.pm
create mode 100644 t/basics.t
create mode 100644 t/fix_users.t
- Log -----------------------------------------------------------------
commit d82ea762cf254684005aac4517ea14b66e0025ce
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Jun 7 21:02:59 2010 +0400
module for testing
diff --git a/lib/CPAN2RT/Test.pm b/lib/CPAN2RT/Test.pm
new file mode 100644
index 0000000..e4e13d0
--- /dev/null
+++ b/lib/CPAN2RT/Test.pm
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+
+package CPAN2RT::Test;
+
+our @ISA;
+BEGIN {
+ local $@;
+ eval { require RT::Test; 1 } or do {
+ require Test::More;
+ Test::More::BAIL_OUT(
+ "requires 3.8 to run tests. Error:\n$@\n"
+ ."You may need to set PERL5LIB=/path/to/rt/lib"
+ );
+ };
+ push @ISA, 'RT::Test';
+}
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ $args{'requires'} ||= [];
+ if ( $args{'testing'} ) {
+ unshift @{ $args{'requires'} }, 'CPAN2RT';
+ } else {
+ $args{'testing'} = 'CPAN2RT';
+ }
+ unshift @{ $args{'requires'} }, 'RT::Extension::MergeUsers';
+
+ $class->SUPER::import( %args );
+ $class->export_to_level(1);
+
+ require CPAN2RT;
+}
+
+1;
commit dedd1e05b695435ed5ba871b0466cd1a7b73320a
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Jun 7 21:04:21 2010 +0400
first tests for importer
diff --git a/t/basics.t b/t/basics.t
new file mode 100644
index 0000000..3a91442
--- /dev/null
+++ b/t/basics.t
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CPAN2RT::Test tests => 28;
+ok( my $importer = CPAN2RT->new( ), "created importer" );
+
diff --git a/t/fix_users.t b/t/fix_users.t
new file mode 100644
index 0000000..5610fad
--- /dev/null
+++ b/t/fix_users.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CPAN2RT::Test tests => 28;
+my $test_class = 'CPAN2RT::Test';
+
+ok( my $importer = CPAN2RT->new( ), "created importer" );
+
+# user has no email and no other user with his cpan email
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'A',
+ Privileged => 1,
+ );
+ $importer->load_or_create_user(
+ A => 'A A' => 'A at xxx.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('A');
+ is( $user->Name, 'A', 'Name is correct' );
+ is( $user->RealName, 'A A', 'Real name updated' );
+ is( $user->EmailAddress, 'A at cpan.org', 'Email address is set to cpan\'s' );
+}
+
+# user has email and it's no his cpan's
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'B',
+ EmailAddress => 'B at xxx.com',
+ Privileged => 1,
+ );
+ $importer->load_or_create_user(
+ B => 'B B' => 'B at yyy.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('B');
+ is( $user->Name, 'B', 'Name is correct' );
+ is( $user->RealName, 'B B', 'Real name updated' );
+ is( $user->EmailAddress, 'B at xxx.com', 'Email address left alone' );
+
+ my $merged_user = RT::User->new( $RT::SystemUser );
+ $merged_user->LoadByEmail('B at cpan.org');
+
+ is( $merged_user->id, $user->id, 'merged user with email B at cpan.org has been created' );
+
+}
+
+
+# no 'C' user, but user with 'C at cpan.org'
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'C at cpan.org',
+ EmailAddress => 'C at cpan.org',
+ Privileged => 1,
+ );
+ $importer->load_or_create_user(
+ C => 'C C' => 'C at xxx.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('C');
+ is( $user->Name, 'C', 'Name is correct' );
+ is( $user->RealName, 'C C', 'Real name updated' );
+ is( $user->EmailAddress, 'C at cpan.org', 'Email address is correct' );
+}
+
+# user has email @cpan.org, but it doesn't match his CPANID
+# some people use it as spam protection
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'D',
+ EmailAddress => 'QWE at cpan.org',
+ Privileged => 1,
+ );
+ $importer->load_or_create_user(
+ D => 'D D' => 'QWE at cpan.org',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('D');
+ is( $user->Name, 'D', 'Name is correct' );
+ is( $user->RealName, 'D D', 'Real name updated' );
+ is( $user->EmailAddress, 'D at cpan.org', 'Email address has been changed' );
+
+ $user = RT::User->new( $RT::SystemUser );
+ $user->LoadByEmail('QWE at cpan.org');
+ ok(!$user->id, "no more fake user");
+}
+
commit 2ca1a45a1726faf5c3675e7f375deb4a0364c606
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 00:29:03 2010 +0400
more tests
diff --git a/t/fix_users.t b/t/fix_users.t
index 5610fad..036a789 100644
--- a/t/fix_users.t
+++ b/t/fix_users.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use CPAN2RT::Test tests => 28;
+use CPAN2RT::Test tests => 38;
my $test_class = 'CPAN2RT::Test';
ok( my $importer = CPAN2RT->new( ), "created importer" );
@@ -22,6 +22,10 @@ ok( my $importer = CPAN2RT->new( ), "created importer" );
is( $user->Name, 'A', 'Name is correct' );
is( $user->RealName, 'A A', 'Real name updated' );
is( $user->EmailAddress, 'A at cpan.org', 'Email address is set to cpan\'s' );
+
+ $user = RT::User->new( $RT::SystemUser );
+ $user->LoadByEmail('A at xxx.com');
+ ok(!$user->id, "no user by public email");
}
# user has email and it's no his cpan's
@@ -87,3 +91,93 @@ ok( my $importer = CPAN2RT->new( ), "created importer" );
ok(!$user->id, "no more fake user");
}
+# good 'E' user with E at cpan.org email
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'E',
+ EmailAddress => 'E at cpan.org',
+ Privileged => 1,
+ );
+ $importer->load_or_create_user(
+ E => 'E E' => 'E at xxx.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('E');
+ is( $user->Name, 'E', 'Name is correct' );
+ is( $user->RealName, 'E E', 'Real name updated' );
+ is( $user->EmailAddress, 'E at cpan.org', 'Email address is correct' );
+
+ $user = RT::User->new( $RT::SystemUser );
+ $user->LoadByEmail('E at xxx.com');
+ ok(!$user->id, "no user by public email");
+}
+
+# no user at all
+{
+ $importer->load_or_create_user(
+ F => 'F F' => 'F at xxx.com',
+ );
+ my $user = RT::User->new( $RT::SystemUser );
+ $user->Load('F');
+ is( $user->Name, 'F', 'Name is correct' );
+ is( $user->RealName, 'F F', 'Real is set' );
+ is( $user->EmailAddress, 'F at cpan.org', 'Email address is correct' );
+
+ $user = RT::User->new( $RT::SystemUser );
+ $user->LoadByEmail('F at xxx.com');
+ ok(!$user->id, "no user by public email");
+}
+
+# 'G' user with some email and G at cpan.org user with G at cpan.org email
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'G',
+ EmailAddress => 'G at xxx.com',
+ Privileged => 1,
+ );
+ $user = $test_class->load_or_create_user(
+ Name => 'G at cpan.org',
+ EmailAddress => 'G at cpan.org',
+ Privileged => 1,
+ );
+
+ $importer->load_or_create_user(
+ G => 'G G' => 'G at xxx.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('G');
+ is( $user->Name, 'G', 'Name is correct' );
+ is( $user->RealName, 'G G', 'Real name updated' );
+ is( $user->EmailAddress, 'G at xxx.com', 'Email address is correct' );
+
+ my $muser = RT::User->new( $RT::SystemUser );
+ $muser->LoadByEmail('G at cpan.org');
+ is($muser->id, $user->id, "users are merged");
+}
+
+# 'H' user with no email and H at cpan.org user with H at cpan.org email
+{
+ my $user = $test_class->load_or_create_user(
+ Name => 'H',
+ Privileged => 1,
+ );
+ $user = $test_class->load_or_create_user(
+ Name => 'H at cpan.org',
+ EmailAddress => 'H at cpan.org',
+ Privileged => 1,
+ );
+
+ $importer->load_or_create_user(
+ H => 'H H' => 'H at xxx.com',
+ );
+ $user = RT::User->new( $RT::SystemUser );
+ $user->Load('H');
+ is( $user->Name, 'H', 'Name is correct' );
+ is( $user->RealName, 'H H', 'Real name updated' );
+ is( $user->EmailAddress, 'H at cpan.org', 'Email address is correct' );
+
+ my $muser = RT::User->new( $RT::SystemUser );
+ $muser->LoadByCols( Name => 'H at cpan.org' );
+ is($muser->id, $user->id, "users are merged");
+}
+
commit 8c2581f8ef64b7833ab0e79df646b5ebd6cbf362
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 00:43:43 2010 +0400
make module more re-usable as API
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 1a1b0c8..63bff70 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -68,9 +68,11 @@ See options in description of L</new>.
sub init {
my $self = shift;
- my $home = ($self->{'home'} ||= $ENV{'RTHOME'} || '/opt/rt3');
- unshift @INC, File::Spec->catdir( $home, 'lib' );
- unshift @INC, File::Spec->catdir( $home, 'local', 'lib' );
+ my $home = ($self->{'home'} ||= $ENV{'RTHOME'});
+ if ( $home ) {
+ unshift @INC, File::Spec->catdir( $home, 'lib' );
+ unshift @INC, File::Spec->catdir( $home, 'local', 'lib' );
+ }
$DEBUG = $self->{'debug'};
commit ba5a50b4addf2ad442ac64ce48fb31ea90aa2082
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 00:44:32 2010 +0400
use RT->Config->Set
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 63bff70..8cca211 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -79,9 +79,9 @@ sub init {
require RT;
RT::LoadConfig();
if ( $DEBUG ) {
- $RT::LogToScreen = 'debug';
+ RT->Config->Set( LogToScreen => 'debug' );
} else {
- $RT::LogToScreen = 'warning';
+ RT->Config->Set( LogToScreen => 'warning' );
}
RT::Init();
}
commit 5900ab692918f55ae55b14941e56ea244bbd9f8d
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 00:45:05 2010 +0400
we depend on MergeUsers extension
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 8cca211..8ac12d1 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -84,6 +84,10 @@ sub init {
RT->Config->Set( LogToScreen => 'warning' );
}
RT::Init();
+
+ unless ( RT::User->can('MergeInto') ) {
+ die "CPAN2RT needs RT::Extension::MergeUsers to work properly";
+ }
}
sub sync_files {
commit eb08758165a1b85f82ff43a73525e49c5e0b1181
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 00:47:22 2010 +0400
switch to more reliable mirror by default
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 8ac12d1..5342c87 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -92,7 +92,7 @@ sub init {
sub sync_files {
my $self = shift;
- my $mirror = shift || $self->{'mirror'} || 'ftp://ftp.funet.fi/pub/CPAN';
+ my $mirror = shift || $self->{'mirror'} || 'http://cpan.perl.org';
debug { "Syncing files from '$mirror'\n" };
commit 3a35d83c09f4e4951c60860766346ae3fe63d589
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Jun 8 03:08:47 2010 +0400
refactor load_or_create_user to match new rules
diff --git a/lib/CPAN2RT.pm b/lib/CPAN2RT.pm
index 5342c87..e4941df 100644
--- a/lib/CPAN2RT.pm
+++ b/lib/CPAN2RT.pm
@@ -569,53 +569,114 @@ sub add_versions {
sub load_or_create_user {
my $self = shift;
- my ($cpanid, $realname, $email) = @_;
+ my ($cpanid, $realname, $public_email) = @_;
+
+ my $user = $self->load_and_fix_user( $cpanid, $public_email);
+ if ( $user ) {
+ if ( $realname && $realname ne ($user->RealName||'') ) {
+ my ($status, $msg) = $user->SetRealName( $realname );
+ $RT::Logger->warning("Couldn't set ${cpanid}'s real name: $msg")
+ unless $status;
+ }
+
+ return $user;
+ }
+ return $self->create_user($cpanid, $realname, $cpanid .'@cpan.org');
+}
+
+sub load_and_fix_user {
+ my $self = shift;
+ my ($cpanid, $public_email) = @_;
+
+ # WARNING: We can not trust public email addresses people publish
+ # on PAUSE. They are not validated in any way! That's it.
+
+ my $cpan_email = $cpanid .'@cpan.org';
+
+ # quick test for case when Name and Email are cosher in one record
+ {
+ my $tmp = RT::User->new( $RT::SystemUser );
+ $tmp->LoadByCols( Name => $cpanid, EmailAddress => $cpan_email );
+ if ( $tmp->id ) {
+ $RT::Logger->debug(
+ "User record with name '$cpanid'"
+ ." and email '$cpan_email' exists."
+ );
+ return $tmp;
+ }
+ }
my $bycpanid = RT::User->new($RT::SystemUser);
- $bycpanid->LoadByCol( Name => $cpanid );
+ $bycpanid->LoadByCols( Name => $cpanid );
- # WARNING: when MergeUser extension is used then the same user records
- # will be loaded even when there are multiple records in the DB
- $email = $self->parse_email_address( $email ) || "$cpanid\@cpan.org";
my $byemail = RT::User->new( $RT::SystemUser );
- $byemail->LoadByEmail( $email );
+ $byemail->LoadByEmail( $cpan_email );
- if ( $bycpanid->id && (($byemail->id && $bycpanid->id == $byemail->id) || !$byemail->id) ) {
- # the same users, both cpanid and email...
- # or email change, so no user with new email...
- #
- # XXX: as we have no way to detect email changes on PAUSE
- # then we set email to the public version from PAUSE only when
- # user in RT has no email. The same applies to name.
- $bycpanid->SetEmailAddress( $email )
- unless $bycpanid->EmailAddress;
- $bycpanid->SetRealName( $realname )
- unless $bycpanid->RealName;
+ return undef if !$bycpanid->id && !$byemail->id;
+
+ if ( $bycpanid->id && !$byemail->id ) {
+ my $current_email = $bycpanid->EmailAddress;
+ unless ( $current_email ) {
+ my ($status, $msg) = $bycpanid->SetEmailAddress( $cpan_email );
+ $RT::Logger->error("Couldn't set email address: $msg")
+ unless $status;
+ }
+ elsif ( $current_email =~ /\@cpan\.org$/i ) {
+ # user has fake @cpan.org address, other is impossible
+ my ($status, $msg) = $bycpanid->SetEmailAddress( $cpan_email );
+ $RT::Logger->error("Couldn't set email address: $msg")
+ unless $status;
+ }
+ else {
+ # $current_email ne $cpan_email
+ my ($tmp, $msg) = $self->create_user(
+ $cpan_email, undef, $cpan_email
+ );
+ if ( $tmp ) {
+ my ($status, $msg) = $tmp->MergeInto( $bycpanid );
+ $RT::Logger->error("Couldn't merge users: $msg")
+ unless $status;
+ } else {
+ $RT::Logger->error("Couldn't create user for merging: $msg");
+ }
+ }
return $bycpanid;
}
- elsif ( $bycpanid->id && $byemail->id ) {
- # both exist, but different
- # XXX: merge them
- debug { "WARNING: Two different users\n" };
+ elsif ( !$bycpanid->id && $byemail->id ) {
+ my ($status, $msg) = $byemail->SetName( $cpanid );
+ $RT::Logger->error("Couldn't set user name (login): $msg" )
+ unless $status;
+ return $byemail;
+ }
+# cases when users by id and email exist
+ elsif ( $bycpanid->id != $byemail->id ) {
+ my $current_email = $bycpanid->EmailAddress;
+ if ( $current_email && $current_email =~ /\@cpan\.org$/i ) {
+ # user has fake @cpan.org address, other is impossible
+ $current_email = undef;
+ }
+
+ unless ( $current_email ) {
+ # switch email address from secondary record to primary
+ my ($status, $msg) = $byemail->SetEmailAddress('');
+ $RT::Logger->error("Couldn't set email address: $msg")
+ unless $status;
+ ($status, $msg) = $bycpanid->SetEmailAddress( $cpan_email );
+ $RT::Logger->error("Couldn't set email address: $msg")
+ unless $status;
+ }
+
+ my ($status, $msg) = $byemail->MergeInto( $bycpanid );
+ $RT::Logger->error(
+ "Couldn't merge user #". $byemail->id
+ ." into #". $bycpanid->id .": $msg"
+ ) unless $status;
return $bycpanid;
}
- elsif ( $byemail->id ) {
- # there is already user with that address, but different CPANID
- my ($new, $msg) = $self->create_user( $cpanid, $realname );
- return ($new, $msg) unless $new;
-
- if ( $new->can('MergeInto') ) {
- debug { "Merging user @{[$new->Name]} into @{[$byemail->Name]}...\n" };
- $new->MergeInto( $byemail );
- } else {
- debug {
- "WARNING: Couldn't merge user @{[$new->Name]} into @{[$byemail->Name]}."
- ." Extension is not installed.\n" };
- }
- return ($new);
+ else {
+ # already merged
+ return $bycpanid;
}
-
- return $self->create_user($cpanid, $realname, $email);
}
sub create_user {
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list