view release on metacpan or  search on metacpan

lib/App/Critique/Session.pm  view on Meta::CPAN

}

sub store {
    my ($self) = @_;

    my $file = $self->{_path};
    my $data = $self->pack;

    eval {
        # JSON might die here ...
        my $json = $App::Critique::JSON->encode( $data );

        # if the file does not exist
        # then we should try and make
        # the path, just in case ...
        $file->parent->mkpath unless -e $file;

        # now try and write out the JSON
        my $fh = $file->openw;
        $fh->print( $json );
        $fh->close;

        1;
    } or do {
        Carp::confess('Unable to store critique session file because: ' . $@);
    };
}

# ...

sub _generate_critique_dir_path {
    my ($class, $git_work_tree, $git_branch) = @_;

    my $root = Path::Tiny::path( $App::Critique::CONFIG{'HOME'} );
    my $git  = Path::Tiny::path( $git_work_tree );

    # ~/.critique/<git-repo-name>/<git-branch-name>/session.json

    $root->child( $App::Critique::CONFIG{'DATA_DIR'} )
         ->child( $git->basename )
         ->child( $git_branch );
}

sub _generate_critique_file_path {
    my ($class, $git_work_tree, $git_branch) = @_;
    $class->_generate_critique_dir_path(
        $git_work_tree,
        $git_branch
    )->child(
        $App::Critique::CONFIG{'DATA_FILE'}
    );
}

## ...

sub _initialize_git_repo {
    my ($class, %args) = @_;

    my $git = Git::Wrapper->new( $args{git_work_tree} );

    # auto-discover/validate the current git branch
    my ($git_branch) = map /^\*\s(.*)$/, grep /^\*/, $git->branch;

    Carp::confess('Unable to determine git branch, looks like your repository is bare')
        unless $git_branch;

    # make sure the branch we are on is the
    # same one we are being asked to load,
    # this error condition is very unlikely
    # to occur since the session file path
    # is based on branch, which is dynamically
    # determined on load. The only way this
    # could happen is if you manually loaded
    # the session file for one branch while
    # intentionally on another branch. So while
    # this is unlikely, it is probably something
    # we should die about none the less since
    # it might be a real pain to debug.
    Carp::confess('Attempting to inflate session for branch ('.$args{git_branch}.') but branch ('.$git_branch.') is currently active')
        if exists $args{git_branch} && $args{git_branch} ne $git_branch;

    # auto-discover/validate the git HEAD sha
    my $git_head_sha = $args{git_head_sha};

    # if we have it already, ...
    if ( $git_head_sha ) {
        # test to make sure the SHA is an ancestor

        my ($possible_branch) = map  /^\*\s(.*)$/, grep /^\*/, $git->branch({
            contains => $git_head_sha
        });

        Carp::confess('The git HEAD sha ('.$git_head_sha.') is not contained within this git branch('.$git_branch.'), something has gone wrong')
            if defined $possible_branch && $possible_branch ne $git_branch;
    }
    else {
        # auto-discover the git SHA
        ($git_head_sha) = $git->rev_parse('HEAD');

        Carp::confess('Unable to determine the SHA of the HEAD, either your repository has no commits or perhaps is bare, either way, we can not work with it')
            unless $git_head_sha;
    }

    # if all is well, return ...
    return ($git, $git_branch, $git_head_sha);
}

sub _initialize_git_work_tree {
    my ($class, $git, %args) = @_;

    my $git_work_tree      = Path::Tiny::path( $args{git_work_tree} );
    my $git_work_tree_root = $git_work_tree; # assume this is correct for now ...

    # then get the absolute root of the git work tree
    # instead of just using what was passsed into us
    my ($git_work_tree_updir) = $git->RUN('rev-parse', '--show-cdup');
    if ( $git_work_tree_updir ) {
        my $num_updirs = scalar grep $_, map { chomp; $_; } split /\// => $git_work_tree_updir;
        while ( $num_updirs ) {
            $git_work_tree_root = $git_work_tree_root->parent;
            $num_updirs--;
        }
    }

    return ($git_work_tree, $git_work_tree_root);
}

sub _initialize_perl_critic {
    my ($class, %args) = @_;

    my $critic;
    if ( $args{perl_critic_policy} ) {
        $critic = Perl::Critic->new( '-single-policy' => $args{perl_critic_policy} );
    }
    else {
        $critic = Perl::Critic->new(
            ($args{perl_critic_profile} ? ('-profile' => $args{perl_critic_profile}) : ()),
            ($args{perl_critic_theme}   ? ('-theme'   => $args{perl_critic_theme})   : ()),
        );

        # inflate this as needed
        $args{perl_critic_profile} = Path::Tiny::path( $args{perl_critic_profile} )