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

...and the template

<!-- template start -->

  <!-- letter menu -->
  <div class="menu">
    <ul>
      <TMPL_LOOP NAME=LETTER_MENU>
        <TMPL_IF NAME="CURRENT">
          <li><TMPL_VAR NAME=LETTER></li>
        </TMPL_IF>
        <TMPL_IF NAME="VOID">
          <li class="void"><TMPL_VAR NAME=LETTER></li>
        </TMPL_IF>
        <TMPL_IF NAME="HREF">
          <li><a href="map<TMPL_VAR NAME=LETTER>.html"><TMPL_VAR NAME=
+LETTER></a></li>
         </TMPL_IF>
      </TMPL_LOOP>
    </ul>
  </div>

<h1><TMPL_VAR NAME=CURRENT_LETTER></h1>

<TMPL_LOOP NAME=SUBJECT>

  <!-- subject bookmark -->
  <div class="bm">
    <a id="<TMPL_VAR NAME=BOOKMARK>" name="<TMPL_VAR NAME=BOOKMARK>"><
+/a>
  </div>
  
  <!-- subject menu -->
  <div class="menu">
    <ul>
      <TMPL_LOOP NAME=SUBJECT_MENU>
        <TMPL_IF NAME=CURRENT>
          <li><TMPL_VAR NAME=SUBJECT></li>
        <TMPL_ELSE>
          <li><a href="#<TMPL_VAR NAME=BOOKMARK>"><TMPL_VAR NAME=SUBJE
+CT></a></li>
        </TMPL_IF>
      </TMPL_LOOP>
    </ul>
  </div>
  
  <!-- subject -->
  <h2><TMPL_VAR NAME=SUBJECT></h2>
    <TMPL_LOOP NAME=SUBJECT_ARTICLES>
      <h4><a href="<TMPL_VAR NAME=HREF>"><TMPL_VAR NAME=TITLE></a></h4
+>
    </TMPL_LOOP>

</TMPL_LOOP>
[download]