On Wed, 2003-02-12 at 00:23, Stas Bekman wrote:
> Nathan Byrd wrote:
> [...]
> > fields Pragma
> > -------------
> > Advantages:
> > * More straightforward approach
> > * Less code to add to module
> >
> > Disadvantages:
> > * Based on pseudo-hashes - may have problems with reloading, etc
> > * Unknown whether it changes performance (due to "typed lexical"
> > limitation of pragma)
> > * Forces developers to 'use base' and/or 'use fields' in sub-class, can
> > cause non-obvious error otherwise
> >
> > Array based
> > -----------
> > Advantages:
> > * Easy to change code to change base class implementation in the future
> > * Good encapsulation (ability to override methods in future without
> > breaking sub-classes)
> >
> > Disadvantages:
> > * Adds a custom non-standard extending technique
> > * Need to explain method in doco for adding sub-class data (via
> > "public"), vs. pointing the developer to an existing perl document.
> > * Doesn't work with multiple inheritance (probably not a big deal for
> > most RegistryCooker sub-class developers though)
>
> Thanks for the summary Nathan,
>
> Looking at it, I favor your original proposal, as then we have a complete
> control and any bugs are our own fault.
>
> Considering that we go with that approach. Are there any in-core modules that
> can be used for creating/managing accessors? I know there is a whole lot of
> them on CPAN, but we don't want to create extra dependencies.
>
> Another approach to simplify your original suggestion, is to move on to hash
> based objects. I doubt it'll be of any significant difference, since most work
> happens in the scripts themselves. I guess a benchmark will show better. But
> if we go with it, subclasses can simply bypass the accessors (we could just
> skip them) and work directly with the hash. Dunno, what's the best way to go.
>
Stas,
Sorry for taking so long to get back with you. I've finally gotten a
chance to start looking at this again. Making the module changes with
hashes does seem to simplify things. As to performance - besides your
point above about most of the work happening in the scripts, I believe
that this shouldn't be worse than mod_perl 1.x anyway since it is also
based on hash objects. I suppose most people probably avoid PerlRun or
Registry as well if optimization is that important to them that they
would actually care about the performance difference between an array
based object and hash based object.
Also, I followed your suggestion and skipped making accessors for each
member. When I started implementing them it seemed a little excessive
when using a hash based object.
Below is patches to RegistryCooker and RegistryLoader to use hash based
objects. The following is a patched and tested (passes make test)
against the latest CVS. Please let me know what you think.
RegistryCooker.pm:
---------
--- RegistryCooker.pm.cvs 2003-02-25 22:49:44.000000000 -0600
+++ RegistryCooker.pm 2003-02-25 23:23:28.000000000 -0600
@@ -55,17 +55,6 @@
# : D_NONE;
#########################################################################
-# object's array index's access constants
-#
-#########################################################################
-use constant REQ => 0;
-use constant FILENAME => 1;
-use constant URI => 2;
-use constant MTIME => 3;
-use constant PACKAGE => 4;
-use constant CODE => 5;
-
-#########################################################################
# OS specific constants
#
#########################################################################
@@ -100,7 +89,7 @@
sub new {
my($class, $r) = @_;
- my $self = bless [], $class;
+ my $self = bless {}, $class;
$self->init($r);
return $self;
}
@@ -114,9 +103,9 @@
#########################################################################
sub init {
- $_[0]->[REQ] = $_[1];
- $_[0]->[URI] = $_[1]->uri;
- $_[0]->[FILENAME] = $_[1]->filename;
+ $_[0]->{REQ} = $_[1];
+ $_[0]->{URI} = $_[1]->uri;
+ $_[0]->{FILENAME} = $_[1]->filename;
}
#########################################################################
@@ -161,9 +150,9 @@
# handlers shouldn't set $r->status but return it, so we reset the
# status after running it
- my $old_status = $self->[REQ]->status;
+ my $old_status = $self->{REQ}->status;
my $rc = $self->run;
- my $new_status = $self->[REQ]->status($old_status);
+ my $new_status = $self->{REQ}->status($old_status);
return ($rc == Apache::OK && $old_status != $new_status)
? $new_status
: $rc;
@@ -180,8 +169,8 @@
sub run {
my $self = shift;
- my $r = $self->[REQ];
- my $package = $self->[PACKAGE];
+ my $r = $self->{REQ};
+ my $package = $self->{PACKAGE};
$self->set_script_name;
$self->chdir_file;
@@ -227,30 +216,30 @@
sub can_compile {
my $self = shift;
- my $r = $self->[REQ];
+ my $r = $self->{REQ};
unless (-r $r->my_finfo && -s _) {
- $self->log_error("$self->[FILENAME] not found or unable to
stat");
+ $self->log_error("$self->{FILENAME} not found or unable to
stat");
return Apache::NOT_FOUND;
}
return Apache::DECLINED if -d _;
- $self->[MTIME] = -M _;
+ $self->{MTIME} = -M _;
unless (-x _ or IS_WIN32) {
$r->log_error("file permissions deny server execution",
- $self->[FILENAME]);
+ $self->{FILENAME});
return Apache::FORBIDDEN;
}
if (!($r->allow_options & Apache::OPT_EXECCGI)) {
$r->log_error("Options ExecCGI is off in this directory",
- $self->[FILENAME]);
+ $self->{FILENAME});
return Apache::FORBIDDEN;
}
- $self->debug("can compile $self->[FILENAME]") if DEBUG & D_NOISE;
+ $self->debug("can compile $self->{FILENAME}") if DEBUG & D_NOISE;
return Apache::OK;
@@ -291,7 +280,7 @@
# prepend root
$package = $self->namespace_root() . "::$package";
- $self->[PACKAGE] = $package;
+ $self->{PACKAGE} = $package;
return $package;
}
@@ -311,7 +300,7 @@
my $self = shift;
my ($volume, $dirs, $file) =
- File::Spec::Functions::splitpath($self->[FILENAME]);
+ File::Spec::Functions::splitpath($self->{FILENAME});
my @dirs = File::Spec::Functions::splitdir($dirs);
return join '_', grep { defined && length } $volume, @dirs, $file;
}
@@ -320,14 +309,14 @@
sub namespace_from_uri {
my $self = shift;
- my $path_info = $self->[REQ]->path_info;
- my $script_name = $path_info && $self->[URI] =~ /$path_info$/ ?
- substr($self->[URI], 0, length($self->[URI]) - length($path_info)) :
- $self->[URI];
+ my $path_info = $self->{REQ}->path_info;
+ my $script_name = $path_info && $self->{URI} =~ /$path_info$/ ?
+ substr($self->{URI}, 0, length($self->{URI}) - length($path_info)) :
+ $self->{URI};
if ($ModPerl::RegistryCooker::NameWithVirtualHost &&
- $self->[REQ]->server->is_virtual) {
- my $name = $self->[REQ]->get_server_name;
+ $self->{REQ}->server->is_virtual) {
+ my $name = $self->{REQ}->get_server_name;
$script_name = join "", $name, $script_name if $name;
}
@@ -347,7 +336,7 @@
sub convert_script_to_compiled_handler {
my $self = shift;
- $self->debug("Adding package $self->[PACKAGE]") if DEBUG & D_NOISE;
+ $self->debug("Adding package $self->{PACKAGE}") if DEBUG & D_NOISE;
# get the script's source
$self->read_script;
@@ -359,8 +348,8 @@
# relative require/open will work.
$self->chdir_file;
-# undef &{"$self->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE;
#avoid warnings
-# $self->[PACKAGE]->can('undef_functions') &&
$self->[PACKAGE]->undef_functions;
+# undef &{"$self->{PACKAGE}\::handler"}; unless DEBUG & D_NOISE;
#avoid warnings
+# $self->{PACKAGE}->can('undef_functions') &&
$self->{PACKAGE}->undef_functions;
my $line = $self->get_mark_line;
@@ -368,15 +357,15 @@
my $eval = join '',
'package ',
- $self->[PACKAGE], ";",
+ $self->{PACKAGE}, ";",
"sub handler {\n",
$line,
- ${ $self->[CODE] },
+ ${ $self->{CODE} },
"\n}"; # last line comment without newline?
my $rc = $self->compile(\$eval);
return $rc unless $rc == Apache::OK;
- $self->debug(qq{compiled package \"$self->[PACKAGE]\"}) if DEBUG &
D_NOISE;
+ $self->debug(qq{compiled package \"$self->{PACKAGE}\"}) if DEBUG &
D_NOISE;
#$self->chdir_file("$Apache::Server::CWD/");
@@ -421,7 +410,7 @@
sub cache_it {
my $self = shift;
- $self->cache_table->{ $self->[PACKAGE] }{mtime} = $self->[MTIME];
+ $self->cache_table->{ $self->{PACKAGE} }{mtime} = $self->{MTIME};
}
@@ -436,7 +425,7 @@
sub is_cached {
my $self = shift;
- exists $self->cache_table->{ $self->[PACKAGE] }{mtime};
+ exists $self->cache_table->{ $self->{PACKAGE} }{mtime};
}
@@ -456,9 +445,9 @@
# wasn't modified
sub should_compile_if_modified {
my $self = shift;
- $self->[MTIME] ||= -M $self->[REQ]->my_finfo;
+ $self->{MTIME} ||= -M $self->{REQ}->my_finfo;
!($self->is_cached &&
- $self->cache_table->{ $self->[PACKAGE] }{mtime} <=
$self->[MTIME]);
+ $self->cache_table->{ $self->{PACKAGE} }{mtime} <=
$self->{MTIME});
}
# return false if the package is cached already
@@ -482,10 +471,10 @@
$self->debug("flushing namespace") if DEBUG & D_NOISE;
no strict 'refs';
- my $tab = \%{ $self->[PACKAGE] . '::' };
+ my $tab = \%{ $self->{PACKAGE} . '::' };
for (keys %$tab) {
- my $fullname = join '::', $self->[PACKAGE], $_;
+ my $fullname = join '::', $self->{PACKAGE}, $_;
# code/hash/array/scalar might be imported make sure the gv
# does not point elsewhere before undefing each
if (%$fullname) {
@@ -534,8 +523,8 @@
sub read_script {
my $self = shift;
- $self->debug("reading $self->[FILENAME]") if DEBUG & D_NOISE;
- $self->[CODE] = $self->[REQ]->my_slurp_filename;
+ $self->debug("reading $self->{FILENAME}") if DEBUG & D_NOISE;
+ $self->{CODE} = $self->{REQ}->my_slurp_filename;
}
#########################################################################
@@ -560,7 +549,7 @@
sub rewrite_shebang {
my $self = shift;
- my($line) = ${ $self->[CODE] } =~ /^(.*)$/m;
+ my($line) = ${ $self->{CODE} } =~ /^(.*)$/m;
my @cmdline = split /\s+/, $line;
return unless @cmdline;
return unless shift(@cmdline) =~ /^\#!/;
@@ -574,7 +563,7 @@
$prepend .= $switches{$_}->();
}
}
- ${ $self->[CODE] } =~ s/^/$prepend/ if $prepend;
+ ${ $self->{CODE} } =~ s/^/$prepend/ if $prepend;
}
#########################################################################
@@ -586,7 +575,7 @@
#########################################################################
sub set_script_name {
- *0 = \(shift->[FILENAME]);
+ *0 = \(shift->{FILENAME});
}
#########################################################################
@@ -602,7 +591,7 @@
sub chdir_file_normal {
my($self, $dir) = @_;
- # $self->[REQ]->chdir_file($dir ? $dir : $self->[FILENAME]);
+ # $self->{REQ}->chdir_file($dir ? $dir : $self->{FILENAME});
}
#########################################################################
@@ -615,19 +604,19 @@
sub get_mark_line {
my $self = shift;
- $ModPerl::Registry::MarkLine ? "\n#line 1 $self->[FILENAME]\n" :
"";
+ $ModPerl::Registry::MarkLine ? "\n#line 1 $self->{FILENAME}\n" :
"";
}
#########################################################################
# func: strip_end_data_segment
# dflt: strip_end_data_segment
-# desc: remove the trailing non-code from $self->[CODE]
+# desc: remove the trailing non-code from $self->{CODE}
# args: $self - registry blessed object
# rtrn: nothing
#########################################################################
sub strip_end_data_segment {
- ${ +shift->[CODE] } =~ s/__(END|DATA)__(.*)//s;
+ ${ +shift->{CODE} } =~ s/__(END|DATA)__(.*)//s;
}
@@ -644,11 +633,11 @@
sub compile {
my($self, $eval) = @_;
- my $r = $self->[REQ];
+ my $r = $self->{REQ};
- $self->debug("compiling $self->[FILENAME]") if DEBUG && D_COMPILE;
+ $self->debug("compiling $self->{FILENAME}") if DEBUG && D_COMPILE;
- ModPerl::Global::special_list_clear(END => $self->[PACKAGE]);
+ ModPerl::Global::special_list_clear(END => $self->{PACKAGE});
ModPerl::Util::untaint($$eval);
{
@@ -707,16 +696,16 @@
sub debug {
my $self = shift;
my $class = ref $self;
- $self->[REQ]->log_error("$$: $class: " . join '', @_);
+ $self->{REQ}->log_error("$$: $class: " . join '', @_);
}
sub log_error {
my($self, $msg) = @_;
my $class = ref $self;
- $self->[REQ]->log_error("$$: $class: $msg");
- $self->[REQ]->notes->set('error-notes' => $msg);
- [EMAIL PROTECTED]>[URI]} = $msg;
+ $self->{REQ}->log_error("$$: $class: $msg");
+ $self->{REQ}->notes->set('error-notes' => $msg);
+ [EMAIL PROTECTED]>{URI}} = $msg;
}
#########################################################################
----
RegistryLoader.pm:
-----------
--- RegistryLoader.pm.cvs 2003-02-25 23:19:23.000000000 -0600
+++ RegistryLoader.pm 2003-02-25 23:19:33.000000000 -0600
@@ -104,7 +104,7 @@
# specified by the 'package' attribute, not RegistryLoader
sub namespace_root {
join '::', ModPerl::RegistryCooker::NAMESPACE_ROOT,
- shift->[ModPerl::RegistryCooker::REQ]->{package};
+ shift->{REQ}->{package};
}
# override Apache class methods called by Modperl::Registry*. normally
---
Thanks,
--
Nathan Byrd <[EMAIL PROTECTED]>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
