########################################### package Module::Rename; ########################################### use strict; use warnings; use File::Find; use Sysadm::Install qw(:all); use Log::Log4perl qw(:easy); use File::Basename; our $VERSION = "0.03"; ########################################### sub new { ########################################### my($class, %options) = @_; my $self = { name_old => undef, name_new => undef, dir_exclude => ['blib'], dir_ignore => ['CVS'], wipe_empty_subdirs => 0, %options, }; $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 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; mv $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/; mv $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; my @dirs = (); # Delete all empty dirs finddepth(sub { if(-d and $self->dir_empty($_) and ! exists $empty_subdirs{$File::Find::name}) { WARN "$File::Find::name is empty and can go away"; rmf $_ if $self->{wipe_empty_subdirs}; $File::Find::prune = 1; } }, $start_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__ =head1 NAME Module::Rename - Utility functions for renaming a module distribution =head1 SYNOPSIS ######## # Shell: ######## $ module-rename Old::Name New::Name Old-Name-Distro ####### # Perl: ####### use Module::Rename; my $ren = Module::Rename->new( name_old => "Old::Name", name_new => "New::Name", ); $ren->find_and_rename($start_dir); =head1 DESCRIPTION Have you ever created a module distribution, only to realize later that the module hierarchary needed to be changed? All of a sudden, C didn't sound cool anymore, but needed to be C instead? Going through a module's distribution, changing all package names, variable names, and move the directories around can be a tedious task. C comes with a script C which takes care of all this: $ ls Cool-Frobnicator-0.01/ $ module-rename Cool::Frobnicator Util::Frobnicator Cool-Frobnicator-0.01 Cool-Frobnicator-0.01/lib/Cool is empty and can go away. Done. The directory hierarchy has changed: $ ls -R Util-Frobnicator-0.01/ ... Util-Frobnicator-0.01/lib/Util/Frobnicator.pm ... and so has the content of all files: $ grep "package" Util-Frobnicator-0.01/lib/Util/Frobnicator.pm package Util::Frobnicator; =head2 Things to Keep in Mind =over 4 =item * C will rename files and replace their content, so make sure that you have a backup copy in case something goes horribly wrong. =item * After changing the module hierarchy, some directories might be empty, like the C directory above. In this case, a warning will be issued: Cool-Frobnicator-0.01/lib/Cool is empty and can go away. and the 'empty' directory gets deleted (even if a CVS subdirectory is in there). =back =head1 API =over 4 =item Cnew(...)> The renamer's constructor takes the following parameters: =over 4 =item C Old module name. =item C New module name. =item C Reference to an array with directories to exclude from traversing. Preset to dir_exclude => ['blib'] but can be overridden. =item C Reference to an array with entries to be ignored in 'empty' directories. Even with these entries being present, a directory will be considered empty and swept away. Preset to dir_ignore => ['CVS'], but can be overridden. =item C If set to a true value, 'empty' (see above) subdirectories will be deleted after all renaming and restructuring is done. Defaults to true. =back =item C<$renamer-Efind_and_rename($start_dir)> Start searching and replacing in C<$start_dir> and recurse into it. =back =head1 LEGALESE Copyright 2005 by Mike Schilli, all rights reserved. This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR 2005, Mike Schilli