#!/usr/bin/perl -w
#
# 1999-08-21 -- tkil@scrye.com
#	fixed handling of track names, including some of the weird
#	workman features.
#
# 1999-08-02 -- tkil@scrye.com
#	oops, need to protect \' inside of URLs.  sigh.

use strict;

use CGI qw(-no_debug);
use CGI::Carp qw(fatalsToBrowser);
use URI::URL;
use HTML::Entities;
use DBI;


# ======================================================================
# globals

my $YEAR_LINE_SPAN = 20;

# ======================================================================
# common init

my $q = new CGI;
my $dbh = DBI->connect("DBI:mysql:hostname=localhost:database=Tkil_CDs",
		       "tkil_ro", "", { RaiseError => 1 } );

my $albums_per_page = 100;

my $N_BGCOLORS = 2;

# ======================================================================
# utility functions

sub make_url
{
    my ($mode, %params) = @_;
    my $u = URI::URL->new($q->url(relative => 1));
    my @query_bits;
    while (my ($param, $val) = each %params)
    {
        push @query_bits, "$param=$val";
    }
    my $query = join "&", "mode=$mode", @query_bits;
    $u->query($query);

    # ouch, i use single quotes everywhere, so...
    my $rv = $u->as_string();
    $rv =~ s/\'/%27/g;

    return $rv;
}

sub mm_ss
{
    my $seconds = shift;

    return sprintf "%d:%02d", int($seconds/60), $seconds % 60;
}

sub make_album_phrase
{
    my ($album, $album_id) = @_;

    my $url = make_url("album", album => $album, album_id => $album_id);
    $album = encode_entities($album);
    # and insert line breaks where appropriate
    $album =~ s!//!<br>\n    &nbsp;&nbsp;&nbsp;!g;
    return "<a href='$url'>$album</a>";
}

sub make_year_phrase
{
    my $year = shift;

    return "<a href='" . make_url("all_cds", year => $year) . "'>$year</a>" ;
}

sub make_format_phrase
{
    my ($format, $format_id) = @_;

    my $url = make_url("all_cds", format => $format, format_id => $format_id);
    return "<a href='$url'>" . encode_entities($format) . "</a>" ;
}

sub make_artist_phrase
{
    my ($artist, $artist_id) = @_;
    my $url = make_url("artist", artist => $artist,
                       artist_id => $artist_id);
    return "<a href='$url'>" . encode_entities($artist) . "</a>" ;
}

sub make_label_phrase
{
    my ($label, $label_id) = @_;
    my $url = make_url( "all_cds",
                        label => $label,
                        label_id => $label_id );
    return "<a href='$url'>" . encode_entities($label) . "</a>" ;
}

my $cur_artist_bg;

sub print_album_row
{
    my ($artist, $artist_id, $album_aref, $album_id_aref, $year_aref, $len_aref) = @_;

    # ========== make artist a link to by-artist lists ==========

    my $artist_phrase = make_artist_phrase($artist, $artist_id);

    # do same for albums
    my @albums = map
    {
        make_album_phrase($album_aref->[$_], $album_id_aref->[$_])
    }
    0 .. $#$album_aref;

    # and for years
    my @years = map make_year_phrase($_), @$year_aref;

    # lengths are just simply formatted
    my @lengths = map mm_ss($_), @$len_aref;

    ++$cur_artist_bg;
    $cur_artist_bg %= $N_BGCOLORS;

    # ========== emit HTML ==========
    # and handle the first row specially, since we already started
    # it with the artist name.
    print
      "<tbody class=\"artist-bg-$cur_artist_bg\">\n",
      "<tr valign=\"top\" border=\"top\" class=\"artist_bg_$cur_artist_bg\">\n",
      "  <td class=\"artist\" ",
      "rowspan=\"", scalar @$album_aref, "\">", $artist_phrase,  "</td>\n",
      "  <td class=\"album\">",                       shift(@albums),  "</td>\n",
      "  <td class=\"cd-year\">",                     shift(@years),   "</td>\n",
      "  <td class=\"cd-length\">",                   shift(@lengths), "</td>\n",
      "</tr>\n";

    # then do the rest of the rows.
    while (@albums)
    {
        print
          "<tr valign=\"top\" class=\"artist_bg_$cur_artist_bg\">\n",
          "  <td class=\"album\">",     shift(@albums),  "</td>\n",
          "  <td class=\"cd-year\">",   shift(@years),   "</td>\n",
          "  <td class=\"cd-length\">", shift(@lengths), "</td>\n",
          "</tr>\n";
    }
    print "</tbody>\n";

}

