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# instruct the client that we're checking out to $checkout_path 575print"E cvs server: updating$checkout_path\n"; 576 577foreachmy$git( @{$updater->gethead} ) 578{ 579# Don't want to check out deleted files 580next if($git->{filehash}eq"deleted"); 581 582($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 583 584# modification time of this file 585print"Mod-time$git->{modified}\n"; 586 587# print some information to the client 588print"MT +updated\n"; 589print"MT text U\n"; 590if(defined($git->{dir} )and$git->{dir}ne"./") 591{ 592print"MT fname$checkout_path/$git->{dir}$git->{name}\n"; 593}else{ 594print"MT fname$checkout_path/$git->{name}\n"; 595} 596print"MT newline\n"; 597print"MT -updated\n"; 598 599# instruct client we're sending a file to put in this path 600print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 601 602print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 603 604# this is an "entries" line 605print"/$git->{name}/1.$git->{revision}///\n"; 606# permissions 607print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 608 609# transmit file 610 transmitfile($git->{filehash}); 611} 612 613print"ok\n"; 614 615 statecleanup(); 616} 617 618# update \n 619# Response expected: yes. Actually do a cvs update command. This uses any 620# previous Argument, Directory, Entry, or Modified requests, if they have 621# been sent. The last Directory sent specifies the working directory at the 622# time of the operation. The -I option is not used--files which the client 623# can decide whether to ignore are not mentioned and the client sends the 624# Questionable request for others. 625sub req_update 626{ 627my($cmd,$data) =@_; 628 629$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 630 631 argsplit("update"); 632 633# Grab a handle to the SQLite db and do any necessary updates 634my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 635 636$updater->update(); 637 638# if no files were specified, we need to work out what files we should be providing status on ... 639 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 640 641#$log->debug("update state : " . Dumper($state)); 642 643# foreach file specified on the commandline ... 644foreachmy$filename( @{$state->{args}} ) 645{ 646$filename= filecleanup($filename); 647 648# if we have a -C we should pretend we never saw modified stuff 649if(exists($state->{opt}{C} ) ) 650{ 651delete$state->{entries}{$filename}{modified_hash}; 652delete$state->{entries}{$filename}{modified_filename}; 653$state->{entries}{$filename}{unchanged} =1; 654} 655 656my$meta; 657if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 658{ 659$meta=$updater->getmeta($filename,$1); 660}else{ 661$meta=$updater->getmeta($filename); 662} 663 664next unless($meta->{revision} ); 665 666my$oldmeta=$meta; 667 668my$wrev= revparse($filename); 669 670# If the working copy is an old revision, lets get that version too for comparison. 671if(defined($wrev)and$wrev!=$meta->{revision} ) 672{ 673$oldmeta=$updater->getmeta($filename,$wrev); 674} 675 676#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 677 678# 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 679next if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{unchanged}and not exists($state->{opt}{C} ) ); 680 681if($meta->{filehash}eq"deleted") 682{ 683my($filepart,$dirpart) = filenamesplit($filename); 684 685$log->info("Removing '$filename' from working copy (no longer in the repo)"); 686 687print"E cvs update: `$filename' is no longer in the repository\n"; 688print"Removed$dirpart\n"; 689print"$filepart\n"; 690} 691elsif(not defined($state->{entries}{$filename}{modified_hash} )or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 692{ 693$log->info("Updating '$filename'"); 694# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 695print"MT +updated\n"; 696print"MT text U\n"; 697print"MT fname$filename\n"; 698print"MT newline\n"; 699print"MT -updated\n"; 700 701my($filepart,$dirpart) = filenamesplit($filename); 702$dirpart=~s/^$state->{directory}//; 703 704if(defined($wrev) ) 705{ 706# instruct client we're sending a file to put in this path as a replacement 707print"Update-existing$dirpart\n"; 708$log->debug("Updating existing file 'Update-existing$dirpart'"); 709}else{ 710# instruct client we're sending a file to put in this path as a new file 711print"Created$dirpart\n"; 712$log->debug("Creating new file 'Created$dirpart'"); 713} 714print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 715 716# this is an "entries" line 717$log->debug("/$filepart/1.$meta->{revision}///"); 718print"/$filepart/1.$meta->{revision}///\n"; 719 720# permissions 721$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 722print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 723 724# transmit file 725 transmitfile($meta->{filehash}); 726}else{ 727my($filepart,$dirpart) = filenamesplit($meta->{name}); 728 729my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 730 731chdir$dir; 732my$file_local=$filepart.".mine"; 733system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 734my$file_old=$filepart.".".$oldmeta->{revision}; 735 transmitfile($oldmeta->{filehash},$file_old); 736my$file_new=$filepart.".".$meta->{revision}; 737 transmitfile($meta->{filehash},$file_new); 738 739# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 740$log->info("Merging$file_local,$file_old,$file_new"); 741 742$log->debug("Temporary directory for merge is$dir"); 743 744my$return=system("merge",$file_local,$file_old,$file_new); 745$return>>=8; 746 747if($return==0) 748{ 749$log->info("Merged successfully"); 750print"M M$filename\n"; 751$log->debug("Update-existing$dirpart"); 752print"Update-existing$dirpart\n"; 753$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 754print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 755$log->debug("/$filepart/1.$meta->{revision}///"); 756print"/$filepart/1.$meta->{revision}///\n"; 757} 758elsif($return==1) 759{ 760$log->info("Merged with conflicts"); 761print"M C$filename\n"; 762print"Update-existing$dirpart\n"; 763print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 764print"/$filepart/1.$meta->{revision}/+//\n"; 765} 766else 767{ 768$log->warn("Merge failed"); 769next; 770} 771 772# permissions 773$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 774print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 775 776# transmit file, format is single integer on a line by itself (file 777# size) followed by the file contents 778# TODO : we should copy files in blocks 779my$data=`cat$file_local`; 780$log->debug("File size : " . length($data)); 781 print length($data) . "\n"; 782 print$data; 783 784 chdir "/"; 785 } 786 787 } 788 789 print "ok\n"; 790} 791 792sub req_ci 793{ 794 my ($cmd,$data) =@_; 795 796 argsplit("ci"); 797 798 #$log->debug("State : " . Dumper($state)); 799 800$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 801 802 if ( -e$state->{CVSROOT} . "/index" ) 803 { 804 print "error 1 Index already exists in git repo\n"; 805 exit; 806 } 807 808 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 809 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 810 { 811 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 812 exit; 813 } 814 815 # Grab a handle to the SQLite db and do any necessary updates 816 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 817$updater->update(); 818 819 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 820 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 821$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 822 823$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 824$ENV{GIT_INDEX_FILE} =$file_index; 825 826 chdir$tmpdir; 827 828 # populate the temporary index based 829 system("git-read-tree",$state->{module}); 830 unless ($?== 0) 831 { 832 die "Error running git-read-tree$state->{module}$file_index$!"; 833 } 834$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 835 836 837 my@committedfiles= (); 838 839 # foreach file specified on the commandline ... 840 foreach my$filename( @{$state->{args}} ) 841 { 842$filename= filecleanup($filename); 843 844 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 845 846 my$meta=$updater->getmeta($filename); 847 848 my$wrev= revparse($filename); 849 850 my ($filepart,$dirpart) = filenamesplit($filename); 851 852 # do a checkout of the file if it part of this tree 853 if ($wrev) { 854 system('git-checkout-index', '-f', '-u',$filename); 855 unless ($?== 0) { 856 die "Error running git-checkout-index -f -u$filename:$!"; 857 } 858 } 859 860 my$addflag= 0; 861 my$rmflag= 0; 862$rmflag= 1 if ( defined($wrev) and$wrev< 0 ); 863$addflag= 1 unless ( -e$filename); 864 865 # Do up to date checking 866 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) ) 867 { 868 # fail everything if an up to date check fails 869 print "error 1 Up to date check failed for$filename\n"; 870 close LOCKFILE; 871 unlink($lockfile); 872 chdir "/"; 873 exit; 874 } 875 876 push@committedfiles,$filename; 877$log->info("Committing$filename"); 878 879 system("mkdir","-p",$dirpart) unless ( -d$dirpart); 880 881 unless ($rmflag) 882 { 883$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename"); 884 rename$state->{entries}{$filename}{modified_filename},$filename; 885 886 # Calculate modes to remove 887 my$invmode= ""; 888 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); } 889 890$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename"); 891 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename); 892 } 893 894 if ($rmflag) 895 { 896$log->info("Removing file '$filename'"); 897 unlink($filename); 898 system("git-update-index", "--remove",$filename); 899 } 900 elsif ($addflag) 901 { 902$log->info("Adding file '$filename'"); 903 system("git-update-index", "--add",$filename); 904 } else { 905$log->info("Updating file '$filename'"); 906 system("git-update-index",$filename); 907 } 908 } 909 910 unless ( scalar(@committedfiles) > 0 ) 911 { 912 print "E No files to commit\n"; 913 print "ok\n"; 914 close LOCKFILE; 915 unlink($lockfile); 916 chdir "/"; 917 return; 918 } 919 920 my$treehash= `git-write-tree`; 921 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`; 922 chomp$treehash; 923 chomp$parenthash; 924 925$log->debug("Treehash :$treehash, Parenthash :$parenthash"); 926 927 # write our commit message out if we have one ... 928 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR); 929 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) ); 930 print$msg_fh"\n\nvia git-CVS emulator\n"; 931 close$msg_fh; 932 933 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`; 934$log->info("Commit hash :$commithash"); 935 936unless($commithash=~/[a-zA-Z0-9]{40}/) 937{ 938$log->warn("Commit failed (Invalid commit hash)"); 939print"error 1 Commit failed (unknown reason)\n"; 940close LOCKFILE; 941unlink($lockfile); 942chdir"/"; 943exit; 944} 945 946open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}"; 947print FILE $commithash; 948close FILE; 949 950$updater->update(); 951 952# foreach file specified on the commandline ... 953foreachmy$filename(@committedfiles) 954{ 955$filename= filecleanup($filename); 956 957my$meta=$updater->getmeta($filename); 958 959my($filepart,$dirpart) = filenamesplit($filename); 960 961$log->debug("Checked-in$dirpart:$filename"); 962 963if($meta->{filehash}eq"deleted") 964{ 965print"Remove-entry$dirpart\n"; 966print"$filename\n"; 967}else{ 968print"Checked-in$dirpart\n"; 969print"$filename\n"; 970print"/$filepart/1.$meta->{revision}///\n"; 971} 972} 973 974close LOCKFILE; 975unlink($lockfile); 976chdir"/"; 977 978print"ok\n"; 979} 980 981sub req_status 982{ 983my($cmd,$data) =@_; 984 985 argsplit("status"); 986 987$log->info("req_status : ". (defined($data) ?$data:"[NULL]")); 988#$log->debug("status state : " . Dumper($state)); 989 990# Grab a handle to the SQLite db and do any necessary updates 991my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 992$updater->update(); 993 994# if no files were specified, we need to work out what files we should be providing status on ... 995 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 996 997# foreach file specified on the commandline ... 998foreachmy$filename( @{$state->{args}} ) 999{1000$filename= filecleanup($filename);10011002my$meta=$updater->getmeta($filename);1003my$oldmeta=$meta;10041005my$wrev= revparse($filename);10061007# If the working copy is an old revision, lets get that version too for comparison.1008if(defined($wrev)and$wrev!=$meta->{revision} )1009{1010$oldmeta=$updater->getmeta($filename,$wrev);1011}10121013# TODO : All possible statuses aren't yet implemented1014my$status;1015# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1016$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1017and1018( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1019or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1020);10211022# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1023$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1024and1025($state->{entries}{$filename}{unchanged}1026or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1027);10281029# Need checkout if it exists in the repo but doesn't have a working copy1030$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );10311032# Locally modified if working copy and repo copy have the same revision but there are local changes1033$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );10341035# Needs Merge if working copy revision is less than repo copy and there are local changes1036$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );10371038$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1039$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1040$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1041$status||="File had conflicts on merge"if(0);10421043$status||="Unknown";10441045print"M ===================================================================\n";1046print"M File:$filename\tStatus:$status\n";1047if(defined($state->{entries}{$filename}{revision}) )1048{1049print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1050}else{1051print"M Working revision:\tNo entry for$filename\n";1052}1053if(defined($meta->{revision}) )1054{1055print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1056print"M Sticky Tag:\t\t(none)\n";1057print"M Sticky Date:\t\t(none)\n";1058print"M Sticky Options:\t\t(none)\n";1059}else{1060print"M Repository revision:\tNo revision control file\n";1061}1062print"M\n";1063}10641065print"ok\n";1066}10671068sub req_diff1069{1070my($cmd,$data) =@_;10711072 argsplit("diff");10731074$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1075#$log->debug("status state : " . Dumper($state));10761077my($revision1,$revision2);1078if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1079{1080$revision1=$state->{opt}{r}[0];1081$revision2=$state->{opt}{r}[1];1082}else{1083$revision1=$state->{opt}{r};1084}10851086$revision1=~s/^1\.//if(defined($revision1) );1087$revision2=~s/^1\.//if(defined($revision2) );10881089$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );10901091# Grab a handle to the SQLite db and do any necessary updates1092my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1093$updater->update();10941095# if no files were specified, we need to work out what files we should be providing status on ...1096 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);10971098# foreach file specified on the commandline ...1099foreachmy$filename( @{$state->{args}} )1100{1101$filename= filecleanup($filename);11021103my($fh,$file1,$file2,$meta1,$meta2,$filediff);11041105my$wrev= revparse($filename);11061107# We need _something_ to diff against1108next unless(defined($wrev) );11091110# if we have a -r switch, use it1111if(defined($revision1) )1112{1113(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1114$meta1=$updater->getmeta($filename,$revision1);1115unless(defined($meta1)and$meta1->{filehash}ne"deleted")1116{1117print"E File$filenameat revision 1.$revision1doesn't exist\n";1118next;1119}1120 transmitfile($meta1->{filehash},$file1);1121}1122# otherwise we just use the working copy revision1123else1124{1125(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1126$meta1=$updater->getmeta($filename,$wrev);1127 transmitfile($meta1->{filehash},$file1);1128}11291130# if we have a second -r switch, use it too1131if(defined($revision2) )1132{1133(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1134$meta2=$updater->getmeta($filename,$revision2);11351136unless(defined($meta2)and$meta2->{filehash}ne"deleted")1137{1138print"E File$filenameat revision 1.$revision2doesn't exist\n";1139next;1140}11411142 transmitfile($meta2->{filehash},$file2);1143}1144# otherwise we just use the working copy1145else1146{1147$file2=$state->{entries}{$filename}{modified_filename};1148}11491150# if we have been given -r, and we don't have a $file2 yet, lets get one1151if(defined($revision1)and not defined($file2) )1152{1153(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1154$meta2=$updater->getmeta($filename,$wrev);1155 transmitfile($meta2->{filehash},$file2);1156}11571158# We need to have retrieved something useful1159next unless(defined($meta1) );11601161# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1162next if(not defined($meta2)and$wrev==$meta1->{revision}1163and1164( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1165or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1166);11671168# Apparently we only show diffs for locally modified files1169next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );11701171print"M Index:$filename\n";1172print"M ===================================================================\n";1173print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1174print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1175print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1176print"M diff ";1177foreachmy$opt(keys%{$state->{opt}} )1178{1179if(ref$state->{opt}{$opt}eq"ARRAY")1180{1181foreachmy$value( @{$state->{opt}{$opt}} )1182{1183print"-$opt$value";1184}1185}else{1186print"-$opt";1187print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1188}1189}1190print"$filename\n";11911192$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));11931194($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);11951196if(exists$state->{opt}{u} )1197{1198system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1199}else{1200system("diff$file1$file2>$filediff");1201}12021203while( <$fh> )1204{1205print"M$_";1206}1207close$fh;1208}12091210print"ok\n";1211}12121213sub req_log1214{1215my($cmd,$data) =@_;12161217 argsplit("log");12181219$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1220#$log->debug("log state : " . Dumper($state));12211222my($minrev,$maxrev);1223if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1224{1225my$control=$2;1226$minrev=$1;1227$maxrev=$3;1228$minrev=~s/^1\.//if(defined($minrev) );1229$maxrev=~s/^1\.//if(defined($maxrev) );1230$minrev++if(defined($minrev)and$controleq"::");1231}12321233# Grab a handle to the SQLite db and do any necessary updates1234my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1235$updater->update();12361237# if no files were specified, we need to work out what files we should be providing status on ...1238 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12391240# foreach file specified on the commandline ...1241foreachmy$filename( @{$state->{args}} )1242{1243$filename= filecleanup($filename);12441245my$headmeta=$updater->getmeta($filename);12461247my$revisions=$updater->getlog($filename);1248my$totalrevisions=scalar(@$revisions);12491250if(defined($minrev) )1251{1252$log->debug("Removing revisions less than$minrev");1253while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1254{1255pop@$revisions;1256}1257}1258if(defined($maxrev) )1259{1260$log->debug("Removing revisions greater than$maxrev");1261while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1262{1263shift@$revisions;1264}1265}12661267next unless(scalar(@$revisions) );12681269print"M\n";1270print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1271print"M Working file:$filename\n";1272print"M head: 1.$headmeta->{revision}\n";1273print"M branch:\n";1274print"M locks: strict\n";1275print"M access list:\n";1276print"M symbolic names:\n";1277print"M keyword substitution: kv\n";1278print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1279print"M description:\n";12801281foreachmy$revision(@$revisions)1282{1283print"M ----------------------------\n";1284print"M revision 1.$revision->{revision}\n";1285# reformat the date for log output1286$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}) );1287$revision->{author} =~s/\s+.*//;1288$revision->{author} =~s/^(.{8}).*/$1/;1289print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1290my$commitmessage=$updater->commitmessage($revision->{commithash});1291$commitmessage=~s/^/M /mg;1292print$commitmessage."\n";1293}1294print"M =============================================================================\n";1295}12961297print"ok\n";1298}12991300sub req_annotate1301{1302my($cmd,$data) =@_;13031304 argsplit("annotate");13051306$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1307#$log->debug("status state : " . Dumper($state));13081309# Grab a handle to the SQLite db and do any necessary updates1310my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1311$updater->update();13121313# if no files were specified, we need to work out what files we should be providing annotate on ...1314 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);13151316# we'll need a temporary checkout dir1317my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1318my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1319$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");13201321$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1322$ENV{GIT_INDEX_FILE} =$file_index;13231324chdir$tmpdir;13251326# foreach file specified on the commandline ...1327foreachmy$filename( @{$state->{args}} )1328{1329$filename= filecleanup($filename);13301331my$meta=$updater->getmeta($filename);13321333next unless($meta->{revision} );13341335# get all the commits that this file was in1336# in dense format -- aka skip dead revisions1337my$revisions=$updater->gethistorydense($filename);1338my$lastseenin=$revisions->[0][2];13391340# populate the temporary index based on the latest commit were we saw1341# the file -- but do it cheaply without checking out any files1342# TODO: if we got a revision from the client, use that instead1343# to look up the commithash in sqlite (still good to default to1344# the current head as we do now)1345system("git-read-tree",$lastseenin);1346unless($?==0)1347{1348die"Error running git-read-tree$lastseenin$file_index$!";1349}1350$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");13511352# do a checkout of the file1353system('git-checkout-index','-f','-u',$filename);1354unless($?==0) {1355die"Error running git-checkout-index -f -u$filename:$!";1356}13571358$log->info("Annotate$filename");13591360# Prepare a file with the commits from the linearized1361# history that annotate should know about. This prevents1362# git-jsannotate telling us about commits we are hiding1363# from the client.13641365open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1366for(my$i=0;$i<@$revisions;$i++)1367{1368print ANNOTATEHINTS $revisions->[$i][2];1369if($i+1<@$revisions) {# have we got a parent?1370print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1371}1372print ANNOTATEHINTS "\n";1373}13741375print ANNOTATEHINTS "\n";1376close ANNOTATEHINTS;13771378my$annotatecmd='git-annotate';1379open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1380or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1381my$metadata= {};1382print"E Annotations for$filename\n";1383print"E ***************\n";1384while( <ANNOTATE> )1385{1386if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1387{1388my$commithash=$1;1389my$data=$2;1390unless(defined($metadata->{$commithash} ) )1391{1392$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1393$metadata->{$commithash}{author} =~s/\s+.*//;1394$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1395$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1396}1397printf("M 1.%-5d (%-8s%10s):%s\n",1398$metadata->{$commithash}{revision},1399$metadata->{$commithash}{author},1400$metadata->{$commithash}{modified},1401$data1402);1403}else{1404$log->warn("Error in annotate output! LINE:$_");1405print"E Annotate error\n";1406next;1407}1408}1409close ANNOTATE;1410}14111412# done; get out of the tempdir1413chdir"/";14141415print"ok\n";14161417}14181419# This method takes the state->{arguments} array and produces two new arrays.1420# The first is $state->{args} which is everything before the '--' argument, and1421# the second is $state->{files} which is everything after it.1422sub argsplit1423{1424return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");14251426my$type=shift;14271428$state->{args} = [];1429$state->{files} = [];1430$state->{opt} = {};14311432if(defined($type) )1433{1434my$opt= {};1435$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");1436$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1437$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");1438$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1439$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1440$opt= { k =>1, m =>1}if($typeeq"add");1441$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1442$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");144314441445while(scalar( @{$state->{arguments}} ) >0)1446{1447my$arg=shift@{$state->{arguments}};14481449next if($argeq"--");1450next unless($arg=~/\S/);14511452# if the argument looks like a switch1453if($arg=~/^-(\w)(.*)/)1454{1455# if it's a switch that takes an argument1456if($opt->{$1} )1457{1458# If this switch has already been provided1459if($opt->{$1} >1and exists($state->{opt}{$1} ) )1460{1461$state->{opt}{$1} = [$state->{opt}{$1} ];1462if(length($2) >0)1463{1464push@{$state->{opt}{$1}},$2;1465}else{1466push@{$state->{opt}{$1}},shift@{$state->{arguments}};1467}1468}else{1469# if there's extra data in the arg, use that as the argument for the switch1470if(length($2) >0)1471{1472$state->{opt}{$1} =$2;1473}else{1474$state->{opt}{$1} =shift@{$state->{arguments}};1475}1476}1477}else{1478$state->{opt}{$1} =undef;1479}1480}1481else1482{1483push@{$state->{args}},$arg;1484}1485}1486}1487else1488{1489my$mode=0;14901491foreachmy$value( @{$state->{arguments}} )1492{1493if($valueeq"--")1494{1495$mode++;1496next;1497}1498push@{$state->{args}},$valueif($mode==0);1499push@{$state->{files}},$valueif($mode==1);1500}1501}1502}15031504# This method uses $state->{directory} to populate $state->{args} with a list of filenames1505sub argsfromdir1506{1507my$updater=shift;15081509$state->{args} = [];15101511foreachmy$file( @{$updater->gethead} )1512{1513next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1514next unless($file->{name} =~s/^$state->{directory}//);1515push@{$state->{args}},$file->{name};1516}1517}15181519# This method cleans up the $state variable after a command that uses arguments has run1520sub statecleanup1521{1522$state->{files} = [];1523$state->{args} = [];1524$state->{arguments} = [];1525$state->{entries} = {};1526}15271528sub revparse1529{1530my$filename=shift;15311532returnundefunless(defined($state->{entries}{$filename}{revision} ) );15331534return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1535return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);15361537returnundef;1538}15391540# This method takes a file hash and does a CVS "file transfer" which transmits the1541# size of the file, and then the file contents.1542# If a second argument $targetfile is given, the file is instead written out to1543# a file by the name of $targetfile1544sub transmitfile1545{1546my$filehash=shift;1547my$targetfile=shift;15481549if(defined($filehash)and$filehasheq"deleted")1550{1551$log->warn("filehash is 'deleted'");1552return;1553}15541555die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);15561557my$type=`git-cat-file -t$filehash`;1558 chomp$type;15591560 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );15611562 my$size= `git-cat-file -s $filehash`;1563chomp$size;15641565$log->debug("transmitfile($filehash) size=$size, type=$type");15661567if(open my$fh,'-|',"git-cat-file","blob",$filehash)1568{1569if(defined($targetfile) )1570{1571open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1572print NEWFILE $_while( <$fh> );1573close NEWFILE;1574}else{1575print"$size\n";1576printwhile( <$fh> );1577}1578close$fhor die("Couldn't close filehandle for transmitfile()");1579}else{1580die("Couldn't execute git-cat-file");1581}1582}15831584# This method takes a file name, and returns ( $dirpart, $filepart ) which1585# refers to the directory porition and the file portion of the filename1586# respectively1587sub filenamesplit1588{1589my$filename=shift;15901591my($filepart,$dirpart) = ($filename,".");1592($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1593$dirpart.="/";15941595return($filepart,$dirpart);1596}15971598sub filecleanup1599{1600my$filename=shift;16011602returnundefunless(defined($filename));1603if($filename=~/^\// )1604{1605print"E absolute filenames '$filename' not supported by server\n";1606returnundef;1607}16081609$filename=~s/^\.\///g;1610$filename=$state->{directory} .$filename;16111612return$filename;1613}16141615package GITCVS::log;16161617####1618#### Copyright The Open University UK - 2006.1619####1620#### Authors: Martyn Smith <martyn@catalyst.net.nz>1621#### Martin Langhoff <martin@catalyst.net.nz>1622####1623####16241625use strict;1626use warnings;16271628=head1 NAME16291630GITCVS::log16311632=head1 DESCRIPTION16331634This module provides very crude logging with a similar interface to1635Log::Log4perl16361637=head1 METHODS16381639=cut16401641=head2 new16421643Creates a new log object, optionally you can specify a filename here to1644indicate the file to log to. If no log file is specified, you can specifiy one1645later with method setfile, or indicate you no longer want logging with method1646nofile.16471648Until one of these methods is called, all log calls will buffer messages ready1649to write out.16501651=cut1652sub new1653{1654my$class=shift;1655my$filename=shift;16561657my$self= {};16581659bless$self,$class;16601661if(defined($filename) )1662{1663open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1664}16651666return$self;1667}16681669=head2 setfile16701671This methods takes a filename, and attempts to open that file as the log file.1672If successful, all buffered data is written out to the file, and any further1673logging is written directly to the file.16741675=cut1676sub setfile1677{1678my$self=shift;1679my$filename=shift;16801681if(defined($filename) )1682{1683open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1684}16851686return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");16871688while(my$line=shift@{$self->{buffer}} )1689{1690print{$self->{fh}}$line;1691}1692}16931694=head2 nofile16951696This method indicates no logging is going to be used. It flushes any entries in1697the internal buffer, and sets a flag to ensure no further data is put there.16981699=cut1700sub nofile1701{1702my$self=shift;17031704$self->{nolog} =1;17051706return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");17071708$self->{buffer} = [];1709}17101711=head2 _logopen17121713Internal method. Returns true if the log file is open, false otherwise.17141715=cut1716sub _logopen1717{1718my$self=shift;17191720return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1721return0;1722}17231724=head2 debug info warn fatal17251726These four methods are wrappers to _log. They provide the actual interface for1727logging data.17281729=cut1730sub debug {my$self=shift;$self->_log("debug",@_); }1731sub info {my$self=shift;$self->_log("info",@_); }1732subwarn{my$self=shift;$self->_log("warn",@_); }1733sub fatal {my$self=shift;$self->_log("fatal",@_); }17341735=head2 _log17361737This is an internal method called by the logging functions. It generates a1738timestamp and pushes the logged line either to file, or internal buffer.17391740=cut1741sub _log1742{1743my$self=shift;1744my$level=shift;17451746return if($self->{nolog} );17471748my@time=localtime;1749my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1750$time[5] +1900,1751$time[4] +1,1752$time[3],1753$time[2],1754$time[1],1755$time[0],1756uc$level,1757);17581759if($self->_logopen)1760{1761print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1762}else{1763push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1764}1765}17661767=head2 DESTROY17681769This method simply closes the file handle if one is open17701771=cut1772sub DESTROY1773{1774my$self=shift;17751776if($self->_logopen)1777{1778close$self->{fh};1779}1780}17811782package GITCVS::updater;17831784####1785#### Copyright The Open University UK - 2006.1786####1787#### Authors: Martyn Smith <martyn@catalyst.net.nz>1788#### Martin Langhoff <martin@catalyst.net.nz>1789####1790####17911792use strict;1793use warnings;1794use DBI;17951796=head1 METHODS17971798=cut17991800=head2 new18011802=cut1803sub new1804{1805my$class=shift;1806my$config=shift;1807my$module=shift;1808my$log=shift;18091810die"Need to specify a git repository"unless(defined($config)and-d $config);1811die"Need to specify a module"unless(defined($module) );18121813$class=ref($class) ||$class;18141815my$self= {};18161817bless$self,$class;18181819$self->{dbdir} =$config."/";1820die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );18211822$self->{module} =$module;1823$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";18241825$self->{git_path} =$config."/";18261827$self->{log} =$log;18281829die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );18301831$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");18321833$self->{tables} = {};1834foreachmy$table($self->{dbh}->tables)1835{1836$table=~s/^"//;1837$table=~s/"$//;1838$self->{tables}{$table} =1;1839}18401841# Construct the revision table if required1842unless($self->{tables}{revision} )1843{1844$self->{dbh}->do("1845 CREATE TABLE revision (1846 name TEXT NOT NULL,1847 revision INTEGER NOT NULL,1848 filehash TEXT NOT NULL,1849 commithash TEXT NOT NULL,1850 author TEXT NOT NULL,1851 modified TEXT NOT NULL,1852 mode TEXT NOT NULL1853 )1854 ");1855}18561857# Construct the revision table if required1858unless($self->{tables}{head} )1859{1860$self->{dbh}->do("1861 CREATE TABLE head (1862 name TEXT NOT NULL,1863 revision INTEGER NOT NULL,1864 filehash TEXT NOT NULL,1865 commithash TEXT NOT NULL,1866 author TEXT NOT NULL,1867 modified TEXT NOT NULL,1868 mode TEXT NOT NULL1869 )1870 ");1871}18721873# Construct the properties table if required1874unless($self->{tables}{properties} )1875{1876$self->{dbh}->do("1877 CREATE TABLE properties (1878 key TEXT NOT NULL PRIMARY KEY,1879 value TEXT1880 )1881 ");1882}18831884# Construct the commitmsgs table if required1885unless($self->{tables}{commitmsgs} )1886{1887$self->{dbh}->do("1888 CREATE TABLE commitmsgs (1889 key TEXT NOT NULL PRIMARY KEY,1890 value TEXT1891 )1892 ");1893}18941895return$self;1896}18971898=head2 update18991900=cut1901sub update1902{1903my$self=shift;19041905# first lets get the commit list1906$ENV{GIT_DIR} =$self->{git_path};19071908# prepare database queries1909my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);1910my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);1911my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);1912my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);19131914my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;1915unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)1916{1917die("Invalid module '$self->{module}'");1918}191919201921my$git_log;1922my$lastcommit=$self->_get_prop("last_commit");19231924# Start exclusive lock here...1925$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";19261927# TODO: log processing is memory bound1928# if we can parse into a 2nd file that is in reverse order1929# we can probably do something really efficient1930my@git_log_params= ('--parents','--topo-order');19311932if(defined$lastcommit) {1933push@git_log_params,"$lastcommit..$self->{module}";1934}else{1935push@git_log_params,$self->{module};1936}1937open(GITLOG,'-|','git-log',@git_log_params)or die"Cannot call git-log:$!";19381939my@commits;19401941my%commit= ();19421943while( <GITLOG> )1944{1945chomp;1946if(m/^commit\s+(.*)$/) {1947# on ^commit lines put the just seen commit in the stack1948# and prime things for the next one1949if(keys%commit) {1950my%copy=%commit;1951unshift@commits, \%copy;1952%commit= ();1953}1954my@parents=split(m/\s+/,$1);1955$commit{hash} =shift@parents;1956$commit{parents} = \@parents;1957}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {1958# on rfc822-like lines seen before we see any message,1959# lowercase the entry and put it in the hash as key-value1960$commit{lc($1)} =$2;1961}else{1962# message lines - skip initial empty line1963# and trim whitespace1964if(!exists($commit{message}) &&m/^\s*$/) {1965# define it to mark the end of headers1966$commit{message} ='';1967next;1968}1969s/^\s+//;s/\s+$//;# trim ws1970$commit{message} .=$_."\n";1971}1972}1973close GITLOG;19741975unshift@commits, \%commitif(keys%commit);19761977# Now all the commits are in the @commits bucket1978# ordered by time DESC. for each commit that needs processing,1979# determine whether it's following the last head we've seen or if1980# it's on its own branch, grab a file list, and add whatever's changed1981# NOTE: $lastcommit refers to the last commit from previous run1982# $lastpicked is the last commit we picked in this run1983my$lastpicked;1984my$head= {};1985if(defined$lastcommit) {1986$lastpicked=$lastcommit;1987}19881989my$committotal=scalar(@commits);1990my$commitcount=0;19911992# Load the head table into $head (for cached lookups during the update process)1993foreachmy$file( @{$self->gethead()} )1994{1995$head->{$file->{name}} =$file;1996}19971998foreachmy$commit(@commits)1999{2000$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2001if(defined$lastpicked)2002{2003if(!in_array($lastpicked, @{$commit->{parents}}))2004{2005# skip, we'll see this delta2006# as part of a merge later2007# warn "skipping off-track $commit->{hash}\n";2008next;2009}elsif(@{$commit->{parents}} >1) {2010# it is a merge commit, for each parent that is2011# not $lastpicked, see if we can get a log2012# from the merge-base to that parent to put it2013# in the message as a merge summary.2014my@parents= @{$commit->{parents}};2015foreachmy$parent(@parents) {2016# git-merge-base can potentially (but rarely) throw2017# several candidate merge bases. let's assume2018# that the first one is the best one.2019if($parenteq$lastpicked) {2020next;2021}2022open my$p,'git-merge-base '.$lastpicked.' '2023.$parent.'|';2024my@output= (<$p>);2025close$p;2026my$base=join('',@output);2027chomp$base;2028if($base) {2029my@merged;2030# print "want to log between $base $parent \n";2031open(GITLOG,'-|','git-log',"$base..$parent")2032or die"Cannot call git-log:$!";2033my$mergedhash;2034while(<GITLOG>) {2035chomp;2036if(!defined$mergedhash) {2037if(m/^commit\s+(.+)$/) {2038$mergedhash=$1;2039}else{2040next;2041}2042}else{2043# grab the first line that looks non-rfc8222044# aka has content after leading space2045if(m/^\s+(\S.*)$/) {2046my$title=$1;2047$title=substr($title,0,100);# truncate2048unshift@merged,"$mergedhash$title";2049undef$mergedhash;2050}2051}2052}2053close GITLOG;2054if(@merged) {2055$commit->{mergemsg} =$commit->{message};2056$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2057foreachmy$summary(@merged) {2058$commit->{mergemsg} .="\t$summary\n";2059}2060$commit->{mergemsg} .="\n\n";2061# print "Message for $commit->{hash} \n$commit->{mergemsg}";2062}2063}2064}2065}2066}20672068# convert the date to CVS-happy format2069$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);20702071if(defined($lastpicked) )2072{2073my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2074while( <FILELIST> )2075{2076unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2077{2078die("Couldn't process git-diff-tree line :$_");2079}20802081# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");20822083my$git_perms="";2084$git_perms.="r"if($1&4);2085$git_perms.="w"if($1&2);2086$git_perms.="x"if($1&1);2087$git_perms="rw"if($git_permseq"");20882089if($3eq"D")2090{2091#$log->debug("DELETE $4");2092$head->{$4} = {2093 name =>$4,2094 revision =>$head->{$4}{revision} +1,2095 filehash =>"deleted",2096 commithash =>$commit->{hash},2097 modified =>$commit->{date},2098 author =>$commit->{author},2099 mode =>$git_perms,2100};2101$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2102}2103elsif($3eq"M")2104{2105#$log->debug("MODIFIED $4");2106$head->{$4} = {2107 name =>$4,2108 revision =>$head->{$4}{revision} +1,2109 filehash =>$2,2110 commithash =>$commit->{hash},2111 modified =>$commit->{date},2112 author =>$commit->{author},2113 mode =>$git_perms,2114};2115$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2116}2117elsif($3eq"A")2118{2119#$log->debug("ADDED $4");2120$head->{$4} = {2121 name =>$4,2122 revision =>1,2123 filehash =>$2,2124 commithash =>$commit->{hash},2125 modified =>$commit->{date},2126 author =>$commit->{author},2127 mode =>$git_perms,2128};2129$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2130}2131else2132{2133$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2134die;2135}2136}2137close FILELIST;2138}else{2139# this is used to detect files removed from the repo2140my$seen_files= {};21412142my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2143while( <FILELIST> )2144{2145unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2146{2147die("Couldn't process git-ls-tree line :$_");2148}21492150my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);21512152$seen_files->{$git_filename} =1;21532154my($oldhash,$oldrevision,$oldmode) = (2155$head->{$git_filename}{filehash},2156$head->{$git_filename}{revision},2157$head->{$git_filename}{mode}2158);21592160if($git_perms=~/^\d\d\d(\d)\d\d/o)2161{2162$git_perms="";2163$git_perms.="r"if($1&4);2164$git_perms.="w"if($1&2);2165$git_perms.="x"if($1&1);2166}else{2167$git_perms="rw";2168}21692170# unless the file exists with the same hash, we need to update it ...2171unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2172{2173my$newrevision= ($oldrevisionor0) +1;21742175$head->{$git_filename} = {2176 name =>$git_filename,2177 revision =>$newrevision,2178 filehash =>$git_hash,2179 commithash =>$commit->{hash},2180 modified =>$commit->{date},2181 author =>$commit->{author},2182 mode =>$git_perms,2183};218421852186$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2187}2188}2189close FILELIST;21902191# Detect deleted files2192foreachmy$file(keys%$head)2193{2194unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2195{2196$head->{$file}{revision}++;2197$head->{$file}{filehash} ="deleted";2198$head->{$file}{commithash} =$commit->{hash};2199$head->{$file}{modified} =$commit->{date};2200$head->{$file}{author} =$commit->{author};22012202$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2203}2204}2205# END : "Detect deleted files"2206}220722082209if(exists$commit->{mergemsg})2210{2211$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2212}22132214$lastpicked=$commit->{hash};22152216$self->_set_prop("last_commit",$commit->{hash});2217}22182219$db_delete_head->execute();2220foreachmy$file(keys%$head)2221{2222$db_insert_head->execute(2223$file,2224$head->{$file}{revision},2225$head->{$file}{filehash},2226$head->{$file}{commithash},2227$head->{$file}{modified},2228$head->{$file}{author},2229$head->{$file}{mode},2230);2231}2232# invalidate the gethead cache2233$self->{gethead_cache} =undef;223422352236# Ending exclusive lock here2237$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2238}22392240sub _headrev2241{2242my$self=shift;2243my$filename=shift;22442245my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2246$db_query->execute($filename);2247my($hash,$revision,$mode) =$db_query->fetchrow_array;22482249return($hash,$revision,$mode);2250}22512252sub _get_prop2253{2254my$self=shift;2255my$key=shift;22562257my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2258$db_query->execute($key);2259my($value) =$db_query->fetchrow_array;22602261return$value;2262}22632264sub _set_prop2265{2266my$self=shift;2267my$key=shift;2268my$value=shift;22692270my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2271$db_query->execute($value,$key);22722273unless($db_query->rows)2274{2275$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2276$db_query->execute($key,$value);2277}22782279return$value;2280}22812282=head2 gethead22832284=cut22852286sub gethead2287{2288my$self=shift;22892290return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );22912292my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);2293$db_query->execute();22942295my$tree= [];2296while(my$file=$db_query->fetchrow_hashref)2297{2298push@$tree,$file;2299}23002301$self->{gethead_cache} =$tree;23022303return$tree;2304}23052306=head2 getlog23072308=cut23092310sub getlog2311{2312my$self=shift;2313my$filename=shift;23142315my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2316$db_query->execute($filename);23172318my$tree= [];2319while(my$file=$db_query->fetchrow_hashref)2320{2321push@$tree,$file;2322}23232324return$tree;2325}23262327=head2 getmeta23282329This function takes a filename (with path) argument and returns a hashref of2330metadata for that file.23312332=cut23332334sub getmeta2335{2336my$self=shift;2337my$filename=shift;2338my$revision=shift;23392340my$db_query;2341if(defined($revision)and$revision=~/^\d+$/)2342{2343$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2344$db_query->execute($filename,$revision);2345}2346elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2347{2348$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2349$db_query->execute($filename,$revision);2350}else{2351$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2352$db_query->execute($filename);2353}23542355return$db_query->fetchrow_hashref;2356}23572358=head2 commitmessage23592360this function takes a commithash and returns the commit message for that commit23612362=cut2363sub commitmessage2364{2365my$self=shift;2366my$commithash=shift;23672368die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);23692370my$db_query;2371$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2372$db_query->execute($commithash);23732374my($message) =$db_query->fetchrow_array;23752376if(defined($message) )2377{2378$message.=" "if($message=~/\n$/);2379return$message;2380}23812382my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2383shift@lineswhile($lines[0] =~/\S/);2384$message=join("",@lines);2385$message.=" "if($message=~/\n$/);2386return$message;2387}23882389=head2 gethistory23902391This function takes a filename (with path) argument and returns an arrayofarrays2392containing revision,filehash,commithash ordered by revision descending23932394=cut2395sub gethistory2396{2397my$self=shift;2398my$filename=shift;23992400my$db_query;2401$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2402$db_query->execute($filename);24032404return$db_query->fetchall_arrayref;2405}24062407=head2 gethistorydense24082409This function takes a filename (with path) argument and returns an arrayofarrays2410containing revision,filehash,commithash ordered by revision descending.24112412This version of gethistory skips deleted entries -- so it is useful for annotate.2413The 'dense' part is a reference to a '--dense' option available for git-rev-list2414and other git tools that depend on it.24152416=cut2417sub gethistorydense2418{2419my$self=shift;2420my$filename=shift;24212422my$db_query;2423$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2424$db_query->execute($filename);24252426return$db_query->fetchall_arrayref;2427}24282429=head2 in_array()24302431from Array::PAT - mimics the in_array() function2432found in PHP. Yuck but works for small arrays.24332434=cut2435sub in_array2436{2437my($check,@array) =@_;2438my$retval=0;2439foreachmy$test(@array){2440if($checkeq$test){2441$retval=1;2442}2443}2444return$retval;2445}24462447=head2 safe_pipe_capture24482449an alterative to `command` that allows input to be passed as an array2450to work around shell problems with weird characters in arguments24512452=cut2453sub safe_pipe_capture {24542455my@output;24562457if(my$pid=open my$child,'-|') {2458@output= (<$child>);2459close$childor die join(' ',@_).":$!$?";2460}else{2461exec(@_)or die"$!$?";# exec() can fail the executable can't be found2462}2463returnwantarray?@output:join('',@output);2464}2465246624671;