# 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_suf;
     $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 return 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 or NT or 2K?).

If invoked in a B<list> context, it will return a B<3-member list> consisting of:

I<(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

I<(2)> the (possible) output filename, and

I<(3)> the containing directory specification (again, verified to actually exist on the local filesystem, and in win32 LFN version, not shortened 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 therefore changing of desired filename suffix.

=head2 EXAMPLES

I<LIST invocation>:

my ($real_name, $converted_to, $in_this_dir) = &PathParsing ('file.extn', '.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 extension 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, Perl 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 redistribute it and/or modify it under the same terms as Perl itself.

=cut