Devel::PerlySense::Project - A Project root

  git
  svn
  none

use strict;
use warnings;

package Devel::PerlySense::Project;
our $VERSION = '0.01';



use Spiffy -Base;
use Carp;
use Data::Dumper;
use File::Basename;
use Path::Class;
use File::Slurp;
use File::chdir;
use Perl::Critic 1.105;
use List::MoreUtils qw/ uniq /;

use Devel::PerlySense;
use Devel::PerlySense::Util;
use Devel::PerlySense::Util::Log;
use Devel::PerlySense::Config::Project::Default;

sub dirProject {
    return
            $self->dirProjectExplicitDir ||
            $self->dirProjectImplicitUse ||
            $self->dirProjectImplicitDir;
}

field "dirProjectExplicitDir" => "";

field "dirProjectImplicitUse" => "";

field "dirProjectImplicitDir" => "";

field "oConfig" => Devel::PerlySense::Config::Project::Default->new();

sub rhConfig {
    return $self->oConfig->rhConfig;
}

field "oPerlySense" => undef;

sub nameVcs {

    #Git
    $self->oPerlySense->dirFindLookingAround(
        ".git",
        $self->dirProject,
        ["."],
    ) and return("git");

    #Subversion
    -d dir($self->dirProject, ".svn") and return("svn");

    return("none");
}

sub newFromLocation(@) {
    my $pkg = shift;
    my ($oPerlySense) = Devel::PerlySense::Util::aNamedArg(["oPerlySense"], @_);
    my %p = @_;
    my $file = $p{file};
    my $dir = $p{dir};
    $file and $dir = dirname($file);
    $dir and $dir = dir($dir)->absolute;

    my $oProject;

    $dir and $oProject = $pkg->newFindExplicit(
        dir => $dir,
        oPerlySense => $oPerlySense,
    ) and return $oProject;


    #If file, look for the dir from where any package in the file can
    #be used
    if($file and my $oDocument = $oPerlySense->oDocumentParseFile($file)) {
        for my $package ($oDocument->aNamePackage) {
            my $filePackage = $oPerlySense->fileFromModule($package);
            my $dirFound = $oPerlySense->dirFindLookingAround($filePackage, $dir);

            if($dirFound) {
                my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin
                return $pkg->new(
                    oPerlySense => $oPerlySense,
                    dirProjectImplicitUse => $dirProject,
                );
            }
        }
    }

    #If dir, look for dirs
    if($dir) {
        my $dirFound =
                   $oPerlySense->fileFindLookingAround("lib", $dir) ||
                   $oPerlySense->fileFindLookingAround("t", $dir);

        if($dirFound) {
            my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin

            #Special case the Unix style root dir. It's never a
            #Project dir, but if often contains a lib dir and so will
            #get identified as a Project.
            #
            #If it _is_ a root dir, this can be overriden with an
            #explicit .PerlySenseProject dir.
            #
            #On Windows, the root looks like X:\, and it's not
            #entirely unlikely that a secondary drive or a SUBST drive
            #letter contains the project root.
            $dirProject eq "/" and return undef;

            return $pkg->new(
                oPerlySense => $oPerlySense,
                dirProjectImplicitDir => $dirProject,
            );
        }
    }

    return(undef);
}

sub newFindExplicit(@) {
    my $pkg = shift;
    my ($oPerlySense, $dir) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "dir"], @_);

    if(my $dirProject = $oPerlySense->dirFindLookingAround(
        ".PerlySenseProject",
        $dir,
        ["."],
    )) {
        return $pkg->new(
            oPerlySense => $oPerlySense,
            dirProjectExplicitDir => $dirProject,
            oConfig => Devel::PerlySense::Config::Project->new(dirRoot => $dirProject),
        );
    }

    return undef;
}

sub rhRunFile {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);
    my %p = @_;
    return( $self->rhRunFile0(%p, what => "run") );
}

### XXX refactor, DRY with rhRunFile
sub rhDebugFile {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);
    my %p = @_;
    return( $self->rhRunFile0(%p, what => "debug") );
}

