http://www.perlmonks.org?node_id=1231784

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

Hi

I have a text file containing different file names ex :

/fd/gfree/tere/frf4545/geerg/fds/0.1/fsdf/dsakdsa/

/fd/gfree/tere/frf4545/geerg/dfds/5.9/fdsf/fdsfd/

/fd/gfree/tere/frf4545/geerg/dsad/02.44/fdsf/fdsf/

...

...

I want to remove the patterns appearing after the decimal numbers. So my output text file should have

/fd/gfree/tere//frf4545/geerg//fds/0.1

/fd/gfree/tere//frf4545/geerg//dfds/5.9

/fd/gfree/tere//frf4545/geerg//fds/02.44

...

...

I have tried the following code, but doesnt seem to work. Can anyone help me with shortest code to do this inside a perl subroutine? Pardon my beginner level question at perl coding.

if($line=~ /^\/fd\/gfree\/tere\/frf4545\/geerg\/(.*)\/(.*)\/fsdf\/(.*) +\//){ + + $line=~ s/\/fsdf\(.*)\///g; + }

regards

Replies are listed 'Best First'.
Re: Pattern replace in a file name (updated)
by haukex (Archbishop) on Mar 28, 2019 at 09:58 UTC

    There's More Than One Way To Do It... this one is cross-platform:

    use warnings; use strict; use File::Spec::Functions qw/splitdir catdir/; while (my $line = <DATA>) { chomp $line; my $out = do { local $.=0; catdir grep {$.++;1../^\d+\.\d+$/} splitdir($line) }; print $out, "\n"; } __DATA__ /fd/gfree/tere/frf4545/geerg/fds/0.1/fsdf/dsakdsa/ /fd/gfree/tere/frf4545/geerg/dfds/5.9/fdsf/fdsfd/ /fd/gfree/tere/frf4545/geerg/dsad/02.44/fdsf/fdsf/

    Output:

    /fd/gfree/tere/frf4545/geerg/fds/0.1 /fd/gfree/tere/frf4545/geerg/dfds/5.9 /fd/gfree/tere/frf4545/geerg/dsad/02.44

    Updates 1 and 2: Updated the code above to better limit the scope of the local $., and the map {...?$_:()} is better written as a grep.

Re: Pattern replace in a file name
by hdb (Monsignor) on Mar 28, 2019 at 09:22 UTC

    A pattern like [.0-9]+ will detect a sequence of digits and dots, also including something like 0.000.0, probably undesirably so. For your examples it would work, full code could be like this:

    use strict; use warnings; my @f = qw( /fd/gfree/tere/frf4545/geerg/fds/0.1/fsdf/dsakdsa/ /fd/gfree/tere/frf4545/geerg/dfds/5.9/fdsf/fdsfd/ /fd/gfree/tere/frf4545/geerg/dsad/02.44/fdsf/fdsf/ ); s|(/[.0-9]+)/.*|$1| for @f; print "$_\n" for @f;

      the problem with your suggestion is it truncates the file path after the first instance of a digit, so my output looks like

      /fd/gfree/tere/frf4

      /fd/gfree/tere/frf4

      /fd/gfree/tere/frf4

      Whereas I wanted the output to be

      /fd/gfree/tere/frf4545/geerg/fds/0.1

      /fd/gfree/tere/frf4545/geerg/dfds/5.9

      /fd/gfree/tere/frf4545/geerg/dsad/02.44

        Now that your expected output looks more logical, a simple test can illustrate one possible solution.

        use strict; use warnings; use Test::More; my @data = ( { have => '/fd/gfree/tere/frf4545/geerg/fds/0.1/fsdf/dsakdsa/', want => '/fd/gfree/tere/frf4545/geerg/fds/0.1', }, { have => '/fd/gfree/tere/frf4545/geerg/dfds/5.9/fdsf/fdsfd/', want => '/fd/gfree/tere/frf4545/geerg/dfds/5.9', }, { have => '/fd/gfree/tere/frf4545/geerg/dsad/02.44/fdsf/fdsf/', want => '/fd/gfree/tere/frf4545/geerg/dsad/02.44', }, ); plan tests => scalar @data; for my $t (@data) { $t->{have} =~ s/(\.\d+).*?$/$1/; is $t->{have}, $t->{want}; }

        If you look at the code I posted you see that I have a couple of / in it in addition to the regex I mention in the text. So the code really looks for a sequence of digits and dots between two slashes. It is true it would truncate the path after the first occurrence of such a pattern.

Re: Pattern replace in a file name
by thanos1983 (Parson) on Mar 28, 2019 at 09:35 UTC

    Hello kaushik9918,

    I am sure that fellow Monks will come up with a better solution but here is one possible way :).

    Update:

    Including loop for demonstration purposes:

    One minor question here kaushik9918. I see on your sample of output that you provide us you are having two forward slashes // is this an accident while you where typing it or it is intended to be like this?

    Looking forward to your reply.

    Hope this helps, BR.

    Seeking for Perl wisdom...on the process of learning...not there...yet!

      thanks for your time , @hippo has already given me the solution. Regards

        Sure, but thanos1983 gave the solution above before hippo's answer giving you another solution. And maybe it is worth to consider thanos1983's different approach: one can often learn from different approaches or solutions, even though you're satisfied that your problem is solved with hippo's help.