#!/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: [EMAIL=hdw@interwer.com]hdw@interwer.com[/EMAIL] # 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 = <[$_],        $catalog    ) foreach (0 .. $#$categories);        # Print it out        foreach (sort keys %$catalog) {            print $_, ' => ', $catalog->{$_}->[0];            print '
Parent: ', $catalog->{$_}->[1] if $catalog->{$_}->[1];            print '
';                        $catalog->{$_}->[2] && do {                my @childs = @{$catalog->{$_}}[2 .. $#{$catalog->{$_}}];                my $childs = join ' | ', @childs;                print 'Childs: ', $childs, '
';            };        } #-############################################# 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;