File Coverage

blib/lib/Padre/Plugin/Git.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Padre::Plugin::Git;
2              
3 2     2   156542 use 5.010001;
  2         9  
  2         91  
4 2     2   95 use strict;
  2         5  
  2         74  
5 2     2   11 use warnings;
  2         269  
  2         94  
6              
7 2     2   4318 use Padre::Unload;
  0            
  0            
8             use Padre::Config ();
9             use Padre::Wx ();
10             use Padre::Plugin ();
11             use Padre::Util ();
12             use Padre::Wx::Action ();
13             use File::Basename ();
14             use File::Which ();
15             use Try::Tiny;
16             use File::Slurp;
17             use CPAN::Changes;
18              
19             our $VERSION = '0.12';
20             use parent qw(
21             Padre::Plugin
22             Padre::Role::Task
23             );
24              
25              
26             #########
27             # We need plugin_enable
28             # as we have an external dependency git
29             #########
30             sub plugin_enable {
31             my $self = shift;
32             my $local_git_exists = 0;
33              
34             try {
35             if ( File::Which::which('git') ) {
36             $local_git_exists = 1;
37             }
38             };
39              
40             #ReSet Config data
41             my $config = $self->config_read;
42             $config = {};
43             $self->config_write($config);
44              
45             return $local_git_exists;
46             }
47              
48             # Child modules we need to unload when disabled
49             use constant CHILDREN => qw{
50             Padre::Plugin::Git::Output
51             Padre::Plugin::Git::FBP::Output
52             Padre::Plugin::Git::Message
53             Padre::Plugin::Git::FBP::Message
54             Padre::Plugin::Git::Task::Git_cmd
55             Padre::Plugin::Git
56             Pithub
57             };
58              
59             use constant {
60             BLANK => qq{ },
61             NONE => q{},
62             };
63              
64             #######
65             # Called by padre to check the required interface
66             #######
67             sub padre_interfaces {
68             return (
69             # Default, required
70             'Padre::Plugin' => '0.96',
71             'Padre::Task' => '0.96',
72             'Padre::Unload' => '0.96',
73             'Padre::Config' => '0.96',
74             'Padre::Wx' => '0.96',
75             'Padre::Wx::Action' => '0.96',
76             'Padre::Util' => '0.97',
77             );
78             }
79              
80             #######
81             # Called by Padre to know the plugin name
82             #######
83             sub plugin_name {
84             return Wx::gettext('Git');
85             }
86              
87             #######
88             # Add Plugin to Padre Menu
89             #######
90             sub menu_plugins_simple {
91             my $self = shift;
92             my $main = $self->main;
93             my $document = $main->current->document;
94              
95             #Hide Git on Tools menu if current file is not in a Git controlled dir
96             $self->current_files;
97             my $tab_id = $self->main->editor_of_file( $document->{filename} );
98              
99             try {
100             if ( defined $tab_id && defined $self->{open_file_info}->{$tab_id}->{'vcs'} ) {
101             if ( $self->{open_file_info}->{$tab_id}->{'vcs'} =~ m/Git/sxm ) {
102              
103             return $self->plugin_name => [
104             Wx::gettext('Local') => [
105             Wx::gettext('Staging') => [
106             Wx::gettext('Stage File') => sub {
107             $self->git_cmd( 'add', $document->filename );
108             $self->git_cmd( 'status', $document->filename );
109             },
110             Wx::gettext('Stage All') => sub {
111             $self->git_cmd( 'add', $document->project_dir );
112             $self->git_cmd( 'status', $document->project_dir );
113             },
114             Wx::gettext('Unstage File') => sub {
115              
116             #ToDo mj41 should we be using this instead
117             #$self->git_cmd( 'rm --cached', $document->filename );
118             $self->git_cmd( 'reset HEAD', $document->filename );
119             $self->git_cmd( 'status', $document->filename );
120             },
121             Wx::gettext('Stage Patch') => sub {
122             $self->git_patch( 'git add -p ' . $document->filename );
123             },
124             ],
125             Wx::gettext('Commit') => [
126             Wx::gettext('Commit File') => sub {
127             $self->git_cmd( 'commit', $document->filename, $document->filename );
128             },
129             Wx::gettext('Commit Project') => sub {
130             $self->git_cmd( 'commit', $document->project_dir );
131             },
132             Wx::gettext('Commit Amend') => sub {
133             $self->git_cmd( 'commit --amend', NONE );
134             },
135             Wx::gettext('Commit All') => sub {
136             $self->git_cmd( 'commit -a', NONE );
137             },
138             Wx::gettext('Commit Patch') => sub {
139             $self->git_patch( 'git commit -p ' . $document->filename );
140             },
141             ],
142             Wx::gettext('Checkout') => [
143             Wx::gettext('Checkout File') => sub {
144             $self->git_cmd( 'checkout --', $document->filename );
145             },
146             ],
147             Wx::gettext('Status') => [
148             Wx::gettext('File Status') => sub {
149             $self->git_cmd( 'status', $document->filename );
150             },
151             Wx::gettext('Directory Status') => sub {
152             self->git_cmd( 'status', File::Basename::dirname( $document->filename ) );
153             },
154             Wx::gettext('Project Status') => sub {
155             $self->git_cmd( 'status', $document->project_dir );
156             },
157             ],
158             Wx::gettext('Diff') => [
159             Wx::gettext('Diff of File') => sub {
160             my $result = $self->git_cmd( 'diff', $document->filename );
161             },
162             Wx::gettext('Diff of Staged File') => sub {
163             $self->git_cmd( 'diff --cached', $document->filename );
164             },
165             Wx::gettext('Diff of Directory') => sub {
166             $self->git_cmd( 'diff', File::Basename::dirname( $document->filename ) );
167             },
168             Wx::gettext('Diff of Project') => sub {
169             $self->git_cmd( 'diff', $document->project_dir );
170             },
171             ],
172             Wx::gettext('Log') => [
173             Wx::gettext('log --stat -2') => sub {
174             $self->git_cmd( 'log --stat -2', NONE );
175             },
176             Wx::gettext('log -p -2') => sub {
177             $self->git_cmd( 'log -p -2', NONE );
178             },
179             Wx::gettext('log pretty') => sub {
180             $self->git_cmd( 'log --pretty=format:"%h %s" --graph', NONE );
181             },
182             Wx::gettext('log graph last 100 commits') => sub {
183             $self->git_cmd( "log --graph --all --format=format:'%h - (%ar) %s - %an %d' --abbrev-commit --date=relative --cherry-pick --max-count=100", NONE );
184             },
185             ],
186             Wx::gettext('Blame') => [
187             Wx::gettext('Blame, Current file') => sub {
188             $self->git_cmd( 'blame', $document->filename );
189             },
190             ],
191             ],
192             Wx::gettext('Origin') => [
193             Wx::gettext('Show Origin Info.') => sub {
194             $self->git_cmd_task( 'remote show origin', NONE );
195             },
196             Wx::gettext('Push to Origin') => sub {
197             $self->git_cmd_task( 'push origin master', NONE );
198             },
199             Wx::gettext('Fetch from Origin') => sub {
200             $self->git_cmd_task( 'fetch origin master', NONE );
201             },
202             Wx::gettext('Pull from Origin') => sub {
203             $self->git_cmd_task( 'pull origin master', NONE );
204             },
205             ],
206             Wx::gettext('Upstream') => [
207             Wx::gettext('Show Upstream Info.') => sub {
208             $self->git_cmd_task( 'remote show upstream', NONE );
209             },
210             Wx::gettext('Fetch Upstream') => sub {
211             $self->git_cmd_task( 'fetch upstream', NONE );
212             },
213             Wx::gettext('Merge Upstream Master') => sub {
214             $self->git_cmd_task( 'merge upstream/master', NONE );
215             },
216             ],
217             Wx::gettext('Branching') => [
218             Wx::gettext('Branch Info') => sub {
219             $self->git_cmd( 'branch -r -a -v', NONE );
220             },
221             Wx::gettext('Fetch All Branches from Origin') => sub {
222             $self->git_cmd_task( 'fetch --all', NONE );
223             },
224             ],
225             Wx::gettext('GitHub') => [
226             Wx::gettext('GitHub Pull Request') => sub {
227             $self->github_pull_request();
228             },
229             ],
230             Wx::gettext('About...') => sub {
231             $self->plugin_about;
232             },
233             # Wx::gettext('Test Commit Message...') => sub {
234              
235             # # $self->commit_message();
236             # $self->commit_message( $document->filename );
237             # },
238             ];
239             }
240             }
241             };
242              
243             # return; #do not enable this return as it Fucks-up the menu
244             }
245              
246             ########
247             # Composed Method clean_dialog
248             ########
249             sub clean_dialog {
250             my $self = shift;
251              
252             # Close the main dialog if it is hanging around
253             if ( $self->{dialog} ) {
254             $self->{dialog}->Hide;
255             $self->{dialog}->Destroy;
256             delete $self->{dialog};
257             }
258              
259             return 1;
260             }
261              
262             ########
263             # plugin_disable
264             ########
265             sub plugin_disable {
266             my $self = shift;
267              
268             # Close the dialog if it is hanging around
269             $self->clean_dialog;
270              
271             # Unload all our child classes
272             for my $package (CHILDREN) {
273             require Padre::Unload;
274             Padre::Unload->unload($package);
275             }
276              
277             $self->SUPER::plugin_disable(@_);
278              
279             return 1;
280             }
281              
282             #######
283             # Add icon to Plugin
284             #######
285             sub plugin_icon {
286             my $self = shift;
287             my $share = $self->plugin_directory_share or return;
288             my $file = File::Spec->catfile( $share, 'icons', '16x16', 'git.png' );
289             return unless -f $file;
290             return unless -r $file;
291             return Wx::Bitmap->new( $file, Wx::wxBITMAP_TYPE_PNG );
292             }
293              
294             #######
295             # plugin_about
296             #######
297             sub plugin_about {
298             my $self = shift;
299              
300             my $share = $self->plugin_directory_share or return;
301             my $file = File::Spec->catfile( $share, 'icons', '48x48', 'git.png' );
302             return unless -f $file;
303             return unless -r $file;
304              
305             my $info = Wx::AboutDialogInfo->new;
306              
307             $info->SetIcon( Wx::Icon->new( $file, Wx::wxBITMAP_TYPE_PNG ) );
308             $info->SetName('Padre::Plugin::Git');
309             $info->SetVersion($VERSION);
310             $info->SetDescription( Wx::gettext('A Simple Git interface for Padre') );
311             $info->SetCopyright('(c) 2008-2012 The Padre development team');
312             $info->SetWebSite('http://padre.perlide.org/trac/wiki/PadrePluginGit');
313             $info->AddDeveloper('Kevin Dawson ');
314             $info->AddDeveloper('Kaare Rasmussen ');
315             $info->SetArtists(
316             [ 'Scott Chacon ',
317             'Licence '
318             ]
319             );
320             Wx::AboutBox($info);
321             return;
322             }
323              
324             ###
325             # End of Padre API Methods
326             ######
327              
328             #######
329             # git_commit
330             #######
331             sub git_cmd {
332             my $self = shift;
333             my $action = shift;
334             my $location = shift;
335             my $filename = shift;
336             my $main = $self->main;
337             my $document = $main->current->document;
338              
339             my $message;
340             my $git_cmd;
341             if ( $action =~ m/^commit/ ) {
342              
343             #ToDo this needs to be replaced with a dedicated dialogue, as all it dose is dump in to DB::History for no good reason
344             # my $commit_editmsg = read_file( $document->project_dir . '/.git/COMMIT_EDITMSG' );
345             # chomp $commit_editmsg;
346              
347             # $message = $main->prompt( "Git Commit of $location", 'Please type in your message', 'MY_GIT_COMMIT' );
348             $message = $self->commit_message( 'Git Commit message', $filename );
349             return if not $message;
350              
351             require Padre::Util;
352             $git_cmd = Padre::Util::run_in_directory_two(
353             cmd => "git $action $location -m \"$message\"",
354             dir => $document->project_dir,
355             option => 0
356             );
357              
358             # #update Changes file
359             # $self->write_changes( $document->project_dir, $message );
360              
361             } else {
362             require Padre::Util;
363             $git_cmd = Padre::Util::run_in_directory_two(
364             cmd => "git $action $location",
365             dir => $document->project_dir,
366             option => 0
367             );
368             }
369              
370             if ( $action !~ m/^diff/ ) {
371              
372             #strip leading #
373             $git_cmd->{output} =~ s/^(\#)//sxmg;
374             }
375              
376             #ToDo sort out Fudge, why O why do we not get correct response
377             # p $git_cmd;
378             if ( $action =~ m/^push/ ) {
379             $git_cmd->{output} = $git_cmd->{error};
380             $git_cmd->{error} = undef;
381             }
382              
383             #Display correct result
384             try {
385             if ( $git_cmd->{error} ) {
386             $main->error(
387             sprintf(
388             Wx::gettext("Git Error follows -> \n\n%s"),
389             $git_cmd->{error}
390             ),
391             );
392             }
393             if ( $git_cmd->{output} ) {
394             $self->load_dialog_output( "Git $action -> $location", $git_cmd->{output} );
395              
396             if ( $action =~ m/^commit/ ) {
397              
398             $git_cmd->{output} =~ m/master\s(?[\w|\d]{7})/;
399              
400             #update Changes file
401             $self->write_changes( $document->project_dir, $message, $+{nr} );
402             }
403              
404             } else {
405             $main->info( Wx::gettext('Info: There is no response, just as if you had run it on the cmd yourself.') );
406             }
407             };
408              
409             return;
410             }
411              
412             #######
413             # github_pull_request
414             #######
415             sub github_pull_request {
416             my $self = shift;
417             my $main = $self->main;
418             my $document = $main->current->document;
419              
420             # Lets start with user-name and token being external to pp-git
421             my $user = $ENV{GITHUB_USER};
422             my $token = $ENV{GITHUB_TOKEN};
423              
424             unless ( $user && $token ) {
425             $main->error(
426             Wx::gettext( 'Error: missing $ENV{GITHUB_USER} and $ENV{GITHUB_TOKEN}' . "\n"
427             . 'See http://padre.perlide.org/trac/wiki/PadrePluginGit' . "\n"
428             . 'Wiki page for more info.'
429             )
430             );
431             return;
432             }
433              
434             # my $message = $main->prompt( "GitHub Pull Request", "Please type in your message" );
435             my $message = $self->commit_message('GitHub Pull Request message');
436             return if not $message;
437              
438             #Use first 32 chars of message as pull request title
439             my $title = substr $message, 0, 32;
440              
441              
442             my $git_cmd;
443             require Padre::Util;
444             $git_cmd = Padre::Util::run_in_directory_two(
445             cmd => "git remote show upstream",
446             dir => $document->project_dir,
447             option => 0
448             );
449              
450             try {
451              
452             if ( defined $git_cmd->{error} ) {
453             if ( $git_cmd->{error} =~ m/^fatal/ ) {
454              
455             # $self->{error} = 'dose not have an upstream component';
456             say 'dose not have an upstream component';
457             $main->error( Wx::gettext('Error: this repo dose not have an upstream component') );
458             return;
459             }
460             }
461             };
462              
463             my $test_output = $git_cmd->{output};
464             $test_output =~ m{(?<=https://github.com/)(?.*)(?:/)(?.*)(?:.git)};
465             my $author = $+{author};
466             my $repo = $+{repo};
467              
468             require Pithub;
469             my $github = Pithub->new(
470             repo => $repo,
471             token => $token,
472             user => $user,
473             );
474              
475             my $status = $github->pull_requests->create(
476             repo => $repo,
477             user => $author,
478             data => {
479             base => "$author:master",
480             body => $message,
481             head => "$user:master",
482             title => $title,
483             }
484             );
485              
486             if ( $status->success eq 1 ) {
487             $main->message(
488             sprintf(
489             Wx::gettext("Info: Cool we got a: %s \nNow you should check your GitHub repo\n https://github.com/%s"),
490             $status->response->{_rc},
491             $user,
492             )
493             );
494             } else {
495             $main->error(
496             sprintf(
497             Wx::gettext("Error: %s\n%s"),
498             $status->response->{_rc},
499             $status->response->{_content},
500             )
501             );
502             }
503              
504             return;
505             }
506              
507             #######
508             # git_cmd_task
509             #######
510             sub git_cmd_task {
511             my $self = shift;
512             my $action = shift;
513             my $location = shift;
514             my $main = $self->main;
515             my $document = $main->current->document;
516              
517             require Padre::Plugin::Git::Task::Git_cmd;
518              
519             # Fire the task
520             $self->task_request(
521             task => 'Padre::Plugin::Git::Task::Git_cmd',
522             action => $action,
523             location => $location,
524             project_dir => $document->project_dir,
525             on_finish => 'on_finish',
526             );
527              
528             return;
529             }
530             #######
531             # on completion of task do this
532             #######patch->{output};
533             sub on_finish {
534             my $self = shift;
535             my $task = shift;
536             my $main = $self->main;
537              
538             if ( $task->{error} ) {
539             $main->error(
540             sprintf(
541             Wx::gettext("Git Error follows -> \n\n%s"),
542             $task->{error}
543             ),
544             );
545             } elsif ( $task->{output} ) {
546             $self->load_dialog_output( "Git task->{action} -> $task->{location}", $task->{output} );
547             } else {
548             $main->info( Wx::gettext('Info: There is no response, just as if you had run it on the cmd yourself.') );
549             }
550             return;
551             }
552              
553             ########
554             # Composed Method,
555             # Load Output dialog, only once
556             #######
557             sub load_dialog_output {
558             my $self = shift;
559             my $title = shift;
560             my $text = shift;
561              
562             # Padre main window integration
563             my $main = $self->main;
564              
565             # Close the dialog if it is hanging around
566             $self->clean_dialog;
567              
568             # Create the new dialog
569             require Padre::Plugin::Git::Output;
570             $self->{dialog} = Padre::Plugin::Git::Output->new( $main, $title, $text );
571             $self->{dialog}->Show;
572              
573             return;
574             }
575              
576             #######
577             # event_on_context_menu
578             #######
579             sub event_on_context_menu {
580             my ( $self, $document, $editor, $menu, $event ) = @_;
581              
582             $self->current_files;
583             return if not $document->filename;
584             return if not $document->project_dir;
585              
586             my $tab_id = $self->main->editor_of_file( $document->{filename} );
587              
588             if ( eval { $self->{open_file_info}->{$tab_id}->{'vcs'} =~ m/Git/sxm } ) {
589              
590             $menu->AppendSeparator;
591              
592             my $item = $menu->Append( -1, Wx::gettext('Git commit -a') );
593             Wx::Event::EVT_MENU(
594             $self->main,
595             $item,
596             sub { $self->git_cmd( 'commit -a', NONE ) },
597             );
598             }
599             return;
600             }
601              
602             #######
603             # Method current_files hacked from wx-dialog-patch
604             #######
605             sub current_files {
606             my $self = shift;
607             my $main = $self->main;
608             my $current = $main->current;
609             my $notebook = $current->notebook;
610             my @label = $notebook->labels;
611              
612             # get last element # not size
613             $self->{tab_cardinality} = $#label;
614              
615             # thanks Alias
616             my @file_vcs = map { $_->project->vcs } $self->main->documents;
617              
618             # create a bucket for open file info, as only a current file bucket exist
619             for ( 0 .. $self->{tab_cardinality} ) {
620             $self->{open_file_info}->{$_} = (
621             { 'index' => $_,
622             'URL' => $label[$_][1],
623             'filename' => $notebook->GetPageText($_),
624             'changed' => 0,
625             'vcs' => $file_vcs[$_],
626             },
627             );
628              
629             if ( $notebook->GetPageText($_) =~ /^\*/sxm ) {
630              
631             # TRACE("Found an unsaved file, will ignore: $notebook->GetPageText($_)") if DEBUG;
632             $self->{open_file_info}->{$_}->{'changed'} = 1;
633             }
634             }
635              
636             return;
637             }
638              
639              
640             ########
641             # Composed Method write_changes under {{$NEXT}}
642             ########
643             sub write_changes {
644             my $self = shift;
645             my $dir = shift;
646             my $message = shift;
647             my $nr_code = shift;
648              
649             require File::Spec;
650             my $change_file = File::Spec->catfile( $dir, 'Changes' );
651              
652             # say $change_file;
653              
654             if ( -e $change_file ) {
655              
656             # say 'found Changes';
657             # say $change_file;
658              
659             my $changes = CPAN::Changes->load(
660             $change_file,
661             next_token => qr/\{\{\$NEXT}}/,
662             );
663              
664             my @releases = $changes->releases;
665              
666             if ( $releases[-1]->version eq '{{$NEXT}}' ) {
667             $releases[-1]->add_changes( $message . " [$nr_code]" );
668             }
669              
670             # print $changes->serialize;
671              
672             write_file( $change_file, { binmode => ':utf8' }, $changes->serialize );
673             }
674             return;
675             }
676              
677              
678              
679             #######
680             # git_patch
681             #######
682             sub git_patch {
683             my $self = shift;
684             my $cmd = shift;
685             my $main = $self->main;
686             my $document = $main->current->document;
687              
688             my $system;
689              
690             # hacked from Padre-Wx-Main->run_command
691             if (Padre::Constant::WIN32) {
692             my $title = $cmd;
693             $title =~ s/"//g;
694             $system = qq(start "$title" cmd /C "$cmd & pause");
695             } elsif (Padre::Constant::UNIX) {
696              
697             if ( defined $ENV{COLORTERM} ) {
698             if ( $ENV{COLORTERM} eq 'gnome-terminal' ) {
699              
700             #Gnome-Terminal line format:
701             #gnome-terminal -e "bash -c \"prove -lv t/96_edit_patch.t; exec bash\""
702             $system = qq($ENV{COLORTERM} -e "bash -c \\\"$cmd ; exec bash\\\"" & );
703             } else {
704             $system = qq(xterm -sb -e "$cmd ; sleep 1000" &);
705             }
706             }
707             } elsif (Padre::Constant::MAC) {
708              
709             # tome
710             my $pwd = $self->current->document->project_dir();
711             $cmd =~ s/"/\\"/g;
712              
713             # Applescript can throw spurious errors on STDERR: http://helpx.adobe.com/photoshop/kb/unit-type-conversion
714             $system = qq(osascript -e 'tell app "Terminal"\n\tdo script "cd $pwd; clear; $cmd ;"\nend tell'\n);
715              
716             } else {
717             $system = qq(xterm -sb -e "$cmd ; sleep 1000" &);
718             }
719              
720             # run 'git add -p file-name' in terminal
721             require Padre::Util;
722             Padre::Util::run_in_directory_two(
723             cmd => $system,
724             dir => $document->project_dir,
725             option => 0
726             );
727              
728             return;
729             }
730              
731             #######
732             # new commit message dialog that dos not dump into DB::History
733             #######
734             sub commit_message {
735             my $self = shift;
736             my $title = shift;
737             my $filename = shift;
738              
739             # Padre main window integration
740             my $main = $self->main;
741             my $document = $main->current->document;
742              
743             # Close the dialog if it is hanging around
744             $self->clean_dialog;
745              
746             # Create the new dialog
747             require Padre::Plugin::Git::Message;
748             $self->{dialog} = Padre::Plugin::Git::Message->new( $main, $title, $document->project_dir, $filename );
749             $self->{dialog}->ShowModal;
750             $self->{dialog}->Destroy;
751             delete $self->{dialog};
752              
753             my $config = $self->config_read;
754             if ( $config->{message} ) {
755             my $message = $config->{message};
756             chomp $message;
757             # say $message;
758             return $message;
759             }
760             return;
761             }
762              
763              
764             1;
765              
766             __END__