mozilla
/
gecko-dev
зеркало из https://github.com/mozilla/gecko-dev.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

a hacked version of bonsai which allows a query of PVCS data.

This commit is contained in:
kestes%walrus.com 2003-12-24 12:16:36 +00:00
Родитель 7384e4cf47
Коммит 303af487de
8 изменённых файлов: 3935 добавлений и 0 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

512
webtools/tinderbox2/src/bonsai_pvcs/CGI.pl Executable file
Просмотреть файл

@ -0,0 +1,512 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
# Contains some global routines used throughout the CGI scripts of Bugzilla.
use diagnostics;
use strict;
use CGI::Carp qw(fatalsToBrowser);
require 'globals.pl';
##
## Utility routines to convert strings
##
# Get rid of all the %xx encoding and the like from the given URL.
sub url_decode {
my ($todecode) = (@_);
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
}
# Quotify a string, suitable for putting into a URL.
sub url_quote {
my($toencode) = (@_);
$toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
return $toencode;
}
# Quotify a string, suitable for output as form values
sub value_quote {
my ($var) = (@_);
$var =~ s/\&/\&amp;/g;
$var =~ s/</\&lt;/g;
$var =~ s/>/\&gt;/g;
$var =~ s/\"/\&quot;/g;
$var =~ s/\n/\&#010;/g;
$var =~ s/\r/\&#013;/g;
return $var;
}
sub url_encode2 {
my ($s) = @_;
$s =~ s/\%/\%25/g;
$s =~ s/\=/\%3d/g;
$s =~ s/\?/\%3f/g;
$s =~ s/ /\%20/g;
$s =~ s/\n/\%0a/g;
$s =~ s/\r//g;
$s =~ s/\"/\%22/g;
$s =~ s/\'/\%27/g;
$s =~ s/\|/\%7c/g;
$s =~ s/\&/\%26/g;
$s =~ s/\+/\%2b/g;
return $s;
}
sub url_encode3 {
my ($s) = @_;
$s =~ s/\n/\%0a/g;
$s =~ s/\r//g;
$s =~ s/\"/\%22/g;
$s =~ s/\+/\%2b/g;
return $s;
}
##
## Routines to generate html as part of Bonsai
##
# Create the URL that has the correct tree and batch information
sub BatchIdPart {
my ($initstr) = @_;
my ($result, $ro) = ("", Param('readonly'));
$initstr = "" unless (defined($initstr) && $initstr);
$result = $initstr if (($::TreeID ne "default") || $ro);
$result .= "&treeid=$::TreeID" if ($::TreeID ne "default");
$result .= "&batchid=$::BatchID" if ($ro);
return $result;
}
# Create a generic page header for bonsai pages
sub PutsHeader {
my ($title, $h1, $h2) = (@_);
if (!defined $h1) {
$h1 = $title;
}
if (!defined $h2) {
$h2 = "";
}
print "<HTML><HEAD>\n<TITLE>$title</TITLE>\n";
print $::Setup_String if (defined($::Setup_String) && $::Setup_String);
print Param("headerhtml") . "\n</HEAD>\n";
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"\n";
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
print PerformSubsts(Param("bannerhtml"), undef);
print "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">\n";
print " <TR>\n";
print " <TD>\n";
print " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2>\n";
print " <TR><TD VALIGN=TOP ALIGN=CENTER NOWRAP>\n";
print " <FONT SIZE=\"+3\"><B><NOBR>$h1</NOBR></B></FONT>\n";
print " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n";
print " <B>$h2</B>\n";
print " </TD></TR>\n";
print " </TABLE>\n";
print " </TD>\n";
print " <TD>\n";
print Param("blurbhtml");
print "</TD></TR></TABLE>\n";
}
# Create a generic page trailer for bonsai pages
sub PutsTrailer {
my $args = BatchIdPart('?');
my $maintainer = Param('maintainer');
my $email = '';
if ($maintainer) {
$email = "<br>" . ConstructMailTo($maintainer, "Bonsai Comments");
$email .= " with comments/questions about this page.\n";
}
print "
<br clear=all>
<hr>
<a href=\"toplevel.cgi$args\" target=_top>
Back to the top of Bonsai</a>
$email
</html>
";
}
sub GeneratePersonInput {
my ($field, $required, $def_value, $extraJavaScript) = (@_);
if (!defined $extraJavaScript) {
$extraJavaScript = "";
}
if ($extraJavaScript ne "") {
$extraJavaScript = "onChange=\" $extraJavaScript \"";
}
return "<INPUT NAME=\"$field\" SIZE=32 $extraJavaScript VALUE=\"$def_value\">";
}
sub GeneratePeopleInput {
my ($field, $def_value) = (@_);
return "<INPUT NAME=\"$field\" SIZE=45 VALUE=\"$def_value\">";
}
sub make_options {
my ($src,$default,$isregexp) = (@_);
my $last = "";
my $popup = "";
my $found = 0;
if ($src) {
foreach my $item (@$src) {
if ($item eq "-blank-" || $item ne $last) {
if ($item eq "-blank-") {
$item = "";
}
$last = $item;
if ($isregexp ? $item =~ $default : $default eq $item) {
$popup .= "<OPTION SELECTED VALUE=\"$item\">$item";
$found = 1;
} else {
$popup .= "<OPTION VALUE=\"$item\">$item";
}
}
}
}
if (!$found && $default ne "") {
$popup .= "<OPTION SELECTED>$default";
}
return $popup;
}
sub make_popup {
my ($name,$src,$default,$listtype,$onchange) = (@_);
my $popup = "<SELECT NAME=$name";
if ($listtype > 0) {
$popup .= " SIZE=5";
if ($listtype == 2) {
$popup .= " MULTIPLE";
}
}
if (defined $onchange && $onchange ne "") {
$popup .= " onchange=$onchange";
}
$popup .= ">" . make_options($src, $default,
($listtype == 2 && $default ne ""));
$popup .= "</SELECT>";
return $popup;
}
sub make_cgi_args {
my ($k,$v);
my $ret = "";
for $k (sort keys %::FORM){
$ret .= ($ret eq "" ? '?' : '&');
$v = $::FORM{$k};
$ret .= &url_encode2($k);
$ret .= '=';
$ret .= &url_encode2($v);
}
return $ret;
}
sub cvsmenu {
my ($extra) = @_;
my ($pass, $i, $page, $title);
my ($desc, $branch, $root, $module, $maintainer);
LoadTreeConfig();
if (!defined $extra) {
$extra = "";
}
print "<table border=1 bgcolor=#ffffcc $extra>\n";
print "<tr><th>Menu</tr><tr><td><p>\n<dl>\n";
foreach $pass ("cvsqueryform|Query",
"rview|Browse",
"moduleanalyse|Examine Modules") {
($page, $title) = split(/\|/, $pass);
$page .= ".cgi";
print "<b>$title</b><br><ul>\n";
foreach $i (@::TreeList) {
$branch = '';
# HACK ALERT
# quick fix by adam:
# when browsing with rview, branch needs to be in 'rev' param
# not 'branch' param. don't ask me why ...
my $hack = ($page eq 'rview.cgi') ? 'rev' : 'branch';
$branch = "&$hack=$::TreeInfo{$i}{'branch'}"
if $::TreeInfo{$i}{'branch'};
$desc = $::TreeInfo{$i}{'shortdesc'};
$desc = $::TreeInfo{$i}{'description'} unless $desc;
$root = "cvsroot=$::TreeInfo{$i}{'repository'}";
$module = "module=$::TreeInfo{$i}{'module'}";
print "<li><a href=\"$page?$root&$module$branch\">$desc</a>\n";
};
print "</ul>\n";
};
if (open(EXTRA, "<data/cvsmenuextra")) {
while (<EXTRA>) {
print $_;
}
close EXTRA;
}
$maintainer = Param('maintainer');
print "</dl>
<p></tr><tr><td>
<font size=-1> Questions, Comments, Feature requests?
mail <a href=\"mailto:$maintainer\">$maintainer</a>
</font>
</tr></table>
";
}
##
## Routines to handle initializing CGI form data, cookies, etc...
##
sub ProcessFormFields {
my ($buffer) = (@_);
undef %::FORM;
undef %::MFORM;
my %isnull;
my $remaining = $buffer;
while ($remaining ne "") {
my $item;
if ($remaining =~ /^([^&]*)&(.*)$/) {
$item = $1;
$remaining = $2;
} else {
$item = $remaining;
$remaining = "";
}
my $name;
my $value;
if ($item =~ /^([^=]*)=(.*)$/) {
$name = $1;
$value = url_decode($2);
} else {
$name = $item;
$value = "";
}
if ($value ne "") {
if (defined $::FORM{$name}) {
$::FORM{$name} .= $value;
my $ref = $::MFORM{$name};
push @$ref, $value;
} else {
$::FORM{$name} = $value;
$::MFORM{$name} = [$value];
}
} else {
$isnull{$name} = 1;
}
}
if (%isnull) {
foreach my $name (keys(%isnull)) {
if (!defined $::FORM{$name}) {
$::FORM{$name} = "";
$::MFORM{$name} = [];
}
}
}
}
sub ProcessMultipartFormFields {
my ($boundary) = (@_);
$boundary =~ s/^-*//;
my $remaining = $ENV{"CONTENT_LENGTH"};
my $inheader = 1;
my $itemname = "";
while ($remaining > 0 && ($_ = <STDIN>)) {
$remaining -= length($_);
if ($_ =~ m/^-*$boundary/) {
$inheader = 1;
$itemname = "";
next;
}
if ($inheader) {
if (m/^\s*$/) {
$inheader = 0;
$::FORM{$itemname} = "";
}
if (m/^Content-Disposition:\s*form-data\s*;\s*name\s*=\s*"([^\"]+)"/i) {
$itemname = $1;
if (m/;\s*filename\s*=\s*"([^\"]+)"/i) {
$::FILENAME{$itemname} = $1;
}
}
next;
}
$::FORM{$itemname} .= $_;
}
delete $::FORM{""};
# Get rid of trailing newlines.
foreach my $i (keys %::FORM) {
chomp($::FORM{$i});
$::FORM{$i} =~ s/\r$//;
}
}
sub FormData {
my ($field) = (@_);
unless (defined($::FORM{$field})) {
print "\n<b>Error: Form field `<tt>$field</tt>' is not defined</b>\n";
exit 0;
}
return $::FORM{$field};
}
sub CheckEmailSyntax {
my ($addr) = (@_);
if ($addr !~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) {
print "Content-type: text/html\n\n";
print "<H1>Invalid e-mail address entered.</H1>\n";
print "The e-mail address you entered\n";
print "(<b>$addr</b>) didn't match our minimal\n";
print "syntax checking for a legal email address. A legal\n";
print "address must contain exactly one '\@', and at least one\n";
print "'.' after the \@, and may not contain any commas or.\n";
print "spaces.\n";
print "<p>Please click <b>back</b> and try again.\n";
exit;
}
}
############# Live code below here (that is, not subroutine defs) #############
$| = 1;
# Uncommenting this next line can help debugging.
# print "Content-type: text/html\n\nHello mom\n";
# foreach my $k (sort(keys %ENV)) {
# print "$k $ENV{$k}<br>\n";
# }
if (defined $ENV{"REQUEST_METHOD"}) {
if ($ENV{"REQUEST_METHOD"} eq "GET") {
if (defined $ENV{"QUERY_STRING"}) {
$::buffer = $ENV{"QUERY_STRING"};
} else {
$::buffer = "";
}
ProcessFormFields $::buffer;
} else {
if ($ENV{"CONTENT_TYPE"} =~
m@multipart/form-data; boundary=\s*([^; ]+)@) {
ProcessMultipartFormFields($1);
$::buffer = "";
} else {
read STDIN, $::buffer, $ENV{"CONTENT_LENGTH"} ||
die "Couldn't get form data";
ProcessFormFields $::buffer;
}
}
}
if (defined $ENV{"HTTP_COOKIE"}) {
foreach my $pair (split(/;/, $ENV{"HTTP_COOKIE"})) {
$pair = trim($pair);
if ($pair =~ /^([^=]*)=(.*)$/) {
$::COOKIE{$1} = $2;
} else {
$::COOKIE{$pair} = "";
}
}
}
if (defined $::FORM{'treeid'} && $::FORM{'treeid'} ne "") {
$::TreeID = $::FORM{'treeid'};
}
if (defined $::FORM{'batchid'}) {
LoadBatchID();
if ($::BatchID != $::FORM{'batchid'}) {
$::BatchID = $::FORM{'batchid'};
# load parameters first to prevent overwriting
Param('readonly');
$::param{'readonly'} = 1;
}
}
# Layers are supported only by Netscape 4.
# The DOM standards are supported by Mozilla and IE 5 or above. It should
# also be supported by any browser claiming "Mozilla/5" or above.
$::use_layers = 0;
$::use_dom = 0;
# MSIE chokes on |type="application/x-javascript"| so if we detect MSIE, we
# we should send |type="text/javascript"|. While we're at it, we should send
# |language="JavaScript"| for any browser that is "Mozilla/4" or older.
$::script_type = '"language="JavaScript""';
if (defined $ENV{HTTP_USER_AGENT}) {
my $user_agent = $ENV{HTTP_USER_AGENT};
if ($user_agent =~ m@^Mozilla/4.@ && $user_agent !~ /MSIE/) {
$::use_layers = 1;
} elsif ($user_agent =~ m@MSIE (\d+)@) {
$::use_dom = 1 if $1 >= 5;
$::script_type = 'type="text/javascript"';
} elsif ($user_agent =~ m@^Mozilla/(\d+)@) {
$::use_dom = 1 if $1 >= 5;
$::script_type = 'type="application/x-javascript"';
}
}
1;

