package Apache::LowCal::Admin;

# Apache::LowCal::Admin - Web-based administration module for LowCal
# Copyright (C) 2001 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

use strict;

use Apache::Constants qw (:common);
use Apache::Util qw(escape_uri);

use File::Copy;

use Apache::LowCal::Common qw(&parse_template &parse_date);

my $version = "1.1.0";
use vars '$uri';
my %args = ();
my %tokens = ('VERSION', $version);

# Module config settings
my ($event_path, $calendar_uri);

sub handler {
  my $r = shift;

  $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';

  # Read config options
  $event_path = $r->server_root_relative($r->dir_config('EventPath'));
  chdir $event_path || die "Bad EventPath: $event_path ($!)\n";

  my @allargs = ($r->args, $r->content);
  %args = ();   # Clear out any data left over from previous calls
  while (my ($argname, $argval) = splice @allargs, 0, 2) {
    if (exists $args{$argname}) { $args{$argname} .= ',' . $argval }
    else                        { $args{$argname}  = $argval }
  }

  $r->uri =~ m~.*/([^/]+)/?$~;
  $uri = $1;
  $tokens{URI} = $uri;

  my ($mday, $nmon, $year, $wday)
    = parse_date($args{'date'}, $args{'day'}, $args{'month'}, $args{'year'});
  $tokens{DATE} = "$nmon/$mday/$year";
  $tokens{EDATE} = "$mday-$nmon-$year";

  $args{'adminedit'} = $args{'event'}
    if ($args{'event'} && !$args{'adminedit'});

  if ($args{'adminsave'}) {
    return admin_save($r, $args{'adminedit'}, $args{'evtsource'});
  } elsif ($args{'adminedit'}) {
    return admin_edit($r, $args{'adminedit'});
  } elsif ($args{'adminrepeating'}) {
    return admin_repeating($r);
  } elsif ($args{'adminlist'}) {
    return admin_list($r, $year, $nmon, $mday);
  } elsif ($args{'adminadd'}) {
    $year = 'evt' if $args{'date'} eq 'evt';
    return admin_add($r, $args{'adminadd'}, $args{'tag'}, $args{'source'},
                     $year, $nmon, $mday);
  } elsif ($args{'admindelete'}) {
    return admin_delete($r, $args{'admindelete'}, $year, $nmon, $mday);
  } else {
    return admin_options($r);
  }
}

sub admin_options {
  my $r = shift;

  $r->content_type('text/html');
  $r->send_http_header;
  return OK if $r->header_only();

  print "<html><head>\n<title>LowCal Admin</title>\n</head><body>\n"
      . "<h2>You must provide an administrative command</h2>\n"
      . "</body></html>\n"
    unless (parse_template($r, "admin_options", \%tokens) == OK);

  return OK;
}

sub admin_list {
  my ($r, $year, $nmon, $mday) = @_;

  $r->content_type('text/html');
  $r->send_http_header;
  return OK if $r->header_only();

  my $basename = sprintf "%04d%02d%02d", $year, $nmon, $mday; 

  # Get list of files in event directory
  opendir(EVENTS, '.') || die "Can't open directory: $!";
  my @events = sort readdir EVENTS;
  closedir EVENTS;

  print "<html><head>\n<title>Event List</title>\n</head><body>\n"
    unless (parse_template($r, "admin_list_header", \%tokens) == OK);

  print "<table border=1>\n";
  print "<th>Event Tag</th>\n";
  print "<th>Event Name</th>\n";
  print "<th>U/L</th>\n";
  print "<th>Location</th>\n";
  print "<th>Categories</th>\n";

  my ($evtfile, $tag, $title, $unique, $location, $category);

  foreach (grep /^$basename/, @events) {
    $evtfile = $_;
    /^$basename-(.*)/;
    $tag = $1 || '(Null)';

    $title = '(No title)';
    if (open(EVTFILE, $evtfile)) {
      while (<EVTFILE>) {
        if (/<meta .*eventname=\"([^\"]*)\"/i) {                      #"
          $title = $1;
          $location = /location=\"([^\"]*)\"/i ? $1 : '';             #"
          $category = /category=\"([^\"]*)\"/i ? $1 : '';             #"
          last;
        }
      }
      close EVTFILE;
    } else {
      $title = "Error: $!";
    }

    $unique = !(-l $evtfile);

    print "<tr>\n";
    print "<td>$tag</td>\n";
    print "<td>$title</td>\n";
    print "<td align=center>" . ($unique ? 'U' : 'L') . "</td>\n";
    print "<td>" . ($location ? "<a href=\"$location\">$location</a>"
                              : "(Local)") . "</td>\n";
    print "<td>$category</td>\n";

    print "<td><a href=\"$uri?adminedit=$evtfile&date=$nmon/$mday/$year\">"
        . "Edit</td>";
    print "<td><a href=\"$uri?admindelete=$evtfile&date=$nmon/$mday/$year\">"
        . "Delete</td>";
    print "</tr>\n\n";

  }

  print "</table>\n";

  # Add fields for event additions
  print "<form action=$uri method=get>\n";
  print "<h3>Create new event</h3>";
  print "<table>\n";
  print "<tr><td>Event tag:</td><td><input name=tag></td></tr>\n";
  print "<tr><td>Source file:</td><td><input name=source></td></tr>\n";
  print "<input name=date type=hidden value=$nmon/$mday/$year>\n";
  print "</table>\n";

  print "<table>\n<tr>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Blank type=submit> listing</td>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Copy type=submit> from source file</td>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Link type=submit> to source file</td>\n";
  print "</tr>\n</table>\n";
  print "</form>";
  print "</tr>\n\n";

  print "</body></html>"
    unless (parse_template($r, "admin_list_footer", \%tokens) == OK);

  return OK;
}

