package Padre::Plugin::HG;
use 5.008;
use warnings;
use strict;
use Padre::Config ();
use Padre::Wx ();
use Padre::Plugin ();
use Padre::Util ();
use Capture::Tiny qw(capture_merged);
use File::Basename ();
use File::Spec;
use Padre::Plugin::HG::ProjectCommit;
use Padre::Plugin::HG::ProjectClone;
use Padre::Plugin::HG::UserPassPrompt;
use Padre::Plugin::HG::DiffView;
use Padre::Plugin::HG::LogView;
my %projects;
our $VERSION = '0.16';
our @ISA = 'Padre::Plugin';
my $VCS = "Mercurial";
# enter the vcs commands here, variables will be evaled in in the sub routines.
# was meant as a way to make it more generic. Not sure it is going to
# succeed.
my %VCSCommand = ( commit => 'hg commit -A -m"$message" $path ',
add => 'hg add $path',
status =>'hg status --all $path',
root => 'hg root',
diff => 'hg diff $path',
diff_revision => 'hg diff -r $revision $path',
clone=> 'hg clone $path',
pull =>'hg pull --update --noninteractive ',
push =>'hg push $path',
log =>'hg log $path');
=pod
=head1 NAME
Padre::Plugin::HG - Mecurial interface for Padre
=head1 Instructions
Ensure Mecurial is installed and the hg command is in the path.
cpan install Padre::Plugin::HG
Either open a file in an existing Mecurial project or choose Plugins > HG > Clone and enter an
exisiting repository to clone.
you can clone this project it self with
"hg clone https://code4pay@bitbucket.org/code4pay/padre-plugin-hg/"
Once you have a file from the project open got to Plugins > HG > View Project.
this will display the project tree in the left hand side bar and allow you to
perform operations on the files /project via the right mouse button.
Project wide operations like pull are only available by right clicking the project root.
=head1 AUTHOR
Michael Mueller << <michael at muellers.net.au> >>
=head1 BUGS
Please report any bugs or feature requests to L<http://padre.perlide.org/>
=head1 COPYRIGHT & LICENSE
Copyright 2008-2009 Michael Mueller
all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
#####################################################################
# Padre::Plugin Methods
sub padre_interfaces {
'Padre::Plugin' => 0.72
}
sub plugin_name {
'HG';
}
sub menu_plugins_simple {
my $self = shift;
return $self->plugin_name => [
'About' => sub { $self->show_about },
'View Project' => sub {$self->show_statusTree},
'Clone' => sub {$self->show_project_clone},
];
}
sub plugin_disable
{
require Class::Unload;
Class::Unload->unload('Padre::Plugin::HG::StatusTree;');
}
#####################################################################
# Custom Methods
sub show_about {
my $self = shift;
# Generate the About dialog
my $about = Wx::AboutDialogInfo->new;
$about->SetName("Padre::Plugin::HG");
$about->SetDescription( <<"END_MESSAGE" );
Mecurial support for Padre
END_MESSAGE
$about->SetVersion( $VERSION );
# Show the About dialog
Wx::AboutBox( $about );
return;
}
#
#vcs_commit
#
# performs the commit
# $self->vcs_commit($filename, $dir);
# will prompt for the commit message.
#
sub vcs_commit {
my ($self, $path, $dir ) = @_;
my $main = Padre->ide->wx->main;
if (!$self->_project_root($path))
{
$main->error("File not in a $VCS Project", "Padre $VCS" );
return;
}
my $message = $main->prompt("$VCS Commit of $path", "Please type in your message", "MY_".$VCS."_COMMIT");
if ($message) {
my $command = eval "qq\0$VCSCommand{commit}\0";
my $result = $self->vcs_execute($command, $dir);
$main->message( $result, "$VCS Commiting $path" );
}
return;
}
#
#vcs_add
#
# Adds the file to the repository
# $self->vcs_add($filename, $dir);
# will prompt for the commit message.
#
sub vcs_add {
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
my $command = eval "qq\0$VCSCommand{add}\0";
my $result = $self->vcs_execute($command,$dir);
$main->message( $result, "$VCS Adding to Repository" );
return;
}
#
# vcs_diff
#
# compare the file to the repository tip
# $self->vcs_diff($filename, $dir);
# provides some basic diffing the current file agains the tip
sub vcs_diff {
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
my $command = eval "qq\0$VCSCommand{diff}\0";
return $main->error('File not in a $VCS Project', "Padre $VCS" ) if not $self->_project_root($path);
my $result = $self->vcs_execute($command, $dir);
return $result;
}
# vcs_diff_revision
#
# compare the file to a repository revision
# $self->vcs_diff($filename, $dir, $revision);
# Revision for HG is the changeset id.
sub vcs_diff_revision {
my ($self, $path, $dir, $revision) = @_;
my $main = Padre->ide->wx->main;
my $command = eval "qq\0$VCSCommand{diff_revision}\0";
return $main->error('File not in a $VCS Project', "Padre $VCS" ) if not $self->_project_root($path);
my $result = $self->vcs_execute($command, $dir);
return $result;
}
# vcs_log
#
# show the commit history of the passed file.
# $self->vcs_commit($filename, $dir);
# returns a string containing the log history
sub vcs_log {
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
my $command = eval "qq\0$VCSCommand{log}\0";
return $main->error('File not in a $VCS Project', "Padre $VCS" ) if not $self->_project_root($path);
my $result = $self->vcs_execute($command, $dir);
return $result;
}
#
#clone_project
#
# Adds the file to the repository
# $self->vcs_diff($repository, $destination_dir);
# Will clone a repository and place it in the destination dir
#
sub clone_project
{
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
my $command = eval "qq\0$VCSCommand{clone}\0";
my $result = $self->vcs_execute($command, $dir);
$main->message( $result, "$VCS Cloning $path" );
return;
}
#
# pull_update_project
#
# Pulls updates to a project.
# It will perform an update automatically on the repository
# $self->pull_update_project($file, $projectdir);
# Only pulls changes from the default repository, which is normally
# the one you cloned from.
sub pull_update_project
{
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
return $main->error('File not in a $VCS Project', "Padre $VCS" ) if not $self->_project_root($path);
my $command = eval "qq\0$VCSCommand{pull}\0";
my $result = $self->vcs_execute($command, $dir);
$main->message( $result, "$VCS Cloning $path" );
return;
}
# Pushes updates to a remote repository.
# Prompts for the username and password.
# $self->push_project($file, $projectdir);
# Only pushes changes to the default remote repository, which is normally
# the one you cloned from.
sub push_project
{
my ($self, $path, $dir) = @_;
my $main = Padre->ide->wx->main;
return $main->error('File not in a $VCS Project', "Padre $VCS" ) if not $self->_project_root($path);
my $config_command = 'hg showconfig';
my $result1 = $self->vcs_execute($config_command, $dir); #overwriting path on purpose.
#overwriting path on purpose.
#gets the configured push path if it exists
($path) = $result1 =~ /paths.default=(.*)/;
return $main->error('No default push path', "Padre $VCS" ) if not $path;
my ($default_username) = $path =~ /\/\/(.*)@/;
my $prompt = Padre::Plugin::HG::UserPassPrompt->new(
title=>'Mecurial Push',
default_username=>$default_username,
default_password =>'');
my $username = $prompt->{username};
my $password = $prompt->{password};
$path =~ s/\/(.*)@/\/\/$username:$password@/g;
my $command = eval "qq\0$VCSCommand{push}\0";
my $result = $self->vcs_execute($command, $dir);
$main->message( $result, "$VCS Pushing $path" );
return;
}
# vcs_execute
#
# Executes a command after changing to the appropriate dir.
# $self->vcs_execute($command, $dir);
# All output is captured and returned as a string.
sub vcs_execute
{
my ($self, $command, $dir) = @_;
print "Command $command\n";
my $busyCursor = Wx::BusyCursor->new();
my $result = capture_merged(sub{chdir($dir);system($command)});
if (!$result){$result = "Action Completed"}
$busyCursor = undef;
return $result;
}
# show_statusTree
#
# Displays a Project Browser in the side pane. The Browser shows the status of the
# files in HG and gives menu options to perform actions.
sub show_statusTree
{
my ($self) = @_;
require Padre::Plugin::HG::StatusTree;
my $main = Padre->ide->wx->main;
my $project_root = $self->_project_root(current_filename());
$self->{project_path} = $project_root;
return $main->error("Not a $VCS Project") if !$project_root;
# we only want to add a tree for projects that don't already have one.
if (!exists($projects{$project_root}) )
{
$projects{$project_root} = Padre::Plugin::HG::StatusTree->new($self,$project_root);
}
}
#
#
#show_commit_list
#
# Displays a list of all the files that are awaiting commiting. It will include
# not added and deleted files adding and removing them as required.
sub show_commit_list
{
my ($self) = @_;
my $main = Padre->ide->wx->main;
$self->{project_path} = $self->_project_root(current_filename());
return $main->error("Not a $VCS Project") if ! $self->{project_path} ;
my $obj = Padre::Plugin::HG::ProjectCommit->showList($self);
$obj = undef;
}
#
# show_diff
#
# Displays a list of all the files that are awaiting commiting. It will include
# not added and deleted files adding and removing them as required.
sub show_diff
{
my ($self, $file, $path) = @_;
my $main = Padre->ide->wx->main;
$self->{project_path} = $self->_project_root($file);
my $full_path = File::Spec->catdir(($path,$file));
return $main->error("Not a $VCS Project") if ! $self->{project_path} ;
my $differences = $self->vcs_diff($file, $path);
Padre::Plugin::HG::DiffView->showDiff($self,$differences);
}
#show_diff_revision
#
# Displays a list of all the revisions for the selected file.
# Allowing you to choose one to diff the current selection to.
sub show_diff_revision
{
my ($self, $file, $path) = @_;
my $main = Padre->ide->wx->main;
$self->{project_path} = $self->_project_root($file);
my $full_path = File::Spec->catdir(($path,$file));
return $main->error("Not a $VCS Project") if ! $self->{project_path} ;
my $changeset = Padre::Plugin::HG::LogView->showList($self,$full_path);
my $differences = $self->vcs_diff_revision($file, $path, $changeset);
Padre::Plugin::HG::DiffView->showDiff($self,$differences);
}
#show_commit_list
#
# Displays a list of all the files that are awaiting commiting. It will include
# not added and deleted files adding and removing them as required.
sub show_log
{
my ($self) = @_;
my $main = Padre->ide->wx->main;
$self->{project_path} = $self->_project_root(current_filename());
return $main->error("Not a $VCS Project") if ! $self->{project_path} ;
my $obj = Padre::Plugin::HG::LogView->showList($self,current_filename());
$obj = undef;
}
#show_project_clone
#
# Dialog for project cloning
#
sub show_project_clone
{
my ($self) = @_;
my $main = Padre->ide->wx->main;
my $clone = Padre::Plugin::HG::ProjectClone->new($self);
if ($clone->enter_repository())
{
$clone->choose_destination();
}
if ($clone->project_url() and $clone->destination_dir())
{
$self->clone_project(
$clone->project_url(),
$clone->destination_dir()
);
}
}
#
# _project_root
#
# $self->_project_root($filename);
# Calculates the project root. if the file is not in a project it
# will return 0
# otherwise it returns the fully qualified path to the project.
sub _project_root
{
my ($self, $filename) = @_;
my $dir = File::Basename::dirname($filename);
my $project_root = $self->vcs_execute($VCSCommand{root}, $dir);
#file in not in a HG project.
if ($project_root =~ m/^abort:/)
{
$project_root = 0;
}
chomp ($project_root);
return $project_root;
}
# _get_hg_files
#
# $self->_get_hg_files(@hgStatus);
# Pass the output of hg status and it will give back an array
# each element of the array is [$status, $filename]
sub _get_hg_files
{
my ($self, @hg_status) = @_;
my @files;
foreach my $line (@hg_status)
{
my ($filestatus, $path) = split(/\s/,$line);
push (@files, ([$filestatus,$path]));
}
return @files;
}
#current_filename
#
# $self->current_filename();
# returns the path of the file with the current attention
# in the ide.
sub current_filename {
my $main = Padre->ide->wx->main;
my $doc = $main->current->document;
my $filename = $doc->filename;
return $main->error("No document found") if not $filename;
return ($filename);
}
#parse_log
#
# $self->parse_log($log);;
# Pass it the output of the hg log command and it will
# return an array of hashes with each array element
# being a hash of the commit values.
# eg changeset, user, date ...
#
sub parse_log {
my ($self,$log) = @_;
# log output looks like
#
#changeset: 3:80d72b2a4751
#user: bill@microsoft.com
#date: Fri Oct 16 07:05:27 2009 +1100
#summary: Added files for CPAN distribution
#
#changeset: 3:80d72b2a4751
#user: bill@microsoft.com
#date: Fri Oct 16 07:05:27 2009 +1100
#summary: Tricky Comment summary: CPAN distribution
#split the output at blank lines
my @commits = split(/\n{2,}/, $log);
my $i = 0;
my @result;
foreach my $commit (@commits)
{
$result[$i] = {
changeset=>$commit =~ /^changeset:\s+(.*)/m,
user=>$commit=~ /^user:\s+(.*)/m,
date=>$commit=~ /^date:\s+(.*)/m,
summary=>$commit=~ /^summary:\s+(.*)/m,
} ;
$i++;
}
return @result;
}
# object_for_testing
#
# creates a blessed object so we can run our tests.
#
sub object_for_testing
{
my ($class) = @_;
my $self = {};
bless $self,$class;
}
1;
# Copyright 2008-2009 Michael Mueller.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.