#!/usr/bin/perl -w
#
# Wcal 2.0 copyright by Joël Savignon <js@neosystem.com>.
#
# Released under GNU General Public License (GPL).
#
# TAB size 4
#

require 5.004;
use Data::Dumper;
use Date::Manip;
use Socket;
use strict;
no strict 'refs';

# These you can edit
$::CONF_FILE = '/etc/wcal.conf';
$::MSG_FILE = '/etc/wcal.msg';
$::DIRECTORY = '/var/www/VIRTUAL/www.homebase.dk/www/wcal';
$::DB_DIR = '/var/wcal';				# settable in wcal.conf in 1.x versions
$::REFRESH_DELAY = 900;					# view refreshed every 900 seconds = 15 minutes
$::PATH_BASENAME = 'wcal';				# last component of the wcal directory name

# Values below affect the proportions of the frames
$::FIRST_HOUR = 8;
$::LAST_HOUR = 23;
$::MANY_WEEKS_VERT = 2;
$::MANY_WEEKS_HOR = 7;
$::FIRST_DAY = 'monday';

# Colors
$::THCOLOR = '#E2E3FC';
$::TDCOLOR = '#D9F4F4';
$::NOW_THCOLOR = '#CAFFD0';
$::NOW_TDCOLOR = '#CAFFD0';
$::REPEAT_WEEK_TEXTCOLOR = '#C02090';
$::REPEAT_MONTH_TEXTCOLOR = '#008844';
$::BG_TDCOLOR = '#F2F3FC';
$::ERROR_COLOR = '#e06060';
@::EVENT_COLS = ('#D9F4F4','#FFFFAA','#AAFFFF','#FFAAFF','#FFAAAA','#AAAAFF','#AAFFAA','#80FFE0','#E080E0','#C0DCC0','#C0C0C0','#FF0080','#A4C8F0','#FF8000','#FF80C0','#8080C0','#FFFFFF');

# No need to touch these
$::MAX_DURATION = 21; # maximum duration of an event in days
$::CURRENT_DB_VERSION = 2;	# Wcal 1.00 had version 1 databases
$::HTTP_HEADER = "Content-Type: text/html\n\n";

# internationalization
sub __
{
    my $str = shift;
    return $::msgs->{$str}->{$::REMOTE_LANG} || $str;
}

# fusion
sub strcal
{
    if ($::query->{'cal'})
    {
	return "&cal=".join("&cal=",split(/\n/,$::query->{'cal'}));
    }
    else
    {
	return "";
    }
}

sub lncal
{
    my $year = shift;
    my $week = shift;

    if ($::query->{'cal'})
    {
	my $str = $::BASE_URL.'/fusion.cgi?t=links&cal='.join("&cal=",split(/\n/,$::query->{'cal'}));
	if ($year && $week)
	{
	    $str .= '&year='.$year.'&week='.$week;
	}
	return "<a onClick='window.open(\"$str\", \"links\", \"toolbar=no,menubar=no,scrollbars=yes,width=250,height=200,resizable=yes\"); return false' href=\"$str\" target=\"_top\">$::LONG_NAME</a>";
    }
    else
    {
	return $::LONG_NAME;
    }
}

# Query string decoder, ripped from CGI_Lite
sub decode_url_encoded_data ($) {
    my ($reference_data) = @_;
    my ($code, $self);
    
    $code = <<'End_of_URL_Decode';
    
    my (@key_value_pairs, $delimiter, $key_value, $key, $value);
    
    @key_value_pairs = ();

    return unless ($$reference_data);

    $delimiter = '&';

    $$reference_data =~ tr/+/ /;
    @key_value_pairs = split (/$delimiter/, $$reference_data);

    foreach $key_value (@key_value_pairs) {
	($key, $value) = split (/=/, $key_value, 2);

	$key   =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;
	$value =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;

#	print Socket "'$key':'$value'\n";
	
	if ($self->{$key})
	{
	    $self->{$key} .= "\n$value";
	}
	else
	{
	    $self->{$key} = $value;
	}
    }

End_of_URL_Decode

    eval ($code);
    return $self;
}

# And encoder, ripped too
sub url_encode
{
    my $string = shift;
    my $str1 = '([\x00-\x20"#%;<>?{}|\\\\^~`\[\]\x7F-\xFF])';
    $string =~ s/$str1/
	sprintf ('%%%x', ord ($1))/eg;
    
    return $string;
}

sub strip_space ($) {
    my ($s) = @_;
    $s =~ s/^\s*(.*?)\s*$/$1/;
    return $s;
}

sub wday_to_dmwday ($) {
    my ($wday) = @_;
    
    if ($::FIRST_DAY eq 'monday') {
	return ($wday + 1);
    } else {
	if ($wday == 0) {
	    return 7;
	} else {
	    return $wday;
	}
    }
}

sub dmwday_to_wday ($) {
    my ($dmwday) = @_;
    
    return ($::FIRST_DAY eq 'monday' ?
	    $dmwday - 1 :
	    $dmwday % 7);
}

