#! 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;
}
####