Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

How to rename the files its directory structure using perl?

by finddata (Sexton)
on Mar 15, 2017 at 05:02 UTC ( #1184638=perlquestion: print w/replies, xml ) Need Help??

finddata has asked for the wisdom of the Perl Monks concerning the following question:

i want to rename the html files how can i do with perl? chdir $output_dir; mkdir 'html',0755; `find . -name '*.html' | cpio -pdm html` my directory structure:
html `-- DCMS_DEMO |-- DCMS_DEMO.html |-- de_top | |-- Block_DV | | |-- Block_DV.html | | |-- rev1 | | | `-- rev1.html | | `-- rev2 | | `-- rev2.html | |-- CAD_checklist | | |-- CAD_checklist.html | | |-- rev1 | | | `-- rev1.html | | |-- rev2 | | | `-- rev2.html | | |-- rev3 | | | `-- rev3.html | | `-- rev4 | | `-- rev4.html | `-- de_top.html `-- new_block2 |-- ICC_L2_Checklist | |-- ICC_L2_Checklist.html | `-- rev1 | `-- rev1.html |-- checklist_tmp | |-- checklist_tmp.html | |-- rev1 | | `-- rev1.html | `-- rev2 | `-- rev2.html `-- new_block2.html
Expected one after renaming
html `-- DCMS_DEMO |-- DCMS_DEMO.html |-- de_top | |-- Block_DV | | |-- Block_DV.html | | |-- rev1 | | | `--Block_DV_rev1.html | | `-- rev2 | | `-- Block_DV_rev2.html | |-- CAD_checklist | | |-- CAD_checklist.html | | |-- rev1 | | | `--CAD_checklist_rev1.html | | |-- rev2 | | | `-- CAD_checklist_rev2.html | | |-- rev3 | | | `--CAD_checklist_rev3.html | | `-- rev4 | | `--CAD_checklist_rev4.html | `-- de_top.html `-- new_block2 |-- ICC_L2_Checklist | |-- ICC_L2_Checklist.html | `-- rev1 | `--ICC_L2_checklist_rev1.html |-- checklist_tmp | |-- checklist_tmp.html | |-- rev1 | | `--checklist_tmp_rev1.html | `-- rev2 | `--checklist_tmprev2.html `-- new_block2.html
code which i tried:
sub runDir($$); sub runDir($$) { my $prefix = shift @_; # print $prefix,"\n"; my $dir = shift @_; #print "******$dir***","\n"; opendir(DIR, $dir) or die $!; my @entries = readdir(DIR); # print @entries,"\n"; close(DIR); foreach my $file (@entries) { next if ($file =~ /^\.+$/); if ( -d $dir . '/' . $file) { runDir($prefix . $file . '_', $dir . '/' . $file); } elsif ( ( -f $dir . '/' . $file ) && ( $file =~ /\.config$/ +) && ($file !~ /^$prefix/)) { my $suffix = $file; $suffix =~ s/^(\S+)-.+\.config$/$1.config/; rename $dir . '/' . $file, $dir . '/' . $prefix . $suffix +; } } } runDir('',$output_dir);
Error: The thing it affects all html files in all other directories. Example:
|-- DCMS_DEMO | |-- DCMS_DEMO_DCMS_DEMO.config | |-- DCMS_DEMO_DCMS_DEMO.html | |-- de_top | | |-- Block_DV | | | |-- DCMS_DEMO_de_top_Block_DV_Block_DV.config | | | |-- DCMS_DEMO_de_top_Block_DV_Block_DV.html | | | |-- rev1 | | | | |-- DCMS_DEMO_de_top_Block_DV_rev1_rev1.config | | | | `-- DCMS_DEMO_de_top_Block_DV_rev1_rev1.html | | | `-- rev2 | | | |-- DCMS_DEMO_de_top_Block_DV_rev2_rev2.config | | | `-- DCMS_DEMO_de_top_Block_DV_rev2_rev2.html | | |-- CAD_checklist | | | |-- DCMS_DEMO_de_top_CAD_checklist_CAD_checklist.config | | | |-- DCMS_DEMO_de_top_CAD_checklist_CAD_checklist.html | | | |-- rev1 | | | | |-- DCMS_DEMO_de_top_CAD_checklist_rev1_rev1.config | | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev1_rev1.html | | | |-- rev2 | | | | |-- DCMS_DEMO_de_top_CAD_checklist_rev2_rev2.config | | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev2_rev2.html | | | |-- rev3 | | | | |-- DCMS_DEMO_de_top_CAD_checklist_rev3_rev3.config | | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev3_rev3.html | | | `-- rev4 | | | |-- DCMS_DEMO_de_top_CAD_checklist_rev4_rev4.config | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev4_rev4.html | | |-- DCMS_DEMO_de_top_de_top.config | | |-- DCMS_DEMO_de_top_de_top.html | | `-- ICC_DPMHV_Checklist | `-- new_block2 | |-- CAD_checklist | |-- DCMS_DEMO_new_block2_new_block2.config | |-- DCMS_DEMO_new_block2_new_block2.html | |-- ICC_L2_Checklist | | |-- DCMS_DEMO_new_block2_ICC_L2_Checklist_ICC_L2_Checklist +.config | | |-- DCMS_DEMO_new_block2_ICC_L2_Checklist_ICC_L2_Checklist +.html | | `-- rev1 | | |-- DCMS_DEMO_new_block2_ICC_L2_Checklist_rev1_rev1.co +nfig | | `-- DCMS_DEMO_new_block2_ICC_L2_Checklist_rev1_rev1.ht +ml | `-- checklist_tmp | |-- DCMS_DEMO_new_block2_checklist_tmp_checklist_tmp.confi +g | |-- DCMS_DEMO_new_block2_checklist_tmp_checklist_tmp.html | |-- rev1 | | |-- DCMS_DEMO_new_block2_checklist_tmp_rev1_rev1.confi +g | | `-- DCMS_DEMO_new_block2_checklist_tmp_rev1_rev1.html | `-- rev2 | |-- DCMS_DEMO_new_block2_checklist_tmp_rev2_rev2.confi +g | `-- DCMS_DEMO_new_block2_checklist_tmp_rev2_rev2.html `-- html `-- DCMS_DEMO |-- DCMS_DEMO_DCMS_DEMO.html |-- de_top | |-- Block_DV | | |-- DCMS_DEMO_de_top_Block_DV_Block_DV.html | | |-- rev1 | | | `-- DCMS_DEMO_de_top_Block_DV_rev1_rev1.html | | `-- rev2 | | `-- DCMS_DEMO_de_top_Block_DV_rev2_rev2.html | |-- CAD_checklist | | |-- DCMS_DEMO_de_top_CAD_checklist_CAD_checklist.html | | |-- rev1 | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev1_rev1.html | | |-- rev2 | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev2_rev2.html | | |-- rev3 | | | `-- DCMS_DEMO_de_top_CAD_checklist_rev3_rev3.html | | `-- rev4 | | `-- DCMS_DEMO_de_top_CAD_checklist_rev4_rev4.html | `-- DCMS_DEMO_de_top_de_top.html `-- new_block2 |-- DCMS_DEMO_new_block2_new_block2.html |-- ICC_L2_Checklist | |-- DCMS_DEMO_new_block2_ICC_L2_Checklist_ICC_L2_Check +list.html | `-- rev1 | `-- DCMS_DEMO_new_block2_ICC_L2_Checklist_rev1_rev +1.html `-- checklist_tmp |-- DCMS_DEMO_new_block2_checklist_tmp_checklist_tmp.h +tml |-- rev1 | `-- DCMS_DEMO_new_block2_checklist_tmp_rev1_rev1.h +tml `-- rev2 `-- DCMS_DEMO_new_block2_checklist_tmp_rev2_rev2.h +tml

Replies are listed 'Best First'.
Re: How to rename the file swiht its directory structure using perl?
by stevieb (Canon) on Mar 15, 2017 at 05:14 UTC
Re: How to rename the files its directory structure using perl?
by huck (Parson) on Mar 15, 2017 at 05:49 UTC

    Run this

    sub runDir($$) { my $prefix = shift @_; print '*'.$prefix,"\n"; my $dir = shift @_; print "**$dir*","\n"; opendir(DIR, $dir) or die $!; my @entries = readdir(DIR); # print @entries,"\n"; close(DIR); foreach my $file (@entries) { next if ($file =~ /^\.+$/); if ( -d $dir . '/' . $file) { print "***down runDir($prefix . $file . '_', $dir . '/' . +$file)\n"; runDir($prefix . $file . '_', $dir . '/' . $file); print "***up runDir($prefix . $file . '_', $dir . '/' . +$file)\n"; } elsif ( ( -f $dir . '/' . $file ) && ( $file =~ /\.config$/ +) && ($file !~ /^$prefix/)) { my $suffix = $file; $suffix =~ s/^(\S+)-.+\.config$/$1.config/; print "****rename $dir . '/' . $file, $dir . '/' . $prefix + . $suffix"."\n"; # rename $dir . '/' . $file, $dir . '/' . $prefix . $suffi +x ; } } }
    and i bet it will become clear

      following error: main::runDir() called too early to check prototype at ./generate.pl line 296.

        kill the prototypes!!!!!!!!!!! change this

        sub runDir($$); sub runDir($$) {
        to this
        sub runDir {
        you dont know what they are doing anyway

        ok changed my mind too run this

        sub runDir { my $prefix = shift @_; print '*'.$prefix,"\n"; my $dir = shift @_; print "**$dir*","\n"; opendir(DIR, $dir) or die $!; my @entries = readdir(DIR); # print @entries,"\n"; close(DIR); foreach my $file (@entries) { next if ($file =~ /^\.+$/); if ( -d $dir . '/' . $file) { print '***down runDir -- '.$prefix . $file . '_'.','. $dir + . '/' . $file."\n"; runDir($prefix . $file . '_', $dir . '/' . $file); print '***up runDir -- '.$prefix . $file . '_'.','. $dir +. '/' . $file."\n"; } elsif ( ( -f $dir . '/' . $file ) && ( $file =~ /\.config$/ +) && ($file !~ /^$prefix/)) { my $suffix = $file; $suffix =~ s/^(\S+)-.+\.config$/$1.config/; print '****rename '.$dir . '/' . $file.','. $dir . '/' . $ +prefix . $suffix ."\n"; # rename $dir . '/' . $file, $dir . '/' . $prefix . $suffi +x ; } } }
        dayum i hate double quotes a lot.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1184638]
Approved by Happy-the-monk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (8)
As of 2020-01-21 17:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?