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:";
#	Content
1	#!/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	my($modulelist)=$query->param('module');
8	my $moduleext=""; $moduleext=":$modulelist" if defined $modulelist;
9
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	$heading = "i-scream CVS$moduleext commits in the past $days day(s)";
16	$days--;
17	$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	}
25	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	elsif($period eq "thisweek") {
32	$firstdate = ">last Sunday";
33	$heading = "i-scream CVS$moduleext commits this week";
34	}
35	else {
36	# default to "today only"
37	$firstdate = ">" . `/bin/date \"+%Y/%m/%d\"`;
38	$heading = "Today's i-scream CVS$moduleext commits";
39	}
40
41	my($cvsroot) = "/cvs/i-scream";
42
43	$modulelist = `ls $cvsroot` unless defined $modulelist;
44	$modulelist =~ s/[\r\n]/ /gm;
45
46	my($cvs2clpath) = "/home/sites/www.i-scream.org.uk/bin/cvs2cl2.pl";
47	#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	my($updatecmd) = "/home/sites/www.i-scream.org.uk/bin/fullcvsupdate.sh $modulelist";
50	my($logcmd) = "cd /home/sites/www.i-scream.org.uk/cvsscripttemp && $cvs2clpath $cvs2clargs";
51
52	my ($left) = "../left.inc" ;
53	my ($title) = "../title.inc";
54	my ($bottom) = "../bottom.inc";
55
56	print "Content-type: text/html\n\n";
57
58	print <<"END";
59	<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
60
61	<html>
62
63	<head>
64	<title>The i-scream Project Commit Log</title>
65	</head>
66
67	<body bgcolor="#ffffff" link="#0000ff" alink="#3333cc" vlink="#3333cc" text="#000066">
68
69	<table border="0" cellpadding="2" cellspacing="2">
70	<tr>
71	<td valign="top">
72	END
73
74	&print_html($left);
75
76	print <<"END";
77	</td>
78	<td valign="top">
79	END
80
81	&print_html($title);
82
83	print <<"END";
84	<h2>$heading</h2>
85	END
86
87	print `$updatecmd >/dev/null 2>&1`;
88
89	my(@modules) = split (/\s+/, $modulelist);
90
91	foreach my $module (@modules) {
92
93	print "<table border=\"0\" bgcolor=\"#000066\" cellpadding=\"5\" width=\"100%\">\n\n";
94	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	print "<tr><td bgcolor=\"white\">\n";
96
97	my(@lines) = `$logcmd $module 2>&1`;
98	if(@lines == 0) {
99	print "There have been no commits in this module during this period.\n";
100	}
101	else {
102	foreach my $line (@lines) {
103
104	if ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)\s+([^\s]+)\s+<([^\s]+)>$/) {
105	print "\n<font color=\"blue\">\n<b>";
106	print HTML_encode($1);
107	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	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	elsif($line =~ /(\S+) (\(\S+\))([,:])/ \|\| $line =~ /(\S+) (\(\S+,\s+\S+\))([,:])/) {
121	#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	if($rest =~ /\((\S+)\.(\d+)(.*)\)/) {
128	my $newrev = "$1.$2";
129	my $oldminver = $2-1;
130	my $oldrev = "$1.$oldminver";
131	if($2 != 1) {
132	my $diff = ".diff?r1=$oldrev&r2=$newrev";
133	print "(<a href=\"/cgi-bin/cvs/viewcvs.cgi/$file$diff\" style=\"text-decoration: none;\">";
134	print HTML_encode("$1.$2");
135	print "</a>";
136	print HTML_encode("$3)");
137	}
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	}
148	else {
149	chop $line;
150	print "<code>";
151	print HTML_encode($line);
152	print "</code><br>\n"
153	}
154	}
155	}
156	print "</td></tr>\n";
157
158	print "</table><p>\n\n";
159	}
160
161	&print_html($bottom);
162
163	print <<"END";
164
165	</td>
166	</tr>
167	</table>
168
169	</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	}
190
191	# Print a file without escaping HTML: -
192	sub print_html ($) {
193	my ($filename) = @_;
194	print `cat $filename 2>&1`;
195	}