package Padre::Project;
# Base project functionality for Padre
use 5.010;
use strict;
use warnings;
use File::Spec ();
use Padre::Constant ();
use Padre::Current ();
our $VERSION = '1.00';
our $COMPATIBLE = '0.93';
######################################################################
# Constructor and Accessors
sub new {
my $class = shift;
my $self = bless {@_}, $class;
# Flag to indicate this root is specifically provided by a user
# and is not intuited.
$self->{explicit} = !!$self->{explicit};
# Check the root directory
unless ( defined $self->root ) {
Carp::croak("Did not provide a root directory");
}
unless ( -d $self->root ) {
return undef;
}
# Check for a padre.yml file
my $padre_yml = File::Spec->catfile(
$self->root,
'padre.yml',
);
if ( -f $padre_yml ) {
$self->{padre_yml} = $padre_yml;
}
return $self;
}
### DEPRECATED
sub from_file {
if ( $VERSION > 0.84 ) {
warn "Deprecated Padre::Project::from_file called by " . scalar caller();
}
require Padre::Current;
Padre::Current->ide->project_manager->from_file( $_[1] );
}
sub explicit {
$_[0]->{explicit};
}
sub root {
$_[0]->{root};
}
sub padre_yml {
$_[0]->{padre_yml};
}
######################################################################
# Navigation Convenience Methods
sub documents {
my $self = shift;
my $root = $self->root;
require Padre::Current;
return grep { $_->project_dir eq $root } Padre::Current->main->documents;
}
######################################################################
# Configuration and Intuition
sub config {
my $self = shift;
# We only need our own config file if we have a padre.yml file
unless ( defined $self->{padre_yml} ) {
require Padre::Current;
return Padre::Current->config;
}
unless ( $self->{config} ) {
# Get the default config object
my $config = Padre::Current->config;
# If we have a padre.yml file create a custom config object
if ( $self->{padre_yml} ) {
require Padre::Config;
require Padre::Config::Project;
$self->{config} = Padre::Config->new(
$config->host,
$config->human,
Padre::Config::Project->read(
$self->{padre_yml},
),
);
} else {
require Padre::Config;
$self->{config} = Padre::Config->new(
$config->host,
$config->human,
);
}
}
return $self->{config};
}
# Locate the "primary" file, if the project has one
sub headline {
return undef;
}
# As above but an absolute path
sub headline_path {
my $self = shift;
my $headline = $self->headline;
return undef unless defined $headline;
File::Spec->catfile( $self->root, $headline );
}
# Intuit the distribution version if possible
sub version {
return undef;
}
# What is the logical name of the version control system we are using.
# Identifying the version control flavour is the only support we provide.
# Anything more details needs to be in the version control plugin.
# Returns a name or undef if no version control.
sub vcs {
my $self = shift;
unless ( exists $self->{vcs} ) {
my $class = ref $self;
$self->{vcs} = $class->_vcs( $self->root );
}
return $self->{vcs};
}
sub _vcs {
my $class = shift;
my $root = shift;
if ( -d File::Spec->catdir( $root, '.svn' ) ) {
return Padre::Constant::SUBVERSION;
}
#Hack for svn 1.7 esp Padre trunk to re-enable VCS feature.
elsif ( -d File::Spec->catdir( $root, '..', '.svn' ) ) {
return Padre::Constant::SUBVERSION;
}
if ( -d File::Spec->catdir( $root, '.git' ) ) {
return Padre::Constant::GIT;
}
if ( -d File::Spec->catdir( $root, '.hg' ) ) {
return Padre::Constant::MERCURIAL;
}
if ( -d File::Spec->catdir( $root, '.bzr' ) ) {
return Padre::Constant::BAZAAR;
}
if ( -f File::Spec->catfile( $root, 'CVS', 'Repository' ) ) {
return Padre::Constant::CVS;
}
return undef;
}
######################################################################
# Process Execution
sub temp {
$_[0]->{temp} or $_[0]->{temp} = $_[0]->_temp;
}
sub _temp {
require Padre::Project::Temp;
Padre::Project::Temp->new;
}
# Synchronise all content from unsaved files in a project to the
# project-specific temporary directory.
sub temp_sync {
my $self = shift;
# What files do we need to save
my @changed = grep { !$_->is_new and $_->is_modified } $self->documents or return 0;
# Save the files to the temporary directory
my $temp = $self->temp;
my $root = $temp->root;
my $files = 0;
foreach my $document (@changed) {
my $relative = $document->filename_relative;
my $tempfile = File::Spec->rel2abs( $relative, $root );
require File::Path;
require File::Basename;
File::Path::mkpath( File::Basename::basedir($tempfile) );
my $file = Padre::File->new($tempfile);
$document->write($file) and $files++;
}
return $files;
}
sub launch_shell {
my $self = shift;
my $config = $self->config;
my $shell = $config->bin_shell or return;
if (Padre::Constant::WIN32) {
require Win32;
require Padre::Util::Win32;
Win32::SetChildShowWindow( Win32::SW_SHOWNORMAL() );
Padre::Util::Win32::ExecuteProcessAndWait(
directory => $self->{project},
file => 'cmd.exe',
parameters => "/C $shell",
);
Win32::SetChildShowWindow( Win32::SW_HIDE() );
} else {
require File::pushd;
my $pushd = File::pushd::pushd( $self->root );
system $shell;
}
return 1;
}
# Run a command and wait
sub launch_system {
my $self = shift;
my $cmd = shift;
# Make sure we execute from the correct directory
if (Padre::Constant::WIN32) {
require Padre::Util::Win32;
Padre::Util::Win32::ExecuteProcessAndWait(
directory => $self->{project},
file => 'cmd.exe',
parameters => "/C $cmd",
);
} else {
require File::pushd;
my $pushd = File::pushd::pushd( $self->root );
system $cmd;
}
return 1;
}
######################################################################
# Directory Tree Integration
# A file/directory pattern to support the directory browser.
# The function takes three parameters of the full file path,
# the directory path, and the file name.
# Returns true if the file is visible.
# Returns false if the file is ignored.
# This method is used to support the functionality of the directory browser.
sub ignore_rule {
return sub {
if ( $_->{name} =~ /^\./ ) {
return 0;
}
if (Padre::Constant::WIN32) {
# On Windows only ignore files or directories that
# begin or end with a dollar sign as "hidden". This is
# mainly relevant if we are opening some project across
# a UNC path on more recent versions of Windows.
if ( $_->{name} =~ /^\$/ ) {
return 0;
}
if ( $_->{name} =~ /\$$/ ) {
return 0;
}
# Windows thumbnailing, instead of having sensibly
# centralised storage of thumbnails, likes to put a
# file in every single directory.
if ( $_->{name} eq 'Thumbs.db' ) {
return 0;
}
# Likewise, desktop.ini files are stupid files used
# by windows to make a folder behave weirdly.
# Ignore them too.
if ( $_->{name} eq 'desktop.ini' ) {
return 0;
}
}
return 1;
};
}
# Alternate form
sub ignore_skip {
my $rule = [
'(?:^|\\/)\\.',
];
if (Padre::Constant::WIN32) {
# On Windows only ignore files or directories that begin or end
# with a dollar sign as "hidden". This is mainly relevant if
# we are opening some project across a UNC path on more recent
# versions of Windows.
push @$rule, "(?:^|\\/)\\\$";
push @$rule, "\\\$\$";
# Windows thumbnailing, instead of having sensibly centralised
# storage of thumbnails, likes to put a file in every single directory.
push @$rule, "(?:^|\\/)Thumbs.db\$";
# Likewise, desktop.ini files are stupid files used by windows
# to make a folder behave weirdly. Ignore them too.
push @$rule, "(?:^|\\/)desktop.ini\$";
}
return $rule;
}
sub name {
my $self = shift;
my $name = ( reverse( File::Spec->splitdir( $self->root ) ) )[0];
if ( !defined $name or $name eq '' ) { # Fallback
$name = $self->root;
$name =~ s/^.*[\/\\]//;
}
return $name;
}
######################################################################
# Padre::Cache Integration
# The detection of VERSION allows us to make this call without having
# to load modules at project destruction time if it isn't needed.
sub DESTROY {
if ( defined $_[0]->{root} and $Padre::Cache::VERSION ) {
Padre::Cache->release( $_[0]->{root} );
}
}
1;
# Copyright 2008-2013 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.