Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]12266[/thread]

Problem mit Klassen



<< >> 7 Einträge, 1 Seite
Gast Gast
 2008-07-29 01:43
#112840 #112840
Hallo,
Die Klasse module_proto soll ein generisches Datenmodul beschreiben, das eine Reihe von Grundfunktionalitäten mitbringt, hier etwa 'list' und 'edit'.
'list' ist der Input für _handle_event(), welche über $Self->{'ActionHash'} die zugehörige Funktion list_all() findet und aufruft.

Die abgeleitete Klasse module_sources definiert list_all() neu und wird wie gewünscht mittels 'list' aufgerufen.
Mit 'edit' soll aber edit_one() in module_proto aufgerufen werden. Das klappt nicht und ich denke, es kann auch garnicht!

Wie kann ich es richtig machen???
Danke!
Die total abgespeckten Klassen:
Code (perl): (dl )
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

package classes::module_proto;

our %ActionsHash        =
        (
        "list"  => { 'postaction' => \&list_all, },
        "edit"  => { 'postaction' => \&edit_one, },
        );
                
sub new
        {
        my ($pkg, $name ) = @_;
        #------------------
        my $Self = {};
        #------------------
        bless( $Self, (ref $pkg || $pkg) );
        $Self->{'ActionHash'}   = \%ActionsHash; 
        # ...
        return $Self;
        }


sub _handle_event
        {
        my $Self = shift;
        my $action = shift;
        # ...
        my $func = $actionshash->{ $action }->{'postaction'} ;
        # ...
        ($result, $error) = $func->(@_) ;
        # ...
        return ($result, $error);
        }


sub edit_one    
        {
        my $Self = shift;
        # ...
        return ( 1, undef);
        }

sub list_all
        {
        my $Self = shift;
        # ...
        return ( 1, undef);
        }
        
#-------

package classes::module_sources;

use classes::module_proto;
our @ISA = qw(classes::module_proto);

my %SourcesActionsHash  =
        (
        "list"  => { 'postaction' => \&list_all, },
        "edit"  => { 'postaction' => \&edit_one, },
        );


sub new
        {
        my ($pkg, $name ) = @_;
        #------------------
        my $Self = $pkg->SUPER::new( $name );
        bless( $Self, (ref $pkg || $pkg) );

        $Self->{'ActionHash'}   = \%SourcesActionsHash; 

        return $Self;
        }


sub list_all
        {
        my $Self = shift;
        # ... tu etwas spezielles mit sources
        return ( 1, undef);
        }       
#-------
1;
MatthiasW
 2008-07-29 13:33
#112861 #112861
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
Du könntest das package mit angeben in dem die Subroutine liegt:
Code: (dl )
"edit" => { 'postaction' => \&classes::module_proto::edit_one }

Oder du änderst es einfach in folgendes:
Code: (dl )
"edit" => { 'postaction' => sub { $_[0]->edit_one } }

Das würde ich dir empfehlen.
Dann wird, falls edit_one() in module_sources definiert ist, diese genommen, ansonsten wird die Subroutine aus module_proto genommen.

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
Gast Gast
 2008-07-30 00:41
#112883 #112883
Danke, MatthiasW, die zweite Variante war genau meine Wunschlösung!

Leider klappt es doch noch nicht, ich erhalte die Meldungen:
Code: (dl )
quellen:module_proto::_handle_event(15): Eintrag gefunden:'CODE(0x1947640)'; $_0='classes::module_sources=HASH(0x197828c)'!;

