#!/usr/bin/perl #-############################################# # catalog.pl # Version: 1.04 # Date: 04/25/2004 # Written by Dieter Werner #-#############################################    print "Content-type: text/html\n\n";    use strict;    use warnings; #-############################################# my $categories = [    ['Telekommunikation', ['Festnetz', ['Telefon', ['Foo', 'Bar'], ], ['Telefax', ['Foo', 'Bar'], ], ], ['Mobilnetz', ['Handy used', ['Siemens', ['C25', 'C35', 'Other'], ], ['Nokia', ['5130', '7710', '8810', 'Other'], ], ['Panasonic', ['GD90', 'GD91', 'GD92'], ], ], ['Handy unused', ['Siemens', ['C25', 'C35', 'Other'], ], ['Nokia', ['5130', '7710', '8810', 'Other'], ], ['Panasonic', ['GD90', 'GD91', 'GD92'], ], ], ],    ],        ['Computer', ['Hardware', ['Monitor', ['Eizo', ['15 Zoll', '17 Zoll', '19 Zoll', '20 Zoll'], ], ['Other',     ['15 Zoll', '17 Zoll', '19 Zoll', '20 Zoll'], ], ], ['CPU', ['Intel',     ['up to 300 MHz', 'up to 600 MHz', 'up to 900 MHz'], ], ['AMD',     ['up to 300 MHz', 'up to 600 MHz', 'up to 900 MHz'], ], ['Other',     ['up to 300 MHz', 'up to 600 MHz', 'up to 900 MHz'], ], ], ], ['Software',     ['Operating Systems', ['Windows', 'Linux'],     ], ['Applications', ['Office-Software', 'Internet-Software', 'Games'],     ], ],    ], ];     #-############################################# # Read from array # and print a list of all categories => Indices #-############################################# my $catalog = {};    dump_cat_1($_, $categories->[$_], $catalog) for 0 .. 1;    print "$_ => $catalog->{$_}
" foreach sort keys %$catalog;   #-############################################# # Dump Level 1 #-############################################# sub dump_cat_1 {    my ($cnt, $cat, $catalog) = @_; my @index; local $_;         for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_2($cat->[$_], $catalog, \@index) : do { @index = ($cnt, $_); $catalog->{join('_', @index)} = $cat->[$_]; } } } #-############################################# # Dump Level 2 #-############################################# sub dump_cat_2 {    my ($cat, $catalog, $index) = @_; local $_; for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_3($cat->[$_], $catalog, $index) : do { $_ == 0 ? (@$index = ($index->[0], ++$index->[1], $_)) : (@$index = (@$index[0 .. 1], $_)); $catalog->{join('_', @$index)} = $cat->[$_]; } } } #-############################################# # Dump Level 3 #-############################################# sub dump_cat_3 {    my ($cat, $catalog, $index) = @_; local $_; for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_4($cat->[$_], $catalog, $index) : do { $_ == 0 ? (@$index = (@$index[0 .. 1], ++$index->[2], $_)) : (@$index = (@$index[0 .. 2], $_)); $catalog->{join('_', @$index)} = $cat->[$_]; } } }   #-############################################# # Dump Level 4 #-############################################# sub dump_cat_4 {    my ($cat, $catalog, $index) = @_; local $_; for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_5($cat->[$_], $catalog, $index) : do { $_ == 0 ? (@$index = (@$index[0 .. 2], ++$index->[3], $_)) : (@$index = (@$index[0 .. 3], $_)); $catalog->{join('_', @$index)} = $cat->[$_]; } } }   #-############################################# # Dump Level 5 #-############################################# sub dump_cat_5 {    my ($cat, $catalog, $index) = @_; local $_; for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_6($cat->[$_], $catalog, $index) : do { $_ == 0 ? (@$index = (@$index[0 .. 3], ++$index->[4], $_)) : (@$index = (@$index[0 .. 4], $_)); $catalog->{join('_', @$index)} = $cat->[$_]; } } } #-############################################# # Dump Level 6 #-############################################# sub dump_cat_6 {    my ($cat, $catalog, $index) = @_; local $_; for (0 .. $#$cat) { ref $cat->[$_] ? dump_cat_7($cat->[$_], $catalog, $index) : do { $_ == 0 ? (@$index = (@$index[0 .. 4], ++$index->[5], $_)) : (@$index = (@$index[0 .. 5], $_)); $catalog->{join('_', @$index)} = $cat->[$_]; } } } #-############################################# exit;