Stas Bekman <[EMAIL PROTECTED]> [14-11-2004 17:05]:
> Radoslaw Zielinski wrote:
[...]
>>> to support this aliasing feature. Or do you suggest to just alias the 
>>> namespaces?
>> Maybe I'm missing something.  I was thinking about just aliasing the
>> namespaces.
> It's a way more complicated than it seems to be at first sight. Search the 
> dev list's archives for EazyLife to see some of the problems.

Done...  OK, so AUTOLOAD is just a can of worms.

But, as the code we're trying to make work already knows which
modules does it need to work, we can try a different approach:
trap the "use Apache::OldName" calls with a subroutine ref in @INC.
Example implementation attached; would this work?

I actually don't really like it, as it's a hack, but... I can't see
how this could impact on anything.

Well, let's see what I've missed now ;-)

>>> Second, quite a few methods have the same API name, but a totally 
>>> different functionality. Please see lib/Apache/compat.pm starting from 
>>> overridable_mp2_api.
>>> I can't see how the two can coexist.
>>   $ cat MP2/Foo.pm 
>>   package MP2::Foo;
>>   sub sf { print shift() . "::same\n"; }
>>   sub df { print shift() . "::different\n"; }
>>   1;
> [...]
>> ...well, maybe in a smarter way.  Note, that this allows coexistence of
>> both mp1 and mp2 applications in one interpreter.
> The problem is that mp1 and mp2 aren't fully compatible, and there is no 
> way to make them so 100%, mainly. So you have a problem here. You can't 
> run all mp1 and mp2 applications under the same interpreter. Again take a 
> look at lib/Apache/compat.pm %overridable_mp2_api and read:
> http://perl.apache.org/docs/2.0/api/Apache/compat.html#Compatibility_Functions_Colliding_with_mod_perl_2_0_API

I've seen it before and still don't see a problem, when we have *different
namespaces*.  I assume, that the compatibility layer is similar (in
effect, not necessarily the implementation) to the attached one.

Can the problem you're seeing be resolved by (I don't know how to do it
mod_perl-wide; maybe a per-VirtualHost/Location directive, telling mp2
to return objects blessed into a specific namespace for a given handler?):

  package handler_for_mp1_partially_ported_to_mp2;
  sub handler {
    my $r = bless shift, 'Apache::RequestRec'; # was Apache2::RequestRec
    # same thing with $c or whatever
    ...
  }

> I think I've mentioned this already, I'm not disagreeing with you, 
> Radoslaw, that I've wished there was a better way than what we have now. 
> But if you really start implementing your proposal you will see that there 
> are problems in your idea. And some of them might be the showstopper. You 
> are more than welcome to prove me/us wrong with a concrete working code.

Are you saying that this namespace change could -- if implemented --
still get to mp2?

