Thread Kindobjekte schon gelöscht bei global destruction (2 answers)
Opened by topeg at 2011-02-10 10:38

topeg
 2011-02-10 10:38
#145551 #145551
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Ich finde dazu nichts Hilfreiches und setze mal meine Sachen hier rein.

Zum Problem.
Am wenn das übergeordnete Objekt Zerstrört wird, sollen alle Kind-Objkte zusammen gespeichert werden. (es kann auch eine andere Aktion sein, die ausgeführt werden soll)
Um das Speichern zu beschleunigen, soll nur dann gespeichert werden, wenn sich tatsächlich etwas geändert hat. Es muss also eine Beziehung vom Kind zum übergeordneten Objekt geben, damit dieses eine Änderung Bekannt machen kann.

Das Eigentliche Problem tritt währen der "global destruction" am Ende des Scriptes. Auch hier soll automatisch gespeichert werden.
Aber Perl hat schon angefangen die Kindobjekte zu zerstören, so das der Baum nicht mehr Vollständig ist, wenn es zum speichern kommt.
Interessanter weise kommt es nur dann zu dem Problem wenn das Kind-Objekt irgendeine Refenz auf das Übergeordnete Objekt hat.

Beispiel:
more (17.2kb):
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

#!/usr/bin/perl
use strict;
use warnings;

########################################################################
package mytest;

sub new { bless({obj=>{}, update=>0 },$_[0]); }

sub add
{
  my $self=shift;
  my $name=shift;
  my $obj=$self->{obj};
  if($name && !exists($obj->{$name}))
  {
    my $val=shift;
    $obj->{$name}=mytest::child->new($name,$val,$self);
    $self->{update}=1;
  }
}

sub get
{
  my $obj=shift->{obj};
  return exists($obj->{$_[0]})?$obj->{$_[0]}:undef;
}

sub save
{
  my $self=shift;
  my %obj=%{$self->{obj}};
  if(%obj && $self->{update})
  {
    # save dummy
    print $_->serialized() for(values(%obj));
  }
}

sub DESTROY
{
  my $self=shift;
  $self->save();

  for(values(%{$self->{obj}}))
  { delete($_->{up}); }
}

########################################################################
package mytest::child;

sub new
{
  my $class=shift;
  bless({ name => shift, val => shift, up => shift, },$class);
}

sub val
{
  my $self=shift;
  if(@_)
  {
    $self->{val}=shift;
    $self->{up}->{update}=1 if($self->{up});
  }
  $self->{val};
}

sub name{ shift()->{name}; }

sub serialized { '{ '.join(', ',map{"$_ => ".$_[0]->{$_}}qw(name val))." }\n"; }

########################################################################
########################################################################
########################################################################
package main;
use Data::Dumper;

my $t=mytest->new();
$t->add(qw(test1 A));
$t->add(qw(test2 B));
$t->add(qw(test3 C));
$t->add(qw(test4 D));

print Dumper($t);


Auch wenn man es über eine Sub-Referenz versucht tritt das Problem auf:

more (17.7kb):
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

#!/usr/bin/perl
use strict;
use warnings;

########################################################################
package mytest;

sub new { bless({obj=>{}, update=>0 },$_[0]); }

sub add
{
  my $self=shift;
  my $name=shift;
  my $obj=$self->{obj};
  if($name && !exists($obj->{$name}))
  {
    my $val=shift;
    $obj->{$name}=mytest::child->new($name,$val,sub{ $self->{update}=1 });
    $self->{update}=1;
  }
}

sub get
{
  my $obj=shift->{obj};
  return exists($obj->{$_[0]})?$obj->{$_[0]}:undef;
}

sub save
{
  my $self=shift;
  my $obj=$self->{obj};
  if(%$obj && $self->{update})
  {
    # save dummy
    print $_->serialized() for(values(%$obj));
    $self->{update}=0;
  }
}

sub DESTROY
{
  my $self=shift;
  $self->save();

  for(values(%{$self->{obj}}))
  { delete($_->{do_update}); }
}

########################################################################
package mytest::child;

sub new
{
  my $class=shift;
  bless({ name => shift, val => shift, do_update => shift, },$class);
}

sub val
{
  my $self=shift;
  if(@_)
  {
    $self->{val}=shift;
    $self->{do_update}->() if($self->{do_update});
  }
  $self->{val};
}

sub name{ shift()->{name}; }

sub serialized { '{ '.join(', ',map{"$_ => ".$_[0]->{$_}}qw(name val))." }\n"; }

