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, and the working copy is unmodified _and_ the user hasn't specified -C 718next if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{unchanged}and not exists($state->{opt}{C} ) ); 719 720if($meta->{filehash}eq"deleted") 721{ 722my($filepart,$dirpart) = filenamesplit($filename); 723 724$log->info("Removing '$filename' from working copy (no longer in the repo)"); 725 726print"E cvs update: `$filename' is no longer in the repository\n"; 727print"Removed$dirpart\n"; 728print"$filepart\n"; 729} 730elsif(not defined($state->{entries}{$filename}{modified_hash} )or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 731{ 732$log->info("Updating '$filename'"); 733# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 734print"MT +updated\n"; 735print"MT text U\n"; 736print"MT fname$filename\n"; 737print"MT newline\n"; 738print"MT -updated\n"; 739 740my($filepart,$dirpart) = filenamesplit($filename); 741$dirpart=~s/^$state->{directory}//; 742 743if(defined($wrev) ) 744{ 745# instruct client we're sending a file to put in this path as a replacement 746print"Update-existing$dirpart\n"; 747$log->debug("Updating existing file 'Update-existing$dirpart'"); 748}else{ 749# instruct client we're sending a file to put in this path as a new file 750print"Created$dirpart\n"; 751$log->debug("Creating new file 'Created$dirpart'"); 752} 753print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 754 755# this is an "entries" line 756$log->debug("/$filepart/1.$meta->{revision}///"); 757print"/$filepart/1.$meta->{revision}///\n"; 758 759# permissions 760$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 761print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 762 763# transmit file 764 transmitfile($meta->{filehash}); 765}else{ 766my($filepart,$dirpart) = filenamesplit($meta->{name}); 767 768my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 769 770chdir$dir; 771my$file_local=$filepart.".mine"; 772system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 773my$file_old=$filepart.".".$oldmeta->{revision}; 774 transmitfile($oldmeta->{filehash},$file_old); 775my$file_new=$filepart.".".$meta->{revision}; 776 transmitfile($meta->{filehash},$file_new); 777 778# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 779$log->info("Merging$file_local,$file_old,$file_new"); 780 781$log->debug("Temporary directory for merge is$dir"); 782 783my$return=system("merge",$file_local,$file_old,$file_new); 784$return>>=8; 785 786if($return==0) 787{ 788$log->info("Merged successfully"); 789print"M M$filename\n"; 790$log->debug("Update-existing$dirpart"); 791print"Update-existing$dirpart\n"; 792$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 793print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 794$log->debug("/$filepart/1.$meta->{revision}///"); 795print"/$filepart/1.$meta->{revision}///\n"; 796} 797elsif($return==1) 798{ 799$log->info("Merged with conflicts"); 800print"M C$filename\n"; 801print"Update-existing$dirpart\n"; 802print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 803print"/$filepart/1.$meta->{revision}/+//\n"; 804} 805else 806{ 807$log->warn("Merge failed"); 808next; 809} 810 811# permissions 812$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 813print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 814 815# transmit file, format is single integer on a line by itself (file 816# size) followed by the file contents 817# TODO : we should copy files in blocks 818my$data=`cat$file_local`; 819$log->debug("File size : " . length($data)); 820 print length($data) . "\n"; 821 print$data; 822 823 chdir "/"; 824 } 825 826 } 827 828 print "ok\n"; 829} 830 831sub req_ci 832{ 833 my ($cmd,$data) =@_; 834 835 argsplit("ci"); 836 837 #$log->debug("State : " . Dumper($state)); 838 839$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 840 841 if ( -e$state->{CVSROOT} . "/index" ) 842 { 843 print "error 1 Index already exists in git repo\n"; 844 exit; 845 } 846 847 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 848 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 849 { 850 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 851 exit; 852 } 853 854 # Grab a handle to the SQLite db and do any necessary updates 855 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 856$updater->update(); 857 858 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 859 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 860$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 861 862$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 863$ENV{GIT_INDEX_FILE} =$file_index; 864 865 chdir$tmpdir; 866 867 # populate the temporary index based 868 system("git-read-tree",$state->{module}); 869 unless ($?== 0) 870 { 871 die "Error running git-read-tree$state->{module}$file_index$!"; 872 } 873$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 874 875 876 my@committedfiles= (); 877 878 # foreach file specified on the commandline ... 879 foreach my$filename( @{$state->{args}} ) 880 { 881$filename= filecleanup($filename); 882 883 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 884 885 my$meta=$updater->getmeta($filename); 886 887 my$wrev= revparse($filename); 888 889 my ($filepart,$dirpart) = filenamesplit($filename); 890 891 # do a checkout of the file if it part of this tree 892 if ($wrev) { 893 system('git-checkout-index', '-f', '-u',$filename); 894 unless ($?== 0) { 895 die "Error running git-checkout-index -f -u$filename:$!"; 896 } 897 } 898 899 my$addflag= 0; 900 my$rmflag= 0; 901$rmflag= 1 if ( defined($wrev) and$wrev< 0 ); 902$addflag= 1 unless ( -e$filename); 903 904 # Do up to date checking 905 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) ) 906 { 907 # fail everything if an up to date check fails 908 print "error 1 Up to date check failed for$filename\n"; 909 close LOCKFILE; 910 unlink($lockfile); 911 chdir "/"; 912 exit; 913 } 914 915 push@committedfiles,$filename; 916$log->info("Committing$filename"); 917 918 system("mkdir","-p",$dirpart) unless ( -d$dirpart); 919 920 unless ($rmflag) 921 { 922$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename"); 923 rename$state->{entries}{$filename}{modified_filename},$filename; 924 925 # Calculate modes to remove 926 my$invmode= ""; 927 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); } 928 929$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename"); 930 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename); 931 } 932 933 if ($rmflag) 934 { 935$log->info("Removing file '$filename'"); 936 unlink($filename); 937 system("git-update-index", "--remove",$filename); 938 } 939 elsif ($addflag) 940 { 941$log->info("Adding file '$filename'"); 942 system("git-update-index", "--add",$filename); 943 } else { 944$log->info("Updating file '$filename'"); 945 system("git-update-index",$filename); 946 } 947 } 948 949 unless ( scalar(@committedfiles) > 0 ) 950 { 951 print "E No files to commit\n"; 952 print "ok\n"; 953 close LOCKFILE; 954 unlink($lockfile); 955 chdir "/"; 956 return; 957 } 958 959 my$treehash= `git-write-tree`; 960 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`; 961 chomp$treehash; 962 chomp$parenthash; 963 964$log->debug("Treehash :$treehash, Parenthash :$parenthash"); 965 966 # write our commit message out if we have one ... 967 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR); 968 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) ); 969 print$msg_fh"\n\nvia git-CVS emulator\n"; 970 close$msg_fh; 971 972 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`; 973$log->info("Commit hash :$commithash"); 974 975unless($commithash=~/[a-zA-Z0-9]{40}/) 976{ 977$log->warn("Commit failed (Invalid commit hash)"); 978print"error 1 Commit failed (unknown reason)\n"; 979close LOCKFILE; 980unlink($lockfile); 981chdir"/"; 982exit; 983} 984 985open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}"; 986print FILE $commithash; 987close FILE; 988 989$updater->update(); 990 991# foreach file specified on the commandline ... 992foreachmy$filename(@committedfiles) 993{ 994$filename= filecleanup($filename); 995 996my$meta=$updater->getmeta($filename); 997 998my($filepart,$dirpart) = filenamesplit($filename); 9991000$log->debug("Checked-in$dirpart:$filename");10011002if($meta->{filehash}eq"deleted")1003{1004print"Remove-entry$dirpart\n";1005print"$filename\n";1006}else{1007print"Checked-in$dirpart\n";1008print"$filename\n";1009print"/$filepart/1.$meta->{revision}///\n";1010}1011}10121013close LOCKFILE;1014unlink($lockfile);1015chdir"/";10161017print"ok\n";1018}10191020sub req_status1021{1022my($cmd,$data) =@_;10231024 argsplit("status");10251026$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1027#$log->debug("status state : " . Dumper($state));10281029# Grab a handle to the SQLite db and do any necessary updates1030my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1031$updater->update();10321033# if no files were specified, we need to work out what files we should be providing status on ...1034 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);10351036# foreach file specified on the commandline ...1037foreachmy$filename( @{$state->{args}} )1038{1039$filename= filecleanup($filename);10401041my$meta=$updater->getmeta($filename);1042my$oldmeta=$meta;10431044my$wrev= revparse($filename);10451046# If the working copy is an old revision, lets get that version too for comparison.1047if(defined($wrev)and$wrev!=$meta->{revision} )1048{1049$oldmeta=$updater->getmeta($filename,$wrev);1050}10511052# TODO : All possible statuses aren't yet implemented1053my$status;1054# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1055$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1056and1057( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1058or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1059);10601061# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1062$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1063and1064($state->{entries}{$filename}{unchanged}1065or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1066);10671068# Need checkout if it exists in the repo but doesn't have a working copy1069$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );10701071# Locally modified if working copy and repo copy have the same revision but there are local changes1072$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );10731074# Needs Merge if working copy revision is less than repo copy and there are local changes1075$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );10761077$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1078$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1079$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1080$status||="File had conflicts on merge"if(0);10811082$status||="Unknown";10831084print"M ===================================================================\n";1085print"M File:$filename\tStatus:$status\n";1086if(defined($state->{entries}{$filename}{revision}) )1087{1088print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1089}else{1090print"M Working revision:\tNo entry for$filename\n";1091}1092if(defined($meta->{revision}) )1093{1094print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1095print"M Sticky Tag:\t\t(none)\n";1096print"M Sticky Date:\t\t(none)\n";1097print"M Sticky Options:\t\t(none)\n";1098}else{1099print"M Repository revision:\tNo revision control file\n";1100}1101print"M\n";1102}11031104print"ok\n";1105}11061107sub req_diff1108{1109my($cmd,$data) =@_;11101111 argsplit("diff");11121113$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1114#$log->debug("status state : " . Dumper($state));11151116my($revision1,$revision2);1117if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1118{1119$revision1=$state->{opt}{r}[0];1120$revision2=$state->{opt}{r}[1];1121}else{1122$revision1=$state->{opt}{r};1123}11241125$revision1=~s/^1\.//if(defined($revision1) );1126$revision2=~s/^1\.//if(defined($revision2) );11271128$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );11291130# Grab a handle to the SQLite db and do any necessary updates1131my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1132$updater->update();11331134# if no files were specified, we need to work out what files we should be providing status on ...1135 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);11361137# foreach file specified on the commandline ...1138foreachmy$filename( @{$state->{args}} )1139{1140$filename= filecleanup($filename);11411142my($fh,$file1,$file2,$meta1,$meta2,$filediff);11431144my$wrev= revparse($filename);11451146# We need _something_ to diff against1147next unless(defined($wrev) );11481149# if we have a -r switch, use it1150if(defined($revision1) )1151{1152(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1153$meta1=$updater->getmeta($filename,$revision1);1154unless(defined($meta1)and$meta1->{filehash}ne"deleted")1155{1156print"E File$filenameat revision 1.$revision1doesn't exist\n";1157next;1158}1159 transmitfile($meta1->{filehash},$file1);1160}1161# otherwise we just use the working copy revision1162else1163{1164(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1165$meta1=$updater->getmeta($filename,$wrev);1166 transmitfile($meta1->{filehash},$file1);1167}11681169# if we have a second -r switch, use it too1170if(defined($revision2) )1171{1172(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1173$meta2=$updater->getmeta($filename,$revision2);11741175unless(defined($meta2)and$meta2->{filehash}ne"deleted")1176{1177print"E File$filenameat revision 1.$revision2doesn't exist\n";1178next;1179}11801181 transmitfile($meta2->{filehash},$file2);1182}1183# otherwise we just use the working copy1184else1185{1186$file2=$state->{entries}{$filename}{modified_filename};1187}11881189# if we have been given -r, and we don't have a $file2 yet, lets get one1190if(defined($revision1)and not defined($file2) )1191{1192(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1193$meta2=$updater->getmeta($filename,$wrev);1194 transmitfile($meta2->{filehash},$file2);1195}11961197# We need to have retrieved something useful1198next unless(defined($meta1) );11991200# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1201next if(not defined($meta2)and$wrev==$meta1->{revision}1202and1203( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1204or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1205);12061207# Apparently we only show diffs for locally modified files1208next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );12091210print"M Index:$filename\n";1211print"M ===================================================================\n";1212print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1213print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1214print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1215print"M diff ";1216foreachmy$opt(keys%{$state->{opt}} )1217{1218if(ref$state->{opt}{$opt}eq"ARRAY")1219{1220foreachmy$value( @{$state->{opt}{$opt}} )1221{1222print"-$opt$value";1223}1224}else{1225print"-$opt";1226print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1227}1228}1229print"$filename\n";12301231$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));12321233($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);12341235if(exists$state->{opt}{u} )1236{1237system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1238}else{1239system("diff$file1$file2>$filediff");1240}12411242while( <$fh> )1243{1244print"M$_";1245}1246close$fh;1247}12481249print"ok\n";1250}12511252sub req_log1253{1254my($cmd,$data) =@_;12551256 argsplit("log");12571258$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1259#$log->debug("log state : " . Dumper($state));12601261my($minrev,$maxrev);1262if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1263{1264my$control=$2;1265$minrev=$1;1266$maxrev=$3;1267$minrev=~s/^1\.//if(defined($minrev) );1268$maxrev=~s/^1\.//if(defined($maxrev) );1269$minrev++if(defined($minrev)and$controleq"::");1270}12711272# Grab a handle to the SQLite db and do any necessary updates1273my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1274$updater->update();12751276# if no files were specified, we need to work out what files we should be providing status on ...1277 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12781279# foreach file specified on the commandline ...1280foreachmy$filename( @{$state->{args}} )1281{1282$filename= filecleanup($filename);12831284my$headmeta=$updater->getmeta($filename);12851286my$revisions=$updater->getlog($filename);1287my$totalrevisions=scalar(@$revisions);12881289if(defined($minrev) )1290{1291$log->debug("Removing revisions less than$minrev");1292while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1293{1294pop@$revisions;1295}1296}1297if(defined($maxrev) )1298{1299$log->debug("Removing revisions greater than$maxrev");1300while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1301{1302shift@$revisions;1303}1304}13051306next unless(scalar(@$revisions) );13071308print"M\n";1309print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1310print"M Working file:$filename\n";1311print"M head: 1.$headmeta->{revision}\n";1312print"M branch:\n";1313print"M locks: strict\n";1314print"M access list:\n";1315print"M symbolic names:\n";1316print"M keyword substitution: kv\n";1317print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1318print"M description:\n";13191320foreachmy$revision(@$revisions)1321{1322print"M ----------------------------\n";1323print"M revision 1.$revision->{revision}\n";1324# reformat the date for log output1325$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}) );1326$revision->{author} =~s/\s+.*//;1327$revision->{author} =~s/^(.{8}).*/$1/;1328print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1329my$commitmessage=$updater->commitmessage($revision->{commithash});1330$commitmessage=~s/^/M /mg;1331print$commitmessage."\n";1332}1333print"M =============================================================================\n";1334}13351336print"ok\n";1337}13381339sub req_annotate1340{1341my($cmd,$data) =@_;13421343 argsplit("annotate");13441345$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1346#$log->debug("status state : " . Dumper($state));13471348# Grab a handle to the SQLite db and do any necessary updates1349my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1350$updater->update();13511352# if no files were specified, we need to work out what files we should be providing annotate on ...1353 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);13541355# we'll need a temporary checkout dir1356my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1357my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1358$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");13591360$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1361$ENV{GIT_INDEX_FILE} =$file_index;13621363chdir$tmpdir;13641365# foreach file specified on the commandline ...1366foreachmy$filename( @{$state->{args}} )1367{1368$filename= filecleanup($filename);13691370my$meta=$updater->getmeta($filename);13711372next unless($meta->{revision} );13731374# get all the commits that this file was in1375# in dense format -- aka skip dead revisions1376my$revisions=$updater->gethistorydense($filename);1377my$lastseenin=$revisions->[0][2];13781379# populate the temporary index based on the latest commit were we saw1380# the file -- but do it cheaply without checking out any files1381# TODO: if we got a revision from the client, use that instead1382# to look up the commithash in sqlite (still good to default to1383# the current head as we do now)1384system("git-read-tree",$lastseenin);1385unless($?==0)1386{1387die"Error running git-read-tree$lastseenin$file_index$!";1388}1389$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");13901391# do a checkout of the file1392system('git-checkout-index','-f','-u',$filename);1393unless($?==0) {1394die"Error running git-checkout-index -f -u$filename:$!";1395}13961397$log->info("Annotate$filename");13981399# Prepare a file with the commits from the linearized1400# history that annotate should know about. This prevents1401# git-jsannotate telling us about commits we are hiding1402# from the client.14031404open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1405for(my$i=0;$i<@$revisions;$i++)1406{1407print ANNOTATEHINTS $revisions->[$i][2];1408if($i+1<@$revisions) {# have we got a parent?1409print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1410}1411print ANNOTATEHINTS "\n";1412}14131414print ANNOTATEHINTS "\n";1415close ANNOTATEHINTS;14161417my$annotatecmd='git-annotate';1418open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1419or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1420my$metadata= {};1421print"E Annotations for$filename\n";1422print"E ***************\n";1423while( <ANNOTATE> )1424{1425if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1426{1427my$commithash=$1;1428my$data=$2;1429unless(defined($metadata->{$commithash} ) )1430{1431$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1432$metadata->{$commithash}{author} =~s/\s+.*//;1433$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1434$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1435}1436printf("M 1.%-5d (%-8s%10s):%s\n",1437$metadata->{$commithash}{revision},1438$metadata->{$commithash}{author},1439$metadata->{$commithash}{modified},1440$data1441);1442}else{1443$log->warn("Error in annotate output! LINE:$_");1444print"E Annotate error\n";1445next;1446}1447}1448close ANNOTATE;1449}14501451# done; get out of the tempdir1452chdir"/";14531454print"ok\n";14551456}14571458# This method takes the state->{arguments} array and produces two new arrays.1459# The first is $state->{args} which is everything before the '--' argument, and1460# the second is $state->{files} which is everything after it.1461sub argsplit1462{1463return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");14641465my$type=shift;14661467$state->{args} = [];1468$state->{files} = [];1469$state->{opt} = {};14701471if(defined($type) )1472{1473my$opt= {};1474$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");1475$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1476$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");1477$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1478$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1479$opt= { k =>1, m =>1}if($typeeq"add");1480$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1481$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");148214831484while(scalar( @{$state->{arguments}} ) >0)1485{1486my$arg=shift@{$state->{arguments}};14871488next if($argeq"--");1489next unless($arg=~/\S/);14901491# if the argument looks like a switch1492if($arg=~/^-(\w)(.*)/)1493{1494# if it's a switch that takes an argument1495if($opt->{$1} )1496{1497# If this switch has already been provided1498if($opt->{$1} >1and exists($state->{opt}{$1} ) )1499{1500$state->{opt}{$1} = [$state->{opt}{$1} ];1501if(length($2) >0)1502{1503push@{$state->{opt}{$1}},$2;1504}else{1505push@{$state->{opt}{$1}},shift@{$state->{arguments}};1506}1507}else{1508# if there's extra data in the arg, use that as the argument for the switch1509if(length($2) >0)1510{1511$state->{opt}{$1} =$2;1512}else{1513$state->{opt}{$1} =shift@{$state->{arguments}};1514}1515}1516}else{1517$state->{opt}{$1} =undef;1518}1519}1520else1521{1522push@{$state->{args}},$arg;1523}1524}1525}1526else1527{1528my$mode=0;15291530foreachmy$value( @{$state->{arguments}} )1531{1532if($valueeq"--")1533{1534$mode++;1535next;1536}1537push@{$state->{args}},$valueif($mode==0);1538push@{$state->{files}},$valueif($mode==1);1539}1540}1541}15421543# This method uses $state->{directory} to populate $state->{args} with a list of filenames1544sub argsfromdir1545{1546my$updater=shift;15471548$state->{args} = [];15491550foreachmy$file( @{$updater->gethead} )1551{1552next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1553next unless($file->{name} =~s/^$state->{directory}//);1554push@{$state->{args}},$file->{name};1555}1556}15571558# This method cleans up the $state variable after a command that uses arguments has run1559sub statecleanup1560{1561$state->{files} = [];1562$state->{args} = [];1563$state->{arguments} = [];1564$state->{entries} = {};1565}15661567sub revparse1568{1569my$filename=shift;15701571returnundefunless(defined($state->{entries}{$filename}{revision} ) );15721573return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1574return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);15751576returnundef;1577}15781579# This method takes a file hash and does a CVS "file transfer" which transmits the1580# size of the file, and then the file contents.1581# If a second argument $targetfile is given, the file is instead written out to1582# a file by the name of $targetfile1583sub transmitfile1584{1585my$filehash=shift;1586my$targetfile=shift;15871588if(defined($filehash)and$filehasheq"deleted")1589{1590$log->warn("filehash is 'deleted'");1591return;1592}15931594die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);15951596my$type=`git-cat-file -t$filehash`;1597 chomp$type;15981599 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );16001601 my$size= `git-cat-file -s $filehash`;1602chomp$size;16031604$log->debug("transmitfile($filehash) size=$size, type=$type");16051606if(open my$fh,'-|',"git-cat-file","blob",$filehash)1607{1608if(defined($targetfile) )1609{1610open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1611print NEWFILE $_while( <$fh> );1612close NEWFILE;1613}else{1614print"$size\n";1615printwhile( <$fh> );1616}1617close$fhor die("Couldn't close filehandle for transmitfile()");1618}else{1619die("Couldn't execute git-cat-file");1620}1621}16221623# This method takes a file name, and returns ( $dirpart, $filepart ) which1624# refers to the directory porition and the file portion of the filename1625# respectively1626sub filenamesplit1627{1628my$filename=shift;16291630my($filepart,$dirpart) = ($filename,".");1631($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1632$dirpart.="/";16331634return($filepart,$dirpart);1635}16361637sub filecleanup1638{1639my$filename=shift;16401641returnundefunless(defined($filename));1642if($filename=~/^\// )1643{1644print"E absolute filenames '$filename' not supported by server\n";1645returnundef;1646}16471648$filename=~s/^\.\///g;1649$filename=$state->{directory} .$filename;16501651return$filename;1652}16531654package GITCVS::log;16551656####1657#### Copyright The Open University UK - 2006.1658####1659#### Authors: Martyn Smith <martyn@catalyst.net.nz>1660#### Martin Langhoff <martin@catalyst.net.nz>1661####1662####16631664use strict;1665use warnings;16661667=head1 NAME16681669GITCVS::log16701671=head1 DESCRIPTION16721673This module provides very crude logging with a similar interface to1674Log::Log4perl16751676=head1 METHODS16771678=cut16791680=head2 new16811682Creates a new log object, optionally you can specify a filename here to1683indicate the file to log to. If no log file is specified, you can specifiy one1684later with method setfile, or indicate you no longer want logging with method1685nofile.16861687Until one of these methods is called, all log calls will buffer messages ready1688to write out.16891690=cut1691sub new1692{1693my$class=shift;1694my$filename=shift;16951696my$self= {};16971698bless$self,$class;16991700if(defined($filename) )1701{1702open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1703}17041705return$self;1706}17071708=head2 setfile17091710This methods takes a filename, and attempts to open that file as the log file.1711If successful, all buffered data is written out to the file, and any further1712logging is written directly to the file.17131714=cut1715sub setfile1716{1717my$self=shift;1718my$filename=shift;17191720if(defined($filename) )1721{1722open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1723}17241725return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");17261727while(my$line=shift@{$self->{buffer}} )1728{1729print{$self->{fh}}$line;1730}1731}17321733=head2 nofile17341735This method indicates no logging is going to be used. It flushes any entries in1736the internal buffer, and sets a flag to ensure no further data is put there.17371738=cut1739sub nofile1740{1741my$self=shift;17421743$self->{nolog} =1;17441745return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");17461747$self->{buffer} = [];1748}17491750=head2 _logopen17511752Internal method. Returns true if the log file is open, false otherwise.17531754=cut1755sub _logopen1756{1757my$self=shift;17581759return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1760return0;1761}17621763=head2 debug info warn fatal17641765These four methods are wrappers to _log. They provide the actual interface for1766logging data.17671768=cut1769sub debug {my$self=shift;$self->_log("debug",@_); }1770sub info {my$self=shift;$self->_log("info",@_); }1771subwarn{my$self=shift;$self->_log("warn",@_); }1772sub fatal {my$self=shift;$self->_log("fatal",@_); }17731774=head2 _log17751776This is an internal method called by the logging functions. It generates a1777timestamp and pushes the logged line either to file, or internal buffer.17781779=cut1780sub _log1781{1782my$self=shift;1783my$level=shift;17841785return if($self->{nolog} );17861787my@time=localtime;1788my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1789$time[5] +1900,1790$time[4] +1,1791$time[3],1792$time[2],1793$time[1],1794$time[0],1795uc$level,1796);17971798if($self->_logopen)1799{1800print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1801}else{1802push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1803}1804}18051806=head2 DESTROY18071808This method simply closes the file handle if one is open18091810=cut1811sub DESTROY1812{1813my$self=shift;18141815if($self->_logopen)1816{1817close$self->{fh};1818}1819}18201821package GITCVS::updater;18221823####1824#### Copyright The Open University UK - 2006.1825####1826#### Authors: Martyn Smith <martyn@catalyst.net.nz>1827#### Martin Langhoff <martin@catalyst.net.nz>1828####1829####18301831use strict;1832use warnings;1833use DBI;18341835=head1 METHODS18361837=cut18381839=head2 new18401841=cut1842sub new1843{1844my$class=shift;1845my$config=shift;1846my$module=shift;1847my$log=shift;18481849die"Need to specify a git repository"unless(defined($config)and-d $config);1850die"Need to specify a module"unless(defined($module) );18511852$class=ref($class) ||$class;18531854my$self= {};18551856bless$self,$class;18571858$self->{dbdir} =$config."/";1859die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );18601861$self->{module} =$module;1862$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";18631864$self->{git_path} =$config."/";18651866$self->{log} =$log;18671868die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );18691870$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");18711872$self->{tables} = {};1873foreachmy$table($self->{dbh}->tables)1874{1875$table=~s/^"//;1876$table=~s/"$//;1877$self->{tables}{$table} =1;1878}18791880# Construct the revision table if required1881unless($self->{tables}{revision} )1882{1883$self->{dbh}->do("1884 CREATE TABLE revision (1885 name TEXT NOT NULL,1886 revision INTEGER NOT NULL,1887 filehash TEXT NOT NULL,1888 commithash TEXT NOT NULL,1889 author TEXT NOT NULL,1890 modified TEXT NOT NULL,1891 mode TEXT NOT NULL1892 )1893 ");1894}18951896# Construct the revision table if required1897unless($self->{tables}{head} )1898{1899$self->{dbh}->do("1900 CREATE TABLE head (1901 name TEXT NOT NULL,1902 revision INTEGER NOT NULL,1903 filehash TEXT NOT NULL,1904 commithash TEXT NOT NULL,1905 author TEXT NOT NULL,1906 modified TEXT NOT NULL,1907 mode TEXT NOT NULL1908 )1909 ");1910}19111912# Construct the properties table if required1913unless($self->{tables}{properties} )1914{1915$self->{dbh}->do("1916 CREATE TABLE properties (1917 key TEXT NOT NULL PRIMARY KEY,1918 value TEXT1919 )1920 ");1921}19221923# Construct the commitmsgs table if required1924unless($self->{tables}{commitmsgs} )1925{1926$self->{dbh}->do("1927 CREATE TABLE commitmsgs (1928 key TEXT NOT NULL PRIMARY KEY,1929 value TEXT1930 )1931 ");1932}19331934return$self;1935}19361937=head2 update19381939=cut1940sub update1941{1942my$self=shift;19431944# first lets get the commit list1945$ENV{GIT_DIR} =$self->{git_path};19461947# prepare database queries1948my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);1949my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);1950my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);1951my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);19521953my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;1954unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)1955{1956die("Invalid module '$self->{module}'");1957}195819591960my$git_log;1961my$lastcommit=$self->_get_prop("last_commit");19621963# Start exclusive lock here...1964$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";19651966# TODO: log processing is memory bound1967# if we can parse into a 2nd file that is in reverse order1968# we can probably do something really efficient1969my@git_log_params= ('--parents','--topo-order');19701971if(defined$lastcommit) {1972push@git_log_params,"$lastcommit..$self->{module}";1973}else{1974push@git_log_params,$self->{module};1975}1976open(GITLOG,'-|','git-log',@git_log_params)or die"Cannot call git-log:$!";19771978my@commits;19791980my%commit= ();19811982while( <GITLOG> )1983{1984chomp;1985if(m/^commit\s+(.*)$/) {1986# on ^commit lines put the just seen commit in the stack1987# and prime things for the next one1988if(keys%commit) {1989my%copy=%commit;1990unshift@commits, \%copy;1991%commit= ();1992}1993my@parents=split(m/\s+/,$1);1994$commit{hash} =shift@parents;1995$commit{parents} = \@parents;1996}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {1997# on rfc822-like lines seen before we see any message,1998# lowercase the entry and put it in the hash as key-value1999$commit{lc($1)} =$2;2000}else{2001# message lines - skip initial empty line2002# and trim whitespace2003if(!exists($commit{message}) &&m/^\s*$/) {2004# define it to mark the end of headers2005$commit{message} ='';2006next;2007}2008s/^\s+//;s/\s+$//;# trim ws2009$commit{message} .=$_."\n";2010}2011}2012close GITLOG;20132014unshift@commits, \%commitif(keys%commit);20152016# Now all the commits are in the @commits bucket2017# ordered by time DESC. for each commit that needs processing,2018# determine whether it's following the last head we've seen or if2019# it's on its own branch, grab a file list, and add whatever's changed2020# NOTE: $lastcommit refers to the last commit from previous run2021# $lastpicked is the last commit we picked in this run2022my$lastpicked;2023my$head= {};2024if(defined$lastcommit) {2025$lastpicked=$lastcommit;2026}20272028my$committotal=scalar(@commits);2029my$commitcount=0;20302031# Load the head table into $head (for cached lookups during the update process)2032foreachmy$file( @{$self->gethead()} )2033{2034$head->{$file->{name}} =$file;2035}20362037foreachmy$commit(@commits)2038{2039$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2040if(defined$lastpicked)2041{2042if(!in_array($lastpicked, @{$commit->{parents}}))2043{2044# skip, we'll see this delta2045# as part of a merge later2046# warn "skipping off-track $commit->{hash}\n";2047next;2048}elsif(@{$commit->{parents}} >1) {2049# it is a merge commit, for each parent that is2050# not $lastpicked, see if we can get a log2051# from the merge-base to that parent to put it2052# in the message as a merge summary.2053my@parents= @{$commit->{parents}};2054foreachmy$parent(@parents) {2055# git-merge-base can potentially (but rarely) throw2056# several candidate merge bases. let's assume2057# that the first one is the best one.2058if($parenteq$lastpicked) {2059next;2060}2061open my$p,'git-merge-base '.$lastpicked.' '2062.$parent.'|';2063my@output= (<$p>);2064close$p;2065my$base=join('',@output);2066chomp$base;2067if($base) {2068my@merged;2069# print "want to log between $base $parent \n";2070open(GITLOG,'-|','git-log',"$base..$parent")2071or die"Cannot call git-log:$!";2072my$mergedhash;2073while(<GITLOG>) {2074chomp;2075if(!defined$mergedhash) {2076if(m/^commit\s+(.+)$/) {2077$mergedhash=$1;2078}else{2079next;2080}2081}else{2082# grab the first line that looks non-rfc8222083# aka has content after leading space2084if(m/^\s+(\S.*)$/) {2085my$title=$1;2086$title=substr($title,0,100);# truncate2087unshift@merged,"$mergedhash$title";2088undef$mergedhash;2089}2090}2091}2092close GITLOG;2093if(@merged) {2094$commit->{mergemsg} =$commit->{message};2095$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2096foreachmy$summary(@merged) {2097$commit->{mergemsg} .="\t$summary\n";2098}2099$commit->{mergemsg} .="\n\n";2100# print "Message for $commit->{hash} \n$commit->{mergemsg}";2101}2102}2103}2104}2105}21062107# convert the date to CVS-happy format2108$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);21092110if(defined($lastpicked) )2111{2112my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2113while( <FILELIST> )2114{2115unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2116{2117die("Couldn't process git-diff-tree line :$_");2118}21192120# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");21212122my$git_perms="";2123$git_perms.="r"if($1&4);2124$git_perms.="w"if($1&2);2125$git_perms.="x"if($1&1);2126$git_perms="rw"if($git_permseq"");21272128if($3eq"D")2129{2130#$log->debug("DELETE $4");2131$head->{$4} = {2132 name =>$4,2133 revision =>$head->{$4}{revision} +1,2134 filehash =>"deleted",2135 commithash =>$commit->{hash},2136 modified =>$commit->{date},2137 author =>$commit->{author},2138 mode =>$git_perms,2139};2140$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2141}2142elsif($3eq"M")2143{2144#$log->debug("MODIFIED $4");2145$head->{$4} = {2146 name =>$4,2147 revision =>$head->{$4}{revision} +1,2148 filehash =>$2,2149 commithash =>$commit->{hash},2150 modified =>$commit->{date},2151 author =>$commit->{author},2152 mode =>$git_perms,2153};2154$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2155}2156elsif($3eq"A")2157{2158#$log->debug("ADDED $4");2159$head->{$4} = {2160 name =>$4,2161 revision =>1,2162 filehash =>$2,2163 commithash =>$commit->{hash},2164 modified =>$commit->{date},2165 author =>$commit->{author},2166 mode =>$git_perms,2167};2168$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2169}2170else2171{2172$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2173die;2174}2175}2176close FILELIST;2177}else{2178# this is used to detect files removed from the repo2179my$seen_files= {};21802181my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2182while( <FILELIST> )2183{2184unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2185{2186die("Couldn't process git-ls-tree line :$_");2187}21882189my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);21902191$seen_files->{$git_filename} =1;21922193my($oldhash,$oldrevision,$oldmode) = (2194$head->{$git_filename}{filehash},2195$head->{$git_filename}{revision},2196$head->{$git_filename}{mode}2197);21982199if($git_perms=~/^\d\d\d(\d)\d\d/o)2200{2201$git_perms="";2202$git_perms.="r"if($1&4);2203$git_perms.="w"if($1&2);2204$git_perms.="x"if($1&1);2205}else{2206$git_perms="rw";2207}22082209# unless the file exists with the same hash, we need to update it ...2210unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2211{2212my$newrevision= ($oldrevisionor0) +1;22132214$head->{$git_filename} = {2215 name =>$git_filename,2216 revision =>$newrevision,2217 filehash =>$git_hash,2218 commithash =>$commit->{hash},2219 modified =>$commit->{date},2220 author =>$commit->{author},2221 mode =>$git_perms,2222};222322242225$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2226}2227}2228close FILELIST;22292230# Detect deleted files2231foreachmy$file(keys%$head)2232{2233unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2234{2235$head->{$file}{revision}++;2236$head->{$file}{filehash} ="deleted";2237$head->{$file}{commithash} =$commit->{hash};2238$head->{$file}{modified} =$commit->{date};2239$head->{$file}{author} =$commit->{author};22402241$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2242}2243}2244# END : "Detect deleted files"2245}224622472248if(exists$commit->{mergemsg})2249{2250$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2251}22522253$lastpicked=$commit->{hash};22542255$self->_set_prop("last_commit",$commit->{hash});2256}22572258$db_delete_head->execute();2259foreachmy$file(keys%$head)2260{2261$db_insert_head->execute(2262$file,2263$head->{$file}{revision},2264$head->{$file}{filehash},2265$head->{$file}{commithash},2266$head->{$file}{modified},2267$head->{$file}{author},2268$head->{$file}{mode},2269);2270}2271# invalidate the gethead cache2272$self->{gethead_cache} =undef;227322742275# Ending exclusive lock here2276$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2277}22782279sub _headrev2280{2281my$self=shift;2282my$filename=shift;22832284my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2285$db_query->execute($filename);2286my($hash,$revision,$mode) =$db_query->fetchrow_array;22872288return($hash,$revision,$mode);2289}22902291sub _get_prop2292{2293my$self=shift;2294my$key=shift;22952296my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2297$db_query->execute($key);2298my($value) =$db_query->fetchrow_array;22992300return$value;2301}23022303sub _set_prop2304{2305my$self=shift;2306my$key=shift;2307my$value=shift;23082309my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2310$db_query->execute($value,$key);23112312unless($db_query->rows)2313{2314$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2315$db_query->execute($key,$value);2316}23172318return$value;2319}23202321=head2 gethead23222323=cut23242325sub gethead2326{2327my$self=shift;23282329return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );23302331my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);2332$db_query->execute();23332334my$tree= [];2335while(my$file=$db_query->fetchrow_hashref)2336{2337push@$tree,$file;2338}23392340$self->{gethead_cache} =$tree;23412342return$tree;2343}23442345=head2 getlog23462347=cut23482349sub getlog2350{2351my$self=shift;2352my$filename=shift;23532354my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2355$db_query->execute($filename);23562357my$tree= [];2358while(my$file=$db_query->fetchrow_hashref)2359{2360push@$tree,$file;2361}23622363return$tree;2364}23652366=head2 getmeta23672368This function takes a filename (with path) argument and returns a hashref of2369metadata for that file.23702371=cut23722373sub getmeta2374{2375my$self=shift;2376my$filename=shift;2377my$revision=shift;23782379my$db_query;2380if(defined($revision)and$revision=~/^\d+$/)2381{2382$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2383$db_query->execute($filename,$revision);2384}2385elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2386{2387$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2388$db_query->execute($filename,$revision);2389}else{2390$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2391$db_query->execute($filename);2392}23932394return$db_query->fetchrow_hashref;2395}23962397=head2 commitmessage23982399this function takes a commithash and returns the commit message for that commit24002401=cut2402sub commitmessage2403{2404my$self=shift;2405my$commithash=shift;24062407die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);24082409my$db_query;2410$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2411$db_query->execute($commithash);24122413my($message) =$db_query->fetchrow_array;24142415if(defined($message) )2416{2417$message.=" "if($message=~/\n$/);2418return$message;2419}24202421my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2422shift@lineswhile($lines[0] =~/\S/);2423$message=join("",@lines);2424$message.=" "if($message=~/\n$/);2425return$message;2426}24272428=head2 gethistory24292430This function takes a filename (with path) argument and returns an arrayofarrays2431containing revision,filehash,commithash ordered by revision descending24322433=cut2434sub gethistory2435{2436my$self=shift;2437my$filename=shift;24382439my$db_query;2440$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2441$db_query->execute($filename);24422443return$db_query->fetchall_arrayref;2444}24452446=head2 gethistorydense24472448This function takes a filename (with path) argument and returns an arrayofarrays2449containing revision,filehash,commithash ordered by revision descending.24502451This version of gethistory skips deleted entries -- so it is useful for annotate.2452The 'dense' part is a reference to a '--dense' option available for git-rev-list2453and other git tools that depend on it.24542455=cut2456sub gethistorydense2457{2458my$self=shift;2459my$filename=shift;24602461my$db_query;2462$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2463$db_query->execute($filename);24642465return$db_query->fetchall_arrayref;2466}24672468=head2 in_array()24692470from Array::PAT - mimics the in_array() function2471found in PHP. Yuck but works for small arrays.24722473=cut2474sub in_array2475{2476my($check,@array) =@_;2477my$retval=0;2478foreachmy$test(@array){2479if($checkeq$test){2480$retval=1;2481}2482}2483return$retval;2484}24852486=head2 safe_pipe_capture24872488an alterative to `command` that allows input to be passed as an array2489to work around shell problems with weird characters in arguments24902491=cut2492sub safe_pipe_capture {24932494my@output;24952496if(my$pid=open my$child,'-|') {2497@output= (<$child>);2498close$childor die join(' ',@_).":$!$?";2499}else{2500exec(@_)or die"$!$?";# exec() can fail the executable can't be found2501}2502returnwantarray?@output:join('',@output);2503}2504250525061;