1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
package Erbe; use CGI; use base 'CGI'; use strict; sub new{ my $class = shift; my $cgi = $class->SUPER::new; return bless {CGI => $cgi}, $class; } sub header{ my $self = shift; my $class = ref($self); return $self->{CGI}->SUPER::header(@_); }
1
2
3
4
5
6
7
8
9
10
Content-Type: text/plain; charset=ISO-8859-1
bless({
CGI => bless({
".charset" => "ISO-8859-1",
".fieldnames" => {},
".header_printed" => 1,
".parameters" => [],
}, "Erbe"),
}, "Erbe")
1
2
3
4
5
sub param{
my $self = shift;
my $class = ref($self);
return $self->{CGI}->SUPER::param(@_);
}
2011-04-12T08:35:28 rosti[...]
Das geerbte CGI-Objekt steckt in $self->{CGI}, damit die geerbten Methoden nicht meine eigenen Attribute überschreiben.
[...]
1 2 3 4 5 6
package main; use Data::Dump qw(dump); my $u = Erbe->new; print $u->{CGI}->header('text/plain'); print dump($u),"\n"; print join "\n", $u->{CGI}->param;
QuoteMir ist allerdings auch nicht auf Anhieb klar, warum das Objektattribut CGI anscheinend in einer Methode undefiniert ist und in einer anderen nicht.
return $self->{CGI}->SUPER::header(@_);
2011-04-12T11:28:27 pqlass die vererbung und das SUPER:: einfach weg.
aber ich wiederhole mich.
2011-04-12T13:04:07 pqim prinzip habe ich dir auch plan B nahegelegt (vererbung weg und SUPER:: weglassen, und schon wäre es eine simple delegation gewesen). wenn du nicht verstanden hast, was ich meinte, hättest du ja nachfragen können. stattdessen hast du darauf bestanden, dass du das schon so hinkriegst, wie du dir das ausgedacht hast, obwohl dir 2 leute gesagt haben, dass sie das ziemlich merkwürdig finden, was du da machst.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
package Foo; # BaseClass sub new{ my $class = shift; return bless {}, $class; } sub fx{ my $self = shift; $self->{FX} = "xxxxxxxxxxxxx xxxxxxxxxxxxxx xxx"; } ########################################################################### package Bar; use base 'Foo'; # Inherit from Foo sub new{ my $class = shift; my $foo = $class->SUPER::new; return bless {FOO => $foo}, $class; } ######################## OVERLOAD Foo::Methods ############################ sub fx{ my $self = shift; $self->{FOO}->SUPER::fx; } ########################################################################### package main; use Data::Dump qw(dump); my $o = Bar->new; $o->fx; print dump($o); # alles am rechten Platz
print $o->UNIVERSAL::isa('Bar'); # Bar => 1, Foo => 1
1 2 3 4 5 6 7 8 9
sub header{ my $self = shift; return $self->{CGI}->header(@_); } sub param{ my $self = shift; return $self->{CGI}->param(@_); }
2011-04-12T20:46:08 rostiDie Methoden werden in dem Moment geerbt, wenn mit use base 'CGI' die Superklasse eingebunden wird. Dann ist für param und header der eigene Code:
Code (perl): (dl )1 2 3 4 5 6 7 8 9sub header{ my $self = shift; return $self->{CGI}->header(@_); } sub param{ my $self = shift; return $self->{CGI}->param(@_); }
ein Overload. Derselbe Code ist eine Delegation, wenn kein use base 'CGI'; oder our @ISA = qw(CGI); erfolgte.
Es funktioniert sowohl der Overload als auch die Delegation mit obenstehenden Code.
2011-04-12T20:46:08 rostiEdit: Die Delegation ist handhabungssicherer,
2011-04-12T20:46:08 rostider Programmierer ist gezwungen, die Methode zu definieren, sonst ist sie nicht vorhanden.
2011-04-12T20:46:08 rostiWerden Methoden geerbt, sind sie vorhanden aber funktionieren nicht erwartungsgemäß wenn sie nicht überschrieben wurden.
1 2 3 4 5 6
use warnings; use strict; use CGI; my $c = CGI->new; print $c->UNIVERSAL::can('header'); # undefined
print $c->can('header');
print UNIVERSAL::can($c,'header');
QuoteCode: (dl )1
2
3
4
5
6
7...
$sub = eval { $ref->can("fandango") };
$ver = $obj->VERSION;
# but never do this!
$is_io = UNIVERSAL::isa($fd, "IO::Handle");
$sub = UNIVERSAL::can($obj, "print");
QuoteIn dem Zusammenhang korrigiere ich mich. Nur $c->can('header') funktioniert.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
package MyCMS; use strict; use warnings; use CGI; sub new { my ($class) = @_; my $self = bless {}, $class; $self->{cgi} = CGI->new; return $self; } sub param { my ($self,@param) = @_; return $self->{cgi}->param( @param ); } 1;
QuoteDas habe ich so verstanden, dass Du das Parsen selbst implementiert hast und nicht die Methode von CGI.pm nutzt.Das habe ich bisher so gelöst, dass in CMS.pm ein eigener Parser eingebaut ist, der POST oder GET-Parameter ganz genauso parst wie das CGI.pm macht und auch so heißt: param.
2011-04-13T09:06:31 reneeQuoteDas habe ich so verstanden, dass Du das Parsen selbst implementiert hast und nicht die Methode von CGI.pm nutzt.Das habe ich bisher so gelöst, dass in CMS.pm ein eigener Parser eingebaut ist, der POST oder GET-Parameter ganz genauso parst wie das CGI.pm macht und auch so heißt: param.