# BEGIN BPS TAGGED BLOCK {{{
-#
+#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
-#
+#
+# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
# (Except where explicitly superseded by other copyright notices)
-#
-#
+#
+#
# LICENSE:
-#
+#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
-#
+#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
-#
+#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
+#
+#
# CONTRIBUTION SUBMISSION POLICY:
-#
+#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
-#
+#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
-#
+#
# END BPS TAGGED BLOCK }}}
package RT::Test;
};
-our @EXPORT = qw(is_empty);
+our @EXPORT = qw(is_empty parse_mail);
our ($port, $dbname);
our @SERVERS;
$tmp{'config'}{'RT'} = File::Spec->catfile(
"$tmp{'directory'}", 'RT_SiteConfig.pm'
);
- open my $config, '>', $tmp{'config'}{'RT'}
+ open( my $config, '>', $tmp{'config'}{'RT'} )
or die "Couldn't open $tmp{'config'}{'RT'}: $!";
print $config qq{
-Set( \$WebPort , $port);
-Set( \$WebBaseURL , "http://localhost:\$WebPort");
-Set( \$LogToSyslog , undef);
-Set( \$LogToScreen , "warning");
-Set( \$MailCommand, 'testfile');
+Set( \$WebDomain, "localhost");
+Set( \$WebPort, $port);
+Set( \$WebPath, "");
+Set( \$RTAddressRegexp , qr/^bad_re_that_doesnt_match\$/);
};
if ( $ENV{'RT_TEST_DB_SID'} ) { # oracle case
print $config "Set( \$DatabaseName , '$ENV{'RT_TEST_DB_SID'}' );\n";
print $config "Set( \$DevelMode, 0 );\n"
if $INC{'Devel/Cover.pm'};
+ $self->bootstrap_logging( $config );
+
# set mail catcher
my $mail_catcher = $tmp{'mailbox'} = File::Spec->catfile(
$tmp{'directory'}->dirname, 'mailbox.eml'
Set( \$MailCommand, sub {
my \$MIME = shift;
- open my \$handle, '>>', '$mail_catcher'
+ open( my \$handle, '>>', '$mail_catcher' )
or die "Unable to open '$mail_catcher' for appending: \$!";
\$MIME->print(\$handle);
close \$handle;
} );
END
-
+
print $config $args{'config'} if $args{'config'};
print $config "\n1;\n";
return $config;
}
+sub bootstrap_logging {
+ my $self = shift;
+ my $config = shift;
+
+ # prepare file for logging
+ $tmp{'log'}{'RT'} = File::Spec->catfile(
+ "$tmp{'directory'}", 'rt.debug.log'
+ );
+ open( my $fh, '>', $tmp{'log'}{'RT'} )
+ or die "Couldn't open $tmp{'config'}{'RT'}: $!";
+ # make world writable so apache under different user
+ # can write into it
+ chmod 0666, $tmp{'log'}{'RT'};
+
+ print $config <<END;
+Set( \$LogToSyslog , undef);
+Set( \$LogToScreen , "warning");
+Set( \$LogToFile, 'debug' );
+Set( \$LogDir, q{$tmp{'directory'}} );
+Set( \$LogToFileNamed, 'rt.debug.log' );
+END
+}
+
sub set_config_wrapper {
my $self = shift;
SCALAR => '$',
);
my $sigil = $sigils{$type} || $sigils{'SCALAR'};
- open my $fh, '>>', $tmp{'config'}{'RT'}
+ open( my $fh, '>>', $tmp{'config'}{'RT'} )
or die "Couldn't open config file: $!";
require Data::Dumper;
+ my $dump = Data::Dumper::Dumper([@_[2 .. $#_]]);
+ $dump =~ s/;\s+$//;
print $fh
- "\nSet(${sigil}${name}, \@{"
- . Data::Dumper::Dumper([@_[2 .. $#_]])
- ."}); 1;\n";
+ "\nSet(${sigil}${name}, \@{". $dump ."}); 1;\n";
close $fh;
if ( @SERVERS ) {
RT->Config->Set( Plugins => @plugins );
RT->InitPluginPaths;
+ my $dba_dbh;
+ $dba_dbh = _get_dbh(
+ RT::Handle->DSN,
+ $ENV{RT_DBA_USER}, $ENV{RT_DBA_PASSWORD},
+ ) if @plugins;
+
require File::Spec;
foreach my $name ( @plugins ) {
my $plugin = RT::Plugin->new( name => $name );
if $ENV{'TEST_VERBOSE'};
if ( -e $etc_path ) {
- my ($ret, $msg) = $RT::Handle->InsertSchema( undef, $etc_path );
+ my ($ret, $msg) = $RT::Handle->InsertSchema( $dba_dbh, $etc_path );
Test::More::ok($ret || $msg =~ /^Couldn't find schema/, "Created schema: ".($msg||''));
- ($ret, $msg) = $RT::Handle->InsertACL( undef, $etc_path );
+ ($ret, $msg) = $RT::Handle->InsertACL( $dba_dbh, $etc_path );
Test::More::ok($ret || $msg =~ /^Couldn't find ACLs/, "Created ACL: ".($msg||''));
my $data_file = File::Spec->catfile( $etc_path, 'initialdata' );
$RT::Handle->Connect; # XXX: strange but mysql can loose connection
}
+ $dba_dbh->disconnect if $dba_dbh;
}
sub _get_dbh {
if ( $principal =~ /^(everyone|(?:un)?privileged)$/i ) {
$principal = RT::Group->new( $RT::SystemUser );
$principal->LoadSystemInternalGroup($1);
+ } elsif ( $principal =~ /^(Owner|Requestor|(?:Admin)?Cc)$/i ) {
+ $principal = RT::Group->new( $RT::SystemUser );
+ $principal->LoadByCols(
+ Domain => (ref($e->{'Object'})||'RT::System').'-Role',
+ Type => $1,
+ ref($e->{'Object'})? (Instance => $e->{'Object'}->id): (),
+ );
} else {
die "principal is not an object, but also is not name of a system group";
}
my $self = shift;
my %args = @_;
+ my $after_open = delete $args{after_open};
+
my $cmd = delete $args{'command'};
die "Couldn't find command ($cmd)" unless -f $cmd;
my ($child_out, $child_in);
my $pid = IPC::Open2::open2($child_out, $child_in, $cmd);
- $args{after_open}->($child_in, $child_out) if $args{after_open};
+ $after_open->($child_in, $child_out) if $after_open;
close $child_in;
my $baseurl = shift;
my $queue = shift || 'general';
my $action = shift || 'correspond';
- Test::More::ok(open(my $mail, "|$RT::BinPath/rt-mailgate --url $baseurl --queue $queue --action $action"), "Opened the mailgate - $!");
+ Test::More::ok(open(my $mail, '|-', "$RT::BinPath/rt-mailgate --url $baseurl --queue $queue --action $action"), "Opened the mailgate - $!");
return $mail;
}
$RT::Handle->dbh( undef );
RT->ConnectToDatabase;
+ # the attribute cache holds on to a stale dbh
+ delete $RT::System->{attributes};
+
return ($ret, RT::Test::Web->new);
}
my %info = $self->apache_server_info( variant => $variant );
Test::More::diag(do {
- open my $fh, '<', $tmp{'config'}{'RT'};
+ open( my $fh, '<', $tmp{'config'}{'RT'} ) or die $!;
local $/;
<$fh>
});
- my $log_fn = File::Spec->catfile(
- "$tmp{'directory'}", 'apache.log'
- );
- my $pid_fn = File::Spec->catfile(
- "$tmp{'directory'}", "apache.pid"
- );
my $tmpl = File::Spec->rel2abs( File::Spec->catfile(
't', 'data', 'configs',
'apache'. $info{'version'} .'+'. $variant .'.conf'
) );
my %opt = (
- listen => $port,
- server_root => $info{'HTTPD_ROOT'} || $ENV{'HTTPD_ROOT'}
+ listen => $port,
+ server_root => $info{'HTTPD_ROOT'} || $ENV{'HTTPD_ROOT'}
|| Test::More::BAIL_OUT("Couldn't figure out server root"),
- pid_file => $pid_fn,
- document_root => $RT::MasonComponentRoot,
- rt_bin_path => $RT::BinPath,
- log_file => $log_fn,
+ document_root => $RT::MasonComponentRoot,
+ tmp_dir => "$tmp{'directory'}",
+ rt_bin_path => $RT::BinPath,
rt_site_config => $ENV{'RT_SITE_CONFIG'},
);
+ foreach (qw(log pid lock)) {
+ $opt{$_ .'_file'} = File::Spec->catfile(
+ "$tmp{'directory'}", "apache.$_"
+ );
+ }
{
my $method = 'apache_'.$variant.'_server_options';
$self->$method( \%info, \%opt );
$self->fork_exec($info{'executable'}, '-f', $tmp{'config'}{'apache'});
my $pid = do {
- my $tries = 60;
- while ( !-e $pid_fn ) {
+ my $tries = 10;
+ while ( !-e $opt{'pid_file'} ) {
$tries--;
last unless $tries;
sleep 1;
}
Test::More::BAIL_OUT("Couldn't start apache server, no pid file")
- unless -e $pid_fn;
- open my $pid_fh, '<', $pid_fn
+ unless -e $opt{'pid_file'};
+ open( my $pid_fh, '<', $opt{'pid_file'} )
or Test::More::BAIL_OUT("Couldn't open pid file: $!");
my $pid = <$pid_fh>;
chomp $pid;
Test::More::diag "reading content of '$path'" if $ENV{'TEST_VERBOSE'};
- open my $fh, "<:raw", $path
+ open( my $fh, "<:raw", $path )
or do {
warn "couldn't open file '$path': $!" unless $args{noexist};
return ''
($out_fh, $out_conf) = tempfile();
} else {
$out_conf = $args{'out'};
- open $out_fh, '>', $out_conf
+ open( $out_fh, '>', $out_conf )
or die "couldn't open '$out_conf': $!";
}
print $out_fh $text;
return ($out_fh, $out_conf);
}
+sub parse_mail {
+ my $mail = shift;
+ require RT::EmailParser;
+ my $parser = RT::EmailParser->new;
+ $parser->ParseMIMEEntityFromScalar( $mail );
+ return $parser->Entity;
+}
+
END {
my $Test = RT::Test->builder;
return if $Test->{Original_Pid} != $$;
RT::Test->stop_server;
# not success
- if ( grep !$_, $Test->summary ) {
+ if ( !$Test->summary || grep !$_, $Test->summary ) {
$tmp{'directory'}->unlink_on_destroy(0);
Test::More::diag(
- "Some tests failed, tmp directory"
+ "Some tests failed or we bailed out, tmp directory"
." '$tmp{directory}' is not cleaned"
);
}