3dbc has asked for the wisdom of the Perl Monks concerning the following question:

Hello Prestigious Monks..:
I need help with amalgamating primary keys to uniformity so that they are no longer stored in a variety of formats. These are the primary Keys are for my HoH data structures therefore; I will need to replace the old keys with the updated key. ie.  $href->{old_Key}{forall_subKeys} replaced by  $href->{newKey}{forall_subKeys}. I have multiple hrefs with similar primary keys but they are not exactly alike do to their database formatting. I am having difficulty comparing the keys since they are all not uniform. Example of key data: $href1->{1}{forall_subKeys}; $href2->{00001    }{forall_subKeys}, $href->{1.0}{forall_subKeys}, Altering the database formatting is outside of my control. I am seeking the best algorithm for accomplishing this task.

Thanks Your advice is always greatly appreciated!

Replies are listed 'Best First'.
Re: altering HoH keys
by Zaxo (Archbishop) on Jan 15, 2004 at 22:22 UTC

    A hash slice and delete will do this handily, 

    @{$href}{map {to_new($_)} keys %$href}  # wrong
    = delete @{$href}{keys %$href};

    [download]
    Since the values are all scalar hashrefs, this code doesn't care about their contents, and leaves them alone.

    Update: Roger++ points out that the keys got clobbered. Mapping the new keys externally fixes that, 

    my @newkeys = map {to_new($_)} keys %$href;
@{$href}{@newkeys} = delete @{$href}{keys %$href};

    [download]

    After Compline,
    Zaxo

[reply]
[d/l]
[select]
Re: altering HoH keys
by Roger (Parson) on Jan 15, 2004 at 22:38 UTC
    This is not a straightforward task. A couple of things I can think of:
    - Are the primary keys numeric? And what's the expected normalized form?
    - What will happen when there is a collision with the sub-hash keys during collation?
    - Database updates would be trivial once the first two are resolved.

    I have written a little script below to demonstrate how to do collision in the ideal world, ie., numeric primary keys, no sub-hash key collision.

    use strict;
use warnings;
use Data::Dumper;

my $href = {
    '1' => { 'key1' => 'value1' },
    '1.0' => { 'key2' => 'value2' },
    '0001' => { 'key3' => 'value3' },
    '2' => { 'key1' => 'value1' },
    '0002' => { 'key2' => 'value2' },
};

print Dumper($href);

# Build a cross-reference table of primary key remapping
my %key_xref = map { $_ => normalize_key($_) } keys %$href;

# Remap primary keys / merge data
while (my ($from, $to) = each %key_xref) {
    next if $from eq $to;

    foreach (keys %{$href->{$from}}) {
        $href->{$to}{$_} = $href->{$from}{$_};
    }

    delete $href->{$from};
}

print Dumper($href);

# Normalize primary keys
sub normalize_key
{
    my $key = shift;
    return int $key;
}

    [download]
    And the output -
    # before
$VAR1 = {
          '0002' => {
                      'key2' => 'value2'
                    },
          '0001' => {
                      'key3' => 'value3'
                    },
          '1' => {
                   'key1' => 'value1'
                 },
          '1.0' => {
                     'key2' => 'value2'
                   },
          '2' => {
                   'key1' => 'value1'
                 }
        };

# after
$VAR1 = {
          '1' => {
                   'key2' => 'value2',
                   'key1' => 'value1',
                   'key3' => 'value3'
                 },
          '2' => {
                   'key2' => 'value2',
                   'key1' => 'value1'
                 }
        };

    [download]
[reply]
[d/l]
[select]
Re: altering HoH keys
by BrowserUk (Patriarch) on Jan 15, 2004 at 23:40 UTC 
    #! perl -slw
use strict;
use Data::Dumper;


my $href = {
    '1'     => { key1 => 'val1' },
    '1.0'     => { key2 => 'val2' },
    '0001'     => { key3 => 'val3' },
    '2'     => { key1 => 'val1' },
    '0002'     => { key2 => 'val2' },
    '2.1'     => { key1 => 'val1'    },
    '2.10'    => { key2 => 'val2' },
    '2.1  '    => { key3 => 'val3' },
    '  2.1'    => { key4 => 'val4' },
    fred    => { key1 => 'val1' },
    '  fred'=> { key2 => 'val2' },
    'fred  '=> { key3 => 'val3' },
};

sub trim{
    $_[0] =~ s[^\s+|\s+$][]g; 
    $_[0] += 0 if $_[0] =~ m[^[\d|.]+$];
    $_[0]; 
}

my( %new, $k, $v );
@{ $new{ trim $k } }{ keys %$v } = ( values %$v ) 
    while ( $k, $v ) = each %$href;

print Dumper \%new;
__END__
P:\test>321690
$VAR1 = {
          '1' => {
                   'key2' => 'val2',
                   'key1' => 'val1',
                   'key3' => 'val3'
                 },
          '2' => {
                   'key2' => 'val2',
                   'key1' => 'val1'
                 },
          '2.1' => {
                     'key2' => 'val2',
                     'key1' => 'val1',
                     'key4' => 'val4',
                     'key3' => 'val3'
                   },
          'fred' => {
                      'key2' => 'val2',
                      'key1' => 'val1',
                      'key3' => 'val3'
                    }
        };

    [download]
    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    Timing (and a little luck) are everything!
[reply]
[d/l]

Back to Seekers of Perl Wisdom