sub rhRunFile0 {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);
    my %p = @_;
    my $rhConfigType = $p{rhConfigType};
    my $what = $p{what};

    $file = file($file)->absolute;
    $rhConfigType ||= $self->rhConfigTypeForFile(
        file      => $file,
        keyConfig => "${what}_file",
    );

    my $dirProject = dir($self->dirProject)->absolute;
    my %hTypeDirRunFrom = (
        source_root_directory => sub { $dirProject },
        file_directory        => sub { $file->dir },
    );
    my $typeRunFrom = $rhConfigType->{"${what}_from"};
    my $rsDirRunFrom = $hTypeDirRunFrom{$typeRunFrom} or die("Invalid ${what}_from value ($typeRunFrom)\n" . Dumper($rhConfigType) . "Allowed values: (" . join(", ", (sort keys %hTypeDirRunFrom)) . ")\n");
    my $dirRunFrom = $rsDirRunFrom->();

    my @aDirIncProject = $self->aDirIncProject(dirRelativeTo => $dirRunFrom);
    my $optionInc = join(" ", map { qq|"-I$_"| } @aDirIncProject);

    my $fileSource = $file->relative($dirRunFrom);
    my $commandRun = textRenderTemplate(
        $rhConfigType->{command}, {
            INC         => $optionInc,
            SOURCE_FILE => $fileSource . "",
        },
    );

    my $rhConfigRun = {
        "dir_${what}_from" => $dirRunFrom . "",
        "command_${what}"  => $commandRun,
        type_source_file   => $rhConfigType->{moniker},
    };
    return($rhConfigRun);
}

sub rhConfigTypeForFile {
    my ($file, $keyConfig) = Devel::PerlySense::Util::aNamedArg(["file", "keyConfig"], @_);

    my $rhConfig = $self->oPerlySense->rhConfig;
    for my $rhConfigType (@{ $rhConfig->{ $keyConfig } }) {
        my $rex = $rhConfigType->{rex}
                or die("Missing rex key in config chunk: " . Dumper($rhConfigType));

        eval { $file =~ /$rex/ } and return $rhConfigType;
        $@ and die("Invalid rex value in config chunk.\nError: $@\n" . Dumper($rhConfigType));
    }

    die("No run_perl rex matched the file ($file). Please check your config\n");
}

sub aDirIncProject {
    my ($dirRelativeTo) = Devel::PerlySense::Util::aNamedArg(["dirRelativeTo"], @_);

    my $dirProject = dir($self->dirProject)->absolute;
    my $dirProjectRelativeTo = $dirProject->relative( $dirRelativeTo );

    ###TODO: extract method for the inc_dir config entry aIncDirConfig
    my @aDirIncProject = @{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] };
    my @aDirInc = (@aDirIncProject, ".", "lib");

    my @aDirIncRelative =
            map { dir($dirProjectRelativeTo, $_) . "" }
            @aDirInc;

    return(@aDirIncRelative);
}

sub isFileInProject {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);

    my @aDirInc =
            map { dir($self->dirProject, $_) }
            @{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] };
    my @aDirSourceAbsolute =
            map { dir($_)->absolute }
            ($self->dirProject, @aDirInc);

    ###TODO: Comment out  debug statements when that failing test in t/PerlySense-Project-file-in-project.t is fixed
    debug("\nTESTING WHETHER FILE\n($file) IS IN PROJECT\n(" . $self->dirProject . "),\ni.e.\n(" . join(")\n(", @aDirSourceAbsolute) . ")\n");
    my @aDirProjectRegex = map { qr/^ \Q$_\E /x } @aDirSourceAbsolute;

    my $dirFileAbsolute = dir( filePathNormalize( file($file)->absolute->dir ) );
    debug("DIR ABSOLUTE ($dirFileAbsolute)\n");

    for my $dirProject (map { dir(filePathNormalize($_)) } @aDirSourceAbsolute) {
        debug("Checking whether\n($dirFileAbsolute) is within\n($dirProject)\n");
        $dirProject->subsumes($dirFileAbsolute) and debug("Found it"), return 1;
    }

    debug("FILE ($file) is NOT in the Project (" . $self->dirProject . ")\n");
    return 0;
}