sub admin_repeating {
  my $r = shift;

  $r->content_type('text/html');
  $r->send_http_header;
  return OK if $r->header_only();

  # Get list of files in event directory
  opendir(EVENTS, '.') || die "Can't open directory: $!";
  my @events = sort readdir EVENTS;
  closedir EVENTS;

  print "<html><head>\n<title>Event List</title>\n</head><body>\n"
    unless (parse_template($r, "admin_list_header", \%tokens) == OK);

  print "<table border=1>\n";
  print "<th>Event Tag</th>\n";
  print "<th>Event Name</th>\n";
  print "<th>Location</th>\n";
  print "<th>Categories</th>\n";
  print "<th>Year</th>\n";
  print "<th>Month</th>\n";
  print "<th>Day</th>\n";
  print "<th>Weekday</th>\n";

  my ($evtfile, $tag, $title, $rpt_year, $rpt_nmon, $rpt_mday, $rpt_wday,
      $location, $category);

  foreach (grep /^evt-/, @events) {
    $evtfile = $_;
    /^evt-(.*)/;
    $tag = $1 || '(Null)';

    $title = '(No title)';
    if (open(EVTFILE, $evtfile)) {
      while (<EVTFILE>) {
        if (/<meta .*eventname=\"([^\"]*)\"/i) {                      #"
          $title = $1;
          $location = /location=\"([^\"]*)\"/i ? $1 : "";             #"
          $category = /category=\"([^\"]*)\"/i ? $1 : '';             #"
        } elsif (/<meta .*repeat=\"([-0-9,*\/ ]+)\"/i) {              #"
          ($rpt_year, $rpt_nmon, $rpt_mday, $rpt_wday) = split ' ', $1;
        }
      }
      close EVTFILE;
    } else {
      $title = "Error: $!";
    }

    print "<tr>\n";
    print "<td>$tag</td>\n";
    print "<td>$title</td>\n";
    print "<td>" . ($location ? "<a href=\"$location\">$location</a>"
                              : "(Local)") . "</td>\n";
    print "<td>$category</td>\n";
    print "<td>$rpt_year</td>\n";
    print "<td>$rpt_nmon</td>\n";
    print "<td>$rpt_mday</td>\n";
    print "<td>$rpt_wday</td>\n";

    print "<td><a href=\"$uri?adminedit=$evtfile\">Edit</td>";
    print "<td><a href=\"$uri?admindelete=$evtfile\">Delete</td>";
    print "</tr>\n\n";
  }

  print "</table>";

  # Add fields for event additions
  print "<form action=$uri method=get>\n";
  print "<h3>Create new event</h3>";
  print "<table>\n";
  print "<tr><td>Event tag:</td><td><input name=tag></td></tr>\n";
  print "<tr><td>Source file:</td><td><input name=source></td></tr>\n";
  print "<input name=date type=hidden value=evt>\n";
  print "</table>\n";

  print "<table>\n<tr>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Blank type=submit> listing</td>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Copy type=submit> from source file</td>\n";
  print "<td width=33%>"
      . "<input name=adminadd value=Link type=submit> to source file</td>\n";
  print "</tr>\n</table>\n";
  print "</form>";
  print "</tr>\n\n";

  print "</body></html>"
    unless (parse_template($r, "admin_list_footer", \%tokens) == OK);

  return OK;
}

