| 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 |  |  |  | 
 
 
 
 
 | 8 |  |  | my($firstdate); | 
 
 
 
 
 | 9 |  |  | if($period eq "days") { | 
 
 
 
 
 | 10 |  |  | my($days)=$query->param('days'); | 
 
 
 
 
 | 11 |  |  | $days = 1 unless defined $days; | 
 
 
 
 
 | 12 |  |  | if ($days < 1) {$days = 1}; | 
 
 
 
 
 | 13 |  |  | $heading = "i-scream CVS commits in the past $days day(s)"; | 
 
 
 
 
 | 14 |  |  | $days--; | 
 
 
 
 
 | 15 |  |  | $firstdate = `date --date \"$days days ago\" \"+%Y/%m/%d\"`; | 
 
 
 
 
 | 16 |  |  | } | 
 
 
 
 
 | 17 |  |  | elsif($period eq "thisweek") { | 
 
 
 
 
 | 18 |  |  | $firstdate = "last Sunday"; | 
 
 
 
 
 | 19 |  |  | $heading = "i-scream CVS commits this week"; | 
 
 
 
 
 | 20 |  |  | } | 
 
 
 
 
 | 21 |  |  | else { | 
 
 
 
 
 | 22 |  |  | # default to "today only" | 
 
 
 
 
 | 23 |  |  | $firstdate = `/bin/date \"+%Y/%m/%d\"`; | 
 
 
 
 
 | 24 |  |  | $heading = "Today's i-scream CVS commits"; | 
 
 
 
 
 | 25 |  |  | } | 
 
 
 
 
 
 
 
 | 26 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 27 | tdb | 1.10 | my($cvsroot) = "/cvs/i-scream"; | 
 
 
 
 
 | 28 |  |  |  | 
 
 
 
 
 | 29 |  |  | my($modulelist)=$query->param('module'); | 
 
 
 
 
 | 30 |  |  | $modulelist = `ls $cvsroot` unless defined $modulelist; | 
 
 
 
 
 
 
 
 | 31 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 32 | tdb | 1.5 | my($cvs2clpath) = "/home/sites/www.i-scream.org.uk/bin/cvs2cl.pl"; | 
 
 
 
 
 | 33 |  |  | my($cvs2clargs) = "--stdout -r -b -t -w -U $cvsroot/CVSROOT/users -l \"-d'\>$firstdate'\" -g \"-d$cvsroot\" -g \"-Q\""; | 
 
 
 
 
 
 
 
 | 34 | tdb | 1.10 | my($updatecmd) = "/home/sites/www.i-scream.org.uk/bin/fullcvsupdate.sh $modulelist"; | 
 
 
 
 
 
 
 
 | 35 | tdb | 1.5 | my($logcmd) = "cd /home/sites/www.i-scream.org.uk/cvsscripttemp && $cvs2clpath $cvs2clargs"; | 
 
 
 
 
 
 
 
 | 36 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 37 | tdb | 1.10 | print "Content-type: text/html\n\n"; | 
 
 
 
 
 | 38 |  |  |  | 
 
 
 
 
 
 
 
 | 39 | tdb | 1.1 | print <<"END"; | 
 
 
 
 
 | 40 |  |  | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> | 
 
 
 
 
 | 41 |  |  |  | 
 
 
 
 
 | 42 |  |  | <html> | 
 
 
 
 
 | 43 |  |  |  | 
 
 
 
 
 | 44 |  |  | <head> | 
 
 
 
 
 
 
 
 | 45 | tdb | 1.7 | <title>The i-scream Project Commit Log</title> | 
 
 
 
 
 
 
 
 | 46 | tdb | 1.1 | </head> | 
 
 
 
 
 | 47 |  |  |  | 
 
 
 
 
 
 
 
 | 48 | tdb | 1.7 | <body bgcolor="#ffffff" link="#ffffff" alink="#ffffff" vlink="#ffffff" text="#000066"> | 
 
 
 
 
 
 
 
 | 49 | tdb | 1.1 |  | 
 
 
 
 
 | 50 |  |  | <a href="http://www.i-scream.org.uk"><img border="0" src="../i-scream.gif"></a> | 
 
 
 
 
 | 51 |  |  |  | 
 
 
 
 
 
 
 
 | 52 | tdb | 1.8 | <h2>$heading</h2> | 
 
 
 
 
 
 
 
 | 53 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 54 | tdb | 1.5 | END | 
 
 
 
 
 
 
 
 | 55 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 56 | tdb | 1.5 | print `$updatecmd`; | 
 
 
 
 
 
 
 
 | 57 | tdb | 1.9 |  | 
 
 
 
 
 
 
 
 | 58 | tdb | 1.5 | my(@modules) = split (/\s+/, $modulelist); | 
 
 
 
 
 | 59 |  |  |  | 
 
 
 
 
 | 60 |  |  | foreach my $module (@modules) { | 
 
 
 
 
 | 61 |  |  |  | 
 
 
 
 
 
 
 
 | 62 | tdb | 1.7 | print "<table border=\"0\" bgcolor=\"#000066\" cellpadding=\"5\" width=\"100%\">"; | 
 
 
 
 
 | 63 |  |  | print "<tr><td><font size=\"4\"><b><a href=\"/cgi-bin/cvs/viewcvs.cgi/$module\">$module module</a></b></font></td></tr>"; | 
 
 
 
 
 
 
 
 | 64 | tdb | 1.8 | print "<tr><td bgcolor=\"white\">\n"; | 
 
 
 
 
 
 
 
 | 65 | tdb | 1.5 |  | 
 
 
 
 
 | 66 |  |  | my(@lines) = `$logcmd $module 2>&1`; | 
 
 
 
 
 | 67 |  |  | if(@lines == 0) { | 
 
 
 
 
 
 
 
 | 68 | tdb | 1.8 | print "There have been no commits in this module during this period.\n"; | 
 
 
 
 
 
 
 
 | 69 | tdb | 1.5 | } | 
 
 
 
 
 | 70 |  |  | else { | 
 
 
 
 
 | 71 |  |  | foreach my $line (@lines) { | 
 
 
 
 
 
 
 
 | 72 | tdb | 1.7 |  | 
 
 
 
 
 | 73 |  |  | if ($line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2}.*?)([^\s]+)$/) { | 
 
 
 
 
 | 74 |  |  | print "<font color=\"blue\"><b>"; | 
 
 
 
 
 | 75 |  |  | print HTML_encode($1); | 
 
 
 
 
 | 76 |  |  | print "</b><i>"; | 
 
 
 
 
 | 77 |  |  | print HTML_encode("by $2"); | 
 
 
 
 
 | 78 |  |  | print "</i></font>" | 
 
 
 
 
 | 79 |  |  | } | 
 
 
 
 
 | 80 |  |  | else { | 
 
 
 
 
 | 81 |  |  | chop $line; | 
 
 
 
 
 | 82 |  |  | print "<code>"; | 
 
 
 
 
 | 83 |  |  | print HTML_encode($line); | 
 
 
 
 
 | 84 |  |  | print "</code><br>" | 
 
 
 
 
 | 85 |  |  | } | 
 
 
 
 
 
 
 
 | 86 | tdb | 1.5 | } | 
 
 
 
 
 | 87 |  |  | } | 
 
 
 
 
 
 
 
 | 88 | tdb | 1.8 | print "</td></tr>\n"; | 
 
 
 
 
 
 
 
 | 89 | tdb | 1.1 |  | 
 
 
 
 
 
 
 
 | 90 | tdb | 1.7 | print "</table><p>\n\n"; | 
 
 
 
 
 
 
 
 | 91 | tdb | 1.1 | } | 
 
 
 
 
 | 92 |  |  |  | 
 
 
 
 
 | 93 |  |  | print <<"END"; | 
 
 
 
 
 
 
 
 | 94 | tdb | 1.7 |  | 
 
 
 
 
 
 
 
 | 95 | tdb | 1.1 | </body> | 
 
 
 
 
 | 96 |  |  |  | 
 
 
 
 
 | 97 |  |  | </html> | 
 
 
 
 
 | 98 |  |  | END | 
 
 
 
 
 | 99 |  |  |  | 
 
 
 
 
 | 100 |  |  | exit 0; | 
 
 
 
 
 | 101 |  |  |  | 
 
 
 
 
 | 102 |  |  | #------------------------------------------------------ | 
 
 
 
 
 | 103 |  |  | # sub HTML_encode | 
 
 
 
 
 | 104 |  |  | # | 
 
 
 
 
 | 105 |  |  | # escape HTML characters that may cause problems when | 
 
 
 
 
 | 106 |  |  | # shown either in the <body> or within text fields. | 
 
 
 
 
 | 107 |  |  | #------------------------------------------------------ | 
 
 
 
 
 | 108 |  |  | sub HTML_encode ($){ | 
 
 
 
 
 | 109 |  |  | my ($encoded) = @_; | 
 
 
 
 
 | 110 |  |  | $encoded =~ s/&/&/g; | 
 
 
 
 
 | 111 |  |  | $encoded =~ s/"/"/g; | 
 
 
 
 
 | 112 |  |  | $encoded =~ s/</</g; | 
 
 
 
 
 | 113 |  |  | $encoded =~ s/>/>/g; | 
 
 
 
 
 | 114 |  |  | return $encoded; | 
 
 
 
 
 | 115 |  |  | } |