web/cgi-bin/cvslog.cgi

#!/usr/bin/perl -w

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 = ">" . `date --date \"$days days ago\" \"+%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) = "/home/sites/www.i-scream.org.uk/bin/cvs2cl2.pl";
#my($cvs2clargs) = "--stdout --no-wrap -r -b -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
my($cvs2clargs) = "--stdout --no-wrap -r -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
my($updatecmd) = "/home/sites/www.i-scream.org.uk/bin/fullcvsupdate.sh $modulelist";
my($logcmd) = "cd /home/sites/www.i-scream.org.uk/cvsscripttemp && $cvs2clpath $cvs2clargs";

my ($left) = "../left.inc" ;
my ($title) = "../title.inc";
my ($bottom) = "../bottom.inc";

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

print <<"END";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">

<html>

<head>
 <title>The i-scream Project Commit Log</title>
</head>

<body bgcolor="#ffffff" link="#0000ff" alink="#3333cc" vlink="#3333cc" text="#000066">

<table border="0" cellpadding="2" cellspacing="2">
 <tr>
  <td valign="top">
END

&print_html($left);

print <<"END";
  </td>
  <td valign="top">
END

&print_html($title);

print <<"END";
<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=\"/cgi-bin/cvs/viewcvs.cgi/$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 " commited 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 " commited by ";
                print HTML_encode("$2");
                print "</i>\n</font>\n"
            }
            elsif($line =~ /(\S+) (\(\S+\))([,:])/ || $line =~ /(\S+) (\(\S+,\s+\S+\))([,:])/) {
                #chop $line;
                my ($file, $rest, $ext) = ($1, $2, $3);
                print "<code>";
                print "<a href=\"/cgi-bin/cvs/viewcvs.cgi/$file\" style=\"text-decoration: none;\">";
                print HTML_encode($file);
                print "</a> ";
                if($rest =~ /\((\S+)\.(\d+)(.*)\)/) {
                    my $newrev = "$1.$2";
                    my $oldminver = $2-1;
                    my $oldrev = "$1.$oldminver";
                    if($2 != 1) {
                        my $diff = ".diff?r1=$oldrev&r2=$newrev";
                        print "(<a href=\"/cgi-bin/cvs/viewcvs.cgi/$file$diff\" style=\"text-decoration: none;\">";
                        print HTML_encode("$1.$2");
                        print "</a>";
                        print HTML_encode("$3)");
                    }
                    else {
                        print HTML_encode($rest);
                    }
                }
                else {
                    print HTML_encode($rest);
                }
                print HTML_encode($ext);
                print "</code><br>\n"
            }
            else {
                chop $line;
                print "<code>";
                print HTML_encode($line);
                print "</code><br>\n"
            }
        }
    }
    print "</td></tr>\n";

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

&print_html($bottom);

print <<"END";

  </td>
 </tr>
</table>

</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.23
Committed:	Mon Mar 3 15:30:59 2003 UTC (21 years, 2 months ago) by tdb
Branch:	MAIN
Branch point for:	I-SCREAM_ORG
Changes since 1.22:	+0 -0 lines
Log Message:	Nothing changed, I just want to log a relevant change... This is the latest modification to cvs2cl, revision 2.38. This is an old and outdatted version of cvs2cl, but it's what we're using right now. I've got rid of unanimous tags in this change. The patch given below is a complete diff from 2.38. 777c777,778 < $files = wrap ("\t", " ", "$files"); --- > # tdb: no-wrap shouldn't wrap ANYTHING! > #$files = wrap ("\t", " ", "$files"); 934c935,936 < if ((scalar (@qunkrefs)) > 1) --- > # tdb: hacked to turn off the commondir feature > if ((scalar (@qunkrefs)) < 0) 978c980,981 < my $everyone_has_this_tag = 1; --- > # tdb: we don't want to have unanimous tags > my $everyone_has_this_tag = 0; 1126c1129,1130 < $beauty .= ", "; --- > # tdb: hacked to put a newline after each one > $beauty .= ",\n"; 1175c1179,1180 < $beauty = "* $beauty:"; --- > # tdb: hacked to remove the prefixed * > $beauty = "$beauty:";
#	User	Rev	Content
1	tdb	1.5	#!/usr/bin/perl -w
2
3			use CGI;
4			$query=new CGI;
5			my($period)=$query->param('period');
6			$period = "today" unless defined $period;
7	tdb	1.16	my($modulelist)=$query->param('module');
8			my $moduleext=""; $moduleext=":$modulelist" if defined $modulelist;
9	tdb	1.5
10			my($firstdate);
11			if($period eq "days") {
12			my($days)=$query->param('days');
13			$days = 1 unless defined $days;
14			if ($days < 1) {$days = 1};
15	tdb	1.16	$heading = "i-scream CVS$moduleext commits in the past $days day(s)";
16	tdb	1.5	$days--;
17	tdb	1.16	$firstdate = ">" . `date --date \"$days days ago\" \"+%Y/%m/%d\"`;
18			}
19			elsif($period eq "date") {
20			my($date)=$query->param('date');
21			$date = `/bin/date \"+%Y/%m/%d\"` unless defined $date;
22			$heading = "i-scream CVS$moduleext commits on $date";
23			$firstdate = "$date 00:00<$date 23:59"
24	tdb	1.5	}
25	tdb	1.18	elsif($period eq "since") {
26			my($date)=$query->param('date');
27			$date = `/bin/date \"+%Y/%m/%d\"` unless defined $date;
28			$heading = "i-scream CVS$moduleext commits since $date";
29			$firstdate = ">$date";
30			}
31	tdb	1.5	elsif($period eq "thisweek") {
32	tdb	1.16	$firstdate = ">last Sunday";
33			$heading = "i-scream CVS$moduleext commits this week";
34	tdb	1.5	}
35			else {
36	tdb	1.16	# default to "today only"
37			$firstdate = ">" . `/bin/date \"+%Y/%m/%d\"`;
38			$heading = "Today's i-scream CVS$moduleext commits";
39	tdb	1.5	}
40	tdb	1.1
41	tdb	1.10	my($cvsroot) = "/cvs/i-scream";
42
43			$modulelist = `ls $cvsroot` unless defined $modulelist;
44	tdb	1.17	$modulelist =~ s/[\r\n]/ /gm;
45	tdb	1.1
46	tdb	1.16	my($cvs2clpath) = "/home/sites/www.i-scream.org.uk/bin/cvs2cl2.pl";
47	tdb	1.21	#my($cvs2clargs) = "--stdout --no-wrap -r -b -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
48			my($cvs2clargs) = "--stdout --no-wrap -r -t -w -S -U $cvsroot/CVSROOT/users -l \"-d'$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\"";
49	tdb	1.10	my($updatecmd) = "/home/sites/www.i-scream.org.uk/bin/fullcvsupdate.sh $modulelist";
50	tdb	1.5	my($logcmd) = "cd /home/sites/www.i-scream.org.uk/cvsscripttemp && $cvs2clpath $cvs2clargs";
51	tdb	1.13
52			my ($left) = "../left.inc" ;
53			my ($title) = "../title.inc";
54			my ($bottom) = "../bottom.inc";
55	tdb	1.1
56	tdb	1.10	print "Content-type: text/html\n\n";
57
58	tdb	1.1	print <<"END";
59			<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
60
61			<html>
62
63			<head>
64	tdb	1.7	<title>The i-scream Project Commit Log</title>
65	tdb	1.1	</head>
66
67	tdb	1.14	<body bgcolor="#ffffff" link="#0000ff" alink="#3333cc" vlink="#3333cc" text="#000066">
68	tdb	1.1
69	tdb	1.12	<table border="0" cellpadding="2" cellspacing="2">
70			<tr>
71			<td valign="top">
72	tdb	1.13	END
73
74			&print_html($left);
75	tdb	1.12
76			print <<"END";
77			</td>
78			<td valign="top">
79	tdb	1.13	END
80	tdb	1.12
81	tdb	1.13	&print_html($title);
82	tdb	1.12
83	tdb	1.13	print <<"END";
84	tdb	1.8	<h2>$heading</h2>
85	tdb	1.5	END
86	tdb	1.1
87	tdb	1.22	print `$updatecmd >/dev/null 2>&1`;
88	tdb	1.9
89	tdb	1.5	my(@modules) = split (/\s+/, $modulelist);
90
91			foreach my $module (@modules) {
92
93	tdb	1.11	print "<table border=\"0\" bgcolor=\"#000066\" cellpadding=\"5\" width=\"100%\">\n\n";
94	tdb	1.14	print "<tr><td>\n<font size=\"4\"><b><a href=\"/cgi-bin/cvs/viewcvs.cgi/$module\" style=\"color: white\">$module module</a></b></font>\n</td></tr>\n\n";
95	tdb	1.8	print "<tr><td bgcolor=\"white\">\n";
96	tdb	1.5
97			my(@lines) = `$logcmd $module 2>&1`;
98			if(@lines == 0) {
99	tdb	1.8	print "There have been no commits in this module during this period.\n";
100	tdb	1.5	}
101			else {
102			foreach my $line (@lines) {
103	tdb	1.7
104	tdb	1.16	if ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)\s+<([^\s]+)>$/) {
105			print "\n<font color=\"blue\">\n<b>";
106	tdb	1.7	print HTML_encode($1);
107	tdb	1.16	print "</b>\n<i>";
108			print " commited by <a href=\"mailto:$3\" style=\"text-decoration: none;\">";
109			print HTML_encode("$2");
110			print "</a></i>\n</font>\n"
111			}
112	tdb	1.20	elsif ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)$/) {
113			print "\n<font color=\"blue\">\n<b>";
114			print HTML_encode($1);
115			print "</b>\n<i>";
116			print " commited by ";
117			print HTML_encode("$2");
118			print "</i>\n</font>\n"
119			}
120	tdb	1.19	elsif($line =~ /(\S+) (\(\S+\))([,:])/ \|\| $line =~ /(\S+) (\(\S+,\s+\S+\))([,:])/) {
121	tdb	1.16	#chop $line;
122			my ($file, $rest, $ext) = ($1, $2, $3);
123			print "<code>";
124			print "<a href=\"/cgi-bin/cvs/viewcvs.cgi/$file\" style=\"text-decoration: none;\">";
125			print HTML_encode($file);
126			print "</a> ";
127	tdb	1.22	if($rest =~ /\((\S+)\.(\d+)(.*)\)/) {
128	tdb	1.16	my $newrev = "$1.$2";
129			my $oldminver = $2-1;
130			my $oldrev = "$1.$oldminver";
131	tdb	1.22	if($2 != 1) {
132	tdb	1.16	my $diff = ".diff?r1=$oldrev&r2=$newrev";
133	tdb	1.19	print "(<a href=\"/cgi-bin/cvs/viewcvs.cgi/$file$diff\" style=\"text-decoration: none;\">";
134			print HTML_encode("$1.$2");
135	tdb	1.16	print "</a>";
136	tdb	1.19	print HTML_encode("$3)");
137	tdb	1.16	}
138			else {
139			print HTML_encode($rest);
140			}
141			}
142			else {
143			print HTML_encode($rest);
144			}
145			print HTML_encode($ext);
146			print "</code><br>\n"
147	tdb	1.7	}
148			else {
149			chop $line;
150			print "<code>";
151			print HTML_encode($line);
152	tdb	1.11	print "</code><br>\n"
153	tdb	1.7	}
154	tdb	1.5	}
155			}
156	tdb	1.8	print "</td></tr>\n";
157	tdb	1.1
158	tdb	1.7	print "</table><p>\n\n";
159	tdb	1.1	}
160
161	tdb	1.13	&print_html($bottom);
162
163	tdb	1.1	print <<"END";
164	tdb	1.12
165			</td>
166			</tr>
167			</table>
168	tdb	1.7
169	tdb	1.1	</body>
170
171			</html>
172			END
173
174			exit 0;
175
176			#------------------------------------------------------
177			# sub HTML_encode
178			#
179			# escape HTML characters that may cause problems when
180			# shown either in the <body> or within text fields.
181			#------------------------------------------------------
182			sub HTML_encode ($){
183			my ($encoded) = @_;
184			$encoded =~ s/&/&/g;
185			$encoded =~ s/"/"/g;
186			$encoded =~ s/</</g;
187			$encoded =~ s/>/>/g;
188			return $encoded;
189	tdb	1.13	}
190
191			# Print a file without escaping HTML: -
192			sub print_html ($) {
193			my ($filename) = @_;
194			print `cat $filename 2>&1`;
195	tdb	1.1	}