########################################################################
########################################################################
########################################################################
package main;
use Data::Dumper;

my $t=mytest->new();
$t->add(qw(test1 A));
$t->add(qw(test2 B));
$t->add(qw(test3 C));
$t->add(qw(test4 D));

print Dumper($t);


Man muss dann wohl auf Referenzen zu verzichten.

Eine Möglichkeit:
more (19.2kb):
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
use strict;
use warnings;

########################################################################
package mytest;

sub new { bless({obj=>{}, update=>0 },$_[0]); }

sub add
{
  my $self=shift;
  my $name=shift;
  my $obj=$self->{obj};
  if($name && !exists($obj->{$name}))
  {
    my $val=shift;
    $obj->{$name}=mytest::child->new($name,$val);
    $self->{update}=1;
  }
}

sub get
{
  my $obj=shift->{obj};
  return exists($obj->{$_[0]})?$obj->{$_[0]}:undef;
}

sub save
{
  my $self=shift;
  my %obj=%{$self->{obj}};
  my $update=$self->{update};

  if(!$update && %obj)
  {
    for(values(%obj))
    {
      if($_->updated())
      {
        $update=1;
        last;
      }
    }
  }

  if(%obj && $update)
  {
    # save dummy
    for(values(%obj))
    {
      print $_->serialized();
      $_->updated(0);
    }
  }
}

sub DESTROY{ shift()->save(); }

########################################################################
package mytest::child;

sub new
{
  my $class=shift;
  bless({ name => shift, val => shift, up => shift, },$class);
}

sub val
{
  my $self=shift;
  if(@_)
  {
    $self->{val}=shift;
    $self->{update}=1;
  }
  $self->{val};
}

sub name{ shift()->{name}; }

sub serialized { '{ '.join(', ',map{"$_ => ".$_[0]->{$_}}qw(name val))." }\n"; }

sub updated
{
  my $self=shift;
  $self->{update}=shift if(@_);
  return $self->{update};
}
########################################################################
########################################################################
########################################################################
package main;
use Data::Dumper;

my $t=mytest->new();
$t->add(qw(test1 A));
$t->add(qw(test2 B));
$t->add(qw(test3 C));
$t->add(qw(test4 D));

print Dumper($t);


Der Nachteil dabei ist, dass das speichern von vielen Objekten, die auch noch tief verschachtelt sein können, sehr langsam wird. Immerhin müssen im Extremfall alle Objekte abgefragt werden, ohne dass gespeichert werden muss.


Eine bessere Lösung ist dies:
more (16.5kb):
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

#!/usr/bin/perl
use strict;
use warnings;


########################################################################
package mytest;

our %update;

sub new{ bless({ obj=>{}, },$_[0]); }

sub add
{
  my $self=shift;
  my $name=shift;
  my $obj=$self->{obj};
  if($name && !exists($obj->{$name}))
  {
    my $val=shift;
    $obj->{$name}=mytest::child->new($name,$val,"$self");
    $update{"$self"}=1;
  }
}

sub get
{
  my $obj=shift->{obj};
  return exists($obj->{$_[0]})?$obj->{$_[0]}:undef;
}

sub save
{
  my $self=shift;
  my %obj=%{$self->{obj}};
  if(%obj && $update{"$self"})
  {
    # save dummy
    for(values(%obj))
    { print $_->serialized(); }
    delete($update{"$self"});
  }
}

sub DESTROY{ shift()->save(); }

########################################################################
package mytest::child;

sub new
{
  my $class=shift;
  bless({ name => shift, val => shift, up=>shift, },$class);
}

sub val
{
  my $self=shift;
  if(@_)
  {
    $self->{val}=shift;
    $mytest::update{$self->{up}}=1 if($self->{up});
  }
  $self->{val};
}

sub name{ shift()->{name}; }

sub serialized { '{ '.join(', ',map{"$_ => ".$_[0]->{$_}}qw(name val))." }\n"; }

########################################################################
########################################################################
########################################################################
package main;
use Data::Dumper;

my $t=mytest->new();
$t->add(qw(test1 A));
$t->add(qw(test2 B));
$t->add(qw(test3 C));
$t->add(qw(test4 D));

print Dumper($t);


Man kann es eine symbolische Referenz nennen, was da benutzt wird.
Last edited: 2011-02-10 10:48:38 +0100 (CET)

View full thread Kindobjekte schon gelöscht bei global destruction