Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
# Last modified Saturday, July 22, 2000 # This lib is an overkill approach to dealing # with vagaries of paths on Win32. sub PathParsing { # if you want more debugging output, # declare (not my!) $dBg=1 in # the main program calling this sub. my ($poss_partial, $ext_suffix, $L_F_N, $Win_full, @sufs, @path_parts, $target_dir, $iter_count, $verified_spec_in, $new_suf, $out_file_spec, $from_start, $what_dir_we_are_in); # At some point will make it do better # than this so it can be used portably. return @_ if &IsNotWin; use Carp; use Cwd; # This lib could use File::Spec, but that wasn't found in Perl on # my provider's FreeBSD server Perl installation; so this way instead +: use File::Basename; fileparse_set_fstype('Win32'); # for '95/'98 which doesn't know $iter_count++; if ($main::spec_IN) { $poss_partial = $spec_IN; # Use global package var instead } else { # of subroutine parameter - option. $poss_partial = shift @_ or croak "Where's the file spec?"; $poss_partial = tpks($poss_partial); } if ($ext_suffix = shift @_) { $ext_suffix = (substr($ext_suffix,0,1) eq '.')? $ext_suffix : '.'. $ext_suffix; @sufs = (lc $ext_suffix, uc $ext_suffix); if (not $ext_suffix =~ m#^ \. [A-Za-z_]+ $#x) { print STDERR "sub may not have been passed a ". "valid (filetype)? extension: $ext_suffix (!?!)\n". "\nUsing default list\n" if $dBg; @sufs = &Suffices; } else { @sufs = (lc $ext_suffix, uc $ext_suffix); } } else { print STDERR "sub was not passed any filetype extension!". "\nUsing default list\n" if $dBg; @sufs = &Suffices; } if (defined &Win32::GetLongPathName) { print STDERR "\n\n$0: Now in winsane.pl on pass $iter_count, and the \ +n" . "name being passed into sub is:\n $poss_partial\n" if $dBg; $L_F_N = Win32::GetLongPathName( ($Win_full = Win32::GetFullPathName($poss_partial))); print STDERR "\ncheck: $L_F_N\n" if $dBg; } else { eval ' require Win32::LFN; $L_F_N = Win32::LFN::GetLongPathName( ($Win_full = Win32::LFN::GetFullPathName($poss_partial))); '; if ($@) { carp "ERROR: Win32::LFN not found\n"; return 0; } } print STDERR "\n $0 " . __LINE__ . ": The complete path + file from\n" + . "input $poss_partial is:\n $L_F_N\n" if $dBg; if (not -e &tpks($L_F_N) ) { croak "I was passed a filename that does not exist!\n"; } @path_parts = fileparse(tpks($L_F_N), @sufs); $target_dir = $path_parts[1]; $ext_suffix = $path_parts[2]; $fileBase = $path_parts[0]; use Cwd 'chdir'; $from_start = getcwd() or croak; chdir $target_dir or croak "\nCouldn't chdir into $target_dir:\n". "\t$!\n$?\n"; $out_file_spec = $fileBase; $verified_spec_in = (@sufs)? $fileBase . $ext_suffix : $fileBase; if (not defined ($new_suf = shift @_)) { $out_file_spec .= ''; # to make the point } else { $new_suf = (substr($new_suf,0,1) eq '.')? $new_suf : '.'. $new_su +f; $out_file_spec .= $new_suf; } if ($verified_spec_in =~ m#^([A-Z]|_|\-)+(\.[A-Z]+)$# && wantarray && $main::Rename) { # Fully qualifies lexical var +bec # I want to remember to define + it. print STDERR "\nWARNING: RENAMING what appears to ". "be a lonely (no LFN equivalent) all-caps DOS ". "leftover filename to a Sentence-case version." if $dBg; if (wantarray) { # we think we'll be using # an output filename spec +. $Sourcefile_mtime = (stat($verified_spec_in))[9]; use File::Copy 'mv'; mv ("$verified_spec_in","${verified_spec_in}__TMP") or die ("Failed to start rename of DOS legacy filename ". "in PathParsing sub:\n $^E"); sleep 3; mv ("${verified_spec_in}__TMP", Sentnc($verified_spec_in)) or die ("Failed to finish rename of DOS legacy filename ". "in PathParsing sub:\n$^E"); utime time,$Sourcefile_mtime,(Sentnc($verified_spec_in)) or die "utime FAILED in sub PathParsing!\n$!"; return &PathParsing( $target_dir . Sentnc($verified_spec_in), $ext_suffix, $new_suf ); } } if ($dBg) { print STDERR "\n"; &pretty; print STDERR "Pass $iter_count: input spec ". "name (verified) is: $verified_spec_in\n"; print STDERR "\n"; &pretty; } $what_dir_we_are_in = tpks($target_dir); chdir $from_start or croak; if (wantarray or $iter_count > 1) { return ("$verified_spec_in", "$out_file_spec", "$what_dir_we_are_in"); # returns dir with trailing '/'! } else { return $what_dir_we_are_in . $verified_spec_in; } } # END OF SUB THAT DOES THE BUSINESS sub tpks { my $fspec = shift @_; $fspec =~ s#\\#/#g; if ($fspec) { return $fspec; } else { return 0; } } sub Sentnc { # a regex to do this: s/(\w+)/\u\L$1/g return ucfirst( lc(shift)); } # ***** THIS SUB PORTABLY DETERMINES OS, WORKS FOR '95 ***** sub IsNotWin { my (@tell, $not_W32); if ($^O and $^O !~ /WIN32/i) { $not_W32 = 1; } elsif ($^O and $^O =~ /WIN32/i) { $not_W32 = 0; } elsif (eval ('require Win32')) { $not_W32 = 0; } else { $not_W32 = 1; } return $not_W32; } sub Suffices { return qw/ .gif .bmp .jpg .png .txt .doc .rtf .exe .bat .cmd .tif .tga .html .htm .tar .tgz .gz .zip .sit .GIF .BMP .JPG .PNG .TXT .DOC .RTF .EXE .BAT .CMD .TIF .TGA .HTML .HTM .TAR .TGZ .GZ .ZIP .SIT /; } sub pretty { print STDERR '*' x 28 ."\n"; } 1; __END__ __END__ =pod =head1 NAME "winsane.pl" =head2 SYNOPSIS require "winsane.pl"; PathParsing FILENAMESPEC, EXTN, OUTPUT-EXTN PathParsing FILENAMESPEC =over 5 If invoked in a B<scalar> context the subroutine C<PathParsing> will r +eturn a verified full path specification (fully qualified name) for t +he file name passed to it (possibly a DOS-8.3 shortname-with-path -- +as would always happen by drag-and-drop operations on Windows 95|8 or + NT or 2K?). If invoked in a B<list> context, it will return a B<3-member list> con +sisting of: I<(1)> the verified long file name only (bare, no prepended path speci +fication) -- that is, the Win32 LFN version of the input filename spe +c passed to it, and I<(2)> the (possible) output filename, and I<(3)> the containing directory specification (again, verified to actu +ally exist on the local filesystem, and in win32 LFN version, not sho +rtened for DOS).. =back Scenario: C<require> this lib in a Perl .bat script which processes a +number of files in some way which involves format conversion and ther +efore changing of desired filename suffix. =head2 EXAMPLES I<LIST invocation>: my ($real_name, $converted_to, $in_this_dir) = &PathParsing ('file.ext +n', '.extn', '.new'); I<SCALAR invocation>: perl -e "require 'winsane.pl'; @E=split /\s+/, qx'dir *.txt'; for (@E) + {print \"\n\",($s=&PathParsing ($_));};" =head2 NOTES The arguments to C<PathParsing> need to be the filename specification, + the filename extension (if known), and the intended filename extensi +on for the output file (assuming C<winsane> is being used this way). +The first argument is the only B<required> parameter. If invoked in a + scalar context, it is the only parameter that makes sense: B<Please note also this general issue>: On Win95 Perl's environment does not know its own identity (that is, P +erl has no value for $^O -- C<Operating System> -- so one must cagily + sus it out. =head1 COPYRIGHT (c) 2000 Soren Andersen. This file is Free Software; you can redistrib +ute it and/or modify it under the same terms as Perl itself. =cut



