#!/usr/bin/perl
##--------------------------------------------------------------------------##
##  File:
##      $Id: mnav.cgi.in.dist,v 1.3 2002/03/06 22:45:14 ehood Exp $
##  Author:
##      Earl Hood       earl@earlhood.com
##  Description:
##	Simple CGI program to handle prev/next month navigation.
##	This program sends an appropriate redirect to an HTTP client
##	to the next/prev month index.  If no prev/next month exists
##	from provided reference month, client is redirected to
##	top index of list archive.
##
##	Error detection is very minimal.  There is a dependency that
##	this script is called with appropriate arguments.
##--------------------------------------------------------------------------##
##  Copyright (C) 2001-2002	Earl Hood <earl@earlhood.com>
##
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##  
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##  
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##  02111-1307, USA
##--------------------------------------------------------------------------##

package mnav_cgi;

use CGI::Carp;

#############################################################################
##	BEGIN: Config Section
#############################################################################

## Full pathname to where HTML archives are located.
my $html_archive_root = '/home/itdp/WWW/html';

## URL pathname to where HTML archives are located.
my $url_archive_root = '/~itdp/html';

#############################################################################
##	END: Config Section
#############################################################################

## Query argument name to contain name of archive
my $argname_archive = 'a';

## Query argumant name to contain nav direction ('next' or 'prev')
my $argname_direction = 'd';

## Query argument name to contain month
my $argname_month = 'm';

## Query argument name to contain type of index
my $argname_type = 't';

MAIN: {
  my $form 	= parse_input();
  my $archive 	= $form->{$argname_archive};
  my $direction = $form->{$argname_direction};
  my $month 	= $form->{$argname_month};
  my $type 	= $form->{$argname_type};
  my $host	= $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} ||
		  $ENV{'SERVER_ADDR'};
  my $port	= $ENV{'SERVER_PORT'} || "";
  if ($port && $port ne '80') {
    $port = ":$port";
  } else {
    $port = "";
  }
  my $server_url= "http://$host$port";
  my $dir	= join('/', $html_archive_root, $archive);
  my $url	= $server_url . join('/', $url_archive_root, $archive);

  local(*DIR);
  if (!opendir(DIR, $dir)) {
      warn qq/Unable to open "$dir": $!\n/;
      print_location($url);
      last MAIN;
  }

  my @months = sort grep { /^\d+(?:-\d+)?/ } readdir(DIR);
  close(DIR);
  if (scalar(@months) <= 0) {
    # No month directories, so jump to top index
    print_location($url);
    last MAIN;
  }

  # Search for current month in listing
  my($i);
  for ($i=0; $i <= $#months; ++$i) {
    last if $month eq $months[$i];
  }
  # Adjust offset according to direction
  if ($direction =~ /prev/) { --$i; } else { ++$i; }
  if (($i < 0) || ($i > $#months)) {
    # Hit bounds, so jump user to top index
    print_location($url);
    last MAIN;
  }

  # Redirect user to new month
  $url .= '/' . $months[$i] . '/' .
	  ($type eq 't' ? 'threads.html' : 'index.html');
  print_location($url)
}

#############################################################################
##	Generic subroutines for CGI use
#############################################################################

sub print_location {
  print STDOUT 'Location: ', $_[0], "\r\n\r\n";
}

#-----------------------------------------------------------------------
#	Converts the input data into a hash.
#
sub parse_input {
    my($method) = ($ENV{"REQUEST_METHOD"});
    my($data);
    if ($method eq "GET") {
	$data = $ENV{"QUERY_STRING"};
    } elsif ($method eq "POST") {
	read(STDIN, $data, $ENV{"CONTENT_LENGTH"});
    } else {
	warn qq/Unknown method: $method/;
	return undef;
    }

    my(@pairs, $name, $value);
    local $_;

    my $form = { };
    if ($data ne '') {
	@pairs = split(/&/, $data);
	foreach (@pairs) {
	    ($name, $value) = split(/=/);
	    $name = expandstr($name);
	    $value = expandstr($value);
	    $form->{$name} = $value;
	}
    }
    $form;
}

#-----------------------------------------------------------------------
#	Prints out specified content-type header back
#	to client
#
sub print_content_type {
    my($type) = shift;
    print STDOUT "Content-type: $type\r\n\r\n";
}

#-----------------------------------------------------------------------
#	expandstr translates hex codes to characters
#
sub expandstr {
    my($str) = shift;
    $str =~ tr/+/ /;
    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ge;
    $str;
}

########################################################################
__END__