1998-06-16 21:43:24 +00:00
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
1999-11-01 23:33:56 +00:00
# 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/
1998-06-16 21:43:24 +00:00
#
1999-11-01 23:33:56 +00:00
# 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.
1998-06-16 21:43:24 +00:00
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
1999-11-01 23:33:56 +00:00
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s):
1998-06-16 21:43:24 +00:00
1999-07-23 18:39:31 +00:00
require 'globals.pl' ;
1999-09-17 15:47:03 +00:00
require 'get_line.pl' ;
1998-06-16 21:43:24 +00:00
1999-10-18 22:55:01 +00:00
use diagnostics ;
use strict ;
# Shut up misguided -w warnings about "used only once". "use vars" just
# doesn't work for me.
sub cvsquery_pl_sillyness {
my $ zz ;
$ zz = $ ::CI_BRANCH ;
$ zz = $ ::CI_CHANGE ;
$ zz = $ ::CI_DATE ;
$ zz = $ ::CI_STICKY ;
$ zz = $ ::TreeID ;
$ zz = $ ::query_debug ;
$ zz = $ ::query_filetype ;
$ zz = $ ::versioninfo ;
} ;
1998-06-16 21:43:24 +00:00
#
# Constants
#
1999-10-18 22:55:01 +00:00
$ ::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 ;
chomp ( $ ::CVS_ROOT ) if defined ( $ ::CVS_ROOT ) ;
if ( ! defined ( $ ::CVS_ROOT ) || $ ::CVS_ROOT eq "" ) {
$ ::CVS_ROOT = pickDefaultRepository ( ) ;
1998-06-16 21:43:24 +00:00
}
#global variables
1999-10-18 22:55:01 +00:00
$ ::lines_added = 0 ;
$ ::lines_removed = 0 ;
1998-06-16 21:43:24 +00:00
1999-10-18 22:55:01 +00:00
$ ::modules = { } ;
1999-07-26 16:10:55 +00:00
1999-10-18 22:55:01 +00:00
my $ CVS_MODULES = "$::CVS_ROOT/CVSROOT/modules" ;
1999-07-26 16:10:55 +00:00
open ( MOD , "<$CVS_MODULES" ) || die "can't open ${CVS_MODULES}" ;
& parse_modules ;
close ( MOD ) ;
1998-06-16 21:43:24 +00:00
1 ;
#
# Actually do the query
#
sub query_checkins {
1999-07-23 18:39:31 +00:00
my ( % mod_map ) = @ _ ;
my ( $ ci , $ result , $ lastlog , $ rev , $ begin_tag , $ end_tag ) ;
1999-10-18 22:55:01 +00:00
my $ have_mod_map ;
1998-06-16 21:43:24 +00:00
1999-10-19 00:20:52 +00:00
$ ::query_module = 'all' unless defined $ ::query_module ;
1999-10-18 22:55:01 +00:00
if ( $ ::query_module ne 'all' && $ ::query_module ne 'allrepositories' && @ ::query_dirs == 0 ) {
1998-06-16 21:43:24 +00:00
$ have_mod_map = 1 ;
1999-10-18 22:55:01 +00:00
% mod_map = & get_module_map ( $ ::query_module ) ;
1998-06-16 21:43:24 +00:00
}
else {
$ have_mod_map = 0 ;
1999-07-23 18:39:31 +00:00
% mod_map = ( ) ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
for my $ i ( @ ::query_dirs ) {
1998-06-16 21:43:24 +00:00
$ i =~ s: ^ / :: ; # Strip leading slash.
$ i =~ s: / $ :: ; # Strip trailing slash.
if ( ! $ have_mod_map ) {
1999-07-23 18:39:31 +00:00
% mod_map = ( ) ;
1998-06-16 21:43:24 +00:00
$ have_mod_map = 1 ;
}
1999-07-23 18:39:31 +00:00
$ mod_map { $ i } = $ NOT_LOCAL ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( $ ::query_branch =~ /^[ ]*HEAD[ ]*$/i ) {
$ ::query_branch_head = 1 ;
1998-06-16 21:43:24 +00:00
}
$ begin_tag = "" ;
$ end_tag = "" ;
1999-10-18 22:55:01 +00:00
if ( defined ( $ ::query_begin_tag ) && $ ::query_begin_tag ne '' ) {
$ begin_tag = load_tag ( $ ::query_begin_tag ) ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( defined ( $ ::query_end_tag ) && $ ::query_end_tag ne '' ) {
$ end_tag = load_tag ( $ ::query_end_tag ) ;
1998-06-16 21:43:24 +00:00
}
$ result = [] ;
1999-07-23 18:39:31 +00:00
ConnectToDatabase ( ) ;
1998-06-16 21:43:24 +00:00
1999-10-12 18:05:42 +00:00
my $ qstring = "select type, UNIX_TIMESTAMP(ci_when), people.who, repositories.repository, dirs.dir, files.file, revision, stickytag, branches.branch, addedlines, removedlines, descs.description from checkins,people,repositories,dirs,files,branches,descs where people.id=whoid and repositories.id=repositoryid and dirs.id=dirid and files.id=fileid and branches.id=branchid and descs.id=descid" ;
1998-06-16 21:43:24 +00:00
1999-10-18 22:55:01 +00:00
if ( $ ::query_module ne 'allrepositories' ) {
$ qstring . = " and repositories.repository = '$::CVS_ROOT'" ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( $ ::query_date_min ) {
my $ t = formatSqlTime ( $ ::query_date_min ) ;
1999-10-12 18:05:42 +00:00
$ qstring . = " and ci_when >= '$t'" ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( $ ::query_date_max ) {
my $ t = formatSqlTime ( $ ::query_date_max ) ;
1999-10-12 18:05:42 +00:00
$ qstring . = " and ci_when <= '$t'" ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( $ ::query_branch_head ) {
1998-06-16 21:43:24 +00:00
$ qstring . = " and branches.branch = ''" ;
1999-10-18 22:55:01 +00:00
} elsif ( $ ::query_branch ne '' ) {
my $ q = SqlQuote ( $ ::query_branch ) ;
if ( $ ::query_branchtype eq 'regexp' ) {
1998-06-16 21:43:24 +00:00
$ qstring . =
1999-07-23 18:39:31 +00:00
" and branches.branch regexp $q" ;
1999-10-18 22:55:01 +00:00
} elsif ( $ ::query_branchtype eq 'notregexp' ) {
1998-10-08 22:01:36 +00:00
$ qstring . =
1999-07-23 18:39:31 +00:00
" and not (branches.branch regexp $q) " ;
1998-06-16 21:43:24 +00:00
} else {
$ qstring . =
1999-07-23 18:39:31 +00:00
" and (branches.branch = $q or branches.branch = " ;
1999-10-18 22:55:01 +00:00
$ qstring . = SqlQuote ( "T$::query_branch" ) . ")" ;
1998-06-16 21:43:24 +00:00
}
}
1999-11-19 17:22:47 +00:00
if ( 0 < @ ::query_dirs ) {
2000-01-19 19:04:31 +00:00
my @ list ;
1999-11-19 17:22:47 +00:00
foreach my $ i ( @ ::query_dirs ) {
2000-01-19 19:04:31 +00:00
push ( @ list , "dirs.dir like " . SqlQuote ( "$i%" ) ) ;
1999-11-19 17:22:47 +00:00
}
2000-01-19 19:04:31 +00:00
$ qstring . = "and (" . join ( " or " , @ list ) . ")" ;
1999-11-19 17:22:47 +00:00
}
1999-10-18 22:55:01 +00:00
if ( defined $ ::query_file && $ ::query_file ne '' ) {
my $ q = SqlQuote ( $ ::query_file ) ;
1999-10-26 21:14:01 +00:00
$ ::query_filetype || = "exact" ;
1999-10-18 22:55:01 +00:00
if ( $ ::query_filetype eq 'regexp' ) {
1999-07-23 18:39:31 +00:00
$ qstring . = " and files.file regexp $q" ;
1998-06-16 21:43:24 +00:00
} else {
1999-07-23 18:39:31 +00:00
$ qstring . = " and files.file = $q" ;
1998-06-16 21:43:24 +00:00
}
}
1999-10-18 22:55:01 +00:00
if ( defined $ ::query_who && $ ::query_who ne '' ) {
my $ q = SqlQuote ( $ ::query_who ) ;
1999-10-18 23:42:25 +00:00
$ ::query_whotype || = "exact" ;
1999-10-18 22:55:01 +00:00
if ( $ ::query_whotype eq 'regexp' ) {
1999-07-23 18:39:31 +00:00
$ qstring . = " and people.who regexp $q" ;
1998-10-08 22:01:36 +00:00
}
1999-10-18 22:55:01 +00:00
elsif ( $ ::query_whotype eq 'notregexp' ) {
1999-07-23 18:39:31 +00:00
$ qstring . = " and not (people.who regexp $q)" ;
1998-10-08 22:01:36 +00:00
1998-06-16 21:43:24 +00:00
} else {
1999-07-23 18:39:31 +00:00
$ qstring . = " and people.who = $q" ;
1998-06-16 21:43:24 +00:00
}
}
1999-10-18 22:55:01 +00:00
if ( defined ( $ ::query_logexpr ) && $ ::query_logexpr ne '' ) {
my $ q = SqlQuote ( $ ::query_logexpr ) ;
1999-07-23 18:39:31 +00:00
$ qstring . = " and descs.description regexp $q" ;
1998-06-16 21:43:24 +00:00
}
1999-10-18 22:55:01 +00:00
if ( $ ::query_debug ) {
1999-07-26 16:10:55 +00:00
print "<pre wrap> Query: $qstring\nTreeID is $::TreeID\n" ;
if ( $ have_mod_map ) {
print "Dump of module map:\n" ;
foreach my $ k ( sort ( keys % mod_map ) ) {
print value_quote ( "$k => $mod_map{$k}" ) . "\n" ;
}
1999-10-21 22:04:13 +00:00
print "\n\nDump of parsed module file:\n" ;
foreach my $ k ( sort ( keys %$ ::modules ) ) {
print value_quote ( "$k => " .
join ( "," , @ { $ ::modules - > { $ k } } ) ) . "\n" ;
}
1999-07-26 16:10:55 +00:00
}
print "</pre>\n" ;
1998-06-16 21:43:24 +00:00
}
1999-07-23 18:39:31 +00:00
SendSQL ( $ qstring ) ;
1998-06-16 21:43:24 +00:00
$ lastlog = 0 ;
1999-10-18 22:55:01 +00:00
my @ row ;
1999-07-23 18:39:31 +00:00
while ( @ row = FetchSQLData ( ) ) {
#print "<pre>";
1999-04-09 14:22:53 +00:00
$ ci = [] ;
1999-10-18 22:55:01 +00:00
for ( my $ i = 0 ; $ i <= $ ::CI_LOG ; $ i + + ) {
1998-06-16 21:43:24 +00:00
$ ci - > [ $ i ] = $ row [ $ i ] ;
1999-07-23 18:39:31 +00:00
#print "$row[$i] ";
1998-06-16 21:43:24 +00:00
}
1999-07-23 18:39:31 +00:00
#print "</pre>";
1998-06-16 21:43:24 +00:00
1999-10-18 22:55:01 +00:00
my $ key = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]" ;
if ( IsHidden ( "$ci->[$::CI_REPOSITORY]/$key" ) ) {
1998-06-18 16:47:00 +00:00
next ;
}
1998-06-16 21:43:24 +00:00
if ( $ have_mod_map &&
1999-10-18 22:55:01 +00:00
! & in_module ( \ % mod_map , $ ci - > [ $ ::CI_DIR ] , $ ci - > [ $ ::CI_FILE ] ) ) {
1998-06-16 21:43:24 +00:00
next ;
}
if ( $ begin_tag ) {
$ rev = $ begin_tag - > { $ key } ;
print "<BR>$key begintag is $rev<BR>\n" ;
1999-10-18 22:55:01 +00:00
if ( $ rev == "" || rev_is_after ( $ ci - > [ $ ::CI_REV ] , $ rev ) ) {
1998-06-16 21:43:24 +00:00
next ;
}
}
if ( $ end_tag ) {
$ rev = $ end_tag - > { $ key } ;
print "<BR>$key endtag is $rev<BR>\n" ;
1999-10-18 22:55:01 +00:00
if ( $ rev == "" || rev_is_after ( $ rev , $ ci - > [ $ ::CI_REV ] ) ) {
1998-06-16 21:43:24 +00:00
next ;
}
}
1999-10-18 22:55:01 +00:00
if ( defined ( $ ::query_logexpr ) &&
$ ::query_logexpr ne '' &&
! ( $ ci - > [ $ ::CI_LOG ] =~ /$::query_logexpr/i ) ) {
1998-06-16 21:43:24 +00:00
next ;
}
push ( @$ result , $ ci ) ;
}
for $ ci ( @ { $ result } ) {
1999-10-18 22:55:01 +00:00
$ ::lines_added += $ ci - > [ $ ::CI_LINES_ADDED ] ;
$ ::lines_removed += $ ci - > [ $ ::CI_LINES_REMOVED ] ;
$ ::versioninfo . = "$ci->[$::CI_WHO]|$ci->[$::CI_DIR]|$ci->[$::CI_FILE]|$ci->[$::CI_REV]," ;
1998-06-16 21:43:24 +00:00
}
return $ result ;
}
sub load_tag {
1999-07-23 18:39:31 +00:00
my ( $ tagname ) = @ _ ;
1998-06-16 21:43:24 +00:00
my $ tagfile ;
my $ cvssuffix ;
my $ s ;
my @ line ;
my $ time ;
my $ cmd ;
my $ dir ;
1999-10-18 22:55:01 +00:00
$ cvssuffix = $ ::CVS_ROOT ;
1998-06-16 21:43:24 +00:00
$ cvssuffix =~ s/\//_/g ;
$ s = $ tagname ;
$ s =~ s/ /\%20/g ;
$ s =~ s/\%/\%25/g ;
$ s =~ s/\//\%2f/g ;
$ s =~ s/\?/\%3f/g ;
$ s =~ s/\*/\%2a/g ;
$ tagfile = "data/taginfo/$cvssuffix/$s" ;
open ( TAG , "<$tagfile" ) || die "Unknown tag $tagname" ;
1999-10-18 22:55:01 +00:00
my $ result = { } ;
1998-06-16 21:43:24 +00:00
print "<br>parsing tag $tagname</br>\n" ;
while ( <TAG> ) {
chop ;
@ line = split ( /\|/ ) ;
$ time = shift @ line ;
$ cmd = shift @ line ;
if ( $ cmd != "add" ) {
# We ought to be able to cope with these... XXX
next ;
}
$ dir = shift @ line ;
1999-10-18 22:55:01 +00:00
$ dir =~ s@^$::CVS_ROOT/@@ ;
1998-06-16 21:43:24 +00:00
$ dir =~ s: ^ \ . / :: ;
while ( @ line ) {
1999-10-18 22:55:01 +00:00
my $ file = shift @ line ;
1998-06-16 21:43:24 +00:00
$ file = "$dir/$file" ;
1999-10-18 22:55:01 +00:00
my $ version = shift @ line ;
1998-06-16 21:43:24 +00:00
$ result - > { $ file } = $ version ;
print "<br>Added ($file,$version) for tag $tagname<br>\n" ;
}
}
return $ result ;
}
sub rev_is_after {
my $ r1 = shift @ _ ;
my $ r2 = shift @ _ ;
my @ a = split /:/ , $ r1 ;
my @ b = split /:/ , $ r2 ;
if ( @ b > @ a ) {
return 1 ;
}
if ( @ b < @ a ) {
return 0 ;
}
for ( my $ i = 0 ; $ i < @ a ; $ i + + ) {
if ( $ a [ $ i ] > $ b [ $ i ] ) { return 1 ; }
if ( $ a [ $ i ] < $ b [ $ i ] ) { return 0 ; }
}
return 0 ;
}
sub in_module {
1999-10-18 22:55:01 +00:00
my ( $ mod_map , $ dirname , $ filename ) = @ _ ;
my ( @ path ) ;
my ( $ i , $ fp , $ local ) ;
1998-06-16 21:43:24 +00:00
#
#quick check if it is already in there.
#
1999-07-23 18:39:31 +00:00
if ( $$ mod_map { $ dirname } ) {
1998-06-16 21:43:24 +00:00
return 1 ;
}
@ path = split ( /\// , $ dirname ) ;
$ fp = '' ;
for ( $ i = 0 ; $ i < @ path ; $ i + + ) {
$ fp . = ( $ fp ne '' ? '/' : '' ) . $ path [ $ i ] ;
1999-07-23 18:39:31 +00:00
if ( $ local = $$ mod_map { $ fp } ) {
1998-06-16 21:43:24 +00:00
if ( $ local == $ IS_LOCAL ) {
if ( $ i == ( @ path - 1 ) ) {
return 1 ;
}
}
else {
# Add directories to the map as we encounter them so we go
# faster
1999-07-23 18:39:31 +00:00
if ( ! exists ( $$ mod_map { $ dirname } ) ||
$$ mod_map { $ dirname } == 0 ) {
$$ mod_map { $ dirname } = $ IS_LOCAL ;
1998-06-16 21:43:24 +00:00
}
return 1 ;
}
}
}
1999-07-23 18:39:31 +00:00
if ( $$ mod_map { $ fp . '/' . $ filename } ) {
1998-06-16 21:43:24 +00:00
return 1 ;
}
else {
return 0 ;
}
}
sub get_module_map {
1999-07-26 16:10:55 +00:00
my ( $ name ) = @ _ ;
my ( % mod_map ) ;
& build_map ( $ name , \ % mod_map ) ;
return % mod_map ;
1998-06-16 21:43:24 +00:00
}
1999-07-26 16:10:55 +00:00
sub parse_modules {
1999-10-18 22:55:01 +00:00
my $ l ;
1999-07-26 16:10:55 +00:00
while ( $ l = & get_line ) {
1999-10-18 22:55:01 +00:00
my ( $ mod_name , $ flag , @ params ) = split ( /[ \t]+/ , $ l ) ;
1999-07-26 16:10:55 +00:00
if ( $# params eq - 1 ) {
@ params = $ flag ;
$ flag = "" ;
}
elsif ( $ flag eq '-d' ) {
1999-10-18 22:55:01 +00:00
my $ dummy ;
1999-07-26 16:10:55 +00:00
( $ mod_name , $ dummy , $ dummy , @ params ) = split ( /[ \t]+/ , $ l ) ;
}
elsif ( $ flag ne '-a' ) {
next ;
}
1999-10-18 22:55:01 +00:00
$ ::modules - > { $ mod_name } = [ @ params ] ;
1999-07-26 16:10:55 +00:00
}
}
sub build_map {
1999-10-18 22:55:01 +00:00
my ( $ name , $ mod_map ) = @ _ ;
my ( $ bFound , $ local ) ;
1999-07-26 16:10:55 +00:00
$ local = $ NOT_LOCAL ;
$ bFound = 0 ;
1999-10-18 22:55:01 +00:00
for my $ i ( @ { $ ::modules - > { $ name } } ) {
1999-07-26 16:10:55 +00:00
$ bFound = 1 ;
if ( $ i eq '-l' ) {
$ local = $ IS_LOCAL ;
}
elsif ( ! build_map ( $ i , $ mod_map ) ) {
$ mod_map - > { $ i } = $ local ;
}
}
return $ bFound ;
}