sub get_now () {
    if (! defined $::now_cache) {
	my (@n);
	@n = &UnixDate (&ParseDate ('now'), $::FIRST_DAY eq 'monday' ? "%G": "%L", "%m", "%d", $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
	$::now_cache = {
	    'year' => $n[0] + 0,
	    'month' => $n[1] + 0,
	    'day' => $n[2] + 0,
	    'week' => $n[3] + 0,
	    'wday' => dmwday_to_wday ($n[4]) };
    }
    return $::now_cache;
}

sub get_next_year_week ($$) {
    my ($year, $week) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d", $year, $week);
    if (! defined $::nyw_cache{$cacheid}) {
	my ($y, $w);
	($y, $w) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "+ 7 days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
	$::nyw_cache{$cacheid} = [$y + 0, $w + 0];
    }
    return @{$::nyw_cache{$cacheid}};
}

sub get_prev_year_week ($$) {
    my ($year, $week) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d", $year, $week);
    if (! defined $::pyw_cache{$cacheid}) {
	my ($y, $w);
	($y, $w) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "- 7 days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
	$::pyw_cache{$cacheid} = [$y + 0, $w + 0];
    }
    return @{$::pyw_cache{$cacheid}};
}

sub get_month_day_by_firstday_year_week ($$) {
    my ($year, $week) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d", $year, $week);
    if (! defined $::md_cache{$cacheid}) {
	my ($month, $day);
	($month, $day) = &UnixDate (&ParseDate ("$::FIRST_DAY week $week in $year"), "%m", "%d");
	$::md_cache{$cacheid} = [$month + 0, $day + 0];
    }
    return @{$::md_cache{$cacheid}};
}

sub get_month_day_by_wday_year_week ($$$) {
    my ($wday, $year, $week) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d%1d", $year, $week, $wday);
    if (! defined $::md2_cache{$cacheid}) {
	my ($month, $day);
	($month, $day) = &UnixDate (&ParseDate ($::weekdays2[$wday] . " week $week in $year"), "%m", "%d");
	$::md2_cache{$cacheid} = [$month + 0, $day + 0];
    }
    return @{$::md2_cache{$cacheid}};
}

sub get_year_week_by_firstday_year_week_minus_days ($$$) {
    my ($year, $week, $days) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d%10d", $year, $week, $days);
    if (! defined $::yw_cache{$cacheid}) {
	my ($ryear, $rweek);
	($ryear, $rweek) = &UnixDate (&DateCalc ("$::FIRST_DAY week $week in $year", "- $days days"), $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U");
	$::yw_cache{$cacheid} = [$ryear + 0, $rweek + 0];
    }
    return @{$::yw_cache{$cacheid}};
}

sub week_wday_by_year_month_day ($$$) {
    my ($year, $month, $day) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d%2d", $year, $month, $day);
    if (! defined $::ww_cache{$cacheid}) {
	my ($week, $wday);
	($week, $wday) = &UnixDate (&ParseDate ("$month/$day/$year"), $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
	$::ww_cache{$cacheid} = [$week + 0, dmwday_to_wday ($wday)];
    }
    return @{$::ww_cache{$cacheid}};
}

sub get_start_end_by_year_week_wday_duration ($$$$) {
    my ($startyear, $startweek, $startwday, $duration) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d%2d%03d", $startyear, $startweek, $startwday, $duration);
    if (! defined $::se_cache{$cacheid}) {
	my ($startmonth, $startday, $endyear, $endweek, $endwday, $endmonth, $endday);

	($startmonth, $startday) =  get_month_day_by_wday_year_week ($startwday, $startyear, $startweek);

	($endyear, $endweek, $endwday) =
	    &UnixDate (&DateCalc (&ParseDate (sprintf ("%04d-W%02d-%1d", $startyear, $startweek, wday_to_dmwday ($startwday))),
				  "+ " . ($duration - 1) . " days"),
		       $::FIRST_DAY eq 'monday' ? "%G": "%L", $::FIRST_DAY eq 'monday' ? "%W" : "%U", "%w");
	$endwday = dmwday_to_wday ($endwday);

	($endmonth, $endday) =  get_month_day_by_wday_year_week ($endwday, $endyear, $endweek);
	
	$::se_cache{$cacheid} =
	    [
	     $startmonth + 0, $startday + 0,
	     $endyear + 0, $endweek + 0, dmwday_to_wday ($endwday),
	     $endmonth + 0, $endday + 0
	     ];
    }
    return @{$::se_cache{$cacheid}};
}

sub get_year_week_wday_by_year_week_wday_plus_days ($$$$) {
    my ($year, $week, $wday, $days) = @_;
    my ($cacheid);
    
    $cacheid = sprintf ("%04d%02d%02d%10d", $year, $week, $wday, $days);
    if (! defined $::yww_cache{$cacheid}) {
	my ($nyear, $nweek, $nwday);
	($nyear, $nweek, $nwday) =
	    &UnixDate (&DateCalc (sprintf ("%04d-W%02d-%1d", $year, $week, wday_to_dmwday ($wday)),
				  "+ $days days"),
		       $::FIRST_DAY eq 'monday' ? "%G": "%L",
		       $::FIRST_DAY eq 'monday' ? "%W" : "%U",
		       "%w");
	$::yww_cache{$cacheid} = [$nyear + 0, $nweek + 0, dmwday_to_wday ($nwday)];
    }
    return @{$::yww_cache{$cacheid}};
}

sub fit_in_week ($$$$) {
    my ($year, $week, $wday, $duration) = @_;
    my ($endyear, $endweek, $endwday);

    ($endyear, $endweek, $endwday) =
	get_year_week_wday_by_year_week_wday_plus_days
	    ($year, $week, $wday, $duration-1);
    if ($endyear != $year or $endweek != $week) {
	return 0;
    } else {
	return 1;
    }
}

sub fit_in_month ($$$$) {
    my ($year, $week, $wday, $duration) = @_;
    my ($month, $day);
    my ($endyear, $endweek, $endwday);
    my ($endmonth, $endday);

    ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
    ($endyear, $endweek, $endwday) =
	get_year_week_wday_by_year_week_wday_plus_days
	    ($year, $week, $wday, $duration-1);
    ($endmonth, $endday) = get_month_day_by_wday_year_week ($endwday, $endyear, $endweek);
    if ($endyear != $year or $endmonth != $month) {
	return 0;
    } else {
	return 1;
    }
}

sub clipboard_set ($$) {
    my ($key, $data_ref) = @_;
    $::clipboard{$key} = $data_ref;
    return;
}

sub clipboard_get ($) {
    my ($key) = @_;
    if (defined $::clipboard{$key}) {
	return $::clipboard{$key};
    } else {
	return '';
    }
}

sub format_hour ($) {
    my ($hour) = @_;

    if ($::CLOCK eq '24-hour') {
	return ($hour + 0);
    } else {
	my ($newhour);
	
	$newhour = $hour;
	$newhour = 24 if $hour == 0;
	$newhour -= 12 if $hour > 12;
	return ($newhour + 0) . ($hour < 12 ? "am" : "pm");
    }
}

sub format_hour_padded ($) {
    my ($hour) = @_;

    if ($::CLOCK eq '24-hour') {
	return sprintf ("%02d", $hour);
    } else {
	my ($newhour);
	
	$newhour = $hour;
	$newhour = 24 if $hour == 0;
	$newhour -= 12 if $hour > 12;
	return sprintf ("%02d", $newhour) . ($hour < 12 ? "am" : "pm");
    }
}

sub format_time ($$) {
    my ($hour, $min) = @_;

    if ($::CLOCK eq '24-hour') {
	return ($hour + 0) . ":" . sprintf ("%02d", $min);
    } else {
	my ($newhour);
	
	$newhour = $hour;
	$newhour = 24 if $hour == 0;
	$newhour -= 12 if $hour > 12;
	return ($newhour + 0) . ":" . sprintf ("%02d", $min) . ($hour < 12 ? "am" : "pm");
    }
}

sub format_time_padded ($$) {
    my ($hour, $min) = @_;

    if ($::CLOCK eq '24-hour') {
	return sprintf ("%02d", $hour) . ":" . sprintf ("%02d", $min);
    } else {
	my ($newhour);
	
	$newhour = $hour;
	$newhour = 24 if $hour == 0;
	$newhour -= 12 if $hour > 12;
	return sprintf ("%02d", $newhour) . ":" . sprintf ("%02d", $min) . ($hour < 12 ? "am" : "pm");
    }
}

sub format_alarm_type {
    my ($type, $single) = @_;

    if ($type == 1)
    {
	if ($single)
	{
	    return __("minute");
	}
	else
	{
	    return __("minutes");
	}
    }
    elsif ($type == 2)
    {
	if ($single)
	{
	    return __("heure");
	}
	else
	{
	    return __("heures");
	}
    }
    elsif ($type == 3)
    {
	if ($single)
	{
	    return __("jour");
	}
	else
	{
	    return __("jours");
	}
    }
    else
    {
	return "";
    }
}

sub img_alarm {
    my ($val, $type, $chk) = @_;
    if ($val)
    {
	my $img = ($chk ? "alarm2" : "alarm");
	return ' <IMG SRC="'. $::IMG_URL . '/' . $img . '.gif" ALT="'.__("Alarme")." : ".$val." ".format_alarm_type($type, ($val == 1)).'">';
    }
    else
    {
	return "";
    }
}
sub img_note {
    my ($data) = @_;
    if ($data)
    {
	$data =~ s/<BR>/ /mg;
	return ' <IMG SRC="' . $::IMG_URL . '/note.gif" ALT="'.__("Note")." : ".$data.'">';
    }
    else
    {
	return "";
    }
}

sub txt_alarm {
    my ($val, $type, $chk) = @_;
    if ($val)
    {
	my $col = ($chk ? "#00AA00" : "#FF0000");
	return '<BR><FONT COLOR="'.$col.'">'.__("Alarme")." : ".$val." ".format_alarm_type($type, ($val == 1)).'</FONT>';
    }
    else
    {
	return "";
    }
}

sub has_html ($) {
    my ($text) = @_;
    return $text =~ /[<>&]/;
}


sub newline_to_html ($) {
    my ($text) = @_;
    $text =~ s/\015\012/<BR>/sg;
    return $text;
}

sub html_to_newline ($) {
    my ($text) = @_;
    $text =~ s/<BR>/\015\012/sg;
    return $text;
}

sub events_version ($) {
    my ($events) = @_;
    my ($version);
    $version = $events->[0];
    if (ref $version) {
	$version = 1;
    }
    return $version;
}

sub convert_events_from_v1_to_v2 ($$$) {
    my ($events, $year, $week) = @_;
    my ($dayid, $eventhour, $eventid);
    for $dayid (0 .. $#$events) {
	for $eventhour (keys %{$events->[$dayid]}) {
	    for $eventid (0 .. $#{$events->[$dayid]->{$eventhour}}) {
		my (@old_event, %new_event);
		@old_event = @{$events->[$dayid]->{$eventhour}->[$eventid]};
		%new_event = (
			      'id' => $old_event[0],
			      'min' => $old_event[1],
			      'lengthmin' => $old_event[2],
			      'title' => $old_event[3],
			      'data' => $old_event[4],
			      'rt' => $old_event[5],
			      'startyear' => $year,
			      'startweek' => $week,
			      'startwday' => $dayid,
			      'duration' => 1
			      );
		$events->[$dayid]->{$eventhour}->[$eventid] = \%new_event;
	    }
	}
    }
    # insert version number into beginning of the array
    unshift (@$events, $::CURRENT_DB_VERSION);
    return;
}

sub read_events ($;$$) {
    my ($rt, $year, $week) = @_;
    my ($filename, $now);
    
    my @filenames;
    my $id;
    my ($refs, $ref, $old_slash);
    
    if ($main::DATA_ID)
    {
	if ($rt eq 'n') {
	    $filename = sprintf "$::DB_DIR/w-$main::DATA_ID-%04d%02d.db", $year, $week;
	} else {
	    $filename = "$::DB_DIR/r$rt-$main::DATA_ID.db";
	}
	if (open F, $filename) {
	    $old_slash = $/;
	    undef $/;
	    $refs = eval (<F>);
	    $/ = $old_slash;
	    close F;
	    # backwards compatibility
	    if (events_version ($refs) < 2) {
		$now = get_now ();
		convert_events_from_v1_to_v2 ($refs, $year || $now->{'year'}, $week || $now->{'week'});
	    }
	    shift @$refs;
	}
    }
    elsif ($main::DATA_IDS)
    {
	my $cl = 0;
	foreach $id (split(/\n/,$main::DATA_IDS))
	{
	    $cl++;
	    if ($rt eq 'n') {
		$filename = sprintf "$::DB_DIR/w-$id-%04d%02d.db", $year, $week;
	    } else {
		$filename = "$::DB_DIR/r$rt-$id.db";
	    }
	    if (open F, $filename) {
		$old_slash = $/;
		undef $/;
		$ref = eval (<F>);
		$/ = $old_slash;
		close F;
		# backwards compatibility
		if (events_version ($ref) < 2) {
		    $now = get_now ();
		    convert_events_from_v1_to_v2 ($ref, $year || $now->{'year'}, $week || $now->{'week'});
		}
		shift @$ref;

		# add cal index
		my $i;
		my $key;
		my $val;
		my $vl;
		for ($i=0; $i < ($rt eq 'm' ? 32 : 7); $i++)
		{
		    while (($key, $val) = each (%{@{$ref}[$i]}))
		    {
			foreach $vl (@{$val})
			{
			    %{$vl}->{cal} = $cl;
			}
		    }
		}
		
		if (!$refs)
		{
		    $refs = $ref;
		    next;
		}
		# fusion
		for ($i=0; $i < ($rt eq 'm' ? 32 : 7); $i++)
		{
		    while (($key, $val) = each (%{@{$ref}[$i]}))
		    {
			if (%{@{$refs}[$i]}->{$key})
			{
			    push @{%{@{$refs}[$i]}->{$key}}, @{$val};
			}
			else
			{
			    @{%{@{$refs}[$i]}->{$key}} =  @{$val};
			}
		    }
		}
	    }
	}
    }
    if ($refs)
    {
	return $refs;
    } elsif ($rt eq 'n' or $rt eq 'w') {
	return [ {}, {}, {}, {}, {}, {}, {} ];
    } elsif ($rt eq 'm') {
	# let's give month 32 days to make sure
	return [ {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {}, {} ]
	}
    # can't happen
}


sub write_events ($$;$$) {
    my ($weekdata, $rt, $year, $week) = @_;
    my ($filename);

    if ($rt eq 'n') {
	if (! defined $year or ! $year or ! defined $week or ! $week) {
	    return "The file type is no-repeat, but week or year not given, or zero.";
	}
	$filename = sprintf "$::DB_DIR/w-${main::DATA_ID}-%04d%02d.db", $year, $week;
	# Remove cached week file
	unlink sprintf ("$::DB_DIR/cache/w-${main::DATA_ID}-%04d%02d.html", $year, $week);
    } else {
	my (@files);
	$filename = "$::DB_DIR/r$rt-${main::DATA_ID}.db";
	# Remove all cached week files
	if (opendir (TDH, "$::DB_DIR/cache")) {
	    @files = grep { /^w-${main::DATA_ID}-\d{6}\.html$/ } readdir (TDH);
	closedir TDH;
	for (@files) {
	    unlink "$::DB_DIR/cache/$_";
	}
    }
}

# add the version identifier
unshift (@$weekdata, $::CURRENT_DB_VERSION);

if (open F, ">$filename") {
    $Data::Dumper::Terse = 1;
    flock (F, 2);
    print F Dumper ($weekdata);
    flock (F, 8);
    close F;
    return '';
} else {
    return "File $filename can't be opened for writing: $!";
}

# and remove the version identifier again
shift @$weekdata;
}

sub read_general () {
    my ($week) = @_;
    if (-f "$::DB_DIR/general.db" and ! -r "$::DB_DIR/general.db") {
	return "No write permission for file $::DB_DIR/general.db";
    }
    if (open F, "$::DB_DIR/general.db") {
	my ($ref, $old_slash);
	$old_slash = $/;
	undef $/;
	$ref = eval (<F>);
	$/ = $old_slash;
	close F;
	if ($@) {
	    return "Error in processing file $::DB_DIR/general.db: $@";
	} else {
	    return $ref;
	}
    } else {
	return { 'highid' => 56 };
    }
}

sub write_general ($) {
    my ($gendata) = @_;
    if (open F, ">$::DB_DIR/general.db") {
	$Data::Dumper::Terse = 1;
	flock (F, 2);
	print F Dumper ($gendata);
	flock (F, 8);
	close F;
	return '';
    } else {
	return "File $::DB_DIR/general.db can't be opened for writing: $!";
    }
}

# Print year, month and day in chosen date format
sub pd_year_month_day ($$$) {
    my ($year, $month, $day) = @_;
    my ($t);
    
    $t = $::DATE_FORMAT;
    if ($t == 1) {
	return "$day.$month.$year";
    } elsif ($t == 2) {
	return "$month/$day/$year";
    } elsif ($t == 3) {
	return "$day/$month/$year";
    } elsif ($t == 4) {
	return "$year/$month/$day";
    } elsif ($t == 5) {
	return "$year-$month-$day";
    } elsif ($t == 5) {
	return sprintf ("%04d%02d%02d", $year, $month, $day);
    } else {
	return "[DATE TYPE $t]";
    }
}

sub pd_month_day ($$) {
    my ($month, $day) = @_;
    my ($t);
    
    $t = $::DATE_FORMAT;
    if ($t == 1) {
	return "$day.$month";
    } elsif ($t == 2) {
	return "$month/$day";
    } elsif ($t == 3) {
	return "$day/$month";
    } elsif ($t == 4) {
	return "$month/$day";
    } elsif ($t == 5) {
	return "$month-$day";
    } elsif ($t == 6) {
	return sprintf ("%02d%02d", $month, $day);
    } else {
	return "[DATE TYPE $t]";
    }
}

sub pd_month_day_padded ($$) {
    my ($month, $day) = @_;
    my ($t);
    
    $t = $::DATE_FORMAT;
    if ($t == 1) {
	return sprintf "%02d.%02d", $day, $month;
    } elsif ($t == 2) {
	return sprintf "%02d/%02d", $month, $day;
    } elsif ($t == 3) {
	return sprintf "%02d/%02d", $day, $month;
    } elsif ($t == 4) {
	return sprintf "%02d/%02d", $month, $day;
    } elsif ($t == 5) {
	return sprintf "%02d-%02d", $month, $day;
    } elsif ($t == 6) {
	return sprintf "%02d%02d", $month, $day;
    } else {
	return "[DATE TYPE $t]";
    }
}

sub pd_single_event_date ($$$$) {
    my ($rt, $year, $week, $wday) = @_;
    my ($month, $day);
    
    ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
    if ($rt eq 'n') {
	return pd_year_month_day ($year, $month, $day);
    } elsif ($rt eq 'w') {
	return __($::weekdays[$wday]);
    } else {
	return $day . ".";
    }
}

sub pd_event_date ($$$$$) {
    my ($rt, $startyear, $startweek, $startwday, $duration) = @_;
    my ($ret);
    
    $ret = '';
    $ret .= pd_single_event_date ($rt, $startyear, $startweek, $startwday);
    if ($duration > 1) {
	($startyear, $startweek, $startwday) =
	    get_year_week_wday_by_year_week_wday_plus_days
		($startyear, $startweek, $startwday, $duration - 1);
	$ret .= " to " . pd_single_event_date ($rt, $startyear, $startweek, $startwday);
    }
    if ($rt eq 'w') {
	$ret .= " ".__("hebdomadaire");
    } elsif ($rt eq 'm') {
	$ret .= " ".__("mensuelle");
    }
    return $ret;
}

sub join_days (@) {
    my (@daylist) = @_;
    my (%sum_day, $day_ref, $hour, $event_ref);
    
    %sum_day = ();
    for $day_ref (@daylist) {
	for $hour (keys %$day_ref) {
	    for $event_ref (@{$day_ref->{$hour}}) {
		push @{$sum_day{$hour}}, $event_ref;
	    }
	}
    }
    return \%sum_day;
}

sub build_day ($$$$) {
    my ($year, $week, $wday, $day) = @_;
    my ($e_n, $e_rw, $e_rm, $sum_day_ref);

    $e_n = read_events ('n', $year, $week);
    $e_rw = read_events ('w');
    $e_rm = read_events ('m');
    
    $sum_day_ref = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
    return $sum_day_ref;
}

sub build_week ($$) {
    my ($year, $week) = @_;
    my ($e_n, $e_rw, $e_rm, @sum_week, $wday);

    $e_n = read_events ('n', $year, $week);
    $e_rw = read_events ('w');
    $e_rm = read_events ('m');

    for $wday (0 .. 6) {
	my ($month, $day);
	($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
	$sum_week[$wday] = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
    }
    return \@sum_week;
}

sub build_week_list ($$) {
    my ($start_year, $start_week) = @_;
    my ($week_filename, @weeks, @ret, %weeks);
    my ($e_n, $e_rw, $e_rm, @sum_week);
    my ($cyear, $cweek, $cdate);
    my ($end_year, $end_week, $end_date);

    $e_rw = read_events ('w');
    $e_rm = read_events ('m');

    if ($main::DATA_ID)
    {
	if (! opendir (DIR, $::DB_DIR)) {
	    return "can't open $::DB_DIR for reading: $!";
	}	
	
	# gather all week filenames, 199805, 199806, 199807 ... 199851
	@weeks = map { /^w-$main::DATA_ID-(\d{4}\d{2})\.db$/ && $1 }
	grep { /^w-$main::DATA_ID-(\d{4}\d{2})\.db$/ &&
		   $1 >= sprintf ("%04d%02d", $start_year, $start_week) }
	sort readdir(DIR);
	close DIR;
    }
    else
    {
	my $id;
	my @wks;
    	foreach $id (split(/\n/,$main::DATA_IDS))
	{
	    if (! opendir (DIR, $::DB_DIR)) {
		return "can't open $::DB_DIR for reading: $!";
	    }	
	    
	    # gather all week filenames, 199805, 199806, 199807 ... 199851
	    @wks = map { /^w-$id-(\d{4}\d{2})\.db$/ && $1 }
	    grep { /^w-$id-(\d{4}\d{2})\.db$/ &&
		       $1 >= sprintf ("%04d%02d", $start_year, $start_week) }
	    sort readdir(DIR);
	    close DIR;
	    push @weeks, @wks;
	}
    }

    # return immediately if no events
    if (scalar @weeks == 0) {
	return [];
    }
    
    # figure out the filename of the last week file
    $weeks[$#weeks] =~ /^(....)(..)$/;
    ($end_year, $end_week) = ($1, $2);
    $end_date = sprintf ("%04d%02d", $end_year, $end_week);
    
    # generate an array of filenames between first and last week filename into %weeks
    $cyear = $start_year; $cweek = $start_week;
    $cdate = sprintf "%04d%02d", $cyear, $cweek;
    do {
	$weeks{$cdate} = $weeks[0] == $cdate ? shift @weeks : 0;
	($cyear, $cweek) = get_next_year_week ($cyear, $cweek);
	$cdate = sprintf "%04d%02d", $cyear, $cweek;
    } while ($cdate le $end_date);
    
    @ret = ();
    for $week_filename (sort keys %weeks) {
	my ($year, $week, @sum_week);
	
	$week_filename =~ /^(\d\d\d\d)(\d\d)/;
	($year, $week) = ($1, $2);
	
	# if $weeks{$week_filename} has true value, then there are week
	# events for that week - only in that case we will use the repeat events
	
	if ($weeks{$week_filename}) {
	    my ($e_n, $wday);
	    
	    $e_n = read_events ('n', $year, $week);
	    # Combine week files and repeat files
	    @sum_week = ();
	    for $wday (0 .. 6) {
		my ($day, $month);
		($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
		$sum_week[$wday] = join_days ($e_n->[$wday], $e_rw->[$wday], $e_rm->[$day]);
	    }
	} else {
	    @sum_week = ( {}, {}, {}, {}, {}, {}, {} );	# ignore repeat events too
	}
	
	push @ret, [\@sum_week, $year, $week];
    }
    return \@ret;
}

sub week_cache_read ($$) {
    my ($year, $week) = @_;
    my ($filename, $data, $old_slash);
    local (*CRFH);

    if (!$main::DATA_ID)
    {
	return undef;
    }
    $filename = sprintf "$::DB_DIR/cache/w-%s-%04d%02d.html", $main::DATA_ID, $year, $week;
    if (! open (CRFH, $filename)) {
	return undef;
    }
    $old_slash = $/;
    undef $/;
    $data = <CRFH>;
    $/ = $old_slash;
    close CRFH;
    return \$data;
}

sub week_cache_write_open ($$) {
    my ($year, $week) = @_;
    my ($dirname, $filename, $cfh);
    $cfh = 'this_is_a_filehandle';
    
    $dirname = "$::DB_DIR/cache";
    if ($main::DATA_ID)
    {
	$filename = sprintf "%s/w-%s-%04d%02d.html", $dirname, $main::DATA_ID, $year, $week;
    }
    else
    {
	$filename = sprintf "%s/w-fusion-%04d%02d.html", $dirname, $year, $week;
    }
if (! -e $dirname) {
    if (! mkdir ($dirname, 0770)) {
	my $str1 = "can't create directory $dirname: $!";
	return \$str1;
    }
}
if (! open ($cfh, ">$filename")) {
    my $str2 = "can't open file $filename for writing: $!";
    return \$str2;
}
flock ($cfh, 2);
return $cfh;
}

sub header_body ($) {
    return \$::H_BODY;
}

sub week_cache_write_close ($) {
    my ($fh) = @_;
    if (fileno(F))
	{
	    flock (F, 8);
	}
    close $fh;
}

sub week_split_events_noon ($) {
    my ($events_ref) = @_;
    my ($e1, $e2, $e3, $day, $hour);

    for (@$events_ref) {
	for $day (0 .. 6) {
	    my (%hours);
	    %hours = %{$events_ref->[$day]};
	    $e1->[$day] = {}; $e2->[$day] = {}; $e3->[$day] = {};
	    if (%hours) {
		for $hour (keys %hours) {
		    if ($hour == -1) 
		    {
			$e3->[$day]->{$hour} = $events_ref->[$day]->{$hour};
		    }
		    elsif ($hour < 12) 
		    {
			$e1->[$day]->{$hour} = $events_ref->[$day]->{$hour};
		    } else 
		    {
			$e2->[$day]->{$hour} = $events_ref->[$day]->{$hour};
		    }
		}
	    }
	}
    }
    return ($e1, $e2, $e3);
}

sub week_print_events ($$$$$$) {
    my ($fh, $events_ref, $use_now_wday, $year, $week, $weekdays_ref) = @_;
    my ($day_offset, $day_ref, $hour, $event_ref);

    $day_offset = 0;
    for $day_ref (@$events_ref) {
	if (%$day_ref) {
	    print $fh "<TD BGCOLOR=\"$::TDCOLOR\" VALIGN=top>\n";
	    print $fh "<table width=100% cellpadding=0 cellspacing=0 border=0>\n";
	    for $hour (sort { $a <=> $b } keys %$day_ref) {
		for $event_ref (@{$day_ref->{$hour}}) {
		    print $fh '<tr><td bgcolor="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'">';
		    my ($id, $min, $title, $data, $lengthmin, $rt, $color, $color_end);
		    my ($startyear, $startweek, $startwday, $duration);
		    my ($alval, $altype, $alchk, $strike);

		    $id = $event_ref->{'id'};
		    $min = $event_ref->{'min'};
		    $lengthmin = $event_ref->{'lengthmin'};
		    $title = $event_ref->{'title'};
		    $data = $event_ref->{'data'};
		    $rt = $event_ref->{'rt'};
		    $startyear = $event_ref->{'startyear'};
		    $startweek = $event_ref->{'startweek'};
		    $startwday = $event_ref->{'startwday'};
		    $duration = $event_ref->{'duration'};
		    $alval = $event_ref->{'alval'} || 0;
		    $altype = $event_ref->{'altype'} || 0;
		    $alchk = $event_ref->{'alchk'} || "";
		    $strike = $event_ref->{'strike'} || 0;

		    if ($rt eq 'w') {
			$color = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\" SIZE=2>";
		    } elsif ($rt eq 'm') {
			$color = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\" SIZE=2>";
		    } else {
			$color = '<FONT SIZE=2>';
		    }
		    $color_end = "</FONT>";
		    my $st = strcal();
		    print $fh "<A TARGET=fevent HREF=\"$::MY_URL_XUSER/?t=event$st",
		    "&id=", $id,
		    "&year=", $year, "&week=", $week, "&wday=", $day_offset,
		    "&hour=", $hour,
		    "&min=", $min,
		    "&lengthmin=", $lengthmin,
		    "&title=", url_encode ($title),
		    "&data=", url_encode ($data),
		    "&rt=", $rt,
		    "&startyear=", $startyear,
		    "&startweek=", $startweek,
		    "&startwday=", $startwday,
		    "&duration=", $duration,
		    "&alval=", $alval,
		    "&altype=", $altype,
		    "&alchk=", $alchk,
		    "&strike=", $strike,
		    "\">$color",
		    $strike ? "<strike><i>" : "",
		    $hour == -1 ? "" : ("<b>",format_time ($hour, $min)," - ",format_time (int ($hour + ($min + $lengthmin)/60) % 24, ($min + $lengthmin) % 60),"</b> "),
		    $title,
		    $strike ? "</i></strike>" : "",
		    $color_end, "</A>",
		    img_note($data),
		    img_alarm($alval, $altype, $alchk),
		    "</td></tr>\n";
		}
	    }
	    print $fh "</table>\n";
	} else {
	    print $fh "<TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=2>&nbsp;</FONT>\n";
		}
		$day_offset++;
	}
	return;
}

# CGI input: year, week OR nothing, in which case current date is used
sub show_week (;$) {
    my ($cacheonly) = @_;
    my ($week, $month, $day, $year, $first_day);
    my ($weekdata, $i, @weekdays, $cached_week_ref, $cache_fh);
    my ($now_date, $now_year, $now_week, $now_wday, $use_now_wday);
    my ($events1, $events2, $events3, $wday_name, $now_ref);

    $year = $::query->{'year'};
    $week = $::query->{'week'};
    if (! defined $year or ! defined $week) {
	my ($ref);
	$ref = get_now ();
	($year,  $week) = ($ref->{'year'}, $ref->{'week'});
    }

    # If the week is in cache, return it
  sw_check_cache:
    $cached_week_ref = week_cache_read ($year, $week);
    if (defined $cached_week_ref) {
	$$cached_week_ref =~ s/X_USER_X/$main::USER/g;
	print Socket $$cached_week_ref;
	return;
    }
    
    # Find the current day to mark it in the output
    $now_ref = get_now ();
    ($now_year, $now_week, $now_wday) = ($now_ref->{'year'}, $now_ref->{'week'}, $now_ref->{'wday'});

    if ($year == $now_year and $week == $now_week) {
	$use_now_wday = $now_wday + 0;
    } else {
	$use_now_wday = -1;
    }
    
    if (defined $main::DATA_ID && $main::DATA_ID)
    {
	# Start writing the week into cache
	$cache_fh = week_cache_write_open ($year, $week);
	if (ref $cache_fh) {
	    print Socket "<BODY>Internal error: $$cache_fh</BODY>\n";
	    return;
	}
    }
    else # fusion
    {
	$cache_fh = "Socket";
    }
    
    # Build year/month/day information of the required week
    ($month, $day) = get_month_day_by_firstday_year_week ($year, $week);
    $weekdays[0] = [$month, $day];
    for $i (1..6) {
	my ($month, $day);
	($month, $day) = get_month_day_by_wday_year_week ($i, $year, $week);
	$weekdays[$i] = [$month, $day];
    }

    my $st = strcal();
    print $cache_fh "<HEAD><META HTTP-EQUIV=refresh CONTENT=\"$::REFRESH_DELAY; url=$::MY_URL_XUSER/?t=week&year=$year&week=$week$st\"></HEAD>\n";
    print $cache_fh $::H_BODY;
    
    # Determine previous and next year & week
    my ($prev_week, $next_week, $prev_year, $next_year);
    $prev_week = $week - 1; $next_week = $week + 1;
    $prev_year = $next_year = $year;
    if ($prev_week < 2) {
	($prev_year, $prev_week )= get_prev_year_week ($year, $week);
    } elsif ($next_week > 50) {
	($next_year, $next_week )= get_next_year_week ($year, $week);
    }
    
    # cal links for fusion
    my $stl = lncal($year, $week);

    # Output title line
    print $cache_fh "<TABLE COLS=4 BORDER=0 WIDTH=\"100%\" ALIGN=center>\n";
    print $cache_fh "<TR><TH ALIGN=center><FONT SIZE=6><B>$stl</B></FONT></TH>\n";
    print $cache_fh "<TH COLSPAN=2 ALIGN=center><A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$prev_year&week=$prev_week$st\"><IMG ALT=\"".__("Semaine précédente")."\" SRC=\"$::IMG_URL/left-arrow.gif\" ALIGN=middle BORDER=0></A>\n";
    print $cache_fh " <A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$now_year&week=$now_week$st\"><FONT SIZE=4><B>",sprintf(__("%s Semaine %s Année %s"),__($::months[$month]),$week,$year),"</B></FONT></A> \n";
    print $cache_fh "<A TARGET=fweek HREF=\"$::MY_URL_XUSER/?t=week&year=$next_year&week=$next_week$st\"><IMG ALT=\"".__("Semaine suivante")."\" SRC=\"$::IMG_URL/right-arrow.gif\" ALIGN=middle BORDER=0></A></TH>\n";
    print $cache_fh "<TH ALIGN=center><A TARGET=fevent HREF=\"$::MY_URL_XUSER/?t=views&year=$year&week=$week$st\">".__("Autres vues")."</A></TH>\n";
    print $cache_fh "</TR></TABLE>\n\n";
    
    print $cache_fh "<TABLE COLS=7 BORDER=1 WIDTH=\"100%\">\n";
    print $cache_fh "<TR>\n";
    
    # Print weekday names
    $i = 0;
    for $wday_name (@main::weekdays_short) {
	my ($color);
	if ($i == $use_now_wday) {
	    $color = $::NOW_THCOLOR;
	} else {
	    $color = $::THCOLOR;
	}
	if ($i <= 4) {
	    print $cache_fh "<TH BGCOLOR=\"$color\">";
	} else {
	    print $cache_fh "<TH BGCOLOR=\"$color\">";
	}
	my $st = strcal();
	print $cache_fh "<A TARGET=fday HREF=\"$::MY_URL_XUSER/?t=day&year=", $year, "&week=", $week, "&wday=", $i, "$st\">", pd_month_day ($weekdays[$i]->[0], $weekdays[$i]->[1]), " ", __($wday_name), "</A>\n";
	$i++;
    }
    
    $weekdata = build_week ($year, $week);
    ($events1, $events2, $events3) = week_split_events_noon ($weekdata);
    
    print $cache_fh "<TR>\n";
    week_print_events ($cache_fh, $events1, $use_now_wday, $year, $week, \@weekdays);
    print $cache_fh "<TR>\n";
    week_print_events ($cache_fh, $events2, $use_now_wday, $year, $week, \@weekdays);
    print $cache_fh "<TR>\n";
    week_print_events ($cache_fh, $events3, $use_now_wday, $year, $week, \@weekdays);
    
    print $cache_fh "</TABLE>\n</CENTER>\n</BODY>";
        
    if (defined $main::DATA_ID && $main::DATA_ID)
    {
	# Now the cache should exist, so retry (someone may have removed it meanwhile, but then we just retry)
	week_cache_write_close ($cache_fh);
	goto sw_check_cache;
    }
}

sub show_day () {
    my ($day, $month, $week, $year, $wday, $wday_name, $eventsdata, @hours, @thours, $day_ref, $rt);
    my ($now_ref, $now_thcolor, $is_now_day, $hour, $event_ref);

    # see if we are given the day or not - if year exists, assume yes
    $year = $::query->{'year'};
    if (! defined $year) {
	my ($now_ref);
	$now_ref = get_now ();
	($year, $month, $day, $week, $wday) =
	    ($now_ref->{'year'}, $now_ref->{'month'}, $now_ref->{'day'}, $now_ref->{'week'}, $now_ref->{'wday'});
    } else {
	$week = $::query->{'week'};
	$wday = $::query->{'wday'};
    }
    $wday_name = $::weekdays[$wday];

    ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);

    $day_ref = build_day ($year, $week, $wday, $day);
    
    # Build list of events on each hour
    @hours = ();
    for $hour (sort { $a <=> $b } keys %$day_ref) {
	if ($hour == -1)
	{
	    for $event_ref (@{$day_ref->{$hour}}) {
		push @{$hours[24]}, $event_ref;
	    }
	}
	else
	{
	    for $event_ref (@{$day_ref->{$hour}}) {
		push @{$hours[$hour]}, $event_ref;
	    }
	}
    }

    # Count how many events will be on each row
    my ($max_c, $cols, @rows);
    $max_c = 0;
    @rows = (0) x ($::LAST_HOUR + 1);
    for $hour ($::FIRST_HOUR .. $::LAST_HOUR) {
	if ($hours[$hour]) {
	    for $event_ref (@{$hours[$hour]}) {
		my ($lengthmin, $min, $end_hour, $h);
		$lengthmin = $event_ref->{'lengthmin'};
		$min = $event_ref->{'min'};
		$end_hour = $hour + int (($lengthmin + $min - 1) / 60) % 24;
		for $h ($hour .. $end_hour) {
		    my ($c);
		    $c = ++$rows[$h];
		    if ($c > $max_c) {
			$max_c = $c;
		    }
		}
	    }
	}
    }
    $max_c = 1 if $max_c == 0;
    $cols = $max_c + 1;

    $now_ref = get_now ();
    if ($now_ref->{'year'} == $year and $now_ref->{'month'} == $month and $now_ref->{'day'} == $day) {
	$is_now_day = 1;
    } else {
	$is_now_day = 0;
    }
    if ($is_now_day) {
	$now_thcolor = $::NOW_THCOLOR;
    } else {
	$now_thcolor = $::THCOLOR;
    }

    my $st = strcal();
    print Socket "<HEAD><META HTTP-EQUIV=refresh CONTENT=\"$::REFRESH_DELAY; url=$::MY_URL/?t=day&year=$year&week=$week&wday=$wday$st\"></HEAD>\n";
    print Socket "<BASE TARGET=fevent>\n";
    print Socket $::H_BODY;
    print Socket "<TABLE BORDER=2 CELLSPACING=0 WIDTH=\"90%\">\n";
    print Socket "<TR><TH WIDTH=10><TH COLSPAN=$max_c WIDTH=\"100%\" BGCOLOR=\"$::THCOLOR\">\n";
    print Socket "<TR><TD COLSPAN=$cols BGCOLOR=\"$now_thcolor\" ALIGN=center><B>", pd_year_month_day ($year, $month, $day), " ", __("$wday_name")."</B>\n";
    if (defined $::READ_ONLY and $::READ_ONLY ne 'true' and clipboard_get ($::REMOTE_USER)) {
	print Socket "&nbsp;&nbsp;<A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=paste_event&year=$year&week=$week&wday=$wday$st\">[".__("Coller")."]</A>\n";
    }
    print Socket "</TD>\n";

    print Socket "<TR><TD BGCOLOR=\"$::THCOLOR\">\n";
    if ($::READ_ONLY ne 'true') {
	print Socket "<A HREF=\"$::MY_URL/?t=add_edit$st",
	"&year=", $year, "&week=", $week, "&wday=", $wday, "&hour=-1\">";
	print Socket "&gt;</A>\n";
    }
    else
    {
	print Socket "&gt;\n";
    }
    print Socket "</TD><TD BGCOLOR=\"$::BG_TDCOLOR\"";
    if ($max_c > 1)
    {
	print Socket "COLSPAN=\"$max_c\"";
    }
    print Socket "><table width=100% cellpadding=0 cellspacing=0 border=0>\n";
    my $isev = 0;
    my $sthour;
    my $sttime;
    for $hour (0 .. $::FIRST_HOUR-1, $::LAST_HOUR+1 .. 25)
    {
	if ($hours[$hour]) 
	{
	    $isev = 1;
	    my (@events, $event_ref);
	    @events = @{$hours[$hour]};
	    for $event_ref (@events) {
		my ($id, $min, $title, $data, $lengthmin, $rcolor, $rcolor_end);
		my ($startyear, $startweek, $startwday, $duration);
		my ($alval, $altype, $alchk, $strike);
		$id = $event_ref->{'id'};
		$min = $event_ref->{'min'};
		$lengthmin = $event_ref->{'lengthmin'};
		$title = $event_ref->{'title'};
		$data = $event_ref->{'data'};
		$rt = $event_ref->{'rt'};
		$startyear = $event_ref->{'startyear'};
		$startweek = $event_ref->{'startweek'};
		$startwday = $event_ref->{'startwday'};
		$duration = $event_ref->{'duration'};
		$alval = $event_ref->{'alval'} || 0;
		$altype = $event_ref->{'altype'} || 0;
		$alchk = $event_ref->{'alchk'} || "";
		$strike = $event_ref->{'strike'} || 0;

		if ($rt eq 'w') {
		    $rcolor = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\">";
		    $rcolor_end = "</FONT>";
		} elsif ($rt eq 'm') {
		    $rcolor = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\">";
		    $rcolor_end = "</FONT>";
		} else {
		    $rcolor = $rcolor_end = '';
		}

		if ($hour == 24)
		{
		    $sthour = -1;
		    $sttime = "";
		}
		else
		{
		    $sthour = $hour;
		    $sttime  = "<b>".format_time($hour, $min)." - ".format_time(int($hour + ($min + $lengthmin)/60) % 24, ($min + $lengthmin) % 60)."</b> ";
		}

		print Socket '<TR><TD BGCOLOR="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'" ROWSPAN=', int (($lengthmin + $min + 59) / 60) % 24, "><FONT SIZE=2>",
		"<P><A HREF=\"$::MY_URL/?t=event&id=", $id,
		"&year=", $year, "&week=", $week, "&wday=", $wday,
		"&hour=", $sthour, "&min=", $min,
		"&lengthmin=", $lengthmin,
		"&title=", url_encode ($title),
		"&data=", url_encode ($data),
		"&rt=", $rt,
		"&startyear=", $startyear,
		"&startweek=", $startweek,
		"&startwday=", $startwday,
		"&duration=", $duration,
		"&alval=", $alval,
		"&altype=", $altype,
		"&alchk=", $alchk,
		"&strike=", $strike,
		"$st\">", $rcolor, 
		$strike ? "<strike><i>" : "",
		$sttime, $title, 
		$strike ? "</i></strike>" : "",
		$rcolor_end, "</A>",
		img_note($data), img_alarm($alval, $altype, $alchk), "</TD></TR>\n";
	    }
	}
    }
    print Socket "</table>";
    if (!$isev)
    {
	print Socket "&nbsp;\n";
    }
    print Socket "</TD></TR>\n";
    
    for $hour ($::FIRST_HOUR .. $::LAST_HOUR) {

	#
	# Print hour
	#
	print Socket "<TR><TD  BGCOLOR=\"$::THCOLOR\"><FONT SIZE=2>";
	if ($::READ_ONLY ne 'true') {
	    print Socket "<A HREF=\"$::MY_URL/?t=add_edit$st",
	    "&year=", $year, "&week=", $week, "&wday=", $wday, "&hour=", $hour, "\">";
	}
	print Socket format_hour_padded ($hour);
	if ($::READ_ONLY ne 'true') {
	    print Socket "</A>\n";
	}

	#
	# Print events for this hour
	#
	if ($hours[$hour]) {
	    my (@events, $event_ref);
	    @events = @{$hours[$hour]};
	    for $event_ref (@events) {
		my ($id, $min, $title, $data, $lengthmin, $rcolor, $rcolor_end);
		my ($startyear, $startweek, $startwday, $duration);
		my ($alval, $altype, $alchk, $strike);
		$id = $event_ref->{'id'};
		$min = $event_ref->{'min'};
		$lengthmin = $event_ref->{'lengthmin'};
		$title = $event_ref->{'title'};
		$data = $event_ref->{'data'};
		$rt = $event_ref->{'rt'};
		$startyear = $event_ref->{'startyear'};
		$startweek = $event_ref->{'startweek'};
		$startwday = $event_ref->{'startwday'};
		$duration = $event_ref->{'duration'};
		$alval = $event_ref->{'alval'} || 0;
		$altype = $event_ref->{'altype'} || 0;
		$alchk = $event_ref->{'alchk'} || "";
		$strike = $event_ref->{'strike'} || 0;

		if ($rt eq 'w') {
		    $rcolor = "<FONT COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\">";
		    $rcolor_end = "</FONT>";
		} elsif ($rt eq 'm') {
		    $rcolor = "<FONT COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\">";
		    $rcolor_end = "</FONT>";
		} else {
		    $rcolor = $rcolor_end = '';
		}
		print Socket '<TD BGCOLOR="'.$::EVENT_COLS[$event_ref->{'cal'} || 0].'" ROWSPAN=', int (($lengthmin + $min + 59) / 60) % 24, "><FONT SIZE=2>",
		"<P><A HREF=\"$::MY_URL/?t=event&id=", $id,
		"&year=", $year, "&week=", $week, "&wday=", $wday,
		"&hour=", $hour, "&min=", $min,
		"&lengthmin=", $lengthmin,
		"&title=", url_encode ($title),
		"&data=", url_encode ($data),
		"&rt=", $rt,
		"&startyear=", $startyear,
		"&startweek=", $startweek,
		"&startwday=", $startwday,
		"&duration=", $duration,
		"&alval=", $alval,
		"&altype=", $altype,
		"&alchk=", $alchk,
		"&strike=", $strike,
		"$st\">", $rcolor, 
		$strike ? "<strike><i>" : "",
		$title, 
		$strike ? "</i></strike>" : "",
		$rcolor_end, "</A>",
		img_note($data), img_alarm($alval, $altype, $alchk), "\n";
	    }
	}
	print Socket "<TD BGCOLOR=\"$::BG_TDCOLOR\">&nbsp;" x ($max_c - $rows[$hour]), "\n";
    }
sd_end:
    print Socket "</TABLE></CENTER>\n</BODY>\n";
}

sub show_event () {
    my ($year, $month, $day, $week, $wday, $wday_name, $weekdata, @hours, $day_ref, $rt);
    my ($hour, $min, $lengthmin, $title, $data, $endhour, $endmin, $id, $is_now, $now_thcolor, $rcolor);
    my ($startyear, $startweek, $startwday, $duration);
    my ($alval, $altype, $alchk, $strike);

    $id = $::query->{'id'};
    $year = $::query->{'year'};
    $week = $::query->{'week'};
    $wday = $::query->{'wday'} || 0;
    $wday_name = $::weekdays[$wday];
    $hour = $::query->{'hour'} || 0;
    $min = $::query->{'min'} || 0;
    $lengthmin = $::query->{'lengthmin'} || 0;
    $title = $::query->{'title'};
    $data = $::query->{'data'};
    $rt = $::query->{'rt'};
    $is_now = $::query->{'is_now'};
    $startyear = $::query->{'startyear'};
    $startweek = $::query->{'startweek'};
    $startwday = $::query->{'startwday'};
    $duration = $::query->{'duration'};
    $alval = $::query->{'alval'} || 0;
    $altype = $::query->{'altype'} || 0;
    $alchk = $::query->{'alchk'} || "";
    $strike = $::query->{'strike'} || 0;

    if (! defined $year or ! defined $title) {
	my ($n);
	$n = get_now ();
        show_other_views ($n->{'year'}, $n->{'week'});
	return;
    }

    ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);

    $endhour = int ($hour + ($min + $lengthmin) / 60) % 24;
    $endmin = int (($min + $lengthmin) % 60);

    print Socket $::H_BODY;

    if ($is_now) {
	$now_thcolor = $::NOW_THCOLOR;
    } else {
	$now_thcolor = $::THCOLOR;
    }
    if ($rt eq 'w') {
	$rcolor = "COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\"";
    } elsif ($rt eq 'm') {
	$rcolor = "COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\"";
    } else {
	$rcolor = '';
    }

    print Socket "<CENTER>\n<TABLE BORDER=1 COLS=1 CELLPADDING=10 ALIGN=center VALIGN=middle WIDTH=\"80%\" BGCOLOR=\"$::TDCOLOR\">\n";
    print Socket "<TR><TH ALIGN=center BGCOLOR=\"$now_thcolor\">".__("Tâche le")." ", pd_event_date ($rt, $startyear, $startweek, $startwday, $duration);
    print Socket "\n<TR><TD BGCOLOR=\"$::TDCOLOR\" ALIGN=left>\n";
    my ($stk1, $stk2) = $strike ? ("<strike><i>","</i></strike>") : ("","");
    if ($hour == -1)
    {
	printf Socket "<P><CENTER><FONT SIZE=\"4\" $rcolor><B>$stk1$title$stk2";
    }
    else
    {
	printf Socket "<P><CENTER><FONT SIZE=\"4\" $rcolor><B>$stk1%s - %s $title$stk2", format_time ($hour, $min), format_time ($endhour, $endmin);
    }
    print Socket (($rt eq 'w') ? ' ('.__("hebdomadaire").')' : ( ( $rt eq 'm' ) ? ' ('.__("mensuelle").')' : '' ));
    print Socket "</B></FONT>", txt_alarm($alval, $altype, $alchk), "</CENTER>\n";
    print Socket "<P>$data\n";
    print Socket "</TABLE>\n";
    my $st = strcal();
    
    if ($::READ_ONLY ne 'true') {
	my ($enc_title, $enc_data);
	$enc_title = url_encode ($title);
	$enc_data = url_encode ($data);
	my $stk3 = $strike ? __("Activer") : __("Désactiver");
	print Socket "<A HREF=\"$::MY_URL/?t=add_edit&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=$enc_title&data=$enc_data&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
	"[".__("Editer")."]</A>\n";
	print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_remove_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
	"[".__("Couper")."]</A>\n";
	print Socket "&nbsp;&nbsp;&nbsp;<A HREF=\"$::MY_URL/?t=copy_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=$enc_title&data=$enc_data&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
	"[".__("Copier")."]</A>\n";
	print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_delete_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
	"[".__("Supprimer")."]</A>\n";
	print Socket "&nbsp;&nbsp;&nbsp;<A TARGET=\"_top\" HREF=\"$::MY_URL/?t=redraw&view=after_strike_event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&title=$enc_title&data=$enc_data&rt=$rt&min=$min&lengthmin=$lengthmin&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike$st\">",
	"[$stk3]</A>\n";
    }
    print Socket "</CENTER></BODY>\n";
}

sub add_edit_event_ask () {
    my ($id, $year, $month, $day, $week, $wday, $wday_name, $weekdata, @hours, $day_ref);
    my ($hour, $min, $lengthmin, $title, $data, $endhour, $endmin, $rt, $duration);
    my ($startyear, $startweek, $startwday, $startmonth, $startday);
    my ($endyear, $endweek, $endwday, $endmonth, $endday);
    
    $id = $::query->{'id'} || '';
    $year = $::query->{'year'};
    $week = $::query->{'week'};
    $wday = $::query->{'wday'};
    $wday_name = $::weekdays[$wday];
    $hour = $::query->{'hour'};
    $min = $::query->{'min'} || 0;
    $lengthmin = $::query->{'lengthmin'};
    $rt = $::query->{'rt'} || 'n';
    $title = $::query->{'title'} || '';
    $data = $::query->{'data'} || '';
    $startyear = $::query->{'startyear'} || $year;
    $startweek = $::query->{'startweek'} || $week;
    $startwday = defined $::query->{'startwday'} ? $::query->{'startwday'} : $wday;
    $duration = $::query->{'duration'} || 1;
    my $strike = $::query->{'strike'} || 0;

    ($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);


    if ($id) {
	if ($hour == -1)
	{
	    $endhour = -1;
	    $endmin = -1;
	}
	else
	{
	    $endhour = int ($hour + ($min + $lengthmin) / 60) % 24;
	    $endmin = int (($min + $lengthmin) % 60);
	}
    } else {
	$endhour = $hour+1;
	$endmin = 0;
    }

    ($startmonth, $startday, $endyear, $endweek, $endwday, $endmonth, $endday) =
	get_start_end_by_year_week_wday_duration ($startyear, $startweek, $startwday, $duration);

    print Socket $::H_BODY;
    print Socket "<CENTER>\n";
    print Socket "<TABLE BORDER=1 COLS=1 CELLPADDING=3 ALIGN=center WIDTH=\"100%\" BGCOLOR=\"$::TDCOLOR\">\n";
    print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>";
    if ($id) {
	print Socket __("Editer tâche");
    } else {
	print Socket __("Ajouter tâche");
    }
    print Socket " ".pd_event_date ($rt, $startyear, $startweek, $startwday, $duration);
    print Socket "</B></TH></TR>\n";
    print Socket "<TR><TD BGCOLOR=\"$::TDCOLOR\">\n";

    print Socket "<CENTER><TABLE BORDER=0 BGCOLOR=\"$::TDCOLOR\" CELLSPACING=0 CELLPADDING=0>\n\n";

    print Socket "<FORM TARGET=_top ACTION=\"$::MY_URL\" METHOD=GET>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=oldrt VALUE=$rt>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=oldhour VALUE=$hour>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=oldduration VALUE=$duration>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=year VALUE=$year>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=week VALUE=$week>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=wday VALUE=$wday>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=startyear VALUE=$startyear>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=startweek VALUE=$startweek>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=startwday VALUE=$startwday>\n";

    print Socket "<INPUT TYPE=HIDDEN NAME=t VALUE=redraw>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=view VALUE=add_event>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=id VALUE=$id>\n";
    print Socket "<INPUT TYPE=HIDDEN NAME=strike VALUE=$strike>\n";

    # Event time
    print Socket "<TR><TD ALIGN=left>\n";
    print Socket __("Heure début")."</TD><TD><SELECT NAME=hour1>\n";
    print Socket "<OPTION VALUE=-1 ", ($hour == -1 ? 'SELECTED' : ''), ">\n";
    for (0 .. 23) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $hour) ? 'SELECTED' : ''), ">", format_hour_padded ($_), "\n";
    }
    print Socket "</SELECT>\n";
    print Socket "<SELECT NAME=min1>\n";
    print Socket "<OPTION VALUE=-1 ", ($min == -1 ? 'SELECTED' : ''), ">\n";
    for (qw (00 15 30 45)) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $min) ? 'SELECTED' : ''), ">$_\n";
    }
    print Socket "</SELECT>\n";
    print Socket " - \n";
    print Socket "<SELECT NAME=hour2>\n";
    print Socket "<OPTION VALUE=-1 ", ($endhour == -1 ? 'SELECTED' : ''), ">\n";
    for (0 .. 23) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $endhour) ? 'SELECTED' : ''), ">", format_hour_padded ($_), "\n";
    }
    print Socket "</SELECT>\n";
    print Socket "<SELECT NAME=min2>\n";
    print Socket "<OPTION VALUE=-1 ", ($endmin == -1 ? 'SELECTED' : ''), ">\n";
    for (qw (00 15 30 45)) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $endmin) ? 'SELECTED' : ''), ">$_\n";
    }
    print Socket "</SELECT>\n</TD></TR>\n";

    # Duration (days)
    print Socket "<TR><TD>".__("Durée")."</TD><TD><SELECT NAME=duration>\n";
    for (1 .. $::MAX_DURATION) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $duration) ? 'SELECTED' : ''), ">$_ ", ($_ == 1 ? __("jour") : __("jours")), "\n";
    }
    print Socket "</SELECT>\n";

    # Repeat
    my ($sn, $sw, $sm);
    $sn = $sw = $sm = '';
    if ($rt eq 'n') {
	$sn = 'SELECTED';
    } elsif ($rt eq 'w') {
	$sw = 'SELECTED';
    } elsif ($rt eq 'm') {
	$sm = 'SELECTED';
    }
    print Socket "<SELECT NAME=rt>";
    print Socket "<OPTION VALUE=n $sn>".__("Sans répétition");
    print Socket "<OPTION VALUE=w $sw>".__("Répéter toutes les semaines");
    print Socket "<OPTION VALUE=m $sm>".__("Répéter tous les mois");
    print Socket "</SELECT>\n</TD></TR>\n";
    
    # Alarm
    print Socket "<TR><TD ALIGN=left>".__("Alarme")."</TD>";
    my $alval = $::query->{'alval'} || 0;
    print Socket "<TD><SELECT NAME=alval>\n";
    for (0 .. 23) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $alval) ? 'SELECTED' : ''), ">", ($_) ? $_ : '' ,"\n";
    }
    print Socket "</SELECT>\n";
    my $altype = $::query->{'altype'} || 0;
    print Socket "<SELECT NAME=altype>\n";
    for (0 .. 3) {
	print Socket "<OPTION VALUE=$_ ", (($_ == $altype) ? 'SELECTED' : ''), ">".format_alarm_type($_)."\n";
    }
    my $alchk = $::query->{'alchk'} || "";
    print Socket "</SELECT>\n";
    print Socket '<INPUT TYPE="checkbox" NAME="alchk" VALUE="'.$alchk.'"';
    if ($alchk)
    {
	print Socket ' CHECKED';
    }
    print Socket "> ".__("lancée");
    print Socket "</TD>\n";

    # Title
    print Socket "<TR><TD ALIGN=left>".__("Titre")."</TD><TD>";
    print Socket "<INPUT SIZE=51 NAME=title VALUE=\"", html_to_newline ($title), "\"></TD></TR>";

    # Data
    print Socket "<TR><TD ALIGN=left COLSPAN=2><TEXTAREA ROWS=", ($::SCREEN_RESOLUTION eq '800x600' ? 2 : 4) ," COLS=58 NAME=\"data\">", html_to_newline ($data), "</TEXTAREA></TD></TR>";
    print Socket "</TABLE>\n";

    # Submit
    my ($submit_value);
    $submit_value = ($id ? __("Valider") : __("Ajouter"));
    print Socket "<INPUT TYPE=submit VALUE=\"$submit_value\">\n";
    print Socket "</FORM></CENTER>\n";

    print Socket "</TABLE>\n";

    print Socket "</FORM></CENTER>\n";
    print Socket "</BODY>\n";
    
}