# For now, this just grabs the named file and dumps it to the browser as
# text/plain.  Come back later and do some parsing on it (particularly the
# LowCal metas) to make it a little friendlier
sub admin_edit {
  my ($r, $evtfile) = @_;

  return FORBIDDEN if $evtfile =~ /\.\./;
  return FORBIDDEN if $evtfile =~ /[\/\\]/;

  $r->content_type('text/html');
  $r->send_http_header;
  return OK if $r->header_only();

  my $evtdata = '';
  my $srclines = 10;
  if (open(EVTFILE, $evtfile)) {
    while (<EVTFILE>) {
      $srclines++;
      $evtdata .= $_;
    }
    close EVTFILE;

    print "<html>\n<head>\n<title>Event Data: $evtfile</title>\n<body>\n"
      unless (parse_template($r, "admin_evt_header", \%tokens) == OK);

    print "<form action=$uri method=post>\n";
    print "<table border=1 width=100%>\n<tr valign=top>\n";
    print "<td width=50%>\n<textarea name=evtsource rows=$srclines cols=80>\n";
    print "$evtdata\n</textarea>\n</td>\n";
    print "<td width=50%>\n$evtdata\n</td>";
    print "</table>";
    print "<input type=hidden name=adminedit value=$evtfile>\n";
    print "<input type=submit name=adminsave value=\"Save Changes\">\n";
    print "</form>\n";

    print "</body></html>"
      unless (parse_template($r, "admin_evt_footer", \%tokens) == OK);
  } else {
    print "$evtfile: $!";
  }

  return OK;
}

sub admin_save {
  my ($r, $evtfile, $evtsource) = @_;

  return FORBIDDEN if $evtfile =~ /\.\./;
  return FORBIDDEN if $evtfile =~ /[\/\\]/;

  $evtfile = $1 if $evtfile =~ /([^`' "\/\\]+)/;      # Untaint filename

  if (open(EVTFILE, ">$evtfile")) {
    print EVTFILE $evtsource;
    close EVTFILE;
  } else {
    $r->content_type('text/html');
    $r->send_http_header;
    print "$evtfile: $!";
    return OK;
  }

  return admin_edit($r, $evtfile);
}

sub admin_add {
  my ($r, $action, $tag, $source, $year, $nmon, $mday) = @_;

  my $evtfile;
  if ($year eq 'evt') {
    $evtfile = 'evt-' . $tag;
  } else {
    $evtfile = (sprintf "%04d%02d%02d-", $year, $nmon, $mday) . $tag;
  }
  $evtfile = $1 if $evtfile =~ /([^`' "\/\\]+)/;      # Untaint filename

  umask 007;
  if    ($action =~ /^blank/i)  { `touch $evtfile`          }
  elsif ($action =~ /^copy/i)   { copy($source, $evtfile)   }
  elsif ($action =~ /^link/i)   { `ln -s $source $evtfile`  }
  else {
    $r->content_type('text/html');
    $r->send_http_header;
    print "Invalid adminadd action: $action";
    return OK;
  }

  return admin_edit($r, $evtfile);
}

sub admin_delete {
  my ($r, $evtfile, $year, $nmon, $mday) = @_;

  return FORBIDDEN if $evtfile =~ /\.\./;
  return FORBIDDEN if $evtfile =~ /[\/\\]/;

  $evtfile = $1 if $evtfile =~ /([^`' "\/\\]+)/;      # Untaint filename

  unlink $evtfile;

  return ($evtfile =~ /^evt-/) ? admin_repeating($r)
                               : admin_list($r, $year, $nmon, $mday);
}

sub parse_categories {
  my $r = shift;

  my $catlist;
  if ($args{'category'}) {
    $catlist = $args{'categories'}
              ? $args{'category'} . ',' .  $args{'categories'}
              : $args{'category'};
  } elsif ($args{'categories'}) { 
    $catlist = $args{'categories'};
  } else {
    $catlist = '';
  }

  $catlist = '' if $catlist =~ /\*/;    # Empty string and * are equivalent

  @categories = split ',', $catlist;

  return;
}

1;

