Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

How to rewrite the contents of the file using perl?

by finddata (Sexton)
on Mar 20, 2017 at 08:22 UTC ( #1185228=perlquestion: print w/replies, xml ) Need Help??

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

i had already posted my code but couldnt get proper answer from anyone.So am posting it again which i created. Help to rename the contents of the file by mapping with txt file.
#! /usr/bin/env perl use strict; use warnings; use Data::Dumper; use File::Path qw( make_path ); use File::Copy qw( copy move); use File::Find::Rule qw( ); use Cwd qw(getcwd); use File::Basename; use File::Copy (); use File::Remove (); use File::Basename; use File::Find; use File::Spec; use Getopt::Long qw( GetOptions ); use Cwd; ##TO CHECK THE USAGE AT COMMAND LINE ARGUMENTS## sub usage { if (@_) { my ($msg) = @_; chomp($msg); print(STDERR "$msg\n"); } my $prog = basename($0); print(STDERR "$prog --help for usage\n"); exit(1); } sub help { my $prog = basename($0); print(STDERR "$prog [options] -output output_dir\n"); print(STDERR "$prog --help\n"); exit(0); } ##GETTING INPUT/OUTPUT FILE FROM COMMAND LINE ARGUMENTS## GetOptions( 'help|h|?' => \&help, 'prjroot=s' => \my $input_dir, 'outdir=s' => \my $output_dir, 'mapfile=s' => \my $mapfile, ) or usage(); ##CREATING THE DIRECTORIES FROM COMMAND LINE ARGUMENTS## mkdir $output_dir ; ##COPYING THE CONFIG FILES FROM SOURCE TO DESTINATION### my %created; for my $in ( File::Find::Rule ->maxdepth(5) ->file() ->prune() ->name(qr/^[^.].*\.config$/) ->in($input_dir) ) { my $match_file = substr($in, length($input_dir) + 1); my ($match_dir) = $match_file =~ m{^(.*)/} ? $1 : '.'; my $out_dir = $output_dir . '/' . $match_dir; my $out = $output_dir . '/' . $match_file; make_path($out_dir) if !$created{$out_dir}++; copy($in, $out); } ##TO RENAME DIRECTORIES AND RENAME THE CONTENTS OF THE .CONFIG FILES A +S PER MATCHING WITH MAPFILE.TXT CONTENTS## my $name_map = read_map( $mapfile ); my ($regex) = map {qr /\b(?:$_)\b/ } join '|', map {quotemeta} keys %$ +name_map; my $top_dir = $output_dir; rename_dirs( $top_dir, $name_map, $regex ); sub rename_dirs { my ( $top_dir, $name_map, $regex ) = @_; opendir (my $dh, $top_dir) or die "Can't open $top_dir: $!"; my $save_dir = getcwd(); chdir $top_dir; while (my $name = readdir $dh) { next if ($name eq '.') or ($name eq '..'); if ( ( -d $name ) && ( exists $name_map->{$name} ) ) { my $new_name = $name_map->{$name}; rename_file_or_dir( $name, $new_name ); $name = $new_name; } elsif ( -f $name ) { if_config_file_rename_and_modify_it( $name, $name_map, $re +gex ); } else { #print " --> is not a directory", "\n"; } if ( -d $name) { rename_dirs( $name, $name_map, $regex ); } } chdir $save_dir; } sub if_config_file_rename_and_modify_it { my ( $name, $name_map, $regex ) = @_; if (( my $base_name = $name) =~ s/\.config$// ) { if ( $name_map->{$base_name} ) { my $new_name = $name_map->{$base_name} . '.config'; rename_file_or_dir( $name, $new_name ); change_file( $new_name, $name_map, $regex ); } } } sub change_file { my ( $fn, $map, $regex ) = @_; print "enter\n"; open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; my $str = do { local $/; <$fh> }; close $fh; my $num_replacements = $str =~ s/($regex)/$map->{$1}/ge; if ( $num_replacements ) { write_new_file( $fn, \$str ); } } sub write_new_file { print "enter1\n"; my ( $fn, $str ) = @_; open ( my $fh, '>', $fn ) or die "Could not open file '$fn': $!"; print $fh $$str; close $fh; } sub rename_file_or_dir { my ( $name, $new_name ) = @_; File::Copy::move( $name, $new_name ) or die "Could not rename '$name' as '$new_name': $!"; #print $name; } sub read_map { my ( $fn ) = @_; my %name_map; open( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; while( my $line = <$fh> ) { chomp $line; my @fields = split /:/, $line; # print @fields; if ( @fields == 3 ) { $name_map{$fields[2]} = $fields[1]; } } close $fh; return \%name_map; }
in the above script the following part is not working fine which means it fails to rename the contents of the file.Help me to fix issue.Hope i will get better code this time.
sub if_config_file_rename_and_modify_it { my ( $name, $name_map, $regex ) = @_; if (( my $base_name = $name) =~ s/\.config$// ) { if ( $name_map->{$base_name} ) { my $new_name = $name_map->{$base_name} . '.config'; rename_file_or_dir( $name, $new_name ); change_file( $new_name, $name_map, $regex ); } } } sub change_file { my ( $fn, $map, $regex ) = @_; print "enter\n"; open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!"; my $str = do { local $/; <$fh> }; close $fh; my $num_replacements = $str =~ s/($regex)/$map->{$1}/ge; if ( $num_replacements ) { write_new_file( $fn, \$str ); } } sub write_new_file { print "enter1\n"; my ( $fn, $str ) = @_; open ( my $fh, '>', $fn ) or die "Could not open file '$fn': $!"; print $fh $$str; close $fh; } sub rename_file_or_dir { my ( $name, $new_name ) = @_; File::Copy::move( $name, $new_name ) or die "Could not rename '$name' as '$new_name': $!"; #print $name; }

Replies are listed 'Best First'.
Re: How to rename the contents in perl?
by Corion (Pope) on Mar 20, 2017 at 08:28 UTC

    You keep talking about "rename the contents of the file", but you cannot rename the contents of a file.

    Please make up your mind whether you want to:

    1. change the name of a file ("rename")
    2. change the content of a file ("rewrite")

    Also, your code contains lots of stuff that has no bearing on whatever your problem is. Please, as you have been told many times already, provide sufficient input data, what your program does and also what you think your program should do instead.

    We can only provide you help if you provide us enough context. Even if this were a code writing service, you still have to tell us exactly what the program should do.

      i had added input file

        Thank you for adding an example input file.

        Please re-read my questions again. There are many more questions that you did not yet answer. Please answer these so that we can provide you better advice.

    A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2020-01-20 08:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?