-- 
Radosław Zieliński <[EMAIL PROTECTED]>
[ GPG key: http://radek.karnet.pl/ ]
package MP2::compat1;
use vars qw(%h);

BEGIN {
        %h = (
                'MP1/Foo.pm' => [
                        ## I guess it'd be better to hardcode it than s///;
                        'MP1::Foo',
                        ## what needs to be done to make these methods available
                        ## (more than one require, an import maybe?)
                        'require MP2::Foo;',
                        ## old names => references to the new values
                        {
                                VERSION => \"1.29",
                                df      => sub { print shift() . 
"::different_overridden\n"; },
                                sf      => \&MP2::Foo::sf,
                        },
                ],
                'MP1/Bar.pm' => ['MP1::Bar', 'require MP2::Bar', {},],
        );
        unshift @INC, \&MP2::compat1::loader;
}

sub loader {
        my (undef, $filename) = @_;
        return undef unless exists $h{$filename};
        my $class = $h{$filename}->[0];
        while (my ($name, $value) = each %{ $h{$filename}->[2] }) {
                *{"${class}::${name}"} = $value;
        }
        eval $h{$filename}->[1];
        die "eval '$h{$class}->[1]' failed: '$@'" if $@;
        $INC{$filename} = __FILE__;
        delete $h{$class};                 # who needs it now anyway
##      require IO::String;
##      my $dummyfh = "1;\n";
##      return new IO::String \$dummyfh;   # doesn't work, I don't know why
        seek DATA, -3, 2;                  # 3 characters: "1;\n"
##      return \*DATA;                     # won't work 2nd time: it gets closed
        open my $fh, "<&DATA" or die "dup __DATA__: $!";
        return $fh;
}

1;
__DATA__
--------  only the last line is important, we seek()  --------

XXX: what about ModPerl::* namespace?  should it be ModPerl2::*?

                ## real example of %h entry, from Apache/compat.pm; not finished
                'Apache/RequestRec.pm' => [
                        'Apache::RequestRec',
                        'require Apache2::RequestRec;
                         require APR::Finfo;
                         require ModPerl::Util;
                         use Apache2::Const -compile => qw(MODE_READBYTES);
                         use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
                         use constant IOBUFSIZE => 8192;
                         require ModPerl::Global;
                        ',
                        {
                                notes => sub {
                                        my $r = shift;
                                        return
                                          wantarray()
                                          ? 
($r->table_get_set(scalar($r->$orig_sub), @_))
                                          : 
scalar($r->table_get_set(scalar($r->$orig_sub), @_));
                                },

                                finfo => sub {
                                        my $r = shift;
                                        stat $r->filename;
                                        \*_;
                                },

                                soft_timeout     => sub { },
                                hard_timeout     => sub { },
                                kill_timeout     => sub { },
                                reset_timeout    => sub { },
                                cleanup_for_exec => sub { },
                                current_callback => 
\&ModPerl::Util::current_callback,

                                send_http_header => sub {
                                        my ($r, $type) = @_;
                                        ## since send_http_header() in mp1 was 
telling mod_perl not to
                                        ## parse headers and in mp2 one must 
call $r->content_type($type) to
                                        ## perform the same, we make sure that 
this happens
                                        $type = $r->content_type || 'text/html'
                                          unless defined $type;
                                        $r->content_type($type);
                                },
                                request => \&Apache2::request,    # FIXME: 
require?

                                table_get_set => sub {
                                        my ($r, $table) = (shift, shift);
                                        my ($key, $value) = @_;

                                        if (1 == @_) {
                                                return wantarray()
                                                  ? ($table->get($key))
                                                  : scalar($table->get($key));
                                        }
                                        elsif (2 == @_) {
                                                if (defined $value) {
                                                        return wantarray()
                                                          ? ($table->set($key, 
$value))
                                                          : 
scalar($table->set($key, $value));
                                                }
                                                else {
                                                        return wantarray()
                                                          ? 
($table->unset($key))
                                                          : 
scalar($table->unset($key));
                                                }
                                        }
                                        elsif (0 == @_) {
                                                return $table;
                                        }
                                        else {
                                                my $name = (caller(1))[3];
                                                $r->warn("Usage: 
\$r->$name([key [,val]])");
                                        }
                                },

                                header_out => sub {
                                        my $r = shift;
                                        return
                                          wantarray()
                                          ? 
($r->table_get_set(scalar($r->headers_out), @_))
                                          : 
scalar($r->table_get_set(scalar($r->headers_out), @_));
                                },

                                header_in => sub {
                                        my $r = shift;
                                        return
                                          wantarray()
                                          ? 
($r->table_get_set(scalar($r->headers_in), @_))
                                          : 
scalar($r->table_get_set(scalar($r->headers_in), @_));
                                },

                                err_header_out => sub {
                                        my $r = shift;
                                        return
                                          wantarray()
                                          ? 
($r->table_get_set(scalar($r->err_headers_out), @_))
                                          : scalar(
                                                
$r->table_get_set(scalar($r->err_headers_out), @_));
                                },

                                register_cleanup => sub {
                                        shift->pool->cleanup_register(@_);
                                },

                                ## FIXME: Will it work?  Depends on the 
previous hash entry,
                                ## and this subroutine isn't loaded yet.  
Resolveable anyway...
                                post_connection => 
\&Apache::RequestRec::register_cleanup,

                                get_remote_host => sub {
                                        my ($r, $type) = @_;
                                        $type = Apache2::REMOTE_NAME unless 
defined $type;
                                        $r->connection->get_remote_host($type, 
$r->per_dir_config);
                                },

                                parse_args => sub {
                                        my ($r, $string) = @_;
                                        return () unless defined $string and 
$string;

                                        return map {
                                                tr/+/ /;
                                                
s/%([0-9a-fA-F]{2})/pack("C",hex($1))/ge;
                                                $_;
                                        } split /[=&;]/, $string, -1;
                                },

                                content => sub {
                                        my $r = shift;

                                        my $bb =
                                          APR::Brigade->new($r->pool, 
$r->connection->bucket_alloc);

                                        my $data     = '';
                                        my $seen_eos = 0;
                                        do {
                                                
$r->input_filters->get_brigade($bb,
                                                        
Apache2::MODE_READBYTES, APR::BLOCK_READ, IOBUFSIZE);
                                                while (!$bb->is_empty) {
                                                        my $b = $bb->first;

                                                        if ($b->is_eos) {
                                                                $seen_eos++;
                                                                last;
                                                        }

                                                        if ($b->read(my $buf)) {
                                                                $data .= $buf;
                                                        }

                                                        $b->delete;
                                                }
                                        } while (!$seen_eos);

                                        $bb->destroy;

                                        return $data unless wantarray;
                                        return $r->parse_args($data);
                                },

                                server_root_relative => sub {
                                        my $r = shift;
                                        
File::Spec->catfile(Apache::ServerUtil::server_root, @_);
                                },

                                clear_rgy_endav => sub {
                                        my ($r, $script_name) = @_;
                                        my $package = 'Apache::ROOT' . 
$script_name;
                                        ModPerl::Global::special_list_clear(END 
=> $package);
                                },

                                stash_rgy_endav => sub {
                                        ##see run_rgy_endav
                                },

                                seqno => sub { 1; },

                                chdir_file => sub {
                                        ##XXX resolve '.' in @INC to basename 
$r->filename
                                },

                                #XXX: would like to have a proper implementation
                                #that reads line-by-line as defined by $/
                                #the best way will probably be to use perlio in 
5.8.0
                                #anything else would be more effort than it is 
worth
                                READLINE => sub {
                                        my $r = shift;
                                        my $line;
                                        $r->read($line, 
$r->headers_in->get('Content-length'));
                                        $line ? $line : undef;
                                },

                                #XXX: howto convert PerlIO to apr_file_t
                                #so we can use the real ap_send_fd function
                                #2.0 ap_send_fd() also has an additional offset 
parameter

                                send_fd_length => sub {
                                        my ($r, $fh, $length) = @_;

                                        my $buff;
                                        my $total_bytes_sent = 0;
                                        my $len;

                                        return 0 if $length == 0;

                                        if (   ($length > 0)
                                                && ($total_bytes_sent + 
IOBUFSIZE) > $length)
                                        {
                                                $len = $length - 
$total_bytes_sent;
                                        }
                                        else {
                                                $len = IOBUFSIZE;
                                        }

                                        binmode $fh;
                                },

                                send_fd => sub {
                                        my ($r, $fh) = @_;
                                        $r->send_fd_length($fh, -1);

                                },

                                is_main => sub { !shift->main },
                        },
                ],
## FIXME: do these belong here?
##      Apache::unescape_url_info sub {
##          my($class, $string) = @_;
##          Apache::URI::unescape_url($string);
##          $string =~ tr/+/ /;
##          $string;
##      }
##      
##      ##sorry, have to use $r->Apache::args at the moment
##      ##for list context splitting
##      
##      Apache::args sub {
##          my $r = shift;
##          my $args = $r->args;
##          return $args unless wantarray;
##          return $r->parse_args($args);
##      }
##      #if somebody really wants to have END subroutine support
##      #with the 1.x Apache::Registry they will need to configure:
##      # PerlHandler Apache::Registry Apache::compat::run_rgy_endav
##      Apache::compat::run_rgy_endav sub {
##          my $r = shift;
##      
##          require ModPerl::Global;
##          require Apache::PerlRun; #1.x's
##          my $package = Apache::PerlRun->new($r)->namespace;
##      
##          ModPerl::Global::special_list_call(END => $package);
##      }


1;

Attachment: pgpCjdCVhH7Jb.pgp
Description: PGP signature

Reply via email to