Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Pattern replace in a file name

by kaushik9918 (Sexton)
on Mar 28, 2019 at 09:13 UTC ( #1231784=perlquestion: print w/replies, xml ) Need Help??

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 (Bishop) 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.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (1)
As of 2021-05-08 21:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (97 votes). Check out past polls.

    Notices?