1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20 21use Fcntl; 22use File::Temp qw/tempdir tempfile/; 23use File::Basename; 24 25my$log= GITCVS::log->new(); 26my$cfg; 27 28my$DATE_LIST= { 29 Jan =>"01", 30 Feb =>"02", 31 Mar =>"03", 32 Apr =>"04", 33 May =>"05", 34 Jun =>"06", 35 Jul =>"07", 36 Aug =>"08", 37 Sep =>"09", 38 Oct =>"10", 39 Nov =>"11", 40 Dec =>"12", 41}; 42 43# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 44$| =1; 45 46#### Definition and mappings of functions #### 47 48my$methods= { 49'Root'=> \&req_Root, 50'Valid-responses'=> \&req_Validresponses, 51'valid-requests'=> \&req_validrequests, 52'Directory'=> \&req_Directory, 53'Entry'=> \&req_Entry, 54'Modified'=> \&req_Modified, 55'Unchanged'=> \&req_Unchanged, 56'Questionable'=> \&req_Questionable, 57'Argument'=> \&req_Argument, 58'Argumentx'=> \&req_Argument, 59'expand-modules'=> \&req_expandmodules, 60'add'=> \&req_add, 61'remove'=> \&req_remove, 62'co'=> \&req_co, 63'update'=> \&req_update, 64'ci'=> \&req_ci, 65'diff'=> \&req_diff, 66'log'=> \&req_log, 67'rlog'=> \&req_log, 68'tag'=> \&req_CATCHALL, 69'status'=> \&req_status, 70'admin'=> \&req_CATCHALL, 71'history'=> \&req_CATCHALL, 72'watchers'=> \&req_CATCHALL, 73'editors'=> \&req_CATCHALL, 74'annotate'=> \&req_annotate, 75'Global_option'=> \&req_Globaloption, 76#'annotate' => \&req_CATCHALL, 77}; 78 79############################################## 80 81 82# $state holds all the bits of information the clients sends us that could 83# potentially be useful when it comes to actually _doing_ something. 84my$state= {}; 85$log->info("--------------- STARTING -----------------"); 86 87my$TEMP_DIR= tempdir( CLEANUP =>1); 88$log->debug("Temporary directory is '$TEMP_DIR'"); 89 90# if we are called with a pserver argument, 91# deal with the authentication cat before entering the 92# main loop 93if(@ARGV&&$ARGV[0]eq'pserver') { 94my$line= <STDIN>;chomp$line; 95unless($lineeq'BEGIN AUTH REQUEST') { 96die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 97} 98$line= <STDIN>;chomp$line; 99 req_Root('root',$line)# reuse Root 100or die"E Invalid root$line\n"; 101$line= <STDIN>;chomp$line; 102unless($lineeq'anonymous') { 103print"E Only anonymous user allowed via pserver\n"; 104print"I HATE YOU\n"; 105} 106$line= <STDIN>;chomp$line;# validate the password? 107$line= <STDIN>;chomp$line; 108unless($lineeq'END AUTH REQUEST') { 109die"E Do not understand$line-- expecting END AUTH REQUEST\n"; 110} 111print"I LOVE YOU\n"; 112# and now back to our regular programme... 113} 114 115# Keep going until the client closes the connection 116while(<STDIN>) 117{ 118chomp; 119 120# Check to see if we've seen this method, and call appropriate function. 121if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 122{ 123# use the $methods hash to call the appropriate sub for this command 124#$log->info("Method : $1"); 125&{$methods->{$1}}($1,$2); 126}else{ 127# log fatal because we don't understand this function. If this happens 128# we're fairly screwed because we don't know if the client is expecting 129# a response. If it is, the client will hang, we'll hang, and the whole 130# thing will be custard. 131$log->fatal("Don't understand command$_\n"); 132die("Unknown command$_"); 133} 134} 135 136$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 137$log->info("--------------- FINISH -----------------"); 138 139# Magic catchall method. 140# This is the method that will handle all commands we haven't yet 141# implemented. It simply sends a warning to the log file indicating a 142# command that hasn't been implemented has been invoked. 143sub req_CATCHALL 144{ 145my($cmd,$data) =@_; 146$log->warn("Unhandled command : req_$cmd:$data"); 147} 148 149 150# Root pathname \n 151# Response expected: no. Tell the server which CVSROOT to use. Note that 152# pathname is a local directory and not a fully qualified CVSROOT variable. 153# pathname must already exist; if creating a new root, use the init 154# request, not Root. pathname does not include the hostname of the server, 155# how to access the server, etc.; by the time the CVS protocol is in use, 156# connection, authentication, etc., are already taken care of. The Root 157# request must be sent only once, and it must be sent before any requests 158# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 159sub req_Root 160{ 161my($cmd,$data) =@_; 162$log->debug("req_Root :$data"); 163 164$state->{CVSROOT} =$data; 165 166$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 167unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 168print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 169print"E\n"; 170print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 171return0; 172} 173 174my@gitvars=`git-repo-config -l`; 175if($?) { 176print"E problems executing git-repo-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 177print"E\n"; 178print"error 1 - problem executing git-repo-config\n"; 179return0; 180} 181foreachmy$line(@gitvars) 182{ 183next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 184$cfg->{$1}{$2} =$3; 185} 186 187unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 188{ 189print"E GITCVS emulation needs to be enabled on this repo\n"; 190print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 191print"E\n"; 192print"error 1 GITCVS emulation disabled\n"; 193return0; 194} 195 196if(defined($cfg->{gitcvs}{logfile} ) ) 197{ 198$log->setfile($cfg->{gitcvs}{logfile}); 199}else{ 200$log->nofile(); 201} 202 203return1; 204} 205 206# Global_option option \n 207# Response expected: no. Transmit one of the global options `-q', `-Q', 208# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 209# variations (such as combining of options) are allowed. For graceful 210# handling of valid-requests, it is probably better to make new global 211# options separate requests, rather than trying to add them to this 212# request. 213sub req_Globaloption 214{ 215my($cmd,$data) =@_; 216$log->debug("req_Globaloption :$data"); 217 218# TODO : is this data useful ??? 219} 220 221# Valid-responses request-list \n 222# Response expected: no. Tell the server what responses the client will 223# accept. request-list is a space separated list of tokens. 224sub req_Validresponses 225{ 226my($cmd,$data) =@_; 227$log->debug("req_Validresponses :$data"); 228 229# TODO : re-enable this, currently it's not particularly useful 230#$state->{validresponses} = [ split /\s+/, $data ]; 231} 232 233# valid-requests \n 234# Response expected: yes. Ask the server to send back a Valid-requests 235# response. 236sub req_validrequests 237{ 238my($cmd,$data) =@_; 239 240$log->debug("req_validrequests"); 241 242$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 243$log->debug("SEND : ok"); 244 245print"Valid-requests ".join(" ",keys%$methods) ."\n"; 246print"ok\n"; 247} 248 249# Directory local-directory \n 250# Additional data: repository \n. Response expected: no. Tell the server 251# what directory to use. The repository should be a directory name from a 252# previous server response. Note that this both gives a default for Entry 253# and Modified and also for ci and the other commands; normal usage is to 254# send Directory for each directory in which there will be an Entry or 255# Modified, and then a final Directory for the original directory, then the 256# command. The local-directory is relative to the top level at which the 257# command is occurring (i.e. the last Directory which is sent before the 258# command); to indicate that top level, `.' should be sent for 259# local-directory. 260sub req_Directory 261{ 262my($cmd,$data) =@_; 263 264my$repository= <STDIN>; 265chomp$repository; 266 267 268$state->{localdir} =$data; 269$state->{repository} =$repository; 270$state->{directory} =$repository; 271$state->{directory} =~s/^$state->{CVSROOT}\///; 272$state->{module} =$1if($state->{directory} =~s/^(.*?)(\/|$)//); 273$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 274 275$log->debug("req_Directory : localdir=$datarepository=$repositorydirectory=$state->{directory} module=$state->{module}"); 276} 277 278# Entry entry-line \n 279# Response expected: no. Tell the server what version of a file is on the 280# local machine. The name in entry-line is a name relative to the directory 281# most recently specified with Directory. If the user is operating on only 282# some files in a directory, Entry requests for only those files need be 283# included. If an Entry request is sent without Modified, Is-modified, or 284# Unchanged, it means the file is lost (does not exist in the working 285# directory). If both Entry and one of Modified, Is-modified, or Unchanged 286# are sent for the same file, Entry must be sent first. For a given file, 287# one can send Modified, Is-modified, or Unchanged, but not more than one 288# of these three. 289sub req_Entry 290{ 291my($cmd,$data) =@_; 292 293$log->debug("req_Entry :$data"); 294 295my@data=split(/\//,$data); 296 297$state->{entries}{$state->{directory}.$data[1]} = { 298 revision =>$data[2], 299 conflict =>$data[3], 300 options =>$data[4], 301 tag_or_date =>$data[5], 302}; 303} 304 305# add \n 306# Response expected: yes. Add a file or directory. This uses any previous 307# Argument, Directory, Entry, or Modified requests, if they have been sent. 308# The last Directory sent specifies the working directory at the time of 309# the operation. To add a directory, send the directory to be added using 310# Directory and Argument requests. 311sub req_add 312{ 313my($cmd,$data) =@_; 314 315 argsplit("add"); 316 317my$addcount=0; 318 319foreachmy$filename( @{$state->{args}} ) 320{ 321$filename= filecleanup($filename); 322 323unless(defined($state->{entries}{$filename}{modified_filename} ) ) 324{ 325print"E cvs add: nothing known about `$filename'\n"; 326next; 327} 328# TODO : check we're not squashing an already existing file 329if(defined($state->{entries}{$filename}{revision} ) ) 330{ 331print"E cvs add: `$filename' has already been entered\n"; 332next; 333} 334 335 336my($filepart,$dirpart) = filenamesplit($filename); 337 338print"E cvs add: scheduling file `$filename' for addition\n"; 339 340print"Checked-in$dirpart\n"; 341print"$filename\n"; 342print"/$filepart/0///\n"; 343 344$addcount++; 345} 346 347if($addcount==1) 348{ 349print"E cvs add: use `cvs commit' to add this file permanently\n"; 350} 351elsif($addcount>1) 352{ 353print"E cvs add: use `cvs commit' to add these files permanently\n"; 354} 355 356print"ok\n"; 357} 358 359# remove \n 360# Response expected: yes. Remove a file. This uses any previous Argument, 361# Directory, Entry, or Modified requests, if they have been sent. The last 362# Directory sent specifies the working directory at the time of the 363# operation. Note that this request does not actually do anything to the 364# repository; the only effect of a successful remove request is to supply 365# the client with a new entries line containing `-' to indicate a removed 366# file. In fact, the client probably could perform this operation without 367# contacting the server, although using remove may cause the server to 368# perform a few more checks. The client sends a subsequent ci request to 369# actually record the removal in the repository. 370sub req_remove 371{ 372my($cmd,$data) =@_; 373 374 argsplit("remove"); 375 376# Grab a handle to the SQLite db and do any necessary updates 377my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 378$updater->update(); 379 380#$log->debug("add state : " . Dumper($state)); 381 382my$rmcount=0; 383 384foreachmy$filename( @{$state->{args}} ) 385{ 386$filename= filecleanup($filename); 387 388if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 389{ 390print"E cvs remove: file `$filename' still in working directory\n"; 391next; 392} 393 394my$meta=$updater->getmeta($filename); 395my$wrev= revparse($filename); 396 397unless(defined($wrev) ) 398{ 399print"E cvs remove: nothing known about `$filename'\n"; 400next; 401} 402 403if(defined($wrev)and$wrev<0) 404{ 405print"E cvs remove: file `$filename' already scheduled for removal\n"; 406next; 407} 408 409unless($wrev==$meta->{revision} ) 410{ 411# TODO : not sure if the format of this message is quite correct. 412print"E cvs remove: Up to date check failed for `$filename'\n"; 413next; 414} 415 416 417my($filepart,$dirpart) = filenamesplit($filename); 418 419print"E cvs remove: scheduling `$filename' for removal\n"; 420 421print"Checked-in$dirpart\n"; 422print"$filename\n"; 423print"/$filepart/-1.$wrev///\n"; 424 425$rmcount++; 426} 427 428if($rmcount==1) 429{ 430print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 431} 432elsif($rmcount>1) 433{ 434print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 435} 436 437print"ok\n"; 438} 439 440# Modified filename \n 441# Response expected: no. Additional data: mode, \n, file transmission. Send 442# the server a copy of one locally modified file. filename is a file within 443# the most recent directory sent with Directory; it must not contain `/'. 444# If the user is operating on only some files in a directory, only those 445# files need to be included. This can also be sent without Entry, if there 446# is no entry for the file. 447sub req_Modified 448{ 449my($cmd,$data) =@_; 450 451my$mode= <STDIN>; 452chomp$mode; 453my$size= <STDIN>; 454chomp$size; 455 456# Grab config information 457my$blocksize=8192; 458my$bytesleft=$size; 459my$tmp; 460 461# Get a filehandle/name to write it to 462my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 463 464# Loop over file data writing out to temporary file. 465while($bytesleft) 466{ 467$blocksize=$bytesleftif($bytesleft<$blocksize); 468read STDIN,$tmp,$blocksize; 469print$fh $tmp; 470$bytesleft-=$blocksize; 471} 472 473close$fh; 474 475# Ensure we have something sensible for the file mode 476if($mode=~/u=(\w+)/) 477{ 478$mode=$1; 479}else{ 480$mode="rw"; 481} 482 483# Save the file data in $state 484$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 485$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 486$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 487$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 488 489 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 490} 491 492# Unchanged filename\n 493# Response expected: no. Tell the server that filename has not been 494# modified in the checked out directory. The filename is a file within the 495# most recent directory sent with Directory; it must not contain `/'. 496sub req_Unchanged 497{ 498 my ($cmd,$data) =@_; 499 500$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 501 502 #$log->debug("req_Unchanged :$data"); 503} 504 505# Questionable filename\n 506# Response expected: no. Additional data: no. 507# Tell the server to check whether filename should be ignored, 508# and if not, next time the server sends responses, send (in 509# a M response) `?' followed by the directory and filename. 510# filename must not contain `/'; it needs to be a file in the 511# directory named by the most recent Directory request. 512sub req_Questionable 513{ 514my($cmd,$data) =@_; 515 516$state->{entries}{$state->{directory}.$data}{questionable} =1; 517 518#$log->debug("req_Questionable : $data"); 519} 520 521# Argument text \n 522# Response expected: no. Save argument for use in a subsequent command. 523# Arguments accumulate until an argument-using command is given, at which 524# point they are forgotten. 525# Argumentx text \n 526# Response expected: no. Append \n followed by text to the current argument 527# being saved. 528sub req_Argument 529{ 530my($cmd,$data) =@_; 531 532# TODO : Not quite sure how Argument and Argumentx differ, but I assume 533# it's for multi-line arguments ... somehow ... 534 535$log->debug("$cmd:$data"); 536 537push@{$state->{arguments}},$data; 538} 539 540# expand-modules \n 541# Response expected: yes. Expand the modules which are specified in the 542# arguments. Returns the data in Module-expansion responses. Note that the 543# server can assume that this is checkout or export, not rtag or rdiff; the 544# latter do not access the working directory and thus have no need to 545# expand modules on the client side. Expand may not be the best word for 546# what this request does. It does not necessarily tell you all the files 547# contained in a module, for example. Basically it is a way of telling you 548# which working directories the server needs to know about in order to 549# handle a checkout of the specified modules. For example, suppose that the 550# server has a module defined by 551# aliasmodule -a 1dir 552# That is, one can check out aliasmodule and it will take 1dir in the 553# repository and check it out to 1dir in the working directory. Now suppose 554# the client already has this module checked out and is planning on using 555# the co request to update it. Without using expand-modules, the client 556# would have two bad choices: it could either send information about all 557# working directories under the current directory, which could be 558# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 559# stands for 1dir, and neglect to send information for 1dir, which would 560# lead to incorrect operation. With expand-modules, the client would first 561# ask for the module to be expanded: 562sub req_expandmodules 563{ 564my($cmd,$data) =@_; 565 566 argsplit(); 567 568$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 569 570unless(ref$state->{arguments}eq"ARRAY") 571{ 572print"ok\n"; 573return; 574} 575 576foreachmy$module( @{$state->{arguments}} ) 577{ 578$log->debug("SEND : Module-expansion$module"); 579print"Module-expansion$module\n"; 580} 581 582print"ok\n"; 583 statecleanup(); 584} 585 586# co \n 587# Response expected: yes. Get files from the repository. This uses any 588# previous Argument, Directory, Entry, or Modified requests, if they have 589# been sent. Arguments to this command are module names; the client cannot 590# know what directories they correspond to except by (1) just sending the 591# co request, and then seeing what directory names the server sends back in 592# its responses, and (2) the expand-modules request. 593sub req_co 594{ 595my($cmd,$data) =@_; 596 597 argsplit("co"); 598 599my$module=$state->{args}[0]; 600my$checkout_path=$module; 601 602# use the user specified directory if we're given it 603$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 604 605$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 606 607$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 608 609$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 610 611# Grab a handle to the SQLite db and do any necessary updates 612my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 613$updater->update(); 614 615$checkout_path=~ s|/$||;# get rid of trailing slashes 616 617# Eclipse seems to need the Clear-sticky command 618# to prepare the 'Entries' file for the new directory. 619print"Clear-sticky$checkout_path/\n"; 620print$state->{CVSROOT} ."/$module/\n"; 621print"Clear-static-directory$checkout_path/\n"; 622print$state->{CVSROOT} ."/$module/\n"; 623print"Clear-sticky$checkout_path/\n";# yes, twice 624print$state->{CVSROOT} ."/$module/\n"; 625print"Template$checkout_path/\n"; 626print$state->{CVSROOT} ."/$module/\n"; 627print"0\n"; 628 629# instruct the client that we're checking out to $checkout_path 630print"E cvs checkout: Updating$checkout_path\n"; 631 632my%seendirs= (); 633my$lastdir=''; 634 635# recursive 636sub prepdir { 637my($dir,$repodir,$remotedir,$seendirs) =@_; 638my$parent= dirname($dir); 639$dir=~ s|/+$||; 640$repodir=~ s|/+$||; 641$remotedir=~ s|/+$||; 642$parent=~ s|/+$||; 643$log->debug("announcedir$dir,$repodir,$remotedir"); 644 645if($parenteq'.'||$parenteq'./') { 646$parent=''; 647} 648# recurse to announce unseen parents first 649if(length($parent) && !exists($seendirs->{$parent})) { 650 prepdir($parent,$repodir,$remotedir,$seendirs); 651} 652# Announce that we are going to modify at the parent level 653if($parent) { 654print"E cvs checkout: Updating$remotedir/$parent\n"; 655}else{ 656print"E cvs checkout: Updating$remotedir\n"; 657} 658print"Clear-sticky$remotedir/$parent/\n"; 659print"$repodir/$parent/\n"; 660 661print"Clear-static-directory$remotedir/$dir/\n"; 662print"$repodir/$dir/\n"; 663print"Clear-sticky$remotedir/$parent/\n";# yes, twice 664print"$repodir/$parent/\n"; 665print"Template$remotedir/$dir/\n"; 666print"$repodir/$dir/\n"; 667print"0\n"; 668 669$seendirs->{$dir} =1; 670} 671 672foreachmy$git( @{$updater->gethead} ) 673{ 674# Don't want to check out deleted files 675next if($git->{filehash}eq"deleted"); 676 677($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 678 679if(length($git->{dir}) &&$git->{dir}ne'./' 680&&$git->{dir}ne$lastdir) { 681unless(exists($seendirs{$git->{dir}})) { 682 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 683$checkout_path, \%seendirs); 684$lastdir=$git->{dir}; 685$seendirs{$git->{dir}} =1; 686} 687print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 688} 689 690# modification time of this file 691print"Mod-time$git->{modified}\n"; 692 693# print some information to the client 694if(defined($git->{dir} )and$git->{dir}ne"./") 695{ 696print"M U$checkout_path/$git->{dir}$git->{name}\n"; 697}else{ 698print"M U$checkout_path/$git->{name}\n"; 699} 700 701# instruct client we're sending a file to put in this path 702print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 703 704print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 705 706# this is an "entries" line 707print"/$git->{name}/1.$git->{revision}///\n"; 708# permissions 709print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 710 711# transmit file 712 transmitfile($git->{filehash}); 713} 714 715print"ok\n"; 716 717 statecleanup(); 718} 719 720# update \n 721# Response expected: yes. Actually do a cvs update command. This uses any 722# previous Argument, Directory, Entry, or Modified requests, if they have 723# been sent. The last Directory sent specifies the working directory at the 724# time of the operation. The -I option is not used--files which the client 725# can decide whether to ignore are not mentioned and the client sends the 726# Questionable request for others. 727sub req_update 728{ 729my($cmd,$data) =@_; 730 731$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 732 733 argsplit("update"); 734 735# 736# It may just be a client exploring the available heads/modules 737# in that case, list them as top level directories and leave it 738# at that. Eclipse uses this technique to offer you a list of 739# projects (heads in this case) to checkout. 740# 741if($state->{module}eq'') { 742print"E cvs update: Updating .\n"; 743opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 744while(my$head=readdir(HEADS)) { 745if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 746print"E cvs update: New directory `$head'\n"; 747} 748} 749closedir HEADS; 750print"ok\n"; 751return1; 752} 753 754 755# Grab a handle to the SQLite db and do any necessary updates 756my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 757 758$updater->update(); 759 760# if no files were specified, we need to work out what files we should be providing status on ... 761 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 762 763#$log->debug("update state : " . Dumper($state)); 764 765# foreach file specified on the commandline ... 766foreachmy$filename( @{$state->{args}} ) 767{ 768$filename= filecleanup($filename); 769 770# if we have a -C we should pretend we never saw modified stuff 771if(exists($state->{opt}{C} ) ) 772{ 773delete$state->{entries}{$filename}{modified_hash}; 774delete$state->{entries}{$filename}{modified_filename}; 775$state->{entries}{$filename}{unchanged} =1; 776} 777 778my$meta; 779if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 780{ 781$meta=$updater->getmeta($filename,$1); 782}else{ 783$meta=$updater->getmeta($filename); 784} 785 786next unless($meta->{revision} ); 787 788my$oldmeta=$meta; 789 790my$wrev= revparse($filename); 791 792# If the working copy is an old revision, lets get that version too for comparison. 793if(defined($wrev)and$wrev!=$meta->{revision} ) 794{ 795$oldmeta=$updater->getmeta($filename,$wrev); 796} 797 798#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 799 800# Files are up to date if the working copy and repo copy have the same revision, 801# and the working copy is unmodified _and_ the user hasn't specified -C 802next if(defined($wrev) 803and defined($meta->{revision}) 804and$wrev==$meta->{revision} 805and$state->{entries}{$filename}{unchanged} 806and not exists($state->{opt}{C} ) ); 807 808# If the working copy and repo copy have the same revision, 809# but the working copy is modified, tell the client it's modified 810if(defined($wrev) 811and defined($meta->{revision}) 812and$wrev==$meta->{revision} 813and not exists($state->{opt}{C} ) ) 814{ 815$log->info("Tell the client the file is modified"); 816print"MT text U\n"; 817print"MT fname$filename\n"; 818print"MT newline\n"; 819next; 820} 821 822if($meta->{filehash}eq"deleted") 823{ 824my($filepart,$dirpart) = filenamesplit($filename); 825 826$log->info("Removing '$filename' from working copy (no longer in the repo)"); 827 828print"E cvs update: `$filename' is no longer in the repository\n"; 829print"Removed$dirpart\n"; 830print"$filepart\n"; 831} 832elsif(not defined($state->{entries}{$filename}{modified_hash} ) 833or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 834{ 835$log->info("Updating '$filename'"); 836# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 837print"MT +updated\n"; 838print"MT text U\n"; 839print"MT fname$filename\n"; 840print"MT newline\n"; 841print"MT -updated\n"; 842 843my($filepart,$dirpart) = filenamesplit($filename); 844$dirpart=~s/^$state->{directory}//; 845 846if(defined($wrev) ) 847{ 848# instruct client we're sending a file to put in this path as a replacement 849print"Update-existing$dirpart\n"; 850$log->debug("Updating existing file 'Update-existing$dirpart'"); 851}else{ 852# instruct client we're sending a file to put in this path as a new file 853print"Created$dirpart\n"; 854$log->debug("Creating new file 'Created$dirpart'"); 855} 856print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 857 858# this is an "entries" line 859$log->debug("/$filepart/1.$meta->{revision}///"); 860print"/$filepart/1.$meta->{revision}///\n"; 861 862# permissions 863$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 864print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 865 866# transmit file 867 transmitfile($meta->{filehash}); 868}else{ 869$log->info("Updating '$filename'"); 870my($filepart,$dirpart) = filenamesplit($meta->{name}); 871 872my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 873 874chdir$dir; 875my$file_local=$filepart.".mine"; 876system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 877my$file_old=$filepart.".".$oldmeta->{revision}; 878 transmitfile($oldmeta->{filehash},$file_old); 879my$file_new=$filepart.".".$meta->{revision}; 880 transmitfile($meta->{filehash},$file_new); 881 882# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 883$log->info("Merging$file_local,$file_old,$file_new"); 884 885$log->debug("Temporary directory for merge is$dir"); 886 887my$return=system("merge",$file_local,$file_old,$file_new); 888$return>>=8; 889 890if($return==0) 891{ 892$log->info("Merged successfully"); 893print"M M$filename\n"; 894$log->debug("Update-existing$dirpart"); 895print"Update-existing$dirpart\n"; 896$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 897print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 898$log->debug("/$filepart/1.$meta->{revision}///"); 899print"/$filepart/1.$meta->{revision}///\n"; 900} 901elsif($return==1) 902{ 903$log->info("Merged with conflicts"); 904print"M C$filename\n"; 905print"Update-existing$dirpart\n"; 906print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 907print"/$filepart/1.$meta->{revision}/+//\n"; 908} 909else 910{ 911$log->warn("Merge failed"); 912next; 913} 914 915# permissions 916$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 917print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 918 919# transmit file, format is single integer on a line by itself (file 920# size) followed by the file contents 921# TODO : we should copy files in blocks 922my$data=`cat$file_local`; 923$log->debug("File size : " . length($data)); 924 print length($data) . "\n"; 925 print$data; 926 927 chdir "/"; 928 } 929 930 } 931 932 print "ok\n"; 933} 934 935sub req_ci 936{ 937 my ($cmd,$data) =@_; 938 939 argsplit("ci"); 940 941 #$log->debug("State : " . Dumper($state)); 942 943$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 944 945 if (@ARGV&&$ARGV[0] eq 'pserver') 946 { 947 print "error 1 pserver access cannot commit\n"; 948 exit; 949 } 950 951 if ( -e$state->{CVSROOT} . "/index" ) 952 { 953$log->warn("file 'index' already exists in the git repository"); 954 print "error 1 Index already exists in git repo\n"; 955 exit; 956 } 957 958 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 959 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 960 { 961$log->warn("lockfile '$lockfile' already exists, please try again"); 962 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 963 exit; 964 } 965 966 # Grab a handle to the SQLite db and do any necessary updates 967 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 968$updater->update(); 969 970 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 971 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 972$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 973 974$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 975$ENV{GIT_INDEX_FILE} =$file_index; 976 977 chdir$tmpdir; 978 979 # populate the temporary index based 980 system("git-read-tree",$state->{module}); 981 unless ($?== 0) 982 { 983 die "Error running git-read-tree$state->{module}$file_index$!"; 984 } 985$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 986 987 988 my@committedfiles= (); 989 990 # foreach file specified on the commandline ... 991 foreach my$filename( @{$state->{args}} ) 992 { 993$filename= filecleanup($filename); 994 995 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 996 997 my$meta=$updater->getmeta($filename); 998 999 my$wrev= revparse($filename);10001001 my ($filepart,$dirpart) = filenamesplit($filename);10021003 # do a checkout of the file if it part of this tree1004 if ($wrev) {1005 system('git-checkout-index', '-f', '-u',$filename);1006 unless ($?== 0) {1007 die "Error running git-checkout-index -f -u$filename:$!";1008 }1009 }10101011 my$addflag= 0;1012 my$rmflag= 0;1013$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1014$addflag= 1 unless ( -e$filename);10151016 # Do up to date checking1017 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1018 {1019 # fail everything if an up to date check fails1020 print "error 1 Up to date check failed for$filename\n";1021 close LOCKFILE;1022 unlink($lockfile);1023 chdir "/";1024 exit;1025 }10261027 push@committedfiles,$filename;1028$log->info("Committing$filename");10291030 system("mkdir","-p",$dirpart) unless ( -d$dirpart);10311032 unless ($rmflag)1033 {1034$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1035 rename$state->{entries}{$filename}{modified_filename},$filename;10361037 # Calculate modes to remove1038 my$invmode= "";1039 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }10401041$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1042 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1043 }10441045 if ($rmflag)1046 {1047$log->info("Removing file '$filename'");1048 unlink($filename);1049 system("git-update-index", "--remove",$filename);1050 }1051 elsif ($addflag)1052 {1053$log->info("Adding file '$filename'");1054 system("git-update-index", "--add",$filename);1055 } else {1056$log->info("Updating file '$filename'");1057 system("git-update-index",$filename);1058 }1059 }10601061 unless ( scalar(@committedfiles) > 0 )1062 {1063 print "E No files to commit\n";1064 print "ok\n";1065 close LOCKFILE;1066 unlink($lockfile);1067 chdir "/";1068 return;1069 }10701071 my$treehash= `git-write-tree`;1072 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;1073 chomp$treehash;1074 chomp$parenthash;10751076$log->debug("Treehash :$treehash, Parenthash :$parenthash");10771078 # write our commit message out if we have one ...1079 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1080 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1081 print$msg_fh"\n\nvia git-CVS emulator\n";1082 close$msg_fh;10831084 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1085$log->info("Commit hash :$commithash");10861087unless($commithash=~/[a-zA-Z0-9]{40}/)1088{1089$log->warn("Commit failed (Invalid commit hash)");1090print"error 1 Commit failed (unknown reason)\n";1091close LOCKFILE;1092unlink($lockfile);1093chdir"/";1094exit;1095}10961097open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}";1098print FILE $commithash;1099close FILE;11001101$updater->update();11021103# foreach file specified on the commandline ...1104foreachmy$filename(@committedfiles)1105{1106$filename= filecleanup($filename);11071108my$meta=$updater->getmeta($filename);11091110my($filepart,$dirpart) = filenamesplit($filename);11111112$log->debug("Checked-in$dirpart:$filename");11131114if($meta->{filehash}eq"deleted")1115{1116print"Remove-entry$dirpart\n";1117print"$filename\n";1118}else{1119print"Checked-in$dirpart\n";1120print"$filename\n";1121print"/$filepart/1.$meta->{revision}///\n";1122}1123}11241125close LOCKFILE;1126unlink($lockfile);1127chdir"/";11281129print"ok\n";1130}11311132sub req_status1133{1134my($cmd,$data) =@_;11351136 argsplit("status");11371138$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1139#$log->debug("status state : " . Dumper($state));11401141# Grab a handle to the SQLite db and do any necessary updates1142my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1143$updater->update();11441145# if no files were specified, we need to work out what files we should be providing status on ...1146 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);11471148# foreach file specified on the commandline ...1149foreachmy$filename( @{$state->{args}} )1150{1151$filename= filecleanup($filename);11521153my$meta=$updater->getmeta($filename);1154my$oldmeta=$meta;11551156my$wrev= revparse($filename);11571158# If the working copy is an old revision, lets get that version too for comparison.1159if(defined($wrev)and$wrev!=$meta->{revision} )1160{1161$oldmeta=$updater->getmeta($filename,$wrev);1162}11631164# TODO : All possible statuses aren't yet implemented1165my$status;1166# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1167$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1168and1169( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1170or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1171);11721173# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1174$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1175and1176($state->{entries}{$filename}{unchanged}1177or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1178);11791180# Need checkout if it exists in the repo but doesn't have a working copy1181$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );11821183# Locally modified if working copy and repo copy have the same revision but there are local changes1184$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );11851186# Needs Merge if working copy revision is less than repo copy and there are local changes1187$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );11881189$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1190$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1191$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1192$status||="File had conflicts on merge"if(0);11931194$status||="Unknown";11951196print"M ===================================================================\n";1197print"M File:$filename\tStatus:$status\n";1198if(defined($state->{entries}{$filename}{revision}) )1199{1200print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1201}else{1202print"M Working revision:\tNo entry for$filename\n";1203}1204if(defined($meta->{revision}) )1205{1206print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1207print"M Sticky Tag:\t\t(none)\n";1208print"M Sticky Date:\t\t(none)\n";1209print"M Sticky Options:\t\t(none)\n";1210}else{1211print"M Repository revision:\tNo revision control file\n";1212}1213print"M\n";1214}12151216print"ok\n";1217}12181219sub req_diff1220{1221my($cmd,$data) =@_;12221223 argsplit("diff");12241225$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1226#$log->debug("status state : " . Dumper($state));12271228my($revision1,$revision2);1229if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1230{1231$revision1=$state->{opt}{r}[0];1232$revision2=$state->{opt}{r}[1];1233}else{1234$revision1=$state->{opt}{r};1235}12361237$revision1=~s/^1\.//if(defined($revision1) );1238$revision2=~s/^1\.//if(defined($revision2) );12391240$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );12411242# Grab a handle to the SQLite db and do any necessary updates1243my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1244$updater->update();12451246# if no files were specified, we need to work out what files we should be providing status on ...1247 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12481249# foreach file specified on the commandline ...1250foreachmy$filename( @{$state->{args}} )1251{1252$filename= filecleanup($filename);12531254my($fh,$file1,$file2,$meta1,$meta2,$filediff);12551256my$wrev= revparse($filename);12571258# We need _something_ to diff against1259next unless(defined($wrev) );12601261# if we have a -r switch, use it1262if(defined($revision1) )1263{1264(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1265$meta1=$updater->getmeta($filename,$revision1);1266unless(defined($meta1)and$meta1->{filehash}ne"deleted")1267{1268print"E File$filenameat revision 1.$revision1doesn't exist\n";1269next;1270}1271 transmitfile($meta1->{filehash},$file1);1272}1273# otherwise we just use the working copy revision1274else1275{1276(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1277$meta1=$updater->getmeta($filename,$wrev);1278 transmitfile($meta1->{filehash},$file1);1279}12801281# if we have a second -r switch, use it too1282if(defined($revision2) )1283{1284(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1285$meta2=$updater->getmeta($filename,$revision2);12861287unless(defined($meta2)and$meta2->{filehash}ne"deleted")1288{1289print"E File$filenameat revision 1.$revision2doesn't exist\n";1290next;1291}12921293 transmitfile($meta2->{filehash},$file2);1294}1295# otherwise we just use the working copy1296else1297{1298$file2=$state->{entries}{$filename}{modified_filename};1299}13001301# if we have been given -r, and we don't have a $file2 yet, lets get one1302if(defined($revision1)and not defined($file2) )1303{1304(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1305$meta2=$updater->getmeta($filename,$wrev);1306 transmitfile($meta2->{filehash},$file2);1307}13081309# We need to have retrieved something useful1310next unless(defined($meta1) );13111312# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1313next if(not defined($meta2)and$wrev==$meta1->{revision}1314and1315( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1316or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1317);13181319# Apparently we only show diffs for locally modified files1320next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );13211322print"M Index:$filename\n";1323print"M ===================================================================\n";1324print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1325print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1326print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1327print"M diff ";1328foreachmy$opt(keys%{$state->{opt}} )1329{1330if(ref$state->{opt}{$opt}eq"ARRAY")1331{1332foreachmy$value( @{$state->{opt}{$opt}} )1333{1334print"-$opt$value";1335}1336}else{1337print"-$opt";1338print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1339}1340}1341print"$filename\n";13421343$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));13441345($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);13461347if(exists$state->{opt}{u} )1348{1349system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1350}else{1351system("diff$file1$file2>$filediff");1352}13531354while( <$fh> )1355{1356print"M$_";1357}1358close$fh;1359}13601361print"ok\n";1362}13631364sub req_log1365{1366my($cmd,$data) =@_;13671368 argsplit("log");13691370$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1371#$log->debug("log state : " . Dumper($state));13721373my($minrev,$maxrev);1374if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1375{1376my$control=$2;1377$minrev=$1;1378$maxrev=$3;1379$minrev=~s/^1\.//if(defined($minrev) );1380$maxrev=~s/^1\.//if(defined($maxrev) );1381$minrev++if(defined($minrev)and$controleq"::");1382}13831384# Grab a handle to the SQLite db and do any necessary updates1385my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1386$updater->update();13871388# if no files were specified, we need to work out what files we should be providing status on ...1389 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);13901391# foreach file specified on the commandline ...1392foreachmy$filename( @{$state->{args}} )1393{1394$filename= filecleanup($filename);13951396my$headmeta=$updater->getmeta($filename);13971398my$revisions=$updater->getlog($filename);1399my$totalrevisions=scalar(@$revisions);14001401if(defined($minrev) )1402{1403$log->debug("Removing revisions less than$minrev");1404while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1405{1406pop@$revisions;1407}1408}1409if(defined($maxrev) )1410{1411$log->debug("Removing revisions greater than$maxrev");1412while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1413{1414shift@$revisions;1415}1416}14171418next unless(scalar(@$revisions) );14191420print"M\n";1421print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1422print"M Working file:$filename\n";1423print"M head: 1.$headmeta->{revision}\n";1424print"M branch:\n";1425print"M locks: strict\n";1426print"M access list:\n";1427print"M symbolic names:\n";1428print"M keyword substitution: kv\n";1429print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1430print"M description:\n";14311432foreachmy$revision(@$revisions)1433{1434print"M ----------------------------\n";1435print"M revision 1.$revision->{revision}\n";1436# reformat the date for log output1437$revision->{modified} =sprintf('%04d/%02d/%02d%s',$3,$DATE_LIST->{$2},$1,$4)if($revision->{modified} =~/(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/and defined($DATE_LIST->{$2}) );1438$revision->{author} =~s/\s+.*//;1439$revision->{author} =~s/^(.{8}).*/$1/;1440print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1441my$commitmessage=$updater->commitmessage($revision->{commithash});1442$commitmessage=~s/^/M /mg;1443print$commitmessage."\n";1444}1445print"M =============================================================================\n";1446}14471448print"ok\n";1449}14501451sub req_annotate1452{1453my($cmd,$data) =@_;14541455 argsplit("annotate");14561457$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1458#$log->debug("status state : " . Dumper($state));14591460# Grab a handle to the SQLite db and do any necessary updates1461my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1462$updater->update();14631464# if no files were specified, we need to work out what files we should be providing annotate on ...1465 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);14661467# we'll need a temporary checkout dir1468my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1469my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1470$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");14711472$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1473$ENV{GIT_INDEX_FILE} =$file_index;14741475chdir$tmpdir;14761477# foreach file specified on the commandline ...1478foreachmy$filename( @{$state->{args}} )1479{1480$filename= filecleanup($filename);14811482my$meta=$updater->getmeta($filename);14831484next unless($meta->{revision} );14851486# get all the commits that this file was in1487# in dense format -- aka skip dead revisions1488my$revisions=$updater->gethistorydense($filename);1489my$lastseenin=$revisions->[0][2];14901491# populate the temporary index based on the latest commit were we saw1492# the file -- but do it cheaply without checking out any files1493# TODO: if we got a revision from the client, use that instead1494# to look up the commithash in sqlite (still good to default to1495# the current head as we do now)1496system("git-read-tree",$lastseenin);1497unless($?==0)1498{1499die"Error running git-read-tree$lastseenin$file_index$!";1500}1501$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");15021503# do a checkout of the file1504system('git-checkout-index','-f','-u',$filename);1505unless($?==0) {1506die"Error running git-checkout-index -f -u$filename:$!";1507}15081509$log->info("Annotate$filename");15101511# Prepare a file with the commits from the linearized1512# history that annotate should know about. This prevents1513# git-jsannotate telling us about commits we are hiding1514# from the client.15151516open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1517for(my$i=0;$i<@$revisions;$i++)1518{1519print ANNOTATEHINTS $revisions->[$i][2];1520if($i+1<@$revisions) {# have we got a parent?1521print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1522}1523print ANNOTATEHINTS "\n";1524}15251526print ANNOTATEHINTS "\n";1527close ANNOTATEHINTS;15281529my$annotatecmd='git-annotate';1530open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1531or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1532my$metadata= {};1533print"E Annotations for$filename\n";1534print"E ***************\n";1535while( <ANNOTATE> )1536{1537if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1538{1539my$commithash=$1;1540my$data=$2;1541unless(defined($metadata->{$commithash} ) )1542{1543$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1544$metadata->{$commithash}{author} =~s/\s+.*//;1545$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1546$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1547}1548printf("M 1.%-5d (%-8s%10s):%s\n",1549$metadata->{$commithash}{revision},1550$metadata->{$commithash}{author},1551$metadata->{$commithash}{modified},1552$data1553);1554}else{1555$log->warn("Error in annotate output! LINE:$_");1556print"E Annotate error\n";1557next;1558}1559}1560close ANNOTATE;1561}15621563# done; get out of the tempdir1564chdir"/";15651566print"ok\n";15671568}15691570# This method takes the state->{arguments} array and produces two new arrays.1571# The first is $state->{args} which is everything before the '--' argument, and1572# the second is $state->{files} which is everything after it.1573sub argsplit1574{1575return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");15761577my$type=shift;15781579$state->{args} = [];1580$state->{files} = [];1581$state->{opt} = {};15821583if(defined($type) )1584{1585my$opt= {};1586$opt= { A =>0, N =>0, P =>0, R =>0, c =>0, f =>0, l =>0, n =>0, p =>0, s =>0, r =>1, D =>1, d =>1, k =>1, j =>1, }if($typeeq"co");1587$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1588$opt= { A =>0, P =>0, C =>0, d =>0, f =>0, l =>0, R =>0, p =>0, k =>1, r =>1, D =>1, j =>1, I =>1, W =>1}if($typeeq"update");1589$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1590$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1591$opt= { k =>1, m =>1}if($typeeq"add");1592$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1593$opt= { l =>0, b =>0, h =>0, R =>0, t =>0, N =>0, S =>0, r =>1, d =>1, s =>1, w =>1}if($typeeq"log");159415951596while(scalar( @{$state->{arguments}} ) >0)1597{1598my$arg=shift@{$state->{arguments}};15991600next if($argeq"--");1601next unless($arg=~/\S/);16021603# if the argument looks like a switch1604if($arg=~/^-(\w)(.*)/)1605{1606# if it's a switch that takes an argument1607if($opt->{$1} )1608{1609# If this switch has already been provided1610if($opt->{$1} >1and exists($state->{opt}{$1} ) )1611{1612$state->{opt}{$1} = [$state->{opt}{$1} ];1613if(length($2) >0)1614{1615push@{$state->{opt}{$1}},$2;1616}else{1617push@{$state->{opt}{$1}},shift@{$state->{arguments}};1618}1619}else{1620# if there's extra data in the arg, use that as the argument for the switch1621if(length($2) >0)1622{1623$state->{opt}{$1} =$2;1624}else{1625$state->{opt}{$1} =shift@{$state->{arguments}};1626}1627}1628}else{1629$state->{opt}{$1} =undef;1630}1631}1632else1633{1634push@{$state->{args}},$arg;1635}1636}1637}1638else1639{1640my$mode=0;16411642foreachmy$value( @{$state->{arguments}} )1643{1644if($valueeq"--")1645{1646$mode++;1647next;1648}1649push@{$state->{args}},$valueif($mode==0);1650push@{$state->{files}},$valueif($mode==1);1651}1652}1653}16541655# This method uses $state->{directory} to populate $state->{args} with a list of filenames1656sub argsfromdir1657{1658my$updater=shift;16591660$state->{args} = [];16611662foreachmy$file( @{$updater->gethead} )1663{1664next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1665next unless($file->{name} =~s/^$state->{directory}//);1666push@{$state->{args}},$file->{name};1667}1668}16691670# This method cleans up the $state variable after a command that uses arguments has run1671sub statecleanup1672{1673$state->{files} = [];1674$state->{args} = [];1675$state->{arguments} = [];1676$state->{entries} = {};1677}16781679sub revparse1680{1681my$filename=shift;16821683returnundefunless(defined($state->{entries}{$filename}{revision} ) );16841685return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1686return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);16871688returnundef;1689}16901691# This method takes a file hash and does a CVS "file transfer" which transmits the1692# size of the file, and then the file contents.1693# If a second argument $targetfile is given, the file is instead written out to1694# a file by the name of $targetfile1695sub transmitfile1696{1697my$filehash=shift;1698my$targetfile=shift;16991700if(defined($filehash)and$filehasheq"deleted")1701{1702$log->warn("filehash is 'deleted'");1703return;1704}17051706die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);17071708my$type=`git-cat-file -t$filehash`;1709 chomp$type;17101711 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );17121713 my$size= `git-cat-file -s $filehash`;1714chomp$size;17151716$log->debug("transmitfile($filehash) size=$size, type=$type");17171718if(open my$fh,'-|',"git-cat-file","blob",$filehash)1719{1720if(defined($targetfile) )1721{1722open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1723print NEWFILE $_while( <$fh> );1724close NEWFILE;1725}else{1726print"$size\n";1727printwhile( <$fh> );1728}1729close$fhor die("Couldn't close filehandle for transmitfile()");1730}else{1731die("Couldn't execute git-cat-file");1732}1733}17341735# This method takes a file name, and returns ( $dirpart, $filepart ) which1736# refers to the directory portion and the file portion of the filename1737# respectively1738sub filenamesplit1739{1740my$filename=shift;17411742my($filepart,$dirpart) = ($filename,".");1743($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1744$dirpart.="/";17451746return($filepart,$dirpart);1747}17481749sub filecleanup1750{1751my$filename=shift;17521753returnundefunless(defined($filename));1754if($filename=~/^\// )1755{1756print"E absolute filenames '$filename' not supported by server\n";1757returnundef;1758}17591760$filename=~s/^\.\///g;1761$filename=$state->{directory} .$filename;17621763return$filename;1764}17651766package GITCVS::log;17671768####1769#### Copyright The Open University UK - 2006.1770####1771#### Authors: Martyn Smith <martyn@catalyst.net.nz>1772#### Martin Langhoff <martin@catalyst.net.nz>1773####1774####17751776use strict;1777use warnings;17781779=head1 NAME17801781GITCVS::log17821783=head1 DESCRIPTION17841785This module provides very crude logging with a similar interface to1786Log::Log4perl17871788=head1 METHODS17891790=cut17911792=head2 new17931794Creates a new log object, optionally you can specify a filename here to1795indicate the file to log to. If no log file is specified, you can specify one1796later with method setfile, or indicate you no longer want logging with method1797nofile.17981799Until one of these methods is called, all log calls will buffer messages ready1800to write out.18011802=cut1803sub new1804{1805my$class=shift;1806my$filename=shift;18071808my$self= {};18091810bless$self,$class;18111812if(defined($filename) )1813{1814open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1815}18161817return$self;1818}18191820=head2 setfile18211822This methods takes a filename, and attempts to open that file as the log file.1823If successful, all buffered data is written out to the file, and any further1824logging is written directly to the file.18251826=cut1827sub setfile1828{1829my$self=shift;1830my$filename=shift;18311832if(defined($filename) )1833{1834open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1835}18361837return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");18381839while(my$line=shift@{$self->{buffer}} )1840{1841print{$self->{fh}}$line;1842}1843}18441845=head2 nofile18461847This method indicates no logging is going to be used. It flushes any entries in1848the internal buffer, and sets a flag to ensure no further data is put there.18491850=cut1851sub nofile1852{1853my$self=shift;18541855$self->{nolog} =1;18561857return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");18581859$self->{buffer} = [];1860}18611862=head2 _logopen18631864Internal method. Returns true if the log file is open, false otherwise.18651866=cut1867sub _logopen1868{1869my$self=shift;18701871return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1872return0;1873}18741875=head2 debug info warn fatal18761877These four methods are wrappers to _log. They provide the actual interface for1878logging data.18791880=cut1881sub debug {my$self=shift;$self->_log("debug",@_); }1882sub info {my$self=shift;$self->_log("info",@_); }1883subwarn{my$self=shift;$self->_log("warn",@_); }1884sub fatal {my$self=shift;$self->_log("fatal",@_); }18851886=head2 _log18871888This is an internal method called by the logging functions. It generates a1889timestamp and pushes the logged line either to file, or internal buffer.18901891=cut1892sub _log1893{1894my$self=shift;1895my$level=shift;18961897return if($self->{nolog} );18981899my@time=localtime;1900my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1901$time[5] +1900,1902$time[4] +1,1903$time[3],1904$time[2],1905$time[1],1906$time[0],1907uc$level,1908);19091910if($self->_logopen)1911{1912print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1913}else{1914push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1915}1916}19171918=head2 DESTROY19191920This method simply closes the file handle if one is open19211922=cut1923sub DESTROY1924{1925my$self=shift;19261927if($self->_logopen)1928{1929close$self->{fh};1930}1931}19321933package GITCVS::updater;19341935####1936#### Copyright The Open University UK - 2006.1937####1938#### Authors: Martyn Smith <martyn@catalyst.net.nz>1939#### Martin Langhoff <martin@catalyst.net.nz>1940####1941####19421943use strict;1944use warnings;1945use DBI;19461947=head1 METHODS19481949=cut19501951=head2 new19521953=cut1954sub new1955{1956my$class=shift;1957my$config=shift;1958my$module=shift;1959my$log=shift;19601961die"Need to specify a git repository"unless(defined($config)and-d $config);1962die"Need to specify a module"unless(defined($module) );19631964$class=ref($class) ||$class;19651966my$self= {};19671968bless$self,$class;19691970$self->{dbdir} =$config."/";1971die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );19721973$self->{module} =$module;1974$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";19751976$self->{git_path} =$config."/";19771978$self->{log} =$log;19791980die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );19811982$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");19831984$self->{tables} = {};1985foreachmy$table($self->{dbh}->tables)1986{1987$table=~s/^"//;1988$table=~s/"$//;1989$self->{tables}{$table} =1;1990}19911992# Construct the revision table if required1993unless($self->{tables}{revision} )1994{1995$self->{dbh}->do("1996 CREATE TABLE revision (1997 name TEXT NOT NULL,1998 revision INTEGER NOT NULL,1999 filehash TEXT NOT NULL,2000 commithash TEXT NOT NULL,2001 author TEXT NOT NULL,2002 modified TEXT NOT NULL,2003 mode TEXT NOT NULL2004 )2005 ");2006}20072008# Construct the revision table if required2009unless($self->{tables}{head} )2010{2011$self->{dbh}->do("2012 CREATE TABLE head (2013 name TEXT NOT NULL,2014 revision INTEGER NOT NULL,2015 filehash TEXT NOT NULL,2016 commithash TEXT NOT NULL,2017 author TEXT NOT NULL,2018 modified TEXT NOT NULL,2019 mode TEXT NOT NULL2020 )2021 ");2022}20232024# Construct the properties table if required2025unless($self->{tables}{properties} )2026{2027$self->{dbh}->do("2028 CREATE TABLE properties (2029 key TEXT NOT NULL PRIMARY KEY,2030 value TEXT2031 )2032 ");2033}20342035# Construct the commitmsgs table if required2036unless($self->{tables}{commitmsgs} )2037{2038$self->{dbh}->do("2039 CREATE TABLE commitmsgs (2040 key TEXT NOT NULL PRIMARY KEY,2041 value TEXT2042 )2043 ");2044}20452046return$self;2047}20482049=head2 update20502051=cut2052sub update2053{2054my$self=shift;20552056# first lets get the commit list2057$ENV{GIT_DIR} =$self->{git_path};20582059# prepare database queries2060my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2061my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2062my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2063my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);20642065my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;2066unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2067{2068die("Invalid module '$self->{module}'");2069}207020712072my$git_log;2073my$lastcommit=$self->_get_prop("last_commit");20742075# Start exclusive lock here...2076$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";20772078# TODO: log processing is memory bound2079# if we can parse into a 2nd file that is in reverse order2080# we can probably do something really efficient2081my@git_log_params= ('--pretty','--parents','--topo-order');20822083if(defined$lastcommit) {2084push@git_log_params,"$lastcommit..$self->{module}";2085}else{2086push@git_log_params,$self->{module};2087}2088# git-rev-list is the backend / plumbing version of git-log2089open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";20902091my@commits;20922093my%commit= ();20942095while( <GITLOG> )2096{2097chomp;2098if(m/^commit\s+(.*)$/) {2099# on ^commit lines put the just seen commit in the stack2100# and prime things for the next one2101if(keys%commit) {2102my%copy=%commit;2103unshift@commits, \%copy;2104%commit= ();2105}2106my@parents=split(m/\s+/,$1);2107$commit{hash} =shift@parents;2108$commit{parents} = \@parents;2109}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2110# on rfc822-like lines seen before we see any message,2111# lowercase the entry and put it in the hash as key-value2112$commit{lc($1)} =$2;2113}else{2114# message lines - skip initial empty line2115# and trim whitespace2116if(!exists($commit{message}) &&m/^\s*$/) {2117# define it to mark the end of headers2118$commit{message} ='';2119next;2120}2121s/^\s+//;s/\s+$//;# trim ws2122$commit{message} .=$_."\n";2123}2124}2125close GITLOG;21262127unshift@commits, \%commitif(keys%commit);21282129# Now all the commits are in the @commits bucket2130# ordered by time DESC. for each commit that needs processing,2131# determine whether it's following the last head we've seen or if2132# it's on its own branch, grab a file list, and add whatever's changed2133# NOTE: $lastcommit refers to the last commit from previous run2134# $lastpicked is the last commit we picked in this run2135my$lastpicked;2136my$head= {};2137if(defined$lastcommit) {2138$lastpicked=$lastcommit;2139}21402141my$committotal=scalar(@commits);2142my$commitcount=0;21432144# Load the head table into $head (for cached lookups during the update process)2145foreachmy$file( @{$self->gethead()} )2146{2147$head->{$file->{name}} =$file;2148}21492150foreachmy$commit(@commits)2151{2152$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2153if(defined$lastpicked)2154{2155if(!in_array($lastpicked, @{$commit->{parents}}))2156{2157# skip, we'll see this delta2158# as part of a merge later2159# warn "skipping off-track $commit->{hash}\n";2160next;2161}elsif(@{$commit->{parents}} >1) {2162# it is a merge commit, for each parent that is2163# not $lastpicked, see if we can get a log2164# from the merge-base to that parent to put it2165# in the message as a merge summary.2166my@parents= @{$commit->{parents}};2167foreachmy$parent(@parents) {2168# git-merge-base can potentially (but rarely) throw2169# several candidate merge bases. let's assume2170# that the first one is the best one.2171if($parenteq$lastpicked) {2172next;2173}2174open my$p,'git-merge-base '.$lastpicked.' '2175.$parent.'|';2176my@output= (<$p>);2177close$p;2178my$base=join('',@output);2179chomp$base;2180if($base) {2181my@merged;2182# print "want to log between $base $parent \n";2183open(GITLOG,'-|','git-log',"$base..$parent")2184or die"Cannot call git-log:$!";2185my$mergedhash;2186while(<GITLOG>) {2187chomp;2188if(!defined$mergedhash) {2189if(m/^commit\s+(.+)$/) {2190$mergedhash=$1;2191}else{2192next;2193}2194}else{2195# grab the first line that looks non-rfc8222196# aka has content after leading space2197if(m/^\s+(\S.*)$/) {2198my$title=$1;2199$title=substr($title,0,100);# truncate2200unshift@merged,"$mergedhash$title";2201undef$mergedhash;2202}2203}2204}2205close GITLOG;2206if(@merged) {2207$commit->{mergemsg} =$commit->{message};2208$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2209foreachmy$summary(@merged) {2210$commit->{mergemsg} .="\t$summary\n";2211}2212$commit->{mergemsg} .="\n\n";2213# print "Message for $commit->{hash} \n$commit->{mergemsg}";2214}2215}2216}2217}2218}22192220# convert the date to CVS-happy format2221$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);22222223if(defined($lastpicked) )2224{2225my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2226while( <FILELIST> )2227{2228unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2229{2230die("Couldn't process git-diff-tree line :$_");2231}22322233# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");22342235my$git_perms="";2236$git_perms.="r"if($1&4);2237$git_perms.="w"if($1&2);2238$git_perms.="x"if($1&1);2239$git_perms="rw"if($git_permseq"");22402241if($3eq"D")2242{2243#$log->debug("DELETE $4");2244$head->{$4} = {2245 name =>$4,2246 revision =>$head->{$4}{revision} +1,2247 filehash =>"deleted",2248 commithash =>$commit->{hash},2249 modified =>$commit->{date},2250 author =>$commit->{author},2251 mode =>$git_perms,2252};2253$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2254}2255elsif($3eq"M")2256{2257#$log->debug("MODIFIED $4");2258$head->{$4} = {2259 name =>$4,2260 revision =>$head->{$4}{revision} +1,2261 filehash =>$2,2262 commithash =>$commit->{hash},2263 modified =>$commit->{date},2264 author =>$commit->{author},2265 mode =>$git_perms,2266};2267$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2268}2269elsif($3eq"A")2270{2271#$log->debug("ADDED $4");2272$head->{$4} = {2273 name =>$4,2274 revision =>1,2275 filehash =>$2,2276 commithash =>$commit->{hash},2277 modified =>$commit->{date},2278 author =>$commit->{author},2279 mode =>$git_perms,2280};2281$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2282}2283else2284{2285$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2286die;2287}2288}2289close FILELIST;2290}else{2291# this is used to detect files removed from the repo2292my$seen_files= {};22932294my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2295while( <FILELIST> )2296{2297unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2298{2299die("Couldn't process git-ls-tree line :$_");2300}23012302my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);23032304$seen_files->{$git_filename} =1;23052306my($oldhash,$oldrevision,$oldmode) = (2307$head->{$git_filename}{filehash},2308$head->{$git_filename}{revision},2309$head->{$git_filename}{mode}2310);23112312if($git_perms=~/^\d\d\d(\d)\d\d/o)2313{2314$git_perms="";2315$git_perms.="r"if($1&4);2316$git_perms.="w"if($1&2);2317$git_perms.="x"if($1&1);2318}else{2319$git_perms="rw";2320}23212322# unless the file exists with the same hash, we need to update it ...2323unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2324{2325my$newrevision= ($oldrevisionor0) +1;23262327$head->{$git_filename} = {2328 name =>$git_filename,2329 revision =>$newrevision,2330 filehash =>$git_hash,2331 commithash =>$commit->{hash},2332 modified =>$commit->{date},2333 author =>$commit->{author},2334 mode =>$git_perms,2335};233623372338$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2339}2340}2341close FILELIST;23422343# Detect deleted files2344foreachmy$file(keys%$head)2345{2346unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2347{2348$head->{$file}{revision}++;2349$head->{$file}{filehash} ="deleted";2350$head->{$file}{commithash} =$commit->{hash};2351$head->{$file}{modified} =$commit->{date};2352$head->{$file}{author} =$commit->{author};23532354$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2355}2356}2357# END : "Detect deleted files"2358}235923602361if(exists$commit->{mergemsg})2362{2363$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2364}23652366$lastpicked=$commit->{hash};23672368$self->_set_prop("last_commit",$commit->{hash});2369}23702371$db_delete_head->execute();2372foreachmy$file(keys%$head)2373{2374$db_insert_head->execute(2375$file,2376$head->{$file}{revision},2377$head->{$file}{filehash},2378$head->{$file}{commithash},2379$head->{$file}{modified},2380$head->{$file}{author},2381$head->{$file}{mode},2382);2383}2384# invalidate the gethead cache2385$self->{gethead_cache} =undef;238623872388# Ending exclusive lock here2389$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2390}23912392sub _headrev2393{2394my$self=shift;2395my$filename=shift;23962397my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2398$db_query->execute($filename);2399my($hash,$revision,$mode) =$db_query->fetchrow_array;24002401return($hash,$revision,$mode);2402}24032404sub _get_prop2405{2406my$self=shift;2407my$key=shift;24082409my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2410$db_query->execute($key);2411my($value) =$db_query->fetchrow_array;24122413return$value;2414}24152416sub _set_prop2417{2418my$self=shift;2419my$key=shift;2420my$value=shift;24212422my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2423$db_query->execute($value,$key);24242425unless($db_query->rows)2426{2427$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2428$db_query->execute($key,$value);2429}24302431return$value;2432}24332434=head2 gethead24352436=cut24372438sub gethead2439{2440my$self=shift;24412442return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );24432444my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2445$db_query->execute();24462447my$tree= [];2448while(my$file=$db_query->fetchrow_hashref)2449{2450push@$tree,$file;2451}24522453$self->{gethead_cache} =$tree;24542455return$tree;2456}24572458=head2 getlog24592460=cut24612462sub getlog2463{2464my$self=shift;2465my$filename=shift;24662467my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2468$db_query->execute($filename);24692470my$tree= [];2471while(my$file=$db_query->fetchrow_hashref)2472{2473push@$tree,$file;2474}24752476return$tree;2477}24782479=head2 getmeta24802481This function takes a filename (with path) argument and returns a hashref of2482metadata for that file.24832484=cut24852486sub getmeta2487{2488my$self=shift;2489my$filename=shift;2490my$revision=shift;24912492my$db_query;2493if(defined($revision)and$revision=~/^\d+$/)2494{2495$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2496$db_query->execute($filename,$revision);2497}2498elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2499{2500$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2501$db_query->execute($filename,$revision);2502}else{2503$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2504$db_query->execute($filename);2505}25062507return$db_query->fetchrow_hashref;2508}25092510=head2 commitmessage25112512this function takes a commithash and returns the commit message for that commit25132514=cut2515sub commitmessage2516{2517my$self=shift;2518my$commithash=shift;25192520die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);25212522my$db_query;2523$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2524$db_query->execute($commithash);25252526my($message) =$db_query->fetchrow_array;25272528if(defined($message) )2529{2530$message.=" "if($message=~/\n$/);2531return$message;2532}25332534my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2535shift@lineswhile($lines[0] =~/\S/);2536$message=join("",@lines);2537$message.=" "if($message=~/\n$/);2538return$message;2539}25402541=head2 gethistory25422543This function takes a filename (with path) argument and returns an arrayofarrays2544containing revision,filehash,commithash ordered by revision descending25452546=cut2547sub gethistory2548{2549my$self=shift;2550my$filename=shift;25512552my$db_query;2553$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2554$db_query->execute($filename);25552556return$db_query->fetchall_arrayref;2557}25582559=head2 gethistorydense25602561This function takes a filename (with path) argument and returns an arrayofarrays2562containing revision,filehash,commithash ordered by revision descending.25632564This version of gethistory skips deleted entries -- so it is useful for annotate.2565The 'dense' part is a reference to a '--dense' option available for git-rev-list2566and other git tools that depend on it.25672568=cut2569sub gethistorydense2570{2571my$self=shift;2572my$filename=shift;25732574my$db_query;2575$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2576$db_query->execute($filename);25772578return$db_query->fetchall_arrayref;2579}25802581=head2 in_array()25822583from Array::PAT - mimics the in_array() function2584found in PHP. Yuck but works for small arrays.25852586=cut2587sub in_array2588{2589my($check,@array) =@_;2590my$retval=0;2591foreachmy$test(@array){2592if($checkeq$test){2593$retval=1;2594}2595}2596return$retval;2597}25982599=head2 safe_pipe_capture26002601an alternative to `command` that allows input to be passed as an array2602to work around shell problems with weird characters in arguments26032604=cut2605sub safe_pipe_capture {26062607my@output;26082609if(my$pid=open my$child,'-|') {2610@output= (<$child>);2611close$childor die join(' ',@_).":$!$?";2612}else{2613exec(@_)or die"$!$?";# exec() can fail the executable can't be found2614}2615returnwantarray?@output:join('',@output);2616}2617261826191;