Ungewollte Ueberspeicherung von Werten eines struct in einem hash

J

Jaque

Grünschnabel
[Perl]Ungewollte Ueberspeicherung von Werten eines struct in einem hash

Hallo,

mein Problem ist, dass die "score"-Werte des globalen hash %network ueberspeichert werden.
Was ich will ist, dass in der Subroutine "scoren" eine Kopie von %network mit dem value von %NOA ausgestattet und zurueckgegeben wird. (Siehe nachfolgendes Bsp.)
Am Ende sollte ausgegeben werden P0=0.9

Code:
my (%network, %NOA); 

use Class::Struct;

struct Node => {
	score => '$',
	strange => '@',
};
# network hash mit key P0, value=Node 
my $key = "P0";
my $first = Node->new();
$first->score(0.9);
$network{$key} = $first;	

# der hash mit dem Wert (0.22), den nur eine Kopie von %network erhalten soll
# leider aber auch %network erhält!
$NOA{$key}=0.22;

#Kopie von %network erhaelt neuen score (value NOA) 
our $refnet = scoren(\%NOA, \%network);

sub scoren{
	my ($refmap, $refnet) =  @_;
	my %q_map = %$refmap; my %network2 = %$refnet; 
	while (my ($key, $value) = each(%q_map)) {
		$network2{$key}->score($value);
	}
	return(\%network2);		
}

foreach (keys %network){
	$dia = $network{$_}->score;
	print "$_ = $dia \n";
}

AUSGABE: P0=0.22

Kann mir Jemand sagen, wie man diese Ueberspeicherung vermeidet (eine wirkliche Kopie %network erzeugt)?

Waere schoen wenn mir jemand weiterhelfen kann! :frage:
MfG, Jaque
 
Zuletzt bearbeitet:
Code:
#!/usr/bin/perl 
use strict; use warnings;
my (%network, %NOA); 

use Class::Struct;

struct Node => {
	score => '$',
	neighbor => '@',
};

# network hash mit key P0, value=Node 
my $key = "P0";
my $first = Node->new();
$first->score(0.9);
$first->neighbor(['P1', 'P2', 'P3']);
$network{$key} = $first; 

# der hash mit dem Wert, den nur eine Kopie von %network erhalten soll
$NOA{$key}=0.22;

#Kopie von %network erhält neuen score (von NOA)
our $refnet = scoren(\%NOA, \%network);
our %new_network = %$refnet;

# Gebe P0 zusätlichen Nachbar 
push @{$new_network{$key}->neighbor}, 'P4';

sub scoren{
	my ($refmap, $refnet) = @_;
	my %q_map = %$refmap; my %network = %$refnet; 
	my %network2; 
	while (my ($key, $value) = each(%q_map)) {
		$network2{$key} = Node->new();
		$network2{$key}->score($value);
		# Nachbarn kopieren:
		my @hold = @{$network{$key}->neighbor};
		$network2{$key}->neighbor(\@hold); 
	}
	return(\%network2); 
}

# das Ganze ausgeben
foreach (keys %network){
	print "Our old network:\n";
	my $dia = $network{$_}->score;
	print "$_ = $dia neighbors: @{$network{$key}->neighbor}\n\n";

	print "The new network:\n";
	$dia = $new_network{$_}->score;
	print "$_ = $dia neighbors: @{$new_network{$key}->neighbor}\n"; 
}
Ausgabe:
Our old network:
P0 = 0.9 neighbors: P1 P2 P3

The new network:
P0 = 0.22 neighbors: P1 P2 P3 P4
Oder objektorientiert (von dash):
Code:
#!/usr/bin/perl -w

use strict;
package Node;

=head1 NAME
Node - bla bla
=head1 SYNOPSIS
=cut

use strict;
use warnings;

use Class::Struct;

struct Node => {
score => '$',
neighbor => '@',
};

=head1 METHODS
=over 4
=item I<$object>-E<gt>B<clone>(?I<key, value, ... >?)
Returns new copy of I<$object>, takes optional key/value pairs for initialization.
=back
=cut

sub clone {
	my $self = shift;
	my $pkg = ref $self;
	# key, value assignment like score =>0.22, strange=>undef
	my %data = map { $_ => $self->$_ } $self->_accessors;
	#my %data = map { $_ => $self->{"${pkg}::$_"} } $self->_accessors;
	return $pkg->new( %data, @_ );
}

=head1 PRIVATE METHODS
=over 4
=item I<$object>-E<gt>B<_accessors>
Returns a list of I<$object>'s accessors.
=back
=cut

sub _accessors {
	my $self = shift;
	my $pkg = ref $self;
	
	#extract keys from struct: strange score
	my @accessors = grep s/^${pkg}:://, keys %{$self};
	#my @array = keys %{$self}; #= Node::strange Node::score
	return @accessors;
}

package main;

my (%network, %NOA); 

# network hash mit key P0, value=Node 
my $key = "P0";
my $first = Node->new();
$first->score(0.9);
$first->neighbor([qw(P1 P2 P3)]);
$network{$key} = $first; 

# der hash mit DEM Wert, nur für Kopie von %network 
$NOA{$key}=0.22;

#Kopie von %network erhält neuen score (von NOA) 
our $refnet = scoren(\%NOA, \%network);
our %new_network = %$refnet;

# neighbor ergänzen
push @{$network{$key}->neighbor}, 'P4';

sub scoren {
	my($refmap, $refnet) = @_;
	my %network2;

	foreach my $key ( keys %{$refmap} ) {
		# clone Node object and set new score value 
		$network2{$key} = $refnet->{$key}->clone(score => $refmap->{$key});
	}
	return \%network2;
}

for(keys %network){
	print "old network:\nkey\tscore\tneighbor\n";
	my $dia = $network{$_}->score;
	my $neigh = $network{$_}->neighbor;
	print "$_\t$dia\t@$neigh\n\n";
	
             print "new network:\n";
	$dia = $new_network{$_}->score;
	$neigh = $new_network{$_}->neighbor;
	print "$_\t$dia\t@$neigh\n";
}
Ausgabe:
old network:
key score neighbor
P0 0.9 P1 P2 P3 P4

new network:
P0 0.22 P1 P2 P3 P4
Wie man sieht, ist der zweite Code nur in Bezug auf das score-Element eine Kopie.
Danke dash (Perlboard) und PerlProfi (Perl-Community)!
 
Zurück
Oben