| \n";
+ if ($::READ_ONLY ne 'true') {
+ print Socket "";
+ print Socket ">\n";
+ }
+ else
+ {
+ print Socket ">\n";
+ }
+ print Socket " | 1)
+ {
+ print Socket "COLSPAN=\"$max_c\"";
+ }
+ print Socket ">\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 = "";
+ $rcolor_end = "";
+ } elsif ($rt eq 'm') {
+ $rcolor = "";
+ $rcolor_end = "";
+ } else {
+ $rcolor = $rcolor_end = '';
+ }
+
+ if ($hour == 24)
+ {
+ $sthour = -1;
+ $sttime = "";
+ }
+ else
+ {
+ $sthour = $hour;
+ $sttime = "".format_time($hour, $min)." - ".format_time(int($hour + ($min + $lengthmin)/60) % 24, ($min + $lengthmin) % 60)." ";
+ }
+
+ print Socket '| ";
+ }
+ print Socket format_hour_padded ($hour);
+ if ($::READ_ONLY ne 'true') {
+ print Socket "\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 = "";
+ $rcolor_end = "";
+ } elsif ($rt eq 'm') {
+ $rcolor = "";
+ $rcolor_end = "";
+ } else {
+ $rcolor = $rcolor_end = '';
+ }
+ print Socket ' | {'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 "\n\n";
+ print Socket "| ".__("Tâche le")." ", pd_event_date ($rt, $startyear, $startweek, $startwday, $duration);
+ print Socket "\n |
|---|
\n";
+ my ($stk1, $stk2) = $strike ? ("","") : ("","");
+ if ($hour == -1)
+ {
+ printf Socket "$stk1$title$stk2";
+ }
+ else
+ {
+ printf Socket "$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 "", txt_alarm($alval, $altype, $alchk), "\n";
+ print Socket "$data\n";
+ print Socket " | \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 "",
+ "[".__("Editer")."]\n";
+ print Socket " ",
+ "[".__("Couper")."]\n";
+ print Socket " ",
+ "[".__("Copier")."]\n";
+ print Socket " ",
+ "[".__("Supprimer")."]\n";
+ print Socket " ",
+ "[$stk3]\n";
+ }
+ print Socket "\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 "\n";
+ print Socket "\n";
+
+ print Socket "\n";
+ print Socket "\n";
+
+}
+
+sub print_event_error_start () {
+ print Socket $::H_BODY;
+ print Socket "\n";
+ print Socket " \n
\n\n";
+}
+
+sub print_event_error_end () {
+ print Socket "
| \n\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 " \n";
+ print Socket " \n";
+ print Socket "\n";
+ print Socket "$error1\n";
+ print Socket "$error2\n | ";
+ print Socket " \n";
+ print Socket "\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 " Listing events failed: $alldata_ref\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 " \n \n \n";
+ print Socket " \n";
+ my $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
+ print Socket "$str\n";
+ print Socket "| \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 " |
|---|
| ".sprintf(__("Semaine %s"), $cweek).", ", pd_year_month_day ($cyear, $b_month, $b_day), " - ", pd_year_month_day ($cyear, $e_month, $e_day), "\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 " | ";
+ printf Socket "%s %s - %s\n",
+ __($::weekdays_short[$wday]),
+ format_time_padded ($hour1, $min1),
+ format_time_padded ($hour2, $min2);
+ print Socket "| ", $e{'title'}, " | ", $data || " ", "\n";
+ }
+ }
+ }
+ }
+ print Socket " | |
|---|
\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 " \n\n";
+ print Socket "| ".__("Autres vues")."";
+ print Socket "\n |
|---|
\n";
+ print Socket "\n";
+ print Socket "\n";
+ my $str = sprintf(__("Agendas %s"), $::ORGANIZATION);
+ my $st = strcal();
+ print Socket "- $str\n";
+ $str = sprintf(__("Tâches depuis la semaine %d de l'année %d"), $week, $year);
+ print Socket "
- $str";
+ print Socket "
| \n";
+ print Socket "\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 "- $str";
+ }
+ print Socket "
| \n";
+ print Socket "
\n";
+
+ print Socket "\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 "\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 "| %02d : %s | \n", $cweek, pd_month_day_padded ($cmonth, $cday);
+ } else {
+ printf Socket "%02d : %s | \n", $cweek, pd_month_day_padded ($cmonth, $cday);
+ }
+ $cweek++;
+ if ($cweek > 50) {
+ $cweek--;
+ ($cyear, $cweek) = get_next_year_week ($cyear, $cweek);
+ }
+ }
+ print Socket " \n";
+ }
+ print Socket " \n";
+
+ print Socket " | \n";
+ print Socket "\n\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 < $title
+
+END
+ return;
+}
+
+sub check_write_access () {
+ if ($::READ_ONLY eq 'true') {
+ print Socket $::H_BODY;
+ print Socket "\n";
+ print Socket "| This user has no write permission. | \n";
+ print Socket " \n";
+ print Socket "\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 "Redraw: Unknown view \"$view\".\n";
+ }
+ return;
+}
+
+sub create_users () {
+ my (@users, $user);
+
+ if (! chdir ($::DIRECTORY)) {
+ return "Can't change into directory $::DIRECTORY: $!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 = " \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'} = ' ';
+ $global_conf{'remote lang'} = 'en';
+ $global_conf{'remote mail'} = 'root';
+ $global_conf{'remote cal'} = 'all';
+
+ while () {
+ 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 , to make browsers happier.
+ if ($conf_ref->{'top left corner'} eq '') {
+ $conf_ref->{'top left corner'} = ' ';
+ }
+ $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 () {
+ 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 "got: '$value', correct is '$::PASSWORD'\n";
+ if ($value ne $::PASSWORD) {
+ print Socket " Invalid password\n";
+ return 0;
+ }
+ } elsif ($key eq '__user') {
+ $::USER = $value;
+ } elsif ($key eq '__gid') {
+ $::GID = $value;
+ } else {
+ print Socket " Unknown configuration option '$key'\n";
+ return 0;
+ }
+ }
+ }
+# print Socket " $::MY_URL\n";
+
+ # Make sure we received all the mandatory options
+ if (! $::USER) {
+ print Socket " 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 " Re-reading configureation failed: ", $$res, " - configuration not changed.\n";
+ } else {
+ $res = create_users ();
+ if ($res) {
+ print STDERR " 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 <{'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 '\n";
+ print Socket "";
+}
+
+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 "\n";
+ print Socket "| ";
+ print Socket __("Transfert Palm Pilot");
+ print Socket " |
|---|
\n";
+ print Socket "\n";
+ if ($::query->{'purge'})
+ {
+ clear_events($week, $year);
+ $str = sprintf(__("Agenda %s purgé jusqu'à la semaine %d de l'année %d"), ''.$::LONG_NAME.'', $week, $year);
+ print Socket "$str\n";
+ }
+ elsif ($::query->{'cancel'})
+ {
+ $str = sprintf(__("Purge de l'agenda %s annulée"), ''.$::LONG_NAME.'');
+ print Socket "$str\n";
+ }
+ else
+ {
+ print Socket "\n";
+ print Socket "".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 "\n";
+ print Socket " |
\n";
+ }
+ print Socket " | \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/
/\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." <);
+ $/ = $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 "$str\n";
+ print Socket $::H_BODY;
+
+ if (! chdir ($::DIRECTORY)) {
+ print Socket "Can't change into directory $::DIRECTORY: $!";
+ print Socket " Make sure it exists, and its permissions are as explained in file INSTALL of the Wcal distribution.";
+ exit (1);
+ }
+
+ print Socket " $str";
+ print Socket sprintf(__("Cliquez sur un calendrier ou sélectionnez les calendriers pour la %s"), ''.__("Fusion")."");
+ print Socket ''."\n";
+ print Socket " \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 ();
+ $/ = $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 "\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 () { chomp; last if /^$/; }; # Read environment to make cgi-proxy happy
+ print Socket $::H_BODY;
+ print Socket "Configuration has changed.";
+ print Socket "Re-reading configureation failed: ", $$config_result, " - configuration not changed.\n";
+ print Socket " Click me to go to the main view\n";
+ print Socket "\n";
+ next;
+ } else {
+ $res = create_users ();
+ if ($res) {
+ print Socket $::H_BODY;
+ print Socket " Configuration has changed.";
+ print Socket "Error creating new users: $res\n";
+ print Socket " Click me to go to the main view\n";
+ print Socket "\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 " Unknown command '$query_type'.\n";
+ }
+ undef $::query;
+
+ } continue {
+ print Socket " | |
';
+ }
+ else
+ {
+ return "";
+ }
+}
+sub img_note {
+ my ($data) = @_;
+ if ($data)
+ {
+ $data =~ s/
';
+ }
+ else
+ {
+ return "";
+ }
+}
+
+sub txt_alarm {
+ my ($val, $type, $chk) = @_;
+ if ($val)
+ {
+ my $col = ($chk ? "#00AA00" : "#FF0000");
+ return '![\"".__("Semaine](\"$::IMG_URL/left-arrow.gif\"){kind=icon}
\n";
+ print $cache_fh " ",sprintf(__("%s Semaine %s Année %s"),__($::months[$month]),$week,$year)," \n";
+ print $cache_fh "![\"".__("Semaine](\"$::IMG_URL/right-arrow.gif\"){kind=icon}