{
    my $all = join ' ', map
    {
        "<a href='" . make_url("all_cds", sort => $_) . "'>" .
          ucfirst($_) . "</a>"
    } qw(artist album year length label keyword);

    # ========== get (first-letter) indexes ==========

    my $init_aref = $dbh->selectcol_arrayref
      ( "SELECT DISTINCT UPPER(SUBSTRING(sort_key, 1, 1)) AS init" .
        "  FROM Artist" .
        "  ORDER BY init" );

    my @init_links =  map
    {
        "<a href='" . make_url("all_cds", sub_key => "$_*") . "'>$_</a>"
    } @$init_aref;

    my $indexes = join(" ", @init_links);

    # ========== get by-year list ==========

    my $years_aref = $dbh->selectcol_arrayref
      ("SELECT DISTINCT year" .
       "  FROM Album" .
       "  WHERE year != 0" .
       "  ORDER BY year" );

    my ($min_year, $max_year) = @{$years_aref}[0, -1];
    my ($min_decade, $max_decade) = map { int($_ / $YEAR_LINE_SPAN) } $min_year, $max_year;

    my %year_has_cds = map { $_ => 1 } @$years_aref;

    my $n_decades = 0;
    my @decades;
    for my $decade ($min_decade .. $max_decade)
    {
        # and find the "real" start of this decade.
        my $real_decade = $decade * $YEAR_LINE_SPAN;

        my @this_decade = map
        {
            if ($year_has_cds{$_})
            {
                $_ = ( "<a href='" . make_url("all_cds", sub_key => "$_") .
                       "'>$_</a>" );
            }
            $_
        }
        $real_decade .. $real_decade + $YEAR_LINE_SPAN - 1;

        push @decades, join " ", @this_decade;
        ++ $n_decades;
    }

    my $years = join("<br>", @decades);

    # ============================== compose navigation bar

    my $nav_bar = <<HTML;
    <table cellpadding=0 cellspace=0>
      <tbody>
	<tr valign="top">
	  <td align=right><small>All CDs by:</small></td>
	  <td><small>$all</small></td>
	</tr>
	<tr valign="top">
	  <td align="right"><small>Groups:</small></td>
	  <td><small>$indexes</small></td>
	</tr>
	<tr valign="top">
	  <td align="right"><small>Years:</small></td>
	  <td><small>$years</small></td>
	</tr>
	<tr valign="top">
	  <td align=right><small>About:</small></td>
	  <td>
	    <small>
	      <a href="http://slinky.scrye.com/~tkil/">Tkil</a>
	      <a href="http://slinky.scrye.com/~tkil/perl/">his perl examples</a>
	      <a href="http://slinky.scrye.com/~tkil/perl/browse-cds">this CGI</a>
	        (and its <a href="http://slinky.scrye.com/~tkil/perl/browse-cds-devel">development version</a>)
	      <a href="http://slinky.scrye.com/~tkil/cd/">DDL &amp; Support Files</a>
	    </small>
	  </td>
	</tr>
      </tbody>
    </table>
HTML

    sub print_header
    {
        my $title = shift;
        $title = encode_entities($title);

        print $q->header;

        # argh, stupid netscape table parsing is BROKEN BROKEN BROKEN!

        print <<HTML;
<html>
  <head>
    <title>Tkil CDs: $title</title>
  </head>
  <style type="text/css">

BODY      { background: black;
            color:      rgb(192,192,192) }

H1, H2, H3, H4, H5, H6 { color: rgb(192,192,192) }

A         { text-decoration: none }
A:link    { color:           rgb(128,128,255) }
A:visited { color:           rgb(224,128,224) }
A:active  { color:           yellow }

TD.album                  { font-style: italic }
TD.artist                 { font-style: bold   }
TD.cd-length, TD.cd-year  { text-align: right }

TR.artist-bg-0 { background: black; }
TR.artist-bg-1 { background: rgb(63, 63, 63); }

TH, TD, SMALL { color: rgb(192, 192, 192);
                background: transparent }

  </style>
  <body>
    $nav_bar
    <hr>
HTML
    }

    sub print_footer
    {
        print <<HTML;
    <hr>
    $nav_bar
  </body>
</html>
HTML
    }

}

