web/cgi-bin/cvslog.cgi

#!/usr/bin/perl -w

# TODO: remove tables, and use CSS instead

use CGI;
$query=new CGI;
my($period)=$query->param('period');
$period = "today" unless defined $period;
my($modulelist)=$query->param('module');
my $moduleext=""; $moduleext=":$modulelist" if defined $modulelist;

my($firstdate);
if($period eq "days") {
    my($days)=$query->param('days');
    $days = 1 unless defined $days;
    if ($days < 1) {$days = 1};
    $heading = "i-scream CVS$moduleext commits in the past $days day(s)";
    $days--;
    $firstdate = ">" . `/bin/date -v-${days}d +%Y/%m/%d`;
}
elsif($period eq "date") {
    my($date)=$query->param('date');
    $date = `/bin/date +%Y/%m/%d` unless defined $date;
    $heading = "i-scream CVS$moduleext commits on $date";
    $firstdate = "$date 00:00<$date 23:59"
}
elsif($period eq "since") {
    my($date)=$query->param('date');
    $date = `/bin/date +%Y/%m/%d` unless defined $date;
    $heading = "i-scream CVS$moduleext commits since $date";
    $firstdate = ">$date";
}
elsif($period eq "thisweek") {
    $firstdate = ">last Sunday";
    $heading = "i-scream CVS$moduleext commits this week";
}
else {
    # default to "today only"
    $firstdate = ">" . `/bin/date +%Y/%m/%d`;
    $heading = "Today's i-scream CVS$moduleext commits";
}

my($cvsroot) = "/cvs/i-scream";

$modulelist = `ls $cvsroot` unless defined $modulelist;
$modulelist =~ s/[\r\n]/ /gm;

my($cvs2clpath) = "/usr/local/bin/cvs2cl";
my($cvs2clargs) = "--stdout --no-wrap --no-common-dir -r -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
my($updatecmd) = "/home/iscream/bin/fullcvsupdate.sh $modulelist";
my($logcmd) = "cd /tmp/i-scream/cvstmp && $cvs2clpath $cvs2clargs";

my ($menu) = "../nwww/menu.inc" ;
my ($header) = "../nwww/header.inc";
my ($footer) = "../nwww/footer.inc";
my ($style) = "../nwww/style.inc";

print "Content-type: text/html\n\n";

print <<"END";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html>

<head>
 <title>i-scream CVS Commit Logs</title>
END

&print_html($style);

print <<"END";
</head>

<body>

<div id="container">

<div id="main">
END

&print_html($header);

print <<"END";
<div id="contents">
<h1 class="top">i-scream CVS Commit Logs</h1>

<h2>$heading</h2>
END

print `$updatecmd >/dev/null 2>&1`;

my(@modules) = split (/\s+/, $modulelist);

