Algorithm::Loops's NestedLoops can handle this.

use strict;
use warnings;

use Algorithm::Loops qw( NestedLoops );

my %data = (
   fruit  => [qw( apple pear     )],
   type   => [qw( farmed organic )],
   period => {
      20050824 => {
         to  => [ 'new york', 'london' ],
      },
      20050825 => {
         to  => [ 'auckland' ],
      },
   }
);

my $iter = NestedLoops([
   $data{fruit},
   $data{type},
   [ keys %{$data{period}} ],
   sub { $data{period}{$_[2]}{to} },
]);

my @expanded;
while (my @list = $iter->()) {
   my %row;
   @row{qw( fruit type period to )} = @list;
   push @expanded, \%row;
}

require Data::Dumper;
print(Data::Dumper::Dumper(\@expanded));
[download]

Update: Fixed typo in link.

Right off the bat you've got a problem before you even start on your question. Your sub hash period's key 20050824 has duplicate values for the same key (to). That either needs to be an arrayref (to => [ 'new york', 'london' ]), or you need to rethink your data structure some.

20050824 => {
        to  => 'new york',
        to  => 'london',
      },
[download]

Apologies, you are right, here is a better example of the input:

my $struct = {
    fruit  => [qw( apple pear )],
    type    => [qw( farmed organic )],
    period  => {
      20050824 => {
        to  => ['new york', 'london', ],
      },
      20050825 => {
        to  => ['auckland', ],
      },
    }
  };
[download]

update: fixed first date [ -> {

Maybe:

# example structure
my $struct = {
    fruit  => [qw( apple pear )],
    type    => [qw( farmed organic )],
    period  => {
      20050824 => [
        to  => ['new york', 'london' ],
        ],
      20050825 => [
        to  => ['auckland' ],
      ],

    },
  };
[download]

Would be syntactically valid?

But given the only attribute to the date is to, why not remove that layer?

jdtoronto

Are you sure that your data structure is the most efficient way to store your data? Take a look at Re: How can I visualize my complex data structure?.

Eric

I believe Re: I've got a hash of hashes how do i get my values out will do almost exactly what you want.

HTH,

#!/usr/bin/perl -w
use strict;
use Dumpvalue;

# example structure
my $struct = { fruit => [qw( apple pear )],
               type => [qw( organic farmed )],
               period => { 20050824 => { to        => [ 'new york', 'l
+ondon', ],
                                         transport => 'air' },
                           20050825 => { to => 'auckland', },
                         } ,
               name   => 'bangers',
            };




#logHere $struct;
print "Input:\n";
Dumpvalue->new->dumpValue(  $struct ) ;

my $expanded = expand($struct, []);

print '='x80,"\nResult:\n";
Dumpvalue->new->dumpValue( $expanded ) ;

sub expand {
  my ( $struct, $expanded, $parent_key) =@_;
  for my $key ( sort keys %$struct ) {
    if ( ref($struct->{$key}) eq 'ARRAY' ) {
      if ( scalar @$expanded ) {
        $expanded = [ map { my $row = $_; map { my $newrow = {%$row}; 
+$newrow->{$key} = $_; $newrow }  @{$struct->{$key}} } @$expanded ];
      }
      else {
        push @$expanded,  map { { $key=> $_ } } @{$struct->{$key}} ;
      }
    }
    elsif ( ref $struct->{$key} eq 'HASH' ) {
      $parent_key ||='';
      my $expansion = expand($struct->{$key}, [], $key);
      $expansion  = [map { {%$_, $parent_key => $key}  } @$expansion] 
+if $parent_key;
      if ( scalar @$expanded ) {
        my $count = scalar @$expanded;
        $expanded = [ map { my $row = $_;
                            map { my $newrow = {%$row};
                                  @$newrow{keys %$_} = values %$_ unle
+ss $newrow->{$parent_key};
                                  $newrow }  @$expansion ;
                            }
                            @$expanded ];
        push @$expanded,  @$expansion if $count == scalar @$expanded;
      }
      else {
        push @$expanded,  @$expansion ;
      }
    }
    else {
      if ( scalar @$expanded ) {
        map { $_->{$key} = $struct->{$key} } @$expanded;
      }
      else {
        push @$expanded,  { $key => $struct->{$key} };
      }
    }
  }

  return $expanded;
}
[download]

Oh Fabulous Bangers! Thank you very much!

Exactly what I was looking for - and I can now see how you managed to stitch together a mild case of recusion... and the embeded map/map cartesian product - rather nifty indeed!

I have made one slight performance tweak:

my $count = scalar @$expanded;
$expanded = [ 
  map { 
    my $row = $_;
    map { 
      my $newrow = {%$row};
      @$newrow{keys %$_} = values %$_ unless $newrow->{$parent_key};
      $newrow }  @$expansion ;
  } @$expanded ];

push @$expanded,  @$expansion if $count == scalar @$expanded;
[download]

to:

if ( $expanded->[0]{$parent_key} ) {
  push @$expanded,  @$children;
}
else {
  # create cartesian product against existing $expanded
  $expanded = [
    map {
      my $row = $_;
      map {
        my $newrow = {%$row};             # clone expanded row
        @$newrow{keys %$_} = values %$_;  # add in parent_key details
        $newrow                           # return new row
      }  @$children;
    } @$expanded ];
}
[download]

as this tests for the presence of $parent_key once, rather than using the before/after count to decide if all the children are new.

Mucho kudos! and many many thanks

Jeff