Title: Catalog-System
Post by Forum Admin on 04/27/04 at 19:37:36
Hi folks,
I coded this catalog-system (cat - subcat - subsubcat and so on) and I would like to have a discussion about it.
Let me know what you think about the code.
Code:
#!/usr/bin/perl
#-#############################################
# catalog.pl
# Version: 1.08
# Date: 04/30/2004
#-#############################################
# LICENSE-CONDITIONS:
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#-#############################################
#
# In accordance with the GNU General Public License (GPL):
# - You may not use and/or distribute this code under a proprietary license!
# - You either may not distribute parts of this code under a proprietary license too!
# - The following copyright notice and the further following copyright notices of
# this software, MUST remain UNCHANGED and INTACT!
#
#-#############################################
#
# Copyright (2004) by Dieter Werner
# http://www.interwer.com
# eMail: hdw@interwer.com
# All rights reserved by the author.
#
#-#############################################
# OK - here we go ...
#-#############################################
# Use-Section
#-#############################################
use strict;
use warnings;
#-#############################################
# Setup-Section
#-#############################################
print "Content-type: text/html\n\n";
$| = 1;
my $catalog = {};
#-#############################################
# The Categories
# This will be the content of a text file.
#-#############################################
my $categories = <<EO_CAT;
['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',
],
],
],
],
['Electronics',
['Audio',
['Player',
[
'Akai',
'Sony',
'Panasonic',
'Other',
],
],
['Recorder',
[
'Akai',
'Sony',
'Panasonic',
'Other',
],
],
['HiFi',
[
'Akai',
'Sony',
'Panasonic',
'Other',
],
],
],
['Video',
['Recorder',
['Akai',
['C25',
[
'Black',
'White',
'Green',
],
],
['C35',
[
'Red',
'Blue',
'Yellow',
],
],
['Other',
[
'Black',
'White',
'Green',
],
],
],
['Sony',
[
'5130',
'7710',
'8810',
'Other',
],
],
['Panasonic',
[
'GD90',
'GD91',
'GD92',
],
],
],
['Player',
['Akai',
[
'C25',
'C35',
'Other',
],
],
['Sony',
[
'5130',
'7710',
'8810',
'Other',
],
],
['Panasonic',
[
'GD90',
'GD91',
'GD92',
],
],
],
],
],
EO_CAT
#-#############################################
# Only for Testing the Subroutine.
# Convert array to hash
# and print the list of categories ...
#-#############################################
$categories = do 'categories.ini' || [eval $categories]; # Hi Randal ;-))
get_index(
$_,
$categories->[$_],
$catalog
) foreach (0 .. $#$categories);
# Print it out
foreach (sort keys %$catalog) {
print $_, ' => ', $catalog->{$_}->[0];
print '<br>Parent: ', $catalog->{$_}->[1] if $catalog->{$_}->[1];
print '<br>';
$catalog->{$_}->[2] && do {
my @childs = @{$catalog->{$_][2 .. $#{$catalog->{$_]];
my $childs = join ' | ', @childs;
print 'Childs: ', $childs, '<hr>';
};
}
#-#############################################
sub get_index {
#-#############################################
my ($cnt, $cat, $catalog) = @_;
my (@sub_cat, @parent, @index);
local $_;
# Dump Sub-Categories
# Get index, parent, child(ren) of each Sub-Category
my $dump = sub {
my (
$dump,
$cat,
$sub_cat,
$catalog,
$index,
$parent
) = @_;
my $cnt = $#$index;
my $prev_last = $index->[-1];
local $_;
($cat->[0] and !ref $cat->[0]) && push @$sub_cat, $cat->[0];
foreach (0 .. $#$cat) {
ref $cat->[$_]
? do {
$dump->(
$dump,
$cat->[$_],
$sub_cat,
$catalog,
$index,
$parent,
);
pop @$sub_cat;
pop @$index;
}
: do {
$_ == 0
? do {
@$parent = (
@$index[0 .. ($cnt - 1)],
0
);
$#$index < 2
? (
@$index = (
$index->[0],
++$index->[1],
$_
)
)
: do {
$prev_last++;
@$index = (
@$index[0 .. ($cnt - 1)],
$prev_last, $_
);
};
}
: do {
@$parent = (@$parent[0 .. ($cnt - 1)], 0);
$#$index < 2
? (@$index = (@$index[0 .. 1], $_))
: (@$index = (@$index[0 .. $cnt], $_));
};
my $index = join '_', @$index;
my $parent = join '_', @$parent;
my $the_cat = join "/", (
@$sub_cat[0 .. ($#$sub_cat - 1)],
$cat->[$_]
);
# Add the Title and the Parent
$catalog->{$index} = [$the_cat, $parent];
# Add the found Child
push @{$catalog->{$parent], $index;
};
}
};
# Dump Main-Categories
# Get the index of each Main-Category
foreach (0 .. $#$cat) {
ref $cat->[$_]
? do {
$dump->(
$dump,
$cat->[$_],
\@sub_cat,
$catalog,
\@index,
\@parent,
);
pop @sub_cat,
pop @index;
}
: do {
push @sub_cat, $cat->[$_];
@index = ($cnt, $_);
@parent = @index;
$catalog->{join('_', @index)} = [
join("/", (@sub_cat[0 .. ($#sub_cat - 1)], $cat->[$_])),
undef
];
};
}
}
#-#############################################
exit; |
|
Edit: The code includes 'Parents' and 'Children' of each category now.
|