diff options
| -rw-r--r-- | Bugzilla.pm | 2 | ||||
| -rw-r--r-- | Bugzilla/DB.pm | 5 | ||||
| -rw-r--r-- | Bugzilla/JobQueue.pm | 2 | ||||
| -rw-r--r-- | Bugzilla/WebService/Server/XMLRPC.pm | 6 | ||||
| -rwxr-xr-x | jsonrpc.cgi | 10 | ||||
| -rw-r--r-- | t/001compile.t | 144 | ||||
| -rw-r--r-- | t/Support/Files.pm | 30 | ||||
| -rwxr-xr-x | xmlrpc.cgi | 10 |
8 files changed, 92 insertions, 117 deletions
diff --git a/Bugzilla.pm b/Bugzilla.pm index 666b1ec15..dc275b34f 100644 --- a/Bugzilla.pm +++ b/Bugzilla.pm @@ -43,7 +43,6 @@ use Bugzilla::CGI; use Bugzilla::DB; use Bugzilla::Install::Localconfig qw(read_localconfig); use Bugzilla::Install::Requirements qw(OPTIONAL_MODULES); -use Bugzilla::JobQueue; use Bugzilla::Template; use Bugzilla::User; use Bugzilla::Error; @@ -379,6 +378,7 @@ sub logout_request { sub job_queue { my $class = shift; + require Bugzilla::JobQueue; $class->request_cache->{job_queue} ||= Bugzilla::JobQueue->new(); return $class->request_cache->{job_queue}; } diff --git a/Bugzilla/DB.pm b/Bugzilla/DB.pm index a702a0f60..b8a638e24 100644 --- a/Bugzilla/DB.pm +++ b/Bugzilla/DB.pm @@ -271,8 +271,7 @@ EOT } # List of abstract methods we are checking the derived class implements -our @_abstract_methods = qw(REQUIRED_VERSION PROGRAM_NAME DBD_VERSION - new sql_regexp sql_not_regexp sql_limit sql_to_days +our @_abstract_methods = qw(new sql_regexp sql_not_regexp sql_limit sql_to_days sql_date_format sql_interval bz_explain sql_group_concat); @@ -287,7 +286,7 @@ sub import { # make sure all abstract methods are implemented foreach my $meth (@_abstract_methods) { $pkg->can($meth) - or croak("Class $pkg does not define method $meth"); + or die("Class $pkg does not define method $meth"); } } diff --git a/Bugzilla/JobQueue.pm b/Bugzilla/JobQueue.pm index d10df9804..9e7172e2b 100644 --- a/Bugzilla/JobQueue.pm +++ b/Bugzilla/JobQueue.pm @@ -27,7 +27,7 @@ use strict; use Bugzilla::Constants; use Bugzilla::Error; use Bugzilla::Install::Util qw(install_string); -BEGIN { eval "use base qw(TheSchwartz)"; } +use base qw(TheSchwartz); # This maps job names for Bugzilla::JobQueue to the appropriate modules. # If you add new types of jobs, you should add a mapping here. diff --git a/Bugzilla/WebService/Server/XMLRPC.pm b/Bugzilla/WebService/Server/XMLRPC.pm index cbfb1b7f2..967235262 100644 --- a/Bugzilla/WebService/Server/XMLRPC.pm +++ b/Bugzilla/WebService/Server/XMLRPC.pm @@ -64,7 +64,7 @@ package Bugzilla::XMLRPC::Deserializer; use strict; # We can't use "use base" because XMLRPC::Serializer doesn't return # a true value. -eval { require XMLRPC::Lite; }; +use XMLRPC::Lite; our @ISA = qw(XMLRPC::Deserializer); use Bugzilla::Error; @@ -141,7 +141,7 @@ sub _validation_subs { package Bugzilla::XMLRPC::SOM; use strict; -eval { require XMLRPC::Lite; }; +use XMLRPC::Lite; our @ISA = qw(XMLRPC::SOM); use Bugzilla::WebService::Util qw(taint_data); @@ -165,7 +165,7 @@ use Scalar::Util qw(blessed); use strict; # We can't use "use base" because XMLRPC::Serializer doesn't return # a true value. -eval { require XMLRPC::Lite; }; +use XMLRPC::Lite; our @ISA = qw(XMLRPC::Serializer); sub new { diff --git a/jsonrpc.cgi b/jsonrpc.cgi index 25fb4c175..ad910e79e 100755 --- a/jsonrpc.cgi +++ b/jsonrpc.cgi @@ -27,12 +27,12 @@ use Bugzilla; use Bugzilla::Constants; use Bugzilla::Error; use Bugzilla::WebService::Constants; -if (!Bugzilla->feature('jsonrpc')) { - ThrowCodeError('feature_disabled', { feature => 'jsonrpc' }); +BEGIN { + if (!Bugzilla->feature('jsonrpc')) { + ThrowCodeError('feature_disabled', { feature => 'jsonrpc' }); + } } - -# This eval allows runtests.pl to pass. -eval { require Bugzilla::WebService::Server::JSONRPC; }; +use Bugzilla::WebService::Server::JSONRPC; Bugzilla->usage_mode(USAGE_MODE_JSON); diff --git a/t/001compile.t b/t/001compile.t index 07e47160a..4a2ea0eda 100644 --- a/t/001compile.t +++ b/t/001compile.t @@ -13,11 +13,11 @@ # The Original Code are the Bugzilla Tests. # # The Initial Developer of the Original Code is Zach Lipton -# Portions created by Zach Lipton are -# Copyright (C) 2001 Zach Lipton. All -# Rights Reserved. +# Portions created by Zach Lipton are Copyright (C) 2001 Zach Lipton. +# All Rights Reserved. # # Contributor(s): Zach Lipton <zach@zachlipton.com> +# Max Kanat-Alexander <mkanat@bugzilla.org> ################# @@ -25,91 +25,97 @@ ###Compilation### use strict; +use 5.008001; use lib qw(. lib t); -use Bugzilla::Constants; use Support::Files; - use Test::More tests => scalar(@Support::Files::testitems); -# Need this to get the available driver information -use DBI; -my @DBI_drivers = DBI->available_drivers; +BEGIN { + use_ok('Bugzilla::Constants'); + use_ok('Bugzilla'); +} -# Bugzilla requires Perl 5.8.1 now. Checksetup will tell you this if you run it, but -# it tests it in a polite/passive way that won't make it fail at compile time. We'll -# slip in a compile-time failure if it's missing here so a tinderbox on < 5.8.1 won't -# pass and mistakenly let people think Bugzilla works on any perl below 5.8.1. -require 5.008001; +use constant FEATURE_FILES => ( + jsonrpc => ['Bugzilla/WebService/Server/JSONRPC.pm', 'jsonrpc.cgi'], + xmlrpc => ['Bugzilla/WebService/Server/XMLRPC.pm', 'xmlrpc.cgi', + 'Bugzilla/WebService.pm', 'Bugzilla/WebService/*.pm'], + moving => ['importxml.pl'], + auth_ldap => ['Bugzilla/Auth/Verify/LDAP.pm'], + auth_radius => ['Bugzilla/Auth/Verify/RADIUS.pm'], + inbound_email => ['email_in.pl'], + jobqueue => ['Bugzilla/Job/*', 'Bugzilla/JobQueue.pm', + 'Bugzilla/JobQueue/*', 'jobqueue.pl'], + patch_viewer => ['Bugzilla/Attachment/PatchReader.pm'], + updates => ['Bugzilla/Update.pm'], +); -# Capture the TESTOUT from Test::More or Test::Builder for printing errors. -# This will handle verbosity for us automatically. -my $fh; -{ - local $^W = 0; # Don't complain about non-existent filehandles - if (-e \*Test::More::TESTOUT) { - $fh = \*Test::More::TESTOUT; - } elsif (-e \*Test::Builder::TESTOUT) { - $fh = \*Test::Builder::TESTOUT; - } else { - $fh = \*STDOUT; +sub map_files_to_feature { + my %features = FEATURE_FILES; + my %files; + foreach my $feature (keys %features) { + my @my_files = @{ $features{$feature} }; + foreach my $pattern (@my_files) { + foreach my $file (glob $pattern) { + $files{$file} = $feature; + } + } } + return \%files; } -my @testitems = @Support::Files::testitems; -my $perlapp = "\"$^X\""; - -# Test the scripts by compiling them - -foreach my $file (@testitems) { - $file =~ s/\s.*$//; # nuke everything after the first space (#comment) - next if (!$file); # skip null entries +sub compile_file { + my ($file) = @_; - # Skip mod_perl.pl in all cases. It doesn't compile correctly from the command line. - if ($file eq 'mod_perl.pl') { - ok(1, "Skipping mod_perl.pl"); - next; + if ($file =~ s/\.pm$//) { + $file =~ s{/}{::}g; + use_ok($file); + return; } - # Check that we have a DBI module to support the DB, if this is a database - # module (but not Schema) - if ($file =~ m#Bugzilla/DB/([^/]+)\.pm$# && $file ne "Bugzilla/DB/Schema.pm") { - if (!grep(lc($_) =~ /$1/i, @DBI_drivers)) { - ok(1,$file." - Skipping, as the DBD module not installed"); - next; - } - } + open(my $fh, $file); + my $bang = <$fh>; + close $fh; - open (FILE,$file); - my $bang = <FILE>; - close (FILE); my $T = ""; if ($bang =~ m/#!\S*perl\s+-.*T/) { $T = "T"; } - my $command = "$perlapp -c$T $file 2>&1"; - my $loginfo=`$command`; - #print '@@'.$loginfo.'##'; - if ($loginfo =~ /syntax ok$/im) { - # Special hack due to CPAN.pm on Windows with Cygwin installed throwing - # strings of the form "Set up gcc environment - 3.4.4 (cygming special, - # gdc 0.12, using dmd 0.125)". See bug 416047 for details. - if (ON_WINDOWS - && grep($_ eq $file, 'install-module.pl', 'Bugzilla/Install/CPAN.pm')) - { - $loginfo =~ s/^Set up gcc environment.*?\n//; + + my $perl = qq{"$^X"}; + my $output = `$perl -wc$T $file 2>&1`; + chomp($output); + my $return_val = $?; + $output =~ s/^\Q$file\E syntax OK$//ms; + diag($output) if $output; + ok(!$return_val, $file) or diag('--ERROR'); +} + +my @testitems = @Support::Files::testitems; +my $file_features = map_files_to_feature(); + +# Test the scripts by compiling them +foreach my $file (@testitems) { + # These were already compiled, above. + next if ($file eq 'Bugzilla.pm' or $file eq 'Bugzilla/Constants.pm'); + SKIP: { + if ($file eq 'mod_perl.pl') { + skip 'mod_perl.pl cannot be compiled from the command line', 1; } - if ($loginfo ne "$file syntax OK\n") { - ok(0,$file." --WARNING"); - print $fh $loginfo; + my $feature = $file_features->{$file}; + if ($feature and !Bugzilla->feature($feature)) { + skip "$file: $feature not enabled", 1; } - else { - ok(1,$file); + + # Check that we have a DBI module to support the DB, if this + # is a database module (but not Schema) + if ($file =~ m{Bugzilla/DB/([^/]+)\.pm$} + and $file ne "Bugzilla/DB/Schema.pm") + { + my $module = lc($1); + my $dbd = DB_MODULE->{$module}->{dbd}->{module}; + eval("use $dbd; 1") or skip "$file: $dbd not installed", 1; } - } - else { - ok(0,$file." --ERROR"); - print $fh $loginfo; + + compile_file($file); } } - -exit 0; diff --git a/t/Support/Files.pm b/t/Support/Files.pm index 07f1c2f6c..d24cc2264 100644 --- a/t/Support/Files.pm +++ b/t/Support/Files.pm @@ -25,44 +25,14 @@ package Support::Files; use File::Find; -# exclude_deps is a hash of arrays listing the files to be excluded -# if a module is not available -# @additional_files = (); -%exclude_deps = ( - 'XML::Twig' => ['importxml.pl'], - 'Net::LDAP' => ['Bugzilla/Auth/Verify/LDAP.pm'], - 'Authen::Radius' => ['Bugzilla/Auth/Verify/RADIUS.pm'], - 'Email::Reply' => ['email_in.pl'], - 'Email::MIME::Attachment::Stripper' => ['email_in.pl'], - 'JSON::RPC' => ['Bugzilla/WebService/Server/JSONRPC.pm'] -); - @files = glob('*'); find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;}, 'Bugzilla'); -sub have_pkg { - my ($pkg) = @_; - my ($msg, $vnum, $vstr); - no strict 'refs'; - eval { my $p; ($p = $pkg . ".pm") =~ s!::!/!g; require $p; }; - return !($@); -} - -@exclude_files = (); -foreach $dep (keys(%exclude_deps)) { - if (!have_pkg($dep)) { - push @exclude_files, @{$exclude_deps{$dep}}; - } -} - sub isTestingFile { my ($file) = @_; my $exclude; - foreach $exclude (@exclude_files) { - if ($file eq $exclude) { return undef; } # get rid of excluded files. - } if ($file =~ /\.cgi$|\.pl$|\.pm$/) { return 1; diff --git a/xmlrpc.cgi b/xmlrpc.cgi index 994e3a485..8b1e69f28 100755 --- a/xmlrpc.cgi +++ b/xmlrpc.cgi @@ -22,12 +22,12 @@ use Bugzilla; use Bugzilla::Constants; use Bugzilla::Error; use Bugzilla::WebService::Constants; -if (!Bugzilla->feature('xmlrpc')) { - ThrowCodeError('feature_disabled', { feature => 'xmlrpc' }); +BEGIN { + if (!Bugzilla->feature('xmlrpc')) { + ThrowCodeError('feature_disabled', { feature => 'xmlrpc' }); + } } -# Use an eval here so that runtests.pl accepts this script even if SOAP-Lite -# is not installed. -eval { require Bugzilla::WebService::Server::XMLRPC; }; +use Bugzilla::WebService::Server::XMLRPC; Bugzilla->usage_mode(USAGE_MODE_XMLRPC); |