sub print_event_error_start () {
    print Socket $::H_BODY;
    print Socket "<DIV ALIGN=center VALIGN=middle>\n";
    print Socket "<TABLE BORDER=1 CELLPADDING=10 ALIGN=center VALIGN=middle BGCOLOR=\"$::TDCOLOR\" WIDTH=\"80%\">\n<TR><TD><BR><BR>\n\n";
}

sub print_event_error_end () {
    print Socket "<BR><BR></TABLE>\n</BODY>\n";
}

sub day_index ($$$$) {
    my ($rt, $year, $week, $wday) = @_;
    my ($index);
    
    # Index by day or wday, depending on repeat type
    if ($rt eq 'n' or $rt eq 'w') {
	$index = $wday + 0;
    } else {
	my ($month, $day);
	($month, $day) = get_month_day_by_wday_year_week ($wday, $year, $week);
	$index = $day + 0;
    }

    return $index;
}

# Read, update, and write new highest event id into general database
# Return the (id, possible error or false)
sub next_id () {
    my ($id, $gendata, $err);

    $gendata = read_general ();
    if (! ref $gendata eq 'HASH') {
	$err = $gendata;
	return ('', $err);
    }

    $id = $gendata->{'highid'} + 1;
    $gendata->{'highid'} = $id;

    $err = write_general ($gendata);
    if ($err) {
	return ('', $err);
    }
    return ($id, '');
}

