package Padre::ProjectManager; # Prototype for a full project manager abstraction to track projects open # in Padre and provide a variety of utility functions. use 5.008; use strict; use warnings; use File::Spec (); use Scalar::Util (); use Padre::Project (); our $VERSION = '1.02'; ###################################################################### # Constructors sub new { my $class = shift; my $self = bless { # For now just store projects in the HASH directly }, $class; return $self; } sub project { my $self = shift; my $root = shift; # Is this root an existing project? if ( defined $self->{$root} ) { return $self->{$root}; } # Check for Dist::Zilla support my $dist_ini = File::Spec->catfile( $root, 'dist.ini' ); if ( -f $dist_ini ) { require Padre::Project::Perl::DZ; return $self->{$root} = Padre::Project::Perl::DZ->new( root => $root, dist_ini => $dist_ini, ); } # Check for Module::Build support my $build_pl = File::Spec->catfile( $root, 'Build.PL' ); if ( -f $build_pl ) { require Padre::Project::Perl::MB; return $self->{$root} = Padre::Project::Perl::MB->new( root => $root, build_pl => $build_pl, ); } # Check for ExtUtils::MakeMaker and Module::Install support my $makefile_pl = File::Spec->catfile( $root, 'Makefile.PL' ); if ( -f $makefile_pl ) { # Differentiate between Module::Install and ExtUtils::MakeMaker if (0) { require Padre::Project::Perl::MI; return $self->{$root} = Padre::Project::Perl::MI->new( root => $root, makefile_pl => $makefile_pl, ); } else { require Padre::Project::Perl::EUMM; return $self->{$root} = Padre::Project::Perl::EUMM->new( root => $root, makefile_pl => $makefile_pl, ); } } # Check for an explicit vanilla project my $padre_yml = File::Spec->catfile( $root, 'padre.yml' ); if ( -f $padre_yml ) { return $self->{$root} = Padre::Project->new( root => $root, padre_yml => $padre_yml, ); } # Intuit a vanilla project based on a version control system # checkout (that use a directory to indicate the root). foreach my $vcs ( '.svn', '.git', '.hg', '.bzr' ) { my $vcs_dir = File::Spec->catfile( $root, $vcs ); if ( -d $vcs_dir ) { my $vcs_plugin = { '.svn' => 'SVN', '.git' => 'Git', '.hg' => 'Mercurial', '.bzr' => 'Bazaar', }->{$vcs}; return $self->{$root} = Padre::Project->new( root => $root, vcs => $vcs_plugin, ); } } # Intuit a vanilla project based on a CVS version control directory. my $cvs_file = File::Spec->catfile( $root, 'CVS', 'Repository' ); if ( -f $cvs_file ) { return $self->{$root} = Padre::Project->new( root => $root, vcs => 'CVS', ); } # No idea what this is, nothing probably require Padre::Project::Null; return $self->{$root} = Padre::Project::Null->new( root => $root, vcs => undef, ); } sub from_file { my $self = shift; my $file = shift; # Split and scan my ( $v, $d, $f ) = File::Spec->splitpath($file); my @d = File::Spec->splitdir($d); if ( defined $d[-1] and $d[-1] eq '' ) { pop @d; } # Is the file inside a project we have loaded already. # This should save a ton of filesystem calls when opening files. foreach my $root ( sort keys %$self ) { my $project = $self->{$root} or next; # Skip baseline projects without a padre.yml file as we # can't be confident enough that they are actually correct. if ( Scalar::Util::blessed($project) eq 'Padre::Project' ) { next unless $project->padre_yml; } # Split into parts (check volume before we bother to split dir) my ( $pv, $pd, $pf ) = File::Spec->splitpath( $root, 1 ); if ( defined $v and defined $pv and $v ne $pv ) { next; } my @pd = File::Spec->splitdir($pd); if ( defined $pd[-1] and $pd[-1] eq '' ) { pop @pd; } foreach my $n ( 0 .. $#pd ) { last unless defined $d[$n]; last unless $d[$n] eq $pd[$n]; next unless $n == $#pd; # Found a match, return the cached project return $project; } } foreach my $n ( reverse 0 .. $#d ) { my $dir = File::Spec->catdir( @d[ 0 .. $n ] ); my $root = File::Spec->catpath( $v, $dir, '' ); # Check for Dist::Zilla support my $dist_ini = File::Spec->catfile( $root, 'dist.ini' ); if ( -f $dist_ini ) { require Padre::Project::Perl::DZ; return $self->{$root} = Padre::Project::Perl::DZ->new( root => $root, dist_ini => $dist_ini, ); } # Check for Module::Build support my $build_pl = File::Spec->catfile( $root, 'Build.PL' ); if ( -f $build_pl ) { require Padre::Project::Perl::MB; return $self->{$root} = Padre::Project::Perl::MB->new( root => $root, build_pl => $build_pl, ); } # Check for ExtUtils::MakeMaker and Module::Install support my $makefile_pl = File::Spec->catfile( $root, 'Makefile.PL' ); if ( -f $makefile_pl ) { # Differentiate between Module::Install and ExtUtils::MakeMaker if (0) { require Padre::Project::Perl::MI; return $self->{$root} = Padre::Project::Perl::MI->new( root => $root, makefile_pl => $makefile_pl, ); } else { require Padre::Project::Perl::EUMM; return $self->{$root} = Padre::Project::Perl::EUMM->new( root => $root, makefile_pl => $makefile_pl, ); } } # Check for an explicit vanilla project my $padre_yml = File::Spec->catfile( $root, 'padre.yml' ); if ( -f $padre_yml ) { return $self->{$root} = Padre::Project->new( root => $root, padre_yml => $padre_yml, ); } # Intuit a vanilla project based on a git, mercurial or Bazaar # checkout (that use a single directory to indicate the root). foreach my $vcs ( '.git', '.hg', '.bzr' ) { my $vcs_dir = File::Spec->catdir( $root, $vcs ); if ( -d $vcs_dir ) { my $vcs_plugin = { '.git' => 'Git', '.hg' => 'Mercurial', '.bzr' => 'Bazaar', }->{$vcs}; return $self->{$root} = Padre::Project->new( root => $root, vcs => $vcs_plugin, ); } } # Intuit a vanilla project based on a Subversion checkout my $svn_dir = File::Spec->catdir( $root, '.svn' ); if ( -d $svn_dir ) { # This must be the top-most .svn directory if ($n) { # We aren't at the top-most directory in the volume my $updir = File::Spec->catdir( @d[ 0 .. $n - 1 ] ); my $svn_updir = File::Spec->catpath( $v, $updir, '.svn' ); unless ( -d $svn_dir ) { return $self->{$root} = Padre::Project->new( root => $root, vcs => 'SVN', ); } } } # Intuit a vanilla project based on a CVS checkout my $cvs_dir = File::Spec->catfile( $root, 'CVS', 'Repository' ); if ( -f $cvs_dir ) { # This must be the top-most CVS directory if ($n) { # We aren't at the top-most directory in the volume my $updir = File::Spec->catdir( @d[ 0 .. $n - 1 ] ); my $cvs_updir = File::Spec->catpath( $v, File::Spec->catdir( $updir, 'CVS' ), 'Repository', ); unless ( -f $cvs_dir ) { return $self->{$root} = Padre::Project->new( root => $root, vcs => 'CVS', ); } } } } # This document is part of the null project require Padre::Project::Null; return Padre::Project::Null->new( root => File::Spec->catpath( $v, File::Spec->catdir(@d), '' ), vcs => undef, ); } sub from_document { my $self = shift; my $document = shift; die "CODE INCOMPLETE"; } ###################################################################### # General Methods sub project_exists { defined $_[0]->{ $_[1] }; } sub projects { my $self = shift; return map { $self->{$_} } sort keys %$self; } sub roots { my $self = shift; my @roots = sort keys %$self; return @roots; } 1; # Copyright 2008-2016 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.