701
webtools/tinderbox2/src/bonsai_pvcs/cvsquery.cgi Executable file
Просмотреть файл

@ -0,0 +1,701 @@
#!/usr/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s):
use diagnostics;
use strict;
# Shut up misguided -w warnings about "used only once". "use vars" just
# doesn't work for me.
sub sillyness {
my $zz;
$zz = $::CI_BRANCH;
$zz = $::CI_REPOSITORY;
$zz = $::CI_CHANGE;
$zz = $::CI_STICKY;
$zz = $::lines_added;
$zz = $::lines_removed;
$zz = $::query_begin_tag;
$zz = $::query_branchtype;
$zz = $::query_date_max;
$zz = $::query_debug;
$zz = $::query_end_tag;
$zz = $::query_filetype;
$zz = $::query_logexpr;
$zz = $::query_whotype;
$zz = $::script_type;
}
require 'CGI.pl';
require 'data/treeconfig.pl';
require 'pvcs_query_checkins.pl';
#require 'cvsquery.pl';
#
# Constants
#
$::CI_CHANGE=0;
$::CI_DATE=1;
$::CI_WHO=2;
$::CI_REPOSITORY=3;
$::CI_DIR=4;
$::CI_FILE=5;
$::CI_REV=6;
$::CI_STICKY=7;
$::CI_BRANCH=8;
$::CI_LINES_ADDED=9;
$::CI_LINES_REMOVED=10;
$::CI_LOG=11;
my $NOT_LOCAL = 1;
my $IS_LOCAL = 2;
$::CVS_ROOT = '/';
my $userdomain = Param('userdomain');
my $registryurl = Param('registryurl');
$registryurl =~ s@/$@@;
$| = 1;
my $sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
my $generateBackoutCVSCommands = 0;
if (defined $::FORM{'generateBackoutCVSCommands'}) {
$generateBackoutCVSCommands = 1;
}
if (!$generateBackoutCVSCommands) {
print "Content-type: text/html
";
print setup_script();
}
#print "<pre>";
my $SORT_HEAD="bgcolor=\"#DDDDDD\"";
#
# Log the query
Log("Query [$ENV{'REMOTE_ADDR'}]: $ENV{'QUERY_STRING'}");
#
# build a module map
#
$::query_module = $::FORM{'module'};
#
# allow ?file=/a/b/c/foo.c to be synonymous with ?dir=/a/b/c&file=foo.c
#
$::FORM{'file'} = "" unless defined $::FORM{'file'};
unless ($::FORM{'dir'}) {
$::FORM{'file'} = Fix_BonsaiLink($::FORM{'file'});
if ($::FORM{'file'} =~ m@(.*?/)([^/]*)$@) {
$::FORM{'dir'} = $1;
$::FORM{'file'} = $2;
} else {
$::FORM{'dir'} = "";
}
}
#
# build a directory map
#
@::query_dirs = split(/[;, \t]+/, $::FORM{'dir'});
$::query_file = $::FORM{'file'};
$::query_filetype = $::FORM{'filetype'};
$::query_logexpr = $::FORM{'logexpr'};
#
# date
#
$::query_date_type = $::FORM{'date'};
if( $::query_date_type eq 'hours' ){
$::query_date_min = time - $::FORM{'hours'}*60*60;
}
elsif( $::query_date_type eq 'day' ){
$::query_date_min = time - 24*60*60;
}
elsif( $::query_date_type eq 'week' ){
$::query_date_min = time - 7*24*60*60;
}
elsif( $::query_date_type eq 'month' ){
$::query_date_min = time - 30*24*60*60;
}
elsif( $::query_date_type eq 'all' ){
$::query_date_min = 0;
}
elsif( $::query_date_type eq 'explicit' ){
if ($::FORM{'mindate'}) {
$::query_date_min = parse_date($::FORM{'mindate'});
}
if ($::FORM{'maxdate'}) {
$::query_date_max = parse_date($::FORM{'maxdate'});
}
}
else {
$::query_date_min = time-60*60*2;
}
#
# who
#
$::query_who = $::FORM{'who'};
$::query_whotype = $::FORM{'whotype'};
my $show_raw = 0;
if ($::FORM{'raw'}) {
$show_raw = 1;
}
#
# branch
#
$::query_branch = $::FORM{'branch'};
if (!defined $::query_branch) {
$::query_branch = 'HEAD';
}
$::query_branchtype = $::FORM{'branchtype'};
#
# tags
#
$::query_begin_tag = $::FORM{'begin_tag'};
$::query_end_tag = $::FORM{'end_tag'};
#
# Get the query in english and print it.
#
my ($t, $e);
$t = $e = &query_to_english;
$t =~ s/<[^>]*>//g;
$::query_debug = $::FORM{'debug'};
my %mod_map = ();
my $result= &query_checkins( %mod_map );
my %w;
for my $i (@{$result}) {
my $aname=$i->[$::CI_WHO];
# the else is for compatibility w/ something that uses the other format
# the regexp is probably not the best, but I think it might work
if ($aname =~ /%\w*.\w\w+/) {
my $tmp = join("@",split("%",$aname));
$w{"$tmp"} = 1;
}else{
$w{"$i->[$::CI_WHO]\@$userdomain"} = 1;
}
}
my @p = sort keys %w;
my $pCount = @p;
my $s = join(",%20", @p);
$e =~ s/Checkins in/In/;
my $menu = "
<p align=center>$e
<p align=left>
<a href=cvsqueryform.cgi?$ENV{QUERY_STRING}>Modify Query</a>
";
if ($pCount) {
$menu .= "
<br><a href=mailto:$s>Mail everyone on this page</a>
<NOBR>($pCount people)</NOBR>
";
}
if (defined $::FORM{'generateBackoutCVSCommands'}) {
print "Content-type: text/plain
# This page can be saved as a shell script and executed. It should be
# run at the top of your CVS work area. It will update your workarea to
# backout the changes selected by your query.
";
unless ($pCount) {
print "
#
# No changes occurred during this interval.
# There is nothing to back out.
#
";
exit;
}
foreach my $ci (reverse @{$result}) {
if ($ci->[$::CI_REV] eq "") {
print "echo 'Changes made to $ci->[$::CI_DIR]/$ci->[$::CI_FILE] need to be backed out by hand'\n";
next;
}
my $prev_revision = PrevRev($ci->[$::CI_REV]);
print "cvs update -j$ci->[$::CI_REV] -j$prev_revision $ci->[$::CI_DIR]/$ci->[$::CI_FILE]\n";
}
exit;
}
PutsHeader($t, "PVCS Checkins", "$menu");
#
# Test code to print the results
#
$|=1;
my $head_who = '';
my $head_file = '';
my $head_directory = '';
my $head_delta = '';
my $head_date = '';
if( !$show_raw ) {
$::FORM{"sortby"} ||= "";
if( $::FORM{"sortby"} eq "Who" ){
$result = [sort {
$a->[$::CI_WHO] cmp $b->[$::CI_WHO]
|| $b->[$::CI_DATE] <=> $a->[$::CI_DATE]
} @{$result}] ;
$head_who = $SORT_HEAD;
}
elsif( $::FORM{"sortby"} eq "File" ){
$result = [sort {
$a->[$::CI_FILE] cmp $b->[$::CI_FILE]
|| $b->[$::CI_DATE] <=> $a->[$::CI_DATE]
|| $a->[$::CI_DIRECTORY] cmp $b->[$::CI_DIRECTORY]
} @{$result}] ;
$head_file = $SORT_HEAD;
}
elsif( $::FORM{"sortby"} eq "Directory" ){
$result = [sort {
$a->[$::CI_DIRECTORY] cmp $b->[$::CI_DIRECTORY]
|| $a->[$::CI_FILE] cmp $b->[$::CI_FILE]
|| $b->[$::CI_DATE] <=> $a->[$::CI_DATE]
} @{$result}] ;
$head_directory = $SORT_HEAD;
}
elsif( $::FORM{"sortby"} eq "Change Size" ){
$result = [sort {
($b->[$::CI_LINES_ADDED]- $b->[$::CI_LINES_REMOVED])
<=> ($a->[$::CI_LINES_ADDED]- $a->[$::CI_LINES_REMOVED])
#|| $b->[$::CI_DATE] <=> $a->[$::CI_DATE]
} @{$result}] ;
$head_delta = $SORT_HEAD;
}
else{
$result = [sort {$b->[$::CI_DATE] <=> $a->[$::CI_DATE]} @{$result}] ;
$head_date = $SORT_HEAD;
}
&print_result($result);
}
else {
print "<pre>";
for my $ci (@$result) {
$ci->[$::CI_LOG] = '';
$s = join("|",@$ci);
print "$s\n";
}
}
#
#
#
sub print_result {
my ($result) = @_;
my ($ci,$i,$k,$j,$max, $l, $span);
&print_head;
$i = 20;
$k = 0;
$max = @{$result};
while( $k < $max ){
$ci = $result->[$k];
$span = 1;
if( ($l = $ci->[$::CI_LOG]) ne '' ){
#
# Calculate the number of consecutive logs that are
# the same and nuke them
#
$j = $k+1;
while( $j < $max && $result->[$j]->[$::CI_LOG] eq $l ){
$result->[$j]->[$::CI_LOG] = '';
$j++;
}
#
# Make sure we don't break over a description block
#
$span = $j-$k;
if( $span-1 > $i ){
$i = $j-$k;
}
}
&print_ci( $ci, $span );
if( $i <= 0 ){
$i = 20;
print "</TABLE><TABLE border cellspacing=2>\n";
}
else {
$i--;
}
$k++;
}
&print_foot;
}
my $descwidth;
sub print_ci {
my ($ci, $span) = @_;
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$::CI_DATE] );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
my $log = &html_log($ci->[$::CI_LOG]);
my $rev = $ci->[$::CI_REV];
my $url_who = url_quote($ci->[$::CI_WHO]);
print "<tr>\n";
# my $slash ='%2F';
# my $colon ='%3A';
# my $space ='%20';
# my $url_t = sprintf("%02d%$slash%02d%$slash%04d%$space%02d%$colon%02d%$colon%02d",
# $mon+1,$mday,$year+1900,
# $hour,$minute,0);
#
# my $t_anchor = $ENV{QUERY_STRING};
# $t_anchor =~ s/\&mindate\=[A-Za-z0-9\%\ \+]*//g;
# $t_anchor =~ s/\&date\=[A-Za-z0-9\%\ \+]*//g;
# $t_anchor = "<a href=cvsquery.cgi?$anchor&date=explicit&mindate=$url_t>$t</a>\n";
print "<TD width=2%>${sm_font_tag}$t</font>\n";
print "<TD width=2%><a href='$registryurl/who.cgi?email=$url_who'"
. " onClick=\"return js_who_menu('$url_who','',event);\" >"
. "$ci->[$::CI_WHO]</a>\n";
print "<TD width=45%>\n";
# if( (length $ci->[$::CI_FILE]) + (length $ci->[$::CI_DIR]) > 30 ){
# $d = $ci->[$::CI_DIR];
# if( (length $ci->[$::CI_DIR]) > 30 ){
# $d =~ s/([^\n]*\/)(classes\/)/$1classes\/<br>&nbsp;&nbsp/;
# # Insert a <BR> before any directory named
# # 'classes.'
# }
# print " $d/<br>&nbsp;&nbsp;$ci->[$::CI_FILE]<a>\n";
# }
# else{
# print " $ci->[$::CI_DIR]/$ci->[$::CI_FILE]<a>\n";
# }
my $d = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]";
if (defined $::query_module && $::query_module eq 'allrepositories') {
$d = "$ci->[$::CI_REPOSITORY]/$d";
}
$d =~ s:/:/ :g; # Insert a whitespace after any slash, so that
# we'll break long names at a reasonable place.
print "$d\n";
if( $rev ne '' ){
my $prevrev = &PrevRev( $rev );
print "<TD width=2%>${sm_font_tag}$rev</font>\n";
}
else {
print "<TD width=2%>\&nbsp;\n";
}
if( !$::query_branch_head ){
my $branch = $ci->[$::CI_BRANCH];
my $anchor = $ENV{QUERY_STRING};
$anchor =~ s/\&branch\=[A-Za-z\ \+]*//g;
$anchor = "<a href=cvsquery.cgi?$anchor&branch=$branch>$branch</a>\n";
print "<TD width=2%><TT><FONT SIZE=-1>$anchor</FONT></TT>&nbsp\n";
}
if( defined($log) && ($log ne '') ){
$log = MarkUpText($log);
# Makes numbers into links to bugsplat.
$log =~ s/\n/<BR>/g;
# Makes newlines into <BR>'s
if( $span > 1 ){
print "<TD WIDTH=$descwidth% VALIGN=TOP ROWSPAN=$span>$log\n";
}
else {
print "<TD WIDTH=$descwidth% VALIGN=TOP>$log\n";
}
}
print "</tr>\n";
}
sub print_head {
if ($::versioninfo) {
print "<FORM action='multidiff.cgi' method=post>";
print "<INPUT TYPE='HIDDEN' name='allchanges' value = '$::versioninfo'>";
print "<INPUT TYPE='HIDDEN' name='cvsroot' value = '$::CVS_ROOT'>";
print "<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>";
print "</FORM>";
print "<tt>(+$::lines_added/$::lines_removed)</tt> Lines changed.";
}
my $anchor = $ENV{QUERY_STRING};
$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
$anchor = "<a href=cvsquery.cgi?$anchor";
print "<TABLE border cellspacing=2>\n";
print "<b><TR ALIGN=LEFT>\n";
print "<TH width=2% $head_date>$anchor>When</a>\n";
print "<TH width=2% $head_who>${anchor}&sortby=Who>Who</a>\n";
print "<TH width=45% $head_file>${anchor}&sortby=File>File</a>\n";
print "<TH width=2%>Rev\n";
$descwidth = 47;
if( !$::query_branch_head ){
print "<TH width=2%>WorkSet\n";
$descwidth -= 2;
}
print "<TH WIDTH=$descwidth%>Description\n";
print "</TR></b>\n";
}
sub print_foot {
print "</TABLE>";
print "<br><br>";
}
sub html_log {
my ( $log ) = @_;
$log =~ s/&/&amp;/g;
$log =~ s/</&lt;/g;
return $log;
}
sub PrevRev {
my( $rev ) = @_;
# PVCS uses different version numberings
return ($rev - 1);
my( $i, $j, $ret, @r );
@r = split( /\./, $rev );
$i = @r-1;
$r[$i]--;
if( $r[$i] == 0 ){
$i -= 2;
}
$j = 0;
while( $j < $i ){
$ret .= "$r[$j]\.";
$j++
}
$ret .= $r[$i];
}
sub parse_date {
my($d) = @_;
my($result) = str2time($d);
if (defined $result) {
return $result;
} elsif ($d > 7000000) {
return $d;
}
return 0;
}
sub setup_script {
my $script_str = qq{
<script $::script_type><!--
var event = 0; // Nav3.0 compatibility
function js_who_menu(n,extra,d) {
if( parseInt(navigator.appVersion) < 4 ||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
return true;
}
l = document.layers['popup'];
l.src="$registryurl/who.cgi?email="+n+extra;
if(d.target.y > window.innerHeight + window.pageYOffset - l.clip.height) {
l.top = (window.innerHeight + window.pageYOffset - l.clip.height);
} else {
l.top = d.target.y - 6;
}
l.left = d.target.x - 6;
l.visibility="show";
return false;
}
function js_file_menu(repos,dir,file,rev,branch,d) {
var fileName="";
if( parseInt(navigator.appVersion) < 4 ||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
return true;
}
for (var i=0;i<d.target.text.length;i++)
{
if (d.target.text.charAt(i)!=" ") {
fileName+=d.target.text.charAt(i);
}
}
l = document.layers['popup'];
l.src="$registryurl/file.cgi?cvsroot="+repos+"&file="+file+"&dir="+dir+"&rev="+rev+"&branch="+branch+"&linked_text="+fileName;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
//--></script>
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
</layer>
};
return $script_str;
}
#
# Actually do the query
#
sub query_to_english {
my $english = 'Checkins ';
$::query_module = 'all' unless defined $::query_module;
if( $::query_module eq 'allrepositories' ){
$english .= "to <i>All Repositories</i> ";
}
elsif( $::query_module ne 'all' && @::query_dirs == 0 ){
$english .= "to product_id <i>" . html_quote($::query_module) . "</i> ";
}
elsif( $::FORM{dir} ne "" ) {
my $word = "directory";
if (@::query_dirs > 1) {
$word = "directories";
}
$english .= "to $word <i>" . html_quote($::FORM{dir}) . "</i> ";
}
if ($::query_file ne "") {
if ($english ne 'Checkins ') {
$english .= "and ";
}
$english .= "to file " . html_quote($::query_file) . " ";
}
if( ! ($::query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
if($::query_branch eq '' ){
$english .= "on all branches ";
}
else {
$english .= "on branch <i>" . html_quote($::query_branch) . "</i> ";
}
}
if( $::query_who) {
$english .= "by " . html_quote($::query_who) . " ";
}
$::query_date_type = $::FORM{'date'};
if( $::query_date_type eq 'hours' ){
$english .="in the last " . html_quote($::FORM{hours}) . " hours";
}
elsif( $::query_date_type eq 'day' ){
$english .="in the last day";
}
elsif( $::query_date_type eq 'week' ){
$english .="in the last week";
}
elsif( $::query_date_type eq 'month' ){
$english .="in the last month";
}
elsif( $::query_date_type eq 'all' ){
$english .="since the beginning of time";
}
elsif( $::query_date_type eq 'explicit' ){
my ($w1, $w2);
if ( $::FORM{mindate} && $::FORM{maxdate}) {
$w1 = "between";
$w2 = "and" ;
}
else {
$w1 = "since";
$w2 = "before";
}
if( $::FORM{'mindate'}){
my $dd = &parse_date($::FORM{'mindate'});
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
$english .= "$w1 <i>$t</i> ";
}
if( $::FORM{'maxdate'}){
my $dd = &parse_date($::FORM{'maxdate'});
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
$english .= "$w2 <i>$t</i> ";
}
}
return $english . ":";
}
PutsTrailer();

309
webtools/tinderbox2/src/bonsai_pvcs/cvsqueryform.cgi Executable file
Просмотреть файл

@ -0,0 +1,309 @@
#!/usr/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s):
# Query the CVS database.
#
use diagnostics;
use strict;
require 'CGI.pl';
require 'pvcs_query_checkins.pl';
$|=1;
print "Content-type: text/html\n\n";
require 'data/treeconfig.pl';
$::modules = {};
#require 'modules.pl';
$::CVS_ROOT = '/';
$::TreeInfo = ();
PutsHeader("Bonsai - CVS_PVCS Query Form", "CVS_PVCS Query Form",
"$::CVS_ROOT - $::TreeInfo{$::TreeID}{shortdesc}");
print "
<p>
<FORM METHOD=GET ACTION='cvsquery.cgi'>
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
<p>
<TABLE BORDER CELLPADDING=8 CELLSPACING=0>
";
#
# module selector
#
print "
<TR><TH ALIGN=RIGHT>Product_ID:</TH>
<TD>
<SELECT name='module' size=5>
";
#
# check to see if there are multiple repositories
#
my @reposList = &getRepositoryList();
my $bMultiRepos = (@reposList > 1);
#
# This code sucks, I should rewrite it to be shorter
#
my $Module = 'default';
if (!exists $::FORM{module} || $::FORM{module} eq 'all' ||
$::FORM{module} eq '') {
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
}
elsif( $::FORM{module} eq 'allrepositories' ){
print "<OPTION VALUE='all'>All Files in the Repository\n";
}
else {
$Module = $::FORM{module};
print "<OPTION VALUE='all'>All Files in the Repository\n";
my $escaped_module = html_quote($::FORM{module});
print "<OPTION SELECTED VALUE='$escaped_module'>$escaped_module\n";
}
#
# Print out all the Different Modules
#
load_product_id_into_modules();
for my $k (sort( keys( %$::modules ) ) ){
if (defined $::FORM{module} && $k eq $::FORM{module}) {
next;
}
print "<OPTION value='$k'>$k\n";
}
print "</SELECT></td>\n";
print "<td rowspan=2>";
cvsmenu();
print "</td></tr>";
#
# Branch
#
if( defined $::FORM{branch} ){
$b = $::FORM{branch};
}
else {
$b = "HEAD";
}
print "<tr>
<th align=right>WorkSet_Name:</th>
<td> <input type=text name=branch value='$b' size=25><br>\n" .
regexpradio('branchtype') .
"<br>(leaving this field empty will show you checkins on both
<tt>HEAD</tt> and branches)
</td></tr>";
#
# Query by directory
#
$::FORM{dir} ||= "";
print "
<tr>
<th align=right>Directory:</th>
<td colspan=2>
<input type=text name=dir value='$::FORM{dir}' size=45><br>
(you can list multiple directories)
</td>
</tr>
";
$::FORM{file} ||= "";
print "
<tr>
<th align=right>File:</th>
<td colspan=2>
<input type=text name=file value='$::FORM{file}' size=45><br>" .
regexpradio('filetype') . "
</td>
</tr>
";
#
# Who
#
$::FORM{who} ||= "";
print "
<tr>
<th align=right>Who:</th>
<td colspan=2> <input type=text name=who value='$::FORM{who}' size=45><br>" .
regexpradio('whotype') . "
</td>
</tr>";
#
# Log contains
#
$::FORM{logexpr} .= '';
print "
<tr>
<th align=right>Log contains:</th>
<td colspan=2> <input type=text name=logexpr value='$::FORM{logexpr}' size=45><br>
(you can use <a href=oracleregexp.cgi>regular expressions</a>)
</td>
</tr>
";
#
# Sort order
#
print "
<tr>
<th align=right>Sort By:</th>
<td colspan=2>
<SELECT name='sortby'>
<OPTION" . &sortTest("Date") . ">Date
<OPTION" . &sortTest("Who") . ">Who
<OPTION" . &sortTest("File") . ">File
<OPTION" . &sortTest("Change Size") . ">Change Size
</SELECT>
</td>
</tr>
";
#
# Print the date selector
#
if (!defined($::FORM{date}) || $::FORM{date} eq "") {
$::FORM{date} = "hours";
}
$::FORM{mindate} = '' unless defined($::FORM{mindate});
$::FORM{maxdate} = '' unless defined($::FORM{maxdate});
print "
<tr>
<th align=right valign=top><br>Date:</th>
<td colspan=2>
<table BORDER=0 CELLSPACING=0 CELLPADDING=0>
<tr>
<td><input type=radio name=date " . &dateTest("hours") . "></td>
<td>In the last <input type=text name=hours value=2 size=4> hours</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("day") . "></td>
<td>In the last day</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("week") . "></td>
<td>In the last week</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("month") . "></td>
<td>In the last month</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("all") . "></td>
<td>Since the beginning of time </td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("explicit") . "></td>
<td><table BORDER=0 CELLPADDING=0 CELLPSPACING=0>
<tr>
<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>
Between <input type=text name=mindate value='$::FORM{mindate}' size=25></td>
<td valign=top rowspan=2>You can use the form
<B><TT><NOBR>mm/dd/yyyy hh:mm:ss</NOBR></TT></B> or a Unix <TT>time_t</TT>
(seconds since the Epoch.)
</td>
</tr>
<tr>
<td VALIGN=TOP ALIGN=RIGHT NOWRAP>
and <input type=text name=maxdate value='$::FORM{maxdate}' size=25></td>
</tr>
</table>
</td>
</tr>
</table>
</tr>
";
print "
<tr>
<th><BR></th>
<td colspan=2>
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$::CVS_ROOT'>
<INPUT TYPE=SUBMIT VALUE='Run Query'>
</td>
</tr>
</table>
</FORM>";
PutsTrailer();
sub sortTest {
return ""
unless (exists($::FORM{sortby}) && defined($_[0]) &&
($_[0] eq $::FORM{sortby}));
return " SELECTED";
}
sub dateTest {
if( $_[0] eq $::FORM{date} ){
return " CHECKED value=$_[0]";
}
else {
return "value=$_[0]";
}
}
sub regexpradio {
my ($name) = @_;
my ($c1, $c2, $c3);
$c1 = $c2 = $c3 = "";
my $n = $::FORM{$name} || "";
if( $n eq 'regexp'){
$c2 = "checked";
}
elsif( $n eq 'notregexp'){
$c3 = "checked";
}
else {
$c1 = "checked";
}
return "
<input type=radio name=$name value=match $c1>Exact match
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<input type=radio name=$name value=regexp $c2><a href=oracleregexp.cgi>Regular&nbsp;expression</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<input type=radio name=$name value=notregexp $c3>Doesn't&nbsp;match&nbsp;<a href=oracleregexp.cgi>Reg&nbsp;Exp</a>";
}

344
webtools/tinderbox2/src/bonsai_pvcs/defparams.pl Executable file
Просмотреть файл

@ -0,0 +1,344 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bonsai Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
# This file defines all the parameters that we have a GUI to edit within
# Bonsai.
use diagnostics;
use strict;
sub WriteParams {
foreach my $i (@::param_list) {
if (!defined $::param{$i}) {
$::param{$i} = $::param_default{$i};
if (!defined $::param{$i}) {
die "No default parameter ever specified for $i";
}
}
}
mkdir("data", 0777);
chmod 0777, "data";
my $tmpname = "data/params.$$";
open(PARAM_FID, ">$tmpname") || die "Can't create $tmpname";
my $v = $::param{'version'};
delete $::param{'version'}; # Don't write the version number out to
# the params file.
print PARAM_FID GenerateCode('%::param');
$::param{'version'} = $v;
print PARAM_FID "1;\n";
close PARAM_FID;
rename $tmpname, "data/params" || die "Can't rename $tmpname to data/params";
chmod 0666, "data/params";
}
sub DefParam {
my ($id, $desc, $type, $default, $checker) = (@_);
push @::param_list, $id;
$::param_desc{$id} = $desc;
$::param_type{$id} = $type;
$::param_default{$id} = $default;
if (defined $checker) {
$::param_checker{$id} = $checker;
}
}
sub check_numeric {
my ($value) = (@_);
if ($value !~ /^[0-9]+$/) {
return "must be a numeric value";
}
return "";
}
sub check_urlbase {
my ($url) = (@_);
if ($url !~ m:^(http|/).*/$:) {
return "must be a legal URL, that starts with either 'http' or a slash, and ends with a slash.";
}
return "";
}
sub check_registryurl {
my ($url) = (@_);
if ($url !~ m:/$:) {
return "must be a legal URL ending with a slash.";
}
return "";
}
@::param_list = ();
# OK, here are the definitions themselves.
#
# The type of parameters (the third parameter to DefParam) can be one
# of the following:
#
# t -- A short text entry field (suitable for a single line)
# p -- A password text entry field
# l -- A long text field (suitable for many lines)
# b -- A boolean value (either 1 or 0)
# i -- An integer.
# defenum -- This param defines an enum that defines a column in one of
# the database tables. The name of the parameter is of the form
# "tablename.columnname".
DefParam("maintainer",
"The email address of the person who maintains this installation of Bonsai.",
"t",
'THE MAINTAINER HAS NOT YET BEEN SET');
DefParam("userdomain",
"The default domain of the people who don't have an \@ in their email address.",
"t",
"");
DefParam("urlbase",
"The URL that is the common initial leading part of all Bonsai URLs.",
"t",
"http://www.mozilla.org/webtools/bonsai/",
\&check_urlbase);
DefParam("toplevel",
"What is the top level of bonsai called. Links to
the toplevel.cgi script will be named this.",
"t",
"hooklist");
DefParam("cvsadmin",
"The email address of the person responsible for cvs.",
"t",
'%maintainer%');
DefParam("mysqluser",
"The username of the bonsai database user.",
"t",
"nobody");
DefParam("mysqlpassword",
"The password of the bonsai database user.",
"p",
"");
DefParam("dbiparam",
"The first parameter to pass to the DBI->connect() method. This may need to be changed to be simply 'bonsai' for older versions of the perl MySQL libraries.",
"t",
"DBI:mysql:database=bonsai;");
DefParam("readonly",
"Are the hook files readonly. (This value gets changed on the fly,
so it is ok to leave the way it is.)",
"b",
0);
##
## Page configuration (look and feel)
##
DefParam("headerhtml",
"Additional HTML to add to the HEAD area of documents, eg. links to stylesheets.",
"l",
'');
DefParam("bannerhtml",
"The html that gets emitted at the head of every Bonsai page.
Anything of the form %<i>word</i>% gets replaced by the defintion of that
word (as defined on this page).",
"l",
q{<TABLE BGCOLOR="#FFFFFF" WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR><TD><!-- insert imagery here --></TD></TR></TABLE>
<CENTER><FONT SIZE=-1>Bonsai version %version%
</FONT></CENTER>});
DefParam("blurbhtml",
"A blurb that appears as part of the header of every Bonsai page. This is a place to put brief warnings, pointers to one or two related pages, etc.",
"l",
"This is <B>Bonsai</B>: a query interface to the CVS source repository");
##
## Command addresses/locations
##
DefParam("mailrelay",
"This is the default mail relay (SMTP Server) that we use to transmit email messages.",
"t",
'localhost');
DefParam("cvscommand",
"This is the location of the CVS command.",
"t",
'/usr/bin/cvs');
DefParam("rlogcommand",
"This is the location of the rlog command.",
"t",
'/usr/bin/rlog');
DefParam("rcsdiffcommand",
"This is the location of the rcsdiff command.",
"t",
'/usr/bin/rcsdiff');
DefParam("cocommand",
"This is the location of the RCS co command.",
"t",
'/usr/bin/co');
DefParam("cvsgraph",
"cvsgraph is an application that will output, in the form of a
graphic, every branch, tag, and revision that exists for a file. It requires
that the <a href=\"http://www.akhphd.au.dk/~bertho/cvsgraph/\">cvsgraph
executable</a> be installed on this system. If you don't wish to use
cvsgraph, leave this param blank.",
"t",
"");
##
## Things that we link to on the fly
##
DefParam("lxr_base",
"The URL that is the common initial leading part of all LXR URLs.",
"t",
"http://lxr.mozilla.org/",
\&check_urlbase);
DefParam("lxr_mungeregexp",
'A regexp to use to munge a pathname from the $CVSROOT into a valid LXR pathname. So, for example, if we tend to have a lot of pathnames that start with "mozilla/", and the LXR URLs should not contain that leading mozilla/, then you would use something like: s@^mozilla/@@',
"t",
"");
DefParam("bugs_base",
"The URL that is the common initial leading part of all Bugzilla URLs.",
"t",
"http://bugzilla.mozilla.org/",
\&check_urlbase);
DefParam("bugsmatch",
'Bugsmatch defines the number of consecutive digits that identify a bug to link to.',
't',
2);
DefParam("bugsystemexpr",
'Bugsystemexpr defines what to replace a number found in log
messages with. It is used to generate an HTML reference to
the bug database in the displayed text. The number of the
bug found can be inserted using the %bug_id% substitution.',
"t",
'<A HREF="%bugs_base%show_bug.cgi?id=%bug_id%">%bug_id%</A>');
##
## Email Addresses that get sent messages automatically when certain
## events happen
##
DefParam("bonsai-hookinterest",
"The email address of the build team interested in the status of the hook.",
"t",
"bonsai-hookinterest");
DefParam("bonsai-daemon",
"The email address of the sender of Bonsai related mail.",
"t",
"bonsai-daemon");
DefParam("bonsai-messageinterest",
"The email address of those interested in the status of Bonsai itself.",
"t",
"bonsai-messageinterest");
DefParam("bonsai-treeinterest",
"The email address of those interested in the status of development trees.",
"t",
"bonsai-treeinterest");
DefParam("software",
"The email address list of those doing development on the trees.",
"t",
"software");
##
## LDAP configuration
##
DefParam("ldapserver",
"The address ofthe LDAP server containing name information,
leave blank if you don't have an LDAP server.",
"t",
'');
DefParam("ldapport",
"The port of the LDAP server.",
"t",
389);
##
## Other URLs
##
DefParam("tinderboxbase",
"The base URL of the tinderbox build pages. Leave blank if
you don't want to use tinderbox.",
"t",
"");
DefParam("other_ref_urls",
"A list of pointers to other documentation, displayed on main bonsai menu",
"l",
'<a href=http://www.mozilla.org/hacking/bonsai.html>Mozilla\'s Introduction to Bonsai.</a><br>');
DefParam("phonebookurl",
'A URL used to generate lookups for usernames. The following
parameters are substituted: %user_name% for the user\'s name
in bonsai; %email_name% for the user\'s email address; and
%account_name% for the user\'s account name on their email
system (ie account_name@some.domain).',
"t",
# '<a href="http://phonebook/ds/dosearch/phonebook/uid=%account_name%,ou=People,o= Netscape Communications Corp.,c=US">%user_name%</a>'
'<a href="mailto:%email_name%">%user_name%</a>'
);
DefParam("registryurl",
"A URL relative to urlbase (or an absolute URL) which leads to the
installed 'registry' package (available from the mozilla.org repository as
a sibling directory to the 'bonsai' directory.). This contains pages that
generate lists of links about a person or a file.",
"t",
qq{../registry/},
\&check_registryurl);
1;