sub remove_events ($$$$$$$) {
    my ($rt, $year, $week, $wday, $duration, $hour, $id) = @_;
    my ($i);

    for $i (0 .. $duration - 1) {
	my ($cyear, $cweek, $cwday, $index_day, $hour_ref, $eventsdata, @hour, $err);

	($cyear, $cweek, $cwday) = get_year_week_wday_by_year_week_wday_plus_days ($year, $week, $wday, $i);

	$index_day = day_index ($rt, $cyear, $cweek, $cwday);

	
	$eventsdata = read_events ($rt, $cyear, $cweek);
	$hour_ref = $eventsdata->[$index_day]->{$hour};
	if (ref $hour_ref eq 'ARRAY') {
	    my ($i);
	    @hour = @$hour_ref;
	    for $i (0 .. $#hour) {
		if ($hour[$i]->{'id'} == $id) {
		    splice (@hour, $i, 1);
		    goto re_found;
		}
	    }
	}
	return "internal error: the event isn't in the database (user ${main::DATA_ID}, year $cyear, week $cweek, wday $cwday, id $id, rt $rt)";
	
re_found:
	if (@hour) {
	    $eventsdata->[$index_day]->{$hour+0} = \@hour;
	} else {
	    # no events left for this hour, so remove whole hour
	    delete $eventsdata->[$index_day]->{$hour};
	}
	$err = write_events ($eventsdata, $rt, $cyear, $cweek);
	if ($err) {
	    return  $err;
	}
    }
    return '';
}

