[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