foreach my $module (@modules) {

    print "<table border=\"0\" bgcolor=\"#000066\" cellpadding=\"5\" width=\"100%\">\n\n";
    print "<tr><td>\n<font size=\"4\"><b><a href=\"http://cvs.i-scream.org/$module/\" style=\"color: white\">$module module</a></b></font>\n</td></tr>\n\n";
    print "<tr><td bgcolor=\"white\">\n";

    my(@lines) = `$logcmd $module 2>&1`;
    if(@lines == 0) {
        print "There have been no commits in this module during this period.\n";
    }
    else {
        foreach my $line (@lines) {

            if ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)\s+<([^\s]+)>$/) {
                print "\n<font color=\"blue\">\n<b>";
                print HTML_encode($1);
                print "</b>\n<i>";
                print " committed by <a href=\"mailto:$3\" style=\"text-decoration: none;\">";
                print HTML_encode("$2");
                print "</a></i>\n</font>\n"
            }
            elsif ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)$/) {
                print "\n<font color=\"blue\">\n<b>";
                print HTML_encode($1);
                print "</b>\n<i>";
                print " committed by ";
                print HTML_encode("$2");
                print "</i>\n</font>\n"
            }
            elsif($line =~ /([^\s]+) (\([^,^\)]+(,[^\)]+)?\))([,:])/) {
                my ($file, $rev, $tags, $ext) = ($1, $2, $3, $4);
                print "<code>";
                print "<a href=\"http://cvs.i-scream.org/$file\" style=\"text-decoration: none;\">";
                print HTML_encode($file);
                print "</a> ";
                if($rev =~ /\(([^\s]+)\.(\d+)(.*)\)/) {
                    my $start = $1;
                    my $end = $2;
                    my $other = $3;
                    my $newrev = "$start.$end";
                    my $oldrev;
                    if($end != 1) {
                        my $oldminver = $end-1;
                        $oldrev = "$start.$oldminver";
                    }
                    elsif($start =~ /^((\d+\.)+)(\d+)$/) {
                        $oldrev = $1;
                        # take trailing . off old revision
                        chop $oldrev;
                    }
                    if(defined $oldrev) {
                        my $diff = ".diff?r1=$oldrev&r2=$newrev";
                        print "(<a href=\"http://cvs.i-scream.org/$file$diff\" style=\"text-decoration: none;\">";
                        print HTML_encode("$start.$end");
                        print "</a>";
                        print HTML_encode("$other)");
                    }
                    else {
                        print HTML_encode($rev);
                    }
                }
                else {
                    print HTML_encode($rev);
                }
                print HTML_encode($ext);
                print "</code><br/>\n"
            }
            else {
                chomp $line;
                print "<code>";
                print HTML_encode($line);
                print "</code><br/>\n"
            }
        }
    }
    print "</td></tr>\n";

    print "</table><p>\n\n";
}

print "</div>";

&print_html($footer);

print "</div>";

&print_html($menu);

print <<"END";
</div>

</body>
</html>
END

exit 0;

#------------------------------------------------------
# sub HTML_encode
#
# escape HTML characters that may cause problems when
# shown either in the <body> or within text fields.
#------------------------------------------------------
sub HTML_encode ($){
    my ($encoded) = @_;
    $encoded =~ s/&/&amp;/g;
    $encoded =~ s/"/&quot;/g;
    $encoded =~ s/</&lt;/g;
    $encoded =~ s/>/&gt;/g;
    return $encoded;
}

