diff --git a/Bugzilla/Bug.pm b/Bugzilla/Bug.pm index 217f0d5f6..4417775d7 100644 --- a/Bugzilla/Bug.pm +++ b/Bugzilla/Bug.pm @@ -58,6 +58,17 @@ use base qw(Bugzilla::Object Exporter); editable_bug_fields ); +#sub import +#{ +# no strict 'refs'; +# my $pkg = [caller]->[0]; +# for(@Bugzilla::Bug::EXPORT) +# { +# *{$pkg."::".$_} = eval "\\&".$_; +# die $@ if $@; +# } +#} + ##################################################################### # Constants ##################################################################### diff --git a/lib/win32/Exporter.pm b/lib/win32/Exporter.pm new file mode 100644 index 000000000..efdab1b06 --- /dev/null +++ b/lib/win32/Exporter.pm @@ -0,0 +1,151 @@ +package Exporter; + +# Извращенческий Exporter для виндового модперла + +require 5.004; + +# Using strict or vars almost doubles our load time. Turn them back +# on when debugging. +#use strict 'vars'; # we're going to be doing a lot of sym refs +#use vars qw($VERSION @EXPORT); + +$VERSION = 0.02; +@EXPORT = qw(import); # we'll know pretty fast if it doesn't work :) +$ExportLevel = 0; + +sub export_tags { + my($exporter, @tags) = @_; + my %t = %{$exporter.'::EXPORT_TAGS'}; + for (@tags) + { + push @{$exporter.'::EXPORT'}, @{$t{$_}}; + } +} + +sub export_ok_tags { + my($exporter, @tags) = @_; + my %t = %{$exporter.'::EXPORT_TAGS'}; + for (@tags) + { + push @{$exporter.'::EXPORT_OK'}, @{$t{$_}}; + } +} + +sub export_to_level { + my($exporter, $level, $package, @imports) = @_; + my($caller, $file, $line) = caller($level); + + unless( @imports ) { # Default import. + @imports = @{$exporter.'::EXPORT'}; + } + else { + # Because @EXPORT_OK = () would indicate that nothing is + # to be exported, we cannot simply check the length of @EXPORT_OK. + # We must to oddness to see if the variable exists at all as + # well as avoid autovivification. + # XXX idea stolen from base.pm, this might be all unnecessary + my $eokglob; + if( $eokglob = ${$exporter.'::'}{EXPORT_OK} and *$eokglob{ARRAY} ) { + if( @{$exporter.'::EXPORT_OK'} ) { + # This can also be cached. + my %ok = map { s/^&//; $_ => 1 } @{$exporter.'::EXPORT_OK'}, + @{$exporter.'::EXPORT'}; + + my($denied) = grep {s/^&//; !/(^\d*(\.\d+)*$|^:|^!)/ && !$ok{$_}} @imports; + _not_exported($denied, $exporter, $file, $line) if $denied; + } + else { # We don't export anything. + _not_exported($imports[0], $exporter, $file, $line); + } + } + } + + export($caller, $exporter, @imports); +} + +sub import { + my($exporter, @imports) = @_; + my($caller, $file, $line) = caller($ExportLevel); + + unless( @imports ) { # Default import. + @imports = @{$exporter.'::EXPORT'}; + } + else { + # Because @EXPORT_OK = () would indicate that nothing is + # to be exported, we cannot simply check the length of @EXPORT_OK. + # We must to oddness to see if the variable exists at all as + # well as avoid autovivification. + # XXX idea stolen from base.pm, this might be all unnecessary + my $eokglob; + if( $eokglob = ${$exporter.'::'}{EXPORT_OK} and *$eokglob{ARRAY} ) { + if( @{$exporter.'::EXPORT_OK'} ) { + # This can also be cached. + my %ok = map { s/^&//; $_ => 1 } @{$exporter.'::EXPORT_OK'}, + @{$exporter.'::EXPORT'}; + + my($denied) = grep {s/^&//; !/(^\d*(\.\d+)*$|^:|^!)/ && !$ok{$_}} @imports; + _not_exported($denied, $exporter, $file, $line) if $denied; + } + else { # We don't export anything. + _not_exported($imports[0], $exporter, $file, $line); + } + } + } + + export($caller, $exporter, @imports); +} + + + +sub export { + my($caller, $exporter, @imp) = @_; + + my %t = %{$exporter.'::EXPORT_TAGS'}; + my @imports; + for(@imp) + { + if (substr($_,0,1) eq ':') + { + push @imports, @{$t{substr($_,1)}}; + } + elsif (substr($_,0,1) eq '!') + { + my $n = substr($_,1); + @imports = grep { $_ ne $n } @imports; + } + else + { + push @imports, $_; + } + } + + # Stole this from Exporter::Heavy. I'm sure it can be written better + # but I'm lazy at the moment. + foreach my $sym (@imports) { + # shortcut for the common case of no type character + (*{$caller.'::'.$sym} = \&{$exporter.'::'.$sym}, next) + unless $sym =~ s/^(\W)//; + + my $type = $1; + my $caller_sym = $caller.'::'.$sym; + my $export_sym = $exporter.'::'.$sym; + *{$caller_sym} = + $type eq '&' ? \&{$export_sym} : + $type eq '$' ? \${$export_sym} : + $type eq '@' ? \@{$export_sym} : + $type eq '%' ? \%{$export_sym} : + $type eq '*' ? *{$export_sym} : + do { require Carp; Carp::croak("Can't export symbol: $type$sym") }; + } +} + + +#"# +sub _not_exported { + my($thing, $exporter, $file, $line) = @_; + die sprintf qq|"%s" is not exported by the %s module at %s line %d\n|, + $thing, $exporter, $file, $line; +} + +1; +__END__ diff --git a/mod_perl_win32.pl b/mod_perl_win32.pl new file mode 100644 index 000000000..cd22f57ec --- /dev/null +++ b/mod_perl_win32.pl @@ -0,0 +1,119 @@ +#!/usr/bin/perl -wT +# -*- Mode: perl; indent-tabs-mode: nil -*- +# +# The contents of this file are subject to the Mozilla Public +# License Version 1.1 (the "License"); you may not use this file +# except in compliance with the License. You may obtain a copy of +# the License at http://www.mozilla.org/MPL/ +# +# Software distributed under the License is distributed on an "AS +# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or +# implied. See the License for the specific language governing +# rights and limitations under the License. +# +# The Original Code is the Bugzilla Bug Tracking System. +# +# Contributor(s): Max Kanat-Alexander + +package Bugzilla::ModPerl; + +use strict; + +# If you have an Apache2::Status handler in your Apache configuration, +# you need to load Apache2::Status *here*, so that Apache::DBI can +# report information to Apache2::Status. +#use Apache2::Status (); + +# We don't want to import anything into the global scope during +# startup, so we always specify () after using any module in this +# file. + +use Apache2::ServerUtil; +use ModPerl::RegistryLoader (); +use CGI (); +CGI->compile(qw(:cgi -no_xhtml -oldstyle_urls :private_tempfiles + :unique_headers SERVER_PUSH :push)); +use Template::Config (); +Template::Config->preload(); + +use Bugzilla (); +use Bugzilla::Constants (); +use Bugzilla::CGI (); +use Bugzilla::Mailer (); +use Bugzilla::Template (); +use Bugzilla::Util (); + +my $cgi_path = Bugzilla::Constants::bz_locations()->{'cgi_path'}; + +# Set up the configuration for the web server +my $server = Apache2::ServerUtil->server; +my $conf = < + AddHandler perl-script .cgi + # No need to PerlModule these because they're already defined in mod_perl.pl + PerlResponseHandler Bugzilla::ModPerl::ResponseHandler + PerlCleanupHandler Bugzilla::ModPerl::CleanupHandler + PerlOptions +ParseHeaders + Options +ExecCGI + AllowOverride Limit + DirectoryIndex index.cgi index.html + +EOT + +if ($^O =~ /MSWin32/i) +{ + $conf = "\nuse lib qw(lib/win32);\n\n$conf"; +} + +$server->add_config([split("\n", $conf)]); + +# Have ModPerl::RegistryLoader pre-compile all CGI scripts. +my $rl = new ModPerl::RegistryLoader(); +# If we try to do this in "new" it fails because it looks for a +# Bugzilla/ModPerl/ResponseHandler.pm +$rl->{package} = 'Bugzilla::ModPerl::ResponseHandler'; +# Note that $cgi_path will be wrong if somebody puts the libraries +# in a different place than the CGIs. +foreach my $file (glob "$cgi_path/*.cgi") { + Bugzilla::Util::trick_taint($file); + $rl->handler($file, $file); +} + + +package Bugzilla::ModPerl::ResponseHandler; +use strict; +use base qw(ModPerl::Registry); +use Bugzilla; + +sub handler : method { + my $class = shift; + + # $0 is broken under mod_perl before 2.0.2, so we have to set it + # here explicitly or init_page's shutdownhtml code won't work right. + $0 = $ENV{'SCRIPT_FILENAME'}; + + Bugzilla::init_page(); + return $class->SUPER::handler(@_); +} + + +package Bugzilla::ModPerl::CleanupHandler; +use strict; +use Apache2::Const -compile => qw(OK); + +sub handler { + my $r = shift; + + Bugzilla::_cleanup(); + # Sometimes mod_perl doesn't properly call DESTROY on all + # the objects in pnotes() + foreach my $key (keys %{$r->pnotes}) { + delete $r->pnotes->{$key}; + } + + return Apache2::Const::OK; +} + +1;