#!/usr/bin/perl
#-#############################################
# catalog.pl
# Version: 1.05
# Date: 04/26/2004
#-#############################################
# Copyright (C) 2002 Dieter Werner
# http://www.interwer.com
# [EMAIL=hdw@interwer.com]hdw@interwer.com[/EMAIL]
#-#############################################
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'],
],
],
],
];
#-#############################################
# Test:
# Convert array to hash
# and print the list of categories ...
#-#############################################
my $catalog = {};
dump_cat($_, $categories->[$_], $catalog) for 0 .. 1;
print "$_ => $catalog->{$_}<br>" foreach sort keys %$catalog;
print "<hr>";
disp_cat($catalog);
#-#############################################
# Test:
# Display Catalog
#-#############################################
sub disp_cat {
my $catalog = shift;
my $key;
foreach $key (sort keys %$catalog) {
my $index = '$index = $categories->[';
$index .= join '][', split /_/, $key;
$index .= ']';
eval $index;
print $index, " => ", $key, "<br>";
}
}
#-#############################################
# Dump Main-Categories
#-#############################################
sub dump_cat {
my ($cnt, $cat, $catalog) = @_;
my @index;
local $_;
foreach (0 .. $#$cat) {
ref $cat->[$_]
? dump_sub_cat($cat->[$_], $catalog, \@index)
: do {
@index = ($cnt, $_);
$catalog->{join('_', @index)} = $cat->[$_];
};
}
}
#-#############################################
# Dump Sub-Categories
#-#############################################
sub dump_sub_cat {
my ($cat, $catalog, $index) = @_;
local $_;
my $dump = sub {
my ($dump, $cat, $catalog, $index) = @_;
my $cnt = $#$index;
my $last = $index->[-1];
local $_;
$last++;
foreach (0 .. $#$cat) {
ref $cat->[$_]
? do {
$dump->($dump, $cat->[$_], $catalog, $index);
pop @$index;
}
: do {
$_ == 0
? (@$index = (@$index[0 .. ($cnt - 1)], $last, $_))
: (@$index = (@$index[0 .. $cnt], $_));
$catalog->{join('_', @$index)} = $cat->[$_];
};
}
};
foreach (0 .. $#$cat) {
ref $cat->[$_]
? do {
$dump->($dump, $cat->[$_], $catalog, $index);
pop @$index;
}
: do {
$_ == 0
? (@$index = ($index->[0], ++$index->[1], $_))
: (@$index = (@$index[0 .. 1], $_));
$catalog->{join('_', @$index)} = $cat->[$_];
};
}
}
#-#############################################
exit;