# Print a file without escaping HTML: -
sub print_html ($) {
    my ($filename) = @_;
    print `cat $filename 2>&1`;
}
Revision:	1.30
Committed:	Sun Mar 21 23:59:32 2004 UTC (20 years, 9 months ago) by tdb
Branch:	MAIN
Changes since 1.29:	+32 -25 lines
Log Message:	Commit new website. The old site is tagged, so this won't change the live site... but it does move HEAD on to the new site. Too many changes to list really. General points are: - Moved to a XHTML CSS compliant site. - Reorganised the site into a more multi-project based look. - Removed a lot of cruft. Still to do: - Fix all the zillions of bugs stopping the whole site from validating :-) - Tidy up the HTML in terms of layout and indentation. Thanks to AJ for his help this weekend in doing this.
#	User	Rev	Content
1	tdb	1.5	#!/usr/bin/perl -w
2
3	tdb	1.30	# TODO: remove tables, and use CSS instead
4
5	tdb	1.5	use CGI;
6			$query=new CGI;
7			my($period)=$query->param('period');
8			$period = "today" unless defined $period;
9	tdb	1.16	my($modulelist)=$query->param('module');
10			my $moduleext=""; $moduleext=":$modulelist" if defined $modulelist;
11	tdb	1.5
12			my($firstdate);
13			if($period eq "days") {
14			my($days)=$query->param('days');
15			$days = 1 unless defined $days;
16			if ($days < 1) {$days = 1};
17	tdb	1.16	$heading = "i-scream CVS$moduleext commits in the past $days day(s)";
18	tdb	1.5	$days--;
19	tdb	1.26	$firstdate = ">" . `/bin/date -v-${days}d +%Y/%m/%d`;
20	tdb	1.16	}
21			elsif($period eq "date") {
22			my($date)=$query->param('date');
23	tdb	1.25	$date = `/bin/date +%Y/%m/%d` unless defined $date;
24	tdb	1.16	$heading = "i-scream CVS$moduleext commits on $date";
25			$firstdate = "$date 00:00<$date 23:59"
26	tdb	1.5	}
27	tdb	1.18	elsif($period eq "since") {
28			my($date)=$query->param('date');
29	tdb	1.25	$date = `/bin/date +%Y/%m/%d` unless defined $date;
30	tdb	1.18	$heading = "i-scream CVS$moduleext commits since $date";
31			$firstdate = ">$date";
32			}
33	tdb	1.5	elsif($period eq "thisweek") {
34	tdb	1.16	$firstdate = ">last Sunday";
35			$heading = "i-scream CVS$moduleext commits this week";
36	tdb	1.5	}
37			else {
38	tdb	1.16	# default to "today only"
39	tdb	1.25	$firstdate = ">" . `/bin/date +%Y/%m/%d`;
40	tdb	1.16	$heading = "Today's i-scream CVS$moduleext commits";
41	tdb	1.5	}
42	tdb	1.1
43	tdb	1.10	my($cvsroot) = "/cvs/i-scream";
44
45			$modulelist = `ls $cvsroot` unless defined $modulelist;
46	tdb	1.17	$modulelist =~ s/[\r\n]/ /gm;
47	tdb	1.1
48	tdb	1.25	my($cvs2clpath) = "/usr/local/bin/cvs2cl";
49	tdb	1.28	my($cvs2clargs) = "--stdout --no-wrap --no-common-dir -r -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
50	tdb	1.25	my($updatecmd) = "/home/iscream/bin/fullcvsupdate.sh $modulelist";
51			my($logcmd) = "cd /tmp/i-scream/cvstmp && $cvs2clpath $cvs2clargs";
52	tdb	1.13
53	tdb	1.30	my ($menu) = "../nwww/menu.inc" ;
54			my ($header) = "../nwww/header.inc";
55			my ($footer) = "../nwww/footer.inc";
56			my ($style) = "../nwww/style.inc";
57	tdb	1.1
58	tdb	1.10	print "Content-type: text/html\n\n";
59
60	tdb	1.1	print <<"END";
61	tdb	1.30	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
62			"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
63	tdb	1.1
64			<html>
65
66			<head>
67	tdb	1.30	<title>i-scream CVS Commit Logs</title>
68			END
69
70			&print_html($style);
71
72			print <<"END";
73	tdb	1.1	</head>
74
75	tdb	1.30	<body>
76
77			<div id="container">
78	tdb	1.1
79	tdb	1.30	<div id="main">
80	tdb	1.13	END
81
82	tdb	1.30	&print_html($header);
83	tdb	1.12
84			print <<"END";
85	tdb	1.30	<div id="contents">
86			<h1 class="top">i-scream CVS Commit Logs</h1>
87	tdb	1.12
88	tdb	1.8	<h2>$heading</h2>
89	tdb	1.5	END
90	tdb	1.1
91	tdb	1.22	print `$updatecmd >/dev/null 2>&1`;
92	tdb	1.9
93	tdb	1.5	my(@modules) = split (/\s+/, $modulelist);
94
95			foreach my $module (@modules) {
96
97	tdb	1.11	print "<table border=\"0\" bgcolor=\"#000066\" cellpadding=\"5\" width=\"100%\">\n\n";
98	tdb	1.30	print "<tr><td>\n<font size=\"4\"><b><a href=\"http://cvs.i-scream.org/$module/\" style=\"color: white\">$module module</a></b></font>\n</td></tr>\n\n";
99	tdb	1.8	print "<tr><td bgcolor=\"white\">\n";
100	tdb	1.5
101			my(@lines) = `$logcmd $module 2>&1`;
102			if(@lines == 0) {
103	tdb	1.8	print "There have been no commits in this module during this period.\n";
104	tdb	1.5	}
105			else {
106			foreach my $line (@lines) {
107	tdb	1.7
108	tdb	1.16	if ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)\s+<([^\s]+)>$/) {
109			print "\n<font color=\"blue\">\n<b>";
110	tdb	1.7	print HTML_encode($1);
111	tdb	1.16	print "</b>\n<i>";
112	tdb	1.27	print " committed by <a href=\"mailto:$3\" style=\"text-decoration: none;\">";
113	tdb	1.16	print HTML_encode("$2");
114			print "</a></i>\n</font>\n"
115			}
116	tdb	1.20	elsif ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)$/) {
117			print "\n<font color=\"blue\">\n<b>";
118			print HTML_encode($1);
119			print "</b>\n<i>";
120	tdb	1.27	print " committed by ";
121	tdb	1.20	print HTML_encode("$2");
122			print "</i>\n</font>\n"
123			}
124	tdb	1.29	elsif($line =~ /([^\s]+) (\([^,^\)]+(,[^\)]+)?\))([,:])/) {
125			my ($file, $rev, $tags, $ext) = ($1, $2, $3, $4);
126	tdb	1.16	print "<code>";
127	tdb	1.25	print "<a href=\"http://cvs.i-scream.org/$file\" style=\"text-decoration: none;\">";
128	tdb	1.16	print HTML_encode($file);
129			print "</a> ";
130	tdb	1.29	if($rev =~ /\(([^\s]+)\.(\d+)(.*)\)/) {
131	tdb	1.25	my $start = $1;
132			my $end = $2;
133			my $other = $3;
134			my $newrev = "$start.$end";
135			my $oldrev;
136			if($end != 1) {
137			my $oldminver = $end-1;
138			$oldrev = "$start.$oldminver";
139			}
140			elsif($start =~ /^((\d+\.)+)(\d+)$/) {
141			$oldrev = $1;
142			# take trailing . off old revision
143			chop $oldrev;
144			}
145			if(defined $oldrev) {
146	tdb	1.16	my $diff = ".diff?r1=$oldrev&r2=$newrev";
147	tdb	1.25	print "(<a href=\"http://cvs.i-scream.org/$file$diff\" style=\"text-decoration: none;\">";
148			print HTML_encode("$start.$end");
149	tdb	1.16	print "</a>";
150	tdb	1.25	print HTML_encode("$other)");
151	tdb	1.16	}
152			else {
153	tdb	1.29	print HTML_encode($rev);
154	tdb	1.16	}
155			}
156			else {
157	tdb	1.29	print HTML_encode($rev);
158	tdb	1.16	}
159			print HTML_encode($ext);
160	tdb	1.30	print "</code><br/>\n"
161	tdb	1.7	}
162			else {
163	tdb	1.29	chomp $line;
164	tdb	1.7	print "<code>";
165			print HTML_encode($line);
166	tdb	1.30	print "</code><br/>\n"
167	tdb	1.7	}
168	tdb	1.5	}
169			}
170	tdb	1.8	print "</td></tr>\n";
171	tdb	1.1
172	tdb	1.7	print "</table><p>\n\n";
173	tdb	1.1	}
174
175	tdb	1.30	print "</div>";
176
177			&print_html($footer);
178
179			print "</div>";
180
181			&print_html($menu);
182	tdb	1.13
183	tdb	1.1	print <<"END";
184	tdb	1.30	</div>
185	tdb	1.7
186	tdb	1.1	</body>
187			</html>
188			END
189
190			exit 0;
191
192			#------------------------------------------------------
193			# sub HTML_encode
194			#
195			# escape HTML characters that may cause problems when
196			# shown either in the <body> or within text fields.
197			#------------------------------------------------------
198			sub HTML_encode ($){
199			my ($encoded) = @_;
200			$encoded =~ s/&/&/g;
201			$encoded =~ s/"/"/g;
202			$encoded =~ s/</</g;
203			$encoded =~ s/>/>/g;
204			return $encoded;
205	tdb	1.13	}
206
207			# Print a file without escaping HTML: -
208			sub print_html ($) {
209			my ($filename) = @_;
210			print `cat $filename 2>&1`;
211	tdb	1.1	}