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

my $home = 'http://slinky.scrye.com/~tkil';

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

my $q = new CGI;
my $dbh = DBI->connect("DBI:mysql:hostname=localhost:database=Tkil_CDs",
		       "tkil_ro", "")
  or die DBI->errstr;

my $albums_per_page = 100;

# ======================================================================
# 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);

  my $a = encode_entities($artist);
  $a =~ s!//!<br>\n    &nbsp;&nbsp;&nbsp;!g;

  return "<a href='$url'>$a</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>" ;
}

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;

  # ========== emit HTML ==========
  # and handle the first row specially, since we already started
  # it with the artist name.
  print
    "<tr valign=top border=top>\n",
    "  <td rowspan=", scalar @$album_aref, ">$artist_phrase</td>\n",
    "  <td>", shift(@albums), "</td>\n",
    "  <td align=right>", shift(@years), "</td>\n",
    "  <td align=right>", shift(@lengths), "</td>\n",
    "</tr>\n";

  # then do the rest of the rows.
  while (@albums)
  {
    print
      "<tr valign=top>\n",
    "  <td>", shift(@albums), "</td>\n",
    "  <td align=right>", shift(@years), "</td>\n",
    "  <td align=right>", shift(@lengths), "</td>\n",
    "</tr>\n";
  }
}

{
  my ($all_by_artist, $all_by_album, $all_by_year, $all_by_length) =
    map { make_url("all_cds", sort => $_) } qw(artist album year length);

  my $sth;

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

  $sth = $dbh->prepare("select substring(sort_key, 1, 1) as init, count(*) " .
		       "from Artist group by init")
    or die $dbh->errstr;
  $sth->execute
    or die $sth->errstr;

  my %cds_by_init;
  while (my $cur = $sth->fetch)
  {
    my ($init, $count) = @$cur;
    $init = uc $init;
    $cds_by_init{$init} = $count;
  }
  $sth->finish;

  my @index_span = ( [ '0' .. '9' ],
		     [ 'A' .. 'J' ],
		     [ 'K' .. 'T' ],
		     [ 'U' .. 'Z' ] );
  my @indexes;
  foreach my $span (@index_span)
  {
    my @this_row = map
    {
      if (exists $cds_by_init{$_})
      {
	$_ = ("<a href='" . make_url("all_cds", pattern => "$_*") .
	      "'>$_</a> (" . $cds_by_init{$_} . ")");
      }
      "\t  <td><small>$_</small></td>\n";
    }
    @$span;

    push @indexes, join "", @this_row;
  }

  my $index_bar = "  " . join("\t</tr>\n\t<tr>\n", @indexes) . "\n";
  my $n_index_rows = @indexes;

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

  $sth = $dbh->prepare("select year, count(*) from Album group by year")
      or die $dbh->errstr;
  $sth->execute
    or die $sth->errstr;

  my %cds_from_year;
  while (my $cur = $sth->fetch)
  {
    my ($year, $count) = @$cur;
    $cds_from_year{$year} = $count;
  }
  $sth->finish;

  my ($min_year, $max_year) =
    (sort { $a <=> $b } grep { $_ != 0 } keys %cds_from_year )[0, -1];

  my ($min_decade, $max_decade) = map { int($_ / 10) } $min_year, $max_year;

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

    my @this_decade = map
    {
      if (exists $cds_from_year{$_})
      {
	$_ = ("<a href='" . make_url("all_cds", year => "$_") .
	      "'>$_</a> (" . $cds_from_year{$_} . ")");
      }
      "\t  <td><small>$_</small></td>\n"
    }
    $real_decade .. $real_decade+9;

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

  my $year_bar = join "\t</tr>\n\t<tr>", @years;

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

  my $nav_bar = <<HTML;
    <table cellpadding=0 cellspace=0>
      <colgroup>
        <col align="right">
      </colgroup>
      <colgroup>
        <col>
        <col>
        <col>
        <col>
        <col>
        <col>
        <col>
        <col>
        <col>
        <col>
      </colgroup>
      <tbody>
	<tr valign="top">
	  <td align=right>
	    <small>All CDs by:</small>
	  </td>
	  <td colspan=10>
	    <small>
	      <a href='$all_by_artist'>Artist</a> |
	      <a href='$all_by_album'>Album</a> |
	      <a href='$all_by_year'>Year</a> |
	      <a href='$all_by_length'>Length</a>
	    </small>
	  </td>
	</tr>
	<tr valign="top">
	  <td align="right" rowspan=$n_index_rows>
	    <small>Groups:</small>
	  </td>
	  $index_bar
	</tr>
	<tr valign="top">
	  <td align=right rowspan=$n_decades>
	    <small>
	      Albums from:
	    </small>
	  </td>
	  $year_bar
	</tr>
	<tr valign="top">
	  <td align=right>
	    <small>
	      About:
	    </small>
	  </td>
	  <td colspan=10>
	    <small>
	      <a href="$home/">Tkil</a> |
	      <a href="$home/perl/">his perl examples</a> |
	      <a href="$home/perl/browse-cds">this CGI</a>
	        (and its <a href="$home/perl/browse-cds-devel"
                 >development version</a>) |
	      <a href="$home/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>
  <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 %dbs_to_use = (Artist => 1, Album => 1);

  my $sort_clause;
  my $sort_title;
  my $sort_mode = $q->param('sort');
  if (!$sort_mode || $sort_mode eq 'artist')
  {
    $sort_clause = "ORDER BY Artist.sort_key, Album.year, Album.name";
    $sort_title = "All CDs by Artist";
  }
  elsif ($sort_mode eq 'year')
  {
    $sort_clause = "ORDER BY Album.year, Artist.sort_key, Album.name";
    $sort_title = "All CDs by Year";
  }
  elsif ($sort_mode eq 'album')
  {
    $sort_clause = "ORDER BY Album.name, Artist.sort_key, Album.year";
    $sort_title = "All CDs by Album";
  }
  elsif ($sort_mode eq 'length')
  {
    $sort_clause = "ORDER BY Album.length, Artist.sort_key, Album.year, Album.name";
    $sort_title = "All CDs by Length";
  }

  print_header("$sort_title");

  # ========== get only a certain subset of artists? ==========

  my $where_clause = "WHERE Artist.id = Album.artist_id";
  if (my $pat = $q->param('pattern'))
  {
    $sort_title = "Artists matching '$pat'";
    # translate from glob to SQL glob.
    for ($pat) {
      s/\_/\\_/g;
      s/\%/\\%/g;
      s/\*/\%/g;
      s/\?/\_/g;
    }
    $where_clause .= " AND Artist.sort_key LIKE " . $dbh->quote($pat);
    $do_pages = 0;
  }

  # ========== get only a certain year? ==========

  if (my $year = $q->param('year'))
  {
    $sort_title = "Albums from $year";
    $where_clause .= " AND Album.year = $year";
    $dbs_to_use{Album} = 1;
    $do_pages = 0;
  }

  # ========== 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")
	  or die $dbh->errstr;
      $sth->execute or die $sth->errstr;
      my $cur = $sth->fetch
	or die_politely("couldn't determine label name for label_id = $param_label_id");
      ($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))
	  or die $dbh->errstr;
      $sth->execute or die $sth->errstr;
      my $cur = $sth->fetch
	or die_politely("couldn't determine label id for label_name = $param_label_name");
      ($real_label_name, $real_label_id) = @$cur;
      $sth->finish;
    }

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

    @dbs_to_use{qw(AlbumLabel Album)} = (1, 1);
    $where_clause .= (" AND AlbumLabel.label_id = $real_label_id" .
		      " AND AlbumLabel.album_id = Album.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")
      or die $dbh->errstr;
    $sth_count_cds->execute()
      or die $sth_count_cds->errstr;
    $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:

  print <<HTML;
