git.pm 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  1. #!/usr/bin/perl
  2. # git support for dpkg-source
  3. package Dpkg::Source::VCS::git;
  4. use strict;
  5. use warnings;
  6. use Dpkg;
  7. use Dpkg::Gettext;
  8. push (@INC, $dpkglibdir);
  9. require 'controllib.pl';
  10. # Called before a tarball is created, must add all files that should be in
  11. # it.
  12. sub prep_tar {
  13. my $srcdir=shift;
  14. my $tardir=shift;
  15. if (! -e "$srcdir/.git") {
  16. main::error(sprintf(_g("%s is not a git repository, but Format git was specified"), $srcdir));
  17. }
  18. # check for uncommitted files
  19. open(GIT_STATUS, "LANG=C cd $srcdir && git status |") ||
  20. main::subprocerr("cd $srcdir && git status");
  21. my $clean=0;
  22. my $status="";
  23. while (<GIT_STATUS>) {
  24. if (/^\Qnothing to commit (working directory clean)\E$/) {
  25. $clean=1;
  26. }
  27. $status.="git-status: $_";
  28. }
  29. close GIT_STATUS;
  30. # git-status exits 1 if there are uncommitted changes or if
  31. # the repo is clean, and 0 if there are uncommitted changes
  32. # listed in the index.
  33. main::subprocerr("cd $srcdir && git status") if ($? && $? >> 8 != 1);
  34. if (! $clean) {
  35. print $status;
  36. main::warnerror(_g("working directory is not clean"));
  37. }
  38. # garbage collect the repo
  39. system("cd $srcdir && git-gc --prune");
  40. $? && main::subprocerr("cd $srcdir && git-gc --prune");
  41. # TODO support for creating a shallow clone for those cases where
  42. # uploading the whole repo history is not desired
  43. system("cp -a $srcdir/.git $tardir");
  44. $? && main::subprocerr("cp -a $srcdir/.git $tardir");
  45. }
  46. # Called after a tarball is unpacked, to check out the working copy.
  47. sub post_unpack_tar {
  48. my $srcdir=shift;
  49. if (! -e "$srcdir/.git") {
  50. main::error(sprintf(_g("%s is not a git repository"), $srcdir));
  51. }
  52. # disable git hooks, as unpacking a source package should not
  53. # involve running code
  54. foreach my $hook (glob("$srcdir/.git/hooks/*")) {
  55. if (-x $hook) {
  56. main::warning(sprintf(_g("executable bit set on %s; clearing"), $hook));
  57. chmod(0644 &~ umask(), $hook) ||
  58. &syserr(sprintf(_g("unable to change permission of `%s'"), $hook));
  59. }
  60. }
  61. # XXX git-reset should be made to run in quiet mode here, but
  62. # lacks a good way to do it. Bug filed.
  63. system("cd $srcdir && git-reset --hard");
  64. $? && main::subprocerr("cd $srcdir && git-reset --hard");
  65. }
  66. 1