231
webtools/tinderbox2/src/bonsai_pvcs/get_all_tree_data Executable file
Просмотреть файл

@ -0,0 +1,231 @@
#!/usr/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# Output all the PVCS Tree data in a format which Tinderbox can
# source. This file should probably be run from crontabs daily. By
# convention we are only interested in Prouct_ID, Workset_Name pairs
# where the two are equal.
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# complete rewrite by Ken Estes:
# kestes@staff.mail.com Old work.
# kestes@reefedge.com New work.
# kestes@walrus.com Home.
# Contributor(s):
# $Revision: 1.1 $
# $Date: 2003/12/24 12:16:36 $
# $Author: kestes%walrus.com $
# $Source: /home/hwine/cvs_conversion/cvsroot/mozilla/webtools/tinderbox2/src/bonsai_pvcs/get_all_tree_data,v $
# $Name: $
use Time::Local;
$sql_user = 'tinderbox/tinderbox';
$sep = '___///___';
sub time2pvcsFormat {
# convert time() format to the format which appears in perforce output
my ($time) = @_;
my ($sec,$min,$hour,$mday,$mon,
$year,$wday,$yday,$isdst) =
localtime($time);
$year += 1900;
$mon++;
my $date_str = sprintf("%04u/%02u/%02u/%02u/%02u/%02u",
$year, $mon, $mday, $hour, $min, $sec);
return ($date_str);
}
sub pvcs_date_str2time {
my ($pvcs_date_str) = @_;
my ($year, $mon, $mday, $hour, $min, $sec) =
split('/', $pvcs_date_str);
$mon--;
my ($time) = timelocal($sec,$min,$hour,$mday,$mon,$year);
return $time;
}
sub pvcs_trim_whitespace {
my ($line) = (@_);
$line =~ s{\t+}{}g;
$line =~ s{\n+}{}g;
$line =~ s{ +}{}g;
return $line;
}
# Adapted from oraselect()
# code by Ulrich Herbst <Ulrich.Herbst@gmx.de>
# found at
# http://servdoc.sourceforge.net/docs/pod/ServDoc_0310oracle.pod.html
sub get_oraselect_separator {
return $sep;
}
sub oraselect {
my ($sqltable) = @_;
my $tmpfile = "/tmp/oracle.$$.sql";
my $SQLCMD = 'sqlplus';
$OSNAME = $^O;
if ($OSNAME =~ /MSWin32/) {
$SQLCMD='plus80';
$tmpfile='c:\TEMP\oracle.$$.sql';
}
# We don't use pipes to input sqlplus because that doesn't work
# for windows.
my $sqlheader = <<"EOSQL";
set pages 0
set pagesize 10000
set linesize 10000
set heading off
set feedback off
set serveroutput on
set colsep '$sep'
alter session set NLS_DATE_FORMAT='yyyy/mm/dd/hh24/mi/ss';
EOSQL
;
open TEMPFH, ">$tmpfile";
print TEMPFH "$sqlheader\n";
print TEMPFH "$sqltable\n";
print TEMPFH "exit;\n";
close TEMPFH;
my $executestring;
if ($OSNAME =~ /MSWin32/) {
$executestring = "$SQLCMD -s '$sql_user' \@$tmpfile 2>&1";
} else {
$executestring =
"source /etc/profile; ".
"$SQLCMD -s \'$sql_user\' \@$tmpfile 2>&1";
}
my @sqlout=`$executestring`;
# I do not thin sqlplus ever returns non zero, but I wish to be
# complete to I check it. Real errors are harder to discribe, we
# use pattern matching to find strings like:
# SP2-0042: unknown command "asdf" - rest of line ignored.
# ORA-00923: FROM keyword not found where expected
my $rc = $?;
if (
($rc) ||
("@sqlout" =~ m/\nERROR at line /) ||
("@sqlout" =~ m/\n[A-Z0-9]+\-\d+\:/) ||
0) {
die(@sqlout);
}
unlink ($tmpfile);
return \@sqlout;
}
sub all_pvcs_tree_data {
# By convention we are only interested in the workset names which match
# their product_id's
my $sqltable = <<"EOSQL";
SELECT DISTINCT
PCMS_ITEM_DATA."PRODUCT_ID",
PCMS_WORKSET_INFO."WORKSET_NAME"
FROM
"PCMS"."PCMS_ITEM_DATA" PCMS_ITEM_DATA,
"PCMS"."PCMS_WORKSET_INFO" PCMS_WORKSET_INFO
WHERE
PCMS_ITEM_DATA."PRODUCT_ID" = PCMS_WORKSET_INFO."PRODUCT_ID" AND
PCMS_ITEM_DATA."PRODUCT_ID" = PCMS_WORKSET_INFO."WORKSET_NAME"
ORDER BY
PCMS_ITEM_DATA."PRODUCT_ID";
exit;
EOSQL
;
$sqlout = oraselect($sqltable);
my $out .= "\n\n\%VC_TREE = (\n\n";
foreach $line (@{ $sqlout }) {
chomp $line;
($line) || next;
my ($product_id) = split (/$sep/ , $line);
$p = pvcs_trim_whitespace($product_id);
$out .= <<EOF
'$p' => {
module => '$p',
branch => '$p',
},
EOF
;
}
$out .="\n);\n\n";
$out .="1;\n\n";
$out .="# automatically created by: $0\n";
$out .="# on: ";
$out .= localtime(time());
$out .="\n\n";
return $out;
}
my $out = all_pvcs_tree_data();
print $out;
1;

