[langage] Re besoin d'un coup de main avec l'encapsulation

**mobscene** · 21/10/2006, 18h56

Me revoila

j'ai fait une classe qui fait la meme chose que Thread::Queue sauf que j'utilise un dbm en l'occurence le module DBM:

eep, mais seulement voila j'ai un problème de référence

voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
package System::File::DBM;
use threads::shared;
use DBM::Deep;
use Data::Dumper;
use Compress::Zlib;
# http://search.cpan.org/~rkinyon/DBM-Deep-0.983/lib/DBM/Deep.pm
 
our @ISA = ("DBM::Deep");
 
sub new {
  my $class = shift;
  my $Qna   = shift;
  my $db = $class->SUPER::new(
      file               => $Qna->{'Store'},
      filter_store_key   => \&_compress,
      filter_store_value => \&_compress,
      filter_fetch_key   => \&_decompress,
      filter_fetch_value => \&_decompress
  );
  share(%$db);
  return bless \%$db, $class;
}
 
 
sub enqueue
{
  my $db    = shift;
  my $value = shift;
  my $key   = shift;
  lock(%$db);
  if ( defined $key and ref($value) eq "HASH" || "ARRAY")
  {
     eval
     {
        $db->put($key, $value) and cond_signal %$db;
     };
     if ($@)
     {
        warn "\nErreur fonction enqueue avec clef\n";
        print $@;
        exit;
     }
  }
    else
  {
     if ( ref($value) eq "HASH" || "ARRAY" and exists $value->{'url'} )
     {
       eval
       {
         $db->put($value->{'url'}, $value)  and cond_signal %$db;
       };
       if ($@)
       {
         warn "\nErreur fonction enqueue\n";
         print $@;
         exit;
       }
     }
  }
}
 
 
 
sub dequeue
{
  my $db = shift;
  my $temp = undef;
  lock(%$db);
  my $max = 5;
  cond_wait %$db until %$db;
  cond_signal %$db if [%$db] > 1; # vive les hack
  if  ( [%$db] > 1 )
  {
     eval
     {
        while ( my ($c, $v) = each(%$db) and $max > 0)
        {
          $temp->{$c} = $v if defined $c;
          $db->delete($c) if defined $c; 
        }
       $db->optimize();
       return $temp;
     };
     if ($@)
     {
       warn "\nErreur dans la fonction dequeue\n";
       print $@;
       exit;
     }
  }
   else
  {
    return {};
  }
}
 
 
sub pending
{
  my $db = shift;
  lock(%$db);
   return scalar keys %$db;
}
 
 
sub flush
{
  my $db = shift;
  lock(%$db);
  $db->clear();
  $db->optimize();
}
 
sub optimize
{
  my $db = shift;
  lock(%$db);
  $db->optimize();
} 
 
 
sub _compress
{
   return Compress::Zlib::memGzip( $_[0] ) ;
}
 
sub _decompress
{
   return Compress::Zlib::memGunzip( $_[0] ) ;
}
 
 
1;

Quand j'invoque la fonction enqueue dans mon script de teste comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/perl -w
use strict;
use diagnostics;
use Data::Dumper;
use System::File::DBM;
 
my $i = new System::File::DBM ({ Store => 'db_compress.db' });
 
   $i->enqueue(  {  url => 'http://www.free.fr', 'teste' => ['e', { 'm' => 55 }]  }  );
 
my $m = $i->dequeue();
 
print Dumper($m);

perl me renvoie l'erreur

Can't locate object method "_get_self" via package "System::File:

BM" at G:/Program Files/Perl/site/lib/DBM/Deep.pm line 1326.

merci de votre aide a tous

**Woufeil** · 22/10/2006, 00h32

Bonjour,

Tu es sûr que ton problème viens de enqueue ? Au pire, si tu lui passes n'importe quoi, elle ne fait rien. Si il y a une erreur, tu gères ça par des exceptions, donc pas de problèmes...

A mon avis, le problème viens du constructeur. Tu peux nous montrer le code de share s'il te plait ?

**mobscene** · 22/10/2006, 02h10

Heu le code de Thread::Shared ? heu le vala

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
package threads::shared;
 
use 5.008;
 
use strict;
use warnings;
 
our $VERSION = '1.01';
 
BEGIN {
    # Declare that we have been loaded
    $threads::shared::threads_shared = 1;
}
 
 
# Load the XS code, if applicable
if ($threads::threads) {
    require XSLoader;
    XSLoader::load('threads::shared', $VERSION);
 
    *is_shared = \&_id;
 
} else {
    # String eval is generally evil, but we don't want these subs to
    # exist at all if 'threads' is not loaded successfully.
    # Vivifying them conditionally this way saves on average about 4K
    # of memory per thread.
    eval <<'_MARKER_';
        sub share          (\[$@%])         { return $_[0] }
        sub is_shared      (\[$@%])         { undef }
        sub cond_wait      (\[$@%];\[$@%])  { undef }
        sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
        sub cond_signal    (\[$@%])         { undef }
        sub cond_broadcast (\[$@%])         { undef }
_MARKER_
}
 
 
### Export ###
 
sub import
{
    # Exported subroutines
    my @EXPORT = qw(share is_shared cond_wait cond_timedwait
                    cond_signal cond_broadcast);
    if ($threads::threads) {
        push(@EXPORT, 'bless');
    }
 
    # Export subroutine names
    my $caller = caller();
    foreach my $sym (@EXPORT) {
        no strict 'refs';
        *{$caller.'::'.$sym} = \&{$sym};
    }
}
 
 
### Methods, etc. ###
 
sub threads::shared::tie::SPLICE
{
    require Carp;
    Carp::croak('Splice not implemented for shared arrays');
}
 
1;
 
__END__

**mobscene** · 23/10/2006, 02h07

Personne n'a d'idée ?

[langage] Re besoin d'un coup de main avec l'encapsulation

Langage Perl

Discussions similaires

Partager

Partager