Eine Kontrollausgabe von mir, die die Lösung bestätigt, aber dann:
Code: (dl )
1
2
3
4
Undefined subroutine &classes::module_sources::edit_one called at
	../../../cgi-bin/classes/module_sources.pm line 66, <file1> line 162 (#4)
    (F) The subroutine indicated hasn't been defined, or if it was, it has
    since been undefined.

Also scheint doch kein Nachsuchen im modul_proto zu erfolgen?
MatthiasW
 2008-07-31 16:50
#112946 #112946
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
Mmh.. also ich kann dein Problem bei mir leider nicht rekonstruieren:
Code (perl): (dl )
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

#!/usr/bin/perl

package classes::module_proto;

use strict;
use warnings;

our %ActionsHash        =
        (
        "list"  => { 'postaction' => sub { $_[0]->list_all() } },
        "edit"  => { 'postaction' => sub { $_[0]->edit_one() } },
        );
                
sub new
        {
        my ($pkg, $name ) = @_;
        #------------------
        my $Self = {};
        #------------------
        bless( $Self, (ref $pkg || $pkg) );
        $Self->{'ActionHash'}   = \%ActionsHash; 
        # ...
        return $Self;
        }


sub _handle_event
        {
        my $Self = shift;
        my $action = shift;
        # ...
        my $func = $ActionsHash{ $action }{'postaction'} ;
        # ...
        my ($result, $error) = $func->( $Self, $action ) ;
        # ...
        return ($result, $error);
        }


sub edit_one    
        {
        my $Self = shift;
        # ...
        return ( 1, undef);
        }

sub list_all
        {
        my $Self = shift;
        # ...
        return ( 1, undef);
        }
        
#-------

package classes::module_sources;

use strict;
use warnings;

our @ISA = qw( classes::module_proto );

my %SourcesActionsHash  =
        (
        "list"  => { 'postaction' => sub { $_[0]->list_all() } },
        "edit"  => { 'postaction' => sub { $_[0]->edit_one() } },
        );


sub new
        {
        my ($pkg, $name ) = @_;
        #------------------
        my $Self = $pkg->SUPER::new( $name );
        bless( $Self, (ref $pkg || $pkg) );

        $Self->{'ActionHash'}   = \%SourcesActionsHash; 

        return $Self;
        }

sub list_all
        {
        my $Self = shift;
        # ... tu etwas spezielles mit sources
        return ( 1, undef);
        }       
#-------

package main;

use strict;
use warnings;

use Data::Dumper;

my $sources = classes::module_sources->new();

print Dumper $sources->_handle_event( 'edit' );
<STDIN>;

__END__

Läuft bei mir ohne Probleme.
Zeig mal etwas mehr Code.

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
Gast Gast
 2008-08-01 03:06
#112969 #112969
Bei Dir gehts, aber Du hast auch etwas geflunkert, denn in Zeile 032 greifst Du direkt auf den Klassen-Hash ActionsHash und so wird die Vererbung nicht gefordert. (Übrigens:
Code: (dl )
%ActionsHash
spielt keine Rolle und ist nur beispielhaft angelegt.)
Mit dieser Zeile 032 funktioniert es und auch noch wenn ich das Beispiel auf drei Dateien verteile!:
Code (perl): (dl )
 032:        my $func = $Self->{'ActionHash'}->{ $action }->{'postaction'} ;

Ich habe den modifizierten originalen _handle_event funktionierend in das Beispiel eingebaut.
Nur gelingt es mir nach wie vor nicht das Ergebnis in das Gesamtprogramm zu übertragen. Die Fehlermeldung lautet weiterhin wie oben. :-(
Vererbung funktioniert grundsätzlich, weil ich new() der Superklasse benutze und von dort _initialize() von "module_sources" aufrufe.

Code (perl): (dl )
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

sub _handle_event
        {
        my $Self           = $_[0];
        #my $actionarr  = $_[1];
        #----
        my $dphase       = 0; #$actionarr->[0];
        my $module       = ''; #$actionarr->[1];
        my $action         = 'edit'; #$actionarr->[2] ;
        #----
        my $phase         = $dphase ? 'doaction' : 'postaction';
        my $result;
        my $error;
        my $actionshash = $Self->{'ActionHash'};
        #-------
        if( exists $actionshash->{ $action }->{ $phase } 
                        && defined $actionshash->{ $action }->{ $phase }  
                                && ref( $actionshash->{ $action }->{ $phase }  ) eq 'CODE')
                {
                my $func = $actionshash->{ $action }->{$phase} ;
                #-------
                if(!$dphase)
                        {
                        ($result, $error) = $func->( @_ ) ;
                        }
                else { }
                }
        else
                {
                die "Kein ausfuehrbarer Eintrag gefunden!;";
                }
        return ($result, $error);
        }
MatthiasW
 2008-08-01 22:34
#113008 #113008
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
Gast+2008-08-01 01:06:41--
Bei Dir gehts, aber Du hast auch etwas geflunkert, denn in Zeile 032 greifst Du direkt auf den Klassen-Hash ActionsHash und so wird die Vererbung nicht gefordert.

Deinem Beispielcode konnte ich das nicht anders entnehmen, sorry.
Kannst du vielleicht nochmal ein Beispiel zeigen, indem es nicht funktioniert? Denn im Moment kann ich dir nicht ganz folgen, und deine genannte Meldung auch nicht nachvollziehen, wobei hier noch interessant wäre zu wissen, welchen Code du eingebaut hast, und auch wo, um diese Meldung zu erzeugen.
Am einfachsten wäre es dir zu helfen, wenn du ein Beispiel posten würdest, das strict und warnings konform ist, und dein Problem wiederspiegelt.

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
Gast Gast
 2008-08-03 01:13
#113032 #113032
Endlich, ich hab´s! :-)

Ich habe die drei beteiligten Module (Dispatcher, Proto und Sources) isoliert und direkt angesprochen, funktionierte!
Dann habe ich Stück für Stück zurückgebaut, bis der Fehler wieder auftrat.


Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14

my %SourcesActionsHash  =
        (


        "new"   =>
                {
                'right'         =>              {"admin" => ''},
                'doaction'      =>              undef,
                'nextaction'    =>              \&edit_one,
                'erroraction'   =>              'list_all',
                },
        

        );


Der im Orginal größere %SourcesActionsHash enthielt noch ein vergessenes \&edit_one (aus der Vorgängerversion), dass scheinbar ausreichte um die Vererbung zu verhindern!?
Wie auch immer, schon etwas magic...

Danke für den Beistand!
<< >> 7 Einträge, 1 Seite



View all threads created 2008-07-29 01:43.