sub die_politely
{
    my $msg = shift;

    print_header("Sorry...");

    print <<HTML;
<h1>Sorry...</h1>

$msg;
HTML

    print_footer("Sorry...");
}

# ======================================================================
# browse all CDs

if (!$q->param('mode') || $q->param('mode') eq "all_cds")
{
    my $do_pages = 1;

    my $sub_key = $q->param('sub_key');

    my %tables = ( Album => 'alb',
                   Artist => 'art' );
    my @clauses = ( 'art.id = alb.artist_id' );
    my @order;
    my @headers = qw(Artist Album Year Length);
    my @columns = qw( art.name art.id
                      alb.name alb.id alb.year alb.length );

    my $thing;

    my $sort_title;
    my $sort_mode = $q->param('sort');
    if (!$sort_mode || $sort_mode eq 'artist')
    {
        @order = ('art.sort_key', 'alb.year', 'alb.name');
        $thing = 'Artist';
        if (defined $sub_key)
        {
            my $pat = $sub_key;
            # translate from glob to SQL glob.
            for ($pat) {
                s/\_/\\_/g;
                s/\%/\\%/g;
                s/\*/\%/g;
                s/\?/\_/g;
            }
            push @clauses, "art.sort_key LIKE '$pat' ESCAPE '\\\\'";
        }
    }
    elsif ($sort_mode eq 'year')
    {
        @order = ('alb.year', 'art.sort_key', 'alb.name');
        $thing = 'Year';
        if (defined $sub_key)
        {
            push @clauses, 'alb.year = $sub_key';
            $do_pages = 0;
        }
    }
    elsif ($sort_mode eq 'album')
    {
        @order = ('alb.name', 'art.sort_key', 'alb.year');
        $thing = 'Album';
    }
    elsif ($sort_mode eq 'length')
    {
        @order = ('alb.length', 'alb.name', 'art.sort_key', 'alb.year');
        $thing = 'Length';
    }
    elsif ($sort_mode eq 'label')
    {
        $tables{AlbumLabel} = 'al';
        $tables{Label} = 'lab';
        push @clauses, 'alb.id = al.album_id', 'al.label_id = lab.id';
        @order = ('lab.name', 'art.sort_key', 'alb.name', 'alb.year', 'alb.length');
        $thing = "Label";
        unshift @headers, 'Label';
    }
    elsif ($sort_mode eq 'keyword')
    {
        $tables{AlbumCategory} = 'ac';
        $tables{Category} = 'cat';
        push @clauses, 'alb.id = ac.album_id', 'al.category_id = cat.id';
        @order = ('cat.name', 'art.sort_key', 'alb.name', 'alb.year', 'alb.length');
        $thing = "Keyword";
        unshift @headers, 'Keyword';
    }

    print_header("All CDs by " . $thing);

    # ========== get only a certain label? ==========

    if ($q->param('label_id') || $q->param('label'))
    {
        my ($real_label_name, $real_label_id);

        if (my $param_label_id = $q->param('label_id'))
        {
            # get the "real" name out of the db.
            my $sth = $dbh->prepare
              ("SELECT name, id from Label where id=$param_label_id");
            $sth->execute;
            my $cur = $sth->fetch;
            ($real_label_name, $real_label_id) = @$cur;
            $sth->finish;
        }
        elsif (my $param_label_name = $q->param('label'))
        {
            # get the label id out of the db.
            my $sth = $dbh->prepare
              ("SELECT name, id from Label where name=" .
               $dbh->quote($param_label_id));
            $sth->execute;
            my $cur = $sth->fetch;
            ($real_label_name, $real_label_id) = @$cur;
            $sth->finish;
        }

        $sort_title = "Albums from label '$real_label_name'";

        $tables{AlbumLabel} = 'al';
        $tables{Label} = 'lab';
        push @clauses, ( "al.label_id = $real_label_id" .
                         "al.album_id = alb.id" );
        $do_pages = 0;
    }

    my $page_bar = "";
    my $limit_clause = "";

    goto SKIP_DO_PAGES unless $do_pages;

    my $page = $q->param('page') || 0;
    my $num_cds;
    {
        my $sth_count_cds = $dbh->prepare("select count(*) from Album");
        $sth_count_cds->execute();
        $num_cds = $sth_count_cds->fetch->[0];
        $sth_count_cds->finish();
    }

    my $max_page = $num_cds/$albums_per_page - 1;
    if ($max_page > int($max_page))
    {
        $max_page += 1;
    }
    $max_page = int $max_page;
    $max_page = 0 if $max_page < 0;

    my @pages;
    if ($page > 0)
    {
        $q->param('page', 0);
        push @pages, "<a href='" . $q->self_url . "'>&lt;&lt; First</a>";
    }
    if ($page > 1)
    {
        $q->param('page', $page-1);
        push @pages, "<a href='" . $q->self_url . "'>&lt; Prev</a>";
    }

    for (0 .. $max_page)
    {
        $q->param('page', $_);
        push @pages, "<a href='" . $q->self_url . "'>" . ($_+1) . "</a>";
    }

    if ($page < $max_page-1)
    {
        $q->param('page', $page+1);
        push @pages, "<a href='" . $q->self_url . "'>Next &gt;</a>";
    }

    if ($page < $max_page)
    {
        $q->param('page', $max_page);
        push @pages, "<a href='" . $q->self_url . "'>Last &gt;&gt;</a>";
    }

    # restore old value
    $q->param('page', $page);

    # only set this to something if there's something to display.
    if (@pages)
    {
        $page_bar = ( "<small><p>Page: \n  " .
                      join(" |\n  ", @pages) .
                      "</p></small>\n");
        my $offset = $page*$albums_per_page;
        $limit_clause = ($offset ? "LIMIT $offset, $albums_per_page"
                         : "LIMIT $albums_per_page");

        $sort_title .= " [page " . ($page+1) . " of " . ($max_page+1) . "]";
    }

  SKIP_DO_PAGES:

    my $headers_html = join "", map "<th>$_</th>", @headers;

    print <<HTML;
<h1>$sort_title</h1>
$page_bar
<table valign=top>
  <thead>
    <tr>$headers_html</tr>
  </thead>
HTML

    my $columns = join ', ', @columns;
    my $tables_clause = 'FROM ' . join ', ', map "$_ $tables{$_}", keys %tables;
    my $where_clause = 'WHERE ' . join ' AND ', @clauses;
    my $sort_clause = 'ORDER BY ' . join ', ', @order;

    my $sql = <<SQL;
select $columns
  $tables_clause
  $where_clause
  $sort_clause
  $limit_clause
SQL

    # print "SQL: <pre>$sql</pre>\n";

    my $sth = $dbh->prepare($sql);

    my ($artist, $artist_id, $album, $album_id, $year, $length);

    unless ($sth &&
            $sth->execute() &&
            $sth->bind_columns(undef, \ ( $artist, $artist_id, $album,
                                          $album_id, $year, $length) ) )
    {
        die $sth->errstr;
    }

    # some variables for grouping by artist, if practical.  hm... i
    # should just use this logic for all of 'em, as it will occasionally
    # be useful even if we're sorting by album or year.
    my $last_artist;
    my $last_artist_id;
    my @album_accum;
    my @album_id_accum;
    my @year_accum;
    my @length_accum;
    my @key_accum;

    while (my $cur = $sth->fetch)
    {
        # print STDERR qq[artist="$artist", album="$album", year=$year, length=$length\n];

        if ($last_artist && $last_artist ne $artist)
        {
            print_album_row($last_artist, $last_artist_id,
                            \@album_accum, \@album_id_accum,
                            \@year_accum, \@length_accum, \@key_accum);

            # empty out the accumulators.
            @album_accum = ();
            @album_id_accum = ();
            @year_accum = ();
            @length_accum = ();
            @key_accum = ();
        }

        $last_artist = $artist;
        $last_artist_id = $artist_id;
        push @album_accum, $album;
        push @album_id_accum, $album_id;
        push @year_accum, $year;
        push @length_accum, $length;
    }

    if (@album_accum) {
        print_album_row($last_artist, $last_artist_id,
                        \@album_accum, \@album_id_accum,
                        \@year_accum, \@length_accum);
    }

    print <<HTML;
</table>
$page_bar
HTML

    print_footer();
}

