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'Argument'=> \&req_Argument, 57'Argumentx'=> \&req_Argument, 58'expand-modules'=> \&req_expandmodules, 59'add'=> \&req_add, 60'remove'=> \&req_remove, 61'co'=> \&req_co, 62'update'=> \&req_update, 63'ci'=> \&req_ci, 64'diff'=> \&req_diff, 65'log'=> \&req_log, 66'tag'=> \&req_CATCHALL, 67'status'=> \&req_status, 68'admin'=> \&req_CATCHALL, 69'history'=> \&req_CATCHALL, 70'watchers'=> \&req_CATCHALL, 71'editors'=> \&req_CATCHALL, 72'annotate'=> \&req_annotate, 73'Global_option'=> \&req_Globaloption, 74#'annotate' => \&req_CATCHALL, 75}; 76 77############################################## 78 79 80# $state holds all the bits of information the clients sends us that could 81# potentially be useful when it comes to actually _doing_ something. 82my$state= {}; 83$log->info("--------------- STARTING -----------------"); 84 85my$TEMP_DIR= tempdir( CLEANUP =>1); 86$log->debug("Temporary directory is '$TEMP_DIR'"); 87 88# Keep going until the client closes the connection 89while(<STDIN>) 90{ 91chomp; 92 93# Check to see if we've seen this method, and call appropiate function. 94if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 95{ 96# use the $methods hash to call the appropriate sub for this command 97#$log->info("Method : $1"); 98&{$methods->{$1}}($1,$2); 99}else{ 100# log fatal because we don't understand this function. If this happens 101# we're fairly screwed because we don't know if the client is expecting 102# a response. If it is, the client will hang, we'll hang, and the whole 103# thing will be custard. 104$log->fatal("Don't understand command$_\n"); 105die("Unknown command$_"); 106} 107} 108 109$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 110$log->info("--------------- FINISH -----------------"); 111 112# Magic catchall method. 113# This is the method that will handle all commands we haven't yet 114# implemented. It simply sends a warning to the log file indicating a 115# command that hasn't been implemented has been invoked. 116sub req_CATCHALL 117{ 118my($cmd,$data) =@_; 119$log->warn("Unhandled command : req_$cmd:$data"); 120} 121 122 123# Root pathname \n 124# Response expected: no. Tell the server which CVSROOT to use. Note that 125# pathname is a local directory and not a fully qualified CVSROOT variable. 126# pathname must already exist; if creating a new root, use the init 127# request, not Root. pathname does not include the hostname of the server, 128# how to access the server, etc.; by the time the CVS protocol is in use, 129# connection, authentication, etc., are already taken care of. The Root 130# request must be sent only once, and it must be sent before any requests 131# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 132sub req_Root 133{ 134my($cmd,$data) =@_; 135$log->debug("req_Root :$data"); 136 137$state->{CVSROOT} =$data; 138 139$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 140 141foreachmy$line(`git-var -l`) 142{ 143next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 144$cfg->{$1}{$2} =$3; 145} 146 147unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 148{ 149print"E GITCVS emulation needs to be enabled on this repo\n"; 150print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 151print"E\n"; 152print"error 1 GITCVS emulation disabled\n"; 153} 154 155if(defined($cfg->{gitcvs}{logfile} ) ) 156{ 157$log->setfile($cfg->{gitcvs}{logfile}); 158}else{ 159$log->nofile(); 160} 161} 162 163# Global_option option \n 164# Response expected: no. Transmit one of the global options `-q', `-Q', 165# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 166# variations (such as combining of options) are allowed. For graceful 167# handling of valid-requests, it is probably better to make new global 168# options separate requests, rather than trying to add them to this 169# request. 170sub req_Globaloption 171{ 172my($cmd,$data) =@_; 173$log->debug("req_Globaloption :$data"); 174 175# TODO : is this data useful ??? 176} 177 178# Valid-responses request-list \n 179# Response expected: no. Tell the server what responses the client will 180# accept. request-list is a space separated list of tokens. 181sub req_Validresponses 182{ 183my($cmd,$data) =@_; 184$log->debug("req_Validrepsonses :$data"); 185 186# TODO : re-enable this, currently it's not particularly useful 187#$state->{validresponses} = [ split /\s+/, $data ]; 188} 189 190# valid-requests \n 191# Response expected: yes. Ask the server to send back a Valid-requests 192# response. 193sub req_validrequests 194{ 195my($cmd,$data) =@_; 196 197$log->debug("req_validrequests"); 198 199$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 200$log->debug("SEND : ok"); 201 202print"Valid-requests ".join(" ",keys%$methods) ."\n"; 203print"ok\n"; 204} 205 206# Directory local-directory \n 207# Additional data: repository \n. Response expected: no. Tell the server 208# what directory to use. The repository should be a directory name from a 209# previous server response. Note that this both gives a default for Entry 210# and Modified and also for ci and the other commands; normal usage is to 211# send Directory for each directory in which there will be an Entry or 212# Modified, and then a final Directory for the original directory, then the 213# command. The local-directory is relative to the top level at which the 214# command is occurring (i.e. the last Directory which is sent before the 215# command); to indicate that top level, `.' should be sent for 216# local-directory. 217sub req_Directory 218{ 219my($cmd,$data) =@_; 220 221my$repository= <STDIN>; 222chomp$repository; 223 224 225$state->{localdir} =$data; 226$state->{repository} =$repository; 227$state->{directory} =$repository; 228$state->{directory} =~s/^$state->{CVSROOT}\///; 229$state->{module} =$1if($state->{directory} =~s/^(.*?)(\/|$)//); 230$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 231 232$log->debug("req_Directory : localdir=$datarepository=$repositorydirectory=$state->{directory} module=$state->{module}"); 233} 234 235# Entry entry-line \n 236# Response expected: no. Tell the server what version of a file is on the 237# local machine. The name in entry-line is a name relative to the directory 238# most recently specified with Directory. If the user is operating on only 239# some files in a directory, Entry requests for only those files need be 240# included. If an Entry request is sent without Modified, Is-modified, or 241# Unchanged, it means the file is lost (does not exist in the working 242# directory). If both Entry and one of Modified, Is-modified, or Unchanged 243# are sent for the same file, Entry must be sent first. For a given file, 244# one can send Modified, Is-modified, or Unchanged, but not more than one 245# of these three. 246sub req_Entry 247{ 248my($cmd,$data) =@_; 249 250$log->debug("req_Entry :$data"); 251 252my@data=split(/\//,$data); 253 254$state->{entries}{$state->{directory}.$data[1]} = { 255 revision =>$data[2], 256 conflict =>$data[3], 257 options =>$data[4], 258 tag_or_date =>$data[5], 259}; 260} 261 262# add \n 263# Response expected: yes. Add a file or directory. This uses any previous 264# Argument, Directory, Entry, or Modified requests, if they have been sent. 265# The last Directory sent specifies the working directory at the time of 266# the operation. To add a directory, send the directory to be added using 267# Directory and Argument requests. 268sub req_add 269{ 270my($cmd,$data) =@_; 271 272 argsplit("add"); 273 274my$addcount=0; 275 276foreachmy$filename( @{$state->{args}} ) 277{ 278$filename= filecleanup($filename); 279 280unless(defined($state->{entries}{$filename}{modified_filename} ) ) 281{ 282print"E cvs add: nothing known about `$filename'\n"; 283next; 284} 285# TODO : check we're not squashing an already existing file 286if(defined($state->{entries}{$filename}{revision} ) ) 287{ 288print"E cvs add: `$filename' has already been entered\n"; 289next; 290} 291 292 293my($filepart,$dirpart) = filenamesplit($filename); 294 295print"E cvs add: scheduling file `$filename' for addition\n"; 296 297print"Checked-in$dirpart\n"; 298print"$filename\n"; 299print"/$filepart/0///\n"; 300 301$addcount++; 302} 303 304if($addcount==1) 305{ 306print"E cvs add: use `cvs commit' to add this file permanently\n"; 307} 308elsif($addcount>1) 309{ 310print"E cvs add: use `cvs commit' to add these files permanently\n"; 311} 312 313print"ok\n"; 314} 315 316# remove \n 317# Response expected: yes. Remove a file. This uses any previous Argument, 318# Directory, Entry, or Modified requests, if they have been sent. The last 319# Directory sent specifies the working directory at the time of the 320# operation. Note that this request does not actually do anything to the 321# repository; the only effect of a successful remove request is to supply 322# the client with a new entries line containing `-' to indicate a removed 323# file. In fact, the client probably could perform this operation without 324# contacting the server, although using remove may cause the server to 325# perform a few more checks. The client sends a subsequent ci request to 326# actually record the removal in the repository. 327sub req_remove 328{ 329my($cmd,$data) =@_; 330 331 argsplit("remove"); 332 333# Grab a handle to the SQLite db and do any necessary updates 334my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 335$updater->update(); 336 337#$log->debug("add state : " . Dumper($state)); 338 339my$rmcount=0; 340 341foreachmy$filename( @{$state->{args}} ) 342{ 343$filename= filecleanup($filename); 344 345if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 346{ 347print"E cvs remove: file `$filename' still in working directory\n"; 348next; 349} 350 351my$meta=$updater->getmeta($filename); 352my$wrev= revparse($filename); 353 354unless(defined($wrev) ) 355{ 356print"E cvs remove: nothing known about `$filename'\n"; 357next; 358} 359 360if(defined($wrev)and$wrev<0) 361{ 362print"E cvs remove: file `$filename' already scheduled for removal\n"; 363next; 364} 365 366unless($wrev==$meta->{revision} ) 367{ 368# TODO : not sure if the format of this message is quite correct. 369print"E cvs remove: Up to date check failed for `$filename'\n"; 370next; 371} 372 373 374my($filepart,$dirpart) = filenamesplit($filename); 375 376print"E cvs remove: scheduling `$filename' for removal\n"; 377 378print"Checked-in$dirpart\n"; 379print"$filename\n"; 380print"/$filepart/-1.$wrev///\n"; 381 382$rmcount++; 383} 384 385if($rmcount==1) 386{ 387print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 388} 389elsif($rmcount>1) 390{ 391print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 392} 393 394print"ok\n"; 395} 396 397# Modified filename \n 398# Response expected: no. Additional data: mode, \n, file transmission. Send 399# the server a copy of one locally modified file. filename is a file within 400# the most recent directory sent with Directory; it must not contain `/'. 401# If the user is operating on only some files in a directory, only those 402# files need to be included. This can also be sent without Entry, if there 403# is no entry for the file. 404sub req_Modified 405{ 406my($cmd,$data) =@_; 407 408my$mode= <STDIN>; 409chomp$mode; 410my$size= <STDIN>; 411chomp$size; 412 413# Grab config information 414my$blocksize=8192; 415my$bytesleft=$size; 416my$tmp; 417 418# Get a filehandle/name to write it to 419my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 420 421# Loop over file data writing out to temporary file. 422while($bytesleft) 423{ 424$blocksize=$bytesleftif($bytesleft<$blocksize); 425read STDIN,$tmp,$blocksize; 426print$fh $tmp; 427$bytesleft-=$blocksize; 428} 429 430close$fh; 431 432# Ensure we have something sensible for the file mode 433if($mode=~/u=(\w+)/) 434{ 435$mode=$1; 436}else{ 437$mode="rw"; 438} 439 440# Save the file data in $state 441$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 442$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 443$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 444$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 445 446 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 447} 448 449# Unchanged filename\n 450# Response expected: no. Tell the server that filename has not been 451# modified in the checked out directory. The filename is a file within the 452# most recent directory sent with Directory; it must not contain `/'. 453sub req_Unchanged 454{ 455 my ($cmd,$data) =@_; 456 457$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 458 459 #$log->debug("req_Unchanged :$data"); 460} 461 462# Argument text\n 463# Response expected: no. Save argument for use in a subsequent command. 464# Arguments accumulate until an argument-using command is given, at which 465# point they are forgotten. 466# Argumentx text\n 467# Response expected: no. Append\nfollowed by text to the current argument 468# being saved. 469sub req_Argument 470{ 471 my ($cmd,$data) =@_; 472 473 # TODO : Not quite sure how Argument and Argumentx differ, but I assume 474 # it's for multi-line arguments ... somehow ... 475 476$log->debug("$cmd:$data"); 477 478push@{$state->{arguments}},$data; 479} 480 481# expand-modules \n 482# Response expected: yes. Expand the modules which are specified in the 483# arguments. Returns the data in Module-expansion responses. Note that the 484# server can assume that this is checkout or export, not rtag or rdiff; the 485# latter do not access the working directory and thus have no need to 486# expand modules on the client side. Expand may not be the best word for 487# what this request does. It does not necessarily tell you all the files 488# contained in a module, for example. Basically it is a way of telling you 489# which working directories the server needs to know about in order to 490# handle a checkout of the specified modules. For example, suppose that the 491# server has a module defined by 492# aliasmodule -a 1dir 493# That is, one can check out aliasmodule and it will take 1dir in the 494# repository and check it out to 1dir in the working directory. Now suppose 495# the client already has this module checked out and is planning on using 496# the co request to update it. Without using expand-modules, the client 497# would have two bad choices: it could either send information about all 498# working directories under the current directory, which could be 499# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 500# stands for 1dir, and neglect to send information for 1dir, which would 501# lead to incorrect operation. With expand-modules, the client would first 502# ask for the module to be expanded: 503sub req_expandmodules 504{ 505my($cmd,$data) =@_; 506 507 argsplit(); 508 509$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 510 511unless(ref$state->{arguments}eq"ARRAY") 512{ 513print"ok\n"; 514return; 515} 516 517foreachmy$module( @{$state->{arguments}} ) 518{ 519$log->debug("SEND : Module-expansion$module"); 520print"Module-expansion$module\n"; 521} 522 523print"ok\n"; 524 statecleanup(); 525} 526 527# co \n 528# Response expected: yes. Get files from the repository. This uses any 529# previous Argument, Directory, Entry, or Modified requests, if they have 530# been sent. Arguments to this command are module names; the client cannot 531# know what directories they correspond to except by (1) just sending the 532# co request, and then seeing what directory names the server sends back in 533# its responses, and (2) the expand-modules request. 534sub req_co 535{ 536my($cmd,$data) =@_; 537 538 argsplit("co"); 539 540my$module=$state->{args}[0]; 541my$checkout_path=$module; 542 543# use the user specified directory if we're given it 544$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 545 546$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 547 548$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 549 550$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 551 552# Grab a handle to the SQLite db and do any necessary updates 553my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 554$updater->update(); 555 556# instruct the client that we're checking out to $checkout_path 557print"E cvs server: updating$checkout_path\n"; 558 559foreachmy$git( @{$updater->gethead} ) 560{ 561# Don't want to check out deleted files 562next if($git->{filehash}eq"deleted"); 563 564($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 565 566# modification time of this file 567print"Mod-time$git->{modified}\n"; 568 569# print some information to the client 570print"MT +updated\n"; 571print"MT text U\n"; 572if(defined($git->{dir} )and$git->{dir}ne"./") 573{ 574print"MT fname$checkout_path/$git->{dir}$git->{name}\n"; 575}else{ 576print"MT fname$checkout_path/$git->{name}\n"; 577} 578print"MT newline\n"; 579print"MT -updated\n"; 580 581# instruct client we're sending a file to put in this path 582print"Created$checkout_path/". (defined($git->{dir} ) ?$git->{dir} ."/":"") ."\n"; 583 584print$state->{CVSROOT} ."/$module/". (defined($git->{dir} ) ?$git->{dir} ."/":"") ."$git->{name}\n"; 585 586# this is an "entries" line 587print"/$git->{name}/1.$git->{revision}///\n"; 588# permissions 589print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 590 591# transmit file 592 transmitfile($git->{filehash}); 593} 594 595print"ok\n"; 596 597 statecleanup(); 598} 599 600# update \n 601# Response expected: yes. Actually do a cvs update command. This uses any 602# previous Argument, Directory, Entry, or Modified requests, if they have 603# been sent. The last Directory sent specifies the working directory at the 604# time of the operation. The -I option is not used--files which the client 605# can decide whether to ignore are not mentioned and the client sends the 606# Questionable request for others. 607sub req_update 608{ 609my($cmd,$data) =@_; 610 611$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 612 613 argsplit("update"); 614 615# Grab a handle to the SQLite db and do any necessary updates 616my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 617 618$updater->update(); 619 620# if no files were specified, we need to work out what files we should be providing status on ... 621 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 622 623#$log->debug("update state : " . Dumper($state)); 624 625# foreach file specified on the commandline ... 626foreachmy$filename( @{$state->{args}} ) 627{ 628$filename= filecleanup($filename); 629 630# if we have a -C we should pretend we never saw modified stuff 631if(exists($state->{opt}{C} ) ) 632{ 633delete$state->{entries}{$filename}{modified_hash}; 634delete$state->{entries}{$filename}{modified_filename}; 635$state->{entries}{$filename}{unchanged} =1; 636} 637 638my$meta; 639if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 640{ 641$meta=$updater->getmeta($filename,$1); 642}else{ 643$meta=$updater->getmeta($filename); 644} 645 646next unless($meta->{revision} ); 647 648my$oldmeta=$meta; 649 650my$wrev= revparse($filename); 651 652# If the working copy is an old revision, lets get that version too for comparison. 653if(defined($wrev)and$wrev!=$meta->{revision} ) 654{ 655$oldmeta=$updater->getmeta($filename,$wrev); 656} 657 658#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 659 660# 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 661next if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{unchanged}and not exists($state->{opt}{C} ) ); 662 663if($meta->{filehash}eq"deleted") 664{ 665my($filepart,$dirpart) = filenamesplit($filename); 666 667$log->info("Removing '$filename' from working copy (no longer in the repo)"); 668 669print"E cvs update: `$filename' is no longer in the repository\n"; 670print"Removed$dirpart\n"; 671print"$filepart\n"; 672} 673elsif(not defined($state->{entries}{$filename}{modified_hash} )or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) 674{ 675$log->info("Updating '$filename'"); 676# normal update, just send the new revision (either U=Update, or A=Add, or R=Remove) 677print"MT +updated\n"; 678print"MT text U\n"; 679print"MT fname$filename\n"; 680print"MT newline\n"; 681print"MT -updated\n"; 682 683my($filepart,$dirpart) = filenamesplit($filename); 684$dirpart=~s/^$state->{directory}//; 685 686if(defined($wrev) ) 687{ 688# instruct client we're sending a file to put in this path as a replacement 689print"Update-existing$dirpart\n"; 690$log->debug("Updating existing file 'Update-existing$dirpart'"); 691}else{ 692# instruct client we're sending a file to put in this path as a new file 693print"Created$dirpart\n"; 694$log->debug("Creating new file 'Created$dirpart'"); 695} 696print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 697 698# this is an "entries" line 699$log->debug("/$filepart/1.$meta->{revision}///"); 700print"/$filepart/1.$meta->{revision}///\n"; 701 702# permissions 703$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 704print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 705 706# transmit file 707 transmitfile($meta->{filehash}); 708}else{ 709my($filepart,$dirpart) = filenamesplit($meta->{name}); 710 711my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 712 713chdir$dir; 714my$file_local=$filepart.".mine"; 715system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 716my$file_old=$filepart.".".$oldmeta->{revision}; 717 transmitfile($oldmeta->{filehash},$file_old); 718my$file_new=$filepart.".".$meta->{revision}; 719 transmitfile($meta->{filehash},$file_new); 720 721# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 722$log->info("Merging$file_local,$file_old,$file_new"); 723 724$log->debug("Temporary directory for merge is$dir"); 725 726my$return=system("merge",$file_local,$file_old,$file_new); 727$return>>=8; 728 729if($return==0) 730{ 731$log->info("Merged successfully"); 732print"M M$filename\n"; 733$log->debug("Update-existing$dirpart"); 734print"Update-existing$dirpart\n"; 735$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 736print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 737$log->debug("/$filepart/1.$meta->{revision}///"); 738print"/$filepart/1.$meta->{revision}///\n"; 739} 740elsif($return==1) 741{ 742$log->info("Merged with conflicts"); 743print"M C$filename\n"; 744print"Update-existing$dirpart\n"; 745print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 746print"/$filepart/1.$meta->{revision}/+//\n"; 747} 748else 749{ 750$log->warn("Merge failed"); 751next; 752} 753 754# permissions 755$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 756print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 757 758# transmit file, format is single integer on a line by itself (file 759# size) followed by the file contents 760# TODO : we should copy files in blocks 761my$data=`cat$file_local`; 762$log->debug("File size : " . length($data)); 763 print length($data) . "\n"; 764 print$data; 765 766 chdir "/"; 767 } 768 769 } 770 771 print "ok\n"; 772} 773 774sub req_ci 775{ 776 my ($cmd,$data) =@_; 777 778 argsplit("ci"); 779 780 #$log->debug("State : " . Dumper($state)); 781 782$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" )); 783 784 if ( -e$state->{CVSROOT} . "/index" ) 785 { 786 print "error 1 Index already exists in git repo\n"; 787 exit; 788 } 789 790 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock"; 791 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) ) 792 { 793 print "error 1 Lock file '$lockfile' already exists, please try again\n"; 794 exit; 795 } 796 797 # Grab a handle to the SQLite db and do any necessary updates 798 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 799$updater->update(); 800 801 my$tmpdir= tempdir ( DIR =>$TEMP_DIR); 802 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 ); 803$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'"); 804 805$ENV{GIT_DIR} =$state->{CVSROOT} . "/"; 806$ENV{GIT_INDEX_FILE} =$file_index; 807 808 chdir$tmpdir; 809 810 # populate the temporary index based 811 system("git-read-tree",$state->{module}); 812 unless ($?== 0) 813 { 814 die "Error running git-read-tree$state->{module}$file_index$!"; 815 } 816$log->info("Created index '$file_index' with for head$state->{module} - exit status$?"); 817 818 819 my@committedfiles= (); 820 821 # foreach file specified on the commandline ... 822 foreach my$filename( @{$state->{args}} ) 823 { 824$filename= filecleanup($filename); 825 826 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} ); 827 828 my$meta=$updater->getmeta($filename); 829 830 my$wrev= revparse($filename); 831 832 my ($filepart,$dirpart) = filenamesplit($filename); 833 834 # do a checkout of the file if it part of this tree 835 if ($wrev) { 836 system('git-checkout-index', '-f', '-u',$filename); 837 unless ($?== 0) { 838 die "Error running git-checkout-index -f -u$filename:$!"; 839 } 840 } 841 842 my$addflag= 0; 843 my$rmflag= 0; 844$rmflag= 1 if ( defined($wrev) and$wrev< 0 ); 845$addflag= 1 unless ( -e$filename); 846 847 # Do up to date checking 848 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) ) 849 { 850 # fail everything if an up to date check fails 851 print "error 1 Up to date check failed for$filename\n"; 852 close LOCKFILE; 853 unlink($lockfile); 854 chdir "/"; 855 exit; 856 } 857 858 push@committedfiles,$filename; 859$log->info("Committing$filename"); 860 861 system("mkdir","-p",$dirpart) unless ( -d$dirpart); 862 863 unless ($rmflag) 864 { 865$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename"); 866 rename$state->{entries}{$filename}{modified_filename},$filename; 867 868 # Calculate modes to remove 869 my$invmode= ""; 870 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); } 871 872$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename"); 873 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename); 874 } 875 876 if ($rmflag) 877 { 878$log->info("Removing file '$filename'"); 879 unlink($filename); 880 system("git-update-index", "--remove",$filename); 881 } 882 elsif ($addflag) 883 { 884$log->info("Adding file '$filename'"); 885 system("git-update-index", "--add",$filename); 886 } else { 887$log->info("Updating file '$filename'"); 888 system("git-update-index",$filename); 889 } 890 } 891 892 unless ( scalar(@committedfiles) > 0 ) 893 { 894 print "E No files to commit\n"; 895 print "ok\n"; 896 close LOCKFILE; 897 unlink($lockfile); 898 chdir "/"; 899 return; 900 } 901 902 my$treehash= `git-write-tree`; 903 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`; 904 chomp$treehash; 905 chomp$parenthash; 906 907$log->debug("Treehash :$treehash, Parenthash :$parenthash"); 908 909 # write our commit message out if we have one ... 910 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR); 911 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) ); 912 print$msg_fh"\n\nvia git-CVS emulator\n"; 913 close$msg_fh; 914 915 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`; 916$log->info("Commit hash :$commithash"); 917 918unless($commithash=~/[a-zA-Z0-9]{40}/) 919{ 920$log->warn("Commit failed (Invalid commit hash)"); 921print"error 1 Commit failed (unknown reason)\n"; 922close LOCKFILE; 923unlink($lockfile); 924chdir"/"; 925exit; 926} 927 928open FILE,">","$ENV{GIT_DIR}refs/heads/$state->{module}"; 929print FILE $commithash; 930close FILE; 931 932$updater->update(); 933 934# foreach file specified on the commandline ... 935foreachmy$filename(@committedfiles) 936{ 937$filename= filecleanup($filename); 938 939my$meta=$updater->getmeta($filename); 940 941my($filepart,$dirpart) = filenamesplit($filename); 942 943$log->debug("Checked-in$dirpart:$filename"); 944 945if($meta->{filehash}eq"deleted") 946{ 947print"Remove-entry$dirpart\n"; 948print"$filename\n"; 949}else{ 950print"Checked-in$dirpart\n"; 951print"$filename\n"; 952print"/$filepart/1.$meta->{revision}///\n"; 953} 954} 955 956close LOCKFILE; 957unlink($lockfile); 958chdir"/"; 959 960print"ok\n"; 961} 962 963sub req_status 964{ 965my($cmd,$data) =@_; 966 967 argsplit("status"); 968 969$log->info("req_status : ". (defined($data) ?$data:"[NULL]")); 970#$log->debug("status state : " . Dumper($state)); 971 972# Grab a handle to the SQLite db and do any necessary updates 973my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 974$updater->update(); 975 976# if no files were specified, we need to work out what files we should be providing status on ... 977 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0); 978 979# foreach file specified on the commandline ... 980foreachmy$filename( @{$state->{args}} ) 981{ 982$filename= filecleanup($filename); 983 984my$meta=$updater->getmeta($filename); 985my$oldmeta=$meta; 986 987my$wrev= revparse($filename); 988 989# If the working copy is an old revision, lets get that version too for comparison. 990if(defined($wrev)and$wrev!=$meta->{revision} ) 991{ 992$oldmeta=$updater->getmeta($filename,$wrev); 993} 994 995# TODO : All possible statuses aren't yet implemented 996my$status; 997# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified 998$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision} 999and1000( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1001or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1002);10031004# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1005$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1006and1007($state->{entries}{$filename}{unchanged}1008or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1009);10101011# Need checkout if it exists in the repo but doesn't have a working copy1012$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );10131014# Locally modified if working copy and repo copy have the same revision but there are local changes1015$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );10161017# Needs Merge if working copy revision is less than repo copy and there are local changes1018$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );10191020$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1021$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1022$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1023$status||="File had conflicts on merge"if(0);10241025$status||="Unknown";10261027print"M ===================================================================\n";1028print"M File:$filename\tStatus:$status\n";1029if(defined($state->{entries}{$filename}{revision}) )1030{1031print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1032}else{1033print"M Working revision:\tNo entry for$filename\n";1034}1035if(defined($meta->{revision}) )1036{1037print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1038print"M Sticky Tag:\t\t(none)\n";1039print"M Sticky Date:\t\t(none)\n";1040print"M Sticky Options:\t\t(none)\n";1041}else{1042print"M Repository revision:\tNo revision control file\n";1043}1044print"M\n";1045}10461047print"ok\n";1048}10491050sub req_diff1051{1052my($cmd,$data) =@_;10531054 argsplit("diff");10551056$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1057#$log->debug("status state : " . Dumper($state));10581059my($revision1,$revision2);1060if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1061{1062$revision1=$state->{opt}{r}[0];1063$revision2=$state->{opt}{r}[1];1064}else{1065$revision1=$state->{opt}{r};1066}10671068$revision1=~s/^1\.//if(defined($revision1) );1069$revision2=~s/^1\.//if(defined($revision2) );10701071$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );10721073# Grab a handle to the SQLite db and do any necessary updates1074my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1075$updater->update();10761077# if no files were specified, we need to work out what files we should be providing status on ...1078 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);10791080# foreach file specified on the commandline ...1081foreachmy$filename( @{$state->{args}} )1082{1083$filename= filecleanup($filename);10841085my($fh,$file1,$file2,$meta1,$meta2,$filediff);10861087my$wrev= revparse($filename);10881089# We need _something_ to diff against1090next unless(defined($wrev) );10911092# if we have a -r switch, use it1093if(defined($revision1) )1094{1095(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1096$meta1=$updater->getmeta($filename,$revision1);1097unless(defined($meta1)and$meta1->{filehash}ne"deleted")1098{1099print"E File$filenameat revision 1.$revision1doesn't exist\n";1100next;1101}1102 transmitfile($meta1->{filehash},$file1);1103}1104# otherwise we just use the working copy revision1105else1106{1107(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1108$meta1=$updater->getmeta($filename,$wrev);1109 transmitfile($meta1->{filehash},$file1);1110}11111112# if we have a second -r switch, use it too1113if(defined($revision2) )1114{1115(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1116$meta2=$updater->getmeta($filename,$revision2);11171118unless(defined($meta2)and$meta2->{filehash}ne"deleted")1119{1120print"E File$filenameat revision 1.$revision2doesn't exist\n";1121next;1122}11231124 transmitfile($meta2->{filehash},$file2);1125}1126# otherwise we just use the working copy1127else1128{1129$file2=$state->{entries}{$filename}{modified_filename};1130}11311132# if we have been given -r, and we don't have a $file2 yet, lets get one1133if(defined($revision1)and not defined($file2) )1134{1135(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1136$meta2=$updater->getmeta($filename,$wrev);1137 transmitfile($meta2->{filehash},$file2);1138}11391140# We need to have retrieved something useful1141next unless(defined($meta1) );11421143# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1144next if(not defined($meta2)and$wrev==$meta1->{revision}1145and1146( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1147or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1148);11491150# Apparently we only show diffs for locally modified files1151next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );11521153print"M Index:$filename\n";1154print"M ===================================================================\n";1155print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1156print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1157print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1158print"M diff ";1159foreachmy$opt(keys%{$state->{opt}} )1160{1161if(ref$state->{opt}{$opt}eq"ARRAY")1162{1163foreachmy$value( @{$state->{opt}{$opt}} )1164{1165print"-$opt$value";1166}1167}else{1168print"-$opt";1169print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1170}1171}1172print"$filename\n";11731174$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));11751176($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);11771178if(exists$state->{opt}{u} )1179{1180system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1181}else{1182system("diff$file1$file2>$filediff");1183}11841185while( <$fh> )1186{1187print"M$_";1188}1189close$fh;1190}11911192print"ok\n";1193}11941195sub req_log1196{1197my($cmd,$data) =@_;11981199 argsplit("log");12001201$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1202#$log->debug("log state : " . Dumper($state));12031204my($minrev,$maxrev);1205if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1206{1207my$control=$2;1208$minrev=$1;1209$maxrev=$3;1210$minrev=~s/^1\.//if(defined($minrev) );1211$maxrev=~s/^1\.//if(defined($maxrev) );1212$minrev++if(defined($minrev)and$controleq"::");1213}12141215# Grab a handle to the SQLite db and do any necessary updates1216my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1217$updater->update();12181219# if no files were specified, we need to work out what files we should be providing status on ...1220 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12211222# foreach file specified on the commandline ...1223foreachmy$filename( @{$state->{args}} )1224{1225$filename= filecleanup($filename);12261227my$headmeta=$updater->getmeta($filename);12281229my$revisions=$updater->getlog($filename);1230my$totalrevisions=scalar(@$revisions);12311232if(defined($minrev) )1233{1234$log->debug("Removing revisions less than$minrev");1235while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1236{1237pop@$revisions;1238}1239}1240if(defined($maxrev) )1241{1242$log->debug("Removing revisions greater than$maxrev");1243while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1244{1245shift@$revisions;1246}1247}12481249next unless(scalar(@$revisions) );12501251print"M\n";1252print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1253print"M Working file:$filename\n";1254print"M head: 1.$headmeta->{revision}\n";1255print"M branch:\n";1256print"M locks: strict\n";1257print"M access list:\n";1258print"M symbolic names:\n";1259print"M keyword substitution: kv\n";1260print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1261print"M description:\n";12621263foreachmy$revision(@$revisions)1264{1265print"M ----------------------------\n";1266print"M revision 1.$revision->{revision}\n";1267# reformat the date for log output1268$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}) );1269$revision->{author} =~s/\s+.*//;1270$revision->{author} =~s/^(.{8}).*/$1/;1271print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1272my$commitmessage=$updater->commitmessage($revision->{commithash});1273$commitmessage=~s/^/M /mg;1274print$commitmessage."\n";1275}1276print"M =============================================================================\n";1277}12781279print"ok\n";1280}12811282sub req_annotate1283{1284my($cmd,$data) =@_;12851286 argsplit("annotate");12871288$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1289#$log->debug("status state : " . Dumper($state));12901291# Grab a handle to the SQLite db and do any necessary updates1292my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1293$updater->update();12941295# if no files were specified, we need to work out what files we should be providing annotate on ...1296 argsfromdir($updater)if(scalar( @{$state->{args}} ) ==0);12971298# we'll need a temporary checkout dir1299my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1300my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1301$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");13021303$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1304$ENV{GIT_INDEX_FILE} =$file_index;13051306chdir$tmpdir;13071308# foreach file specified on the commandline ...1309foreachmy$filename( @{$state->{args}} )1310{1311$filename= filecleanup($filename);13121313my$meta=$updater->getmeta($filename);13141315next unless($meta->{revision} );13161317# get all the commits that this file was in1318# in dense format -- aka skip dead revisions1319my$revisions=$updater->gethistorydense($filename);1320my$lastseenin=$revisions->[0][2];13211322# populate the temporary index based on the latest commit were we saw1323# the file -- but do it cheaply without checking out any files1324# TODO: if we got a revision from the client, use that instead1325# to look up the commithash in sqlite (still good to default to1326# the current head as we do now)1327system("git-read-tree",$lastseenin);1328unless($?==0)1329{1330die"Error running git-read-tree$lastseenin$file_index$!";1331}1332$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");13331334# do a checkout of the file1335system('git-checkout-index','-f','-u',$filename);1336unless($?==0) {1337die"Error running git-checkout-index -f -u$filename:$!";1338}13391340$log->info("Annotate$filename");13411342# Prepare a file with the commits from the linearized1343# history that annotate should know about. This prevents1344# git-jsannotate telling us about commits we are hiding1345# from the client.13461347open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1348for(my$i=0;$i<@$revisions;$i++)1349{1350print ANNOTATEHINTS $revisions->[$i][2];1351if($i+1<@$revisions) {# have we got a parent?1352print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1353}1354print ANNOTATEHINTS "\n";1355}13561357print ANNOTATEHINTS "\n";1358close ANNOTATEHINTS;13591360my$annotatecmd='git-annotate';1361open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1362or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1363my$metadata= {};1364print"E Annotations for$filename\n";1365print"E ***************\n";1366while( <ANNOTATE> )1367{1368if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1369{1370my$commithash=$1;1371my$data=$2;1372unless(defined($metadata->{$commithash} ) )1373{1374$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1375$metadata->{$commithash}{author} =~s/\s+.*//;1376$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1377$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1378}1379printf("M 1.%-5d (%-8s%10s):%s\n",1380$metadata->{$commithash}{revision},1381$metadata->{$commithash}{author},1382$metadata->{$commithash}{modified},1383$data1384);1385}else{1386$log->warn("Error in annotate output! LINE:$_");1387print"E Annotate error\n";1388next;1389}1390}1391close ANNOTATE;1392}13931394# done; get out of the tempdir1395chdir"/";13961397print"ok\n";13981399}14001401# This method takes the state->{arguments} array and produces two new arrays.1402# The first is $state->{args} which is everything before the '--' argument, and1403# the second is $state->{files} which is everything after it.1404sub argsplit1405{1406return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");14071408my$type=shift;14091410$state->{args} = [];1411$state->{files} = [];1412$state->{opt} = {};14131414if(defined($type) )1415{1416my$opt= {};1417$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");1418$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1419$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");1420$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1421$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1422$opt= { k =>1, m =>1}if($typeeq"add");1423$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1424$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");142514261427while(scalar( @{$state->{arguments}} ) >0)1428{1429my$arg=shift@{$state->{arguments}};14301431next if($argeq"--");1432next unless($arg=~/\S/);14331434# if the argument looks like a switch1435if($arg=~/^-(\w)(.*)/)1436{1437# if it's a switch that takes an argument1438if($opt->{$1} )1439{1440# If this switch has already been provided1441if($opt->{$1} >1and exists($state->{opt}{$1} ) )1442{1443$state->{opt}{$1} = [$state->{opt}{$1} ];1444if(length($2) >0)1445{1446push@{$state->{opt}{$1}},$2;1447}else{1448push@{$state->{opt}{$1}},shift@{$state->{arguments}};1449}1450}else{1451# if there's extra data in the arg, use that as the argument for the switch1452if(length($2) >0)1453{1454$state->{opt}{$1} =$2;1455}else{1456$state->{opt}{$1} =shift@{$state->{arguments}};1457}1458}1459}else{1460$state->{opt}{$1} =undef;1461}1462}1463else1464{1465push@{$state->{args}},$arg;1466}1467}1468}1469else1470{1471my$mode=0;14721473foreachmy$value( @{$state->{arguments}} )1474{1475if($valueeq"--")1476{1477$mode++;1478next;1479}1480push@{$state->{args}},$valueif($mode==0);1481push@{$state->{files}},$valueif($mode==1);1482}1483}1484}14851486# This method uses $state->{directory} to populate $state->{args} with a list of filenames1487sub argsfromdir1488{1489my$updater=shift;14901491$state->{args} = [];14921493foreachmy$file( @{$updater->gethead} )1494{1495next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1496next unless($file->{name} =~s/^$state->{directory}//);1497push@{$state->{args}},$file->{name};1498}1499}15001501# This method cleans up the $state variable after a command that uses arguments has run1502sub statecleanup1503{1504$state->{files} = [];1505$state->{args} = [];1506$state->{arguments} = [];1507$state->{entries} = {};1508}15091510sub revparse1511{1512my$filename=shift;15131514returnundefunless(defined($state->{entries}{$filename}{revision} ) );15151516return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1517return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);15181519returnundef;1520}15211522# This method takes a file hash and does a CVS "file transfer" which transmits the1523# size of the file, and then the file contents.1524# If a second argument $targetfile is given, the file is instead written out to1525# a file by the name of $targetfile1526sub transmitfile1527{1528my$filehash=shift;1529my$targetfile=shift;15301531if(defined($filehash)and$filehasheq"deleted")1532{1533$log->warn("filehash is 'deleted'");1534return;1535}15361537die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);15381539my$type=`git-cat-file -t$filehash`;1540 chomp$type;15411542 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );15431544 my$size= `git-cat-file -s $filehash`;1545chomp$size;15461547$log->debug("transmitfile($filehash) size=$size, type=$type");15481549if(open my$fh,'-|',"git-cat-file","blob",$filehash)1550{1551if(defined($targetfile) )1552{1553open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1554print NEWFILE $_while( <$fh> );1555close NEWFILE;1556}else{1557print"$size\n";1558printwhile( <$fh> );1559}1560close$fhor die("Couldn't close filehandle for transmitfile()");1561}else{1562die("Couldn't execute git-cat-file");1563}1564}15651566# This method takes a file name, and returns ( $dirpart, $filepart ) which1567# refers to the directory porition and the file portion of the filename1568# respectively1569sub filenamesplit1570{1571my$filename=shift;15721573my($filepart,$dirpart) = ($filename,".");1574($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1575$dirpart.="/";15761577return($filepart,$dirpart);1578}15791580sub filecleanup1581{1582my$filename=shift;15831584returnundefunless(defined($filename));1585if($filename=~/^\// )1586{1587print"E absolute filenames '$filename' not supported by server\n";1588returnundef;1589}15901591$filename=~s/^\.\///g;1592$filename=$state->{directory} .$filename;15931594return$filename;1595}15961597package GITCVS::log;15981599####1600#### Copyright The Open University UK - 2006.1601####1602#### Authors: Martyn Smith <martyn@catalyst.net.nz>1603#### Martin Langhoff <martin@catalyst.net.nz>1604####1605####16061607use strict;1608use warnings;16091610=head1 NAME16111612GITCVS::log16131614=head1 DESCRIPTION16151616This module provides very crude logging with a similar interface to1617Log::Log4perl16181619=head1 METHODS16201621=cut16221623=head2 new16241625Creates a new log object, optionally you can specify a filename here to1626indicate the file to log to. If no log file is specified, you can specifiy one1627later with method setfile, or indicate you no longer want logging with method1628nofile.16291630Until one of these methods is called, all log calls will buffer messages ready1631to write out.16321633=cut1634sub new1635{1636my$class=shift;1637my$filename=shift;16381639my$self= {};16401641bless$self,$class;16421643if(defined($filename) )1644{1645open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1646}16471648return$self;1649}16501651=head2 setfile16521653This methods takes a filename, and attempts to open that file as the log file.1654If successful, all buffered data is written out to the file, and any further1655logging is written directly to the file.16561657=cut1658sub setfile1659{1660my$self=shift;1661my$filename=shift;16621663if(defined($filename) )1664{1665open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1666}16671668return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");16691670while(my$line=shift@{$self->{buffer}} )1671{1672print{$self->{fh}}$line;1673}1674}16751676=head2 nofile16771678This method indicates no logging is going to be used. It flushes any entries in1679the internal buffer, and sets a flag to ensure no further data is put there.16801681=cut1682sub nofile1683{1684my$self=shift;16851686$self->{nolog} =1;16871688return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");16891690$self->{buffer} = [];1691}16921693=head2 _logopen16941695Internal method. Returns true if the log file is open, false otherwise.16961697=cut1698sub _logopen1699{1700my$self=shift;17011702return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1703return0;1704}17051706=head2 debug info warn fatal17071708These four methods are wrappers to _log. They provide the actual interface for1709logging data.17101711=cut1712sub debug {my$self=shift;$self->_log("debug",@_); }1713sub info {my$self=shift;$self->_log("info",@_); }1714subwarn{my$self=shift;$self->_log("warn",@_); }1715sub fatal {my$self=shift;$self->_log("fatal",@_); }17161717=head2 _log17181719This is an internal method called by the logging functions. It generates a1720timestamp and pushes the logged line either to file, or internal buffer.17211722=cut1723sub _log1724{1725my$self=shift;1726my$level=shift;17271728return if($self->{nolog} );17291730my@time=localtime;1731my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",1732$time[5] +1900,1733$time[4] +1,1734$time[3],1735$time[2],1736$time[1],1737$time[0],1738uc$level,1739);17401741if($self->_logopen)1742{1743print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";1744}else{1745push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";1746}1747}17481749=head2 DESTROY17501751This method simply closes the file handle if one is open17521753=cut1754sub DESTROY1755{1756my$self=shift;17571758if($self->_logopen)1759{1760close$self->{fh};1761}1762}17631764package GITCVS::updater;17651766####1767#### Copyright The Open University UK - 2006.1768####1769#### Authors: Martyn Smith <martyn@catalyst.net.nz>1770#### Martin Langhoff <martin@catalyst.net.nz>1771####1772####17731774use strict;1775use warnings;1776use DBI;17771778=head1 METHODS17791780=cut17811782=head2 new17831784=cut1785sub new1786{1787my$class=shift;1788my$config=shift;1789my$module=shift;1790my$log=shift;17911792die"Need to specify a git repository"unless(defined($config)and-d $config);1793die"Need to specify a module"unless(defined($module) );17941795$class=ref($class) ||$class;17961797my$self= {};17981799bless$self,$class;18001801$self->{dbdir} =$config."/";1802die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );18031804$self->{module} =$module;1805$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";18061807$self->{git_path} =$config."/";18081809$self->{log} =$log;18101811die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );18121813$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");18141815$self->{tables} = {};1816foreachmy$table($self->{dbh}->tables)1817{1818$table=~s/^"//;1819$table=~s/"$//;1820$self->{tables}{$table} =1;1821}18221823# Construct the revision table if required1824unless($self->{tables}{revision} )1825{1826$self->{dbh}->do("1827 CREATE TABLE revision (1828 name TEXT NOT NULL,1829 revision INTEGER NOT NULL,1830 filehash TEXT NOT NULL,1831 commithash TEXT NOT NULL,1832 author TEXT NOT NULL,1833 modified TEXT NOT NULL,1834 mode TEXT NOT NULL1835 )1836 ");1837}18381839# Construct the revision table if required1840unless($self->{tables}{head} )1841{1842$self->{dbh}->do("1843 CREATE TABLE head (1844 name TEXT NOT NULL,1845 revision INTEGER NOT NULL,1846 filehash TEXT NOT NULL,1847 commithash TEXT NOT NULL,1848 author TEXT NOT NULL,1849 modified TEXT NOT NULL,1850 mode TEXT NOT NULL1851 )1852 ");1853}18541855# Construct the properties table if required1856unless($self->{tables}{properties} )1857{1858$self->{dbh}->do("1859 CREATE TABLE properties (1860 key TEXT NOT NULL PRIMARY KEY,1861 value TEXT1862 )1863 ");1864}18651866# Construct the commitmsgs table if required1867unless($self->{tables}{commitmsgs} )1868{1869$self->{dbh}->do("1870 CREATE TABLE commitmsgs (1871 key TEXT NOT NULL PRIMARY KEY,1872 value TEXT1873 )1874 ");1875}18761877return$self;1878}18791880=head2 update18811882=cut1883sub update1884{1885my$self=shift;18861887# first lets get the commit list1888$ENV{GIT_DIR} =$self->{git_path};18891890# prepare database queries1891my$db_insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);1892my$db_insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);1893my$db_delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);1894my$db_insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);18951896my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;1897unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)1898{1899die("Invalid module '$self->{module}'");1900}190119021903my$git_log;1904my$lastcommit=$self->_get_prop("last_commit");19051906# Start exclusive lock here...1907$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";19081909# TODO: log processing is memory bound1910# if we can parse into a 2nd file that is in reverse order1911# we can probably do something really efficient1912my@git_log_params= ('--parents','--topo-order');19131914if(defined$lastcommit) {1915push@git_log_params,"$lastcommit..$self->{module}";1916}else{1917push@git_log_params,$self->{module};1918}1919open(GITLOG,'-|','git-log',@git_log_params)or die"Cannot call git-log:$!";19201921my@commits;19221923my%commit= ();19241925while( <GITLOG> )1926{1927chomp;1928if(m/^commit\s+(.*)$/) {1929# on ^commit lines put the just seen commit in the stack1930# and prime things for the next one1931if(keys%commit) {1932my%copy=%commit;1933unshift@commits, \%copy;1934%commit= ();1935}1936my@parents=split(m/\s+/,$1);1937$commit{hash} =shift@parents;1938$commit{parents} = \@parents;1939}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {1940# on rfc822-like lines seen before we see any message,1941# lowercase the entry and put it in the hash as key-value1942$commit{lc($1)} =$2;1943}else{1944# message lines - skip initial empty line1945# and trim whitespace1946if(!exists($commit{message}) &&m/^\s*$/) {1947# define it to mark the end of headers1948$commit{message} ='';1949next;1950}1951s/^\s+//;s/\s+$//;# trim ws1952$commit{message} .=$_."\n";1953}1954}1955close GITLOG;19561957unshift@commits, \%commitif(keys%commit);19581959# Now all the commits are in the @commits bucket1960# ordered by time DESC. for each commit that needs processing,1961# determine whether it's following the last head we've seen or if1962# it's on its own branch, grab a file list, and add whatever's changed1963# NOTE: $lastcommit refers to the last commit from previous run1964# $lastpicked is the last commit we picked in this run1965my$lastpicked;1966my$head= {};1967if(defined$lastcommit) {1968$lastpicked=$lastcommit;1969}19701971my$committotal=scalar(@commits);1972my$commitcount=0;19731974# Load the head table into $head (for cached lookups during the update process)1975foreachmy$file( @{$self->gethead()} )1976{1977$head->{$file->{name}} =$file;1978}19791980foreachmy$commit(@commits)1981{1982$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");1983if(defined$lastpicked)1984{1985if(!in_array($lastpicked, @{$commit->{parents}}))1986{1987# skip, we'll see this delta1988# as part of a merge later1989# warn "skipping off-track $commit->{hash}\n";1990next;1991}elsif(@{$commit->{parents}} >1) {1992# it is a merge commit, for each parent that is1993# not $lastpicked, see if we can get a log1994# from the merge-base to that parent to put it1995# in the message as a merge summary.1996my@parents= @{$commit->{parents}};1997foreachmy$parent(@parents) {1998# git-merge-base can potentially (but rarely) throw1999# several candidate merge bases. let's assume2000# that the first one is the best one.2001if($parenteq$lastpicked) {2002next;2003}2004open my$p,'git-merge-base '.$lastpicked.' '2005.$parent.'|';2006my@output= (<$p>);2007close$p;2008my$base=join('',@output);2009chomp$base;2010if($base) {2011my@merged;2012# print "want to log between $base $parent \n";2013open(GITLOG,'-|','git-log',"$base..$parent")2014or die"Cannot call git-log:$!";2015my$mergedhash;2016while(<GITLOG>) {2017chomp;2018if(!defined$mergedhash) {2019if(m/^commit\s+(.+)$/) {2020$mergedhash=$1;2021}else{2022next;2023}2024}else{2025# grab the first line that looks non-rfc8222026# aka has content after leading space2027if(m/^\s+(\S.*)$/) {2028my$title=$1;2029$title=substr($title,0,100);# truncate2030unshift@merged,"$mergedhash$title";2031undef$mergedhash;2032}2033}2034}2035close GITLOG;2036if(@merged) {2037$commit->{mergemsg} =$commit->{message};2038$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2039foreachmy$summary(@merged) {2040$commit->{mergemsg} .="\t$summary\n";2041}2042$commit->{mergemsg} .="\n\n";2043# print "Message for $commit->{hash} \n$commit->{mergemsg}";2044}2045}2046}2047}2048}20492050# convert the date to CVS-happy format2051$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);20522053if(defined($lastpicked) )2054{2055my$filepipe=open(FILELIST,'-|','git-diff-tree','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2056while( <FILELIST> )2057{2058unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o)2059{2060die("Couldn't process git-diff-tree line :$_");2061}20622063# $log->debug("File mode=$1, hash=$2, change=$3, name=$4");20642065my$git_perms="";2066$git_perms.="r"if($1&4);2067$git_perms.="w"if($1&2);2068$git_perms.="x"if($1&1);2069$git_perms="rw"if($git_permseq"");20702071if($3eq"D")2072{2073#$log->debug("DELETE $4");2074$head->{$4} = {2075 name =>$4,2076 revision =>$head->{$4}{revision} +1,2077 filehash =>"deleted",2078 commithash =>$commit->{hash},2079 modified =>$commit->{date},2080 author =>$commit->{author},2081 mode =>$git_perms,2082};2083$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2084}2085elsif($3eq"M")2086{2087#$log->debug("MODIFIED $4");2088$head->{$4} = {2089 name =>$4,2090 revision =>$head->{$4}{revision} +1,2091 filehash =>$2,2092 commithash =>$commit->{hash},2093 modified =>$commit->{date},2094 author =>$commit->{author},2095 mode =>$git_perms,2096};2097$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2098}2099elsif($3eq"A")2100{2101#$log->debug("ADDED $4");2102$head->{$4} = {2103 name =>$4,2104 revision =>1,2105 filehash =>$2,2106 commithash =>$commit->{hash},2107 modified =>$commit->{date},2108 author =>$commit->{author},2109 mode =>$git_perms,2110};2111$db_insert_rev->execute($4,$head->{$4}{revision},$2,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2112}2113else2114{2115$log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");2116die;2117}2118}2119close FILELIST;2120}else{2121# this is used to detect files removed from the repo2122my$seen_files= {};21232124my$filepipe=open(FILELIST,'-|','git-ls-tree','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2125while( <FILELIST> )2126{2127unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o)2128{2129die("Couldn't process git-ls-tree line :$_");2130}21312132my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);21332134$seen_files->{$git_filename} =1;21352136my($oldhash,$oldrevision,$oldmode) = (2137$head->{$git_filename}{filehash},2138$head->{$git_filename}{revision},2139$head->{$git_filename}{mode}2140);21412142if($git_perms=~/^\d\d\d(\d)\d\d/o)2143{2144$git_perms="";2145$git_perms.="r"if($1&4);2146$git_perms.="w"if($1&2);2147$git_perms.="x"if($1&1);2148}else{2149$git_perms="rw";2150}21512152# unless the file exists with the same hash, we need to update it ...2153unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2154{2155my$newrevision= ($oldrevisionor0) +1;21562157$head->{$git_filename} = {2158 name =>$git_filename,2159 revision =>$newrevision,2160 filehash =>$git_hash,2161 commithash =>$commit->{hash},2162 modified =>$commit->{date},2163 author =>$commit->{author},2164 mode =>$git_perms,2165};216621672168$db_insert_rev->execute($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2169}2170}2171close FILELIST;21722173# Detect deleted files2174foreachmy$file(keys%$head)2175{2176unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2177{2178$head->{$file}{revision}++;2179$head->{$file}{filehash} ="deleted";2180$head->{$file}{commithash} =$commit->{hash};2181$head->{$file}{modified} =$commit->{date};2182$head->{$file}{author} =$commit->{author};21832184$db_insert_rev->execute($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2185}2186}2187# END : "Detect deleted files"2188}218921902191if(exists$commit->{mergemsg})2192{2193$db_insert_mergelog->execute($commit->{hash},$commit->{mergemsg});2194}21952196$lastpicked=$commit->{hash};21972198$self->_set_prop("last_commit",$commit->{hash});2199}22002201$db_delete_head->execute();2202foreachmy$file(keys%$head)2203{2204$db_insert_head->execute(2205$file,2206$head->{$file}{revision},2207$head->{$file}{filehash},2208$head->{$file}{commithash},2209$head->{$file}{modified},2210$head->{$file}{author},2211$head->{$file}{mode},2212);2213}2214# invalidate the gethead cache2215$self->{gethead_cache} =undef;221622172218# Ending exclusive lock here2219$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2220}22212222sub _headrev2223{2224my$self=shift;2225my$filename=shift;22262227my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2228$db_query->execute($filename);2229my($hash,$revision,$mode) =$db_query->fetchrow_array;22302231return($hash,$revision,$mode);2232}22332234sub _get_prop2235{2236my$self=shift;2237my$key=shift;22382239my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2240$db_query->execute($key);2241my($value) =$db_query->fetchrow_array;22422243return$value;2244}22452246sub _set_prop2247{2248my$self=shift;2249my$key=shift;2250my$value=shift;22512252my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2253$db_query->execute($value,$key);22542255unless($db_query->rows)2256{2257$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2258$db_query->execute($key,$value);2259}22602261return$value;2262}22632264=head2 gethead22652266=cut22672268sub gethead2269{2270my$self=shift;22712272return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );22732274my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);2275$db_query->execute();22762277my$tree= [];2278while(my$file=$db_query->fetchrow_hashref)2279{2280push@$tree,$file;2281}22822283$self->{gethead_cache} =$tree;22842285return$tree;2286}22872288=head2 getlog22892290=cut22912292sub getlog2293{2294my$self=shift;2295my$filename=shift;22962297my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2298$db_query->execute($filename);22992300my$tree= [];2301while(my$file=$db_query->fetchrow_hashref)2302{2303push@$tree,$file;2304}23052306return$tree;2307}23082309=head2 getmeta23102311This function takes a filename (with path) argument and returns a hashref of2312metadata for that file.23132314=cut23152316sub getmeta2317{2318my$self=shift;2319my$filename=shift;2320my$revision=shift;23212322my$db_query;2323if(defined($revision)and$revision=~/^\d+$/)2324{2325$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2326$db_query->execute($filename,$revision);2327}2328elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2329{2330$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2331$db_query->execute($filename,$revision);2332}else{2333$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2334$db_query->execute($filename);2335}23362337return$db_query->fetchrow_hashref;2338}23392340=head2 commitmessage23412342this function takes a commithash and returns the commit message for that commit23432344=cut2345sub commitmessage2346{2347my$self=shift;2348my$commithash=shift;23492350die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);23512352my$db_query;2353$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2354$db_query->execute($commithash);23552356my($message) =$db_query->fetchrow_array;23572358if(defined($message) )2359{2360$message.=" "if($message=~/\n$/);2361return$message;2362}23632364my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2365shift@lineswhile($lines[0] =~/\S/);2366$message=join("",@lines);2367$message.=" "if($message=~/\n$/);2368return$message;2369}23702371=head2 gethistory23722373This function takes a filename (with path) argument and returns an arrayofarrays2374containing revision,filehash,commithash ordered by revision descending23752376=cut2377sub gethistory2378{2379my$self=shift;2380my$filename=shift;23812382my$db_query;2383$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2384$db_query->execute($filename);23852386return$db_query->fetchall_arrayref;2387}23882389=head2 gethistorydense23902391This function takes a filename (with path) argument and returns an arrayofarrays2392containing revision,filehash,commithash ordered by revision descending.23932394This version of gethistory skips deleted entries -- so it is useful for annotate.2395The 'dense' part is a reference to a '--dense' option available for git-rev-list2396and other git tools that depend on it.23972398=cut2399sub gethistorydense2400{2401my$self=shift;2402my$filename=shift;24032404my$db_query;2405$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2406$db_query->execute($filename);24072408return$db_query->fetchall_arrayref;2409}24102411=head2 in_array()24122413from Array::PAT - mimics the in_array() function2414found in PHP. Yuck but works for small arrays.24152416=cut2417sub in_array2418{2419my($check,@array) =@_;2420my$retval=0;2421foreachmy$test(@array){2422if($checkeq$test){2423$retval=1;2424}2425}2426return$retval;2427}24282429=head2 safe_pipe_capture24302431an alterative to `command` that allows input to be passed as an array2432to work around shell problems with weird characters in arguments24332434=cut2435sub safe_pipe_capture {24362437my@output;24382439if(my$pid=open my$child,'-|') {2440@output= (<$child>);2441close$childor die join(' ',@_).":$!$?";2442}else{2443exec(@_)or die"$!$?";# exec() can fail the executable can't be found2444}2445returnwantarray?@output:join('',@output);2446}2447244824491;