Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
Just another Perl shrine
 
PerlMonks  

Need to capture an optional sub-directory name

by technojosh (Priest)
on Mar 29, 2012 at 15:18 UTC ( #962426=perlquestion: print w/ replies, xml ) Need Help??
technojosh has asked for the wisdom of the Perl Monks concerning the following question:

I have a sub I use to build a name of a "test case" during an automation run. This name is a string that includes the directory of the Perl .pl file, as well as the file name with the suffix (.pl) stripped off.

So a file with the path 'C:\Tools\scripts\Test\Foo.pl' would produce the string 'Test - Foo'

here is my current sub, which works for me as long as there is no directory between 'Test' and 'Foo':

sub ScriptName {
    my ($self) = @_;
    my $name = Win32::GetFullPathName($0);
    
    my $dirChop = substr(
        $name,
        index($name,'\\scripts\\')+9
    );
    
    my $dir = substr(
        $dirChop,
        0,
        index($dirChop,'\\')
    );
    
    my $clean = substr(
        $name,
        rindex($name,'\\')+1,
        rindex($name,'.')-(rindex($name,'\\')+1)
    );
    return "$dir - $clean"
}

[download]

This will totally ignore the sub-directory in the path 'C:\Tools\scripts\Test\Unstable\Foo.pl', where I would like it to return the string 'Test - Unstable - Foo'... but I am no regex pro.

I am looking for a couple pointers:
  1. Can this be cleaned up with regex?
  2. How can I capture a subdirectory (if it exists) too (without losing current functionality)?
-TJ

Comment on Need to capture an optional sub-directory name
Download Code
Re: Need to capture an optional sub-directory name
by BrowserUk (Pope) on Mar 29, 2012 at 15:28 UTC
    but I am no regex pro

    You don't need to become a "regex pro" -- whatever one of those is -- but you would sure save yourself some time in the long run, by making the effort to learn the basics:

    $p = 'C:\Tools\scripts\Test\Unstable\Foo.pl';;
$p =~ s[C:\\Tools\\scripts\\([^.]+).pl][$1]; 
$p =~ s[\\][ - ]g; 
print $p;;
Test - Unstable - Foo

$p2 = 'C:\Tools\scripts\Test\Foo.pl';;
$p2 =~ s[C:\\Tools\\scripts\\([^.]+).pl][$1]; 
$p2 =~ s[\\][ - ]g; 
print $p2;;
Test - Foo

    [download]
    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    The start of some sanity?
[reply]
[d/l]
Re: Need to capture an optional sub-directory name
by spazm (Monk) on Mar 29, 2012 at 16:26 UTC
    You way want to look into a module like File::Spec or Path::Class that allows manipulation of file paths to use the fact that you know this is a path situation. 
    use File::Spec

sub SriptName {
    my ($self) = @_;
    my $name = Win32::GetFullPathName($0);
    my ($volume, $dirs, $file ) = File::Spec->splitpath( $name );
    my (@dirs) = File::Spec->splitdir( $dirs );
    $_ = shift @dirs until $_ eq 'scripts';

    #drop all suffix (not sure if this is what you want here) 
    # this could/should also be $file = basename($file)
    $file =~ s/\..*//; 

    return join( ' - ', @dirs, $file)
}

    [download]
[reply]
[d/l]
Re: Need to capture an optional sub-directory name
by AnomalousMonk (Prior) on Mar 29, 2012 at 18:35 UTC

    A nice module like File::Spec or Path::Class will probably save you some head-hurt, but here's a possible regex approach (needs 5.10+ for \K): 

    >perl -wMstrict -le
"my @paths = qw(
   C:\Tools\scripts\Test\Foo.pl
   C:\Tools\Test\Unstable\Foo.pl
   C:\Tools\scripts\Test\Bar.dir\Baz\Foo.pl
   C:\Tools\Test\Baz\Test\Foo.pl
   );
 ;;
 my $all_before_Test = qr{ \A (?: (?! \\ Test) .)* }xms;
 ;;
 for my $path (@paths) {
   print qq{'$path'};
   my @chunks =
     $path =~ m{ (?: $all_before_Test | \G) \\ \K [^\\]+ }xmsg;
   $chunks[-1] =~ s{ [.] [^.]* \z }{}xms;
   my $msg = join q{ - }, @chunks;
   print qq{'$msg' \n};
   }
"
'C:\Tools\scripts\Test\Foo.pl'
'Test - Foo'

'C:\Tools\Test\Unstable\Foo.pl'
'Test - Unstable - Foo'

'C:\Tools\scripts\Test\Bar.dir\Baz\Foo.pl'
'Test - Bar.dir - Baz - Foo'

'C:\Tools\Test\Baz\Test\Foo.pl'
'Test - Baz - Test - Foo'

    [download]

    If you want 'C:\Tools\Test\Baz\Test\Foo.pl' to render as 'Test - Foo' use
        my $all_before_Test = qr{ \A .* (?= \\ Test) }xms;
    instead.

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2013-05-23 22:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best material for plates (tableware) is:









    Results (493 votes), past polls