sub flymakeFile {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);

    if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{syntax}) {
        my $rhConfigRun = $self->rhRunFile(
            file => $file,
            rhConfigType =>  {
                command => q{perl -c ${INC} "${SOURCE_FILE}" 2>&1 | perl -ne " /Subroutine [\\w:]+ redefined at/ or print"},
                moniker => "Flymake",
                rex => "",
                run_from => "file_directory",
            },
        );

        local $CWD = $rhConfigRun->{dir_run_from};
        system( $rhConfigRun->{command_run} );
    }

    if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{critic}) {
        ###TODO: don't run if syntax errors found

        my $fileConfigCritic = file(
            dir($self->dirProject)->absolute, ".PerlySenseProject", ".perlcritic",
        );

        my @aOption = (-profile => $fileConfigCritic . "");
        -e $fileConfigCritic or @aOption = ();

        my $oCritic = Perl::Critic->new(@aOption);

        my @aViolation = $oCritic->critique($file);

        Perl::Critic::Violation::set_format( "%m near '%r' (%e, %p) at %f line %l.\n" );
        for my $violation (@aViolation) {
            print STDERR "Warning: $violation";
        }
    }

    return 1;
}

sub rhSubCovered {
    my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_);

    local $CWD = $self->dirProject;

    eval {
        require Devel::CoverX::Covered;
        require Devel::CoverX::Covered::Db;
    };
    $@ and die("Devel::CoverX::Covered isn't installed\n");

    ###TODO: use dir specified in config and/or on command line
    local $CWD = $self->dirProject . "";

    ###TODO: Change Devel::CoverX::Covered to expose this dir properly
    ###and get it from there.
    my $dirDb = "covered";
    -d $dirDb or return( {} );

    my $db = Devel::CoverX::Covered::Db->new();
    my $fileRelative = file($file)->relative( $self->dirProject );
    my %hSubQuality;
    for my $raSubQuality ( $db->covered_subs($fileRelative) ) {
        my ($sub, $quality) = @$raSubQuality;
        $hSubQuality{$sub} += $quality;
    }

    return(\%hSubQuality);
}

sub raFileTestOther {
    my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file", "sub"], @_);

    eval {
        require Devel::CoverX::Covered;
        require Devel::CoverX::Covered::Db;
    };
    $@ and die("Devel::CoverX::Covered isn't installed\n");

    ###TODO: verify there is a cover_db database present

    local $CWD = $self->dirProject . "";

    my $db = Devel::CoverX::Covered::Db->new();

    my $method = ($file =~ /\.pm$/)
            ? "test_files_covering"
            : "source_files_covered_by";
    my $fileRelative = file($file)->relative( $self->dirProject );
    my $raFileTestOther = [ $db->$method($fileRelative, $sub) ];

    return($raFileTestOther);
}

sub raFileProjectOther {
    my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file"], @_);

    eval {
        require File::Corresponding;
        require File::Corresponding::Config::Find;
    };
    $@ and die("File::Corresponding isn't installed\n");


    # Work from the project dir, so the rest of the paths will just work out
    local $CWD = $self->dirProject . "";

    my $fileConfig = File::Corresponding::Config::Find->new(
        preferred_dirs => [ dir(".PerlySenseProject"), dir(".") ],
    )->user_config(".corresponding_file")
            or die("Could not find a '.corresponding_file' config file in either 1) the .PerlySenseProject;  b) the current directory;  c) your home directory. See perldoc File::Corresponding for information on how to create one.\n");

    my $corresponding = File::Corresponding->new();
    eval { $corresponding->load_config_file($fileConfig) }
            or die("Could not read config file ($fileConfig): $@\n");

    my $fileRelative = file($file)->relative( $self->dirProject );
    my @aFileProjectOther = uniq(
        map { $_->file }
        @{$corresponding->corresponding( $fileRelative )}
    );

    return(\@aFileProjectOther);
}






1;





__END__