File Coverage

blib/lib/Module/Rename.pm

Criterion	Covered	Total	%
statement	131	132	99.2
branch	32	36	88.8
condition	18	18	100.0
subroutine	18	18	100.0
pod	2	7	28.5
total	201	211	95.2

###########################################
package Module::Rename;
###########################################

use strict;
use warnings;
use File::Find;
use File::Basename;
use File::Spec qw( splitdir );
use Sysadm::Install qw(:all);
use Log::Log4perl qw(:easy);
use File::Spec::Functions qw( abs2rel splitdir );

our $VERSION = "0.04";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        name_old           => undef,
        name_new           => undef,
        dir_exclude        => ['blib'],
        dir_ignore         => ['CVS'],
        wipe_empty_subdirs => 0,
        use_git            => 0,
        %options,
    };

    if( $self->{use_git} ) {
        $self->{ git_bin } = bin_find( "git" );
        if( !defined $self->{ git_bin } ) {
            die "No git executable found";
        }
        push @{ $self->{dir_exclude} }, ".git";
    }

    $self->{dir_exclude_hash} = { map { $_ => 1 } @{$self->{dir_exclude}} };
    $self->{dir_ignore_hash}  = { map { $_ => 1 } @{$self->{dir_ignore}} };

    ($self->{look_for}   = $self->{name_old}) =~ s#::#/#g;
    ($self->{replace_by} = $self->{name_new}) =~ s#::#/#g;

    ($self->{pmfile}  = $self->{name_old}) =~ s#.*::##g;
     $self->{pmfile} .= ".pm";

    ($self->{new_pmfile}  = $self->{name_new}) =~ s#.*::##g;
     $self->{new_pmfile} .= ".pm";

    bless $self, $class;
}

###########################################
sub longest_common_path {
###########################################
    my( $self, $file1, $file2 ) = @_;

    my @common = ();

    my @dirs1 = splitdir( dirname $file1 );
    my @dirs2 = splitdir( dirname $file2 );

    for my $dir1_part ( @dirs1 ) {
        my $dir2_part = shift @dirs2;
        if( $dir1_part eq $dir2_part ) {
            push @common, $dir1_part;
        } else {
            last;
        }
    }

    return File::Spec->catfile( @common );
}

###########################################
sub move {
###########################################
    my($self, $old_path, $new_path) = @_;

    if( $old_path ne $new_path ) {
        if ($self->{use_git} and !-d $old_path) {
              # make sure we launch the git command inside the git workspace
            my $common = $self->longest_common_path( $old_path, $new_path );
            cd $common;
            tap("git", "mv",
               abs2rel( $old_path, $common ),
               abs2rel( $new_path, $common ),
            );
            cdback;
        } else {
            mv $old_path, $new_path;
        }
    }
}

###########################################
sub find_and_rename {
###########################################
    my($self, $start_dir) = @_;

    my @files = ();
    my %empty_subdirs = ();

    find(sub {
        if(-d and $self->dir_empty($_)) {
            INFO "$File::Find::name is an empty subdir";
            $empty_subdirs{$File::Find::name}++;
        }
        if(-d and exists $self->{dir_exclude_hash}->{$_}) {
            $File::Find::prune = 1;
            return;
        }
        return unless -f $_;
        push @files, $File::Find::name if
                $File::Find::name =~ /$self->{look_for}/ or
                $_ eq $self->{pmfile};
        $self->file_process($_, $File::Find::name);
    }, $start_dir);

    for my $file (@files) {

        my $newfile = $file;

        if($file =~ /$self->{look_for}/) {
            $newfile =~ s/$self->{look_for}/$self->{replace_by}/;
        } else {
                # We found a module file outside the regular
                # dir structure, just replace it within this directory
            $newfile =~ s/$self->{pmfile}/$self->{new_pmfile}/;
        }

        INFO "mv $file $newfile";
        my $dir = dirname($newfile);
        mkd $dir unless -d $dir;
        $self->move($file, $newfile);
    }

    (my $dashed_look_for   = $self->{name_old}) =~ s#::#-#g;
    (my $dashed_replace_by = $self->{name_new}) =~ s#::#-#g;

        # Rename any top directory files like Foo-Bar-0.01
    my @rename_candidates = ($start_dir);
    find(sub {
        if(/$dashed_look_for/) {
            push @rename_candidates, $File::Find::name;
        }
    }, $start_dir);
    for my $item (@rename_candidates) {
        (my $newitem = $item) =~ s/$dashed_look_for/$dashed_replace_by/;
        $self->move($item, $newitem);
    }

        # Even the start_dir could have to be modified.
    $start_dir =~ s/$dashed_look_for/$dashed_replace_by/;

        # Update empty_subdirs with the latest name changes
    %empty_subdirs = map { s/$dashed_look_for/$dashed_replace_by/; $_; }
        %empty_subdirs;

    if( $self->{wipe_empty_subdirs} ) {
        my @dirs = ();
            # Delete all empty dirs
        find(sub {
            if( exists $self->{dir_exclude_hash}->{$_} ) {
                $File::Find::prune = 1;
            }

            if(-d and $self->dir_empty($_) and
               ! exists $empty_subdirs{$File::Find::name}
            ) {
                WARN "$File::Find::name is empty and can go away";
                push @dirs, $File::Find::name;
            }
        }, $start_dir);
        for my $dir ( @dirs ) {
            rmf $dir;
        }
    }
}

###########################################
sub dir_empty {
###########################################
    my($self, $dir) = @_;

    opendir DIR, $dir or LOGDIE "Cannot open dir $dir";
    my @items = grep { $_ ne "." and $_ ne ".." } readdir DIR;
    closedir DIR;

    @items = grep { ! exists $self->{dir_ignore_hash}->{$_} } @items;

    return ! scalar @items;
}

###########################################
sub file_process {
###########################################
    my($self, $file, $path) = @_;

    my $out = "";

    open FILE, "<$file" or LOGDIE "Can't open $file ($!)";
    while() {
        DEBUG "Looking for /$self->{name_old}/";
        s/($self->{name_old})\b/$self->rep($1,$self->{name_new})/ge;
        DEBUG "Looking for /$self->{look_for}/";
        s/($self->{look_for})\b/$self->rep($1,$self->{replace_by})/ge;
        $out .= $_;
    }
    close FILE;

    blurt $out, $file;
}

###########################################
sub rep {
###########################################
    my($self, $found, $replace) = @_;

    INFO "$File::Find::name ($.): $found => $replace";
    return $replace;
}

1;

__END__