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} ."/"; 142unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 143print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 144print"E\n"; 145print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 146return0; 147} 148 149my@gitvars=`git-var -l`; 150if($?) { 151print"E problems executing git-var on the server -- this is not a git repository or the PATH is not set correcly.\n"; 152print"E\n"; 153print"error 1 - problem executing git-var\n"; 154return0; 155} 156foreachmy$line(@gitvars) 157{ 158next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 159$cfg->{$1}{$2} =$3; 160} 161 162unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 163{ 164print"E GITCVS emulation needs to be enabled on this repo\n"; 165print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 166print"E\n"; 167print"error 1 GITCVS emulation disabled\n"; 168} 169 170if(defined($cfg->{gitcvs}{logfile} ) ) 171{ 172$log->setfile($cfg->{gitcvs}{logfile}); 173}else{ 174$log->nofile(); 175} 176} 177 178# Global_option option \n 179# Response expected: no. Transmit one of the global options `-q', `-Q', 180# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 181# variations (such as combining of options) are allowed. For graceful 182# handling of valid-requests, it is probably better to make new global 183# options separate requests, rather than trying to add them to this 184# request. 185sub req_Globaloption 186{ 187my($cmd,$data) =@_; 188$log->debug("req_Globaloption :$data"); 189 190# TODO : is this data useful ??? 191} 192 193# Valid-responses request-list \n 194# Response expected: no. Tell the server what responses the client will 195# accept. request-list is a space separated list of tokens. 196sub req_Validresponses 197{ 198my($cmd,$data) =@_; 199$log->debug("req_Validrepsonses :$data"); 200 201# TODO : re-enable this, currently it's not particularly useful 202#$state->{validresponses} = [ split /\s+/, $data ]; 203} 204 205# valid-requests \n 206# Response expected: yes. Ask the server to send back a Valid-requests 207# response. 208sub req_validrequests 209{ 210my($cmd,$data) =@_; 211 212$log->debug("req_validrequests"); 213 214$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 215$log->debug("SEND : ok"); 216 217print"Valid-requests ".join(" ",keys%$methods) ."\n"; 218print"ok\n"; 219} 220 221# Directory local-directory \n 222# Additional data: repository \n. Response expected: no. Tell the server 223# what directory to use. The repository should be a directory name from a 224# previous server response. Note that this both gives a default for Entry 225# and Modified and also for ci and the other commands; normal usage is to 226# send Directory for each directory in which there will be an Entry or 227# Modified, and then a final Directory for the original directory, then the 228# command. The local-directory is relative to the top level at which the 229# command is occurring (i.e. the last Directory which is sent before the 230# command); to indicate that top level, `.' should be sent for 231# local-directory. 232sub req_Directory 233{ 234my($cmd,$data) =@_; 235 236my$repository= <STDIN>; 237chomp$repository; 238 239 240$state->{localdir} =$data; 241$state->{repository} =$repository; 242$state->{directory} =$repository; 243$state->{directory} =~s/^$state->{CVSROOT}\///; 244$state->{module} =$1if($state->{directory} =~s/^(.*?)(\/|$)//); 245$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 246 247$log->debug("req_Directory : localdir=$datarepository=$repositorydirectory=$state->{directory} module=$state->{module}"); 248} 249 250# Entry entry-line \n 251# Response expected: no. Tell the server what version of a file is on the 252# local machine. The name in entry-line is a name relative to the directory 253# most recently specified with Directory. If the user is operating on only 254# some files in a directory, Entry requests for only those files need be 255# included. If an Entry request is sent without Modified, Is-modified, or 256# Unchanged, it means the file is lost (does not exist in the working 257# directory). If both Entry and one of Modified, Is-modified, or Unchanged 258# are sent for the same file, Entry must be sent first. For a given file, 259# one can send Modified, Is-modified, or Unchanged, but not more than one 260# of these three. 261sub req_Entry 262{ 263my($cmd,$data) =@_; 264 265$log->debug("req_Entry :$data"); 266 267my@data=split(/\//,$data); 268 269$state->{entries}{$state->{directory}.$data[1]} = { 270 revision =>$data[2], 271 conflict =>$data[3], 272 options =>$data[4], 273 tag_or_date =>$data[5], 274}; 275} 276 277# add \n 278# Response expected: yes. Add a file or directory. This uses any previous 279# Argument, Directory, Entry, or Modified requests, if they have been sent. 280# The last Directory sent specifies the working directory at the time of 281# the operation. To add a directory, send the directory to be added using 282# Directory and Argument requests. 283sub req_add 284{ 285my($cmd,$data) =@_; 286 287 argsplit("add"); 288 289my$addcount=0; 290 291foreachmy$filename( @{$state->{args}} ) 292{ 293$filename= filecleanup($filename); 294 295unless(defined($state->{entries}{$filename}{modified_filename} ) ) 296{ 297print"E cvs add: nothing known about `$filename'\n"; 298next; 299} 300# TODO : check we're not squashing an already existing file 301if(defined($state->{entries}{$filename}{revision} ) ) 302{ 303print"E cvs add: `$filename' has already been entered\n"; 304next; 305} 306 307 308my($filepart,$dirpart) = filenamesplit($filename); 309 310print"E cvs add: scheduling file `$filename' for addition\n"; 311 312print"Checked-in$dirpart\n"; 313print"$filename\n"; 314print"/$filepart/0///\n"; 315 316$addcount++; 317} 318 319if($addcount==1) 320{ 321print"E cvs add: use `cvs commit' to add this file permanently\n"; 322} 323elsif($addcount>1) 324{ 325print"E cvs add: use `cvs commit' to add these files permanently\n"; 326} 327 328print"ok\n"; 329} 330 331# remove \n 332# Response expected: yes. Remove a file. This uses any previous Argument, 333# Directory, Entry, or Modified requests, if they have been sent. The last 334# Directory sent specifies the working directory at the time of the 335# operation. Note that this request does not actually do anything to the 336# repository; the only effect of a successful remove request is to supply 337# the client with a new entries line containing `-' to indicate a removed 338# file. In fact, the client probably could perform this operation without 339# contacting the server, although using remove may cause the server to 340# perform a few more checks. The client sends a subsequent ci request to 341# actually record the removal in the repository. 342sub req_remove 343{ 344my($cmd,$data) =@_; 345 346 argsplit("remove"); 347 348# Grab a handle to the SQLite db and do any necessary updates 349my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 350$updater->update(); 351 352#$log->debug("add state : " . Dumper($state)); 353 354my$rmcount=0; 355 356foreachmy$filename( @{$state->{args}} ) 357{ 358$filename= filecleanup($filename); 359 360if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 361{ 362print"E cvs remove: file `$filename' still in working directory\n"; 363next; 364} 365 366my$meta=$updater->getmeta($filename); 367my$wrev= revparse($filename); 368 369unless(defined($wrev) ) 370{ 371print"E cvs remove: nothing known about `$filename'\n"; 372next; 373} 374 375if(defined($wrev)and$wrev<0) 376{ 377print"E cvs remove: file `$filename' already scheduled for removal\n"; 378next; 379} 380 381unless($wrev==$meta->{revision} ) 382{ 383# TODO : not sure if the format of this message is quite correct. 384print"E cvs remove: Up to date check failed for `$filename'\n"; 385next; 386} 387 388 389my($filepart,$dirpart) = filenamesplit($filename); 390 391print"E cvs remove: scheduling `$filename' for removal\n"; 392 393print"Checked-in$dirpart\n"; 394print"$filename\n"; 395print"/$filepart/-1.$wrev///\n"; 396 397$rmcount++; 398} 399 400if($rmcount==1) 401{ 402print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 403} 404elsif($rmcount>1) 405{ 406print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 407} 408 409print"ok\n"; 410} 411 412# Modified filename \n 413# Response expected: no. Additional data: mode, \n, file transmission. Send 414# the server a copy of one locally modified file. filename is a file within 415# the most recent directory sent with Directory; it must not contain `/'. 416# If the user is operating on only some files in a directory, only those 417# files need to be included. This can also be sent without Entry, if there 418# is no entry for the file. 419sub req_Modified 420{ 421my($cmd,$data) =@_; 422 423my$mode= <STDIN>; 424chomp$mode; 425my$size= <STDIN>; 426chomp$size; 427 428# Grab config information 429my$blocksize=8192; 430my$bytesleft=$size; 431my$tmp; 432 433# Get a filehandle/name to write it to 434my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 435 436# Loop over file data writing out to temporary file. 437while($bytesleft) 438{ 439$blocksize=$bytesleftif($bytesleft<$blocksize); 440read STDIN,$tmp,$blocksize; 441print$fh $tmp; 442$bytesleft-=$blocksize; 443} 444 445close$fh; 446 447# Ensure we have something sensible for the file mode 448if($mode=~/u=(\w+)/) 449{ 450$mode=$1; 451}else{ 452$mode="rw"; 453} 454 455# Save the file data in $state 456$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 457$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 458$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 459$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 460 461 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 462} 463 464# Unchanged filename\n 465# Response expected: no. Tell the server that filename has not been 466# modified in the checked out directory. The filename is a file within the 467# most recent directory sent with Directory; it must not contain `/'. 468sub req_Unchanged 469{ 470 my ($cmd,$data) =@_; 471 472$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 473 474 #$log->debug("req_Unchanged :$data"); 475} 476 477# Questionable filename\n 478# Response expected: no. Additional data: no. 479# Tell the server to check whether filename should be ignored, 480# and if not, next time the server sends responses, send (in 481# a M response) `?' followed by the directory and filename. 482# filename must not contain `/'; it needs to be a file in the 483# directory named by the most recent Directory request. 484sub req_Questionable 485{ 486my($cmd,$data) =@_; 487 488$state->{entries}{$state->{directory}.$data}{questionable} =1; 489 490#$log->debug("req_Questionable : $data"); 491} 492 493# Argument text \n 494# Response expected: no. Save argument for use in a subsequent command. 495# Arguments accumulate until an argument-using command is given, at which 496# point they are forgotten. 497# Argumentx text \n 498# Response expected: no. Append \n followed by text to the current argument 499# being saved. 500sub req_Argument 501{ 502my($cmd,$data) =@_; 503 504# TODO : Not quite sure how Argument and Argumentx differ, but I assume 505# it's for multi-line arguments ... somehow ... 506 507$log->debug("$cmd:$data"); 508 509push@{$state->{arguments}},$data; 510} 511 512# expand-modules \n 513# Response expected: yes. Expand the modules which are specified in the 514# arguments. Returns the data in Module-expansion responses. Note that the 515# server can assume that this is checkout or export, not rtag or rdiff; the 516# latter do not access the working directory and thus have no need to 517# expand modules on the client side. Expand may not be the best word for 518# what this request does. It does not necessarily tell you all the files 519# contained in a module, for example. Basically it is a way of telling you 520# which working directories the server needs to know about in order to 521# handle a checkout of the specified modules. For example, suppose that the 522# server has a module defined by 523# aliasmodule -a 1dir 524# That is, one can check out aliasmodule and it will take 1dir in the 525# repository and check it out to 1dir in the working directory. Now suppose 526# the client already has this module checked out and is planning on using 527# the co request to update it. Without using expand-modules, the client 528# would have two bad choices: it could either send information about all 529# working directories under the current directory, which could be 530# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 531# stands for 1dir, and neglect to send information for 1dir, which would 532# lead to incorrect operation. With expand-modules, the client would first 533# ask for the module to be expanded: 534sub req_expandmodules 535{ 536my($cmd,$data) =@_; 537 538 argsplit(); 539 540$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 541 542unless(ref$state->{arguments}eq"ARRAY") 543{ 544print"ok\n"; 545return; 546} 547 548foreachmy$module( @{$state->{arguments}} ) 549{ 550$log->debug("SEND : Module-expansion$module"); 551print"Module-expansion$module\n"; 552} 553 554print"ok\n"; 555 statecleanup(); 556} 557 558# co \n 559# Response expected: yes. Get files from the repository. This uses any 560# previous Argument, Directory, Entry, or Modified requests, if they have 561# been sent. Arguments to this command are module names; the client cannot 562# know what directories they correspond to except by (1) just sending the 563# co request, and then seeing what directory names the server sends back in 564# its responses, and (2) the expand-modules request. 565sub req_co 566{ 567my($cmd,$data) =@_; 568 569 argsplit("co"); 570 571my$module=$state->{args}[0]; 572my$checkout_path=$module; 573 574# use the user specified directory if we're given it 575$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 576 577$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 578 579$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 580 581$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 582 583# Grab a handle to the SQLite db and do any necessary updates 584my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 585$updater->update(); 586 587$checkout_path=~ s|/$||;# get rid of trailing slashes 588 589# Eclipse seems to need the Clear-sticky command 590# to prepare the 'Entries' file for the new directory. 591print"Clear-sticky$checkout_path/\n"; 592print$state->{CVSROOT} ."/$module/\n"; 593print"Clear-static-directory$checkout_path/\n"; 594print$state->{CVSROOT} ."/$module/\n"; 595print"Clear-sticky$checkout_path/\n";# yes, twice 596print$state->{CVSROOT} ."/$module/\n"; 597print"Template$checkout_path/\n"; 598print$state->{CVSROOT} ."/$module/\n"; 599print"0\n"; 600 601# instruct the client that we're checking out to $checkout_path 602print"E cvs checkout: Updating$checkout_path\n"; 603 604my%seendirs= (); 605my$lastdir=''; 606 607# recursive 608sub prepdir { 609my($dir,$repodir,$remotedir,$seendirs) =@_; 610my$parent= dirname($dir); 611$dir=~ s|/+$||; 612$repodir=~ s|/+$||; 613$remotedir=~ s|/+$||; 614$parent=~ s|/+$||; 615$log->debug("announcedir$dir,$repodir,$remotedir"); 616 617if($parenteq'.'||$parenteq'./') { 618$parent=''; 619} 620# recurse to announce unseen parents first 621if(length($parent) && !exists($seendirs->{$parent})) { 622 prepdir($parent,$repodir,$remotedir,$seendirs); 623} 624# Announce that we are going to modify at the parent level 625if($parent) { 626print"E cvs checkout: Updating$remotedir/$parent\n"; 627}else{ 628print"E cvs checkout: Updating$remotedir\n"; 629} 630print"Clear-sticky$remotedir/$parent/\n"; 631print"$repodir/$parent/\n"; 632 633print"Clear-static-directory$remotedir/$dir/\n"; 634print"$repodir/$dir/\n"; 635print"Clear-sticky$remotedir/$parent/\n";# yes, twice 636print"$repodir/$parent/\n"; 637print"Template$remotedir/$dir/\n"; 638print"$repodir/$dir/\n"; 639print"0\n"; 640 641$seendirs->{$dir} =1; 642} 643 644foreachmy$git( @{$updater->gethead} ) 645{ 646# Don't want to check out deleted files 647next if($git->{filehash}eq"deleted"); 648 649($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 650 651if(length($git->{dir}) &&$git->{dir}ne'./' 652&&$git->{dir}ne$lastdir) { 653unless(exists($seendirs{$git->{dir}})) { 654 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 655$checkout_path, \%seendirs); 656$lastdir=$git->{dir}; 657$seendirs{$git->{dir}} =1; 658} 659print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 660} 661 662# modification time of this file 663print"Mod-time$git->{modified}\n"; 664 665# print some information to the client 666if(defined($git->{dir} )and$git->{dir}ne"./") 667{ 668print"M U$checkout_path/$git->{dir}$git->{name}\n"; 669}else{ 670print"M U$checkout_path/$git->{name}\n"; 671} 672 673# instruct client we're sending a file to put in this path 674print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 675 676print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 677 678# this is an "entries" line 679print"/$git->{name}/1.$git->{revision}///\n"; 680# permissions 681print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 682 683# transmit file 684 transmitfile($git->{filehash}); 685} 686 687print"ok\n"; 688 689 statecleanup(); 690} 691 692# update \n 693# Response expected: yes. Actually do a cvs update command. This uses any 694# previous Argument, Directory, Entry, or Modified requests, if they have 695# been sent. The last Directory sent specifies the working directory at the 696# time of the operation. The -I option is not used--files which the client 697# can decide whether to ignore are not mentioned and the client sends the 698# Questionable request for others. 699sub req_update 700{ 701my($cmd,$data) =@_; 702 703$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 704 705 argsplit("update"); 706 707# 708# It may just be a client exploring the available heads/modukles 709# in that case, list them as top level directories and leave it 710# at that. Eclipse uses this technique to offer you a list of 711# projects (heads in this case) to checkout. 712# 713if($state->{module}eq'') { 714print"E cvs update: Updating .\n"; 715opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 716while(my$head=readdir(HEADS)) { 717if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 718print"E cvs update: New directory `$head'\n"; 719} 720} 721closedir HEADS; 722print"ok\n"; 723return1; 724} 725 726 727# Grab a handle to the SQLite db and do any necessary updates 728my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 729 730$updater->update(); 731 732# if no files were specified, we need to work out what files we should be providing status on ... 733 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 734 735#$log->debug("update state : " . Dumper($state)); 736 737# foreach file specified on the commandline ... 738foreachmy$filename( @{$state->{args}} ) 739{ 740$filename= filecleanup($filename); 741 742# if we have a -C we should pretend we never saw modified stuff 743if(exists($state->{opt}{C} ) ) 744{ 745delete$state->{entries}{$filename}{modified_hash}; 746delete$state->{entries}{$filename}{modified_filename}; 747$state->{entries}{$filename}{unchanged} =1; 748} 749 750my$meta; 751if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 752{ 753$meta=$updater->getmeta($filename,$1); 754}else{ 755$meta=$updater->getmeta($filename); 756} 757 758next unless($meta->{revision} ); 759 760my$oldmeta=$meta; 761 762my$wrev= revparse($filename); 763 764# If the working copy is an old revision, lets get that version too for comparison. 765if(defined($wrev)and$wrev!=$meta->{revision} ) 766{ 767$oldmeta=$updater->getmeta($filename,$wrev); 768} 769 770#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 771 772# Files are up to date if the working copy and repo copy have the same revision, 773# and the working copy is unmodified _and_ the user hasn't specified -C 774next if(defined($wrev) 775and defined($meta->{revision}) 776and$wrev==$meta->{revision} 777and$state->{entries}{$filename}{unchanged} 778and not exists($state->{opt}{C} ) ); 779 780# If the working copy and repo copy have the same revision, 781# but the working copy is modified, tell the client it's modified 782if(defined($wrev) 783and defined($meta->{revision}) 784and$wrev==$meta->{revision} 785and not exists($state->{opt}{C} ) ) 786{ 787$log->info("Tell the client the file is modified"); 788print"MT text U\n"; 789print"MT fname$filename\n"; 790print"MT newline\n"; 791next; 792} 793 794if($meta->{filehash}eq"deleted") 795{ 796my($filepart,$dirpart) = filenamesplit($filename); 797 798$log->info("Removing '$filename' from working copy (no longer in the repo)"); 799 800print"E cvs update: `$filename' is no longer in the repository\n"; 801print"Removed$dirpart\n"; 802print"$filepart\n"; 803} 804elsif(not defined($state->{entries}{$filename}{modified_hash} ) 805or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 806{ 807$log->info("Updating '$filename'"); 808# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 809print"MT +updated\n"; 810print"MT text U\n"; 811print"MT fname$filename\n"; 812print"MT newline\n"; 813print"MT -updated\n"; 814 815my($filepart,$dirpart) = filenamesplit($filename); 816$dirpart=~s/^$state->{directory}//; 817 818if(defined($wrev) ) 819{ 820# instruct client we're sending a file to put in this path as a replacement 821print"Update-existing$dirpart\n"; 822$log->debug("Updating existing file 'Update-existing$dirpart'"); 823}else{ 824# instruct client we're sending a file to put in this path as a new file 825print"Created$dirpart\n"; 826$log->debug("Creating new file 'Created$dirpart'"); 827} 828print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 829 830# this is an "entries" line 831$log->debug("/$filepart/1.$meta->{revision}///"); 832print"/$filepart/1.$meta->{revision}///\n"; 833 834# permissions 835$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 836print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 837 838# transmit file 839 transmitfile($meta->{filehash}); 840}else{ 841$log->info("Updating '$filename'"); 842my($filepart,$dirpart) = filenamesplit($meta->{name}); 843 844my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 845 846chdir$dir; 847my$file_local=$filepart.".mine"; 848system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 849my$file_old=$filepart.".".$oldmeta->{revision}; 850 transmitfile($oldmeta->{filehash},$file_old); 851my$file_new=$filepart.".".$meta->{revision}; 852 transmitfile($meta->{filehash},$file_new); 853 854# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 855$log->info("Merging$file_local,$file_old,$file_new"); 856 857$log->debug("Temporary directory for merge is$dir"); 858 859my$return=system("merge",$file_local,$file_old,$file_new); 860$return>>=8; 861 862if($return==0) 863{ 864$log->info("Merged successfully"); 865print"M M$filename\n"; 866$log->debug("Update-existing$dirpart"); 867print"Update-existing$dirpart\n"; 868$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 869print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 870$log->debug("/$filepart/1.$meta->{revision}///"); 871print"/$filepart/1.$meta->{revision}///\n"; 872} 873elsif($return==1) 874{ 875$log->info("Merged with conflicts"); 876print"M C$filename\n"; 877print"Update-existing$dirpart\n"; 878print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 879print"/$filepart/1.$meta->{revision}/+//\n"; 880} 881else 882{ 883$log->warn("Merge failed"); 884next; 885} 886 887# permissions 888$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 889print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 890 891# transmit file, format is single integer on a line by itself (file 892# size) followed by the file contents 893# TODO : we should copy files in blocks 894my$data=`cat$file_local`; 895$log->debug("File size : " . length($data)); 896 print length($data) . "\n"; 897 print$data; 898 899 chdir "/"; 900 } 901 902 } 903 904 print "ok\n"; 905} 906 907sub req_ci 908{ 909 my ($cmd,$data) =@_; 910 911 argsplit("ci"); 912 913 #$log->debug("State : " . Dumper($state)); 914 915$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 916 917 if ( -e$state->{CVSROOT} . "/index" ) 918 { 919 print "error 1 Index already exists in git repo\n"; 920 exit; 921 } 922 923 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 924 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 925 { 926 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 927 exit; 928 } 929 930 # Grab a handle to the SQLite db and do any necessary updates 931 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 932$updater->update(); 933 934 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 935 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 936$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 937 938$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 939$ENV{GIT_INDEX_FILE} =$file_index; 940 941 chdir$tmpdir; 942 943 # populate the temporary index based 944 system("git-read-tree",$state->{module}); 945 unless ($?== 0) 946 { 947 die "Error running git-read-tree$state->{module}$file_index$!"; 948 } 949$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 950 951 952 my@committedfiles= (); 953 954 # foreach file specified on the commandline ... 955 foreach my$filename( @{$state->{args}} ) 956 { 957$filename= filecleanup($filename); 958 959 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 960 961 my$meta=$updater->getmeta($filename); 962 963 my$wrev= revparse($filename); 964 965 my ($filepart,$dirpart) = filenamesplit($filename); 966 967 # do a checkout of the file if it part of this tree 968 if ($wrev) { 969 system('git-checkout-index', '-f', '-u',$filename); 970 unless ($?== 0) { 971 die "Error running git-checkout-index -f -u$filename:$!"; 972 } 973 } 974 975 my$addflag= 0; 976 my$rmflag= 0; 977$rmflag= 1 if ( defined($wrev) and$wrev< 0 ); 978$addflag= 1 unless ( -e$filename); 979 980 # Do up to date checking 981 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) ) 982 { 983 # fail everything if an up to date check fails 984 print "error 1 Up to date check failed for$filename\n"; 985 close LOCKFILE; 986 unlink($lockfile); 987 chdir "/"; 988 exit; 989 } 990 991 push@committedfiles,$filename; 992$log->info("Committing$filename"); 993 994 system("mkdir","-p",$dirpart) unless ( -d$dirpart); 995 996 unless ($rmflag) 997 { 998$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename"); 999 rename$state->{entries}{$filename}{modified_filename},$filename;10001001 # Calculate modes to remove1002 my$invmode= "";1003 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }10041005$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1006 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1007 }10081009 if ($rmflag)1010 {1011$log->info("Removing file '$filename'");1012 unlink($filename);1013 system("git-update-index", "--remove",$filename);1014 }1015 elsif ($addflag)1016 {1017$log->info("Adding file '$filename'");1018 system("git-update-index", "--add",$filename);1019 } else {1020$log->info("Updating file '$filename'");1021 system("git-update-index",$filename);1022 }1023 }10241025 unless ( scalar(@committedfiles) > 0 )1026 {1027 print "E No files to commit\n";1028 print "ok\n";1029 close LOCKFILE;1030 unlink($lockfile);1031 chdir "/";1032 return;1033 }10341035 my$treehash= `git-write-tree`;1036 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;1037 chomp$treehash;1038 chomp$parenthash;10391040$log->debug("Treehash :$treehash, Parenthash :$parenthash");10411042 # write our commit message out if we have one ...1043 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1044 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1045 print$msg_fh"\n\nvia git-CVS emulator\n";1046 close$msg_fh;10471048 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1049$log->info("Commit hash :$commithash");10501051unless($commithash=~/[a-zA-Z0-9]{40}/)1052{1053$log->warn("Commit failed (Invalid commit hash)");1054print"error 1 Commit failed (unknown reason)\n";1055close LOCKFILE;1056unlink($lockfile);1057chdir"/";1058exit;1059}10601061open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}";1062print FILE $commithash;1063close FILE;10641065$updater->update();10661067# foreach file specified on the commandline ...1068foreachmy$filename(@committedfiles)1069{1070$filename= filecleanup($filename);10711072my$meta=$updater->getmeta($filename);10731074my($filepart,$dirpart) = filenamesplit($filename);10751076$log->debug("Checked-in$dirpart:$filename");10771078if($meta->{filehash}eq"deleted")1079{1080print"Remove-entry$dirpart\n";1081print"$filename\n";1082}else{1083print"Checked-in$dirpart\n";1084print"$filename\n";1085print"/$filepart/1.$meta->{revision}///\n";1086}1087}10881089close LOCKFILE;1090unlink($lockfile);1091chdir"/";10921093print"ok\n";1094}10951096sub req_status1097{1098my($cmd,$data) =@_;10991100 argsplit("status");11011102$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1103#$log->debug("status state : " . Dumper($state));11041105# Grab a handle to the SQLite db and do any necessary updates1106my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1107$updater->update();11081109# if no files were specified, we need to work out what files we should be providing status on ...1110 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);11111112# foreach file specified on the commandline ...1113foreachmy$filename( @{$state->{args}} )1114{1115$filename= filecleanup($filename);11161117my$meta=$updater->getmeta($filename);1118my$oldmeta=$meta;11191120my$wrev= revparse($filename);11211122# If the working copy is an old revision, lets get that version too for comparison.1123if(defined($wrev)and$wrev!=$meta->{revision} )1124{1125$oldmeta=$updater->getmeta($filename,$wrev);1126}11271128# TODO : All possible statuses aren't yet implemented1129my$status;1130# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1131$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1132and1133( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1134or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1135);11361137# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1138$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1139and1140($state->{entries}{$filename}{unchanged}1141or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1142);11431144# Need checkout if it exists in the repo but doesn't have a working copy1145$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );11461147# Locally modified if working copy and repo copy have the same revision but there are local changes1148$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );11491150# Needs Merge if working copy revision is less than repo copy and there are local changes1151$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );11521153$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1154$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1155$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1156$status||="File had conflicts on merge"if(0);11571158$status||="Unknown";11591160print"M ===================================================================\n";1161print"M File:$filename\tStatus:$status\n";1162if(defined($state->{entries}{$filename}{revision}) )1163{1164print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1165}else{1166print"M Working revision:\tNo entry for$filename\n";1167}1168if(defined($meta->{revision}) )1169{1170print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1171print"M Sticky Tag:\t\t(none)\n";1172print"M Sticky Date:\t\t(none)\n";1173print"M Sticky Options:\t\t(none)\n";1174}else{1175print"M Repository revision:\tNo revision control file\n";1176}1177print"M\n";1178}11791180print"ok\n";1181}11821183sub req_diff1184{1185my($cmd,$data) =@_;11861187 argsplit("diff");11881189$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1190#$log->debug("status state : " . Dumper($state));11911192my($revision1,$revision2);1193if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1194{1195$revision1=$state->{opt}{r}[0];1196$revision2=$state->{opt}{r}[1];1197}else{1198$revision1=$state->{opt}{r};1199}12001201$revision1=~s/^1\.//if(defined($revision1) );1202$revision2=~s/^1\.//if(defined($revision2) );12031204$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );12051206# Grab a handle to the SQLite db and do any necessary updates1207my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1208$updater->update();12091210# if no files were specified, we need to work out what files we should be providing status on ...1211 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12121213# foreach file specified on the commandline ...1214foreachmy$filename( @{$state->{args}} )1215{1216$filename= filecleanup($filename);12171218my($fh,$file1,$file2,$meta1,$meta2,$filediff);12191220my$wrev= revparse($filename);12211222# We need _something_ to diff against1223next unless(defined($wrev) );12241225# if we have a -r switch, use it1226if(defined($revision1) )1227{1228(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1229$meta1=$updater->getmeta($filename,$revision1);1230unless(defined($meta1)and$meta1->{filehash}ne"deleted")1231{1232print"E File$filenameat revision 1.$revision1doesn't exist\n";1233next;1234}1235 transmitfile($meta1->{filehash},$file1);1236}1237# otherwise we just use the working copy revision1238else1239{1240(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1241$meta1=$updater->getmeta($filename,$wrev);1242 transmitfile($meta1->{filehash},$file1);1243}12441245# if we have a second -r switch, use it too1246if(defined($revision2) )1247{1248(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1249$meta2=$updater->getmeta($filename,$revision2);12501251unless(defined($meta2)and$meta2->{filehash}ne"deleted")1252{1253print"E File$filenameat revision 1.$revision2doesn't exist\n";1254next;1255}12561257 transmitfile($meta2->{filehash},$file2);1258}1259# otherwise we just use the working copy1260else1261{1262$file2=$state->{entries}{$filename}{modified_filename};1263}12641265# if we have been given -r, and we don't have a $file2 yet, lets get one1266if(defined($revision1)and not defined($file2) )1267{1268(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1269$meta2=$updater->getmeta($filename,$wrev);1270 transmitfile($meta2->{filehash},$file2);1271}12721273# We need to have retrieved something useful1274next unless(defined($meta1) );12751276# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1277next if(not defined($meta2)and$wrev==$meta1->{revision}1278and1279( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1280or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1281);12821283# Apparently we only show diffs for locally modified files1284next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );12851286print"M Index:$filename\n";1287print"M ===================================================================\n";1288print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1289print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1290print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1291print"M diff ";1292foreachmy$opt(keys%{$state->{opt}} )1293{1294if(ref$state->{opt}{$opt}eq"ARRAY")1295{1296foreachmy$value( @{$state->{opt}{$opt}} )1297{1298print"-$opt$value";1299}1300}else{1301print"-$opt";1302print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1303}1304}1305print"$filename\n";13061307$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));13081309($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);13101311if(exists$state->{opt}{u} )1312{1313system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1314}else{1315system("diff$file1$file2>$filediff");1316}13171318while( <$fh> )1319{1320print"M$_";1321}1322close$fh;1323}13241325print"ok\n";1326}13271328sub req_log1329{1330my($cmd,$data) =@_;13311332 argsplit("log");13331334$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1335#$log->debug("log state : " . Dumper($state));13361337my($minrev,$maxrev);1338if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1339{1340my$control=$2;1341$minrev=$1;1342$maxrev=$3;1343$minrev=~s/^1\.//if(defined($minrev) );1344$maxrev=~s/^1\.//if(defined($maxrev) );1345$minrev++if(defined($minrev)and$controleq"::");1346}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 status on ...1353 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);13541355# foreach file specified on the commandline ...1356foreachmy$filename( @{$state->{args}} )1357{1358$filename= filecleanup($filename);13591360my$headmeta=$updater->getmeta($filename);13611362my$revisions=$updater->getlog($filename);1363my$totalrevisions=scalar(@$revisions);13641365if(defined($minrev) )1366{1367$log->debug("Removing revisions less than$minrev");1368while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1369{1370pop@$revisions;1371}1372}1373if(defined($maxrev) )1374{1375$log->debug("Removing revisions greater than$maxrev");1376while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1377{1378shift@$revisions;1379}1380}13811382next unless(scalar(@$revisions) );13831384print"M\n";1385print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1386print"M Working file:$filename\n";1387print"M head: 1.$headmeta->{revision}\n";1388print"M branch:\n";1389print"M locks: strict\n";1390print"M access list:\n";1391print"M symbolic names:\n";1392print"M keyword substitution: kv\n";1393print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1394print"M description:\n";13951396foreachmy$revision(@$revisions)1397{1398print"M ----------------------------\n";1399print"M revision 1.$revision->{revision}\n";1400# reformat the date for log output1401$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}) );1402$revision->{author} =~s/\s+.*//;1403$revision->{author} =~s/^(.{8}).*/$1/;1404print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1405my$commitmessage=$updater->commitmessage($revision->{commithash});1406$commitmessage=~s/^/M /mg;1407print$commitmessage."\n";1408}1409print"M =============================================================================\n";1410}14111412print"ok\n";1413}14141415sub req_annotate1416{1417my($cmd,$data) =@_;14181419 argsplit("annotate");14201421$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1422#$log->debug("status state : " . Dumper($state));14231424# Grab a handle to the SQLite db and do any necessary updates1425my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1426$updater->update();14271428# if no files were specified, we need to work out what files we should be providing annotate on ...1429 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);14301431# we'll need a temporary checkout dir1432my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1433my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1434$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");14351436$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1437$ENV{GIT_INDEX_FILE} =$file_index;14381439chdir$tmpdir;14401441# foreach file specified on the commandline ...1442foreachmy$filename( @{$state->{args}} )1443{1444$filename= filecleanup($filename);14451446my$meta=$updater->getmeta($filename);14471448next unless($meta->{revision} );14491450# get all the commits that this file was in1451# in dense format -- aka skip dead revisions1452my$revisions=$updater->gethistorydense($filename);1453my$lastseenin=$revisions->[0][2];14541455# populate the temporary index based on the latest commit were we saw1456# the file -- but do it cheaply without checking out any files1457# TODO: if we got a revision from the client, use that instead1458# to look up the commithash in sqlite (still good to default to1459# the current head as we do now)1460system("git-read-tree",$lastseenin);1461unless($?==0)1462{1463die"Error running git-read-tree$lastseenin$file_index$!";1464}1465$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");14661467# do a checkout of the file1468system('git-checkout-index','-f','-u',$filename);1469unless($?==0) {1470die"Error running git-checkout-index -f -u$filename:$!";1471}14721473$log->info("Annotate$filename");14741475# Prepare a file with the commits from the linearized1476# history that annotate should know about. This prevents1477# git-jsannotate telling us about commits we are hiding1478# from the client.14791480open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1481for(my$i=0;$i<@$revisions;$i++)1482{1483print ANNOTATEHINTS $revisions->[$i][2];1484if($i+1<@$revisions) {# have we got a parent?1485print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1486}1487print ANNOTATEHINTS "\n";1488}14891490print ANNOTATEHINTS "\n";1491close ANNOTATEHINTS;14921493my$annotatecmd='git-annotate';1494open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1495or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1496my$metadata= {};1497print"E Annotations for$filename\n";1498print"E ***************\n";1499while( <ANNOTATE> )1500{1501if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1502{1503my$commithash=$1;1504my$data=$2;1505unless(defined($metadata->{$commithash} ) )1506{1507$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1508$metadata->{$commithash}{author} =~s/\s+.*//;1509$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1510$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1511}1512printf("M 1.%-5d (%-8s%10s):%s\n",1513$metadata->{$commithash}{revision},1514$metadata->{$commithash}{author},1515$metadata->{$commithash}{modified},1516$data1517);1518}else{1519$log->warn("Error in annotate output! LINE:$_");1520print"E Annotate error\n";1521next;1522}1523}1524close ANNOTATE;1525}15261527# done; get out of the tempdir1528chdir"/";15291530print"ok\n";15311532}15331534# This method takes the state->{arguments} array and produces two new arrays.1535# The first is $state->{args} which is everything before the '--' argument, and1536# the second is $state->{files} which is everything after it.1537sub argsplit1538{1539return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");15401541my$type=shift;15421543$state->{args} = [];1544$state->{files} = [];1545$state->{opt} = {};15461547if(defined($type) )1548{1549my$opt= {};1550$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");1551$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1552$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");1553$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1554$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1555$opt= { k =>1, m =>1}if($typeeq"add");1556$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1557$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");155815591560while(scalar( @{$state->{arguments}} ) >0)1561{1562my$arg=shift@{$state->{arguments}};15631564next if($argeq"--");1565next unless($arg=~/\S/);15661567# if the argument looks like a switch1568if($arg=~/^-(\w)(.*)/)1569{1570# if it's a switch that takes an argument1571if($opt->{$1} )1572{1573# If this switch has already been provided1574if($opt->{$1} >1and exists($state->{opt}{$1} ) )1575{1576$state->{opt}{$1} = [$state->{opt}{$1} ];1577if(length($2) >0)1578{1579push@{$state->{opt}{$1}},$2;1580}else{1581push@{$state->{opt}{$1}},shift@{$state->{arguments}};1582}1583}else{1584# if there's extra data in the arg, use that as the argument for the switch1585if(length($2) >0)1586{1587$state->{opt}{$1} =$2;1588}else{1589$state->{opt}{$1} =shift@{$state->{arguments}};1590}1591}1592}else{1593$state->{opt}{$1} =undef;1594}1595}1596else1597{1598push@{$state->{args}},$arg;1599}1600}1601}1602else1603{1604my$mode=0;16051606foreachmy$value( @{$state->{arguments}} )1607{1608if($valueeq"--")1609{1610$mode++;1611next;1612}1613push@{$state->{args}},$valueif($mode==0);1614push@{$state->{files}},$valueif($mode==1);1615}1616}1617}16181619# This method uses $state->{directory} to populate $state->{args} with a list of filenames1620sub argsfromdir1621{1622my$updater=shift;16231624$state->{args} = [];16251626foreachmy$file( @{$updater->gethead} )1627{1628next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1629next unless($file->{name} =~s/^$state->{directory}//);1630push@{$state->{args}},$file->{name};1631}1632}16331634# This method cleans up the $state variable after a command that uses arguments has run1635sub statecleanup1636{1637$state->{files} = [];1638$state->{args} = [];1639$state->{arguments} = [];1640$state->{entries} = {};1641}16421643sub revparse1644{1645my$filename=shift;16461647returnundefunless(defined($state->{entries}{$filename}{revision} ) );16481649return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1650return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);16511652returnundef;1653}16541655# This method takes a file hash and does a CVS "file transfer" which transmits the1656# size of the file, and then the file contents.1657# If a second argument $targetfile is given, the file is instead written out to1658# a file by the name of $targetfile1659sub transmitfile1660{1661my$filehash=shift;1662my$targetfile=shift;16631664if(defined($filehash)and$filehasheq"deleted")1665{1666$log->warn("filehash is 'deleted'");1667return;1668}16691670die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);16711672my$type=`git-cat-file -t$filehash`;1673 chomp$type;16741675 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );16761677 my$size= `git-cat-file -s $filehash`;1678chomp$size;16791680$log->debug("transmitfile($filehash) size=$size, type=$type");16811682if(open my$fh,'-|',"git-cat-file","blob",$filehash)1683{1684if(defined($targetfile) )1685{1686open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1687print NEWFILE $_while( <$fh> );1688close NEWFILE;1689}else{1690print"$size\n";1691printwhile( <$fh> );1692}1693close$fhor die("Couldn't close filehandle for transmitfile()");1694}else{1695die("Couldn't execute git-cat-file");1696}1697}16981699# This method takes a file name, and returns ( $dirpart, $filepart ) which1700# refers to the directory porition and the file portion of the filename1701# respectively1702sub filenamesplit1703{1704my$filename=shift;17051706my($filepart,$dirpart) = ($filename,".");1707($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1708$dirpart.="/";17091710return($filepart,$dirpart);1711}17121713sub filecleanup1714{1715my$filename=shift;17161717returnundefunless(defined($filename));1718if($filename=~/^\// )1719{1720print"E absolute filenames '$filename' not supported by server\n";1721returnundef;1722}17231724$filename=~s/^\.\///g;1725$filename=$state->{directory} .$filename;17261727return$filename;1728}17291730package GITCVS::log;17311732####1733#### Copyright The Open University UK - 2006.1734####1735#### Authors: Martyn Smith <martyn@catalyst.net.nz>1736#### Martin Langhoff <martin@catalyst.net.nz>1737####1738####17391740use strict;1741use warnings;17421743=head1 NAME17441745GITCVS::log17461747=head1 DESCRIPTION17481749This module provides very crude logging with a similar interface to1750Log::Log4perl17511752=head1 METHODS17531754=cut17551756=head2 new17571758Creates a new log object, optionally you can specify a filename here to1759indicate the file to log to. If no log file is specified, you can specifiy one1760later with method setfile, or indicate you no longer want logging with method1761nofile.17621763Until one of these methods is called, all log calls will buffer messages ready1764to write out.17651766=cut1767sub new1768{1769my$class=shift;1770my$filename=shift;17711772my$self= {};17731774bless$self,$class;17751776if(defined($filename) )1777{1778open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1779}17801781return$self;1782}17831784=head2 setfile17851786This methods takes a filename, and attempts to open that file as the log file.1787If successful, all buffered data is written out to the file, and any further1788logging is written directly to the file.17891790=cut1791sub setfile1792{1793my$self=shift;1794my$filename=shift;17951796if(defined($filename) )1797{1798open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1799}18001801return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");18021803while(my$line=shift@{$self->{buffer}} )1804{1805print{$self->{fh}}$line;1806}1807}18081809=head2 nofile18101811This method indicates no logging is going to be used. It flushes any entries in1812the internal buffer, and sets a flag to ensure no further data is put there.18131814=cut1815sub nofile1816{1817my$self=shift;18181819$self->{nolog} =1;18201821return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");18221823$self->{buffer} = [];1824}18251826=head2 _logopen18271828Internal method. Returns true if the log file is open, false otherwise.18291830=cut1831sub _logopen1832{1833my$self=shift;18341835return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1836return0;1837}18381839=head2 debug info warn fatal18401841These four methods are wrappers to _log. They provide the actual interface for1842logging data.18431844=cut1845sub debug {my$self=shift;$self->_log("debug",@_); }1846sub info {my$self=shift;$self->_log("info",@_); }1847subwarn{my$self=shift;$self->_log("warn",@_); }1848sub fatal {my$self=shift;$self->_log("fatal",@_); }18491850=head2 _log18511852This is an internal method called by the logging functions. It generates a1853timestamp and pushes the logged line either to file, or internal buffer.18541855=cut1856sub _log1857{1858my$self=shift;1859my$level=shift;18601861return if($self->{nolog} );18621863my@time=localtime;1864my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1865$time[5] +1900,1866$time[4] +1,1867$time[3],1868$time[2],1869$time[1],1870$time[0],1871uc$level,1872);18731874if($self->_logopen)1875{1876print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1877}else{1878push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1879}1880}18811882=head2 DESTROY18831884This method simply closes the file handle if one is open18851886=cut1887sub DESTROY1888{1889my$self=shift;18901891if($self->_logopen)1892{1893close$self->{fh};1894}1895}18961897package GITCVS::updater;18981899####1900#### Copyright The Open University UK - 2006.1901####1902#### Authors: Martyn Smith <martyn@catalyst.net.nz>1903#### Martin Langhoff <martin@catalyst.net.nz>1904####1905####19061907use strict;1908use warnings;1909use DBI;19101911=head1 METHODS19121913=cut19141915=head2 new19161917=cut1918sub new1919{1920my$class=shift;1921my$config=shift;1922my$module=shift;1923my$log=shift;19241925die"Need to specify a git repository"unless(defined($config)and-d $config);1926die"Need to specify a module"unless(defined($module) );19271928$class=ref($class) ||$class;19291930my$self= {};19311932bless$self,$class;19331934$self->{dbdir} =$config."/";1935die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );19361937$self->{module} =$module;1938$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";19391940$self->{git_path} =$config."/";19411942$self->{log} =$log;19431944die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );19451946$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");19471948$self->{tables} = {};1949foreachmy$table($self->{dbh}->tables)1950{1951$table=~s/^"//;1952$table=~s/"$//;1953$self->{tables}{$table} =1;1954}19551956# Construct the revision table if required1957unless($self->{tables}{revision} )1958{1959$self->{dbh}->do("1960 CREATE TABLE revision (1961 name TEXT NOT NULL,1962 revision INTEGER NOT NULL,1963 filehash TEXT NOT NULL,1964 commithash TEXT NOT NULL,1965 author TEXT NOT NULL,1966 modified TEXT NOT NULL,1967 mode TEXT NOT NULL1968 )1969 ");1970}19711972# Construct the revision table if required1973unless($self->{tables}{head} )1974{1975$self->{dbh}->do("1976 CREATE TABLE head (1977 name TEXT NOT NULL,1978 revision INTEGER NOT NULL,1979 filehash TEXT NOT NULL,1980 commithash TEXT NOT NULL,1981 author TEXT NOT NULL,1982 modified TEXT NOT NULL,1983 mode TEXT NOT NULL1984 )1985 ");1986}19871988# Construct the properties table if required1989unless($self->{tables}{properties} )1990{1991$self->{dbh}->do("1992 CREATE TABLE properties (1993 key TEXT NOT NULL PRIMARY KEY,1994 value TEXT1995 )1996 ");1997}19981999# Construct the commitmsgs table if required2000unless($self->{tables}{commitmsgs} )2001{2002$self->{dbh}->do("2003 CREATE TABLE commitmsgs (2004 key TEXT NOT NULL PRIMARY KEY,2005 value TEXT2006 )2007 ");2008}20092010return$self;2011}20122013=head2 update20142015=cut2016sub update2017{2018my$self=shift;20192020# first lets get the commit list2021$ENV{GIT_DIR} =$self->{git_path};20222023# prepare database queries2024my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2025my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2026my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2027my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);20282029my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;2030unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2031{2032die("Invalid module '$self->{module}'");2033}203420352036my$git_log;2037my$lastcommit=$self->_get_prop("last_commit");20382039# Start exclusive lock here...2040$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";20412042# TODO: log processing is memory bound2043# if we can parse into a 2nd file that is in reverse order2044# we can probably do something really efficient2045my@git_log_params= ('--parents','--topo-order');20462047if(defined$lastcommit) {2048push@git_log_params,"$lastcommit..$self->{module}";2049}else{2050push@git_log_params,$self->{module};2051}2052open(GITLOG,'-|','git-log',@git_log_params)or die"Cannot call git-log:$!";20532054my@commits;20552056my%commit= ();20572058while( <GITLOG> )2059{2060chomp;2061if(m/^commit\s+(.*)$/) {2062# on ^commit lines put the just seen commit in the stack2063# and prime things for the next one2064if(keys%commit) {2065my%copy=%commit;2066unshift@commits, \%copy;2067%commit= ();2068}2069my@parents=split(m/\s+/,$1);2070$commit{hash} =shift@parents;2071$commit{parents} = \@parents;2072}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2073# on rfc822-like lines seen before we see any message,2074# lowercase the entry and put it in the hash as key-value2075$commit{lc($1)} =$2;2076}else{2077# message lines - skip initial empty line2078# and trim whitespace2079if(!exists($commit{message}) &&m/^\s*$/) {2080# define it to mark the end of headers2081$commit{message} ='';2082next;2083}2084s/^\s+//;s/\s+$//;# trim ws2085$commit{message} .=$_."\n";2086}2087}2088close GITLOG;20892090unshift@commits, \%commitif(keys%commit);20912092# Now all the commits are in the @commits bucket2093# ordered by time DESC. for each commit that needs processing,2094# determine whether it's following the last head we've seen or if2095# it's on its own branch, grab a file list, and add whatever's changed2096# NOTE: $lastcommit refers to the last commit from previous run2097# $lastpicked is the last commit we picked in this run2098my$lastpicked;2099my$head= {};2100if(defined$lastcommit) {2101$lastpicked=$lastcommit;2102}21032104my$committotal=scalar(@commits);2105my$commitcount=0;21062107# Load the head table into $head (for cached lookups during the update process)2108foreachmy$file( @{$self->gethead()} )2109{2110$head->{$file->{name}} =$file;2111}21122113foreachmy$commit(@commits)2114{2115$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2116if(defined$lastpicked)2117{2118if(!in_array($lastpicked, @{$commit->{parents}}))2119{2120# skip, we'll see this delta2121# as part of a merge later2122# warn "skipping off-track $commit->{hash}\n";2123next;2124}elsif(@{$commit->{parents}} >1) {2125# it is a merge commit, for each parent that is2126# not $lastpicked, see if we can get a log2127# from the merge-base to that parent to put it2128# in the message as a merge summary.2129my@parents= @{$commit->{parents}};2130foreachmy$parent(@parents) {2131# git-merge-base can potentially (but rarely) throw2132# several candidate merge bases. let's assume2133# that the first one is the best one.2134if($parenteq$lastpicked) {2135next;2136}2137open my$p,'git-merge-base '.$lastpicked.' '2138.$parent.'|';2139my@output= (<$p>);2140close$p;2141my$base=join('',@output);2142chomp$base;2143if($base) {2144my@merged;2145# print "want to log between $base $parent \n";2146open(GITLOG,'-|','git-log',"$base..$parent")2147or die"Cannot call git-log:$!";2148my$mergedhash;2149while(<GITLOG>) {2150chomp;2151if(!defined$mergedhash) {2152if(m/^commit\s+(.+)$/) {2153$mergedhash=$1;2154}else{2155next;2156}2157}else{2158# grab the first line that looks non-rfc8222159# aka has content after leading space2160if(m/^\s+(\S.*)$/) {2161my$title=$1;2162$title=substr($title,0,100);# truncate2163unshift@merged,"$mergedhash$title";2164undef$mergedhash;2165}2166}2167}2168close GITLOG;2169if(@merged) {2170$commit->{mergemsg} =$commit->{message};2171$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2172foreachmy$summary(@merged) {2173$commit->{mergemsg} .="\t$summary\n";2174}2175$commit->{mergemsg} .="\n\n";2176# print "Message for $commit->{hash} \n$commit->{mergemsg}";2177}2178}2179}2180}2181}21822183# convert the date to CVS-happy format2184$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);21852186if(defined($lastpicked) )2187{2188my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2189while( <FILELIST> )2190{2191unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2192{2193die("Couldn't process git-diff-tree line :$_");2194}21952196# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");21972198my$git_perms="";2199$git_perms.="r"if($1&4);2200$git_perms.="w"if($1&2);2201$git_perms.="x"if($1&1);2202$git_perms="rw"if($git_permseq"");22032204if($3eq"D")2205{2206#$log->debug("DELETE $4");2207$head->{$4} = {2208 name =>$4,2209 revision =>$head->{$4}{revision} +1,2210 filehash =>"deleted",2211 commithash =>$commit->{hash},2212 modified =>$commit->{date},2213 author =>$commit->{author},2214 mode =>$git_perms,2215};2216$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2217}2218elsif($3eq"M")2219{2220#$log->debug("MODIFIED $4");2221$head->{$4} = {2222 name =>$4,2223 revision =>$head->{$4}{revision} +1,2224 filehash =>$2,2225 commithash =>$commit->{hash},2226 modified =>$commit->{date},2227 author =>$commit->{author},2228 mode =>$git_perms,2229};2230$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2231}2232elsif($3eq"A")2233{2234#$log->debug("ADDED $4");2235$head->{$4} = {2236 name =>$4,2237 revision =>1,2238 filehash =>$2,2239 commithash =>$commit->{hash},2240 modified =>$commit->{date},2241 author =>$commit->{author},2242 mode =>$git_perms,2243};2244$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2245}2246else2247{2248$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2249die;2250}2251}2252close FILELIST;2253}else{2254# this is used to detect files removed from the repo2255my$seen_files= {};22562257my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2258while( <FILELIST> )2259{2260unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2261{2262die("Couldn't process git-ls-tree line :$_");2263}22642265my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);22662267$seen_files->{$git_filename} =1;22682269my($oldhash,$oldrevision,$oldmode) = (2270$head->{$git_filename}{filehash},2271$head->{$git_filename}{revision},2272$head->{$git_filename}{mode}2273);22742275if($git_perms=~/^\d\d\d(\d)\d\d/o)2276{2277$git_perms="";2278$git_perms.="r"if($1&4);2279$git_perms.="w"if($1&2);2280$git_perms.="x"if($1&1);2281}else{2282$git_perms="rw";2283}22842285# unless the file exists with the same hash, we need to update it ...2286unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2287{2288my$newrevision= ($oldrevisionor0) +1;22892290$head->{$git_filename} = {2291 name =>$git_filename,2292 revision =>$newrevision,2293 filehash =>$git_hash,2294 commithash =>$commit->{hash},2295 modified =>$commit->{date},2296 author =>$commit->{author},2297 mode =>$git_perms,2298};229923002301$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2302}2303}2304close FILELIST;23052306# Detect deleted files2307foreachmy$file(keys%$head)2308{2309unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2310{2311$head->{$file}{revision}++;2312$head->{$file}{filehash} ="deleted";2313$head->{$file}{commithash} =$commit->{hash};2314$head->{$file}{modified} =$commit->{date};2315$head->{$file}{author} =$commit->{author};23162317$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2318}2319}2320# END : "Detect deleted files"2321}232223232324if(exists$commit->{mergemsg})2325{2326$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2327}23282329$lastpicked=$commit->{hash};23302331$self->_set_prop("last_commit",$commit->{hash});2332}23332334$db_delete_head->execute();2335foreachmy$file(keys%$head)2336{2337$db_insert_head->execute(2338$file,2339$head->{$file}{revision},2340$head->{$file}{filehash},2341$head->{$file}{commithash},2342$head->{$file}{modified},2343$head->{$file}{author},2344$head->{$file}{mode},2345);2346}2347# invalidate the gethead cache2348$self->{gethead_cache} =undef;234923502351# Ending exclusive lock here2352$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2353}23542355sub _headrev2356{2357my$self=shift;2358my$filename=shift;23592360my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2361$db_query->execute($filename);2362my($hash,$revision,$mode) =$db_query->fetchrow_array;23632364return($hash,$revision,$mode);2365}23662367sub _get_prop2368{2369my$self=shift;2370my$key=shift;23712372my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2373$db_query->execute($key);2374my($value) =$db_query->fetchrow_array;23752376return$value;2377}23782379sub _set_prop2380{2381my$self=shift;2382my$key=shift;2383my$value=shift;23842385my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2386$db_query->execute($value,$key);23872388unless($db_query->rows)2389{2390$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2391$db_query->execute($key,$value);2392}23932394return$value;2395}23962397=head2 gethead23982399=cut24002401sub gethead2402{2403my$self=shift;24042405return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );24062407my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2408$db_query->execute();24092410my$tree= [];2411while(my$file=$db_query->fetchrow_hashref)2412{2413push@$tree,$file;2414}24152416$self->{gethead_cache} =$tree;24172418return$tree;2419}24202421=head2 getlog24222423=cut24242425sub getlog2426{2427my$self=shift;2428my$filename=shift;24292430my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2431$db_query->execute($filename);24322433my$tree= [];2434while(my$file=$db_query->fetchrow_hashref)2435{2436push@$tree,$file;2437}24382439return$tree;2440}24412442=head2 getmeta24432444This function takes a filename (with path) argument and returns a hashref of2445metadata for that file.24462447=cut24482449sub getmeta2450{2451my$self=shift;2452my$filename=shift;2453my$revision=shift;24542455my$db_query;2456if(defined($revision)and$revision=~/^\d+$/)2457{2458$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2459$db_query->execute($filename,$revision);2460}2461elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2462{2463$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2464$db_query->execute($filename,$revision);2465}else{2466$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2467$db_query->execute($filename);2468}24692470return$db_query->fetchrow_hashref;2471}24722473=head2 commitmessage24742475this function takes a commithash and returns the commit message for that commit24762477=cut2478sub commitmessage2479{2480my$self=shift;2481my$commithash=shift;24822483die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);24842485my$db_query;2486$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2487$db_query->execute($commithash);24882489my($message) =$db_query->fetchrow_array;24902491if(defined($message) )2492{2493$message.=" "if($message=~/\n$/);2494return$message;2495}24962497my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2498shift@lineswhile($lines[0] =~/\S/);2499$message=join("",@lines);2500$message.=" "if($message=~/\n$/);2501return$message;2502}25032504=head2 gethistory25052506This function takes a filename (with path) argument and returns an arrayofarrays2507containing revision,filehash,commithash ordered by revision descending25082509=cut2510sub gethistory2511{2512my$self=shift;2513my$filename=shift;25142515my$db_query;2516$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2517$db_query->execute($filename);25182519return$db_query->fetchall_arrayref;2520}25212522=head2 gethistorydense25232524This function takes a filename (with path) argument and returns an arrayofarrays2525containing revision,filehash,commithash ordered by revision descending.25262527This version of gethistory skips deleted entries -- so it is useful for annotate.2528The 'dense' part is a reference to a '--dense' option available for git-rev-list2529and other git tools that depend on it.25302531=cut2532sub gethistorydense2533{2534my$self=shift;2535my$filename=shift;25362537my$db_query;2538$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2539$db_query->execute($filename);25402541return$db_query->fetchall_arrayref;2542}25432544=head2 in_array()25452546from Array::PAT - mimics the in_array() function2547found in PHP. Yuck but works for small arrays.25482549=cut2550sub in_array2551{2552my($check,@array) =@_;2553my$retval=0;2554foreachmy$test(@array){2555if($checkeq$test){2556$retval=1;2557}2558}2559return$retval;2560}25612562=head2 safe_pipe_capture25632564an alterative to `command` that allows input to be passed as an array2565to work around shell problems with weird characters in arguments25662567=cut2568sub safe_pipe_capture {25692570my@output;25712572if(my$pid=open my$child,'-|') {2573@output= (<$child>);2574close$childor die join(' ',@_).":$!$?";2575}else{2576exec(@_)or die"$!$?";# exec() can fail the executable can't be found2577}2578returnwantarray?@output:join('',@output);2579}2580258125821;