sub add_events  {
    my ($rt, $year, $week, $wday, $duration, $hour, $id, $min, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike) = @_;
    my ($i, $err);

    if (!$alval)
    {
	$alval = 0;
    }
    if (!$altype)
    {
	$altype = 0;
    }
    if (!$alchk)
    {
	$alchk = "";
    }
    if (!$strike)
    {
	$strike = 0;
    }
    # Figure out the new $id
    if (! $id) {
	my ($gendata);

	# Read, update, and write new highest event id into general database
	$gendata = read_general ();
	if (! ref $gendata eq 'HASH') {
	    $err = $gendata;
	    return $err;
	}
	$id = $gendata->{'highid'} + 1;
	$gendata->{'highid'} = $id;
	$err = write_general ($gendata);
	if ($err) {
	    return $err;
	}
    }

    
    for $i (0 .. $duration - 1) {
	my ($cyear, $cweek, $cwday, $index_day, $eventsdata);


	($cyear, $cweek, $cwday) = get_year_week_wday_by_year_week_wday_plus_days ($year, $week, $wday, $i);


	$index_day = day_index ($rt, $cyear, $cweek, $cwday);

	# Read events, add, write back
	$eventsdata = read_events ($rt, $cyear, $cweek);
	push @{$eventsdata->[$index_day]->{$hour+0}},
	{
	    'id' => $id + 0,
	    'min' => $min + 0,
	    'lengthmin' => $lengthmin + 0,
	    'title' => $title,
	    'data' => $data,
	    'rt' => $rt,
	    'startyear' => $year + 0,
	    'startweek' => $week + 0,
	    'startwday' => $wday + 0,
	    'duration' => $duration + 0,
	    'alval' => $alval + 0,
	    'altype' => $altype + 0,
	    'alchk' => $alchk,
	    'strike' => $strike,
	};
	
	$err = write_events ($eventsdata, $rt, $cyear, $cweek);
	if ($err) {
	    return $err;
	}
	
    }
    return '';
}

sub add_event_commit () {
    my ($id, $year, $month, $day, $week, $wday, $wday_name, $rt);
    my ($hour1, $min1, $hour2, $min2, $lengthmin, $title, $data, $endhour, $endmin);
    my ($err, $i);
    my ($oldrt, $oldhour);
    my ($oldhour_ref, @hour, $oldduration, $duration);
    my ($startyear, $startweek, $startwday, $startmonth, $startday);
    my ($alval, $altype, $alchk, $strike);

    $oldrt = $::query->{'oldrt'};
    $oldhour = $::query->{'oldhour'};
    $oldduration = $::query->{'oldduration'};

    $id = $::query->{'id'} || '';
    $year = $::query->{'year'};
    $week = $::query->{'week'};
    $wday = $::query->{'wday'};
    $startyear = $::query->{'startyear'};
    $startweek = $::query->{'startweek'};
    $startwday = $::query->{'startwday'};
    $duration = $::query->{'duration'};

    $hour1 = $::query->{'hour1'};
    $min1 = $::query->{'min1'};
    $hour2 = $::query->{'hour2'};
    $min2 = $::query->{'min2'};
    $rt = $::query->{'rt'};
    $title = strip_space $::query->{'title'};
    $data = strip_space $::query->{'data'} || '';

    $alval = $::query->{'alval'} || 0;
    $altype = $::query->{'altype'} || 0;
    $alchk = $::query->{'alchk'} || "";
    $strike = $::query->{'strike'} || 0;

    ($startmonth, $startday) = get_month_day_by_wday_year_week ($startwday, $startyear, $startweek);

    if ($hour1 == -1)
    {
	$min1 = -1;
	$hour2 = -1;
	$min2 = -1;
	$lengthmin = -1;
    }
    else
    {
	$lengthmin = $hour2*60 + $min2 - $hour1*60 - $min1;
    }

    if (! defined $title or ! $title) {
	return "The title of the event must be entered.";
    } elsif (! &ParseDate ("$startmonth/$startday/$startyear")) {
	return "Date $startday.$startmonth.$startyear is invalid."
	} elsif ($duration < 1 or $duration > $::MAX_DURATION) {
	    return "You chose impossible duration \"$duration\"."
	    } elsif ($rt eq 'w' and ! fit_in_week ($startyear, $startweek, $startwday, $duration)) {
		return "Weekly repeating event must fit entirely in one week."
		} elsif ($rt eq 'm' and ! fit_in_month ($startyear, $startweek, $startwday, $duration)) {
		    return "Monthly repeating event must fit entirely in one month (the month you placed it in specifically)."
		    } elsif ($rt ne 'n' and $rt ne 'w' and $rt ne 'm') {
			return "You chose impossible repeat type \"$rt\"."
			} elsif (has_html $title or has_html $data) {
			    return "Text contains one more more of the illegal characters <, > and &."
			    } elsif ($lengthmin <= 0 && $hour1 != -1) {
				return "The start of the event ($hour1:$min1) must be before its end ($hour2:$min2)."
				}

    $title = newline_to_html $title;
    $data = newline_to_html $data;

    #
    # Remove the old event. The old one only exists if $id is set so this is
    # an edit command.
    #

    if ($id) {
	$err = remove_events ($oldrt, $startyear, $startweek, $startwday, $oldduration, $oldhour, $id);
	if ($err) {
	    return $err;
	}
    }

    #
    # Figure out the new $id
    #
    if (! $id) {
	($id, $err) = next_id ();
	if ($err) {
	    return $err;
	}
    }

    #
    # Add event for each day
    #

    $err = add_events ($rt, $startyear, $startweek, $startwday, $duration, $hour1, $id,
		       $min1, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike);
    if ($err) {
	return $err;
    }
    #
    # When we get here, add has been succesful.
    #
    # Return the id and some other items to redraw(), since he doesn't know
    # them otherwise.
    #
    return { 'id' => $id, 'lengthmin' => $lengthmin, 'data' => $data, 'title' => $title };
}

sub remove_event_commit ($$$$$$$$$$$$$$) {
    my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration) = @_;
    my ($err);

    if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
	return "some data of the event to be removed not given";
    }

    #
    # Copy data into clipboard
    #
    clipboard_set ($::REMOTE_USER,
		   { 'hour' => $hour, 'min' => $min, 'lengthmin' => $lengthmin,
		     'title' => $title, 'data' => $data, 'rt' => $rt,
		     'startyear' => $startyear, 'startweek' => $startweek, 'startwday' => $startwday, 'duration' => $duration } );

    #
    # Remove the event from the database
    #
    $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
    if ($err) {
	return $err;
    }

    return '';
}

sub delete_event_commit ($$$$$$$$$$$$$$) {
    my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration) = @_;
    my ($err);

    if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
	return "some data of the event to be removed not given";
    }

    #
    # Remove the event from the database
    #
    $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
    if ($err) {
	return $err;
    }

    return '';
}

sub switch_strike_event_commit {
    my ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration, $alval, $altype, $alchk, $strike) = @_;
    my ($err);

    if (! defined $id or ! defined $week or ! defined $wday or ! defined $rt or ! defined $duration) {
	return "some data of the event to be striked not given";
    }

    #
    # Strike/unstrike the event in the database
    #

    $strike = 1 - $strike;
    $err = remove_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id);
    if ($err) { return $err; }
    $err = add_events ($rt, $startyear, $startweek, $startwday, $duration, $hour, $id, $min, $lengthmin, $title, $data, $alval, $altype, $alchk, $strike);
    if ($err) { return $err; }
    return '';
}

sub copy_event () {
    my ($hour, $min, $lengthmin, $title, $data, $rt, $startyear, $startweek, $startwday, $duration);

    $hour = $::query->{'hour'};
    $min = $::query->{'min'};
    $lengthmin = $::query->{'lengthmin'};
    $title = $::query->{'title'};
    $data = $::query->{'data'};
    $rt = $::query->{'rt'};
    $startyear = $::query->{'startyear'};
    $startweek = $::query->{'startweek'};
    $startwday = $::query->{'startwday'};
    $duration = $::query->{'duration'};

    return if ! check_write_access ();

    clipboard_set ($::REMOTE_USER,
		   { 'hour' => $hour, 'min' => $min, 'lengthmin' => $lengthmin,
		     'title' => $title, 'data' => $data, 'rt' => $rt,
		     'startyear' => $startyear, 'startweek' => $startweek, 'startwday' => $startwday, 'duration' => $duration } );

    # Show_even() re-reads the variables from %$::query
    show_event ();
}

sub paste_event_commit ($$$) {
    my ($year, $week, $wday) = @_;
    my ($event_ref, $err, $id);


    # Read the event data from clipboard
    $event_ref = clipboard_get ($::REMOTE_USER);
    if (! $event_ref) {
	return "There is no event in clipboard for your computer $::REMOTE_USER.";
    }

    #
    # Find new id
    #
    ($id, $err) = next_id ();
    if ($err) {
	return $err;
    }

    #
    # Update some fields
    #

    $event_ref->{'startyear'} = $year;
    $event_ref->{'startweek'} = $week;
    $event_ref->{'startwday'} = $wday;
    $event_ref->{'id'} = $id;

    #
    # Make some sanity checks
    #

    my ($startmonth, $startday, $startyear, $startweek, $startwday, $duration, $rt);
    ($startmonth, $startday) = get_month_day_by_wday_year_week ($wday, $year, $week);
    $startyear = $year; $startweek = $week; $startwday = $wday;
    $duration = $event_ref->{'duration'};
    $rt = $event_ref->{'rt'};

    if (! &ParseDate ("$startmonth/$startday/$startyear")) {
	return "Date $startday.$startmonth.$startyear is invalid."
	} elsif ($rt eq 'w' and ! fit_in_week ($startyear, $startweek, $startwday, $duration)) {
	    return "Weekly repeating event must fit entirely in one week."
	    } elsif ($rt eq 'm' and ! fit_in_month ($startyear, $startweek, $startwday, $duration)) {
		return "Monthly repeating event must fit entirely in one month (the month you placed it in, specifically)."
		}
    
    #
    # Add event for each day
    #


    $err = add_events (
		       $event_ref->{'rt'},
		       $event_ref->{'startyear'},
		       $event_ref->{'startweek'},
		       $event_ref->{'startwday'},
		       $event_ref->{'duration'},
		       $event_ref->{'hour'},
		       $event_ref->{'id'},
		       $event_ref->{'min'},
		       $event_ref->{'lengthmin'},
		       $event_ref->{'title'},
		       $event_ref->{'data'} );
    if ($err) {
	return $err;
    }

    # When we get here, add has been succesful
    return $event_ref;
}

sub xxx_event_error () {
    my ($error1, $error2);
    $error1 = $::query->{'error1'};
    $error2 = $::query->{'error2'};
    
    print Socket $::H_BODY;
    print Socket "<DIV ALIGN=center VALIGN=middle>\n";
    print Socket "<TABLE BORDER=3 ROWS=1 COLS=1 CELLPADDING=20 ALIGN=center VALIGN=middle WIDTH=\"70%\" BGCOLOR=$::ERROR_COLOR>\n";
    print Socket "<TR><TD ALIGN=center VALIGN=middle>\n";
    print Socket "<H1>$error1</H1>\n";
    print Socket "<P>$error2\n</TD></TR>";
    print Socket "</TABLE>\n";
    print Socket "</BODY>\n";
    return;
}

sub show_event_list () {
    my ($year, $week, $alldata_ref, $lastweek);
    my ($cweek, $cyear, $cmonth, $cday, $end_cmonth, $end_cday);	
    my ($now_ref, $now_year, $now_week, $now_wday, $week_ref, $wday, $hour);
    
    $year = $::query->{'year'};
    $week = $::query->{'week'};

    $alldata_ref = build_week_list ($year, $week);
    if (ref $alldata_ref ne 'ARRAY') {
	print Socket "<DIV ALIGN=center VALIGN=middle><H1>Listing events failed: $alldata_ref</H1></DIV>\n";
	return;
    }

    $now_ref = get_now ();
    ($now_year, $now_week, $now_wday) = ($now_ref->{'year'}, $now_ref->{'week'}, $now_ref->{'wday'});

    print Socket $::H_BODY;

    print Socket "<PRE>\n</PRE>\n<P>\n";
    print Socket "<TABLE BORDER=1 WIDTH=\"100%\">\n";
    my $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
    print Socket "<TR><TH COLSPAN=3 BGCOLOR=\"$::THCOLOR\"><FONT SIZE=\"+1\">$str\n";
    print Socket "<TR><TH COLSPAN=3>\n";

    my $st = strcal();
    $lastweek = -1;
    for $week_ref (@$alldata_ref) {
	for $wday (0..6) {
	    for $hour (sort {$a <=> $b} keys %{$week_ref->[0]->[$wday]}) {
		my ($event_ref);
		$cyear = $week_ref->[1];
		$cweek = $week_ref->[2];

		# Change of week
		if ($cweek != $lastweek) {
		    my ($b_month, $b_day, $e_month, $e_day, $color);
		    $lastweek = $cweek;
		    ($b_month, $b_day) = get_month_day_by_firstday_year_week ($cyear, $cweek);
		    ($e_month, $e_day) = get_month_day_by_wday_year_week (6, $cyear, $cweek);
		    if ($cyear == $now_year and $cweek == $now_week) {
			$color = $::NOW_TDCOLOR;
		    } else {
			$color = $::TDCOLOR;
		    }
		    print Socket "<TR><TD COLSPAN=3 BGCOLOR=\"$color\"><A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=week&year=$cyear&week=$cweek$st\"><B>".sprintf(__("Semaine %s"), $cweek).", ", pd_year_month_day ($cyear, $b_month, $b_day), " - ", pd_year_month_day ($cyear, $e_month, $e_day), "</B></A>\n";
		}

		for $event_ref (@{$week_ref->[0]->[$wday]->{$hour}}) {
		    my (%e, $hour1, $min1, $hour2, $min2, $lengthmin);
		    my ($tmonth, $tday, $twday, $id, $min, $title, $data, $rt, $day, $color, $rcolor);
		    my ($startyear, $startweek, $startwday, $duration);
		    %e = %$event_ref;
		    $hour1 = $hour;
		    $id = $e{'id'};
		    $min1 = $e{'min'};
		    $lengthmin = $e{'lengthmin'};
		    $title = $e{'title'};
		    $data = $e{'data'};
		    $rt = $e{'rt'};
		    $startyear = $event_ref->{'startyear'};
		    $startweek = $event_ref->{'startweek'};
		    $startwday = $event_ref->{'startwday'};
		    $duration = $event_ref->{'duration'};

		    $hour2 = ($hour1 + int (($min1+$lengthmin) / 60)) % 24;
		    $min2 = ($min1 + $lengthmin) % 60;
		    ($cmonth, $cday) = get_month_day_by_wday_year_week ($wday, $cyear, $cweek);
		    if ($cyear == $now_year and $cweek == $now_week and $wday == $now_wday) {
			$color = " BGCOLOR=\"$::NOW_TDCOLOR\"";
		    } else {
			$color = " BGCOLOR=\"$::BG_TDCOLOR\"";
		    }

		    if ($rt eq 'w') {
			$rcolor = "COLOR=\"$::REPEAT_WEEK_TEXTCOLOR\"";
		    } elsif ($rt eq 'm') {
			$rcolor = "COLOR=\"$::REPEAT_MONTH_TEXTCOLOR\"";
		    } else {
			$rcolor = '';
		    }
		    print Socket "<TR><TD$color><A TARGET=_top HREF=\"$::MY_URL/?t=redraw&view=event$st",
		    "&id=", $id,
		    "&year=", $cyear, "&week=", $cweek, "&wday=", $wday,
		    "&hour=", $hour,
		    "&min=", $min1,
		    "&lengthmin=", $lengthmin,
		    "&title=", url_encode ($title),
		    "&data=", url_encode ($data),
		    "&rt=", $rt,
		    "&startyear=", $startyear,
		    "&startweek=", $startweek,
		    "&startwday=", $startwday,
		    "&duration=", $duration,
		    "\"><FONT $rcolor SIZE=\"2\">";
		    printf Socket "<TT>%s %s - %s</TT></A>\n",
		    __($::weekdays_short[$wday]),
		    format_time_padded ($hour1, $min1),
		    format_time_padded ($hour2, $min2);
		    print Socket "</FONT><TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=\"2\">", $e{'title'}, "</FONT><TD BGCOLOR=\"$::BG_TDCOLOR\"><FONT SIZE=\"2\">", $data || "&nbsp;", "</FONT>\n";
				}
			}
		}
	}
	print Socket "</TABLE><BR CLEAR=all>\n";

	return;
}