1253
webtools/tinderbox2/src/bonsai_pvcs/globals.pl Executable file
Просмотреть файл

Разница между файлами не показана из-за своего большого размера Загрузить разницу

86
webtools/tinderbox2/src/bonsai_pvcs/oracleregexp.cgi Executable file
Просмотреть файл

@ -0,0 +1,86 @@
#!/usr/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s):
print "Content-type: text/html\n\n";
$out =<<EOF
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="Author" CONTENT="lloyd tabb">
<META NAME="GENERATOR" CONTENT="Mozilla/4.0 [en] (WinNT; I) [Netscape]">
<TITLE>Regular expressions in the cvs_pvcs query tool</TITLE>
</HEAD>
<BODY>
<H1>
Description of Oracle regular expression syntax.</H1>
Regular expressions are a powerful way of specifying complex searches.
<h2>LIKE</h2>
<p>
The LIKE predicate provides the only pattern matching capability in SQL for the character data types. It takes the following form
</p>
<pre>
columnname [NOT] LIKE pattern-to-match
</pre>
<p>
The pattern match characters are the percent sign (%) to denote 0 or more arbitrary characters, and the underscore (_) to denote exactly one arbitrary character.
</p>
<p>
List the employee numbers and surnames of all employees who have a surname beginning with C.
</p>
<pre>
SELECT empno,surname
FROM employee
WHERE surname LIKE 'C%'
</pre>
<p>
List all course numbers and names for any course to do with accounting.
</p>
<pre>
SELECT courseno,cname
FROM course
WHERE cname LIKE '%ccount%'
</pre>
<p>
List all employees who have r as the second letter of their forename.
</p>
<pre>
SELECT surname, forenames
FROM employee
WHERE forenames LIKE '_r%'
</pre>
&nbsp;
</BODY>
</HTML>
EOF
;
print $out;
exit 0;

