Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 194 lines (156 sloc) 5.432 kb
#! /usr/local/bin/perl
#---------------------------------------------------------------------
# makeweb.pl
# Copyright 2012 Christopher J. Madsen
#
# Generate a website from the Seinfeld chain database
#---------------------------------------------------------------------
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use DateTime ();
use DBI ();
use Template ();
chdir $Bin or die $!;
my $db = DBI->connect("dbi:SQLite:dbname=seinfeld.db","","",
{ AutoCommit => 1, PrintError => 0, RaiseError => 1 });
$db->do("PRAGMA foreign_keys = ON");
my $tt = Template->new({
INCLUDE_PATH => "$Bin/templates",
OUTPUT_PATH => "$Bin/web",
EVAL_PERL => 1,
TAG_STYLE => 'asp',
POST_CHOMP => 1,
});
my %start_time = (
con => DateTime->new(qw(year 2012 month 1 day 1 time_zone UTC)),
hist => DateTime->new(qw(year 1995 month 8 day 13 time_zone UTC)),
);
# Find the beginning of the current period (midnight UTC Sunday):
my $today = DateTime->today;
my $current_period = $today->clone->subtract(days => ($today->day_of_week % 7));
my $curPeriod = $current_period->epoch;
my @endangered_classes = (
('') x 3, # Sun - Tue: no indicator
('y') x 2, # Wed - Thu: less than 96 hours to make a release = yellow
('z') x 2 # Fri - Sat: less than 48 hours to make a release = red
);
my $endangered_class = $endangered_classes[ $today->day_of_week % 7 ];
chomp(my $order_by = <<'');
ORDER BY
length DESC,
active_weeks DESC,
author_id ASC
my %query_creator = (
all_time => sub {
my $type = shift;
# If an author has a chain under construction (a "current chain"):
# If an author's longest chain is longer than his current chain,
# both chains are eligible for the all_time list. Otherwise,
# only the current chain is considered. This allows authors
# with a record chain to see how their current effort is going.
#
# Else for authors without a current chain:
# Only the longest chain is considered.
return <<"";
SELECT
author_id AS id,
${type}_last_start AS start,
${type}_last_length AS length,
${type}_active_weeks AS active_weeks,
(${type}_last_end = $curPeriod) AS endangered,
1 AS ongoing
FROM authors
WHERE ${type}_last_length > 1 AND ${type}_last_end >= $curPeriod
UNION
SELECT
author_id AS id,
${type}_longest_start AS start,
${type}_longest_length AS length,
${type}_active_weeks AS active_weeks,
0 AS endangered,
0 AS ongoing
FROM authors
WHERE ${type}_longest_length > ${type}_last_length
OR (${type}_longest_length > 1 AND ${type}_last_end < $curPeriod)
$order_by
}, # end all_time
current => sub {
my $type = shift;
return <<"";
SELECT
author_id AS id,
${type}_last_start AS start,
${type}_last_length AS length,
${type}_active_weeks AS active_weeks,
(${type}_last_end = $curPeriod) AS endangered
FROM authors
WHERE ${type}_last_end >= $curPeriod AND ${type}_last_length > 1
$order_by
}, # end current
); # end %query_creator
sub begin_query
{
my ($type, $query, $limit) = @_;
my $total_weeks = $current_period->delta_days( $start_time{$type} )
->in_units('weeks') + 1;
my $one_week_percentage = 100 / $total_weeks;
my (%id_used, %row, $rank, $last_score, $new_score, $d);
my $s = $db->prepare($query_creator{$query}->($type));
$s->execute;
$s->bind_columns( \( @row{ @{$s->{NAME_lc} } } ));
$last_score = '';
return sub {
$s->fetch or return undef;
++$rank;
$new_score = "@row{qw(length active_weeks)}";
$row{ranking} = do {
if ($new_score eq $last_score) {
''; # We have a tie; hide the rank
} elsif ($limit and $rank > $limit) {
$s->finish;
return undef; # We hit the limit
} else {
$rank;
}
};
$last_score = $new_score;
$row{row_id} = do {
my $id = "id$row{id}";
die "ID $row{id} already seen twice"
if $id_used{$id}++ and $id_used{$id .= '.c'}++;
$id;
};
$row{endangered} = '' unless $endangered_class;
$row{percentage} = sprintf('%.0f%%',
$row{active_weeks} * $one_week_percentage);
$d = DateTime->from_epoch( epoch => $row{start} );
$row{start_date} = sprintf '%s %d, %d', $d->month_abbr, $d->day, $d->year;
return \%row;
};
} # end begin_query
#---------------------------------------------------------------------
sub page
{
my ($fn, $data) = @_;
$data->{endangered} = $endangered_class;
$tt->process($fn, $data, $fn);
} # end page
#=====================================================================
page('index.html' => {
all_time => begin_query(qw(con all_time), 10),
current => begin_query(qw(con current), 10),
historical => begin_query(qw(hist all_time), 10),
});
#---------------------------------------------------------------------
page('longest.html', { all_time => begin_query(qw(con all_time), 200) });
#---------------------------------------------------------------------
page('current.html', { current => begin_query(qw(con current), 0) });
#---------------------------------------------------------------------
page('historical.html', { all_time => begin_query(qw(hist all_time), 200) });
#---------------------------------------------------------------------
$db->disconnect;
# Local Variables:
# compile-command: "perl makeweb.pl"
# End:
Jump to Line
Something went wrong with that request. Please try again.