Git.pm 7.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324
  1. package SimplyGit::Git;
  2. use strict;
  3. use warnings;
  4. use Log::Log4perl qw(:easy);
  5. use lib ".";
  6. use SimplyGit::Shellex qw(shellex findBin);
  7. use Exporter qw(import);
  8. our @EXPORT_OK = qw(readConfig getStatus returnState addFiles commitChanges pushChanges stashAndReset resetFromUpstream updateGitIgnore appendRepoUserConfig parseSGConfig warnOnUser);
  9. # TODO: Add info/debug logging for all subroutines
  10. sub checkPath($$) {
  11. my $path = shift;
  12. my $logger = shift;
  13. if ( ! -d $path ) {
  14. $logger->error("$path doesn't look like a dir, exiting...");
  15. exit 1;
  16. }
  17. }
  18. sub warnOnUser($$$) {
  19. my $user = shift;
  20. my $email = shift;
  21. my $logger = shift;
  22. my $gitCmd = findBin("git",$logger);
  23. my $configuredUser = shellex("$gitCmd config --get user.name",$logger);
  24. my $configuredEmail = shellex("$gitCmd config --get user.email",$logger);
  25. if ( $configuredUser ne $user || $configuredEmail ne $email ) {
  26. print "***************\n";
  27. print "Your configured user/email don't match what you declared in the config file!\n";
  28. print "Desired User: $user\nConfigured User: $configuredUser\nDesired Email: $email\nConfigured Email: $configuredEmail\n";
  29. print "***************\n";
  30. }
  31. }
  32. # https://perlmaven.com/trim
  33. sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
  34. sub parseSGConfig($$) {
  35. my $config = shift;
  36. my $logger = shift;
  37. if ( ! -e $config ) {
  38. $logger->error("$config doesn't look like a regular file, exiting...");
  39. exit 1;
  40. }
  41. my $catCmd = findBin("cat",$logger);
  42. my @configLines = split("\n",shellex("$catCmd $config",$logger));
  43. my %configHash;
  44. foreach my $line ( @configLines ) {
  45. chomp $line;
  46. if ( $line =~ m/^(.*)\ =\ "(.*)"$/ ) {
  47. $configHash{$1} = $2;
  48. }
  49. if ( $line =~ m/^(.*)\ =\ \[(.*)\]/ ) {
  50. my @trimmedPorts;
  51. my @ports = split(",",$2);
  52. foreach my $port (@ports) {
  53. $port =~ /(\d{1,5})/;
  54. push(@trimmedPorts,trim($1));
  55. }
  56. $configHash{$1} = \@trimmedPorts;
  57. }
  58. }
  59. return %configHash;
  60. }
  61. sub returnConfigPath($$) {
  62. my $path = shift;
  63. my $logger = shift;
  64. checkPath($path,$logger);
  65. my $gitConfigPath = $path . "/" . ".git/config";
  66. return $gitConfigPath;
  67. }
  68. sub readConfig($$) {
  69. # This sub is probably not really needed for what I'm trying to do
  70. # git itself already parses this config...but an interesting exercise non the less
  71. # and may be useful later
  72. my $path = shift;
  73. my $logger = shift;
  74. my $gitConfigPath = returnConfigPath($path,$logger);
  75. my $catCmd = findBin("cat",$logger);
  76. my @configLines = split("\n",shellex("$catCmd $gitConfigPath",$logger));
  77. # Key is config header, value is hash ref containing config values
  78. my %gitConfig;
  79. my @valueLines;
  80. my $lineCounter = 0;
  81. foreach my $line ( @configLines ) {
  82. $lineCounter++;
  83. #if ( $line =~ m/\[(.*)\]/ ) {
  84. if ( $line =~ m/\[(.*)\]/ ) {
  85. #$valueLine =~ /\t(.*)\ =\ (.*)$/;
  86. $gitConfig{$1} = "";
  87. }
  88. }
  89. # Tag each line with it's heading
  90. # Only way I could think of that worked to solve how this
  91. # There are almost certainly better ways
  92. my @taggedLines;
  93. my $tag = "NULLTAG";
  94. foreach my $line ( @configLines ) {
  95. if ( $line =~ m/\[(.*)\]/ ) {
  96. $tag = $1;
  97. } else {
  98. my $newLine = $tag . $line;
  99. push(@taggedLines,$newLine);
  100. }
  101. }
  102. # Get all of the tagged lines into a hash structure.
  103. foreach my $key ( keys %gitConfig ) {
  104. my %stash;
  105. foreach my $tl ( @taggedLines ) {
  106. if ( $tl =~ m/^($key)/ ) {
  107. $tl =~ s/^($key)//g;
  108. $tl =~ m/^\t(.*)\ \=\ (.*)$/;
  109. my $confKey = $1;
  110. my $confVal = $2;
  111. $stash{$confKey} = $confVal;
  112. }
  113. }
  114. $gitConfig{$key} = \%stash;
  115. }
  116. return %gitConfig;
  117. }
  118. sub getStatus($) {
  119. my $logger = shift;
  120. my $gitCmd = findBin("git",$logger);
  121. my $status = shellex("$gitCmd status -uall --porcelain",$logger);
  122. chomp $status;
  123. return $status;
  124. }
  125. sub returnState($) {
  126. my $logger = shift;
  127. my $gitCmd = findBin("git",$logger);
  128. my $currentStatus = getStatus($logger);
  129. my @statusLines = split("\n", $currentStatus);
  130. my @untracked;
  131. my @modified;
  132. my @added;
  133. my @deleted;
  134. foreach my $file ( @statusLines ) {
  135. $file =~ m/^\ {0,1}([A-Z?]{1,2})\ {1,2}(.*)/;
  136. my $fileAttrs = $1;
  137. my $filename = $2;
  138. my @attrs = split("",$fileAttrs);
  139. foreach my $attr ( @attrs ) {
  140. if ( $attr =~ m/\?/ ) {
  141. push(@untracked, $filename) unless grep $_ eq $filename, @untracked;
  142. }
  143. if ( $attr =~ m/[M]/ ) {
  144. push(@modified, $filename) unless grep $_ eq $filename, @modified;
  145. }
  146. if ( $attr =~ m/[A]/ ) {
  147. push(@added, $filename) unless grep $_ eq $filename, @added;
  148. }
  149. if ( $attr =~ m/[D]/ ) {
  150. push(@deleted, $filename) unless grep $_ eq $filename, @deleted;
  151. }
  152. }
  153. }
  154. return ( \@untracked, \@modified, \@added, \@deleted );
  155. }
  156. sub addFiles($$) {
  157. my $filesToAddRef = shift;
  158. my $logger = shift;
  159. my $gitCmd = findBin("git",$logger);
  160. foreach my $file ( @$filesToAddRef ) {
  161. shellex("$gitCmd add $file",$logger);
  162. }
  163. }
  164. sub commitChanges($$) {
  165. my $commitMsg = shift;
  166. chomp $commitMsg;
  167. my $logger = shift;
  168. my $gitCmd = findBin("git",$logger);
  169. shellex("$gitCmd commit -m \"$commitMsg\"",$logger);
  170. }
  171. sub pushChanges($) {
  172. my $logger = shift;
  173. my $gitCmd = findBin("git",$logger);
  174. my $output = shellex("$gitCmd push",$logger);
  175. }
  176. sub dropStash($) {
  177. my $logger = shift;
  178. my $gitCmd = findBin("git",$logger);
  179. my @stashList = split("\n", shellex("$gitCmd stash list",$logger));
  180. my $stashCount = scalar @stashList;
  181. # TODO: Don't need $stashCount, should just be able to iterate over @stashList
  182. if ( scalar @stashList == 0 ) {
  183. print "Stash is empty so not dropping\n";
  184. } else {
  185. foreach my $stashNum ( 1..$stashCount ) {
  186. shellex("$gitCmd stash drop 0",$logger);
  187. }
  188. }
  189. }
  190. sub stashAndReset($) {
  191. my $logger = shift;
  192. my $gitCmd = findBin("git",$logger);
  193. shellex("$gitCmd stash",$logger);
  194. dropStash($logger);
  195. shellex("$gitCmd rebase",$logger);
  196. }
  197. sub resetFromUpstream($) {
  198. # git stash and git reset --hard and git pull ? I think
  199. # git reset upstream/master; git stash
  200. my $logger = shift;
  201. my $gitCmd = findBin("git",$logger);
  202. my $upstream = shellex("$gitCmd config --get remote.upstream.url",$logger);
  203. if ( $upstream eq "" || ! defined $upstream ) {
  204. print "Upstream not configured, exiting\n";
  205. exit 1;
  206. }
  207. shellex("$gitCmd reset upstream/master",$logger);
  208. shellex("$gitCmd stash",$logger);
  209. dropStash($logger);
  210. print "Successful reset from upstream\n";
  211. print "Changes have not been pushed, run \'$gitCmd pull\' to revert\n";
  212. }
  213. sub updateGitIgnore($$$) {
  214. my $path = shift;
  215. # Maybe better to accept an array of values
  216. my $ignoreValue = shift;
  217. my $logger = shift;
  218. checkPath($path,$logger);
  219. my $filename = $path . "/" . ".gitignore";
  220. # Make sure we're not appending/writing if entry already exists in gitignore
  221. if ( -f $filename ) {
  222. my $catCmd = findBin("cat",$logger);
  223. my @ignoreLines = split("\n",shellex("$catCmd $filename",$logger));
  224. if ( ! grep( /^$ignoreValue$/, @ignoreLines ) ) {
  225. open(my $fh, ">>", $filename) or die $logger->error("Couldn't open $filename, exiting...");
  226. chomp $ignoreValue;
  227. print $fh "$ignoreValue\n";
  228. close $fh;
  229. }
  230. } else {
  231. open(my $fh, ">", $filename) or die $logger->error("Couldn't open $filename, exiting...");
  232. chomp $ignoreValue;
  233. print $fh "$ignoreValue\n";
  234. close $fh;
  235. }
  236. }
  237. sub appendRepoUserConfig($$$) {
  238. my $desiredName = shift;
  239. my $desiredEmail = shift;
  240. my $logger = shift;
  241. my $gitCmd = findBin("git",$logger);
  242. my $currentName = shellex("$gitCmd config --get user.name",$logger);
  243. chomp $currentName;
  244. my $currentEmail = shellex("$gitCmd config --get user.email",$logger);
  245. chomp $currentEmail;
  246. if ( $currentName eq $desiredName ) {
  247. print "Already have $desiredName configured\n";
  248. } else {
  249. shellex("$gitCmd config user.name \"$desiredName\"",$logger);
  250. print "Set $desiredName successfully\n";
  251. }
  252. if ( $currentEmail eq $desiredEmail ) {
  253. print "Already have $desiredEmail configured\n";
  254. } else {
  255. shellex("$gitCmd config user.email \"$desiredEmail\"",$logger);
  256. print "Set $desiredEmail successfully\n";
  257. }
  258. }