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

Now that I have calmed down from a rotten day at work, I think that I can ask a cohesive question. As you will see, this example code consists of 2 subroutines, each returning different information regarding my "dogs". What I want to do, is to put all of the data into one hash so that I can print all the data together. The "code": 
#!/usr/local/bin/perl -w

use strict;

my $dogdir = "/path/to/colors";
my $typedir = "/path/to/type";
my ($color_file, @color_list, $color_blurb, @type_list, $type_string, 
+   $type_value, @breed)
my %colors = ();
my %type = ();
my %dogs  = ( barky => 1,
          fluffy => 1,
          licky => 1 
        )
  
&colors;
&type;

sub colors {
  
  opendir (DOGDIR, $dogdir) or die "Cannot open $dogdir: $!" ;
  while ( defined ($color_file = readdir (DOGDIR))) {
    @color_list = `cat $dogdir/$color_file | grep COLOR`;
    my $color = $_;
    if (exists $dogs{$color}) {
      foreach $color_blurb(@colorlist) {
    push @{$colors{$color_file}}, $color_blurb;
      }
      foreach $color_file (sort keys %colors) {
    $color_blurb = join "", @{$colors{$color_file}};
    print "$color__file:\n";
    print "===========================\n";
    print "$color_blurb\n\n";
      }
    } 
    
  }
  
}

sub type {
  
  opendir (TYPEDIR, $typedir) or die "Cannot open $typedir: $!" ;
  while ( defined ($type_file = readdir (TYPEDIR))) {
    @type_list = `cat $typedir/$type_file |grep Breed` ;
    if (exists $dogs{$color}) {
      foreach  $type_string(@type_list) {
    @breed = split(' ',$type_string); 
    if  ($type_string =~ m/(is.*?),/) {
      $type_value = ("$i[2] $1");
      push @{$type{$type_file}}, $type_value;
    }
      }
    }
    foreach  $type_file (sort keys %type) {
      print "$type_file\n";
      print "===========================\n";
      print "$type_value\n\n";    
    }
  }
}

[download]
The subroutine "colors" prints: 
Barky
===========================
is brown

Fluffy
===========================
is black

Licky
===========================
is bald

[download]
The subroutine type prints: 
Barky
===========================
is a beagle

Fluffy
===========================
is a terrier

Licky
===========================
is a bald mutt

[download]
I want the program to print: 
Barky
===========================
is brown
is a beagle

etc., etc, etc,

[download]

Replies are listed 'Best First'.
Re: Hash Question
by lindex (Friar) on Oct 06, 2000 at 05:48 UTC
    I think this might work for you, basicly all it does is takes two hashes with the same keys but different values and then merges them into one hash with the same keys but values as arrayref's of the values of the other two hashes :)
    use strict;

my(%hash1) = (
 'foo'  => 'bar',
 'bleh' => 'qwer',
 'lala' => 'asdf'
);

my(%hash2) = (
 'foo'  => 'bvcx',
 'bleh' => 'lkjh',
 'lala' => 'iopj'
);

my(%hash3) = map {
        $_ => [$hash1{$_}]
} keys(%hash1);

map {
        push(@{$hash3{$_}},$hash2{$_});
} keys(%hash2);

foreach (keys(%hash3)) {
        print "$_ is\n";
        map {
                print "\t$_\n";
        } @{$hash3{$_}};
}

    [download]



    lindex 
    /****************************/
  jason@gost.net, wh@ckz.org
    http://jason.gost.net
/*****************************/

    [download]
[reply]
[d/l]
[select]
      This could be made into one line, but it's too late at night to do the formatting change: 
      foreach my $key (keys %hash1) {
    $hash1{$key} = [ defined $hash2{$key} ?
         ($hash1{$key}, $hash2{$key}) : $hash1{$key} ];
}

      [download]
      That could be made to go into a different hash, if that's your thing.
[reply]
[d/l]
        better yet :) (at least I think this will work) 
        $hash3 = map { $_ => [ $hash1{$_}, $hash2{$_} ] } keys(%hash1);

        [download]
        p.s. vroom should allow us to customize the size of our text fields... I work on a 20 inch monitor with I.E in fullscreen mode :)


        lindex 
        /****************************/
  jason@gost.net, wh@ckz.org
    http://jason.gost.net
/*****************************/

        [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom