#! perl use warnings; use strict; use HTML::Template; #use Data::Dump qw(dump); # make subject map for each letter # load the database my @data; { my $file = 'data\database_sorted.txt'; open my $f, '<', $file or die "can't open $file: $!"; @data = <$f>; close $f or die "can't close $file: $!"; } # load the hash my %hash; for (@data){ chomp; my ($letter, $subject, undef, $file) = split /\t/,$_,4; push @{$hash{$letter}{$subject}}, $file; } # make the pages my @letters = sort keys %hash; for my $letter (@letters){ my $t = HTML::Template->new(filename => 'tmpl\ht_map.tmpl'); my @ht_array = (); my @subjects = sort keys %{$hash{$letter}}; my $letter_menu = make_letter_menu($letter); for my $subject (@subjects){ my $subject_menu = make_subject_menu($subject, @subjects); my @subject_articles; for my $article (@{$hash{$letter}{$subject}}){ my ($href,$title) = split /\t/,$article; push @subject_articles, { href => $href, title => $title, }; } push @ht_array, { subject => $subject, subject_menu => $subject_menu, bookmark => make_bookmark($subject), subject_articles => \@subject_articles }; } #print dump(@ht_array); #exit; $t->param(LETTER_MENU => $letter_menu); $t->param(SUBJECT => \@ht_array); $t->param(CURRENT_LETTER => $letter); print $t->output; exit; } exit; # subs sub make_letter_menu{ my $letter_current = shift; my @letters_array; for my $letter ('a'..'z'){ my %letter_hash = ( letter => $letter, void => 0, current => 0, href => 0, ); if ($letter eq $letter_current){ $letter_hash{current} = 1; } elsif (exists $hash{$letter}){ $letter_hash{href} = 1; } else{ $letter_hash{void} = 1; } push @letters_array, {%letter_hash}; } return \@letters_array; } sub make_subject_menu{ my $subject_current = shift; my @subject = @_; my @subject_array; for my $subject (@subject){ my %subject_hash = ( subject => $subject, bookmark => make_bookmark($subject), current => 0, ); if ($subject eq $subject_current){ $subject_hash{current} = 1; } push @subject_array, { %subject_hash }; } #dump (@subject_array); #exit; return \@subject_array; } sub make_bookmark{ my $bookmark = shift; $bookmark =~ s/[\s-]//; $bookmark = lc substr $bookmark, 0,8; return $bookmark; } ####