NAME

``winsane.pl''

SYNOPSIS

require ``winsane.pl'';

PathParsing FILENAMESPEC, EXTN, OUTPUT-EXTN

PathParsing FILENAMESPEC

If invoked in a scalar context the subroutine PathParsing will retur n a verified full path specification (fully qualified name) for the file name passed to it (possibly a DOS-8.3 shortname-with-path -- as would always happen by drag-and-drop operations on Windows 95|8 o r NT or 2K?).

If invoked in a list context, it will return a 3-member list con sisting of:

(1) the verified long file name only (bare, no prepended path specification) -- that is, the Win32 LFN version of the input filename spec passed to it, and

(2) the (possible) output filename, and

(3) the containing directory specification (again, verified to actually exist on the loca l filesystem, and in win32 LFN version, not shortened for DOS)..

Scenario: require this lib in a Perl .bat script which processes a number of files in some way which involves format conversion and therefore changing of desired filename suffix.

EXAMPLES

LIST invocation:

my ($real_name, $converted_to, $in_this_dir) = &PathParsing ('file.extn', '.extn', '.new');

SCALAR invocation:

perl -e ``require 'winsane.pl'; @E=split /\s+/, qx'dir *.txt'; for (@E) {print \''\n\``,($s=&P athParsing ($_));};''

NOTES

The arguments to PathParsing need to be the filename specification, the filename exte nsion (if known), and the intended filename extension for the output file (assuming winsane is being used this way). The first argument is the only required parameter. If i nvoked in a scalar context, it is the only parameter that makes sense:

Please note also this general issue:

On Win95 Perl's environment does not know its own identity (that is, Perl has no value for $^O -- Operating System -- so one must cagily sus it out.


COPYRIGHT

(c) 2000 Soren Andersen. This file is Free Software; you can redistribute it and/or modify it unde r the same terms as Perl itself.


In reply to winsane.pl by Intrepid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (8)
    As of 2014-08-30 08:55 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (291 votes), past polls