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$state->{globaloptions}{$data} =1; 218} 219 220# Valid-responses request-list \n 221# Response expected: no. Tell the server what responses the client will 222# accept. request-list is a space separated list of tokens. 223sub req_Validresponses 224{ 225my($cmd,$data) =@_; 226$log->debug("req_Validresponses :$data"); 227 228# TODO : re-enable this, currently it's not particularly useful 229#$state->{validresponses} = [ split /\s+/, $data ]; 230} 231 232# valid-requests \n 233# Response expected: yes. Ask the server to send back a Valid-requests 234# response. 235sub req_validrequests 236{ 237my($cmd,$data) =@_; 238 239$log->debug("req_validrequests"); 240 241$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 242$log->debug("SEND : ok"); 243 244print"Valid-requests ".join(" ",keys%$methods) ."\n"; 245print"ok\n"; 246} 247 248# Directory local-directory \n 249# Additional data: repository \n. Response expected: no. Tell the server 250# what directory to use. The repository should be a directory name from a 251# previous server response. Note that this both gives a default for Entry 252# and Modified and also for ci and the other commands; normal usage is to 253# send Directory for each directory in which there will be an Entry or 254# Modified, and then a final Directory for the original directory, then the 255# command. The local-directory is relative to the top level at which the 256# command is occurring (i.e. the last Directory which is sent before the 257# command); to indicate that top level, `.' should be sent for 258# local-directory. 259sub req_Directory 260{ 261my($cmd,$data) =@_; 262 263my$repository= <STDIN>; 264chomp$repository; 265 266 267$state->{localdir} =$data; 268$state->{repository} =$repository; 269$state->{path} =$repository; 270$state->{path} =~s/^$state->{CVSROOT}\///; 271$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 272$state->{path} .="/"if($state->{path} =~ /\S/ ); 273 274$state->{directory} =$state->{localdir}; 275$state->{directory} =""if($state->{directory}eq"."); 276$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 277 278if(not defined($state->{prependdir})and$state->{localdir}eq"."and$state->{path} =~/\S/) 279{ 280$log->info("Setting prepend to '$state->{path}'"); 281$state->{prependdir} =$state->{path}; 282foreachmy$entry(keys%{$state->{entries}} ) 283{ 284$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 285delete$state->{entries}{$entry}; 286} 287} 288 289if(defined($state->{prependdir} ) ) 290{ 291$log->debug("Prepending '$state->{prependdir}' to state|directory"); 292$state->{directory} =$state->{prependdir} .$state->{directory} 293} 294 295$log->debug("req_Directory : localdir=$datarepository=$repositorydirectory=$state->{directory} module=$state->{module}"); 296} 297 298# Entry entry-line \n 299# Response expected: no. Tell the server what version of a file is on the 300# local machine. The name in entry-line is a name relative to the directory 301# most recently specified with Directory. If the user is operating on only 302# some files in a directory, Entry requests for only those files need be 303# included. If an Entry request is sent without Modified, Is-modified, or 304# Unchanged, it means the file is lost (does not exist in the working 305# directory). If both Entry and one of Modified, Is-modified, or Unchanged 306# are sent for the same file, Entry must be sent first. For a given file, 307# one can send Modified, Is-modified, or Unchanged, but not more than one 308# of these three. 309sub req_Entry 310{ 311my($cmd,$data) =@_; 312 313#$log->debug("req_Entry : $data"); 314 315my@data=split(/\//,$data); 316 317$state->{entries}{$state->{directory}.$data[1]} = { 318 revision =>$data[2], 319 conflict =>$data[3], 320 options =>$data[4], 321 tag_or_date =>$data[5], 322}; 323 324$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 325} 326 327# Questionable filename \n 328# Response expected: no. Additional data: no. Tell the server to check 329# whether filename should be ignored, and if not, next time the server 330# sends responses, send (in a M response) `?' followed by the directory and 331# filename. filename must not contain `/'; it needs to be a file in the 332# directory named by the most recent Directory request. 333sub req_Questionable 334{ 335my($cmd,$data) =@_; 336 337$log->debug("req_Questionable :$data"); 338$state->{entries}{$state->{directory}.$data}{questionable} =1; 339} 340 341# add \n 342# Response expected: yes. Add a file or directory. This uses any previous 343# Argument, Directory, Entry, or Modified requests, if they have been sent. 344# The last Directory sent specifies the working directory at the time of 345# the operation. To add a directory, send the directory to be added using 346# Directory and Argument requests. 347sub req_add 348{ 349my($cmd,$data) =@_; 350 351 argsplit("add"); 352 353my$addcount=0; 354 355foreachmy$filename( @{$state->{args}} ) 356{ 357$filename= filecleanup($filename); 358 359unless(defined($state->{entries}{$filename}{modified_filename} ) ) 360{ 361print"E cvs add: nothing known about `$filename'\n"; 362next; 363} 364# TODO : check we're not squashing an already existing file 365if(defined($state->{entries}{$filename}{revision} ) ) 366{ 367print"E cvs add: `$filename' has already been entered\n"; 368next; 369} 370 371my($filepart,$dirpart) = filenamesplit($filename,1); 372 373print"E cvs add: scheduling file `$filename' for addition\n"; 374 375print"Checked-in$dirpart\n"; 376print"$filename\n"; 377print"/$filepart/0///\n"; 378 379$addcount++; 380} 381 382if($addcount==1) 383{ 384print"E cvs add: use `cvs commit' to add this file permanently\n"; 385} 386elsif($addcount>1) 387{ 388print"E cvs add: use `cvs commit' to add these files permanently\n"; 389} 390 391print"ok\n"; 392} 393 394# remove \n 395# Response expected: yes. Remove a file. This uses any previous Argument, 396# Directory, Entry, or Modified requests, if they have been sent. The last 397# Directory sent specifies the working directory at the time of the 398# operation. Note that this request does not actually do anything to the 399# repository; the only effect of a successful remove request is to supply 400# the client with a new entries line containing `-' to indicate a removed 401# file. In fact, the client probably could perform this operation without 402# contacting the server, although using remove may cause the server to 403# perform a few more checks. The client sends a subsequent ci request to 404# actually record the removal in the repository. 405sub req_remove 406{ 407my($cmd,$data) =@_; 408 409 argsplit("remove"); 410 411# Grab a handle to the SQLite db and do any necessary updates 412my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 413$updater->update(); 414 415#$log->debug("add state : " . Dumper($state)); 416 417my$rmcount=0; 418 419foreachmy$filename( @{$state->{args}} ) 420{ 421$filename= filecleanup($filename); 422 423if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 424{ 425print"E cvs remove: file `$filename' still in working directory\n"; 426next; 427} 428 429my$meta=$updater->getmeta($filename); 430my$wrev= revparse($filename); 431 432unless(defined($wrev) ) 433{ 434print"E cvs remove: nothing known about `$filename'\n"; 435next; 436} 437 438if(defined($wrev)and$wrev<0) 439{ 440print"E cvs remove: file `$filename' already scheduled for removal\n"; 441next; 442} 443 444unless($wrev==$meta->{revision} ) 445{ 446# TODO : not sure if the format of this message is quite correct. 447print"E cvs remove: Up to date check failed for `$filename'\n"; 448next; 449} 450 451 452my($filepart,$dirpart) = filenamesplit($filename,1); 453 454print"E cvs remove: scheduling `$filename' for removal\n"; 455 456print"Checked-in$dirpart\n"; 457print"$filename\n"; 458print"/$filepart/-1.$wrev///\n"; 459 460$rmcount++; 461} 462 463if($rmcount==1) 464{ 465print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 466} 467elsif($rmcount>1) 468{ 469print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 470} 471 472print"ok\n"; 473} 474 475# Modified filename \n 476# Response expected: no. Additional data: mode, \n, file transmission. Send 477# the server a copy of one locally modified file. filename is a file within 478# the most recent directory sent with Directory; it must not contain `/'. 479# If the user is operating on only some files in a directory, only those 480# files need to be included. This can also be sent without Entry, if there 481# is no entry for the file. 482sub req_Modified 483{ 484my($cmd,$data) =@_; 485 486my$mode= <STDIN>; 487chomp$mode; 488my$size= <STDIN>; 489chomp$size; 490 491# Grab config information 492my$blocksize=8192; 493my$bytesleft=$size; 494my$tmp; 495 496# Get a filehandle/name to write it to 497my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 498 499# Loop over file data writing out to temporary file. 500while($bytesleft) 501{ 502$blocksize=$bytesleftif($bytesleft<$blocksize); 503read STDIN,$tmp,$blocksize; 504print$fh $tmp; 505$bytesleft-=$blocksize; 506} 507 508close$fh; 509 510# Ensure we have something sensible for the file mode 511if($mode=~/u=(\w+)/) 512{ 513$mode=$1; 514}else{ 515$mode="rw"; 516} 517 518# Save the file data in $state 519$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 520$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 521$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 522$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 523 524 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 525} 526 527# Unchanged filename\n 528# Response expected: no. Tell the server that filename has not been 529# modified in the checked out directory. The filename is a file within the 530# most recent directory sent with Directory; it must not contain `/'. 531sub req_Unchanged 532{ 533 my ($cmd,$data) =@_; 534 535$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 536 537 #$log->debug("req_Unchanged :$data"); 538} 539 540# Argument text\n 541# Response expected: no. Save argument for use in a subsequent command. 542# Arguments accumulate until an argument-using command is given, at which 543# point they are forgotten. 544# Argumentx text\n 545# Response expected: no. Append\nfollowed by text to the current argument 546# being saved. 547sub req_Argument 548{ 549 my ($cmd,$data) =@_; 550 551 # TODO : Not quite sure how Argument and Argumentx differ, but I assume 552 # it's for multi-line arguments ... somehow ... 553 554$log->debug("$cmd:$data"); 555 556push@{$state->{arguments}},$data; 557} 558 559# expand-modules \n 560# Response expected: yes. Expand the modules which are specified in the 561# arguments. Returns the data in Module-expansion responses. Note that the 562# server can assume that this is checkout or export, not rtag or rdiff; the 563# latter do not access the working directory and thus have no need to 564# expand modules on the client side. Expand may not be the best word for 565# what this request does. It does not necessarily tell you all the files 566# contained in a module, for example. Basically it is a way of telling you 567# which working directories the server needs to know about in order to 568# handle a checkout of the specified modules. For example, suppose that the 569# server has a module defined by 570# aliasmodule -a 1dir 571# That is, one can check out aliasmodule and it will take 1dir in the 572# repository and check it out to 1dir in the working directory. Now suppose 573# the client already has this module checked out and is planning on using 574# the co request to update it. Without using expand-modules, the client 575# would have two bad choices: it could either send information about all 576# working directories under the current directory, which could be 577# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 578# stands for 1dir, and neglect to send information for 1dir, which would 579# lead to incorrect operation. With expand-modules, the client would first 580# ask for the module to be expanded: 581sub req_expandmodules 582{ 583my($cmd,$data) =@_; 584 585 argsplit(); 586 587$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 588 589unless(ref$state->{arguments}eq"ARRAY") 590{ 591print"ok\n"; 592return; 593} 594 595foreachmy$module( @{$state->{arguments}} ) 596{ 597$log->debug("SEND : Module-expansion$module"); 598print"Module-expansion$module\n"; 599} 600 601print"ok\n"; 602 statecleanup(); 603} 604 605# co \n 606# Response expected: yes. Get files from the repository. This uses any 607# previous Argument, Directory, Entry, or Modified requests, if they have 608# been sent. Arguments to this command are module names; the client cannot 609# know what directories they correspond to except by (1) just sending the 610# co request, and then seeing what directory names the server sends back in 611# its responses, and (2) the expand-modules request. 612sub req_co 613{ 614my($cmd,$data) =@_; 615 616 argsplit("co"); 617 618my$module=$state->{args}[0]; 619my$checkout_path=$module; 620 621# use the user specified directory if we're given it 622$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 623 624$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 625 626$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 627 628$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 629 630# Grab a handle to the SQLite db and do any necessary updates 631my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 632$updater->update(); 633 634$checkout_path=~ s|/$||;# get rid of trailing slashes 635 636# Eclipse seems to need the Clear-sticky command 637# to prepare the 'Entries' file for the new directory. 638print"Clear-sticky$checkout_path/\n"; 639print$state->{CVSROOT} ."/$module/\n"; 640print"Clear-static-directory$checkout_path/\n"; 641print$state->{CVSROOT} ."/$module/\n"; 642print"Clear-sticky$checkout_path/\n";# yes, twice 643print$state->{CVSROOT} ."/$module/\n"; 644print"Template$checkout_path/\n"; 645print$state->{CVSROOT} ."/$module/\n"; 646print"0\n"; 647 648# instruct the client that we're checking out to $checkout_path 649print"E cvs checkout: Updating$checkout_path\n"; 650 651my%seendirs= (); 652my$lastdir=''; 653 654# recursive 655sub prepdir { 656my($dir,$repodir,$remotedir,$seendirs) =@_; 657my$parent= dirname($dir); 658$dir=~ s|/+$||; 659$repodir=~ s|/+$||; 660$remotedir=~ s|/+$||; 661$parent=~ s|/+$||; 662$log->debug("announcedir$dir,$repodir,$remotedir"); 663 664if($parenteq'.'||$parenteq'./') { 665$parent=''; 666} 667# recurse to announce unseen parents first 668if(length($parent) && !exists($seendirs->{$parent})) { 669 prepdir($parent,$repodir,$remotedir,$seendirs); 670} 671# Announce that we are going to modify at the parent level 672if($parent) { 673print"E cvs checkout: Updating$remotedir/$parent\n"; 674}else{ 675print"E cvs checkout: Updating$remotedir\n"; 676} 677print"Clear-sticky$remotedir/$parent/\n"; 678print"$repodir/$parent/\n"; 679 680print"Clear-static-directory$remotedir/$dir/\n"; 681print"$repodir/$dir/\n"; 682print"Clear-sticky$remotedir/$parent/\n";# yes, twice 683print"$repodir/$parent/\n"; 684print"Template$remotedir/$dir/\n"; 685print"$repodir/$dir/\n"; 686print"0\n"; 687 688$seendirs->{$dir} =1; 689} 690 691foreachmy$git( @{$updater->gethead} ) 692{ 693# Don't want to check out deleted files 694next if($git->{filehash}eq"deleted"); 695 696($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 697 698if(length($git->{dir}) &&$git->{dir}ne'./' 699&&$git->{dir}ne$lastdir) { 700unless(exists($seendirs{$git->{dir}})) { 701 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 702$checkout_path, \%seendirs); 703$lastdir=$git->{dir}; 704$seendirs{$git->{dir}} =1; 705} 706print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 707} 708 709# modification time of this file 710print"Mod-time$git->{modified}\n"; 711 712# print some information to the client 713if(defined($git->{dir} )and$git->{dir}ne"./") 714{ 715print"M U$checkout_path/$git->{dir}$git->{name}\n"; 716}else{ 717print"M U$checkout_path/$git->{name}\n"; 718} 719 720# instruct client we're sending a file to put in this path 721print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 722 723print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 724 725# this is an "entries" line 726print"/$git->{name}/1.$git->{revision}///\n"; 727# permissions 728print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 729 730# transmit file 731 transmitfile($git->{filehash}); 732} 733 734print"ok\n"; 735 736 statecleanup(); 737} 738 739# update \n 740# Response expected: yes. Actually do a cvs update command. This uses any 741# previous Argument, Directory, Entry, or Modified requests, if they have 742# been sent. The last Directory sent specifies the working directory at the 743# time of the operation. The -I option is not used--files which the client 744# can decide whether to ignore are not mentioned and the client sends the 745# Questionable request for others. 746sub req_update 747{ 748my($cmd,$data) =@_; 749 750$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 751 752 argsplit("update"); 753 754# 755# It may just be a client exploring the available heads/modules 756# in that case, list them as top level directories and leave it 757# at that. Eclipse uses this technique to offer you a list of 758# projects (heads in this case) to checkout. 759# 760if($state->{module}eq'') { 761print"E cvs update: Updating .\n"; 762opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 763while(my$head=readdir(HEADS)) { 764if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 765print"E cvs update: New directory `$head'\n"; 766} 767} 768closedir HEADS; 769print"ok\n"; 770return1; 771} 772 773 774# Grab a handle to the SQLite db and do any necessary updates 775my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 776 777$updater->update(); 778 779 argsfromdir($updater); 780 781#$log->debug("update state : " . Dumper($state)); 782 783# foreach file specified on the commandline ... 784foreachmy$filename( @{$state->{args}} ) 785{ 786$filename= filecleanup($filename); 787 788$log->debug("Processing file$filename"); 789 790# if we have a -C we should pretend we never saw modified stuff 791if(exists($state->{opt}{C} ) ) 792{ 793delete$state->{entries}{$filename}{modified_hash}; 794delete$state->{entries}{$filename}{modified_filename}; 795$state->{entries}{$filename}{unchanged} =1; 796} 797 798my$meta; 799if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 800{ 801$meta=$updater->getmeta($filename,$1); 802}else{ 803$meta=$updater->getmeta($filename); 804} 805 806next unless($meta->{revision} ); 807 808my$oldmeta=$meta; 809 810my$wrev= revparse($filename); 811 812# If the working copy is an old revision, lets get that version too for comparison. 813if(defined($wrev)and$wrev!=$meta->{revision} ) 814{ 815$oldmeta=$updater->getmeta($filename,$wrev); 816} 817 818#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 819 820# Files are up to date if the working copy and repo copy have the same revision, 821# and the working copy is unmodified _and_ the user hasn't specified -C 822next if(defined($wrev) 823and defined($meta->{revision}) 824and$wrev==$meta->{revision} 825and$state->{entries}{$filename}{unchanged} 826and not exists($state->{opt}{C} ) ); 827 828# If the working copy and repo copy have the same revision, 829# but the working copy is modified, tell the client it's modified 830if(defined($wrev) 831and defined($meta->{revision}) 832and$wrev==$meta->{revision} 833and not exists($state->{opt}{C} ) ) 834{ 835$log->info("Tell the client the file is modified"); 836print"MT text U\n"; 837print"MT fname$filename\n"; 838print"MT newline\n"; 839next; 840} 841 842if($meta->{filehash}eq"deleted") 843{ 844my($filepart,$dirpart) = filenamesplit($filename,1); 845 846$log->info("Removing '$filename' from working copy (no longer in the repo)"); 847 848print"E cvs update: `$filename' is no longer in the repository\n"; 849# Don't want to actually _DO_ the update if -n specified 850unless($state->{globaloptions}{-n} ) { 851print"Removed$dirpart\n"; 852print"$filepart\n"; 853} 854} 855elsif(not defined($state->{entries}{$filename}{modified_hash} ) 856or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 857{ 858$log->info("Updating '$filename'"); 859# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 860print"MT +updated\n"; 861print"MT text U\n"; 862print"MT fname$filename\n"; 863print"MT newline\n"; 864print"MT -updated\n"; 865 866my($filepart,$dirpart) = filenamesplit($filename,1); 867 868# Don't want to actually _DO_ the update if -n specified 869unless($state->{globaloptions}{-n} ) 870{ 871if(defined($wrev) ) 872{ 873# instruct client we're sending a file to put in this path as a replacement 874print"Update-existing$dirpart\n"; 875$log->debug("Updating existing file 'Update-existing$dirpart'"); 876}else{ 877# instruct client we're sending a file to put in this path as a new file 878print"Clear-static-directory$dirpart\n"; 879print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 880print"Clear-sticky$dirpart\n"; 881print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 882 883$log->debug("Creating new file 'Created$dirpart'"); 884print"Created$dirpart\n"; 885} 886print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 887 888# this is an "entries" line 889$log->debug("/$filepart/1.$meta->{revision}///"); 890print"/$filepart/1.$meta->{revision}///\n"; 891 892# permissions 893$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 894print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 895 896# transmit file 897 transmitfile($meta->{filehash}); 898} 899}else{ 900$log->info("Updating '$filename'"); 901my($filepart,$dirpart) = filenamesplit($meta->{name},1); 902 903my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 904 905chdir$dir; 906my$file_local=$filepart.".mine"; 907system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 908my$file_old=$filepart.".".$oldmeta->{revision}; 909 transmitfile($oldmeta->{filehash},$file_old); 910my$file_new=$filepart.".".$meta->{revision}; 911 transmitfile($meta->{filehash},$file_new); 912 913# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 914$log->info("Merging$file_local,$file_old,$file_new"); 915 916$log->debug("Temporary directory for merge is$dir"); 917 918my$return=system("merge",$file_local,$file_old,$file_new); 919$return>>=8; 920 921if($return==0) 922{ 923$log->info("Merged successfully"); 924print"M M$filename\n"; 925$log->debug("Update-existing$dirpart"); 926 927# Don't want to actually _DO_ the update if -n specified 928unless($state->{globaloptions}{-n} ) 929{ 930print"Update-existing$dirpart\n"; 931$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 932print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 933$log->debug("/$filepart/1.$meta->{revision}///"); 934print"/$filepart/1.$meta->{revision}///\n"; 935} 936} 937elsif($return==1) 938{ 939$log->info("Merged with conflicts"); 940print"M C$filename\n"; 941 942# Don't want to actually _DO_ the update if -n specified 943unless($state->{globaloptions}{-n} ) 944{ 945print"Update-existing$dirpart\n"; 946print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 947print"/$filepart/1.$meta->{revision}/+//\n"; 948} 949} 950else 951{ 952$log->warn("Merge failed"); 953next; 954} 955 956# Don't want to actually _DO_ the update if -n specified 957unless($state->{globaloptions}{-n} ) 958{ 959# permissions 960$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 961print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 962 963# transmit file, format is single integer on a line by itself (file 964# size) followed by the file contents 965# TODO : we should copy files in blocks 966my$data=`cat$file_local`; 967$log->debug("File size : " . length($data)); 968 print length($data) . "\n"; 969 print$data; 970 } 971 972 chdir "/"; 973 } 974 975 } 976 977 print "ok\n"; 978} 979 980sub req_ci 981{ 982 my ($cmd,$data) =@_; 983 984 argsplit("ci"); 985 986 #$log->debug("State : " . Dumper($state)); 987 988$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 989 990 if (@ARGV&&$ARGV[0] eq 'pserver') 991 { 992 print "error 1 pserver access cannot commit\n"; 993 exit; 994 } 995 996 if ( -e$state->{CVSROOT} . "/index" ) 997 { 998$log->warn("file 'index' already exists in the git repository"); 999 print "error 1 Index already exists in git repo\n";1000 exit;1001 }10021003 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock";1004 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )1005 {1006$log->warn("lockfile '$lockfile' already exists, please try again");1007 print "error 1 Lock file '$lockfile' already exists, please try again\n";1008 exit;1009 }10101011 # Grab a handle to the SQLite db and do any necessary updates1012 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1013$updater->update();10141015 my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1016 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 );1017$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");10181019$ENV{GIT_DIR} =$state->{CVSROOT} . "/";1020$ENV{GIT_INDEX_FILE} =$file_index;10211022 chdir$tmpdir;10231024 # populate the temporary index based1025 system("git-read-tree",$state->{module});1026 unless ($?== 0)1027 {1028 die "Error running git-read-tree$state->{module}$file_index$!";1029 }1030$log->info("Created index '$file_index' with for head$state->{module} - exit status$?");103110321033 my@committedfiles= ();10341035 # foreach file specified on the commandline ...1036 foreach my$filename( @{$state->{args}} )1037 {1038 my$committedfile=$filename;1039$filename= filecleanup($filename);10401041 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );10421043 my$meta=$updater->getmeta($filename);10441045 my$wrev= revparse($filename);10461047 my ($filepart,$dirpart) = filenamesplit($filename);10481049 # do a checkout of the file if it part of this tree1050 if ($wrev) {1051 system('git-checkout-index', '-f', '-u',$filename);1052 unless ($?== 0) {1053 die "Error running git-checkout-index -f -u$filename:$!";1054 }1055 }10561057 my$addflag= 0;1058 my$rmflag= 0;1059$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1060$addflag= 1 unless ( -e$filename);10611062 # Do up to date checking1063 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1064 {1065 # fail everything if an up to date check fails1066 print "error 1 Up to date check failed for$filename\n";1067 close LOCKFILE;1068 unlink($lockfile);1069 chdir "/";1070 exit;1071 }10721073 push@committedfiles,$committedfile;1074$log->info("Committing$filename");10751076 system("mkdir","-p",$dirpart) unless ( -d$dirpart);10771078 unless ($rmflag)1079 {1080$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1081 rename$state->{entries}{$filename}{modified_filename},$filename;10821083 # Calculate modes to remove1084 my$invmode= "";1085 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }10861087$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1088 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1089 }10901091 if ($rmflag)1092 {1093$log->info("Removing file '$filename'");1094 unlink($filename);1095 system("git-update-index", "--remove",$filename);1096 }1097 elsif ($addflag)1098 {1099$log->info("Adding file '$filename'");1100 system("git-update-index", "--add",$filename);1101 } else {1102$log->info("Updating file '$filename'");1103 system("git-update-index",$filename);1104 }1105 }11061107 unless ( scalar(@committedfiles) > 0 )1108 {1109 print "E No files to commit\n";1110 print "ok\n";1111 close LOCKFILE;1112 unlink($lockfile);1113 chdir "/";1114 return;1115 }11161117 my$treehash= `git-write-tree`;1118 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;1119 chomp$treehash;1120 chomp$parenthash;11211122$log->debug("Treehash :$treehash, Parenthash :$parenthash");11231124 # write our commit message out if we have one ...1125 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1126 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1127 print$msg_fh"\n\nvia git-CVS emulator\n";1128 close$msg_fh;11291130 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1131$log->info("Commit hash :$commithash");11321133unless($commithash=~/[a-zA-Z0-9]{40}/)1134{1135$log->warn("Commit failed (Invalid commit hash)");1136print"error 1 Commit failed (unknown reason)\n";1137close LOCKFILE;1138unlink($lockfile);1139chdir"/";1140exit;1141}11421143open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}";1144print FILE $commithash;1145close FILE;11461147$updater->update();11481149# foreach file specified on the commandline ...1150foreachmy$filename(@committedfiles)1151{1152$filename= filecleanup($filename);11531154my$meta=$updater->getmeta($filename);11551156my($filepart,$dirpart) = filenamesplit($filename,1);11571158$log->debug("Checked-in$dirpart:$filename");11591160if($meta->{filehash}eq"deleted")1161{1162print"Remove-entry$dirpart\n";1163print"$filename\n";1164}else{1165print"Checked-in$dirpart\n";1166print"$filename\n";1167print"/$filepart/1.$meta->{revision}///\n";1168}1169}11701171close LOCKFILE;1172unlink($lockfile);1173chdir"/";11741175print"ok\n";1176}11771178sub req_status1179{1180my($cmd,$data) =@_;11811182 argsplit("status");11831184$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1185#$log->debug("status state : " . Dumper($state));11861187# Grab a handle to the SQLite db and do any necessary updates1188my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1189$updater->update();11901191# if no files were specified, we need to work out what files we should be providing status on ...1192 argsfromdir($updater);11931194# foreach file specified on the commandline ...1195foreachmy$filename( @{$state->{args}} )1196{1197$filename= filecleanup($filename);11981199my$meta=$updater->getmeta($filename);1200my$oldmeta=$meta;12011202my$wrev= revparse($filename);12031204# If the working copy is an old revision, lets get that version too for comparison.1205if(defined($wrev)and$wrev!=$meta->{revision} )1206{1207$oldmeta=$updater->getmeta($filename,$wrev);1208}12091210# TODO : All possible statuses aren't yet implemented1211my$status;1212# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1213$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1214and1215( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1216or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1217);12181219# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1220$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1221and1222($state->{entries}{$filename}{unchanged}1223or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1224);12251226# Need checkout if it exists in the repo but doesn't have a working copy1227$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );12281229# Locally modified if working copy and repo copy have the same revision but there are local changes1230$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );12311232# Needs Merge if working copy revision is less than repo copy and there are local changes1233$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );12341235$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1236$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1237$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1238$status||="File had conflicts on merge"if(0);12391240$status||="Unknown";12411242print"M ===================================================================\n";1243print"M File:$filename\tStatus:$status\n";1244if(defined($state->{entries}{$filename}{revision}) )1245{1246print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1247}else{1248print"M Working revision:\tNo entry for$filename\n";1249}1250if(defined($meta->{revision}) )1251{1252print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1253print"M Sticky Tag:\t\t(none)\n";1254print"M Sticky Date:\t\t(none)\n";1255print"M Sticky Options:\t\t(none)\n";1256}else{1257print"M Repository revision:\tNo revision control file\n";1258}1259print"M\n";1260}12611262print"ok\n";1263}12641265sub req_diff1266{1267my($cmd,$data) =@_;12681269 argsplit("diff");12701271$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1272#$log->debug("status state : " . Dumper($state));12731274my($revision1,$revision2);1275if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1276{1277$revision1=$state->{opt}{r}[0];1278$revision2=$state->{opt}{r}[1];1279}else{1280$revision1=$state->{opt}{r};1281}12821283$revision1=~s/^1\.//if(defined($revision1) );1284$revision2=~s/^1\.//if(defined($revision2) );12851286$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );12871288# Grab a handle to the SQLite db and do any necessary updates1289my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1290$updater->update();12911292# if no files were specified, we need to work out what files we should be providing status on ...1293 argsfromdir($updater);12941295# foreach file specified on the commandline ...1296foreachmy$filename( @{$state->{args}} )1297{1298$filename= filecleanup($filename);12991300my($fh,$file1,$file2,$meta1,$meta2,$filediff);13011302my$wrev= revparse($filename);13031304# We need _something_ to diff against1305next unless(defined($wrev) );13061307# if we have a -r switch, use it1308if(defined($revision1) )1309{1310(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1311$meta1=$updater->getmeta($filename,$revision1);1312unless(defined($meta1)and$meta1->{filehash}ne"deleted")1313{1314print"E File$filenameat revision 1.$revision1doesn't exist\n";1315next;1316}1317 transmitfile($meta1->{filehash},$file1);1318}1319# otherwise we just use the working copy revision1320else1321{1322(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1323$meta1=$updater->getmeta($filename,$wrev);1324 transmitfile($meta1->{filehash},$file1);1325}13261327# if we have a second -r switch, use it too1328if(defined($revision2) )1329{1330(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1331$meta2=$updater->getmeta($filename,$revision2);13321333unless(defined($meta2)and$meta2->{filehash}ne"deleted")1334{1335print"E File$filenameat revision 1.$revision2doesn't exist\n";1336next;1337}13381339 transmitfile($meta2->{filehash},$file2);1340}1341# otherwise we just use the working copy1342else1343{1344$file2=$state->{entries}{$filename}{modified_filename};1345}13461347# if we have been given -r, and we don't have a $file2 yet, lets get one1348if(defined($revision1)and not defined($file2) )1349{1350(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1351$meta2=$updater->getmeta($filename,$wrev);1352 transmitfile($meta2->{filehash},$file2);1353}13541355# We need to have retrieved something useful1356next unless(defined($meta1) );13571358# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1359next if(not defined($meta2)and$wrev==$meta1->{revision}1360and1361( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1362or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1363);13641365# Apparently we only show diffs for locally modified files1366next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );13671368print"M Index:$filename\n";1369print"M ===================================================================\n";1370print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1371print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1372print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1373print"M diff ";1374foreachmy$opt(keys%{$state->{opt}} )1375{1376if(ref$state->{opt}{$opt}eq"ARRAY")1377{1378foreachmy$value( @{$state->{opt}{$opt}} )1379{1380print"-$opt$value";1381}1382}else{1383print"-$opt";1384print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1385}1386}1387print"$filename\n";13881389$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));13901391($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);13921393if(exists$state->{opt}{u} )1394{1395system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1396}else{1397system("diff$file1$file2>$filediff");1398}13991400while( <$fh> )1401{1402print"M$_";1403}1404close$fh;1405}14061407print"ok\n";1408}14091410sub req_log1411{1412my($cmd,$data) =@_;14131414 argsplit("log");14151416$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1417#$log->debug("log state : " . Dumper($state));14181419my($minrev,$maxrev);1420if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1421{1422my$control=$2;1423$minrev=$1;1424$maxrev=$3;1425$minrev=~s/^1\.//if(defined($minrev) );1426$maxrev=~s/^1\.//if(defined($maxrev) );1427$minrev++if(defined($minrev)and$controleq"::");1428}14291430# Grab a handle to the SQLite db and do any necessary updates1431my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1432$updater->update();14331434# if no files were specified, we need to work out what files we should be providing status on ...1435 argsfromdir($updater);14361437# foreach file specified on the commandline ...1438foreachmy$filename( @{$state->{args}} )1439{1440$filename= filecleanup($filename);14411442my$headmeta=$updater->getmeta($filename);14431444my$revisions=$updater->getlog($filename);1445my$totalrevisions=scalar(@$revisions);14461447if(defined($minrev) )1448{1449$log->debug("Removing revisions less than$minrev");1450while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1451{1452pop@$revisions;1453}1454}1455if(defined($maxrev) )1456{1457$log->debug("Removing revisions greater than$maxrev");1458while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1459{1460shift@$revisions;1461}1462}14631464next unless(scalar(@$revisions) );14651466print"M\n";1467print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1468print"M Working file:$filename\n";1469print"M head: 1.$headmeta->{revision}\n";1470print"M branch:\n";1471print"M locks: strict\n";1472print"M access list:\n";1473print"M symbolic names:\n";1474print"M keyword substitution: kv\n";1475print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1476print"M description:\n";14771478foreachmy$revision(@$revisions)1479{1480print"M ----------------------------\n";1481print"M revision 1.$revision->{revision}\n";1482# reformat the date for log output1483$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}) );1484$revision->{author} =~s/\s+.*//;1485$revision->{author} =~s/^(.{8}).*/$1/;1486print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1487my$commitmessage=$updater->commitmessage($revision->{commithash});1488$commitmessage=~s/^/M /mg;1489print$commitmessage."\n";1490}1491print"M =============================================================================\n";1492}14931494print"ok\n";1495}14961497sub req_annotate1498{1499my($cmd,$data) =@_;15001501 argsplit("annotate");15021503$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1504#$log->debug("status state : " . Dumper($state));15051506# Grab a handle to the SQLite db and do any necessary updates1507my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1508$updater->update();15091510# if no files were specified, we need to work out what files we should be providing annotate on ...1511 argsfromdir($updater);15121513# we'll need a temporary checkout dir1514my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1515my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1516$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");15171518$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1519$ENV{GIT_INDEX_FILE} =$file_index;15201521chdir$tmpdir;15221523# foreach file specified on the commandline ...1524foreachmy$filename( @{$state->{args}} )1525{1526$filename= filecleanup($filename);15271528my$meta=$updater->getmeta($filename);15291530next unless($meta->{revision} );15311532# get all the commits that this file was in1533# in dense format -- aka skip dead revisions1534my$revisions=$updater->gethistorydense($filename);1535my$lastseenin=$revisions->[0][2];15361537# populate the temporary index based on the latest commit were we saw1538# the file -- but do it cheaply without checking out any files1539# TODO: if we got a revision from the client, use that instead1540# to look up the commithash in sqlite (still good to default to1541# the current head as we do now)1542system("git-read-tree",$lastseenin);1543unless($?==0)1544{1545die"Error running git-read-tree$lastseenin$file_index$!";1546}1547$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");15481549# do a checkout of the file1550system('git-checkout-index','-f','-u',$filename);1551unless($?==0) {1552die"Error running git-checkout-index -f -u$filename:$!";1553}15541555$log->info("Annotate$filename");15561557# Prepare a file with the commits from the linearized1558# history that annotate should know about. This prevents1559# git-jsannotate telling us about commits we are hiding1560# from the client.15611562open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1563for(my$i=0;$i<@$revisions;$i++)1564{1565print ANNOTATEHINTS $revisions->[$i][2];1566if($i+1<@$revisions) {# have we got a parent?1567print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1568}1569print ANNOTATEHINTS "\n";1570}15711572print ANNOTATEHINTS "\n";1573close ANNOTATEHINTS;15741575my$annotatecmd='git-annotate';1576open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1577or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1578my$metadata= {};1579print"E Annotations for$filename\n";1580print"E ***************\n";1581while( <ANNOTATE> )1582{1583if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1584{1585my$commithash=$1;1586my$data=$2;1587unless(defined($metadata->{$commithash} ) )1588{1589$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1590$metadata->{$commithash}{author} =~s/\s+.*//;1591$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1592$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1593}1594printf("M 1.%-5d (%-8s%10s):%s\n",1595$metadata->{$commithash}{revision},1596$metadata->{$commithash}{author},1597$metadata->{$commithash}{modified},1598$data1599);1600}else{1601$log->warn("Error in annotate output! LINE:$_");1602print"E Annotate error\n";1603next;1604}1605}1606close ANNOTATE;1607}16081609# done; get out of the tempdir1610chdir"/";16111612print"ok\n";16131614}16151616# This method takes the state->{arguments} array and produces two new arrays.1617# The first is $state->{args} which is everything before the '--' argument, and1618# the second is $state->{files} which is everything after it.1619sub argsplit1620{1621return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");16221623my$type=shift;16241625$state->{args} = [];1626$state->{files} = [];1627$state->{opt} = {};16281629if(defined($type) )1630{1631my$opt= {};1632$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");1633$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1634$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");1635$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1636$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1637$opt= { k =>1, m =>1}if($typeeq"add");1638$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1639$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");164016411642while(scalar( @{$state->{arguments}} ) >0)1643{1644my$arg=shift@{$state->{arguments}};16451646next if($argeq"--");1647next unless($arg=~/\S/);16481649# if the argument looks like a switch1650if($arg=~/^-(\w)(.*)/)1651{1652# if it's a switch that takes an argument1653if($opt->{$1} )1654{1655# If this switch has already been provided1656if($opt->{$1} >1and exists($state->{opt}{$1} ) )1657{1658$state->{opt}{$1} = [$state->{opt}{$1} ];1659if(length($2) >0)1660{1661push@{$state->{opt}{$1}},$2;1662}else{1663push@{$state->{opt}{$1}},shift@{$state->{arguments}};1664}1665}else{1666# if there's extra data in the arg, use that as the argument for the switch1667if(length($2) >0)1668{1669$state->{opt}{$1} =$2;1670}else{1671$state->{opt}{$1} =shift@{$state->{arguments}};1672}1673}1674}else{1675$state->{opt}{$1} =undef;1676}1677}1678else1679{1680push@{$state->{args}},$arg;1681}1682}1683}1684else1685{1686my$mode=0;16871688foreachmy$value( @{$state->{arguments}} )1689{1690if($valueeq"--")1691{1692$mode++;1693next;1694}1695push@{$state->{args}},$valueif($mode==0);1696push@{$state->{files}},$valueif($mode==1);1697}1698}1699}17001701# This method uses $state->{directory} to populate $state->{args} with a list of filenames1702sub argsfromdir1703{1704my$updater=shift;17051706$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");17071708return if(scalar( @{$state->{args}} ) >0);17091710$log->info("No args specified, populating file list automatically");17111712$state->{args} = [];17131714foreachmy$file( @{$updater->gethead} )1715{1716next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1717next unless($file->{name} =~s/^$state->{directory}//);1718push@{$state->{args}},$file->{name};1719}1720}17211722# This method cleans up the $state variable after a command that uses arguments has run1723sub statecleanup1724{1725$state->{files} = [];1726$state->{args} = [];1727$state->{arguments} = [];1728$state->{entries} = {};1729}17301731sub revparse1732{1733my$filename=shift;17341735returnundefunless(defined($state->{entries}{$filename}{revision} ) );17361737return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1738return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);17391740returnundef;1741}17421743# This method takes a file hash and does a CVS "file transfer" which transmits the1744# size of the file, and then the file contents.1745# If a second argument $targetfile is given, the file is instead written out to1746# a file by the name of $targetfile1747sub transmitfile1748{1749my$filehash=shift;1750my$targetfile=shift;17511752if(defined($filehash)and$filehasheq"deleted")1753{1754$log->warn("filehash is 'deleted'");1755return;1756}17571758die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);17591760my$type=`git-cat-file -t$filehash`;1761 chomp$type;17621763 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );17641765 my$size= `git-cat-file -s $filehash`;1766chomp$size;17671768$log->debug("transmitfile($filehash) size=$size, type=$type");17691770if(open my$fh,'-|',"git-cat-file","blob",$filehash)1771{1772if(defined($targetfile) )1773{1774open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1775print NEWFILE $_while( <$fh> );1776close NEWFILE;1777}else{1778print"$size\n";1779printwhile( <$fh> );1780}1781close$fhor die("Couldn't close filehandle for transmitfile()");1782}else{1783die("Couldn't execute git-cat-file");1784}1785}17861787# This method takes a file name, and returns ( $dirpart, $filepart ) which1788# refers to the directory portion and the file portion of the filename1789# respectively1790sub filenamesplit1791{1792my$filename=shift;1793my$fixforlocaldir=shift;17941795my($filepart,$dirpart) = ($filename,".");1796($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1797$dirpart.="/";17981799if($fixforlocaldir)1800{1801$dirpart=~s/^$state->{prependdir}//;1802}18031804return($filepart,$dirpart);1805}18061807sub filecleanup1808{1809my$filename=shift;18101811returnundefunless(defined($filename));1812if($filename=~/^\// )1813{1814print"E absolute filenames '$filename' not supported by server\n";1815returnundef;1816}18171818$filename=~s/^\.\///g;1819$filename=$state->{directory} .$filename;1820return$filename;1821}18221823package GITCVS::log;18241825####1826#### Copyright The Open University UK - 2006.1827####1828#### Authors: Martyn Smith <martyn@catalyst.net.nz>1829#### Martin Langhoff <martin@catalyst.net.nz>1830####1831####18321833use strict;1834use warnings;18351836=head1 NAME18371838GITCVS::log18391840=head1 DESCRIPTION18411842This module provides very crude logging with a similar interface to1843Log::Log4perl18441845=head1 METHODS18461847=cut18481849=head2 new18501851Creates a new log object, optionally you can specify a filename here to1852indicate the file to log to. If no log file is specified, you can specify one1853later with method setfile, or indicate you no longer want logging with method1854nofile.18551856Until one of these methods is called, all log calls will buffer messages ready1857to write out.18581859=cut1860sub new1861{1862my$class=shift;1863my$filename=shift;18641865my$self= {};18661867bless$self,$class;18681869if(defined($filename) )1870{1871open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1872}18731874return$self;1875}18761877=head2 setfile18781879This methods takes a filename, and attempts to open that file as the log file.1880If successful, all buffered data is written out to the file, and any further1881logging is written directly to the file.18821883=cut1884sub setfile1885{1886my$self=shift;1887my$filename=shift;18881889if(defined($filename) )1890{1891open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1892}18931894return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");18951896while(my$line=shift@{$self->{buffer}} )1897{1898print{$self->{fh}}$line;1899}1900}19011902=head2 nofile19031904This method indicates no logging is going to be used. It flushes any entries in1905the internal buffer, and sets a flag to ensure no further data is put there.19061907=cut1908sub nofile1909{1910my$self=shift;19111912$self->{nolog} =1;19131914return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");19151916$self->{buffer} = [];1917}19181919=head2 _logopen19201921Internal method. Returns true if the log file is open, false otherwise.19221923=cut1924sub _logopen1925{1926my$self=shift;19271928return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1929return0;1930}19311932=head2 debug info warn fatal19331934These four methods are wrappers to _log. They provide the actual interface for1935logging data.19361937=cut1938sub debug {my$self=shift;$self->_log("debug",@_); }1939sub info {my$self=shift;$self->_log("info",@_); }1940subwarn{my$self=shift;$self->_log("warn",@_); }1941sub fatal {my$self=shift;$self->_log("fatal",@_); }19421943=head2 _log19441945This is an internal method called by the logging functions. It generates a1946timestamp and pushes the logged line either to file, or internal buffer.19471948=cut1949sub _log1950{1951my$self=shift;1952my$level=shift;19531954return if($self->{nolog} );19551956my@time=localtime;1957my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1958$time[5] +1900,1959$time[4] +1,1960$time[3],1961$time[2],1962$time[1],1963$time[0],1964uc$level,1965);19661967if($self->_logopen)1968{1969print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1970}else{1971push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1972}1973}19741975=head2 DESTROY19761977This method simply closes the file handle if one is open19781979=cut1980sub DESTROY1981{1982my$self=shift;19831984if($self->_logopen)1985{1986close$self->{fh};1987}1988}19891990package GITCVS::updater;19911992####1993#### Copyright The Open University UK - 2006.1994####1995#### Authors: Martyn Smith <martyn@catalyst.net.nz>1996#### Martin Langhoff <martin@catalyst.net.nz>1997####1998####19992000use strict;2001use warnings;2002use DBI;20032004=head1 METHODS20052006=cut20072008=head2 new20092010=cut2011sub new2012{2013my$class=shift;2014my$config=shift;2015my$module=shift;2016my$log=shift;20172018die"Need to specify a git repository"unless(defined($config)and-d $config);2019die"Need to specify a module"unless(defined($module) );20202021$class=ref($class) ||$class;20222023my$self= {};20242025bless$self,$class;20262027$self->{dbdir} =$config."/";2028die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );20292030$self->{module} =$module;2031$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";20322033$self->{git_path} =$config."/";20342035$self->{log} =$log;20362037die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );20382039$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");20402041$self->{tables} = {};2042foreachmy$table($self->{dbh}->tables)2043{2044$table=~s/^"//;2045$table=~s/"$//;2046$self->{tables}{$table} =1;2047}20482049# Construct the revision table if required2050unless($self->{tables}{revision} )2051{2052$self->{dbh}->do("2053 CREATE TABLE revision (2054 name TEXT NOT NULL,2055 revision INTEGER NOT NULL,2056 filehash TEXT NOT NULL,2057 commithash TEXT NOT NULL,2058 author TEXT NOT NULL,2059 modified TEXT NOT NULL,2060 mode TEXT NOT NULL2061 )2062 ");2063}20642065# Construct the revision table if required2066unless($self->{tables}{head} )2067{2068$self->{dbh}->do("2069 CREATE TABLE head (2070 name TEXT NOT NULL,2071 revision INTEGER NOT NULL,2072 filehash TEXT NOT NULL,2073 commithash TEXT NOT NULL,2074 author TEXT NOT NULL,2075 modified TEXT NOT NULL,2076 mode TEXT NOT NULL2077 )2078 ");2079}20802081# Construct the properties table if required2082unless($self->{tables}{properties} )2083{2084$self->{dbh}->do("2085 CREATE TABLE properties (2086 key TEXT NOT NULL PRIMARY KEY,2087 value TEXT2088 )2089 ");2090}20912092# Construct the commitmsgs table if required2093unless($self->{tables}{commitmsgs} )2094{2095$self->{dbh}->do("2096 CREATE TABLE commitmsgs (2097 key TEXT NOT NULL PRIMARY KEY,2098 value TEXT2099 )2100 ");2101}21022103return$self;2104}21052106=head2 update21072108=cut2109sub update2110{2111my$self=shift;21122113# first lets get the commit list2114$ENV{GIT_DIR} =$self->{git_path};21152116# prepare database queries2117my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2118my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2119my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2120my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);21212122my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;2123unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2124{2125die("Invalid module '$self->{module}'");2126}212721282129my$git_log;2130my$lastcommit=$self->_get_prop("last_commit");21312132# Start exclusive lock here...2133$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";21342135# TODO: log processing is memory bound2136# if we can parse into a 2nd file that is in reverse order2137# we can probably do something really efficient2138my@git_log_params= ('--pretty','--parents','--topo-order');21392140if(defined$lastcommit) {2141push@git_log_params,"$lastcommit..$self->{module}";2142}else{2143push@git_log_params,$self->{module};2144}2145# git-rev-list is the backend / plumbing version of git-log2146open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";21472148my@commits;21492150my%commit= ();21512152while( <GITLOG> )2153{2154chomp;2155if(m/^commit\s+(.*)$/) {2156# on ^commit lines put the just seen commit in the stack2157# and prime things for the next one2158if(keys%commit) {2159my%copy=%commit;2160unshift@commits, \%copy;2161%commit= ();2162}2163my@parents=split(m/\s+/,$1);2164$commit{hash} =shift@parents;2165$commit{parents} = \@parents;2166}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2167# on rfc822-like lines seen before we see any message,2168# lowercase the entry and put it in the hash as key-value2169$commit{lc($1)} =$2;2170}else{2171# message lines - skip initial empty line2172# and trim whitespace2173if(!exists($commit{message}) &&m/^\s*$/) {2174# define it to mark the end of headers2175$commit{message} ='';2176next;2177}2178s/^\s+//;s/\s+$//;# trim ws2179$commit{message} .=$_."\n";2180}2181}2182close GITLOG;21832184unshift@commits, \%commitif(keys%commit);21852186# Now all the commits are in the @commits bucket2187# ordered by time DESC. for each commit that needs processing,2188# determine whether it's following the last head we've seen or if2189# it's on its own branch, grab a file list, and add whatever's changed2190# NOTE: $lastcommit refers to the last commit from previous run2191# $lastpicked is the last commit we picked in this run2192my$lastpicked;2193my$head= {};2194if(defined$lastcommit) {2195$lastpicked=$lastcommit;2196}21972198my$committotal=scalar(@commits);2199my$commitcount=0;22002201# Load the head table into $head (for cached lookups during the update process)2202foreachmy$file( @{$self->gethead()} )2203{2204$head->{$file->{name}} =$file;2205}22062207foreachmy$commit(@commits)2208{2209$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2210if(defined$lastpicked)2211{2212if(!in_array($lastpicked, @{$commit->{parents}}))2213{2214# skip, we'll see this delta2215# as part of a merge later2216# warn "skipping off-track $commit->{hash}\n";2217next;2218}elsif(@{$commit->{parents}} >1) {2219# it is a merge commit, for each parent that is2220# not $lastpicked, see if we can get a log2221# from the merge-base to that parent to put it2222# in the message as a merge summary.2223my@parents= @{$commit->{parents}};2224foreachmy$parent(@parents) {2225# git-merge-base can potentially (but rarely) throw2226# several candidate merge bases. let's assume2227# that the first one is the best one.2228if($parenteq$lastpicked) {2229next;2230}2231open my$p,'git-merge-base '.$lastpicked.' '2232.$parent.'|';2233my@output= (<$p>);2234close$p;2235my$base=join('',@output);2236chomp$base;2237if($base) {2238my@merged;2239# print "want to log between $base $parent \n";2240open(GITLOG,'-|','git-log',"$base..$parent")2241or die"Cannot call git-log:$!";2242my$mergedhash;2243while(<GITLOG>) {2244chomp;2245if(!defined$mergedhash) {2246if(m/^commit\s+(.+)$/) {2247$mergedhash=$1;2248}else{2249next;2250}2251}else{2252# grab the first line that looks non-rfc8222253# aka has content after leading space2254if(m/^\s+(\S.*)$/) {2255my$title=$1;2256$title=substr($title,0,100);# truncate2257unshift@merged,"$mergedhash$title";2258undef$mergedhash;2259}2260}2261}2262close GITLOG;2263if(@merged) {2264$commit->{mergemsg} =$commit->{message};2265$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2266foreachmy$summary(@merged) {2267$commit->{mergemsg} .="\t$summary\n";2268}2269$commit->{mergemsg} .="\n\n";2270# print "Message for $commit->{hash} \n$commit->{mergemsg}";2271}2272}2273}2274}2275}22762277# convert the date to CVS-happy format2278$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);22792280if(defined($lastpicked) )2281{2282my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2283while( <FILELIST> )2284{2285unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2286{2287die("Couldn't process git-diff-tree line :$_");2288}22892290# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");22912292my$git_perms="";2293$git_perms.="r"if($1&4);2294$git_perms.="w"if($1&2);2295$git_perms.="x"if($1&1);2296$git_perms="rw"if($git_permseq"");22972298if($3eq"D")2299{2300#$log->debug("DELETE $4");2301$head->{$4} = {2302 name =>$4,2303 revision =>$head->{$4}{revision} +1,2304 filehash =>"deleted",2305 commithash =>$commit->{hash},2306 modified =>$commit->{date},2307 author =>$commit->{author},2308 mode =>$git_perms,2309};2310$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2311}2312elsif($3eq"M")2313{2314#$log->debug("MODIFIED $4");2315$head->{$4} = {2316 name =>$4,2317 revision =>$head->{$4}{revision} +1,2318 filehash =>$2,2319 commithash =>$commit->{hash},2320 modified =>$commit->{date},2321 author =>$commit->{author},2322 mode =>$git_perms,2323};2324$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2325}2326elsif($3eq"A")2327{2328#$log->debug("ADDED $4");2329$head->{$4} = {2330 name =>$4,2331 revision =>1,2332 filehash =>$2,2333 commithash =>$commit->{hash},2334 modified =>$commit->{date},2335 author =>$commit->{author},2336 mode =>$git_perms,2337};2338$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2339}2340else2341{2342$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2343die;2344}2345}2346close FILELIST;2347}else{2348# this is used to detect files removed from the repo2349my$seen_files= {};23502351my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2352while( <FILELIST> )2353{2354unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2355{2356die("Couldn't process git-ls-tree line :$_");2357}23582359my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);23602361$seen_files->{$git_filename} =1;23622363my($oldhash,$oldrevision,$oldmode) = (2364$head->{$git_filename}{filehash},2365$head->{$git_filename}{revision},2366$head->{$git_filename}{mode}2367);23682369if($git_perms=~/^\d\d\d(\d)\d\d/o)2370{2371$git_perms="";2372$git_perms.="r"if($1&4);2373$git_perms.="w"if($1&2);2374$git_perms.="x"if($1&1);2375}else{2376$git_perms="rw";2377}23782379# unless the file exists with the same hash, we need to update it ...2380unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2381{2382my$newrevision= ($oldrevisionor0) +1;23832384$head->{$git_filename} = {2385 name =>$git_filename,2386 revision =>$newrevision,2387 filehash =>$git_hash,2388 commithash =>$commit->{hash},2389 modified =>$commit->{date},2390 author =>$commit->{author},2391 mode =>$git_perms,2392};239323942395$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2396}2397}2398close FILELIST;23992400# Detect deleted files2401foreachmy$file(keys%$head)2402{2403unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2404{2405$head->{$file}{revision}++;2406$head->{$file}{filehash} ="deleted";2407$head->{$file}{commithash} =$commit->{hash};2408$head->{$file}{modified} =$commit->{date};2409$head->{$file}{author} =$commit->{author};24102411$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2412}2413}2414# END : "Detect deleted files"2415}241624172418if(exists$commit->{mergemsg})2419{2420$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2421}24222423$lastpicked=$commit->{hash};24242425$self->_set_prop("last_commit",$commit->{hash});2426}24272428$db_delete_head->execute();2429foreachmy$file(keys%$head)2430{2431$db_insert_head->execute(2432$file,2433$head->{$file}{revision},2434$head->{$file}{filehash},2435$head->{$file}{commithash},2436$head->{$file}{modified},2437$head->{$file}{author},2438$head->{$file}{mode},2439);2440}2441# invalidate the gethead cache2442$self->{gethead_cache} =undef;244324442445# Ending exclusive lock here2446$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2447}24482449sub _headrev2450{2451my$self=shift;2452my$filename=shift;24532454my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2455$db_query->execute($filename);2456my($hash,$revision,$mode) =$db_query->fetchrow_array;24572458return($hash,$revision,$mode);2459}24602461sub _get_prop2462{2463my$self=shift;2464my$key=shift;24652466my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2467$db_query->execute($key);2468my($value) =$db_query->fetchrow_array;24692470return$value;2471}24722473sub _set_prop2474{2475my$self=shift;2476my$key=shift;2477my$value=shift;24782479my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2480$db_query->execute($value,$key);24812482unless($db_query->rows)2483{2484$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2485$db_query->execute($key,$value);2486}24872488return$value;2489}24902491=head2 gethead24922493=cut24942495sub gethead2496{2497my$self=shift;24982499return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );25002501my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2502$db_query->execute();25032504my$tree= [];2505while(my$file=$db_query->fetchrow_hashref)2506{2507push@$tree,$file;2508}25092510$self->{gethead_cache} =$tree;25112512return$tree;2513}25142515=head2 getlog25162517=cut25182519sub getlog2520{2521my$self=shift;2522my$filename=shift;25232524my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2525$db_query->execute($filename);25262527my$tree= [];2528while(my$file=$db_query->fetchrow_hashref)2529{2530push@$tree,$file;2531}25322533return$tree;2534}25352536=head2 getmeta25372538This function takes a filename (with path) argument and returns a hashref of2539metadata for that file.25402541=cut25422543sub getmeta2544{2545my$self=shift;2546my$filename=shift;2547my$revision=shift;25482549my$db_query;2550if(defined($revision)and$revision=~/^\d+$/)2551{2552$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2553$db_query->execute($filename,$revision);2554}2555elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2556{2557$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2558$db_query->execute($filename,$revision);2559}else{2560$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2561$db_query->execute($filename);2562}25632564return$db_query->fetchrow_hashref;2565}25662567=head2 commitmessage25682569this function takes a commithash and returns the commit message for that commit25702571=cut2572sub commitmessage2573{2574my$self=shift;2575my$commithash=shift;25762577die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);25782579my$db_query;2580$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2581$db_query->execute($commithash);25822583my($message) =$db_query->fetchrow_array;25842585if(defined($message) )2586{2587$message.=" "if($message=~/\n$/);2588return$message;2589}25902591my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2592shift@lineswhile($lines[0] =~/\S/);2593$message=join("",@lines);2594$message.=" "if($message=~/\n$/);2595return$message;2596}25972598=head2 gethistory25992600This function takes a filename (with path) argument and returns an arrayofarrays2601containing revision,filehash,commithash ordered by revision descending26022603=cut2604sub gethistory2605{2606my$self=shift;2607my$filename=shift;26082609my$db_query;2610$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2611$db_query->execute($filename);26122613return$db_query->fetchall_arrayref;2614}26152616=head2 gethistorydense26172618This function takes a filename (with path) argument and returns an arrayofarrays2619containing revision,filehash,commithash ordered by revision descending.26202621This version of gethistory skips deleted entries -- so it is useful for annotate.2622The 'dense' part is a reference to a '--dense' option available for git-rev-list2623and other git tools that depend on it.26242625=cut2626sub gethistorydense2627{2628my$self=shift;2629my$filename=shift;26302631my$db_query;2632$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2633$db_query->execute($filename);26342635return$db_query->fetchall_arrayref;2636}26372638=head2 in_array()26392640from Array::PAT - mimics the in_array() function2641found in PHP. Yuck but works for small arrays.26422643=cut2644sub in_array2645{2646my($check,@array) =@_;2647my$retval=0;2648foreachmy$test(@array){2649if($checkeq$test){2650$retval=1;2651}2652}2653return$retval;2654}26552656=head2 safe_pipe_capture26572658an alternative to `command` that allows input to be passed as an array2659to work around shell problems with weird characters in arguments26602661=cut2662sub safe_pipe_capture {26632664my@output;26652666if(my$pid=open my$child,'-|') {2667@output= (<$child>);2668close$childor die join(' ',@_).":$!$?";2669}else{2670exec(@_)or die"$!$?";# exec() can fail the executable can't be found2671}2672returnwantarray?@output:join('',@output);2673}2674267526761;