OSSP CVS Repository

ossp-pkg/changelog/changelog.cgi 1.1

---

#!/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>&nbsp;</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> &nbsp;<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> &nbsp;<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 &nbsp;&nbsp;$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|&|&amp;|sg;
        $str =~ s|<|&lt;|sg;
        $str =~ s|>|&gt;|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&nbsp;&nbsp;</font></td>" .
            "<td><font color=\"$tcolor\">$team&nbsp;&nbsp;</font></td>" .
            "<td><font color=\"$tcolor\">$person&nbsp;&nbsp;</font></td>" .
            "<td><font color=\"$tcolor\">$risk&nbsp;&nbsp;</font></td>" .
            "<td><font color=\"$tcolor\">$subject&nbsp;&nbsp;</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 &nbsp;&nbsp;$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 &copy; 2001-2002 Cable &amp; 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);

---