sub show_other_views (;$$) {
    my ($year, $week) = @_;
    my ($month, $moffset);

    $year = $year || $::query->{'year'};
    $week = $week || $::query->{'week'};

    print Socket $::H_BODY;
    
    print Socket "<CENTER>\n<TABLE BORDER=1 CELLPADDING=5 ALIGN=center VALIGN=middle WIDTH=\"95%\" BGCOLOR=\"$::TDCOLOR\">\n";
    print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>".__("Autres vues")."</B>";
    print Socket "\n<TR><TD BGCOLOR=\"$::TDCOLOR\" ALIGN=left>\n";
    print Socket "<TABLE><TR>\n";
    print Socket "<TD><UL><FONT SIZE=2>\n";
    my $str = sprintf(__("Agendas %s"), $::ORGANIZATION);
    my $st = strcal();
    print Socket "<LI><A TARGET=_top HREF=\"$::BASE_URL/\">$str</A>\n";
    $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
    print Socket "<LI><A HREF=\"$::MY_URL/?t=event_list&year=$year&week=$week$st\">$str</A>";
    print Socket "</FONT></UL></TD>\n";
    print Socket "<TD><UL><FONT SIZE=2>\n";
    $str = sprintf(__("Purger l'agenda jusqu'à la semaine %d de l'année %d"), , $week, $year);
    if (!$st && $::USER !~ /^\wo_/ && -e "/dev/pilot")
    {
	print Socket "<LI><A HREF=\"$::MY_URL/?t=purge&year=$year&week=$week\">$str</A>";
    }
    print Socket "</FONT></UL></TD>\n";
    print Socket "</TR></TABLE>\n";

    print Socket "<CENTER><TABLE BORDER=1 COLS=$::MANY_WEEKS_HOR WIDTH=\"98%\" BGCOLOR=\"$::BG_TDCOLOR\">\n";
    my ($cyear, $cweek, $cmonth, $cday, $now_year, $now_week, $n);
    $n = get_now ();
    $now_year = $n->{'year'}; $now_week = $n->{'week'};
    ($cyear, $cweek) = get_year_week_by_firstday_year_week_minus_days ($year, $week,
								       ($::MANY_WEEKS_VERT * $::MANY_WEEKS_HOR  + int ($::MANY_WEEKS_HOR / 2)) * 7);
    for $moffset (-$::MANY_WEEKS_VERT .. $::MANY_WEEKS_VERT) {
	my ($m);
	print Socket "<TR>\n";
	for $m (0 .. $::MANY_WEEKS_HOR-1) {
	    ($cmonth, $cday) = get_month_day_by_firstday_year_week ($cyear, $cweek);
	    if ($cweek == $now_week and $cyear == $now_year) {
		printf Socket "<TD BGCOLOR=\"$::NOW_TDCOLOR\"><FONT SIZE=2><A TARGET=fweek HREF=\"$::MY_URL/?t=week&year=$cyear&week=$cweek$st\">%02d : %s</A></FONT></TD>\n", $cweek, pd_month_day_padded ($cmonth, $cday);
	    } else {
		printf Socket "<TD><FONT SIZE=2><A TARGET=fweek HREF=\"$::MY_URL/?t=week&year=$cyear&week=$cweek$st\">%02d : %s</A></FONT></TD>\n", $cweek, pd_month_day_padded ($cmonth, $cday);
	    }
	    $cweek++;
	    if ($cweek > 50) {
		$cweek--;
		($cyear, $cweek) = get_next_year_week ($cyear, $cweek);
	    }
	}
	print Socket "</TR>\n";
    }
    print Socket "</TABLE></CENTER>\n";

    print Socket "</TABLE>\n";
    print Socket "</CENTER>\n</BODY>\n";
    return;
}

sub redraw_print_frameset ($$$) {
    my ($tweek, $tday, $tevent) = @_;
    my ($top_y, $left_x);
    
    if ($::SCREEN_RESOLUTION eq '800x600') {
	$top_y = 200;
	$left_x = 250;
    } else {
	$top_y = 250;
	$left_x = 320
	}

    my $title = sprintf(__("Agenda %s"), $::LONG_NAME);
    my $st = "";
    if ($::query->{'cal'})
    {
	$st .= "&cal=".join("&cal=", split(/\n/, $::query->{'cal'}));
    }

    print Socket <<END;
<HEAD><TITLE>$title</TITLE></HEAD>
<frameset framespacing="0" border="false" rows="$top_y,*" frameborder="0">
frameborder="0" marginheight="0" marginwidth="3" name="fhead" scrolling="no" target="fday" noresize>
<frame src="$tweek$st" bordercolor="#ffffff"
frameborder="0" marginheight="3" marginwidth="3" name="fweek" scrolling="auto" target="fday" noresize>
<frameset cols="$left_x,*">
<frame src="$tday$st" frameborder="0" marginheight="3"
marginwidth="3" name="fday" scrolling="auto" target="fevent" noresize>
<frame src="$tevent$st" frameborder="0" marginheight="3"
marginwidth="3" name="fevent" scrolling="auto" noresize>
</frameset>
<noframes>
<body>
</body>
</noframes>
</frameset>
END
    return;
}

sub check_write_access () {
    if ($::READ_ONLY eq 'true') {
	print Socket $::H_BODY;
	print Socket "<CENTER><TABLE BORDER=2 COLS=1 CELLPADDING=5 WIDTH=\"80%\" ALIGN=center VALIGN=middle BGCOLOR=\"$::ERROR_COLOR\">\n";
	print Socket "<TR><TD><BGCOLOR=\"$::THCOLOR\">&nbsp;<P><CENTER><FONT COLOR=\"#ffffff\" SIZE=4><B>This user has no write permission.</B></FONT></CENTER><P>&nbsp;</TD></TR>\n";
	print Socket "</TABLE></CENTER>\n";
	print Socket "</BODY>\n";
	return 0;
    }
    return 1;
}

sub redraw () {
    my ($view, $id, $year, $week, $wday, $wday_name);
    my ($hour, $min, $lengthmin, $title, $data, $rt);
    my ($tweek, $tday, $tevent);
    my ($startyear, $startweek, $startwday, $duration);
    my ($alval, $altype, $alchk, $strike);

    $view = $::query->{'view'};
    $id = $::query->{'id'};
    $year = $::query->{'year'};
    $week = $::query->{'week'};
    $wday = $::query->{'wday'} || 0;
    $wday_name = $::weekdays[$wday];
    $hour = $::query->{'hour'};
    $min = $::query->{'min'};
    $lengthmin = $::query->{'lengthmin'};
    $title = $::query->{'title'};
    $data = $::query->{'data'};
    $rt = $::query->{'rt'} || 'n';
    $startyear = $::query->{'startyear'};
    $startweek = $::query->{'startweek'};
    $startwday = $::query->{'startwday'};
    $duration = $::query->{'duration'};
    $alval = $::query->{'alval'};
    $altype = $::query->{'altype'};
    $alchk = $::query->{'alchk'} || "";
    $strike = $::query->{'strike'} || 0;

    if (! defined $view or $view eq '' or $view eq 'default') {
	$tweek = "$::MY_URL/?t=week";
	$tday = "$::MY_URL/?t=day";
	$tevent = "$::MY_URL/?t=event";
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'week') {
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day";
	$tevent = "$::MY_URL/?t=event";
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'event') {
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday";
	$tevent = "$::MY_URL/?t=event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=" . url_encode ($title) . "&data=" . url_encode ($data) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration";
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'after_remove_event') {
	my ($err);
	return if ! check_write_access ();
	$err = remove_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration);
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
	if ($err) {
	    $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error removing event") . "&error2=" . (url_encode $err);
	} else {
	    $tevent = "$::MY_URL/?t=event";
	}
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'after_delete_event') {
	my ($err);
	return if ! check_write_access ();
	$err = delete_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration);
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
	if ($err) {
	    $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error removing event") . "&error2=" . (url_encode $err);
	} else {
	    $tevent = "$::MY_URL/?t=event";
	}
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'paste_event') {
	my ($err);
	return if ! check_write_access ();
	$err = paste_event_commit ($year, $week, $wday);
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
	if (ref $err ne 'HASH') {
	    $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error pasting event from clipboard") . "&error2=" . (url_encode $err);
	} else {
	    $tevent = "$::MY_URL/?t=event&id=" . $err->{'id'} . "&year=$year&week=$week&wday=$wday&hour=" . $err->{'hour'} . "&min=" . $err->{'min'} . "&lengthmin=" . $err->{'lengthmin'} . "&title=" . url_encode ($err->{'title'}) . "&data=" . url_encode ($err->{'data'}) . "&rt=" . $err->{'rt'} . "&startyear=" . $err->{'startyear'} . "&startweek=" . $err->{'startweek'} . "&startwday=" . $err->{'startwday'} . "&duration=" . $err->{'duration'};
	}
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'add_event') {
	my ($err);
	return if ! check_write_access ();
	$err = add_event_commit ();
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
	if (ref $err ne 'HASH') {
	    $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error adding an event") . "&error2=" . (url_encode $err);
	} else {
	    $tevent = "$::MY_URL/?t=event&id=" . $err->{'id'} . "&year=$year&week=$week&wday=$wday&hour=" . $::query->{'hour1'} . "&min=" . $::query->{'min1'} . "&lengthmin=" . $err->{'lengthmin'} . "&title=" . url_encode ($err->{'title'}) . "&data=" . url_encode ($err->{'data'}) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike";
	}
	redraw_print_frameset ($tweek, $tday, $tevent);
    } elsif ($view eq 'after_strike_event') {
	my ($err);
	return if ! check_write_access ();
	$err = switch_strike_event_commit ($year, $week, $wday, $id, $hour, $rt, $min, $lengthmin, $title, $data, $startyear, $startweek, $startwday, $duration, $alval, $altype, $alchk, $strike);
	$tweek = "$::MY_URL/?t=week&year=$year&week=$week";
	$tday = "$::MY_URL/?t=day&year=$year&week=$week&wday=$wday&rt=$rt";
	if ($err) {
	    $tevent = "$::MY_URL/?t=xxx_event_error&error1=" . url_encode ("Error striking event") . "&error2=" . (url_encode $err);
	} else {
	    $strike = 1 - $strike;
	    $tevent = "$::MY_URL/?t=event&id=$id&year=$year&week=$week&wday=$wday&hour=$hour&min=$min&lengthmin=$lengthmin&title=" . url_encode ($title) . "&data=" . url_encode ($data) . "&rt=$rt&startyear=$startyear&startweek=$startweek&startwday=$startwday&duration=$duration&alval=$alval&altype=$altype&alchk=$alchk&strike=$strike";
	}
	redraw_print_frameset ($tweek, $tday, $tevent);
    } else {
	print Socket "<CENTER><H1>Redraw: Unknown view \"$view\".\n";
    }
    return;
}

sub create_users () {
    my (@users, $user);
    
    if (! chdir ($::DIRECTORY)) {
	return "Can't change into directory $::DIRECTORY: $!<P>Make sure it exists, and its permissions are as explained in file INSTALL of the Wcal distribution.";
    }
    
    @users = sort (keys (%$::USER_CONFS));
    for $user (@users) {
	my ($desc);
	$desc = $::USER_CONFS->{$user}->{'long name'};
	if (-d $user and -M $user > -M $::CONF_FILE) {
	    system "/bin/rm -rf $user";
	}
	if (! -d $user) {
	    my ($access_file, $access_file_name);
	    if (! mkdir ($user, 0755)) {
		return "Internal error: can't create user '$user': $!";
	    }
	    if (! link ('index.cgi', $user . '/index.cgi')) {
		return "Internal error: can't create hard link 'index.cgi -> $user/index.cgi': $!";
	    }
	    $access_file_name = $::USER_CONFS->{$user}->{'access file name'};
	    $access_file = $::USER_CONFS->{$user}->{'access file'};
	    if ($access_file and $access_file_name) {
		if (! open (AF, ">$user/$access_file_name")) {
		    return "Internal error: can't create access file $user/$access_file_name: $!";
		}
		print AF "# This file is automatically generated from $::CONF_FILE - do not edit\n";
		print AF $access_file;
		close AF;
	    }
	}
    }
    return '';
}

# Removes all cache files.
sub purge_cache_all () {
    my (@files);
    if (! opendir (DIR, "$::DB_DIR/cache")) {
	return;
    }
    @files = grep { /^w-[^-]+-\d\d\d\d\d\d\.html$/ } readdir (DIR);
    closedir DIR;
    for (@files) {
	unlink "$::DB_DIR/cache/$_" or warn "can't remove $::DB_DIR/cache/$_: $!\n";
    }
}

# Removes cached week views and Date::Manip wrapper caches.
# Supposed to be called at first request after midnight.
sub purge_cache_newday () {
    my (@files);
    my ($now_ref, $foo, $week1, $week2);
    
    #
    # Cached dates.
    # Other date caches stay valid accross date change.
    #

    undef $::now_cache;

    #
    # Cached week for this week, or all weeks if the week has changed
    # 
    $now_ref = get_now ();
    $week1 = sprintf ("%02d", $now_ref->{'week'});
    ($foo, $week2) = get_prev_year_week ($now_ref->{'year'}, $week1);
    $week2 = sprintf ("%02d", $week2);
    
    if (! opendir (DIR, "$::DB_DIR/cache")) {
	return;
    }
    if ($week1 == $week2) {
	@files = grep { /^w-[^-]+-\d\d\d\d$week1\.html$/ } readdir (DIR);
    } else {
	@files = grep { /^w-[^-]+-\d\d\d\d\d\d\.html$/ } readdir (DIR);
    }
    closedir DIR;
    for (@files) {
	unlink "$::DB_DIR/cache/$_" or warn "can't remove $::DB_DIR/cache/$_: $!\n";
    }

    return;
}

