Re^2: How to remove underscore at the end of the line?

[finddata]

But it is not displaying the expected output as per you mentioned.

[davido]

Then you must be using it wrong. Show us how you used the solution posted.

I am confident that s/_$// works for the sample data you posted. Show us your code.

[madtoperl]

Hi finddata
As suggested by davido Please check below it works,


#!/usr/local/bin/perl
use strict;
use warnings;

my $str = 'DCMS_DEMO_new_block2_checklist_tmp_rev1_';
chop $str;

print "$str\n";

my $regstr = 'DCMS_DEMO_new_block2_checklist_tmp_rev1_';
$regstr =~ s/_$//;

print $regstr;


OUTPUT:
DCMS_DEMO_new_block2_checklist_tmp_rev1
DCMS_DEMO_new_block2_checklist_tmp_rev1

Also for your current input, a chop will also work (which is not recommended if your input line does not have _ always at end.It will remove the last character blindly)
As other monks suggested, please try first and post the code which is not working instead of expecting the full code by other monks here.

[finddata]

sub ir($$);
sub ir($$) {
    my $prefix = shift @_;
    $prefix=~ s/_$//;
    print $prefix,"\n";
    my $dir = shift @_;
    print "&&&$dir&&&","\n";
    opendir(DIR, $dir) or die $!;
    my @entries = readdir(DIR);
    print "****@entries***";
    close(DIR);
    foreach my $file (@entries) {
        next if ($file =~ /^\.+$/);
        if ( -d $dir . '/' . $file) {
            ir($prefix . $file .'_', $dir . '/' . $file);

        } elsif ( ( -f $dir . '/' . $file ) && ( $file =~ /\.config$/ 
+) && ($file !~ /^$prefix/)) {
            my $suffix = $file;

            $suffix=~s{\A[^.]*}{}xms;
        print "^^^$suffix^^^","\n";
                   #    print $suffix,"\n";
            rename $dir . '/' . $file, $dir . '/' . $prefix . $suffix 
+;
        }
    }
}
ir('',$output_dir);


here print prefix has underscore at the end of the line

[davido]

Thank you for posting some code. It's not a great code example because it contains code that is not part of the problem, doesn't compile, and doesn't demonstrate how it's being used with some sample data. But it's enough to test your assertion.

The portion of what you posted that is relevant to your assertion that the code snippet provided in this thread doesn't work is the first three lines of the subroutine ir().

# First three lines of your subroutine, ir() with the prototype remove
+d because it's not useful:

sub ir {
    my $prefix = shift @_;
    $prefix=~ s/_$//;
    print $prefix,"\n";
}

# A loop to test those first three lines of your code to see if they w
+ork:

while(<DATA>) {
    chomp;
    ir($_);
}

# Sample input you provided:

__DATA__
DCMS_DEMO_
DCMS_DEMO_new_block2_
DCMS_DEMO_new_block2_checklist_tmp_
DCMS_DEMO_new_block2_checklist_tmp_rev1_

....output....

DCMS_DEMO
DCMS_DEMO_new_block2
DCMS_DEMO_new_block2_checklist_tmp
DCMS_DEMO_new_block2_checklist_tmp_rev1

It works.

[huck]

It is real hard to believe that when passed the empty string as prefix it would have an underscore at the end of it ya know, your example leaves a whole lot to be desired

This $prefix=~ s/_$//;takes one underscore off the end. To take all underscores off the end you would need $prefix=~ s/_$//g; or $prefix=~ s/_+$//;. But that wasnt what you asked was it? you should have asked how to remove ALL underscores from the end.

Now why might there be more than one underscore at the end of $prefix? well dont you add one when you say ir($prefix . $file .'_', $dir . '/' . $file); and if $file already had one at the end you just made it two didnt you?

so if you dont want an underscore at the end of $prefix then just why do you add one when you call ir()? i would love to hear that explanation.....

another explanation i would like to hear is what good the $$ prototype is doing for you, can you explain why you need it?

and what is going to happen if you ever hit a file with TWO dots in it?

[Anonymous Monk]

Hi,

Sorry, that doesn't compile

$ perl finddata
syntax error at finddata line 30, near "here print"
Execution of finddata aborted due to compilation errors.

Try again please, there is an old tutorial to help you with that

[Anonymous Monk]

Instead of $prefix =~ s/_$//;, maybe try this:

my $newfile = $prefix . $suffix;
$newfile =~ s/_$//;
rename "$dir/$file", "$dir/$newfile";

[AnomalousMonk]

Just to drive davido's point home:

c:\@Work\Perl\monks>perl -wMstrict -le
"for my $s (qw(
   DCMS_DEMO_
   DCMS_DEMO_new_block2_
   DCMS_DEMO_new_block2_checklist_tmp_
   DCMS_DEMO_new_block2_checklist_tmp_rev1_
   )) {
   my $subject = $s;
   print qq{'$subject'};
   $subject =~ s/_(?=[^_]*$)//;
   print qq{'$subject' \n};
   }
"
'DCMS_DEMO_'
'DCMS_DEMO'

'DCMS_DEMO_new_block2_'
'DCMS_DEMO_new_block2'

'DCMS_DEMO_new_block2_checklist_tmp_'
'DCMS_DEMO_new_block2_checklist_tmp'

'DCMS_DEMO_new_block2_checklist_tmp_rev1_'
'DCMS_DEMO_new_block2_checklist_tmp_rev1'

That's with your original regex, and I get the same output with  s/_$// also.