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# Keep going until the client closes the connection 91while(<STDIN>) 92{ 93chomp; 94 95# Check to see if we've seen this method, and call appropiate function. 96if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 97{ 98# use the $methods hash to call the appropriate sub for this command 99#$log->info("Method : $1"); 100&{$methods->{$1}}($1,$2); 101}else{ 102# log fatal because we don't understand this function. If this happens 103# we're fairly screwed because we don't know if the client is expecting 104# a response. If it is, the client will hang, we'll hang, and the whole 105# thing will be custard. 106$log->fatal("Don't understand command$_\n"); 107die("Unknown command$_"); 108} 109} 110 111$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 112$log->info("--------------- FINISH -----------------"); 113 114# Magic catchall method. 115# This is the method that will handle all commands we haven't yet 116# implemented. It simply sends a warning to the log file indicating a 117# command that hasn't been implemented has been invoked. 118sub req_CATCHALL 119{ 120my($cmd,$data) =@_; 121$log->warn("Unhandled command : req_$cmd:$data"); 122} 123 124 125# Root pathname \n 126# Response expected: no. Tell the server which CVSROOT to use. Note that 127# pathname is a local directory and not a fully qualified CVSROOT variable. 128# pathname must already exist; if creating a new root, use the init 129# request, not Root. pathname does not include the hostname of the server, 130# how to access the server, etc.; by the time the CVS protocol is in use, 131# connection, authentication, etc., are already taken care of. The Root 132# request must be sent only once, and it must be sent before any requests 133# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 134sub req_Root 135{ 136my($cmd,$data) =@_; 137$log->debug("req_Root :$data"); 138 139$state->{CVSROOT} =$data; 140 141$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 142 143foreachmy$line(`git-var -l`) 144{ 145next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 146$cfg->{$1}{$2} =$3; 147} 148 149unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 150{ 151print"E GITCVS emulation needs to be enabled on this repo\n"; 152print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 153print"E\n"; 154print"error 1 GITCVS emulation disabled\n"; 155} 156 157if(defined($cfg->{gitcvs}{logfile} ) ) 158{ 159$log->setfile($cfg->{gitcvs}{logfile}); 160}else{ 161$log->nofile(); 162} 163} 164 165# Global_option option \n 166# Response expected: no. Transmit one of the global options `-q', `-Q', 167# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 168# variations (such as combining of options) are allowed. For graceful 169# handling of valid-requests, it is probably better to make new global 170# options separate requests, rather than trying to add them to this 171# request. 172sub req_Globaloption 173{ 174my($cmd,$data) =@_; 175$log->debug("req_Globaloption :$data"); 176 177# TODO : is this data useful ??? 178} 179 180# Valid-responses request-list \n 181# Response expected: no. Tell the server what responses the client will 182# accept. request-list is a space separated list of tokens. 183sub req_Validresponses 184{ 185my($cmd,$data) =@_; 186$log->debug("req_Validrepsonses :$data"); 187 188# TODO : re-enable this, currently it's not particularly useful 189#$state->{validresponses} = [ split /\s+/, $data ]; 190} 191 192# valid-requests \n 193# Response expected: yes. Ask the server to send back a Valid-requests 194# response. 195sub req_validrequests 196{ 197my($cmd,$data) =@_; 198 199$log->debug("req_validrequests"); 200 201$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 202$log->debug("SEND : ok"); 203 204print"Valid-requests ".join(" ",keys%$methods) ."\n"; 205print"ok\n"; 206} 207 208# Directory local-directory \n 209# Additional data: repository \n. Response expected: no. Tell the server 210# what directory to use. The repository should be a directory name from a 211# previous server response. Note that this both gives a default for Entry 212# and Modified and also for ci and the other commands; normal usage is to 213# send Directory for each directory in which there will be an Entry or 214# Modified, and then a final Directory for the original directory, then the 215# command. The local-directory is relative to the top level at which the 216# command is occurring (i.e. the last Directory which is sent before the 217# command); to indicate that top level, `.' should be sent for 218# local-directory. 219sub req_Directory 220{ 221my($cmd,$data) =@_; 222 223my$repository= <STDIN>; 224chomp$repository; 225 226 227$state->{localdir} =$data; 228$state->{repository} =$repository; 229$state->{directory} =$repository; 230$state->{directory} =~s/^$state->{CVSROOT}\///; 231$state->{module} =$1if($state->{directory} =~s/^(.*?)(\/|$)//); 232$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 233 234$log->debug("req_Directory : localdir=$datarepository=$repositorydirectory=$state->{directory} module=$state->{module}"); 235} 236 237# Entry entry-line \n 238# Response expected: no. Tell the server what version of a file is on the 239# local machine. The name in entry-line is a name relative to the directory 240# most recently specified with Directory. If the user is operating on only 241# some files in a directory, Entry requests for only those files need be 242# included. If an Entry request is sent without Modified, Is-modified, or 243# Unchanged, it means the file is lost (does not exist in the working 244# directory). If both Entry and one of Modified, Is-modified, or Unchanged 245# are sent for the same file, Entry must be sent first. For a given file, 246# one can send Modified, Is-modified, or Unchanged, but not more than one 247# of these three. 248sub req_Entry 249{ 250my($cmd,$data) =@_; 251 252$log->debug("req_Entry :$data"); 253 254my@data=split(/\//,$data); 255 256$state->{entries}{$state->{directory}.$data[1]} = { 257 revision =>$data[2], 258 conflict =>$data[3], 259 options =>$data[4], 260 tag_or_date =>$data[5], 261}; 262} 263 264# add \n 265# Response expected: yes. Add a file or directory. This uses any previous 266# Argument, Directory, Entry, or Modified requests, if they have been sent. 267# The last Directory sent specifies the working directory at the time of 268# the operation. To add a directory, send the directory to be added using 269# Directory and Argument requests. 270sub req_add 271{ 272my($cmd,$data) =@_; 273 274 argsplit("add"); 275 276my$addcount=0; 277 278foreachmy$filename( @{$state->{args}} ) 279{ 280$filename= filecleanup($filename); 281 282unless(defined($state->{entries}{$filename}{modified_filename} ) ) 283{ 284print"E cvs add: nothing known about `$filename'\n"; 285next; 286} 287# TODO : check we're not squashing an already existing file 288if(defined($state->{entries}{$filename}{revision} ) ) 289{ 290print"E cvs add: `$filename' has already been entered\n"; 291next; 292} 293 294 295my($filepart,$dirpart) = filenamesplit($filename); 296 297print"E cvs add: scheduling file `$filename' for addition\n"; 298 299print"Checked-in$dirpart\n"; 300print"$filename\n"; 301print"/$filepart/0///\n"; 302 303$addcount++; 304} 305 306if($addcount==1) 307{ 308print"E cvs add: use `cvs commit' to add this file permanently\n"; 309} 310elsif($addcount>1) 311{ 312print"E cvs add: use `cvs commit' to add these files permanently\n"; 313} 314 315print"ok\n"; 316} 317 318# remove \n 319# Response expected: yes. Remove a file. This uses any previous Argument, 320# Directory, Entry, or Modified requests, if they have been sent. The last 321# Directory sent specifies the working directory at the time of the 322# operation. Note that this request does not actually do anything to the 323# repository; the only effect of a successful remove request is to supply 324# the client with a new entries line containing `-' to indicate a removed 325# file. In fact, the client probably could perform this operation without 326# contacting the server, although using remove may cause the server to 327# perform a few more checks. The client sends a subsequent ci request to 328# actually record the removal in the repository. 329sub req_remove 330{ 331my($cmd,$data) =@_; 332 333 argsplit("remove"); 334 335# Grab a handle to the SQLite db and do any necessary updates 336my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 337$updater->update(); 338 339#$log->debug("add state : " . Dumper($state)); 340 341my$rmcount=0; 342 343foreachmy$filename( @{$state->{args}} ) 344{ 345$filename= filecleanup($filename); 346 347if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 348{ 349print"E cvs remove: file `$filename' still in working directory\n"; 350next; 351} 352 353my$meta=$updater->getmeta($filename); 354my$wrev= revparse($filename); 355 356unless(defined($wrev) ) 357{ 358print"E cvs remove: nothing known about `$filename'\n"; 359next; 360} 361 362if(defined($wrev)and$wrev<0) 363{ 364print"E cvs remove: file `$filename' already scheduled for removal\n"; 365next; 366} 367 368unless($wrev==$meta->{revision} ) 369{ 370# TODO : not sure if the format of this message is quite correct. 371print"E cvs remove: Up to date check failed for `$filename'\n"; 372next; 373} 374 375 376my($filepart,$dirpart) = filenamesplit($filename); 377 378print"E cvs remove: scheduling `$filename' for removal\n"; 379 380print"Checked-in$dirpart\n"; 381print"$filename\n"; 382print"/$filepart/-1.$wrev///\n"; 383 384$rmcount++; 385} 386 387if($rmcount==1) 388{ 389print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 390} 391elsif($rmcount>1) 392{ 393print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 394} 395 396print"ok\n"; 397} 398 399# Modified filename \n 400# Response expected: no. Additional data: mode, \n, file transmission. Send 401# the server a copy of one locally modified file. filename is a file within 402# the most recent directory sent with Directory; it must not contain `/'. 403# If the user is operating on only some files in a directory, only those 404# files need to be included. This can also be sent without Entry, if there 405# is no entry for the file. 406sub req_Modified 407{ 408my($cmd,$data) =@_; 409 410my$mode= <STDIN>; 411chomp$mode; 412my$size= <STDIN>; 413chomp$size; 414 415# Grab config information 416my$blocksize=8192; 417my$bytesleft=$size; 418my$tmp; 419 420# Get a filehandle/name to write it to 421my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 422 423# Loop over file data writing out to temporary file. 424while($bytesleft) 425{ 426$blocksize=$bytesleftif($bytesleft<$blocksize); 427read STDIN,$tmp,$blocksize; 428print$fh $tmp; 429$bytesleft-=$blocksize; 430} 431 432close$fh; 433 434# Ensure we have something sensible for the file mode 435if($mode=~/u=(\w+)/) 436{ 437$mode=$1; 438}else{ 439$mode="rw"; 440} 441 442# Save the file data in $state 443$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 444$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 445$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 446$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 447 448 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 449} 450 451# Unchanged filename\n 452# Response expected: no. Tell the server that filename has not been 453# modified in the checked out directory. The filename is a file within the 454# most recent directory sent with Directory; it must not contain `/'. 455sub req_Unchanged 456{ 457 my ($cmd,$data) =@_; 458 459$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 460 461 #$log->debug("req_Unchanged :$data"); 462} 463 464# Questionable filename\n 465# Response expected: no. Additional data: no. 466# Tell the server to check whether filename should be ignored, 467# and if not, next time the server sends responses, send (in 468# a M response) `?' followed by the directory and filename. 469# filename must not contain `/'; it needs to be a file in the 470# directory named by the most recent Directory request. 471sub req_Questionable 472{ 473my($cmd,$data) =@_; 474 475$state->{entries}{$state->{directory}.$data}{questionable} =1; 476 477#$log->debug("req_Questionable : $data"); 478} 479 480# Argument text \n 481# Response expected: no. Save argument for use in a subsequent command. 482# Arguments accumulate until an argument-using command is given, at which 483# point they are forgotten. 484# Argumentx text \n 485# Response expected: no. Append \n followed by text to the current argument 486# being saved. 487sub req_Argument 488{ 489my($cmd,$data) =@_; 490 491# TODO : Not quite sure how Argument and Argumentx differ, but I assume 492# it's for multi-line arguments ... somehow ... 493 494$log->debug("$cmd:$data"); 495 496push@{$state->{arguments}},$data; 497} 498 499# expand-modules \n 500# Response expected: yes. Expand the modules which are specified in the 501# arguments. Returns the data in Module-expansion responses. Note that the 502# server can assume that this is checkout or export, not rtag or rdiff; the 503# latter do not access the working directory and thus have no need to 504# expand modules on the client side. Expand may not be the best word for 505# what this request does. It does not necessarily tell you all the files 506# contained in a module, for example. Basically it is a way of telling you 507# which working directories the server needs to know about in order to 508# handle a checkout of the specified modules. For example, suppose that the 509# server has a module defined by 510# aliasmodule -a 1dir 511# That is, one can check out aliasmodule and it will take 1dir in the 512# repository and check it out to 1dir in the working directory. Now suppose 513# the client already has this module checked out and is planning on using 514# the co request to update it. Without using expand-modules, the client 515# would have two bad choices: it could either send information about all 516# working directories under the current directory, which could be 517# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 518# stands for 1dir, and neglect to send information for 1dir, which would 519# lead to incorrect operation. With expand-modules, the client would first 520# ask for the module to be expanded: 521sub req_expandmodules 522{ 523my($cmd,$data) =@_; 524 525 argsplit(); 526 527$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 528 529unless(ref$state->{arguments}eq"ARRAY") 530{ 531print"ok\n"; 532return; 533} 534 535foreachmy$module( @{$state->{arguments}} ) 536{ 537$log->debug("SEND : Module-expansion$module"); 538print"Module-expansion$module\n"; 539} 540 541print"ok\n"; 542 statecleanup(); 543} 544 545# co \n 546# Response expected: yes. Get files from the repository. This uses any 547# previous Argument, Directory, Entry, or Modified requests, if they have 548# been sent. Arguments to this command are module names; the client cannot 549# know what directories they correspond to except by (1) just sending the 550# co request, and then seeing what directory names the server sends back in 551# its responses, and (2) the expand-modules request. 552sub req_co 553{ 554my($cmd,$data) =@_; 555 556 argsplit("co"); 557 558my$module=$state->{args}[0]; 559my$checkout_path=$module; 560 561# use the user specified directory if we're given it 562$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 563 564$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 565 566$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 567 568$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 569 570# Grab a handle to the SQLite db and do any necessary updates 571my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 572$updater->update(); 573 574$checkout_path=~ s|/$||;# get rid of trailing slashes 575 576# Eclipse seems to need the Clear-sticky command 577# to prepare the 'Entries' file for the new directory. 578print"Clear-sticky$checkout_path/\n"; 579print$state->{CVSROOT} ."/$checkout_path/\n"; 580print"Clear-static-directory$checkout_path/\n"; 581print$state->{CVSROOT} ."/$checkout_path/\n"; 582 583# instruct the client that we're checking out to $checkout_path 584print"E cvs checkout: Updating$checkout_path\n"; 585 586my%seendirs= (); 587 588foreachmy$git( @{$updater->gethead} ) 589{ 590# Don't want to check out deleted files 591next if($git->{filehash}eq"deleted"); 592 593($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 594 595# modification time of this file 596print"Mod-time$git->{modified}\n"; 597 598# print some information to the client 599if(defined($git->{dir} )and$git->{dir}ne"./") 600{ 601print"M U$checkout_path/$git->{dir}$git->{name}\n"; 602}else{ 603print"M U$checkout_path/$git->{name}\n"; 604} 605 606if(length($git->{dir}) &&$git->{dir}ne'./'&& !exists($seendirs{$git->{dir}})) { 607 608# Eclipse seems to need the Clear-sticky command 609# to prepare the 'Entries' file for the new directory. 610print"Clear-sticky$module/$git->{dir}\n"; 611print$state->{CVSROOT} ."/$module/$git->{dir}\n"; 612print"Clear-static-directory$module/$git->{dir}\n"; 613print$state->{CVSROOT} ."/$module/$git->{dir}\n"; 614print"E cvs checkout: Updating /$module/$git->{dir}\n"; 615$seendirs{$git->{dir}} =1; 616} 617 618# instruct client we're sending a file to put in this path 619print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 620 621print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 622 623# this is an "entries" line 624print"/$git->{name}/1.$git->{revision}///\n"; 625# permissions 626print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 627 628# transmit file 629 transmitfile($git->{filehash}); 630} 631 632print"ok\n"; 633 634 statecleanup(); 635} 636 637# update \n 638# Response expected: yes. Actually do a cvs update command. This uses any 639# previous Argument, Directory, Entry, or Modified requests, if they have 640# been sent. The last Directory sent specifies the working directory at the 641# time of the operation. The -I option is not used--files which the client 642# can decide whether to ignore are not mentioned and the client sends the 643# Questionable request for others. 644sub req_update 645{ 646my($cmd,$data) =@_; 647 648$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 649 650 argsplit("update"); 651 652# 653# It may just be a client exploring the available heads/modukles 654# in that case, list them as top level directories and leave it 655# at that. Eclipse uses this technique to offer you a list of 656# projects (heads in this case) to checkout. 657# 658if($state->{module}eq'') { 659print"E cvs update: Updating .\n"; 660opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 661while(my$head=readdir(HEADS)) { 662if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 663print"E cvs update: New directory `$head'\n"; 664} 665} 666closedir HEADS; 667print"ok\n"; 668return1; 669} 670 671 672# Grab a handle to the SQLite db and do any necessary updates 673my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 674 675$updater->update(); 676 677# if no files were specified, we need to work out what files we should be providing status on ... 678 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 679 680#$log->debug("update state : " . Dumper($state)); 681 682# foreach file specified on the commandline ... 683foreachmy$filename( @{$state->{args}} ) 684{ 685$filename= filecleanup($filename); 686 687# if we have a -C we should pretend we never saw modified stuff 688if(exists($state->{opt}{C} ) ) 689{ 690delete$state->{entries}{$filename}{modified_hash}; 691delete$state->{entries}{$filename}{modified_filename}; 692$state->{entries}{$filename}{unchanged} =1; 693} 694 695my$meta; 696if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 697{ 698$meta=$updater->getmeta($filename,$1); 699}else{ 700$meta=$updater->getmeta($filename); 701} 702 703next unless($meta->{revision} ); 704 705my$oldmeta=$meta; 706 707my$wrev= revparse($filename); 708 709# If the working copy is an old revision, lets get that version too for comparison. 710if(defined($wrev)and$wrev!=$meta->{revision} ) 711{ 712$oldmeta=$updater->getmeta($filename,$wrev); 713} 714 715#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 716 717# Files are up to date if the working copy and repo copy have the same revision, 718# and the working copy is unmodified _and_ the user hasn't specified -C 719next if(defined($wrev) 720and defined($meta->{revision}) 721and$wrev==$meta->{revision} 722and$state->{entries}{$filename}{unchanged} 723and not exists($state->{opt}{C} ) ); 724 725# If the working copy and repo copy have the same revision, 726# but the working copy is modified, tell the client it's modified 727if(defined($wrev) 728and defined($meta->{revision}) 729and$wrev==$meta->{revision} 730and not exists($state->{opt}{C} ) ) 731{ 732$log->info("Tell the client the file is modified"); 733print"MT text U\n"; 734print"MT fname$filename\n"; 735print"MT newline\n"; 736next; 737} 738 739if($meta->{filehash}eq"deleted") 740{ 741my($filepart,$dirpart) = filenamesplit($filename); 742 743$log->info("Removing '$filename' from working copy (no longer in the repo)"); 744 745print"E cvs update: `$filename' is no longer in the repository\n"; 746print"Removed$dirpart\n"; 747print"$filepart\n"; 748} 749elsif(not defined($state->{entries}{$filename}{modified_hash} ) 750or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 751{ 752$log->info("Updating '$filename'"); 753# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 754print"MT +updated\n"; 755print"MT text U\n"; 756print"MT fname$filename\n"; 757print"MT newline\n"; 758print"MT -updated\n"; 759 760my($filepart,$dirpart) = filenamesplit($filename); 761$dirpart=~s/^$state->{directory}//; 762 763if(defined($wrev) ) 764{ 765# instruct client we're sending a file to put in this path as a replacement 766print"Update-existing$dirpart\n"; 767$log->debug("Updating existing file 'Update-existing$dirpart'"); 768}else{ 769# instruct client we're sending a file to put in this path as a new file 770print"Created$dirpart\n"; 771$log->debug("Creating new file 'Created$dirpart'"); 772} 773print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 774 775# this is an "entries" line 776$log->debug("/$filepart/1.$meta->{revision}///"); 777print"/$filepart/1.$meta->{revision}///\n"; 778 779# permissions 780$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 781print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 782 783# transmit file 784 transmitfile($meta->{filehash}); 785}else{ 786$log->info("Updating '$filename'"); 787my($filepart,$dirpart) = filenamesplit($meta->{name}); 788 789my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 790 791chdir$dir; 792my$file_local=$filepart.".mine"; 793system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 794my$file_old=$filepart.".".$oldmeta->{revision}; 795 transmitfile($oldmeta->{filehash},$file_old); 796my$file_new=$filepart.".".$meta->{revision}; 797 transmitfile($meta->{filehash},$file_new); 798 799# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 800$log->info("Merging$file_local,$file_old,$file_new"); 801 802$log->debug("Temporary directory for merge is$dir"); 803 804my$return=system("merge",$file_local,$file_old,$file_new); 805$return>>=8; 806 807if($return==0) 808{ 809$log->info("Merged successfully"); 810print"M M$filename\n"; 811$log->debug("Update-existing$dirpart"); 812print"Update-existing$dirpart\n"; 813$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 814print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 815$log->debug("/$filepart/1.$meta->{revision}///"); 816print"/$filepart/1.$meta->{revision}///\n"; 817} 818elsif($return==1) 819{ 820$log->info("Merged with conflicts"); 821print"M C$filename\n"; 822print"Update-existing$dirpart\n"; 823print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 824print"/$filepart/1.$meta->{revision}/+//\n"; 825} 826else 827{ 828$log->warn("Merge failed"); 829next; 830} 831 832# permissions 833$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 834print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 835 836# transmit file, format is single integer on a line by itself (file 837# size) followed by the file contents 838# TODO : we should copy files in blocks 839my$data=`cat$file_local`; 840$log->debug("File size : " . length($data)); 841 print length($data) . "\n"; 842 print$data; 843 844 chdir "/"; 845 } 846 847 } 848 849 print "ok\n"; 850} 851 852sub req_ci 853{ 854 my ($cmd,$data) =@_; 855 856 argsplit("ci"); 857 858 #$log->debug("State : " . Dumper($state)); 859 860$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 861 862 if ( -e$state->{CVSROOT} . "/index" ) 863 { 864 print "error 1 Index already exists in git repo\n"; 865 exit; 866 } 867 868 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 869 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 870 { 871 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 872 exit; 873 } 874 875 # Grab a handle to the SQLite db and do any necessary updates 876 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 877$updater->update(); 878 879 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 880 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 881$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 882 883$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 884$ENV{GIT_INDEX_FILE} =$file_index; 885 886 chdir$tmpdir; 887 888 # populate the temporary index based 889 system("git-read-tree",$state->{module}); 890 unless ($?== 0) 891 { 892 die "Error running git-read-tree$state->{module}$file_index$!"; 893 } 894$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 895 896 897 my@committedfiles= (); 898 899 # foreach file specified on the commandline ... 900 foreach my$filename( @{$state->{args}} ) 901 { 902$filename= filecleanup($filename); 903 904 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 905 906 my$meta=$updater->getmeta($filename); 907 908 my$wrev= revparse($filename); 909 910 my ($filepart,$dirpart) = filenamesplit($filename); 911 912 # do a checkout of the file if it part of this tree 913 if ($wrev) { 914 system('git-checkout-index', '-f', '-u',$filename); 915 unless ($?== 0) { 916 die "Error running git-checkout-index -f -u$filename:$!"; 917 } 918 } 919 920 my$addflag= 0; 921 my$rmflag= 0; 922$rmflag= 1 if ( defined($wrev) and$wrev< 0 ); 923$addflag= 1 unless ( -e$filename); 924 925 # Do up to date checking 926 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) ) 927 { 928 # fail everything if an up to date check fails 929 print "error 1 Up to date check failed for$filename\n"; 930 close LOCKFILE; 931 unlink($lockfile); 932 chdir "/"; 933 exit; 934 } 935 936 push@committedfiles,$filename; 937$log->info("Committing$filename"); 938 939 system("mkdir","-p",$dirpart) unless ( -d$dirpart); 940 941 unless ($rmflag) 942 { 943$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename"); 944 rename$state->{entries}{$filename}{modified_filename},$filename; 945 946 # Calculate modes to remove 947 my$invmode= ""; 948 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); } 949 950$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename"); 951 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename); 952 } 953 954 if ($rmflag) 955 { 956$log->info("Removing file '$filename'"); 957 unlink($filename); 958 system("git-update-index", "--remove",$filename); 959 } 960 elsif ($addflag) 961 { 962$log->info("Adding file '$filename'"); 963 system("git-update-index", "--add",$filename); 964 } else { 965$log->info("Updating file '$filename'"); 966 system("git-update-index",$filename); 967 } 968 } 969 970 unless ( scalar(@committedfiles) > 0 ) 971 { 972 print "E No files to commit\n"; 973 print "ok\n"; 974 close LOCKFILE; 975 unlink($lockfile); 976 chdir "/"; 977 return; 978 } 979 980 my$treehash= `git-write-tree`; 981 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`; 982 chomp$treehash; 983 chomp$parenthash; 984 985$log->debug("Treehash :$treehash, Parenthash :$parenthash"); 986 987 # write our commit message out if we have one ... 988 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR); 989 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) ); 990 print$msg_fh"\n\nvia git-CVS emulator\n"; 991 close$msg_fh; 992 993 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`; 994$log->info("Commit hash :$commithash"); 995 996unless($commithash=~/[a-zA-Z0-9]{40}/) 997{ 998$log->warn("Commit failed (Invalid commit hash)"); 999print"error 1 Commit failed (unknown reason)\n";1000close LOCKFILE;1001unlink($lockfile);1002chdir"/";1003exit;1004}10051006open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}";1007print FILE $commithash;1008close FILE;10091010$updater->update();10111012# foreach file specified on the commandline ...1013foreachmy$filename(@committedfiles)1014{1015$filename= filecleanup($filename);10161017my$meta=$updater->getmeta($filename);10181019my($filepart,$dirpart) = filenamesplit($filename);10201021$log->debug("Checked-in$dirpart:$filename");10221023if($meta->{filehash}eq"deleted")1024{1025print"Remove-entry$dirpart\n";1026print"$filename\n";1027}else{1028print"Checked-in$dirpart\n";1029print"$filename\n";1030print"/$filepart/1.$meta->{revision}///\n";1031}1032}10331034close LOCKFILE;1035unlink($lockfile);1036chdir"/";10371038print"ok\n";1039}10401041sub req_status1042{1043my($cmd,$data) =@_;10441045 argsplit("status");10461047$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1048#$log->debug("status state : " . Dumper($state));10491050# Grab a handle to the SQLite db and do any necessary updates1051my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1052$updater->update();10531054# if no files were specified, we need to work out what files we should be providing status on ...1055 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);10561057# foreach file specified on the commandline ...1058foreachmy$filename( @{$state->{args}} )1059{1060$filename= filecleanup($filename);10611062my$meta=$updater->getmeta($filename);1063my$oldmeta=$meta;10641065my$wrev= revparse($filename);10661067# If the working copy is an old revision, lets get that version too for comparison.1068if(defined($wrev)and$wrev!=$meta->{revision} )1069{1070$oldmeta=$updater->getmeta($filename,$wrev);1071}10721073# TODO : All possible statuses aren't yet implemented1074my$status;1075# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1076$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1077and1078( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1079or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1080);10811082# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1083$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1084and1085($state->{entries}{$filename}{unchanged}1086or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1087);10881089# Need checkout if it exists in the repo but doesn't have a working copy1090$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );10911092# Locally modified if working copy and repo copy have the same revision but there are local changes1093$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );10941095# Needs Merge if working copy revision is less than repo copy and there are local changes1096$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );10971098$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1099$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1100$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1101$status||="File had conflicts on merge"if(0);11021103$status||="Unknown";11041105print"M ===================================================================\n";1106print"M File:$filename\tStatus:$status\n";1107if(defined($state->{entries}{$filename}{revision}) )1108{1109print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1110}else{1111print"M Working revision:\tNo entry for$filename\n";1112}1113if(defined($meta->{revision}) )1114{1115print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1116print"M Sticky Tag:\t\t(none)\n";1117print"M Sticky Date:\t\t(none)\n";1118print"M Sticky Options:\t\t(none)\n";1119}else{1120print"M Repository revision:\tNo revision control file\n";1121}1122print"M\n";1123}11241125print"ok\n";1126}11271128sub req_diff1129{1130my($cmd,$data) =@_;11311132 argsplit("diff");11331134$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1135#$log->debug("status state : " . Dumper($state));11361137my($revision1,$revision2);1138if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1139{1140$revision1=$state->{opt}{r}[0];1141$revision2=$state->{opt}{r}[1];1142}else{1143$revision1=$state->{opt}{r};1144}11451146$revision1=~s/^1\.//if(defined($revision1) );1147$revision2=~s/^1\.//if(defined($revision2) );11481149$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );11501151# Grab a handle to the SQLite db and do any necessary updates1152my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1153$updater->update();11541155# if no files were specified, we need to work out what files we should be providing status on ...1156 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);11571158# foreach file specified on the commandline ...1159foreachmy$filename( @{$state->{args}} )1160{1161$filename= filecleanup($filename);11621163my($fh,$file1,$file2,$meta1,$meta2,$filediff);11641165my$wrev= revparse($filename);11661167# We need _something_ to diff against1168next unless(defined($wrev) );11691170# if we have a -r switch, use it1171if(defined($revision1) )1172{1173(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1174$meta1=$updater->getmeta($filename,$revision1);1175unless(defined($meta1)and$meta1->{filehash}ne"deleted")1176{1177print"E File$filenameat revision 1.$revision1doesn't exist\n";1178next;1179}1180 transmitfile($meta1->{filehash},$file1);1181}1182# otherwise we just use the working copy revision1183else1184{1185(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1186$meta1=$updater->getmeta($filename,$wrev);1187 transmitfile($meta1->{filehash},$file1);1188}11891190# if we have a second -r switch, use it too1191if(defined($revision2) )1192{1193(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1194$meta2=$updater->getmeta($filename,$revision2);11951196unless(defined($meta2)and$meta2->{filehash}ne"deleted")1197{1198print"E File$filenameat revision 1.$revision2doesn't exist\n";1199next;1200}12011202 transmitfile($meta2->{filehash},$file2);1203}1204# otherwise we just use the working copy1205else1206{1207$file2=$state->{entries}{$filename}{modified_filename};1208}12091210# if we have been given -r, and we don't have a $file2 yet, lets get one1211if(defined($revision1)and not defined($file2) )1212{1213(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1214$meta2=$updater->getmeta($filename,$wrev);1215 transmitfile($meta2->{filehash},$file2);1216}12171218# We need to have retrieved something useful1219next unless(defined($meta1) );12201221# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1222next if(not defined($meta2)and$wrev==$meta1->{revision}1223and1224( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1225or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1226);12271228# Apparently we only show diffs for locally modified files1229next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );12301231print"M Index:$filename\n";1232print"M ===================================================================\n";1233print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1234print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1235print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1236print"M diff ";1237foreachmy$opt(keys%{$state->{opt}} )1238{1239if(ref$state->{opt}{$opt}eq"ARRAY")1240{1241foreachmy$value( @{$state->{opt}{$opt}} )1242{1243print"-$opt$value";1244}1245}else{1246print"-$opt";1247print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1248}1249}1250print"$filename\n";12511252$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));12531254($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);12551256if(exists$state->{opt}{u} )1257{1258system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1259}else{1260system("diff$file1$file2>$filediff");1261}12621263while( <$fh> )1264{1265print"M$_";1266}1267close$fh;1268}12691270print"ok\n";1271}12721273sub req_log1274{1275my($cmd,$data) =@_;12761277 argsplit("log");12781279$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1280#$log->debug("log state : " . Dumper($state));12811282my($minrev,$maxrev);1283if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1284{1285my$control=$2;1286$minrev=$1;1287$maxrev=$3;1288$minrev=~s/^1\.//if(defined($minrev) );1289$maxrev=~s/^1\.//if(defined($maxrev) );1290$minrev++if(defined($minrev)and$controleq"::");1291}12921293# Grab a handle to the SQLite db and do any necessary updates1294my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1295$updater->update();12961297# if no files were specified, we need to work out what files we should be providing status on ...1298 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12991300# foreach file specified on the commandline ...1301foreachmy$filename( @{$state->{args}} )1302{1303$filename= filecleanup($filename);13041305my$headmeta=$updater->getmeta($filename);13061307my$revisions=$updater->getlog($filename);1308my$totalrevisions=scalar(@$revisions);13091310if(defined($minrev) )1311{1312$log->debug("Removing revisions less than$minrev");1313while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1314{1315pop@$revisions;1316}1317}1318if(defined($maxrev) )1319{1320$log->debug("Removing revisions greater than$maxrev");1321while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1322{1323shift@$revisions;1324}1325}13261327next unless(scalar(@$revisions) );13281329print"M\n";1330print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1331print"M Working file:$filename\n";1332print"M head: 1.$headmeta->{revision}\n";1333print"M branch:\n";1334print"M locks: strict\n";1335print"M access list:\n";1336print"M symbolic names:\n";1337print"M keyword substitution: kv\n";1338print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1339print"M description:\n";13401341foreachmy$revision(@$revisions)1342{1343print"M ----------------------------\n";1344print"M revision 1.$revision->{revision}\n";1345# reformat the date for log output1346$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}) );1347$revision->{author} =~s/\s+.*//;1348$revision->{author} =~s/^(.{8}).*/$1/;1349print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1350my$commitmessage=$updater->commitmessage($revision->{commithash});1351$commitmessage=~s/^/M /mg;1352print$commitmessage."\n";1353}1354print"M =============================================================================\n";1355}13561357print"ok\n";1358}13591360sub req_annotate1361{1362my($cmd,$data) =@_;13631364 argsplit("annotate");13651366$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1367#$log->debug("status state : " . Dumper($state));13681369# Grab a handle to the SQLite db and do any necessary updates1370my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1371$updater->update();13721373# if no files were specified, we need to work out what files we should be providing annotate on ...1374 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);13751376# we'll need a temporary checkout dir1377my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1378my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1379$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");13801381$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1382$ENV{GIT_INDEX_FILE} =$file_index;13831384chdir$tmpdir;13851386# foreach file specified on the commandline ...1387foreachmy$filename( @{$state->{args}} )1388{1389$filename= filecleanup($filename);13901391my$meta=$updater->getmeta($filename);13921393next unless($meta->{revision} );13941395# get all the commits that this file was in1396# in dense format -- aka skip dead revisions1397my$revisions=$updater->gethistorydense($filename);1398my$lastseenin=$revisions->[0][2];13991400# populate the temporary index based on the latest commit were we saw1401# the file -- but do it cheaply without checking out any files1402# TODO: if we got a revision from the client, use that instead1403# to look up the commithash in sqlite (still good to default to1404# the current head as we do now)1405system("git-read-tree",$lastseenin);1406unless($?==0)1407{1408die"Error running git-read-tree$lastseenin$file_index$!";1409}1410$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");14111412# do a checkout of the file1413system('git-checkout-index','-f','-u',$filename);1414unless($?==0) {1415die"Error running git-checkout-index -f -u$filename:$!";1416}14171418$log->info("Annotate$filename");14191420# Prepare a file with the commits from the linearized1421# history that annotate should know about. This prevents1422# git-jsannotate telling us about commits we are hiding1423# from the client.14241425open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1426for(my$i=0;$i<@$revisions;$i++)1427{1428print ANNOTATEHINTS $revisions->[$i][2];1429if($i+1<@$revisions) {# have we got a parent?1430print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1431}1432print ANNOTATEHINTS "\n";1433}14341435print ANNOTATEHINTS "\n";1436close ANNOTATEHINTS;14371438my$annotatecmd='git-annotate';1439open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1440or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1441my$metadata= {};1442print"E Annotations for$filename\n";1443print"E ***************\n";1444while( <ANNOTATE> )1445{1446if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1447{1448my$commithash=$1;1449my$data=$2;1450unless(defined($metadata->{$commithash} ) )1451{1452$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1453$metadata->{$commithash}{author} =~s/\s+.*//;1454$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1455$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1456}1457printf("M 1.%-5d (%-8s%10s):%s\n",1458$metadata->{$commithash}{revision},1459$metadata->{$commithash}{author},1460$metadata->{$commithash}{modified},1461$data1462);1463}else{1464$log->warn("Error in annotate output! LINE:$_");1465print"E Annotate error\n";1466next;1467}1468}1469close ANNOTATE;1470}14711472# done; get out of the tempdir1473chdir"/";14741475print"ok\n";14761477}14781479# This method takes the state->{arguments} array and produces two new arrays.1480# The first is $state->{args} which is everything before the '--' argument, and1481# the second is $state->{files} which is everything after it.1482sub argsplit1483{1484return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");14851486my$type=shift;14871488$state->{args} = [];1489$state->{files} = [];1490$state->{opt} = {};14911492if(defined($type) )1493{1494my$opt= {};1495$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");1496$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1497$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");1498$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1499$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1500$opt= { k =>1, m =>1}if($typeeq"add");1501$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1502$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");150315041505while(scalar( @{$state->{arguments}} ) >0)1506{1507my$arg=shift@{$state->{arguments}};15081509next if($argeq"--");1510next unless($arg=~/\S/);15111512# if the argument looks like a switch1513if($arg=~/^-(\w)(.*)/)1514{1515# if it's a switch that takes an argument1516if($opt->{$1} )1517{1518# If this switch has already been provided1519if($opt->{$1} >1and exists($state->{opt}{$1} ) )1520{1521$state->{opt}{$1} = [$state->{opt}{$1} ];1522if(length($2) >0)1523{1524push@{$state->{opt}{$1}},$2;1525}else{1526push@{$state->{opt}{$1}},shift@{$state->{arguments}};1527}1528}else{1529# if there's extra data in the arg, use that as the argument for the switch1530if(length($2) >0)1531{1532$state->{opt}{$1} =$2;1533}else{1534$state->{opt}{$1} =shift@{$state->{arguments}};1535}1536}1537}else{1538$state->{opt}{$1} =undef;1539}1540}1541else1542{1543push@{$state->{args}},$arg;1544}1545}1546}1547else1548{1549my$mode=0;15501551foreachmy$value( @{$state->{arguments}} )1552{1553if($valueeq"--")1554{1555$mode++;1556next;1557}1558push@{$state->{args}},$valueif($mode==0);1559push@{$state->{files}},$valueif($mode==1);1560}1561}1562}15631564# This method uses $state->{directory} to populate $state->{args} with a list of filenames1565sub argsfromdir1566{1567my$updater=shift;15681569$state->{args} = [];15701571foreachmy$file( @{$updater->gethead} )1572{1573next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1574next unless($file->{name} =~s/^$state->{directory}//);1575push@{$state->{args}},$file->{name};1576}1577}15781579# This method cleans up the $state variable after a command that uses arguments has run1580sub statecleanup1581{1582$state->{files} = [];1583$state->{args} = [];1584$state->{arguments} = [];1585$state->{entries} = {};1586}15871588sub revparse1589{1590my$filename=shift;15911592returnundefunless(defined($state->{entries}{$filename}{revision} ) );15931594return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1595return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);15961597returnundef;1598}15991600# This method takes a file hash and does a CVS "file transfer" which transmits the1601# size of the file, and then the file contents.1602# If a second argument $targetfile is given, the file is instead written out to1603# a file by the name of $targetfile1604sub transmitfile1605{1606my$filehash=shift;1607my$targetfile=shift;16081609if(defined($filehash)and$filehasheq"deleted")1610{1611$log->warn("filehash is 'deleted'");1612return;1613}16141615die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);16161617my$type=`git-cat-file -t$filehash`;1618 chomp$type;16191620 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );16211622 my$size= `git-cat-file -s $filehash`;1623chomp$size;16241625$log->debug("transmitfile($filehash) size=$size, type=$type");16261627if(open my$fh,'-|',"git-cat-file","blob",$filehash)1628{1629if(defined($targetfile) )1630{1631open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1632print NEWFILE $_while( <$fh> );1633close NEWFILE;1634}else{1635print"$size\n";1636printwhile( <$fh> );1637}1638close$fhor die("Couldn't close filehandle for transmitfile()");1639}else{1640die("Couldn't execute git-cat-file");1641}1642}16431644# This method takes a file name, and returns ( $dirpart, $filepart ) which1645# refers to the directory porition and the file portion of the filename1646# respectively1647sub filenamesplit1648{1649my$filename=shift;16501651my($filepart,$dirpart) = ($filename,".");1652($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1653$dirpart.="/";16541655return($filepart,$dirpart);1656}16571658sub filecleanup1659{1660my$filename=shift;16611662returnundefunless(defined($filename));1663if($filename=~/^\// )1664{1665print"E absolute filenames '$filename' not supported by server\n";1666returnundef;1667}16681669$filename=~s/^\.\///g;1670$filename=$state->{directory} .$filename;16711672return$filename;1673}16741675package GITCVS::log;16761677####1678#### Copyright The Open University UK - 2006.1679####1680#### Authors: Martyn Smith <martyn@catalyst.net.nz>1681#### Martin Langhoff <martin@catalyst.net.nz>1682####1683####16841685use strict;1686use warnings;16871688=head1 NAME16891690GITCVS::log16911692=head1 DESCRIPTION16931694This module provides very crude logging with a similar interface to1695Log::Log4perl16961697=head1 METHODS16981699=cut17001701=head2 new17021703Creates a new log object, optionally you can specify a filename here to1704indicate the file to log to. If no log file is specified, you can specifiy one1705later with method setfile, or indicate you no longer want logging with method1706nofile.17071708Until one of these methods is called, all log calls will buffer messages ready1709to write out.17101711=cut1712sub new1713{1714my$class=shift;1715my$filename=shift;17161717my$self= {};17181719bless$self,$class;17201721if(defined($filename) )1722{1723open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1724}17251726return$self;1727}17281729=head2 setfile17301731This methods takes a filename, and attempts to open that file as the log file.1732If successful, all buffered data is written out to the file, and any further1733logging is written directly to the file.17341735=cut1736sub setfile1737{1738my$self=shift;1739my$filename=shift;17401741if(defined($filename) )1742{1743open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1744}17451746return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");17471748while(my$line=shift@{$self->{buffer}} )1749{1750print{$self->{fh}}$line;1751}1752}17531754=head2 nofile17551756This method indicates no logging is going to be used. It flushes any entries in1757the internal buffer, and sets a flag to ensure no further data is put there.17581759=cut1760sub nofile1761{1762my$self=shift;17631764$self->{nolog} =1;17651766return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");17671768$self->{buffer} = [];1769}17701771=head2 _logopen17721773Internal method. Returns true if the log file is open, false otherwise.17741775=cut1776sub _logopen1777{1778my$self=shift;17791780return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1781return0;1782}17831784=head2 debug info warn fatal17851786These four methods are wrappers to _log. They provide the actual interface for1787logging data.17881789=cut1790sub debug {my$self=shift;$self->_log("debug",@_); }1791sub info {my$self=shift;$self->_log("info",@_); }1792subwarn{my$self=shift;$self->_log("warn",@_); }1793sub fatal {my$self=shift;$self->_log("fatal",@_); }17941795=head2 _log17961797This is an internal method called by the logging functions. It generates a1798timestamp and pushes the logged line either to file, or internal buffer.17991800=cut1801sub _log1802{1803my$self=shift;1804my$level=shift;18051806return if($self->{nolog} );18071808my@time=localtime;1809my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1810$time[5] +1900,1811$time[4] +1,1812$time[3],1813$time[2],1814$time[1],1815$time[0],1816uc$level,1817);18181819if($self->_logopen)1820{1821print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1822}else{1823push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1824}1825}18261827=head2 DESTROY18281829This method simply closes the file handle if one is open18301831=cut1832sub DESTROY1833{1834my$self=shift;18351836if($self->_logopen)1837{1838close$self->{fh};1839}1840}18411842package GITCVS::updater;18431844####1845#### Copyright The Open University UK - 2006.1846####1847#### Authors: Martyn Smith <martyn@catalyst.net.nz>1848#### Martin Langhoff <martin@catalyst.net.nz>1849####1850####18511852use strict;1853use warnings;1854use DBI;18551856=head1 METHODS18571858=cut18591860=head2 new18611862=cut1863sub new1864{1865my$class=shift;1866my$config=shift;1867my$module=shift;1868my$log=shift;18691870die"Need to specify a git repository"unless(defined($config)and-d $config);1871die"Need to specify a module"unless(defined($module) );18721873$class=ref($class) ||$class;18741875my$self= {};18761877bless$self,$class;18781879$self->{dbdir} =$config."/";1880die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );18811882$self->{module} =$module;1883$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";18841885$self->{git_path} =$config."/";18861887$self->{log} =$log;18881889die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );18901891$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");18921893$self->{tables} = {};1894foreachmy$table($self->{dbh}->tables)1895{1896$table=~s/^"//;1897$table=~s/"$//;1898$self->{tables}{$table} =1;1899}19001901# Construct the revision table if required1902unless($self->{tables}{revision} )1903{1904$self->{dbh}->do("1905 CREATE TABLE revision (1906 name TEXT NOT NULL,1907 revision INTEGER NOT NULL,1908 filehash TEXT NOT NULL,1909 commithash TEXT NOT NULL,1910 author TEXT NOT NULL,1911 modified TEXT NOT NULL,1912 mode TEXT NOT NULL1913 )1914 ");1915}19161917# Construct the revision table if required1918unless($self->{tables}{head} )1919{1920$self->{dbh}->do("1921 CREATE TABLE head (1922 name TEXT NOT NULL,1923 revision INTEGER NOT NULL,1924 filehash TEXT NOT NULL,1925 commithash TEXT NOT NULL,1926 author TEXT NOT NULL,1927 modified TEXT NOT NULL,1928 mode TEXT NOT NULL1929 )1930 ");1931}19321933# Construct the properties table if required1934unless($self->{tables}{properties} )1935{1936$self->{dbh}->do("1937 CREATE TABLE properties (1938 key TEXT NOT NULL PRIMARY KEY,1939 value TEXT1940 )1941 ");1942}19431944# Construct the commitmsgs table if required1945unless($self->{tables}{commitmsgs} )1946{1947$self->{dbh}->do("1948 CREATE TABLE commitmsgs (1949 key TEXT NOT NULL PRIMARY KEY,1950 value TEXT1951 )1952 ");1953}19541955return$self;1956}19571958=head2 update19591960=cut1961sub update1962{1963my$self=shift;19641965# first lets get the commit list1966$ENV{GIT_DIR} =$self->{git_path};19671968# prepare database queries1969my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);1970my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);1971my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);1972my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);19731974my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;1975unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)1976{1977die("Invalid module '$self->{module}'");1978}197919801981my$git_log;1982my$lastcommit=$self->_get_prop("last_commit");19831984# Start exclusive lock here...1985$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";19861987# TODO: log processing is memory bound1988# if we can parse into a 2nd file that is in reverse order1989# we can probably do something really efficient1990my@git_log_params= ('--parents','--topo-order');19911992if(defined$lastcommit) {1993push@git_log_params,"$lastcommit..$self->{module}";1994}else{1995push@git_log_params,$self->{module};1996}1997open(GITLOG,'-|','git-log',@git_log_params)or die"Cannot call git-log:$!";19981999my@commits;20002001my%commit= ();20022003while( <GITLOG> )2004{2005chomp;2006if(m/^commit\s+(.*)$/) {2007# on ^commit lines put the just seen commit in the stack2008# and prime things for the next one2009if(keys%commit) {2010my%copy=%commit;2011unshift@commits, \%copy;2012%commit= ();2013}2014my@parents=split(m/\s+/,$1);2015$commit{hash} =shift@parents;2016$commit{parents} = \@parents;2017}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2018# on rfc822-like lines seen before we see any message,2019# lowercase the entry and put it in the hash as key-value2020$commit{lc($1)} =$2;2021}else{2022# message lines - skip initial empty line2023# and trim whitespace2024if(!exists($commit{message}) &&m/^\s*$/) {2025# define it to mark the end of headers2026$commit{message} ='';2027next;2028}2029s/^\s+//;s/\s+$//;# trim ws2030$commit{message} .=$_."\n";2031}2032}2033close GITLOG;20342035unshift@commits, \%commitif(keys%commit);20362037# Now all the commits are in the @commits bucket2038# ordered by time DESC. for each commit that needs processing,2039# determine whether it's following the last head we've seen or if2040# it's on its own branch, grab a file list, and add whatever's changed2041# NOTE: $lastcommit refers to the last commit from previous run2042# $lastpicked is the last commit we picked in this run2043my$lastpicked;2044my$head= {};2045if(defined$lastcommit) {2046$lastpicked=$lastcommit;2047}20482049my$committotal=scalar(@commits);2050my$commitcount=0;20512052# Load the head table into $head (for cached lookups during the update process)2053foreachmy$file( @{$self->gethead()} )2054{2055$head->{$file->{name}} =$file;2056}20572058foreachmy$commit(@commits)2059{2060$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2061if(defined$lastpicked)2062{2063if(!in_array($lastpicked, @{$commit->{parents}}))2064{2065# skip, we'll see this delta2066# as part of a merge later2067# warn "skipping off-track $commit->{hash}\n";2068next;2069}elsif(@{$commit->{parents}} >1) {2070# it is a merge commit, for each parent that is2071# not $lastpicked, see if we can get a log2072# from the merge-base to that parent to put it2073# in the message as a merge summary.2074my@parents= @{$commit->{parents}};2075foreachmy$parent(@parents) {2076# git-merge-base can potentially (but rarely) throw2077# several candidate merge bases. let's assume2078# that the first one is the best one.2079if($parenteq$lastpicked) {2080next;2081}2082open my$p,'git-merge-base '.$lastpicked.' '2083.$parent.'|';2084my@output= (<$p>);2085close$p;2086my$base=join('',@output);2087chomp$base;2088if($base) {2089my@merged;2090# print "want to log between $base $parent \n";2091open(GITLOG,'-|','git-log',"$base..$parent")2092or die"Cannot call git-log:$!";2093my$mergedhash;2094while(<GITLOG>) {2095chomp;2096if(!defined$mergedhash) {2097if(m/^commit\s+(.+)$/) {2098$mergedhash=$1;2099}else{2100next;2101}2102}else{2103# grab the first line that looks non-rfc8222104# aka has content after leading space2105if(m/^\s+(\S.*)$/) {2106my$title=$1;2107$title=substr($title,0,100);# truncate2108unshift@merged,"$mergedhash$title";2109undef$mergedhash;2110}2111}2112}2113close GITLOG;2114if(@merged) {2115$commit->{mergemsg} =$commit->{message};2116$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2117foreachmy$summary(@merged) {2118$commit->{mergemsg} .="\t$summary\n";2119}2120$commit->{mergemsg} .="\n\n";2121# print "Message for $commit->{hash} \n$commit->{mergemsg}";2122}2123}2124}2125}2126}21272128# convert the date to CVS-happy format2129$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);21302131if(defined($lastpicked) )2132{2133my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2134while( <FILELIST> )2135{2136unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2137{2138die("Couldn't process git-diff-tree line :$_");2139}21402141# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");21422143my$git_perms="";2144$git_perms.="r"if($1&4);2145$git_perms.="w"if($1&2);2146$git_perms.="x"if($1&1);2147$git_perms="rw"if($git_permseq"");21482149if($3eq"D")2150{2151#$log->debug("DELETE $4");2152$head->{$4} = {2153 name =>$4,2154 revision =>$head->{$4}{revision} +1,2155 filehash =>"deleted",2156 commithash =>$commit->{hash},2157 modified =>$commit->{date},2158 author =>$commit->{author},2159 mode =>$git_perms,2160};2161$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2162}2163elsif($3eq"M")2164{2165#$log->debug("MODIFIED $4");2166$head->{$4} = {2167 name =>$4,2168 revision =>$head->{$4}{revision} +1,2169 filehash =>$2,2170 commithash =>$commit->{hash},2171 modified =>$commit->{date},2172 author =>$commit->{author},2173 mode =>$git_perms,2174};2175$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2176}2177elsif($3eq"A")2178{2179#$log->debug("ADDED $4");2180$head->{$4} = {2181 name =>$4,2182 revision =>1,2183 filehash =>$2,2184 commithash =>$commit->{hash},2185 modified =>$commit->{date},2186 author =>$commit->{author},2187 mode =>$git_perms,2188};2189$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2190}2191else2192{2193$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2194die;2195}2196}2197close FILELIST;2198}else{2199# this is used to detect files removed from the repo2200my$seen_files= {};22012202my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2203while( <FILELIST> )2204{2205unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2206{2207die("Couldn't process git-ls-tree line :$_");2208}22092210my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);22112212$seen_files->{$git_filename} =1;22132214my($oldhash,$oldrevision,$oldmode) = (2215$head->{$git_filename}{filehash},2216$head->{$git_filename}{revision},2217$head->{$git_filename}{mode}2218);22192220if($git_perms=~/^\d\d\d(\d)\d\d/o)2221{2222$git_perms="";2223$git_perms.="r"if($1&4);2224$git_perms.="w"if($1&2);2225$git_perms.="x"if($1&1);2226}else{2227$git_perms="rw";2228}22292230# unless the file exists with the same hash, we need to update it ...2231unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2232{2233my$newrevision= ($oldrevisionor0) +1;22342235$head->{$git_filename} = {2236 name =>$git_filename,2237 revision =>$newrevision,2238 filehash =>$git_hash,2239 commithash =>$commit->{hash},2240 modified =>$commit->{date},2241 author =>$commit->{author},2242 mode =>$git_perms,2243};224422452246$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2247}2248}2249close FILELIST;22502251# Detect deleted files2252foreachmy$file(keys%$head)2253{2254unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2255{2256$head->{$file}{revision}++;2257$head->{$file}{filehash} ="deleted";2258$head->{$file}{commithash} =$commit->{hash};2259$head->{$file}{modified} =$commit->{date};2260$head->{$file}{author} =$commit->{author};22612262$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2263}2264}2265# END : "Detect deleted files"2266}226722682269if(exists$commit->{mergemsg})2270{2271$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2272}22732274$lastpicked=$commit->{hash};22752276$self->_set_prop("last_commit",$commit->{hash});2277}22782279$db_delete_head->execute();2280foreachmy$file(keys%$head)2281{2282$db_insert_head->execute(2283$file,2284$head->{$file}{revision},2285$head->{$file}{filehash},2286$head->{$file}{commithash},2287$head->{$file}{modified},2288$head->{$file}{author},2289$head->{$file}{mode},2290);2291}2292# invalidate the gethead cache2293$self->{gethead_cache} =undef;229422952296# Ending exclusive lock here2297$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2298}22992300sub _headrev2301{2302my$self=shift;2303my$filename=shift;23042305my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2306$db_query->execute($filename);2307my($hash,$revision,$mode) =$db_query->fetchrow_array;23082309return($hash,$revision,$mode);2310}23112312sub _get_prop2313{2314my$self=shift;2315my$key=shift;23162317my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2318$db_query->execute($key);2319my($value) =$db_query->fetchrow_array;23202321return$value;2322}23232324sub _set_prop2325{2326my$self=shift;2327my$key=shift;2328my$value=shift;23292330my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2331$db_query->execute($value,$key);23322333unless($db_query->rows)2334{2335$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2336$db_query->execute($key,$value);2337}23382339return$value;2340}23412342=head2 gethead23432344=cut23452346sub gethead2347{2348my$self=shift;23492350return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );23512352my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);2353$db_query->execute();23542355my$tree= [];2356while(my$file=$db_query->fetchrow_hashref)2357{2358push@$tree,$file;2359}23602361$self->{gethead_cache} =$tree;23622363return$tree;2364}23652366=head2 getlog23672368=cut23692370sub getlog2371{2372my$self=shift;2373my$filename=shift;23742375my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2376$db_query->execute($filename);23772378my$tree= [];2379while(my$file=$db_query->fetchrow_hashref)2380{2381push@$tree,$file;2382}23832384return$tree;2385}23862387=head2 getmeta23882389This function takes a filename (with path) argument and returns a hashref of2390metadata for that file.23912392=cut23932394sub getmeta2395{2396my$self=shift;2397my$filename=shift;2398my$revision=shift;23992400my$db_query;2401if(defined($revision)and$revision=~/^\d+$/)2402{2403$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2404$db_query->execute($filename,$revision);2405}2406elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2407{2408$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2409$db_query->execute($filename,$revision);2410}else{2411$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2412$db_query->execute($filename);2413}24142415return$db_query->fetchrow_hashref;2416}24172418=head2 commitmessage24192420this function takes a commithash and returns the commit message for that commit24212422=cut2423sub commitmessage2424{2425my$self=shift;2426my$commithash=shift;24272428die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);24292430my$db_query;2431$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2432$db_query->execute($commithash);24332434my($message) =$db_query->fetchrow_array;24352436if(defined($message) )2437{2438$message.=" "if($message=~/\n$/);2439return$message;2440}24412442my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2443shift@lineswhile($lines[0] =~/\S/);2444$message=join("",@lines);2445$message.=" "if($message=~/\n$/);2446return$message;2447}24482449=head2 gethistory24502451This function takes a filename (with path) argument and returns an arrayofarrays2452containing revision,filehash,commithash ordered by revision descending24532454=cut2455sub gethistory2456{2457my$self=shift;2458my$filename=shift;24592460my$db_query;2461$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2462$db_query->execute($filename);24632464return$db_query->fetchall_arrayref;2465}24662467=head2 gethistorydense24682469This function takes a filename (with path) argument and returns an arrayofarrays2470containing revision,filehash,commithash ordered by revision descending.24712472This version of gethistory skips deleted entries -- so it is useful for annotate.2473The 'dense' part is a reference to a '--dense' option available for git-rev-list2474and other git tools that depend on it.24752476=cut2477sub gethistorydense2478{2479my$self=shift;2480my$filename=shift;24812482my$db_query;2483$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2484$db_query->execute($filename);24852486return$db_query->fetchall_arrayref;2487}24882489=head2 in_array()24902491from Array::PAT - mimics the in_array() function2492found in PHP. Yuck but works for small arrays.24932494=cut2495sub in_array2496{2497my($check,@array) =@_;2498my$retval=0;2499foreachmy$test(@array){2500if($checkeq$test){2501$retval=1;2502}2503}2504return$retval;2505}25062507=head2 safe_pipe_capture25082509an alterative to `command` that allows input to be passed as an array2510to work around shell problems with weird characters in arguments25112512=cut2513sub safe_pipe_capture {25142515my@output;25162517if(my$pid=open my$child,'-|') {2518@output= (<$child>);2519close$childor die join(' ',@_).":$!$?";2520}else{2521exec(@_)or die"$!$?";# exec() can fail the executable can't be found2522}2523returnwantarray?@output:join('',@output);2524}2525252625271;