[Bps-public-commit] rt-authen-externalauth branch, multiple-emails, updated. 0.09-37-gb7dd411

Ruslan Zakirov ruz at bestpractical.com
Thu May 12 17:29:25 EDT 2011


The branch, multiple-emails has been updated
       via  b7dd4119599ceefa60d17c35dfc392ce01d29acd (commit)
       via  adde79c2d197aea015b770b3b9790f5d0542bc84 (commit)
       via  4e69e1c31abd9e3c0b158fcf1de234a77d1df32c (commit)
      from  ddd96ec7ceae8c63255f49d320d14683caa2f256 (commit)

Summary of changes:
 Makefile.PL                        |    8 ++
 inc/Module/Install/Substitute.pm   |  131 ++++++++++++++++++++++++++++++++++++
 lib/RT/Authen/ExternalAuth/DBI.pm  |   30 ++------
 lib/RT/Authen/ExternalAuth/Test.pm |   14 ++++
 xt/sqlite.t                        |   11 +---
 5 files changed, 163 insertions(+), 31 deletions(-)
 create mode 100644 inc/Module/Install/Substitute.pm

- Log -----------------------------------------------------------------
commit 4e69e1c31abd9e3c0b158fcf1de234a77d1df32c
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Thu May 12 01:49:51 2011 +0400

    port xt/sqlite.t over ::Test

diff --git a/lib/RT/Authen/ExternalAuth/Test.pm b/lib/RT/Authen/ExternalAuth/Test.pm
index 2d433d5..dfdb426 100644
--- a/lib/RT/Authen/ExternalAuth/Test.pm
+++ b/lib/RT/Authen/ExternalAuth/Test.pm
@@ -42,6 +42,20 @@ sub import {
             exit;
         }
     }
+    if ( my $driver = delete $args{'dbi'} ) {
+        local $@;
+        eval {
+            require DBI;
+            require File::Temp;
+            require Digest::MD5;
+            require File::Spec;
+            eval "require DBD::$driver; 1";
+        } or do {
+            require Test::More;
+            Test::More::plan( skip_all => 'Unable to test without DB modules: '. $@ );
+            exit;
+        }
+    }
 
     $class->SUPER::import( %args );
     $class->export_to_level(1);
diff --git a/xt/sqlite.t b/xt/sqlite.t
index 09791de..ff53103 100644
--- a/xt/sqlite.t
+++ b/xt/sqlite.t
@@ -1,15 +1,8 @@
 use strict;
 use warnings;
 
-use RT::Test;
-use DBI;
-use File::Temp;
-use Digest::MD5;
-use File::Spec;
-
-eval { require DBD::SQLite; } or do {
-    plan skip_all => 'Unable to test without DBD::SQLite';
-};
+use RT::Authen::ExternalAuth::Test dbi => 'SQLite', tests => 19;
+my $class = 'RT::Authen::ExternalAuth::Test';
 
 my $dir    = File::Temp::tempdir( CLEANUP => 1 );
 my $dbname = File::Spec->catfile( $dir, 'rtauthtest' );

commit adde79c2d197aea015b770b3b9790f5d0542bc84
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Thu May 12 01:52:02 2011 +0400

    port ::DBI::CanonicalizeUserInfo over new API

diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 7099632..adc5a38 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -120,12 +120,10 @@ sub GetAuth {
 
 sub CanonicalizeUserInfo {
     
-    my ($service, $key, $value) = @_;
+    my ($service, $key, $value, $attrs) = @_;
 
     my $found = 0;
-    my %params = (Name         => undef,
-                  EmailAddress => undef,
-                  RealName     => undef);
+    my %params = ();
     
     # Load the config
     my $config = $RT::ExternalSettings->{$service};
@@ -147,27 +145,21 @@ sub CanonicalizeUserInfo {
         return ($found, %params);
     }
     
-    # "where" refers to WHERE section of SQL query
-    my ($where_key,$where_value) = ("@{[ $key ]}",$value);
-
     # Get the list of unique attrs we need
-    my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
-    my @attrs = keys(%db_attrs);
-    my $fields = join(',', at attrs);
-    my $query = "SELECT $fields FROM $table WHERE $where_key=?";
-    my @bind_params = ($where_value);
+    my $query = "SELECT ". join(', ', @$attrs) ." FROM $table WHERE $key=?";
+    my @bind_params = ($value);
 
     # Uncomment this to trace basic DBI throughput in a log
     # DBI->trace(1,'/tmp/dbi.log');
     my $dbh = _GetBoundDBIObj($config);
-    my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
+    my $results = $dbh->selectall_arrayref($query, undef, @bind_params);
     $dbh->disconnect();
 
-    if ((scalar keys %$results_hashref) != 1) {
+    if ( @$results != 1 ) {
         # If returned users <> 1, we have no single unique user, so prepare to die
         my $death_msg;
         
-	    if ((scalar keys %$results_hashref) == 0) {
+	    if ( @$results == 0) {
             # If no user...
 	        $death_msg = "No User Found in External Database!";
         } else {
@@ -190,14 +182,8 @@ sub CanonicalizeUserInfo {
 
     # We haven't dropped out, so DB search must have succeeded with 
     # exactly 1 result. Get the result and set $found to 1
-    my $result = $results_hashref->{$value};
- 
-    # Use the result to populate %params for every key we're given in the config
-    foreach my $key (keys(%{$config->{'attr_map'}})) {
-        $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
-    }
-    
     $found = 1;
+    @params{ @$attrs } = @{ $results->[0] };
   
     return ($found, %params);
 }

commit b7dd4119599ceefa60d17c35dfc392ce01d29acd
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Fri May 13 01:28:37 2011 +0400

    use M::I::Substitute for 'use lib ...' in ::Test

diff --git a/Makefile.PL b/Makefile.PL
index d4cb1bf..fb6d06e 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -31,6 +31,14 @@ recursive_author_tests('xt');
 
 requires_rt('3.8.2');
 
+my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
+my $local_lib_path = "$RT::LocalPath/lib";
+substitute( {
+        RT_LIB_PATH => join( ' ', $local_lib_path, $lib_path ),
+    },
+    'lib/RT/Authen/ExternalAuth/Test.pm',
+);
+
 &auto_install();
 
 &WriteAll;
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..56af7fe
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+	my $self = shift;
+	$self->{__subst} = shift;
+	$self->{__option} = {};
+	if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+		my $opts = shift;
+		while( my ($k,$v) = each( %$opts ) ) {
+			$self->{__option}->{ lc( $k ) } = $v || '';
+		}
+	}
+	$self->_parse_options;
+
+	my @file = @_;
+	foreach my $f (@file) {
+		$self->_rewrite_file( $f );
+	}
+
+	return;
+}
+
+sub _parse_options
+{
+	my $self = shift;
+	my $cwd = Cwd::getcwd();
+	foreach my $t ( qw(from to) ) {
+        $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+		my $d = $self->{__option}->{$t};
+		die "Couldn't read directory '$d'" unless -d $d && -r _;
+	}
+}
+
+sub _rewrite_file
+{
+	my ($self, $file) = @_;
+	my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+	$source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+	unless( -f $source && -r _ ) {
+		print STDERR "Couldn't find file '$source'\n";
+		return;
+	}
+	my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+	return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+	my ($self, $source, $dest) = @_;
+
+	my $mode = (stat($source))[2];
+
+	open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+	print "Open input '$source' file for substitution\n";
+
+	my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+	$self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+	close $sfh;
+
+	seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+	open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+	print "Open output '$dest' file for substitution\n";
+
+	while( <$tmpfh> ) {
+		print $dfh $_;
+	}
+	close $dfh;
+	chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+	my ($self, $in, $out, $replace) = @_;
+	
+	my @queue = ();
+	my $subst = $self->{'__subst'};
+	my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+	while( my $str = <$in> ) {
+		if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+			my ($action, $nstr) = ($1,$2);
+			$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+			die "Replace action is bad idea for situations when dest is equal to source"
+                if $replace && $action eq 'replace';
+			if( $action eq 'before' ) {
+				die "no line before 'before' action" unless @queue;
+				# overwrite prev line;
+				pop @queue;
+				push @queue, $nstr;
+				push @queue, $str;
+			} elsif( $action eq 'replace' ) {
+				push @queue, $nstr;
+			} elsif( $action eq 'after' ) {
+				push @queue, $str;
+				push @queue, $nstr;
+				# skip one line;
+				<$in>;
+			}
+		} else {
+			push @queue, $str;
+		}
+		while( @queue > 3 ) {
+			print $out shift(@queue);
+		}
+	}
+	while( scalar @queue ) {
+		print $out shift(@queue);
+	}
+}
+
+1;
+

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list