# ======================================================================
# browse a given artist

elsif ($q->param('mode') eq 'artist')
{
    my $param_artist_id = $q->param('artist_id');
    my $param_artist_name = $q->param('artist');

    my $artist_spec;
    my $real_name;
    if ($param_artist_id)
    {
        $artist_spec = "Artist.id = $param_artist_id";

        # get the "real" name out of the db.
        my $sth = $dbh->prepare
          ("SELECT name from Artist where id=$param_artist_id");
        $sth->execute;
        my $cur = $sth->fetch
          or die_politely("couldn't determine artist name for artist_id = $param_artist_id");
        $real_name = $cur->[0];
        $sth->finish;
    }
    elsif ($param_artist_name)
    {
        $artist_spec = "Artist.name = " . $dbh->quote($param_artist_name);
        $real_name = $param_artist_name;
    }
    else
    {
        die_politely("Mode <code>artist</code> requires either " .
                     "<code>artist_id</code> or <code>artist</code> parameters.");
    }

    my $sth = $dbh->prepare(<<SQL);
SELECT Album.name, Album.id, Album.year,
    Album.length, Formats.name, Formats.id
  FROM Album, Artist, Formats
  WHERE Album.artist_id = Artist.id
    AND Album.format_id = Formats.id
    AND $artist_spec
  ORDER BY Album.year
SQL

    $sth->execute();

    my ($album, $album_id, $year, $length, $format, $format_id);
    $sth->bind_columns(undef, \$album, \$album_id, \$year,
                       \$length, \$format, \$format_id);

    print_header("Albums by $real_name");

    print <<HTML;
<h1>Albums by $real_name</h1>
<table valign=top>
  <col align=left valign=top>
  <col align=right valign=top>
  <col align=right valign=top>
  <col align=left valign=top>
  <thead>
    <tr>
      <th>Album</th>
      <th>Year</th>
      <th>Length</th>
      <th>Format</th>
    </tr>
  </thead>
  <tbody>
HTML

    while (my $cur = $sth->fetch)
    {
        my $album_phrase = make_album_phrase($album, $album_id);
        my $year_phrase = make_year_phrase($year);
        my $format_phrase = make_format_phrase($format, $format_id);
        print
          "<tr valign=top>\n",
          "  <td>$album_phrase</td>\n",
          "  <td align=right>$year_phrase</td>\n",
          "  <td align=right>", mm_ss($length), "</td>\n",
          "  <td>$format_phrase</td>\n",
          "</tr>\n";
    }

    $sth->finish;

    print <<HTML;
  </tbody>
</table>
HTML

    print_footer();
}