# Create socket and make it listen
sub init_socket () {
    if (! socket (SSocket, PF_INET, SOCK_STREAM, getprotobyname('tcp')) ) {
	print STDERR "$0: can't create socket: $!";
	exit 1;
    }

    if (! setsockopt(SSocket, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ) {
	print STDERR "$0: can't set socketopt SO_REUSEADDR: $!";
	exit 1;
    }

    if (! bind(SSocket, sockaddr_in($::PORT, INADDR_ANY)) ) {
	print STDERR "$0: can't bind socket to INADDR_ANY: $!";
	exit 1;
    }

    if (! listen(SSocket, SOMAXCONN) ) {
	print STDERR "$0: can't make socket listen: $!";
	exit 1;
    }
}

sub parse_config_line ($) {
    my ($line) = @_;
    my ($key, $value);

    if ($line =~ /^#/ or $line =~ /^\s*$/) {
	return '';
    }
    if ($line =~ /=/) {
	($key, $value) = split (/=/, $_, 2);
    } else {
	($key, $value) = ($_, '');
    }
    $key =~ s/^\s*(.*?)\s*$/$1/;
    $key = lc $key;
    $key =~ tr/ \t/ /s;
    if ($key !~ /^[a-z0-9_ ]+$/) {
	return "Config file line $. key '$key' has invalid characters";
    }
    $value =~ s/^\s*(.*?)\s*$/$1/;
    return {'key' => $key, 'value' => $value};
}

sub import_settings ($) {
    my ($s_ref) = @_;
    $::PASSWORD = $s_ref->{'password'};
    $::PORT = $s_ref->{'port'};
    $::BASE_URL = $s_ref->{'base url'};
    $::IMG_URL = $::BASE_URL . '/images';
    $::ORGANIZATION = $s_ref->{'organization'};
    $::LONG_NAME = $s_ref->{'long name'};
    $::READ_ONLY = $s_ref->{'read only'};
    $::DATA_ID = $s_ref->{'data id'};
    $::FIRST_DAY = $s_ref->{'first day'};
    $::DATE_FORMAT = $s_ref->{'date format'};
    $::CLOCK = $s_ref->{'clock'};
    $::SCREEN_RESOLUTION = $s_ref->{'screen resolution'};
    
    $::MY_URL = $::BASE_URL . "/" . (defined $::USER ? $::USER.'/index.cgi' : 'index.cgi');
    $::MY_URL_XUSER = $::BASE_URL . "/" . (defined $::USER ? 'X_USER_X/index.cgi' : 'index.cgi');
    $::REMOTE_LANG = $s_ref->{'remote lang'} || "en";
    $::REMOTE_MAIL = $s_ref->{'remote mail'} || "root";
    $::REMOTE_CAL = $s_ref->{'remote cal'} || "all";

    $::H_BODY = "<BODY BGCOLOR=\"#ffffff\" TEXT=\"#000000\" LINK=\"#0000b0\" VLINK=\"#0000b0\" ALINK=\"#0000b0\" BACKGROUND=\"$::BASE_URL/images/background.jpg\">\n";
    return;
}

# Reads global config data from /etc/wcal.conf
sub read_config () {
    my ($key, $value, $line, $line_ref, %global_conf, %user_confs, $cuser, $conf_ref);
    my (@current_access_file, $reading_access_file);
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
    my ($valid_line);

    if (! open (CONF, "<$::CONF_FILE")) {
	my $str1 = "can't open $::CONF_FILE for reading: $!";
	return \$str1;
    }

    # Conf file must not be read/writeable by 'other'
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat (CONF);
    if ($mode & 6) {
	close CONF;
	my $str2 = "Configuration file $::CONF_FILE must not have read or write permission for 'other' (do 'chmod o= $::CONF_FILE)'.\n";
	return \$str2;
    }

    # Empty the settings from the last run
    %global_conf = (); %user_confs = ();
    $conf_ref = \%global_conf;
    $cuser = '';
    $reading_access_file = 0;

    # Set some defaults
    $global_conf{'host'} = 'localhost';
    $global_conf{'port'} = '13134';
    $global_conf{'base url'} = '/wcal';
    $global_conf{'access file name'} = '.htaccess';
    $global_conf{'access file'} = '';
    $global_conf{'organization'} = 'My Organization';
    $global_conf{'read only'} = 'false';
    $global_conf{'first day'} = 'monday';
    $global_conf{'date format'} = 1;
    $global_conf{'clock'} = '24-hour';
    $global_conf{'screen resolution'} = '1024x768';
    $global_conf{'top left corner'} = '&nbsp;';
    $global_conf{'remote lang'} = 'en';
    $global_conf{'remote mail'} = 'root';
    $global_conf{'remote cal'} = 'all';

    while (<CONF>) {
	chomp;
	$line = $_;

	# If we are reading access file, do special processing
	if ($reading_access_file) {
	    $line =~ s/^\s*(.*?)\s*$/$1/;
	    if ($line =~ /^end access file$/i) {
		$conf_ref->{'access file'} = join ("\n", @current_access_file) . "\n";
		$reading_access_file = 0;
	    } else {
		push @current_access_file, $line;
	    }
	    next;
	}
	
	# Else do the normal processing

	$line_ref = parse_config_line ($line);
	next if ! $line_ref;	# skip comments and empty lines
	if (! ref $line_ref) {	# if return value not empty, and not a reference, it's an error
	    close CONF;
	    return \$line_ref;
	}
	$key = $line_ref->{'key'};
	$value = $line_ref->{'value'};

	# 'user' field starts user definition
	if ($key eq 'user') {
	    if (! defined $global_conf{'password'}) {
		close CONF;
		my $str2 = "Configuration file $::CONF_FILE line $. starts user definition, but the password field hasn't yet occured (password must be given in global section before any user definitions)";
		return \$str2;
	    }
	    $cuser = $value;
	    $conf_ref = {};
	    next;
	}
	
	# 'end user' field ends user definition
	if ($key eq 'end user') {
	    my ($gkey);
	    # Copy each global conf field into user definition if it isn't given in user definition
	    for $gkey (keys %global_conf) {
		if (! defined $conf_ref->{$gkey}) {
		    $conf_ref->{$gkey} = $global_conf{$gkey};
		}
	    }
	    # Long name = user, if not explicitely given
	    if (! defined $conf_ref->{'long name'}) {
		$conf_ref->{'long name'} = $cuser;
	    }
	    # Data id = user, if not explicitely given
	    if (! defined $conf_ref->{'data id'}) {
		$conf_ref->{'data id'} = $cuser;
	    }
	    # Empty 'top left corner' replaced with &nbsp;, to make browsers happier.
	    if ($conf_ref->{'top left corner'} eq '') {
		$conf_ref->{'top left corner'} = '&nbsp;';
	    }
	    $user_confs{$cuser} = $conf_ref;
	    $cuser = '';
	    $conf_ref = \%global_conf;
	    next;
	}

	# 'access file' starts (default / user) access file definition
	if ($key eq 'access file') {
	    if ($value) {
		close CONF;
		my $str3 = "Configuration file $::CONF_FILE line $. starts access file definition, but has value field";
		return \$str3;
	    }
	    @current_access_file = ();
	    $reading_access_file = 1;
	    next;
	}

	$valid_line = 0;

	# Some fields can only occur in global section
	if ($cuser and ($key eq 'port' or $key eq 'address')) {
	    close CONF;
	    my $str4 = "Configuration file $::CONF_FILE line $. has in user $cuser definition parameter '$key' that can only occur in global section";
	    return \$str4;
	}

	# And some only in user definition
	if (! $cuser and ($key eq 'long name' or $key eq 'read only')) {
	    close CONF;
	    my $str5 = "Configuration file $::CONF_FILE line $. has in global section parameter '$key' that can only occur in user definition";
	    return \$str5;
	}

	# READ ONLY field can have only values true or false
	if ($key eq 'read only') {
	    $value = lc $value;
	    if ($value ne 'true' and $value ne 'false') {
		close CONF;
		my $str6 = "Configuration file $::CONF_FILE line $. has invalid value for option 'read only'. Allowed values are true and false (default false).";
		return \$str6;
	    }
	    $valid_line = 1;
	}

	# FIRST DAY can be only monday or sunday
	elsif ($key eq 'first day') {
	    if ($value ne 'monday' and $value ne 'sunday') {
		close CONF;
		my $str7 = "Configuration file $::CONF_FILE line $. has invalid value for option 'first day'. Allowed values are monday and sunday (default monday).";
		return \$str7;
	    }
	    $value = lc $value;
	    $valid_line = 1;
	}

	# DATE FORMAT must be between 1 and 5
	elsif ($key eq 'date format') {
	    if ($value < 1 or $value > 6) {
		close CONF;
		my $str8 = "Configuration file $::CONF_FILE line $. has invalid value for option 'date format'. Allowed values are 1 to 6 (default 1).";
		return \$str8;
	    }
	    $valid_line = 1;
	}
	
	# PORT must be a integer number
	elsif ($key eq 'port') {
	    if ($value !~ /^\d+$/ or $value < 1 or $value > 65535) {
		close CONF;
		my $str9 = "Configuration file $::CONF_FILE line $. has invalid value for option 'port'. Allowed values are integer numbers between 1 and 65535 (default 13134).";
		return \$str9;
	    }
	    $valid_line = 1;
	}

	# CLOCK must be 24-hour or 12-hour
	elsif ($key eq 'clock') {
	    $value = lc $value;
	    if ($value ne '24-hour' and $value ne '12-hour') {
		close CONF;
		my $str10 = "Configuration file $::CONF_FILE line $. has invalid value for option 'clock'. Allowed values are '24-hour' and '12-hour' (default 24-hour).";
		return \$str10;
	    }
	    $valid_line = 1;
	}

	# SCREEN RESOLUTION must be 800x600 or 1024x768
	elsif ($key eq 'screen resolution') {
	    $value = lc $value;
	    if ($value ne '800x600' and $value ne '1024x768') {
		close CONF;
		my $str11 = "Configuration file $::CONF_FILE line $. has invalid value for option 'screen resolution'. Allowed values are '800x600' and '1024x768' (default 1024x768).";
		return \$str11;
	    }
	    $valid_line = 1;
	}

	# DATABASE DIRECTORY is deprecated
	elsif ($key eq 'database directory') {
		print STDERR "Configuration variable 'database directory' is deprecated and won't be used.";
		print STDERR "If you have database in a place other than $::DB_DIR, move it there now.";
	    $valid_line = 1;
	}

	# OTHERS - no particular syntax required, but must be a valid key
	elsif ($key eq 'base url' or $key eq 'password' or
	       $key eq 'organization' or $key eq 'access file name' or $key eq 'data id' or
	       $key eq 'long name' or $key eq 'address' or $key eq 'top left corner' or 
	       $key eq 'lang' or $key eq 'remote lang' or $key eq 'remote mail' or $key eq 'remote cal' or $key eq 'install dir') {
	    $valid_line = 1;
	}

	if (! $valid_line) {
	    close CONF;
	    my $str12 = "Configuration file $::CONF_FILE line $. has unknown option '$key'.";
	    return \$str12;
	}

	$conf_ref->{$key} = $value;
    }
    close CONF;
    if ($reading_access_file or $cuser) {
	my $str13 = "End of configuration file $::CONF_FILE while reading access file or user definition";
	return \$str13;
    }

    $::GLOBAL_CONF = \%global_conf;
    $::USER_CONFS = \%user_confs;

    import_settings ($::GLOBAL_CONF);

    purge_cache_all ();

    return 1;
}

# Read CGI environment and conf option from Socket (sent by the cgi-proxy)
sub read_environment () {
    my ($key, $value, $user);

    while (<Socket>) {
	chomp;
	last if /^$/;
	my ($key, $value);
	
	($key, $value) = split (/=/, $_, 2);
	$key =~ tr/\x00-\x1f\x80-\x9f//d;	# filter out control characters,
	$value =~ tr/\x00-\x1f\x80-\x9f//d;	# including infamous NUL
	if ($key eq 'QUERY_STRING') {
	    $::query = decode_url_encoded_data \$value;
	} elsif ($key eq 'REMOTE_USER') {
	    $::REMOTE_USER = $value;
	    $ENV{REMOTE_USER} = $::REMOTE_USER;
	} elsif ($key eq 'REMOTE_PASS') {
	    $::REMOTE_PASS = $value;
	    $ENV{REMOTE_PASS} = $::REMOTE_PASS;
	} elsif ($key eq 'REMOTE_MAIL') {
	    $::REMOTE_MAIL = $value;
	} elsif ($key eq 'REMOTE_CAL') {
	    $::REMOTE_CAL = $value;
	} elsif ($key eq 'REMOTE_LANG') {
	    $::REMOTE_LANG = $value;
	} elsif ($key =~ /^__/) {
	    $key = lc $key;
	    if ($key eq '__password') {
#				print Socket "<P>got: '$value', correct is '$::PASSWORD'\n";
		if ($value ne $::PASSWORD) {
		    print Socket "<P>Invalid password\n";
		    return 0;
		}
	    } elsif ($key eq '__user') {
		$::USER = $value;
	    } elsif ($key eq '__gid') {
		$::GID = $value;
	    } else {
		print Socket "<P>Unknown configuration option '$key'\n";
		return 0;
	    }
	}
    }
#	print Socket "<P>$::MY_URL\n";

    # Make sure we received all the mandatory options
    if (! $::USER) {
	print Socket "<P>User not sent by cgi-proxy\n";
	return 0;
    }
    return 1;
}

sub siginthandler {
    exit (1);
}

sub sighuphandler {
    my ($res);

    return; # do nothing, this is just a kludge that doesn't work

    $::GID = 60;
    $res = read_config ();
    if (ref $res) {
	print STDERR "<P>Re-reading configureation failed: ", $$res, " - configuration not changed.\n";
    } else {
	$res = create_users ();
	if ($res) {
	    print STDERR "<P>Error creating new users: $res\n";
	}
    }
    
    return;
}

sub check_and_set_first_day () {
    my ($gen);
    
    $gen = read_general ();
    if (! ref $gen) {
	print "error: $gen\n";
	exit (1);
    }
    if (defined $gen->{'first day'} and $gen->{'first day'} ne $::FIRST_DAY) {
	print <<EOD;

Current database ($::DB_DIR/*.db) is created using different 'first day'
value than defined in current configuration file $::CONF_FILE.
If you want to change 'first day' setting, you must first destroy the
current database (by doing 'rm $::DB_DIR/*.db').

EOD
	exit (1);
    }
    if (! defined $gen->{'first day'}) {
	my ($err);

	$gen->{'first day'} = $::FIRST_DAY;
	$err = write_general ($gen);
	if ($err) {
	    print "error: $err\n";
	    exit (1);
	}
    }
    return;
}

sub show_links () {
    print Socket $::H_BODY;
    my @cals = split(/\n/, $::query->{'cal'});
    my $st = "";
    if ($::query->{'year'} && $::query->{'week'})
    {
	$st = '&year='.$::query->{'year'}.'&week='.$::query->{'week'};
    }
    print Socket '<h1><a href="'.$::BASE_URL.'/fusion.cgi/?t=week&cal='.join("&cal=", @cals).$st;

    print Socket '" target="fweek">'.$::LONG_NAME."</a></h1>\n";
    print Socket "<table width=100% border=0 cellspacing=0 cellpadding=5>\n";
    my $cal;
    my $i = 1;
    foreach $cal (@cals)
    {
	print Socket '<tr bgcolor="'.$::EVENT_COLS[$i++].'"><td><font size=4><b><a href="'.$::BASE_URL.'/'.$cal.'/index.cgi/?t=week'.$st.'"target="fweek">'.%{$::USER_CONFS->{$cal}}->{'long name'}."</b></font></a>\n";
    }
    print Socket "</table>";
}

sub clear_events  {
    my $week = shift;
    my $year = shift;

    if ($week)
    {
	my $file;
	opendir(DIR, $::DB_DIR);
	while ($file = readdir(DIR))
	{
	    if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.db$/)
	    {
		if (($1 < $year) || (($1 == $year) && ($2 <= $week)))
		{
		    unlink($::DB_DIR."/".$file);
		}

	    }
	}
	closedir(DIR);
	opendir(DIR, $::DB_DIR."/cache");
	while ($file = readdir(DIR))
	{
	    if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.html$/)
	    {
		if (($1 < $year) || (($1 == $year) && ($2 <= $week)))
		{
		    unlink($::DB_DIR."/cache/".$file);
		}

	    }
	}
	closedir(DIR);
	    
    }
    else
    {
	system('\rm '.$::DB_DIR.'/*'.$::USER.'*');
	system('\rm '.$::DB_DIR.'/cache/*'.$::USER.'*');
    }
}

sub all_events () {
    opendir(DIR, $::DB_DIR);
    my @events;
    my $event;
    my $evw;
    my $i;
    my $key;
    my $val;
    my $file;
    while ($file = readdir(DIR))
    {
	if ($file =~ /^w\-$::USER\-(\d\d\d\d)(\d\d)\.db$/)
	{
	    $evw = read_events('n', $1, $2);
	    for ($i=0; $i<7; $i++)
	    {
		 while (($key, $val) = each(%{@{$evw}[$i]}))
		 {
		     foreach $event (@{$val})
		     {
			 $event->{hour} = $key;
			 push @events, $event;
		     }
		 }
	     }
	}
    }

    return \@events;
}

sub show_purge () {
    my $str;
    my $week = $::query->{'week'};
    my $year = $::query->{'year'};

    print Socket $::H_BODY;
    print Socket "<TABLE BORDER=1 WIDTH=\"100%\" BGCOLOR=\"$::TDCOLOR\">\n";
    print Socket "<TR><TH ALIGN=center BGCOLOR=\"$::THCOLOR\"><B>";
    print Socket __("Transfert Palm Pilot");
    print Socket "</B></TH></TR>\n";
    print Socket "<TR><TD BGCOLOR=\"$::TDCOLOR\">\n";
    if ($::query->{'purge'})
    {
	clear_events($week, $year);
	$str = sprintf(__("Agenda %s purgé jusqu'à la semaine %d de l'année %d"), '<A HREF="'.$::MY_URL.'" TARGET="_top">'.$::LONG_NAME.'</A>', $week, $year);
	print Socket "<H1>$str</H1>\n";
    }
    elsif ($::query->{'cancel'})
    {
	$str = sprintf(__("Purge de l'agenda %s annulée"), '<A HREF="'.$::MY_URL.'" TARGET="_top">'.$::LONG_NAME.'</A>');
	print Socket "<H1>$str</H1>\n";
    }
    else
    {
	print Socket "<TABLE><TR align=center>\n";
	print Socket "<TD colspan=2><h1>".sprintf(__("Voulez-vous réellement purger l'agenda %s jusqu'à la semaine %d de l'année %d ?"), $::LONG_NAME, $::query->{'week'}, $::query->{'year'})."\n";
	print Socket "<TR align=center>\n";
	print Socket "<FORM ACTION=\"$::MY_URL\" METHOD=GET>\n";
	print Socket "<INPUT TYPE=HIDDEN NAME=t VALUE=purge>\n";
	print Socket "<INPUT TYPE=HIDDEN NAME=week VALUE=$::query->{'week'}>\n";
	print Socket "<INPUT TYPE=HIDDEN NAME=year VALUE=$::query->{'year'}>\n";
	my $submit_value =  __("Oui");
	print Socket "<TD><INPUT TYPE=submit NAME=purge VALUE=\"$submit_value\">\n";
	$submit_value =  __("Non");
	print Socket "<TD><INPUT TYPE=submit NAME=cancel VALUE=\"$submit_value\">\n";
	print Socket "</FORM></TABLE>\n";
    }
    print Socket "</TABLE>\n";
}

sub checkAlarm
{
    my $event = shift;
    my $cal = shift;
    my $hour = shift;
    my $day = shift;
    my $et = shift;
    my $week = shift;
    my $year = shift;

    my @types = ("", "minutes", "hours" , "days");
    # compute start date
    my $now=&ParseDate("today");
    my $begin;
    my $end;
    my $alarm;
    my $strdate;
    my @format;
    my @tab;
    my $chk = 1;
    my $min =  $event->{min};
    my $notime;
    if ($hour == -1)
    {
	$hour = 0;
	$min = 0;
	$notime = 1;
    }
    if ($et eq "w")
    {
	$begin = &DateCalc(&ParseDate(sprintf("%04d-w%02d-%d", $event->{startyear}, $event->{startweek}, $event->{startwday}+1)), sprintf("+%dhours +%dminutes", $hour, $min));
	$alarm = &DateCalc($begin, sprintf("-%d%s", $event->{alval}, $types[$event->{altype}]));
	if ($alarm gt $now)
	{
	    return 0;
	}
    }
    elsif ($et eq "rw")
    {
	$alarm = &DateCalc($now, sprintf("+%d%s", $event->{alval}, $types[$event->{altype}]));
	@format = ("%w");
	my $wday = &UnixDate($alarm, @format);
	$wday = 1 + $event->{startwday} - $wday;
	if ($wday > 0)
	{
	    return 0;
	}
	elsif ($wday < 0)
	{
	    $begin = &DateCalc($alarm, $wday."days");
	}
	else
	{
	    $begin = $alarm;
	}
	$begin = substr($begin,0,8).sprintf("%02d:%02d:00", $hour, $min);
	if ($begin gt $alarm || ($event->{alchk} && $begin le $event->{alchk}))
	{
	    return 0;
	}
	
	$chk = $begin;
    }
    elsif ($et eq "rm")
    {
	$alarm = &DateCalc($now, sprintf("+%d%s", $event->{alval}, $types[$event->{altype}]));
	@format = ("%d");
	my $mday = &UnixDate($alarm, @format);
	$mday = $day - $mday;
	if ($mday > 0)
	{
	    return 0;
	}
	elsif ($mday < 0)
	{
	    $begin = &DateCalc($alarm, $mday."days");
	}
	else
	{
	    $begin = $alarm;
	}
	$begin = substr($begin,0,8).sprintf("%02d:%02d:00", $hour, $min);
	if ($begin gt $alarm || ($event->{alchk} && $begin le $event->{alchk}))
	{
	    return 0;
	}
	
	$chk = $begin;
    }

    my $email = "root";
    my $head;
    my $body;
    $email = $::REMOTE_MAIL;
    $head = sprintf(__("Agenda %s"), %{$::USER_CONFS->{$cal}}->{'long name'});

    if ($notime)
    {
	@format = ("%d","%m","%y");
	@tab = &UnixDate($begin, @format);
	$strdate = sprintf("%02d/%02d/%02d", @tab);
    }
    else
    {
	@format = ("%d","%m","%y","%H","%M");
	@tab = &UnixDate($begin, @format);
	$strdate = sprintf("%02d/%02d/%02d %02d:%02d", @tab);
	$end = &DateCalc($begin, sprintf("+%dminutes", $event->{lengthmin}));
	@format = ("%H","%M");
	@tab = &UnixDate($end, @format);
	$strdate .= sprintf(" - %02d:%02d", @tab);
    }
    my $data = $event->{data};
    $data =~ s/<BR>/\n\t  /mg;

    $body = $head."\n";

    $head .= " : ".$event->{title}."\n";
    $body .= "************************************************************\n";
    $body .= __("Date")."\t: ".$strdate."\n";
    $body .= __("Titre")."\t: ".$event->{title}."\n";
    if ($data)
    {
	$body .= __("Note")."\t: ".$data."\n";
    }
    $body .= "************************************************************\n";
    system('mail -s "'.$head.'" '.$email." <<EOF\n".$body."\nEOF");
 
    return $chk;
}

sub check_alarm () {
    opendir(DIR, $::DB_DIR);
    my $file;
    my $et;
    my $cal;
    my $week;
    my $year;
    my $refs;
    my $hour;
    my $day;
    my $devents;
    my $events;
    my $event;
    my $old_slash;
    my $err;
    my $chk;

    while ($file = readdir(DIR))
    {
	if ($file =~ /^(\w+)-(.+)\.db$/)
	{
	    $et = $1;
	    $cal = $2;
	    if ($cal =~ /^(.+)-(\d\d\d\d)(\d\d)$/)
	    {
		$cal = $1;
		$year = $2;
		$week = $3;
	    }
	    else
	    {
		$year = "";
		$week = "";
	    }
	    if ($::REMOTE_CAL ne "all" && $::REMOTE_CAL ne $cal)
	    {
		next;
	    }
	    if (open F, "$::DB_DIR/$file")
	    {
		$old_slash = $/;
		undef $/;
		$refs = eval (<F>);
		$/ = $old_slash;
		close F;
		shift @$refs;
		$day = 0;
		foreach $devents (@$refs)
		{
		    while (($hour,$events) = each (%$devents))
		    {
			foreach $event (@$events)
			{
			    if ($event->{alval} && !$event->{strike} && (!$event->{alchk} || $event->{alchk} ne "1"))
			    {
			      if ($chk = checkAlarm($event, $cal, $hour, $day, $et, $week, $year))
			      {
				  $::USER = $cal;
				  $::DATA_ID = $cal;
				  print Socket "$event->{'title'} ($event->{'id'}) checked\n";
				  $err = remove_events(
						       $event->{'rt'},
						       $event->{'startyear'},
						       $event->{'startweek'},
						       $event->{'startwday'},
						       $event->{'duration'},
						       $hour,
						       $event->{'id'});
				  if (!$err)
				  {
				      $err = add_events(
							$event->{'rt'},
							$event->{'startyear'},
							$event->{'startweek'},
							$event->{'startwday'},
							$event->{'duration'},
							$hour,
							$event->{'id'},
							$event->{'min'},
							$event->{'lengthmin'},
							$event->{'title'},
							$event->{'data'},
							$event->{'alval'},
							$event->{'altype'},
							$chk);
				  }
			      }
			  }
			}
		    }
		    $day++;
		}
	    }
	}
    }
    closedir(DIR);
}

sub list_users () {
	my (@users, $user);

	my $str = sprintf(__("Agendas %s"), $::ORGANIZATION);
	print Socket "<HEAD><TITLE>$str</TITLE></HEAD>\n";
	print Socket $::H_BODY;

	if (! chdir ($::DIRECTORY)) {
		print Socket "<P>Can't change into directory $::DIRECTORY: $!";
		print Socket "<P>Make sure it exists, and its permissions are as explained in file INSTALL of the Wcal distribution.";
		exit (1);
	}

	print Socket "<CENTER><H1>$str</H1></CENTER>";
	print Socket sprintf(__("Cliquez sur un calendrier ou sélectionnez les calendriers pour la %s"), '<a href="fusion-'.$::REMOTE_LANG.'.html">'.__("Fusion")."</a>");
	print Socket '<form action="'.$::BASE_URL.'/fusion.cgi">'."\n";
	print Socket "<P><UL>\n";
	@users = sort (keys (%$::USER_CONFS));
	for $user (@users) {
		my ($desc);
		$desc = $::USER_CONFS->{$user}->{'long name'};
		print Socket '<input type="checkbox" name="cal" value="'.$user.'"> ';
		print Socket "<A TARGET=_top HREF=\"$::BASE_URL/$user/?t=redraw&view=default\">$desc</A><br>\n";
	}
	print Socket "</UL>\n";
	print Socket '<input type="submit" name="fusion" value="'.__("Fusion").'"></form action>'."\n";
	print Socket "</BODY>\n";
	return;
}

sub main () {
    my ($config_result, $last_run, $last_conf, $res);
    
    $SIG{HUP} = $SIG{PIPE} = 'IGNORE';
    $SIG{ALRM} = \&purge_cache_all;
    $ENV{'PATH'} = '/usr/local/bin:/usr/local/sbin:/usr/bin:/usr/sbin:/bin:/sbin';	# To pass taint checks
    
    #
    # Make sure the $::DIRECTORY variable is set
    #

    if ($::DIRECTORY =~ /^_X_DIRECTOR/) {
	print "You haven't set the variable $::DIRECTORY at top of wcald.\n";
	print "It is automatically set by Makefile. If you're installing manually,\n";
	print "set the variable the name directory you installed wcald to.\n";
	exit 1;
    }

    #
    # Refuse to run as root
    #
    if ($> == 0) {
	die "Won't run as root.\n";
    }

    #
    # Check some file permissions
    #
    if (! -d $::DB_DIR or ! -w $::DB_DIR or (sprintf "%04o", ((stat ($::DB_DIR))[2]) & 07777) ne '0700') {
	die "$::DB_DIR must exist, be writable and have mode 0700.\n";
    }
    if (! -d "$::DB_DIR/cache") {
    	mkdir ("$::DB_DIR/cache", 0700) or die "mkdir (\"$::DB_DIR/cache\", 0700): $!\n";
    }
    if (! -d $::DIRECTORY or ! -w $::DIRECTORY or (sprintf "%04o", ((stat ($::DIRECTORY))[2]) & 07777) ne '0750') {
	die "$::DIRECTORY must exist, be writable and have mode 0750.\n";
    }

    #
    # Read in wcal.msg
    #
    open(MSG, $::MSG_FILE) or die "Can't open $::MSG_FILE for reading: $!";
    my $old_slash = $/;
    undef $/;
    $::msgs = eval (<MSG>);
    $/ = $old_slash;
    close(MSG);

    #
    # Read configuration and create users
    #
    $config_result = read_config ();
    if (ref $config_result) {
	die "$0: error: ", $$config_result, "\n";
    }
    $res = create_users ();
    if ($res) {
	die "$0: error creating users: $res\n";
    }

    #
    # Make sure current database (if one exists) uses same 'first day'
    # parameter as we're currently using.
    #
    check_and_set_first_day ();
    
    #
    # Set the date constants
    #
    if ($::FIRST_DAY eq 'monday') {
	@::weekdays = qw (Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche);
	@::weekdays_short = qw (lun mar mer jeu ven sam dim);
	@::weekdays2 = qw (Monday Tuesday Wednesday Thursday Friday Saturday Sunday);
	&Date_Init ('FirstDay=1');
    } else {
	@::weekdays = qw (Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi);
	@::weekdays_short = qw (dim lun mar mer jeu ven sam);
	@::weekdays2 = qw (Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
	&Date_Init ('FirstDay=7');
    }
    @::months = qw (Erreur Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre);

    init_socket ();

    $last_run = (localtime(time))[7];
    $last_conf = 0;

    while (1) {
	my ($query_type, $pid, $paddr, $cgi, %user, $now_run, $now_conf);

	$SIG{'INT'} = $SIG{'TERM'} = \&siginthandler;
	$SIG{'HUP'} = \&sighuphandler;
	$paddr = accept (Socket, SSocket);
	$SIG{'INT'} = $SIG{'TERM'} = $SIG{'HUP'} = 'IGNORE';

	#
	# Purge cache when day changes
	#
	$now_run = (localtime(time))[7];
	if ($now_run != $last_run) {
	    $last_run = $now_run;
	    purge_cache_newday ();
	}

	#
	# Start outputing HTML
	#
	print Socket $::HTTP_HEADER;
	print Socket "<HTML>\n";

	#
	# Read CGI environment and the config options that cgi-proxy passes to us
	# Includes QUERY_STRING (decoded into $::query),
	#  __password (checked) and __user (stored in $::USER)
	#
	if (! read_environment ()) {
	    next;
	}

	#
	# Re-read config if it has changed
	#
	$now_conf = (stat($::CONF_FILE))[9];
	if ($now_conf != $last_conf) {
	    $last_conf = $now_conf;
	    $config_result = read_config ();
	    if (ref $config_result) {
		while (<Socket>) { chomp; last if /^$/; };	# Read environment to make cgi-proxy happy
		print Socket $::H_BODY;
		print Socket "<P><H2>Configuration has changed.</H2>";
		print Socket "<P>Re-reading configureation failed: ", $$config_result, " - configuration not changed.\n";
		print Socket "<P><A TARGET=\"_top\" HREF=\"$::BASE_URL/\">Click me</A> to go to the main view\n";
		print Socket "</BODY>\n";
		next;
	    } else {
		$res = create_users ();
		if ($res) {
		    print Socket $::H_BODY;
		    print Socket "<P><H2>Configuration has changed.</H2>";
		    print Socket "<P>Error creating new users: $res\n";
		    print Socket "<P><A TARGET=\"_top\" HREF=\"$::BASE_URL/\">Click me</A> to go to the main view\n";
		    print Socket "</BODY>\n";
		    next;
		}
		# fall through: just serve the request 
	    }
	}

	# show a list of users
	if (!$::query->{'cal'} && $::USER eq $::PATH_BASENAME) {
	    list_users ();
	    next;
	}

	#
	# Dispatch the operation
	#

	# Make sure the users exists
	if ($::USER_CONFS->{$::USER}) {
	    import_settings ($::USER_CONFS->{$::USER});
	    $::DATA_IDS = 0;
	}
	else # fusion
	{
	    $::READ_ONLY = 'true';
	    $::DATA_ID = 0;
	    $::DATA_IDS = $::query->{'cal'};
	    $::LONG_NAME = __('Fusion');
	    $::MY_URL = $::BASE_URL.'/fusion.cgi';
	    $::MY_URL_XUSER = $::BASE_URL.'/fusion.cgi';
	}	
	
	$::query->{'u'} = $::USER;
	$query_type = $::query->{'t'} || '';
	if ($query_type eq 'redraw' or $query_type eq '') {
	    redraw ();
	} elsif ($query_type eq 'week') {
	    show_week ();
	} elsif ($query_type eq 'day') {
	    show_day ();
	} elsif ($query_type eq 'event') {
	    show_event ();
	} elsif ($query_type eq 'copy_event') {
	    copy_event ();
	} elsif ($query_type eq 'add_edit') {
	    add_edit_event_ask () if check_write_access ();
	} elsif ($query_type eq 'add_edit_confirm') {
	    add_edit_event_confirm () if check_write_access ();
	} elsif ($query_type eq 'remove') {
	    remove_event_confirm () if check_write_access ();
	} elsif ($query_type eq 'xxx_event_error') {
	    xxx_event_error ();
	} elsif ($query_type eq 'event_list') {
	    show_event_list ();
	} elsif ($query_type eq 'views') {
	    show_other_views ();
	} elsif ($query_type eq 'links') {
	    show_links ();
	} elsif ($query_type eq 'purge') {
	    show_purge ();
	} elsif ($query_type eq 'checkalarm') {
	    check_alarm ();
	} else {
	    print Socket "<H2><P>Unknown command '$query_type'.</H2>\n";
	}
	undef $::query;
	
    } continue {
	print Socket "</HTML>\n";
	close Socket;
    }
    
    # not reached
}

main();