499
webtools/tinderbox2/src/bonsai_pvcs/pvcs_query_checkins.pl Executable file
Просмотреть файл

@ -0,0 +1,499 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# This file interfaces PVCS into the original Bonsai code. The
# resulting Bonsai hack will allow users to query the PVCS database
# using SQL. Many of the original bonsai features are not applicable
# in this environment and have been removed.
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# complete rewrite by Ken Estes:
# kestes@staff.mail.com Old work.
# kestes@reefedge.com New work.
# kestes@walrus.com Home.
# Contributor(s):
# $Revision: 1.1 $
# $Date: 2003/12/24 12:16:36 $
# $Author: kestes%walrus.com $
# $Source: /home/hwine/cvs_conversion/cvsroot/mozilla/webtools/tinderbox2/src/bonsai_pvcs/pvcs_query_checkins.pl,v $
# $Name: $
require Time::Local;
require Data::Dumper;
$sql_user = 'tinderbox/tinderbox';
$sep = '___///___';
sub time2pvcsFormat {
# convert time() format to the format which appears in perforce output
my ($time) = @_;
my ($sec,$min,$hour,$mday,$mon,
$year,$wday,$yday,$isdst) =
localtime($time);
$year += 1900;
$mon++;
my $date_str = sprintf("%04u/%02u/%02u/%02u/%02u/%02u",
$year, $mon, $mday, $hour, $min, $sec);
return ($date_str);
}
sub pvcs_date_str2time {
my ($pvcs_date_str) = @_;
my ($year, $mon, $mday, $hour, $min, $sec) =
split('/', $pvcs_date_str);
$mon--;
my ($time) = timelocal($sec,$min,$hour,$mday,$mon,$year);
return $time;
}
sub pvcs_trim_whitespace {
my ($line) = (@_);
$line =~ s{\t+}{}g;
$line =~ s{\n+}{}g;
$line =~ s{ +}{}g;
return $line;
}
# Adapted from oraselect()
# code by Ulrich Herbst <Ulrich.Herbst@gmx.de>
# found at
# http://servdoc.sourceforge.net/docs/pod/ServDoc_0310oracle.pod.html
sub get_oraselect_separator {
return $sep;
}
sub oraselect {
my ($sqltable) = @_;
my $tmpfile = "/tmp/oracle.$$.sql";
my $SQLCMD = 'sqlplus';
$OSNAME = $^O;
if ($OSNAME =~ /MSWin32/) {
$SQLCMD='plus80';
$tmpfile='c:\TEMP\oracle.$$.sql';
}
# We don't use pipes to input sqlplus because that doesn't work
# for windows.
my $sqlheader = <<"EOSQL";
set pages 0
set pagesize 10000
set linesize 10000
set heading off
set feedback off
set serveroutput on
set colsep '$sep'
alter session set NLS_DATE_FORMAT='yyyy/mm/dd/hh24/mi/ss';
EOSQL
;
open TEMPFH, ">$tmpfile";
print TEMPFH "$sqlheader\n";
print TEMPFH "$sqltable\n";
print TEMPFH "exit;\n";
close TEMPFH;
my $executestring;
if ($OSNAME =~ /MSWin32/) {
$executestring = "$SQLCMD -s '$sql_user' \@$tmpfile 2>&1";
} else {
$executestring =
"source /etc/profile; ".
"$SQLCMD -s \'$sql_user\' \@$tmpfile 2>&1";
}
my @sqlout=`$executestring`;
# I do not thin sqlplus ever returns non zero, but I wish to be
# complete to I check it. Real errors are harder to discribe, we
# use pattern matching to find strings like:
# SP2-0042: unknown command "asdf" - rest of line ignored.
# ORA-00923: FROM keyword not found where expected
my $rc = $?;
if (
($rc) ||
("@sqlout" =~ m/\nERROR at line /) ||
("@sqlout" =~ m/\n[A-Z0-9]+\-\d+\:/) ||
0) {
die(@sqlout);
}
unlink ($tmpfile);
return \@sqlout;
}
sub create_where_stmt {
my (
$query_module,
$query_branch,
$query_branch_head,
$query_branchtype,
$query_who,
$query_whotype,
$query_date_max,
$query_date_min,
$query_logexpr,
$query_file,
$query_filetype,
@query_dirs,
) = @_;
if (
( $query_module eq 'allrepositories' ) ||
( $query_module eq 'all' ) ||
( $query_module eq 'All' ) ||
0){
1;
} else {
my $q = SqlQuote($query_module);
$qstring1 .= "PCMS_ITEM_DATA.\"PRODUCT_ID\" = $q AND ";
}
if (
($query_branch_head) ||
($query_branch eq 'head') ||
($query_branch eq 'HEAD') ||
0) {
1;
} elsif ($query_branch ne '') {
my $q = SqlQuote($query_branch);
if ($query_branchtype eq 'regexp') {
$qstring1 .=
" PCMS_WORKSET_INFO.\"WORKSET_NAME\" LIKE $q AND ";
} elsif ($query_branchtype eq 'notregexp') {
$qstring1 .=
" PCMS_WORKSET_INFO.\"WORKSET_NAME\" NOT LIKE $q AND ";
} else {
$qstring1 .=
" PCMS_WORKSET_INFO.\"WORKSET_NAME\" = $q AND ";
}
}
if ($query_date_min) {
my $t = time2pvcsFormat($query_date_min);
$qstring1 .= "PCMS_ITEM_DATA.\"CREATE_DATE\" >= '$t' AND ";
}
if ($query_date_max) {
my $t = time2pvcsFormat($query_date_max);
$qstring1 .= "PCMS_ITEM_DATA.\"CREATE_DATE\" <= '$t' AND ";
}
if (0 < @query_dirs) {
my @list;
foreach my $i (@query_dirs) {
my $l = "PCMS_ITEM_DATA.\"LIB_FILENAME\" LIKE " . SqlQuote("$i%");
push(@list, $l);
}
$qstring1 .= " (" . join(" or ", @list) . ") AND ";
}
if (defined $query_file && $query_file ne '') {
my $q = SqlQuote($query_file);
$query_filetype ||= "exact";
if ($query_filetype eq 'regexp') {
$qstring1 .= "PCMS_ITEM_DATA.\"LIB_FILENAME\" LIKE $q AND ";
} elsif ($query_filetype eq 'notregexp') {
$qstring1 .= "PCMS_ITEM_DATA.\"LIB_FILENAME\" NOT LIKE $q AND ";
} else {
$qstring1 .= "PCMS_ITEM_DATA.\"LIB_FILENAME\" = $q AND ";
}
}
if (defined $query_who && $query_who ne '') {
my $q = SqlQuote($query_who);
$query_whotype ||= "exact";
if ($query_whotype eq 'regexp') {
$qstring1 .= "PCMS_ITEM_DATA.\"ORIGINATOR\" LIKE $q AND ";
}
elsif ($query_whotype eq 'notregexp') {
$qstring1 .= "PCMS_ITEM_DATA.\"ORIGINATOR\" NOT LIKE $q AND ";
} else {
$qstring1 .= "PCMS_ITEM_DATA.\"ORIGINATOR\" = $q AND ";
}
}
if (defined($query_logexpr) && $query_logexpr ne '') {
my $q = SqlQuote($query_logexpr);
$qstring1 .= " PCMS_CHDOC_DATA.\"TITLE\" = $q AND ";
}
$qstring1 .= "PCMS_ITEM_DATA.\"PRODUCT_ID\" = PCMS_WORKSET_INFO.\"PRODUCT_ID\" AND ";
$qstring1 .= "PCMS_CHDOC_RELATED_ITEMS.\"TO_ITEM_UID\" = PCMS_ITEM_DATA.\"ITEM_UID\" AND ";
$qstring1 .= "PCMS_CHDOC_RELATED_ITEMS.\"FROM_CH_UID\" = PCMS_CHDOC_DATA.\"CH_UID\" ";
return $qstring1;
}
# a drop in replacement for the bonsai
# function sub query_checkins found in cvsquery.pl
sub query_checkins {
# the function takes these global variables as arguments:
# $::query_module
# $::query_branch
# $::query_branchtype
# $::query_who
# $::query_whotype
# $::query_date_max
# $::query_date_min
# $::query_logexpr
# $::query_file
# $::query_filetype
# @::query_dirs
# $::query_module
# $::query_branch
# $::query_branchtype
# $::query_who
# $::query_whotype
# $::query_date_max
# $::query_date_min
# $::query_logexpr
# $::query_file
# $::query_filetype
# @::query_dirs
# print "query_module: $::query_module, query_branch: $::query_branch<br>\n";
$where_stmt = create_where_stmt (
$::query_module,
$::query_branch,
$::query_branch_head,
$::query_branchtype,
$::query_who,
$::query_whotype,
$::query_date_max,
$::query_date_min,
$::query_logexpr,
$::query_file,
$::query_filetype,
@::query_dirs,
);
# print"$where_stmt<br>\n";
my $sqltable = <<"EOSQL";
SELECT
PCMS_ITEM_DATA."PRODUCT_ID",
PCMS_ITEM_DATA."CREATE_DATE",
PCMS_ITEM_DATA."ORIGINATOR",
PCMS_ITEM_DATA."LIB_FILENAME",
PCMS_ITEM_DATA."REVISION",
PCMS_ITEM_DATA."STATUS",
PCMS_WORKSET_INFO."WORKSET_NAME",
PCMS_CHDOC_DATA."CH_DOC_ID",
PCMS_CHDOC_DATA."TITLE"
FROM
"PCMS"."PCMS_ITEM_DATA" PCMS_ITEM_DATA,
"PCMS"."PCMS_WORKSET_INFO",
"PCMS"."PCMS_CHDOC_DATA" PCMS_CHDOC_DATA,
"PCMS"."PCMS_CHDOC_RELATED_ITEMS" PCMS_CHDOC_RELATED_ITEMS
WHERE
$where_stmt
ORDER BY
PCMS_CHDOC_DATA."CH_DOC_ID" DESC;
exit;
EOSQL
;
$sqlout = oraselect($sqltable);
# print $sqltable. "<br><br>\n\n";
# print $sqlout. "<br><br>\n\n";
my @out;
# we get back these values from PVCS.
my (
$product_id,
$create_date,
$originator,
$lib_filename,
$revision,
$status,
$workset_name,
$ch_doc_id,
$title,
);
# Fudge some bonsai arguments which we do not have data for or do
# not care about.
my $rectype = 'M';
my $lines_added = 0;
my $lines_removed = 0;
my $dir = '<ignored>';
my $sticky = '<ignored>';
my $repository = '<ignored>';
foreach $line (@{ $sqlout }) {
chomp $line;
($line) || next;
(
$product_id,
$create_date,
$originator,
$lib_filename,
$revision,
$status,
$workset_name,
$ch_doc_id,
$title,
) = split (/$sep/ , $line);
$product_id = pvcs_trim_whitespace($product_id);
$lib_filename = pvcs_trim_whitespace($lib_filename);
$originator = pvcs_trim_whitespace($originator);
$create_date = pvcs_trim_whitespace($create_date);
$revision = pvcs_trim_whitespace($revision);
$status = pvcs_trim_whitespace($status);
$workset_name = pvcs_trim_whitespace($workset_name);
$ch_doc_id = pvcs_trim_whitespace($ch_doc_id);
$status = pvcs_trim_whitespace($status);
my $time = pvcs_date_str2time($create_date);
@row = (
$rectype, $time, $originator, $repository,
$dir, $lib_filename,
$revision, $sticky, $workset_name,
$lines_added, $lines_removed, "$ch_doc_id: $title",
);
# This the format that Bonsai expects to get back is a LoL
# a list (rows from the database) of
# lists (columns for each line, these columns must be in the
# Bonsai expected order).
push @out, [ @row ];
}
my $result = \@out;
return $result;
}
sub load_product_id_into_modules {
$module_cache_file = './data/modules';
# Tell Bonsai what the possible Product_ID's are so that it can
# create a pick list at the top of the SQL query page. We cache
# this information and only perform the SQL call once a day.
my $sqltable = <<"EOSQL";
SELECT DISTINCT
PCMS_WORKSET_INFO."PRODUCT_ID"
FROM
"PCMS"."PCMS_WORKSET_INFO" PCMS_WORKSET_INFO
ORDER BY
PCMS_WORKSET_INFO."PRODUCT_ID";
exit;
EOSQL
;
if (-M $module_cache_file < 1) {
require($module_cache_file) ||
die("Could not eval filename: $module_cache_file: $!\n");
return ;
}
$sqlout = oraselect($sqltable);
foreach $line (@{ $sqlout }) {
chomp $line;
($line) || next;
my $product_id = pvcs_trim_whitespace($line);
# Bonsai expects this information in a global variable.
$::modules->{$product_id} = 1;
}
my (@out) = (
Data::Dumper->Dump([$::modules], ["\$::modules"],).
"1;\n"
);
open(NEW, "> $module_cache_file") ||
die "Couldn't create `$module_cache_file': $!";
print NEW "@out\n";
close(NEW);
return ;
}
1;