package Apache::LowCal::Common;

# Apache::LowCal::Common - Library of common functions for LowCal components
# Copyright (C) 2000 Dave Sherohman (dave@sherohman.org)
#
# 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

BEGIN {
  use Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(&parse_date);
  @EXPORT_OK = qw(&parse_template &send_catbox);
}

use Apache::Constants qw (:common);
use Time::Local;

use strict;

# Input:  ($request_rec, $template_name, \%token_hash)
# Output: OK or error code
#
# Opens the named template (which could also be an event file), perform the
# substitutions given in the token hash, and print the results to the client
# browser
sub parse_template {
  my ($r, $tempname, $tokref) = @_;
  my $catbox_size = 3;

  return NOT_FOUND unless open(TEMPLATE, $tempname);
  while (<TEMPLATE>) {
    my $line = $_;    
    if ($line =~ /%.+%/) {    # Skip token check if no %...%
      while ((my ($token, $value)) = each (%{$tokref})) {
        $line =~ s/%$token%/$value/g;
      }

      # Deal with tokens that require processing beyond a simple text
      # substitution
      $catbox_size = $1 if $line =~ s/%CATBOXSIZE=(\d+)%//g;
      $line =~ s/%CATBOX%/send_catbox($$tokref{'CATLIST'}, $catbox_size)/eg;
    }
    $r->print($line);
  }
  close TEMPLATE;

  return OK;
}

# Input:  ($date, $day, $month, $year)
# Output: ($day, $month, $year, $weekday)
#
# All input values may have +/-offset appended and that offset will be
# applied to the output date.  Any values which are not set will default
# to the current date
sub parse_date {
  my ($date_param, $day_param, $month_param, $year_param) = @_;
  my ($day, $month, $year);
  my ($weekday, $day_off, $month_off, $year_off);

  ($day, $month, $year) = (localtime)[3..5];
  $year += 1900;
  $month += 1;

  # Compensate for URI decoding converting + to space
  $date_param   =~ tr/ /+/;
  $day_param    =~ tr/ /+/;
  $month_param  =~ tr/ /+/;
  $year_param   =~ tr/ /+/;

  if ($date_param) {
    if ($date_param =~ m~(\d\d?)/(\d\d?)/(\d+)~) {
      # American mm/dd/yyyy
      $month = $1;
      $day = $2;
      $year = $3;
    } elsif ($date_param =~ /(\d\d?)-(\d\d?)-(\d+)/) {
      # European dd-mm-yyyy
      $day = $1;
      $month = $2;
      $year = $3;
    }
  }

  # Untaint and handle offsets
  if ($year_param =~ /(\d*)([-+]?)(\d*)/) {
    $year = $1 if $1;
    $year += $3 if $2 eq '+';
    $year -= $3 if $2 eq '-';
  }

  if ($month_param =~ /(\d*)([-+]?)(\d*)/) {
    $month = $1 if $1;
    if ($2 eq '+') {
      $month += $3;
      while ($month > 12) {
        $month -= 12;
        $year += 1;
      }
    } elsif ($2 eq '-') {
      $month -= $3;
      while ($month < 1) {
        $month += 12;
        $year -= 1;
      }
    }
  }

  if ($day_param =~ /(\d*)([-+]?)(\d*)/) {
    $day = $1 if $1;
    if ($2 eq '+') {
      $day_off = $3;
    } elsif ($2 eq '-') {
      $day_off = $3 * -1;
    }
  }

  # Convert date to epoch time and back to handle day offset and obtain
  # day of week
  my $epochtime = timelocal(0, 0, 12, $day, ($month - 1), $year);
  $epochtime += 24 * 60 * 60 * $day_off;
  ($day, $month, $year, $weekday) = (localtime($epochtime))[3..6];
  $year += 1900;
  $month += 1;

  return ($day, $month, $year, $weekday);
}

# Input:  ([$current_categories][, $lines])
# Output: ($HTML_string)
#
# Returns an HTML string which will create a multiple-select listbox
# containing all available categories (as defined in the event directory's
# 'categories' file).  $current_categories is a list of categories that
# are currently displayed so that they can be preselected in the listbox.
# Three lines will be displayed unless overridden by the $lines parameter.

sub send_catbox {
  my $curr_cat = shift || '';
  my $lines = shift || 3;
  my @categories = ();
  my @displayed = ();
  my $result;

  # Read the list of available categories
  return "" unless open(CATFILE, "categories");
  while (<CATFILE>) {
    chomp;
    push @categories, $_ unless (!$_ || /^\s*#/);
  }
  close CATFILE;

  return "" unless $#categories > -1;

  # Parse the list of currently-displayed categories
  if ($curr_cat ne 'all events') {
    @displayed = split ', ', $curr_cat;
  }

  # Generate HTML for listbox
  $result = "\n<select name=category multiple";
  $result .= " size=$lines" if $lines > 0;
  $result .= ">\n";
  $result .= "<option value=\"*\"";
  $result .= " selected" unless $#displayed > -1;
  $result .= ">All events</option>\n";

  foreach my $cat (@categories) {
    $result .= "<option";
    $result .= " selected" if (grep /$cat/i, @displayed);
    $result .= ">$cat</option>\n"
  }

  $result .= "</select>\n";

  return $result;
}

1;

END { }
