#!/usr/bin/perl
#mini-cb60-render.pl
# This is free Software.
# Released under the same terms as Perl.
# Copyright Yves (demerphq) 2006

use strict;
use warnings;
use CGI ();
use Getopt::Long;
use vars qw/$VERSION/;
$VERSION= 0.02;

############### SET THESE AS APPROPRIATE ######################
my $SITE_DOMAIN= "mini-cb60.flux8.com";
my $SITE_PATH= "/";
my $PM_HOST_USERNAME= "demerphq";
my $PM_HOST_USERID= 108447;
############### OR SET FROM COMMANDLINE #######################

$CGI::POST_MAX= 1024;       # no need for more than 1k.
$CGI::DISABLE_UPLOADS = 1;  # no uploads
my $do_header= $ENV{REQUEST_METHOD} ? 1 : 0; # Default based on if run from shell
my $q= CGI->new();
my @cookies;

sub get_user_param {
    my ( $name, @legal )= @_;
    my %screen= map { lc($_) => $_ } @legal;
    my $cval= $screen{lc($q->cookie($name))};
    my $pval= $screen{lc($q->param($name))};
    my $ret= $pval || $cval || $legal[0];
    if ($do_header && ($ret ne $legal[0] || ($cval && $cval ne $ret))) {
        push @cookies,
            $q->cookie(
                -name => $name,
                -value => $ret,
                -expires => '+10y',
                $SITE_PATH ?  (-path => $SITE_PATH) : (),
                $SITE_DOMAIN ? (-domain => $SITE_DOMAIN) : (),
            );
    }
    return $ret;
}

(my $dir= $0) =~ s![^\\\/]+$!messages/!;
GetOptions(
    'msgdir=s'    => \$dir,
    'header!'     => \$do_header,
    'domain=s'    => sub { $q->param(@_) },
    'site_domain' => \$SITE_DOMAIN,
    'site_path'   => \$SITE_PATH,
    'hoster=s'    => \$PM_HOST_USERNAME,
    'hosterid=i'  => \$PM_HOST_USERID,
    'reverse!'    => sub { $q->param(@_) },
) or die <<EOFUSAGE;
mini-cb60-render.pl --msgdir=PATH --[no]header
                    --domain=(org|com|net)
                    --hoster=MONKNAME --hosterid=MONKID
EOFUSAGE

my @domains=qw(org com net);
my $domain= get_user_param('domain',@domains);
my $order= get_user_param('order',qw(desc asc));

chdir $dir;

print $do_header
        ? $q->header(@cookies ? ( -cookie => \@cookies ) : ())
        : "",
    $q->start_html(
        -title=> 'Perlmonks Mini-CB60',
        -xbase=> "http://perlmonks.$domain/index.pl",
        -meta=> { 'keywords'=>"Perlmonks Mini-CB60",},
        -head=>$q->Link({
            -rel=>'icon',
            -href=>"/favicon.ico"}
        ),
        -style=> { -code => "dt { background-color:#ddd }" },
    ),
    $q->center(
        $q->h1(
            $q->a( { href => '?node_id=131' },
                "Perlmonks")
          . " "
          . $q->a( { href => "http://$SITE_DOMAIN$SITE_PATH" },
                "Mini-CB60")
        )
    ),
    $q->start_dl();

my $threshold= sprintf "%08x-%08x.msg",time() - 3600, 0;
my @files=sort glob "*.msg";
@files=reverse @files if $order eq 'desc';
foreach my $file (@files) {
    if ($file lt $threshold) {
        unlink $file;
        next;
    }
    open my $fh,"<",$file or die "Failed to read '$file' :$!";
    chomp(my $version=<$fh>);
    if ( $version == 0 ) {
        print <$fh>;
    } else {
        die "Error '$file' is of an unknown version: '$version'";
    }
}

my $hostspec="";
if ( $PM_HOST_USERNAME ) {
    $hostspec.= "<br/>Hosted by:" .
        ( $PM_HOST_USERID
          ?  $q->a(
                { href => "?node_id=$PM_HOST_USERID" },
                $PM_HOST_USERNAME
            )
          : $PM_HOST_USERNAME
        )
}
my @form=!$do_header ? () : (
      $q->hr,
      $q->start_center,
      $q->start_form(-action=>"http://$SITE_DOMAIN"),
      "Preferred Domain for Perlmonks: ",
      $q->radio_group(
        -name=>'domain',
        -values=>\@domains,
        -default=>$domain,
        -force=>1,
      ),
      $q->br,
      "Order messages: ",
      $q->radio_group(
        -name=>'order',
        -values=>['desc','asc'],
        -default=>$order,
        -force=>1,
        -labels=>{ asc => 'Oldest First',
                   desc => 'Newest First'}
      ),
      $q->br,
      $q->submit(-name=>'stumbit',
                 -value=>'Update Preferences'),
      $q->endform(),
      $q->end_center,
);

print $q->end_dl(),
      @form,
      $q->hr,
      $q->p( { align => 'right' },
            $q->small(
                  $q->a({href=>'?node_id=531067'},"Version $VERSION")
                . "<br/>Coding By "
                . $q->a({ href => '?node_id=108447' },'demerphq')
                . $hostspec
            )
      ),
      $q->end_html(),
      "\n";