*** /dev/null Tue Apr 30 09:33:00 2024
--- - Tue Apr 30 09:34:13 2024
***************
*** 0 ****
--- 1,468 ----
+ #!/cw/bin/perl
+ ##
+ ## changelog.cgi -- Team ChangeLog Web-Interface
+ ## Copyright (c) 2001-2002 Ralf S. Engelschall <rse@engelschall.com>
+ ##
+
+ require 5.006;
+ use CGI; # standard in Perl 5.6
+ use POSIX; # standard in Perl 5.6
+
+ # unbuffered STDOUT
+ $|++;
+
+ # establish CGI query object
+ my $Q = new CGI;
+
+ # establish my configuration
+ my $MY = {};
+ $MY->{PROGNAME} = ($0 =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0];
+ $MY->{HEADER} = '';
+ open(FP, "<".$MY->{PROGNAME}.".head.html");
+ $MY->{HEADER} .= $_ while (<FP>);
+ close(FP);
+ $MY->{FOOTER} = '';
+ open(FP, "<".$MY->{PROGNAME}.".foot.html");
+ $MY->{FOOTER} .= $_ while (<FP>);
+ close(FP);
+
+ # general error handler
+ $SIG{__DIE__} = sub {
+ my ($err) = @_;
+ $err =~ s|\s+at\s+.*||s;
+ $err =~ s|\n|<br>\n|sg;
+ my $page = "Content-Type: text/html\n" .
+ "\n" .
+ $MY->{HEADER} .
+ "<h1>Application Services ChangeLog: ERROR</h1>\n" .
+ "<pre>$err</pre>\n" .
+ $MY->{FOOTER};
+ print STDOUT $page;
+ exit(0);
+ };
+
+ # database entry escaping
+ sub entry_escape {
+ my ($str) = @_;
+ $str =~ s/\|/\\x07/sg;
+ $str =~ s/\s+/ /sg;
+ return $str;
+ }
+
+ # database entry unescaping
+ sub entry_unescape {
+ my ($str) = @_;
+ $str =~ s/\\x07/\|/sg;
+ return $str;
+ }
+
+ # wildcard patter matching
+ sub wildmat {
+ my ($str, $pat) = @_;
+ $pat =~ s|\*|.*|sg;
+ $pat =~ s/\|/\\|/sg;
+ return ($str =~ m|^$pat$|s);
+ }
+
+ # remember some parameters via HTTP cookies for the user's convinience
+ my $cookies = [];
+ foreach $param (qw(a_team a_person v_team v_person v_display)) {
+ if ($Q->param($param) ne '' and ($Q->param($param) ne $Q->cookie($param))) {
+ push(@{$cookies}, $Q->cookie(
+ -name => $param,
+ -value => $Q->param($param),
+ -expires => '+1d',
+ -path => $Q->url(-absolute => 1),
+ -secure => 0
+ ));
+ }
+ if ($Q->param($param) eq '' and $Q->cookie($param) ne '') {
+ $Q->param(-name => $param, -value => [$Q->cookie($param)]);
+ }
+ }
+
+ # fetch HTTP GET/POST parameters
+ my $a_team = $Q->param('a_team') || 'is';
+ my $a_person = $Q->param('a_person') || '';
+ my $a_risk = $Q->param('a_risk') || 'low';
+ my $a_subject = $Q->param('a_subject') || '';
+ my $a_change = $Q->param('a_change') || '';
+ my $v_team = $Q->param('v_team') || '*';
+ my $v_person = $Q->param('v_person') || '*';
+ my $v_risk = $Q->param('v_risk') || '*';
+ my $v_subject = $Q->param('v_subject') || '*';
+ my $v_change = $Q->param('v_change') || '*';
+ my $v_start = $Q->param('v_start') || '0';
+ my $v_display = $Q->param('v_display') || '20';
+
+ # add a new ChangeLog entry
+ if ($Q->param('form') eq 'Add') {
+ # make sure the parameters really exists
+ foreach $param (qw(a_team a_person a_risk a_subject a_change)) {
+ if ($Q->param($param) eq '') {
+ die "Parameter <b>" . uc(substr($param,2,1)).substr($param,3). "</b> is empty";
+ }
+ }
+
+ # generate time stamp
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
+ my $time = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min);
+
+ # escape values
+ my $x_team = &entry_escape($a_team);
+ my $x_person = &entry_escape($a_person);
+ my $x_subject = &entry_escape($a_subject);
+ my $x_risk = &entry_escape($a_risk);
+ my $x_change = &entry_escape($a_change);
+
+ # read last entry from database
+ my $entry_last = "";
+ open(FP, "<".$MY->{PROGNAME}.".txt") || die "unable to read logfile";
+ $entry_last = $_ while (<FP>);
+ close(FP);
+
+ # generate new entry
+ my $entry = sprintf("%s|%s|%s|%s|%s|%s\n", $time, $x_team, $x_person, $x_risk, $x_subject, $x_change);
+
+ # make sure we do not accidently add an entry multiple times
+ # (this can happen if people press "RELOAD" in their browser
+ # immediately after adding an entry by pressing "ADD" before).
+ my $entry_now = $entry;
+ $entry_now =~ s/^[^|]+|//s;
+ $entry_last =~ s/^[^|]+|//s;
+ if ($entry_now eq $entry_last) {
+ die "Adding the last entry a second time is not allowed!";
+ }
+
+ # write new entry to database
+ open(FP, ">>".$MY->{PROGNAME}.".txt") || die "unable to write logfile";
+ printf FP $entry;
+ close(FP);
+
+ # reset values for subsequent processing
+ $Q->param(-name => 'a_subject', -value => '');
+ $Q->param(-name => 'a_change', -value => '');
+ $a_subject = '';
+ $a_change = '';
+ };
+
+ # start generating output page
+ my $page = '';
+ $page .= $Q->header (-cookie => $cookies, -expires => '+1s');
+ $page .= $MY->{HEADER};
+
+ $page .= "<table width=100% bgcolor=\"#000000\" cellspacing=0 cellpadding=0>\n";
+ $page .= "<tr>\n" .
+ "<td align=center>\n" .
+ "<a href=\"http://as.de.cw.net/changelog.cgi\">" .
+ "<img src=\"changelog.logo.png\" border=0>" .
+ "</a>" .
+ "</td>\n" .
+ "</tr>\n" .
+ "<tr>\n" .
+ "<td>\n";
+
+ $page .= "<table width=100% cellspacing=0 cellpadding=0 border=0>\n";
+
+ $page .= "<tr>\n" .
+ "<td><img src=\"changelog.1x1.gif\" width=140 height=1></td>" .
+ "<td><img src=\"changelog.1x1.gif\" width=10 height=1></td>" .
+ "<td><img src=\"changelog.1x1.gif\" width=10 height=1></td>" .
+ "<td><img src=\"changelog.1x1.gif\" width=10 height=1></td>" .
+ "<td><img src=\"changelog.1x1.gif\" width=10 height=1></td>" .
+ "<td><img src=\"changelog.1x1.gif\" width=10 height=1></td>" .
+ "</tr>\n";
+
+ $page .= "<tr bgcolor=\"#666699\">\n" .
+ "<td> </td>" .
+ "<td><font color=\"#e0e0ff\">Team</font></td>" .
+ "<td><font color=\"#e0e0ff\">Person</font></td>" .
+ "<td><font color=\"#e0e0ff\">Risk</font></td>" .
+ "<td><font color=\"#e0e0ff\">Subject</font></td>" .
+ "<td><font color=\"#e0e0ff\">Change</font></td>" .
+ "</tr>\n";
+
+ # generate "ADD" form
+ $page .= $Q->startform( -method => "POST", -action => $Q->url()) .
+ "<tr bgcolor=\"#9999cc\">\n" .
+ "<td align=right>" .
+ "<b>" . $Q->submit(-name => 'form', -value => 'Add') . "</b>" .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'a_team',
+ -values => ['is', 'hosting', 'development', 'database'],
+ -default => $a_team
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'a_person',
+ -values => ['',
+ 'peter',
+ 'cschug', 'rse', 'cbotta',
+ 'mhendel', 'pbrudna', 'awaegner', 'kgruber', 'rohde', 'scholli', 'msander', 'cmuschio',
+ 'tlottere', 'psmej', 'mschloh',
+ 'sgans', 'cscheith', 'sgierth', 'asikeler',
+ ],
+ -default => $a_person
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'a_risk',
+ -values => ['high', 'low'],
+ -default => $a_risk
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->textfield(
+ -name => 'a_subject',
+ -default => $a_subject,
+ -size => 20,
+ -maxlength => 80
+ ) .
+ "</td>" .
+ "<td>" .
+ "<table cellspacing=0 cellpadding=0><tr><td>" .
+ $Q->textfield(
+ -name => 'a_change',
+ -default => $a_change,
+ -size => 50,
+ -maxlength => 200
+ ) .
+ "</td>" .
+ "</tr></table>" .
+ "</td>" .
+ "</tr>\n" .
+ $Q->endform;
+
+ # generate "VIEW" form
+ $page .= $Q->startform(-method => "GET", -action => $Q->url()) .
+ "<tr bgcolor=\"#666699\">\n" .
+ "<td align=right>" .
+ $Q->textfield(
+ -name => 'v_display',
+ -default => $v_display,
+ -size => 2,
+ -maxlength => 3
+ ) .
+ "<b>" . $Q->submit(-name => 'form', -value => 'View') . "</b>" .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'v_team',
+ -values => ['*', 'is', 'hosting', 'development', 'database'],
+ -default => $v_team
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'v_person',
+ -values => ['*',
+ 'peter',
+ 'cschug', 'rse', 'cbotta',
+ 'mhendel', 'pbrudna', 'awaegner', 'kgruber', 'rohde', 'scholli', 'msander', 'cmuschio',
+ 'tlottere', 'psmej', 'mschloh',
+ 'sgans', 'cscheith', 'sgierth', 'asikeler',
+ ],
+ -default => $v_person
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->popup_menu(
+ -name => 'v_risk',
+ -values => ['*', 'high', 'low'],
+ -default => $v_risk
+ ) .
+ "</td>" .
+ "<td>" .
+ $Q->textfield(
+ -name => 'v_subject',
+ -default => $v_subject,
+ -size => 20,
+ -maxlength => 80
+ ) .
+ "</td>" .
+ "<td>" .
+ "<table cellspacing=0 cellpadding=0><tr><td>" .
+ $Q->textfield(
+ -name => 'v_change',
+ -default => $v_change,
+ -size => 50,
+ -maxlength => 200
+ ) .
+ "</td>" .
+ "</tr></table>" .
+ "</td>" .
+ "</tr>\n" .
+ $Q->endform;
+
+ # read database
+ my $changelog = '';
+ open(FP, "<".$MY->{PROGNAME}.".txt") || die "reading";
+ $changelog .= $_ while (<FP>);
+ close(FP);
+
+ # reverse order of entries
+ my @changelog = reverse(split(/\n/, $changelog));
+
+ # calculate number of entries
+ my $db_entries = $#changelog + 1;
+
+ # restrict according to selected view
+ my @changelog_view = ();
+ foreach $line (@changelog) {
+ next if ($line eq '');
+ my ($time, $team, $person, $risk, $subject, $change) = split(/(?<!\\)\|/, $line);
+ $team = &entry_unescape($team);
+ $person = &entry_unescape($person);
+ $subject = &entry_unescape($subject);
+ $risk = &entry_unescape($risk);
+ $change = &entry_unescape($change);
+ if ( &wildmat($team, $v_team)
+ and &wildmat($person, $v_person)
+ and &wildmat($subject, $v_subject)
+ and &wildmat($risk, $v_risk)
+ and &wildmat($change, $v_change)) {
+ push(@changelog_view, $line);
+ }
+ }
+ @changelog = @changelog_view;
+
+ # determine view window
+ my $numdisplay = (($v_display >= 1 and $v_display <= 999) ? $v_display : 20);
+ my $prev = ($v_start - $numdisplay);
+ $prev = 0 if ($prev < 0);
+ my $next = ($v_start + $numdisplay);
+ $next = ($#changelog - $numdisplay) if ($next > ($#changelog-$numdisplay));
+ $next = 0 if ($next < 0);
+ if ($#changelog > 0) {
+ $prev_percent = sprintf("%d", ($v_start / $#changelog) * 100);
+ $next_percent = sprintf("%d", (($#changelog-$next) / $#changelog) * 100);
+ }
+ else {
+ $prev_percent = 0;
+ $next_percent = 0;
+ }
+
+ # determine navigation links
+ my $nav_prev = "<a href=\"".$Q->url(-relative => 1)."?v_start=$prev"."\"><img src=\"changelog.prev.png\" border=0></a> <font color=\"#cccccc\">($prev_percent\%)</font>";
+ $nav_prev = "" if ($v_start == 0);
+ my $nav_next = "<a href=\"".$Q->url(-relative => 1)."?v_start=$next"."\"><img src=\"changelog.next.png\" border=0></a> <font color=\"#cccccc\">($next_percent\%)</font>";
+ $nav_next = "" if ($v_start == ($#changelog - $numdisplay) or $next == 0);
+
+ # restrict to view window
+ @changelog = @changelog[$v_start .. ($v_start + $numdisplay)];
+
+ $page .= "<tr bgcolor=\"#000000\">\n" .
+ "<td><font color=\"#ffffff\">Time $nav_prev</font></td>" .
+ "<td><font color=\"#ffffff\">Team</font></td>" .
+ "<td><font color=\"#ffffff\">Person</font></td>" .
+ "<td><font color=\"#ffffff\">Risk</font></td>" .
+ "<td><font color=\"#ffffff\">Subject</font></td>" .
+ "<td><font color=\"#ffffff\">Change</font></td>" .
+ "</tr>\n";
+
+ my $first = ($v_start == 0);
+ my $cnt = 0;
+ my $col = {
+ 'low' => ['#f0f0f0', '#ffffff'],
+ 'high' => ['#f0f0f0', '#ffffff'],
+ };
+ my $datenext = '';
+ foreach $line (@changelog) {
+ next if ($line eq '');
+ my ($time, $team, $person, $risk, $subject, $change) = split(/\|/, $line);
+ $team = &entry_unescape($team);
+ $person = &entry_unescape($person);
+ $subject = &entry_unescape($subject);
+ $risk = &entry_unescape($risk);
+ $change = &entry_unescape($change);
+
+ my $color = $col->{$risk}->[$cnt];
+ my $date = $time;
+ $date =~ s|/.*$||s;
+ if ($datenext ne $date) {
+ sub weekday {
+ my ($date) = @_;
+ my ($y, $m, $d) = ($date =~ m|^(\d{4})-(\d{2})-(\d{2})|s);
+ my $t = mktime(0, 0, 0, $d, $m-1, $y-1900, 0, 0, 0);
+ my $wday = (localtime($t))[6];
+ $wday = 7 if ($wday == 0); # Sun
+ return $wday;
+ }
+ if (&weekday($datenext) < &weekday($date)) {
+ $page .= "<tr height=2 bgcolor=\"#000000\">" .
+ "<td colspan=6 height=2><img src=\"changelog.1x1.gif\" width=400 height=1></td>" .
+ "</tr>\n";
+ }
+ else {
+ $page .= "<tr height=1 bgcolor=\"#cccccc\">" .
+ "<td colspan=6 height=1><img src=\"changelog.1x1.gif\" width=400 height=1></td>" .
+ "</tr>\n";
+ }
+ $datenext = $date;
+ }
+ sub html_escape {
+ my ($str) = @_;
+ $str =~ s|&|&|sg;
+ $str =~ s|<|<|sg;
+ $str =~ s|>|>|sg;
+ return $str;
+ }
+ $team = &html_escape($team);
+ $person = &html_escape($person);
+ $subject = &html_escape($subject);
+ $risk = &html_escape($risk);
+ $change = &html_escape($change);
+ if ($first) {
+ $first = 0;
+ $color = "#e0e0ff";
+ }
+ my $tcolor = "#000000";
+ if ($risk eq 'high') {
+ $tcolor = "#333399";
+ $risk = "<font color=\"#cc3333\"><b>$risk</b></font>";
+ }
+ $page .= "<tr bgcolor=\"".$color."\">" .
+ "<td><font color=\"$tcolor\">$time </font></td>" .
+ "<td><font color=\"$tcolor\">$team </font></td>" .
+ "<td><font color=\"$tcolor\">$person </font></td>" .
+ "<td><font color=\"$tcolor\">$risk </font></td>" .
+ "<td><font color=\"$tcolor\">$subject </font></td>" .
+ "<td width=100%><font color=\"$tcolor\">$change</font></td>" .
+ "</tr>\n";
+ $cnt = (($cnt+1) % 2);
+ }
+
+ $page .= "<tr bgcolor=\"#000000\">\n" .
+ "<td><font color=\"#ffffff\">Time $nav_next</font></td>" .
+ "<td><font color=\"#ffffff\">Team</font></td>" .
+ "<td><font color=\"#ffffff\">Person</font></td>" .
+ "<td><font color=\"#ffffff\">Risk</font></td>" .
+ "<td><font color=\"#ffffff\">Subject</font></td>" .
+ "<td><font color=\"#ffffff\">Change</font></td>" .
+ "</tr>\n";
+
+ $page .= "</table>\n";
+
+ $page .= "</td>\n" .
+ "</tr>\n";
+
+ $page .= "<tr bgcolor=\"#666699\">" .
+ "<td align=center>" .
+ "<font color=\"#e0e0ff\">" .
+ "Copyright © 2001-2002 Cable & Wireless Deutschland GmbH<br>" .
+ "Database: <b>$db_entries</b> entries, <a href=\"changelog.txt\">raw</a> version" .
+ "</font>" .
+ "</td>\n";
+
+ $page .= "</tr>\n" .
+ "</table>\n";
+
+ $page .= $MY->{FOOTER};
+
+ print STDOUT $page;
+ exit(0);
+
|