<h1>$sort_title</h1>
$page_bar
<table valign=top>
  <col align=left valign=top>
  <col align=left valign=top>
  <col align=right valign=top>
  <col align=right valign=top>
  <thead>
    <tr>
      <th>Artist</th>
      <th>Album</th>
      <th>Year</th>
      <th>Length</th>
    </tr>
  </thead>
  <tbody>
HTML

  my $dbs_string = join ", ", keys %dbs_to_use;

  my $sth = $dbh->prepare(<<SQL) or die $dbh->errstr;
select Artist.name, Artist.id, Album.name, Album.id, Album.year, Album.length
  from $dbs_string
  $where_clause
  $sort_clause
  $limit_clause
SQL

  $sth->execute()
    or die $sth->errstr;

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

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

  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);

      # empty out the accumulators.
      @album_accum = ();
      @album_id_accum = ();
      @year_accum = ();
      @length_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;
  </tbody>
</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")
	or die $dbh->errstr;
    $sth->execute or die $sth->errstr;
    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
    or die $sth->errstr;

  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")
	or die $dbh->errstr;
    $sth->execute or die $sth->errstr;
    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) or die $dbh->errstr;
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 or die $sth_album->errstr;

  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)
      or die $sth_album->errstr;

  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) or die $dbh->errstr;
SELECT Label.id, Label.name
  FROM AlbumLabel, Label
  WHERE AlbumLabel.album_id = $album_id
    AND AlbumLabel.label_id = Label.id
SQL

    $sth->execute
      or die $sth->errstr;

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

    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) or die $dbh->errstr;
SELECT track_num, name, length
  FROM Track
  WHERE album_id = $album_id
  ORDER BY Track.track_num
SQL

    $sth->execute
      or die $sth->errstr;

    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);

    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";
    }

    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();