# ======================================================================
# browse a given CD.

elsif ($q->param('mode') eq 'album')
{
    my $album_spec;
    my $real_name;

    my $param_album_id = $q->param('album_id');
    my $param_album_name = $q->param('album');

    if ($param_album_id)
    {
        $album_spec = "Album.id = $param_album_id";

        # get the "real" name out of the db.
        my $sth = $dbh->prepare
          ("SELECT Album.name from Album where id=$param_album_id");
        $sth->execute();
        my $cur = $sth->fetch
          or die_politely("couldn't determine album name for album_id = $param_album_id");
        $real_name = $cur->[0];
        $sth->finish;
    }
    elsif ($param_album_name)
    {
        my $album_sql_name = $dbh->quote($param_album_name);
        $album_spec = "Album.name = $album_sql_name";
        $real_name = $param_album_name;
    }
    else
    {
        die_politely("Mode <code>album</code> requires either " .
                     "<code>album_id</code> or <code>artist</code> parameters.");
    }

    # get info about all albums that might match
    my $sth_album = $dbh->prepare(<<SQL);
SELECT Artist.name, Artist.id,
    Album.id, Album.name, Album.year, Album.length,
    Formats.name, Formats.id
  FROM Artist, Album, Formats
  WHERE Artist.id = Album.artist_id
    AND Formats.id = Album.format_id
    AND $album_spec
  LIMIT 20
SQL

    $sth_album->execute();

    my ($artist_name, $artist_id,
        $album_id, $album_name, $album_year, $album_length,
        $format_name, $format_id);
    $sth_album->bind_columns
      (undef, \$artist_name, \$artist_id,
       \$album_id, \$album_name, \$album_year, \$album_length,
       \$format_name, \$format_id);

    print_header("Album '$real_name'");

    my $page = 0;
    while (my $album_info_aref = $sth_album->fetch)
    {
        print "<hr>\n" if $page > 0;
        ++ $page;

        # ========== get labels ==========

        my $sth = $dbh->prepare(<<SQL);
SELECT Label.id, Label.name
  FROM AlbumLabel, Label
  WHERE AlbumLabel.album_id = $album_id
    AND AlbumLabel.label_id = Label.id
SQL

        $sth->execute();

        my ($label_id, $label_name);
        $sth->bind_columns(undef, \$label_id, \$label_name);

        my @labels;
        while (my $cur = $sth->fetch)
        {
            push @labels, make_label_phrase($label_name, $label_id);
        }
        my $labels = join " |\n", @labels;
        $sth->finish;

        my $html_album_name = encode_entities($album_name);
        my $format_phrase = make_format_phrase($format_name, $format_id);
        my $artist_phrase = make_artist_phrase($artist_name, $artist_id);
        my $year_phrase = make_year_phrase($album_year);

        print <<HTML;
<h1>$artist_phrase: $html_album_name ($year_phrase)</h1>
<p>Labels: $labels</p>
<p>Format: $format_phrase</p>
<h2>Tracks:</h2>
HTML

        # ========== get tracks ==========

        $sth = $dbh->prepare(<<SQL);
SELECT track_num, name, length
  FROM Track
  WHERE album_id = $album_id
  ORDER BY Track.track_num
SQL

        $sth->execute();

        my ($track_num, $track_name, $track_length);
        $sth->bind_columns(undef, \$track_num, \$track_name, \$track_length);

        print <<HTML;
<table valign=top>
  <col align=right valign=top>
  <col align=left valign=top>
  <col align=right valign=top>
  <thead>
    <tr>
      <th>Track</th>
      <th>TItle</th>
      <th>Length</th>
    </tr>
  </thead>
  <tbody>
HTML

        my ($last_artist, $last_album, $last_author);
        my ($total_length);

        while (my $cur = $sth->fetch)
        {
            # munge the workman format lines
            my @lines = split '//', $track_name;
            foreach (@lines) {
                if (/^\+\[(.*)\]$/)
                {
                    my $author = $1 || $last_author || "";
                    $_ = "<small>Writer: " . encode_entities($author) . "</small>";
                    $last_author = $author;
                }
                elsif (/^\+/)
                {
                    my $album = substr($_, 1) || $last_album || "";
                    $_ = "<small>From: <cite>" . encode_entities($album) . "</cite></small>",
                    $last_album = $album;
                }
                elsif (/^\@/)
                {
                    my $artist = substr($_, 1) || $last_artist || "";
                    $_ = ( "<small>By: <strong>" .
                           encode_entities($artist) .
                           "</strong></small>" );
                    $last_artist = $artist;
                }
                else
                {
                    $_ = encode_entities($_);
                }
            }

            my $track_content = join "<br>", @lines;

            print
              "<tr valign=top>\n",
              "  <td align=right>$track_num</td>\n",
              "  <td>$track_content</td>\n",
              "  <td align=right>", mm_ss($track_length), "</td>\n",
              "</tr>\n";

            $total_length += $track_length;
        }

        if ($total_length)
        {
            print
              "<tr valign=\"top\">\n",
              "  <td align=\"right\" colspan=\"2\"><em>Total running time:</em></td>\n",
              "  <td align=\"right\"><em>", mm_ss($total_length), "</em></td>\n",
              "</tr>\n";
        }

        print <<HTML;
  </tbody>
</table>
HTML

    }

    print_footer();
}

# ======================================================================
# punt

else
{
    my $html_mode = encode_entities($q->param('mode'));

    die_politely(<<HTML);
<p>
  This program does not understand given mode <code>$html_mode</code>.
  Please select another option from the navigation bar.  Thanks!
</p>

<p>
  If you got this message after clicking a link on one of the
  generated pages, please

  <a href="mailto:tkil\@scrye.com">mail me</a>

  to let me know.  I appreciate it!
</p>
HTML
}

# ======================================================================
# common termination

$dbh->disconnect();