##########
# Windows file functions that use very long paths and Unicode characters.
##########

package Win32::LongPath;

use 5.008_000;
use base 'Exporter';
use strict;
use warnings;

use Carp;
require Encode;
use Fcntl
  qw(O_APPEND O_BINARY O_CREAT O_RDONLY O_RDWR O_TRUNC O_WRONLY :mode);
use File::Spec::Functions;
use Time::Local;

##########
# external constants
##########

sub FILE_ATTRIBUTE_ARCHIVE () {0x20}
sub FILE_ATTRIBUTE_COMPRESSED () {0x800}
sub FILE_ATTRIBUTE_DEVICE () {0x40}
sub FILE_ATTRIBUTE_DIRECTORY () {0x10}
sub FILE_ATTRIBUTE_ENCRYPTED () {0x4000}
sub FILE_ATTRIBUTE_HIDDEN () {0x2}
sub FILE_ATTRIBUTE_INTEGRITY_STREAM () {0x8000}
sub FILE_ATTRIBUTE_NORMAL () {0x80}
sub FILE_ATTRIBUTE_NOT_CONTENT_INDEXED () {0x2000}
sub FILE_ATTRIBUTE_NO_SCRUB_DATA () {0x20000}
sub FILE_ATTRIBUTE_OFFLINE () {0x1000}
sub FILE_ATTRIBUTE_READONLY () {0x1}
sub FILE_ATTRIBUTE_REPARSE_POINT () {0x400}
sub FILE_ATTRIBUTE_SPARSE_FILE () {0x200}
sub FILE_ATTRIBUTE_SYSTEM () {0x4}
sub FILE_ATTRIBUTE_TEMPORARY () {0x100}
sub FILE_ATTRIBUTE_VIRTUAL () {0x10000}

sub FILE_CASE_PRESERVED_NAMES () {0x00000002}
sub FILE_CASE_SENSITIVE_SEARCH () {0x00000001}
sub FILE_FILE_COMPRESSION () {0x00000010}
sub FILE_NAMED_STREAMS () {0x00040000}
sub FILE_PERSISTENT_ACLS () {0x00000008}
sub FILE_READ_ONLY_VOLUME () {0x00080000}
sub FILE_SEQUENTIAL_WRITE_ONCE () {0x00100000}
sub FILE_SUPPORTS_ENCRYPTION () {0x00020000}
sub FILE_SUPPORTS_EXTENDED_ATTRIBUTES () {0x00800000}
sub FILE_SUPPORTS_HARD_LINKS () {0x00400000}
sub FILE_SUPPORTS_OBJECT_IDS () {0x00010000}
sub FILE_SUPPORTS_OPEN_BY_FILE_ID () {0x01000000}
sub FILE_SUPPORTS_REPARSE_POINTS () {0x00000080}
sub FILE_SUPPORTS_SPARSE_FILES () {0x00000040}
sub FILE_SUPPORTS_TRANSACTIONS () {0x00200000}
sub FILE_SUPPORTS_USN_JOURNAL () {0x02000000}
sub FILE_UNICODE_ON_DISK () {0x00000004}
sub FILE_VOLUME_IS_COMPRESSED () {0x00008000}
sub FILE_VOLUME_QUOTAS () {0x00000020}

##########
# exports
##########

our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
BEGIN
  {
  my @aFuncs =
    qw(abspathL attribL chdirL copyL getcwdL linkL lstatL mkdirL openL
    readlinkL renameL rmdirL shortpathL statL symlinkL sysopenL testL
    unlinkL utimeL volinfoL);
  my @aAttribs = qw(
    FILE_ATTRIBUTE_ARCHIVE
    FILE_ATTRIBUTE_COMPRESSED
    FILE_ATTRIBUTE_DEVICE
    FILE_ATTRIBUTE_DIRECTORY
    FILE_ATTRIBUTE_ENCRYPTED
    FILE_ATTRIBUTE_HIDDEN
    FILE_ATTRIBUTE_INTEGRITY_STREAM
    FILE_ATTRIBUTE_NORMAL
    FILE_ATTRIBUTE_NOT_CONTENT_INDEXED
    FILE_ATTRIBUTE_NO_SCRUB_DATA
    FILE_ATTRIBUTE_OFFLINE
    FILE_ATTRIBUTE_READONLY
    FILE_ATTRIBUTE_REPARSE_POINT
    FILE_ATTRIBUTE_SPARSE_FILE
    FILE_ATTRIBUTE_SYSTEM
    FILE_ATTRIBUTE_TEMPORARY
    FILE_ATTRIBUTE_VIRTUAL
    );
  my @aVolFlags = qw(
    FILE_CASE_PRESERVED_NAMES
    FILE_CASE_SENSITIVE_SEARCH
    FILE_FILE_COMPRESSION
    FILE_NAMED_STREAMS
    FILE_PERSISTENT_ACLS
    FILE_READ_ONLY_VOLUME
    FILE_SEQUENTIAL_WRITE_ONCE
    FILE_SUPPORTS_ENCRYPTION
    FILE_SUPPORTS_EXTENDED_ATTRIBUTES
    FILE_SUPPORTS_HARD_LINKS
    FILE_SUPPORTS_OBJECT_IDS
    FILE_SUPPORTS_OPEN_BY_FILE_ID
    FILE_SUPPORTS_REPARSE_POINTS
    FILE_SUPPORTS_SPARSE_FILES
    FILE_SUPPORTS_TRANSACTIONS
    FILE_SUPPORTS_USN_JOURNAL
    FILE_UNICODE_ON_DISK
    FILE_VOLUME_IS_COMPRESSED
    FILE_VOLUME_QUOTAS
    );
  @EXPORT = @aFuncs;
  @EXPORT_OK = (@aAttribs, @aVolFlags);
  %EXPORT_TAGS = (
    all => [@EXPORT, @EXPORT_OK],
    funcs => [@aFuncs],
    fileattr => [@aAttribs],
    volflags => [@aVolFlags]
    );
  $VERSION = '2.0';
  require XSLoader;
  XSLoader::load ('Win32::LongPath', $VERSION);
  }

##########
# local constants
##########

my $GENERIC_READ = 0x80000000;
my $GENERIC_WRITE = 0x40000000;
my $GENERIC_RW = 0xC0000000;

my $CREATE_ALWAYS = 2;
my $OPEN_EXISTING = 3;
my $OPEN_ALWAYS = 4;
my $TRUNC_EXISTING = 5;

my $NOFILE = FILE_ATTRIBUTE_DEVICE | FILE_ATTRIBUTE_DIRECTORY
  | FILE_ATTRIBUTE_OFFLINE;
my $ALL_ATTRIBS = FILE_ATTRIBUTE_ARCHIVE | FILE_ATTRIBUTE_HIDDEN
  | FILE_ATTRIBUTE_NOT_CONTENT_INDEXED | FILE_ATTRIBUTE_OFFLINE
  | FILE_ATTRIBUTE_READONLY | FILE_ATTRIBUTE_SYSTEM | FILE_ATTRIBUTE_TEMPORARY;

##########
# local varbs
##########

my $_UTF16 ||= Encode::find_encoding ('utf16-le');

##########
# external functions
##########

###########
# Absolute Path
#
# INPUT:
#   Arg (1) = relative path
# OUTPUT: absolute path; undef=error
###########

sub abspathL

{
my $sPath = shift;
if (!defined $sPath)
  { croak 'path missing!'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my $sLong = get_long_path ($sPath);
if ($sLong ne '')
  { $sPath = $sLong; }
return _denormalize_path ($sPath);
}

###########
# Set Attributes
#
# INPUT:
#   Arg (1) = attribute string
#   Arg (2) = path
# OUTPUT: success=1; undef=error
###########

sub attribL

{
###########
# o get current attributes
# o adjust attributes
###########

my ($sAttribs, $sPath) = @_;
if (!defined $sAttribs)
  { croak 'attributes missing!'; }
if (!defined $sPath)
  { croak 'path missing!'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my $nAttribs = get_attribs ($sPath);
if (!defined $nAttribs)
  { return; }
$nAttribs &= $ALL_ATTRIBS;
my $bSet = 1;
foreach my $sAttrib (split //, lc $sAttribs)
  {
  if ($sAttrib eq '+')
    {
    $bSet = 1;
    next;
    }
  if ($sAttrib eq '-')
    {
    $bSet = 0;
    next;
    }
  my $nMask;
  if ($sAttrib eq 'a')
    { $nMask = FILE_ATTRIBUTE_ARCHIVE; }
  elsif ($sAttrib eq 'h')
    { $nMask = FILE_ATTRIBUTE_HIDDEN; }
  elsif ($sAttrib eq 'i')
    { $nMask = FILE_ATTRIBUTE_NOT_CONTENT_INDEXED; }
  elsif ($sAttrib eq 'r')
    { $nMask = FILE_ATTRIBUTE_READONLY; }
  elsif ($sAttrib eq 's')
    { $nMask = FILE_ATTRIBUTE_SYSTEM; }
  else
    { croak 'invalid attribute!'; }
  if ($bSet)
    { $nAttribs |= $nMask; }
  else
    { $nAttribs &= ~$nMask; }
  }

###########
# set attributes
###########

if (!set_attribs ($sPath, $nAttribs))
  { return; }
return 1;
}

###########
# Change Current Working Directory
#
# INPUT:
#   [Arg (1)] = directory path; default=$ENV{HOME} or $ENV{LOGDIR}
# OUTPUT: 1=success; undef=error
###########

sub chdirL

{
my $sPath = shift;
if (!defined $sPath && exists $ENV {HOME})
  { $sPath = $ENV {HOME}; }
elsif (!defined $sPath && exists $ENV {LOGDIR})
  { $sPath = $ENV {LOGDIR}; }
if (!defined $sPath)
  { return $sPath; }
if ($sPath !~ /[\\\/]$/)
  { $sPath .= '/'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
if (set_current_directory ($sPath))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Copy File
#
# INPUT:
#   Arg (1) = from
#   Arg (2) = to
# OUTPUT: 1=success; undef=error
###########

sub copyL

{
my ($sFrom, $sTo) = @_;
if (!defined $sFrom)
  { croak 'from missing!'; }
if (!defined $sTo)
  { croak 'to missing!'; }
$sFrom = _normalize_path ($sFrom);
if (!defined $sFrom)
  { return; }
$sTo = _normalize_path ($sTo);
if (!defined $sTo)
  { return; }
if (copy_file ($sFrom, $sTo))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Get Current Working Directory
#
# INPUT: none
# OUTPUT: cwd
###########

sub getcwdL

{
return _denormalize_path (get_current_directory ());
}

###########
# Create Hard Link
#
# INPUT:
#   Arg (1) = to
#   Arg (2) = from
# OUTPUT: 1=success; undef=error
###########

sub linkL

{
###########
# o check args
# o relative target?
# o create link
###########

my ($sTo, $sFrom) = @_;
if (!defined $sTo)
  { croak 'oldname missing!'; }
if (!defined $sFrom)
  { croak 'newname missing!'; }
$sTo = _normalize_path ($sTo);
if (!defined $sTo)
  { return; }
$sFrom = _normalize_path ($sFrom);
if (!defined $sFrom)
  { return; }
if (make_hlink ($sTo, $sFrom))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Linked Status Information
#
# INPUT:
#   [Arg (1)] = path; default=$_
# OUTPUT: status object; undef=error
###########

sub lstatL

{
return statL (shift, 1);
}

###########
# Make Directory
#
# INPUT:
#   [Arg (1)] = path; default=$_
# OUTPUT: 1=success; undef=error
###########

sub mkdirL

{
my $sPath = shift;
if (!defined $sPath)
  { $sPath = $_; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
if (create_directory ($sPath))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Open File
#
# INPUT:
#   Arg (1) = filehandle
#   Arg (2) = mode
#   Arg (3) = path
# OUTPUT: 1=success; undef=error
###########

sub openL

{
##########
# check parms
##########

my ($oFH, $sMode, $sPath) = @_;
if (!ref $oFH)
  { croak 'filehandle reference missing!'; }
if (!defined $sMode)
  { croak 'mode missing!'; }
if (!defined $sPath)
  { croak 'path missing!'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my $sLayer = '';
if ($sMode =~ /^([^\:]*)(\:.*)/)
  {
  ($sMode, $sLayer) = ($1, $2);
  if ($sLayer eq ':')
    { croak 'invalid layer for openL!'; }
  }
my $oFH1;
if ($sMode eq '' or $sMode eq '<')
  { $oFH1 = create_file ($sPath, $GENERIC_READ, $OPEN_EXISTING, O_RDONLY); }
elsif ($sMode eq '+<')
  { $oFH1 = create_file ($sPath, $GENERIC_RW, $OPEN_EXISTING, O_RDWR); }
elsif ($sMode eq '>')
  {
  $oFH1 = create_file
    ($sPath, $GENERIC_WRITE, $CREATE_ALWAYS, O_TRUNC | O_WRONLY);
  }
elsif ($sMode eq '+>')
  {
  $oFH1 = create_file
    ($sPath, $GENERIC_RW, $CREATE_ALWAYS, O_RDWR | O_TRUNC);
  }
elsif ($sMode eq '>>')
  {
  $oFH1 = create_file
    ($sPath, $GENERIC_WRITE, $OPEN_ALWAYS, O_APPEND | O_WRONLY);
  }
elsif ($sMode eq '+>>')
  {
  $oFH1 = create_file ($sPath, $GENERIC_RW, $OPEN_ALWAYS, O_APPEND | O_RDWR);
  }
else
  { croak 'invalid mode!'; }
if (!$oFH1)
  { return; }
else
  {
  # this avoids a bug in Perl 5.22 when opening files w/a scalar reference
  $$oFH = $oFH1;
  }
if ($sLayer ne '')
  {
  if (!binmode $$oFH, $sLayer)
    {
    close $$oFH;
    return;
    }
  }
return 1;
}

###########
# Read Link Value
#
# INPUT:
#   [Arg (1)] = path; default=$_
# OUTPUT: path that link points to; undef=error or unable to find
###########

sub readlinkL

{
##########
# o get default path if undef
# o find link
##########

my $sPath = shift;
if (!defined $sPath)
  { $sPath = $_; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my $sLink = find_link ($sPath);
if (!defined $sLink)
  { return; }
set_last_error (0);
return _denormalize_path ($sLink);
}

###########
# Rename (Move) File
#
# INPUT:
#   Arg (1) = from
#   Arg (2) = to
# OUTPUT: 1=success; undef=error
###########

sub renameL

{
my ($sFrom, $sTo) = @_;
if (!defined $sFrom)
  { croak 'oldname missing!'; }
if (!defined $sTo)
  { croak 'newname missing!'; }
$sFrom = _normalize_path ($sFrom);
if (!defined $sFrom)
  { return; }
$sTo = _normalize_path ($sTo);
if (!defined $sTo)
  { return; }
if (move_file ($sFrom, $sTo))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Remove Directory
#
# INPUT:
#   [Arg (1)] = path; default=$_
# OUTPUT: 1=success; undef=error
###########

sub rmdirL

{
my $sPath = shift;
if (!defined $sPath)
  { $sPath = $_; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
if (remove_directory ($sPath))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# Short Path
#
# INPUT:
#   Arg (1) = path
# OUTPUT: shortpath; blank=error
###########

sub shortpathL

{
my $sPath = shift;
if (!defined $sPath)
  { croak 'path missing!'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return ''; }
my $sShort = get_short_path ($sPath);
return _denormalize_path ($sShort);
}

###########
# Status Information
#
# INPUT:
#   [Arg (1)] = expression; default=$_
#   [Arg (2)] = true then lstat
# OUTPUT: status object; undef=error
###########

sub statL

{
##########
# o get default path if undef
# o check if lstatL
# o get stats
# o convert size from large int
# o get time as gmtime
##########

my ($sPath, $bLStat) = @_;
if (!defined $sPath)
  { $sPath = $_; }
$bLStat = $bLStat ? 1 : 0;
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my $oStat = get_stat ($sPath, $bLStat);
if (!defined $oStat)
  { return; }
$oStat->{size} = $oStat->{size_high}
  ? (($oStat->{size_high} << 32) + $oStat->{size_low}) : $oStat->{size_low};
delete $oStat->{size_high};
delete $oStat->{size_low};
foreach my $sTime (qw (atime ctime mtime))
  {
  if ($oStat->{$sTime})
    { $oStat->{$sTime} = timegm (split /,/, $oStat->{$sTime}); }
  }
return $oStat;
}

###########
# Create Symbolic Link
#
# INPUT:
#   Arg (1) = to
#   Arg (2) = from
# OUTPUT: 1=success; undef=error
###########

sub symlinkL

{
###########
# o check args
# o relative target?
# o create link
###########

my ($sTo, $sFrom) = @_;
if (!defined $sTo)
  { croak 'oldname missing!'; }
if (!defined $sFrom)
  { croak 'newname missing!'; }
$sTo =~ s#/#\\#g;
if ($sTo =~ /^\\/ or $sTo =~ /^[a-z]:/i)
  { $sTo = _normalize_path ($sTo); }
else
  { $sTo = $_UTF16->encode ($sTo) . "\x00"; }
if (!defined $sTo)
  { return; }
$sFrom = _normalize_path ($sFrom);
if (!defined $sFrom)
  { return; }
if (make_slink ($sTo, $sFrom))
  {
  set_last_error (0);
  return 1;
  }
return;
}

###########
# System Open File
#
# INPUT:
#   Arg (1) = filehandle
#   Arg (2) = path
#   Arg (3) = mode
# OUTPUT: 1=success; undef=error
###########

sub sysopenL

{
##########
# o check parms
# o open file
##########

my ($oFH, $sPath, $nMode) = @_;
if (!ref $oFH)
  { croak 'filehandle reference missing!'; }
if (!defined $nMode)
  { croak 'mode missing!'; }
if (!defined $sPath)
  { croak 'path missing!'; }
$sPath = _normalize_path ($sPath);
if (!defined $sPath)
  { return; }
my ($nAccess, $nCreate);
if ($nMode & O_WRONLY)
  { $nAccess = $GENERIC_WRITE; }
elsif ($nMode & O_RDWR)
  { $nAccess = $GENERIC_RW; }
else
  { $nAccess = $GENERIC_READ; }
if ($nMode & O_TRUNC)
  { $nCreate = $CREATE_ALWAYS; }
elsif ($nMode & O_CREAT)
  { $nCreate = $OPEN_ALWAYS; }
else
  { $nCreate = $OPEN_EXISTING; }
$$oFH = create_file ($sPath, $nAccess, $nCreate, $nMode);
if ($$oFH && ($nMode & O_BINARY))
  { binmode $$oFH; }
return $$oFH ? 1 : undef;
}

###########
# Test Path
#
# INPUT:
#   Arg (1) = test
#   [Arg (2)] = path; default=$_
# OUTPUT: success=1; fail=''; undef=error
###########

sub testL

{
###########
# o valid test?
# o get stat
# o check test
###########

my $sTest = shift;
if ($sTest !~ /^[bcdeflOoRrsWwXxz]$/)
  { croak 'invalid test!'; }
my $oStat = $sTest eq 'l' ? lstatL (shift) : statL (shift);
if (!defined $oStat)
  { return; }
my $nRet = '';
if ($sTest eq 'd')
  {
  if ($oStat->{mode} & S_IFDIR)
    { $nRet = 1; }
  }
elsif ($sTest eq 'e')
  { $nRet = 1; }
elsif ($sTest eq 'f')
  {
  if (!($oStat->{attribs} & $NOFILE))
    { $nRet = 1; }
  }
elsif ($sTest eq 'l')
  {
  if ($oStat->{attribs} & FILE_ATTRIBUTE_REPARSE_POINT)
    { $nRet = 1; }
  }
elsif ($sTest =~ /o/i)
  { $nRet = 1; }
elsif ($sTest =~ /r/i)
  {
  if ($oStat->{mode} & S_IRUSR)
    { $nRet = 1; }
  }
elsif ($sTest eq 's')
  {
  if ($oStat->{size})
    { $nRet = $oStat->{size}; }
  }
elsif ($sTest =~ /w/i)
  {
  if ($oStat->{mode} & S_IWUSR)
    { $nRet = 1; }
  }
elsif ($sTest =~ /x/i)
  {
  if ($oStat->{mode} & S_IXUSR)
    { $nRet = 1; }
  }
elsif ($sTest eq 'z')
  {
  if (!$oStat->{size})
    { $nRet = 1; }
  }
return $nRet;
}

###########
# Delete Files
#
# INPUT:
#   [Arg (...)] = files to delete; default=$_
# OUTPUT: number of files deleted; undef=error
###########

sub unlinkL

{
##########
# o get default path if undef
# o delete each file
##########

my @sPaths = @_;
if (!@sPaths)
  { push @sPaths, $_; }
my $nFiles = 0;
my $nErr = 0;
foreach my $sPath (@sPaths)
  {
  $sPath = _normalize_path ($sPath);
  if (!defined $sPath)
    {
    $nErr = get_last_error ();
    next;
    }
  if (remove_file ($sPath))
    { $nFiles++; }
  else
    {
    $nErr = get_last_error ();
    next;
    }
  }

##########
# errors?
##########

if ($nErr)
  {
  set_last_error ($nErr);
  return;
  }
return $nFiles;
}

###########
# Change File Times
#
# INPUT:
#   Arg (1) = access time; undef=now
#   Arg (2) = modification time; undef=now
#   Arg (...) = files to change
# OUTPUT: number of files changed; undef=error
###########

sub utimeL

{
##########
# o get times and files
# o process each file
##########

my ($nATime, $nMTime, @sPaths) = @_;
if (!defined $nATime && !defined $nMTime)
  { $nATime = $nMTime = time; }
if (!defined $nATime)
  { $nATime = 0; }
if (!defined $nMTime)
  { $nMTime = 0; }
my $nFiles = 0;
my $nErr = 0;
foreach my $sPath (@sPaths)
  {
  $sPath = _normalize_path ($sPath);
  if (!defined $sPath)
    {
    $nErr = get_last_error ();
    next;
    }
  if (set_filetime ($nATime, $nMTime, $sPath))
    { $nFiles++; }
  else
    {
    $nErr = get_last_error ();
    next;
    }
  }

##########
# errors?
##########

if ($nErr)
  { set_last_error ($nErr); }
return $nFiles;
}

###########
# Get Volume Information
#
# INPUT:
#   Arg (1) = path
# OUTPUT: volume object; undef=error
###########

sub volinfoL

{
###########
# o get fullpath
# o limit to root
# o get volume info
###########

my $sPath = abspathL (shift);
if (!defined $sPath)
  { return; }
if ($sPath =~ /^([a-z]:)/i)
  { $sPath = "$1\\"; }
else
  {
  $sPath =~ /^(\\\\[^\\]+\\[^\\]+)/;
  $sPath = "$1\\";
  }
my $oVol = get_vol_info (_normalize_path ($sPath));
if (!defined $oVol)
  { return; }
$oVol->{name} = _wide_to_utf8 ($oVol->{name});
return $oVol;
}

##########
# object functions
##########

###########
# Close Directory
#
# INPUT: none
# OUTPUT: close handle
###########

sub closedirL

{
###########
# close if handle already open
###########

my $self = shift;
if (!defined $self->{handle})
  { croak 'no directory open!'; }
$self->find_close ();
delete $self->{handle};
return 1;
}

##########
# destructor
##########

sub DESTROY

{
##########
# close handle
##########

my $self = shift;
if (defined $self->{handle})
  { $self->find_close (); }
return;
}

###########
# Create Directory Object
###########

sub new

{
return bless { }, shift;
}

###########
# Open Directory
#
# INPUT:
#   [Arg (1)] = directory path; default=current dir
# OUTPUT: 1=success, undef=error
###########

sub opendirL

{
###########
# o close if handle already open
# o normalize path
# o find first file
# o return opendir object
###########

my ($self, $sDir) = @_;
if (defined $self->{handle})
  { $self->find_close (); }
if (!defined $sDir)
  { $sDir = '.'; }
my $sPath = _normalize_path ($sDir);
if (!defined $sPath)
  { return; }
$self->{dirpath} = _denormalize_path ($sPath);
$self->find_first_file (_normalize_path (catfile ($sDir, '*')));
if ($self->{handle} == 4294967295)
  { return; }
$self->{first} = _denormalize_path ($self->{first});
set_last_error (0);
return 1;
}

###########
# Read Directory
#
# INPUT: none
# OUTPUT:
#   list: all remaining directory entries
#   otherwise next entry or undef if none
###########

sub readdirL

{
###########
# o check for first entry from opendir
# o retrieve entries
# o return entries
###########

my $self = shift;
if (!defined $self->{handle})
  { croak 'no directory open!'; }
my $bList = wantarray;
my @sDirs;
if ($self->{first} ne '')
  {
  push @sDirs, $self->{first};
  $self->{first} = '';
  if (!$bList)
    { return $sDirs [0]; }
  }
while (defined (my $sDir = $self->find_next_file ()))
  {
  push @sDirs, _denormalize_path ($sDir);
  if (!$bList)
    { last; }
  }
return $bList ? @sDirs : pop @sDirs;
}

##########
# local functions
##########

###########
# Denormalize Path
#
# INPUT:
#   Arg (1) = normalized path
# OUTPUT: denormalized path
###########

sub _denormalize_path

{
###########
# o convert to UTF-8
# o strip out trailing null
# o strip off extended path prefix
###########

my $sPath = shift;
if (!defined $sPath)
  { return $sPath; }
$sPath = _wide_to_utf8 ($sPath);
$sPath =~ s/^\\\\\?\\UNC/\\/;
$sPath =~ s/^\\\\\?\\//;
return $sPath;
}

###########
# Normalize Path
#
# INPUT:
#   Arg (1) = denormalized path
# OUTPUT: normalized path
###########

sub _normalize_path

{
###########
# o make sure using backslashes for separator
# o extended path?
###########

my $sPath = shift;
if (!defined $sPath)
  { return $sPath; }
$sPath =~ s#/#\\#g;
if ($sPath !~ /^\\\\\?\\/)
  {
  ###########
  # add root path if missing
  ###########

  if ($sPath !~ /^\\\\/ && $sPath !~ /^[a-z]:/i)
    {
    if ($sPath !~ /^\\/)
      { $sPath = getcwdL () . "\\$sPath"; }
    else
      {
      my $sRoot = getcwdL ();
      if ($sRoot =~ /^(\\\\[^\\]+\\[^\\]+)/)
        { $sPath = "$1$sPath"; }
      elsif ($sRoot =~ /([a-z]:)/i)
        { $sPath = "$1$sPath"; }
      }
    }
  if ($sPath =~ /^([a-z]:)[^\\+]\\/i)
    {
    ###########
    # o switch drive
    # o add root path
    # o switch drive back
    ###########

    my $sDrive = $1;
    my $sCurDir = getcwdL ();
    if (!chdirL ($sDrive))
      { return; }
    $sPath = getcwdL () . substr ($sPath, 2);
    if (!chdirL ($sCurDir))
      { return; }
    }

  ###########
  # strip off volume (drive letter or UNC)
  ###########

  my $sVol;
  if ($sPath =~ /^([a-z]:)(.*)/i)
    { ($sVol, $sPath) = ($1, $2); }
  elsif ($sPath =~ /^\\(\\[^\\]+\\[^\\]+)(.*)/)
    { ($sVol, $sPath) = ($1, $2); }
  else
    {
    set_last_error (3);
    return;
    }

  ###########
  # remove relative dirs
  ###########

  my @sNewDirs;
  foreach my $sDir (split /\\/, $sPath)
    {
    if ($sDir eq '' or $sDir eq '.')
      { next; }
    if ($sDir ne '..')
      {
      push @sNewDirs, $sDir;
      next;
      }
    if (!@sNewDirs)
      {
      set_last_error (3);
      return;
      }
    pop @sNewDirs;
    }

  ###########
  # o return to the original path
  # o form extended path
  ###########

  $sPath = '\\\\?\\' . ($sVol =~ /\\/ ? 'UNC' : '')
    . "$sVol\\" . join ('\\', @sNewDirs);
  }

###########
# convert to UTF-16 and add trailing null
###########

return $_UTF16->encode ($sPath) . "\x00";
}

###########
# Wide to UTF-8
#
# INPUT:
#   Arg (1) = wide char string
# OUTPUT: Perl UTF-8 string
###########

sub _wide_to_utf8

{
my $sText = $_UTF16->decode (shift);
$sText =~ s/\x00$//;
return $sText;
}

1;

__END__

=encoding UTF-8

=head1 NAME

Win32::LongPath - provide functions to access long paths and Unicode in the Windows environment

=head1 SYNOPSIS

	use File::Spec::Functions;
	use Win32::LongPath;
	use utf8;

	# make a really long path w/Unicode from around the world
	$path = 'c:';
	while (length ($path) < 5000) {
	  $path = catdir ($path, 'ελληνικά-русский-日本語-한국-中國的-עִברִית-عربي');
	  if (!testL ('e', $path)) {
	    mkdirL ($path) or die "unable to create $path ($^E)";
	  }
	}
	print 'ShortPath: ' . shortpathL ($path) . "\n";

	# next, create a file in the path
	$file = catfile ('more interesting characters فارسی-தமிழர்-​ພາສາ​ລາວ');
	openL (\$FH, '>:encoding(UTF-8)', $file)
	  or die ("unable to open $file ($^E)");
	print $FH "writing some more Unicode characters\n";
	print $FH "דאס שרייבט אַ שורה אין ייִדיש.\n";
	close $FH;

	# now undo everything
	unlinkL ($file) or die "unable to delete file ($^E)";
	while ($path =~ /[\/\\]/) {
	  rmdirL ($path) or die "unable to remove $path ($^E)";
	  $path =~ s#[/\\][^/\\]+$##;
	}

=head1 DESCRIPTION

Although Perl natively supports functions that can access files in Windows
these functions fail for Unicode or long file paths (i.e. greater than the
Windows MAX_PATH value which is about 255 characters). Win32::LongPath
overcomes these limitations by using Windows wide-character functions
which support Unicode and extended-length paths. The end result is that
you can process any file in the Windows environment without worrying about
Unicode or path length.

Win32::LongPath provides replacement functions for most of the native Perl
file functions. These functions attempt to imitate the native functionality
and format as closely as possible and accept file paths which include
Unicode characters and can be up to 32,767 characters long.

Some additional functions are also available to provide low-level features
that are specific to Windows files.

=head2 Paths

File and directory paths can be provided containing any of the following
components.

=over 4

=item *

B<path separators>: Both the forward (/) and reverse (\) slashes can be used
to separate the path components.

=item *

B<Unicode>: Unicode characters can be used anywhere in the path provided they
are supported by the Windows file naming standard. If Unicode is used, the
string must be internally identified as UTF-8. See L<perlunicode> for more
information on using Unicode with Perl.

=item *

B<drive letter>: The path can begin with an upper or lower case letter from A
to Z followed by a colon to indicate a drive letter path. For example,
C<C:/path> (fullpath) or C<c:path> (relative path).

=item *

B<UNC>: The path can begin with a UNC path in the form C<\\server\share> or
C<//server/share>.

=item *

B<extended-length>: The path can begin with an extended-length prefix in the
form of C<\\?\> or C<//?/>.

=back

All input paths will be converted (I<normalized>) to a fullpath using the
extended-length format and wide characters. This allows paths to be up to
32,767 characters long and to include Unicode characters. The Microsoft
specification still limits the directory component to MAX_PATH (about 255)
characters.

Output paths will be converted back (I<denormalized>) to a UTF-8 fullpath
that begins with a drive letter or UNC.

B<NOTE:> See the I<Naming Files, Paths, and Namespaces> topic in the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about extended-length paths.

=head2 Return Values

Unless stated otherwise, all functions return true (a numeric value of 1)
if successful or false (undef) if an error occurred. Generally, if a
function fails it will set the $! value to the failure. However, $^E will
have the more specific Windows error value.

=head1 FILE FUNCTIONS

This section lists the replacements for native Perl file functions. Since
L</openL> returns a native Perl file handle, functions that use open file
handles (read, write, close, binmode, etc.) can be used as is and do not
have replacement functions. In like manner, L</sysopenL> also returns a
native Perl file handle.

Functions that are specific to the Unix environment (chmod, chown, umask,
etc.) do not have replacements.

=over 4

=item X<linkL>linkL OLDFILE,NEWFILE

If the Windows file system supports it, a hard link is created from
B<NEWFILE> to B<OLDFILE>.

	linkL ('goodbye', 'до свидания')
	  or die ("unable to link file ($^E)");

=item X<lstatL>lstatL PATH

Does the same thing as the L</statL> function but will retrieve the
statistics for the link and not the file it links to.

=item X<openL>openL FILEHANDLEREF,MODE,PATH

open is a very powerful and versatile Perl function with many modes and
capabilities. The openL replacement does not provide the full range of
capability but does provide what is needed to open files in the Windows
file system. It only supports the three-argument form of open.

B<FILEHANDLEREF> cannot be a bareword file handle or a scalar variable.
It must be a reference to a scalar value which will be set to be a Perl
file handle. For example:

	openL (\$fh, '<', $file) or die ("unable to open $file: ($^E)");

For the most part, B<MODE> matches the native definition and can begin
with E<lt>, E<gt>, E<gt>E<gt>, +E<lt>, +E<gt> and +E<gt>E<gt> to
indicate read/write behavior. The E<verbar>-, -E<verbar>, E<lt>-, -,
E<gt>- modes are not valid since they apply to pipes, STDIN and STDOUT.
Read-only is assumed if the read/write symbols are not used. B<MODE>
can also include a colon followed by the I/O layer definition. For
example:

	openL (\$fh, '>:encoding(UTF-8)', $file);

B<PATH> is the relative or fullpath name of the file. It cannot be undef
for temporary files, a reference to a variable for in-memory files or
a file handle.

	# these are WRONG!
	openL ($infh, '', $infile);
	openL (INFILE, '', $infile);
	openL (\$infh, '', undef);
	openL (\$infh, '', \$memory);
	openL (\$infh, '', INFILE);
	openL (\$infh, '-|', "file<$infile");

	# these are correct
	# append infile to outfile
	openL (\$infh, '', $infile)
	  or die ("unable to open $infile: ($^E)");
	openL (\$outfh, '>>', $outfile)
	  or die ("unable to open $outfile: ($^E)");
	while (<$infh>) {
	  print $outfh $_;
	}
	eof ($infh) or print "terminated before EOF!\n";
	close $infh;
	close $outfh;

=item X<readlinkL>readlinkL PATH

Returns the path that a junction/mount point or symbolic link points to. If
B<PATH> is not provided, $_ is used. It will fail for hard links.

	# symlinks should always be equal
	symlinkL ($orig, $slink) or die ("unable to symlink file ($^E)");
	$rlink = readlinkL ($slink) or die ("unable to read link ($^E)");
	die ("links not equal!") if ($rlink ne $orig);

	# hard links should always be undef
	linkL ($orig, $hlink) or die ("unable to link file ($^E)");
	!readlinkL ($hlink) or die ("should have failed!");

=item X<renameL>renameL OLDNAME,NEWNAME

Changes the name or moves B<OLDNAME> to B<NEWNAME>. Renames directories
as well as files. Cannot move directories across volumes.

B<NOTE:> See I<MoveFile> in the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information.

	# should work
	renameL ('c:/file', 'c:/newfile');
	# fails, can't move file to directory
	renameL ('d:/file', '.');
	# should work for files
	renameL ('e:/file', 'f:/newfile');
	# should work
	renameL ('d:/dir', 'd:/topdir/subdir');
	# fails, can't move directory across volumes
	renameL ('c:/dir', 'd:/newdir');

=item X<statL>statL PATH

Returns an object with the statistics for the file. B<PATH> must be a path
to a file and cannot be a file or directory handle. If it is not provided,
$_ is used. If there is an error gathering the statistics undef is returned
and the error variables are set. The definition of object elements are very
similar to the native Perl stat function although the access method is like
L<File::stat>.

=over 4

B<atime>: Last access time in seconds. B<NOTE:> Different file systems have
different time resolutions. For example, FAT has a resolution of 1 day for
the access time. See the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about file time.

B<attribs>: File attributes as returned by the Windows GetFileAttributes ()
function. Use the following constants to retrieve the individual values. See
the L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about the meaning of these values. Import these values into your
L<environment|/MODULE EXPORTS> if you do not want to refer to them with the
C<Win32::LongPath::> prefix.

=over 4

=over 4

=item FILE_ATTRIBUTE_ARCHIVE

=item FILE_ATTRIBUTE_COMPRESSED

=item FILE_ATTRIBUTE_DEVICE

=item FILE_ATTRIBUTE_DIRECTORY

=item FILE_ATTRIBUTE_ENCRYPTED

=item FILE_ATTRIBUTE_HIDDEN

=item FILE_ATTRIBUTE_INTEGRITY_STREAM

=item FILE_ATTRIBUTE_NORMAL

=item FILE_ATTRIBUTE_NOT_CONTENT_INDEXED

=item FILE_ATTRIBUTE_NO_SCRUB_DATA

=item FILE_ATTRIBUTE_OFFLINE

=item FILE_ATTRIBUTE_READONLY

=item FILE_ATTRIBUTE_REPARSE_POINT

=item FILE_ATTRIBUTE_SPARSE_FILE

=item FILE_ATTRIBUTE_SYSTEM

=item FILE_ATTRIBUTE_TEMPORARY

=item FILE_ATTRIBUTE_VIRTUAL

=back

=back

B<ctime>: Although defined to be inode change time in seconds for native
Perl, it will reflect the Windows creation time.

B<dev>: The Windows serial number for the volume. See the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information.

B<gid>: Is always zero.

B<ino>: Is always zero.

B<mode>: File mode (type and permissions). C<use Fcntl ':mode'> can be used
to extract the meaning of the mode. Regardless of the actual user and group
permissions, the following bits are set.

=over 4

=item *

Directories: C<S_IFDIR>, C<S_IRWXU>, C<S_IRWXG> and C<S_IRWXO>

=item *

Files: C<S_IFREG>, C<S_IRUSR>, C<S_IRGRP> and C<S_IROTH>

=item *

Files without read-only attribute: C<S_IWUSR>, C<S_IWGRP> and C<S_IWOTH>

=item *

Files with BAT, CMD, COM and EXE extension: C<S_IXUSR>, C<S_IXGRP>
and C<S_IXOTH>

=back

B<mtime>: Last modify time in seconds. B<NOTE:> Different file systems have
different time resolutions. For example, FAT has a resolution of 2 seconds
for the modification time. See the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about file time.

B<nlink>: Is always one.

B<rdev>: Same as B<dev>.

B<size>: Total size of the file in bytes. Has a value of zero for directories.

B<uid>: Is always zero.

=back

	use Fcntl ':mode';
	use Win32::LongPath qw(:funcs :fileattr);

	# get object
	testL ('e', $file)
	  or die "$file doesn't exist!";
	$stat = statL ($file)
	  or die ("unable to get stat for $file ($^E)");

	# this test for directory
	$stat->{mode} & S_IFDIR ? print "Directory\n" : print "File\n";
	# is the same as this one
	$stat->{attribs} & FILE_ATTRIBUTE_DIRECTORY ? print "Directory\n" : print "File\n";

	# show file times as local time
	printf "Created: %s\nAccessed: %s\nModified: %s\n",
	  scalar localtime $stat->{ctime},
	  scalar localtime $stat->{atime},
	  scalar localtime $stat->{mtime};

=item X<symlinkL>symlinkL OLDFILE,NEWFILE

If the Windows OS, file system and user permissions support it, a symbolic
link is created from B<NEWFILE> to B<OLDFILE>.

B<OLDFILE> can be a relative or full path. If relative path is used, it
will not be converted to an extended-length path.

B<NOTE:> See I<CreateSymbolicLink> in the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about symbolic links.

	symlinkL ('no problem', '問題ない')
	  or die ("unable to link file ($^E)");
	symlinkL ('c:/', 'rootpath')
	  or die ("unable to link file ($^E)");

=item X<sysopenL>sysopenL FILEHANDLEREF,PATH,MODE

Performs the same function as the native Perl sysopen function but only
supports the three-argument form of sysopen.

B<FILEHANDLEREF> cannot be a bareword file handle or a scalar variable.
It must be a reference to a scalar value which will be set to be a Perl
file handle. For example:

	sysopenL (\$fh, $file, O_CREAT | O_EXCL) or die ("unable to open $file: ($^E)");

B<PATH> is the relative or fullpath name of the file.

B<MODE> matches the native definition.

=item X<testL>testL TYPE,PATH

Used to replace the native I<-X> functions. B<TYPE> is the same value as
the I<-X> function. For example:

	# these are equivalent
	die 'unable to read!' if -r $file;
	die 'unable to read!' if testL ('r', $file);

The supported B<TYPE>s and their values are:

=over 4

=item *

B<b>: Block device. Always returns undef.

=item *

B<c>: Character device. Always returns undef.

=item *

B<d>: Directory.

=item *

B<e>: Exists.

=item *

B<f>: Plain file. Returns true if not a directory of Windows offline file.

=item *

B<l>: Link file. Only returns true for junction/mount points and symbolic
links.

=item *

B<o> or B<O>: Owned. Always returns true.

=item *

B<r> or B<R>: Read. Always returns true.

=item *

B<s>: File has nonzero size (returns size in bytes).

=item *

B<w> or B<W>: Read. Returns true if the file does not have the read-only attribute.

=item *

B<x> or B<X>: Read. Returns true if the file has one of the following extensions:
F<bat>, F<cmd>, F<com>, F<exe>.

=item *

B<z>: Zero size.

=back

=item X<unlinkL>unlinkL PATH[,...]

Deletes the list of files. If successful, it returns the number of files
deleted. It will fail if the file has the read-only attribute set. It
returns undef if an error occurs, and the error variable is set to the
value of the last error encountered.

	# if you do this you don't know which failed
	die ("delete of some files failed!") if !unlinkL ($f1, $f2, $f3, $f4);

	# this identifies the failures
	foreach my $file ($f1, $f2, $f3, $f4) {
	  unlinkL ($file) or print "Unable to delete $file ($^E)\n";  
	}

=item X<utimeL>utimeL [ATIME],[MTIME],PATH[,...]

Changes the access and modification times on each file. B<ATIME> and
B<MTIME> are the numeric times from the time () function. If both are
undef then the times will be changed to the current time. If only one
is undef that one will use a time value of zero.

B<PATH> must be the path to a file.

If successful, it returns the number of files changed. It returns undef if
an error occurs, and the error variable is set to the value of the last
error encountered.

B<NOTE:> This function is not supported in Cygwin and will return an error.

B<NOTE:> Different file systems have different time resolutions. For
example, FAT has a resolution of 2 seconds for modification time and
1 day for the access time. See the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about file time.

	# set back 24 hours
	$yesterday = time () - (24 * 60 * 60);
	utimeL ($yesterday, $yesterday, $file)
	  or die ("unable to change time on $file ($^E)");

	# this is the same as the touch command
	utimeL (undef, undef, $file)
	  or die ("unable to change time on $file ($^E)");

=back

=head1 DIRECTORY FUNCTIONS

B<NOTE:> Although extended-length paths are used, the Microsoft
specification still limits the directory component to MAX_PATH (about
255) characters.

=over 4

=item X<chdirL>chdirL PATH

Changes the working directory. If B<PATH> is missing it tries to change to
C<$ENV{HOME}> if it is set, or C<$ENV{LOGDIR}> if that is set. If neither is
set then it will do nothing and return.

Unlike other functions, the B<PATH> cannot exceed MAX_PATH characters,
although it can contain Unicode and be in the extended-path format.

	chdirL ($path)
	  or die ("unable to change to $path ($^E)");

=item X<getcwdL>getcwdL

Returns the fullpath of the current working directory. This does not replace
a native Perl function since none exists. It works like the curdir function
in L<File::Spec>.

	print "The current directory is: ", getcwdL (), "\n";

=item X<mkdirL>mkdirL PATH

Creates a directory which inherits the permissions of the parent. If B<PATH>
is not provided, $_ is used. An error is returned if the parent directory
does not exist.

	mkdirL ($dir)
	  or die ("unable to create $dir ($^E)");

=item X<rmdirL>rmdirL PATH

Deletes a directory. If B<PATH> is not provided, $_ is used. An error is
returned if the directory is not empty.

	rmdirL ($dir)
	  or die ("unable to delete $dir ($^E)");

=back

=head1 OPENDIR FUNCTIONS

Unlike the L</openL> function which returns a native handle, the open
directory functions must create a directory object and then use that
object to manipulate the directory. The native Perl rewinddir, seekdir
and telldir functions are not supported.

=over 4

=item new

Creates a directory object.

	$dir = Win32::LongPath->new ();

=item X<closedirL>closedirL

Closes the current directory for reading.

	$dir->closedirL ();

=item X<opendirL>opendirL PATH

Opens a directory for reading. If the directory object is already open the
existing directory will be closed before opening the new one.

	my $path = 'c:/rootdir/very long directory name/First Level';
	$dir->opendirL ($path)
	  or die ("unable to open $path ($^E)");

=item X<readdirL>readdirL

Reads the next item in the directory. In list context returns all the items
as a list. Otherwise returns the next item or undef if there are no more
items or an error occurred.

B<NOTE>: Only the item name is returned, not the whole path to the item.

	use Win32::LongPath qw(:funcs :fileattr);

	# search down the whole tree
	search_tree ($rootdir);
	exit 0;

	sub search_tree {

	# open directory and read contents
	my $path = shift;
	my $dir = Win32::LongPath->new ();
	$dir->opendirL ($path)
	  or die ("unable to open $path ($^E)");
	foreach my $file ($dir->readdirL ()) {
	  # skip parent dir
	  if ($file eq '..'){
	    { next; }

	  # get file stats
	  my $name = $file eq '.' ? $path : "$path/$file";
	  my $stat = lstatL ($name)
	    or die "unable to stat $name ($^E)";

	  # recurse if dir
	  if (($file ne '.') && (($stat->{attribs}
	    & (FILE_ATTRIBUTE_DIRECTORY | FILE_ATTRIBUTE_REPARSE_POINT))
	    == FILE_ATTRIBUTE_DIRECTORY)) {
	    search_tree ($name);
	    next;
	  }

	  # output stats
	  print "$name\t$stat->{attribs}\t$stat->{size}\t",
	    scalar localtime $stat->{ctime}, "\t",
	    scalar localtime $stat->{mtime}, "\n";
	}
	$dir->closedirL ();
	return;
	}

=back

=head1 MISCELLANEOUS FUNCTIONS

The following functions are not native Perl functions but are useful
when working with Windows.

=over 4

=item X<abspathL>abspathL PATH

Returns the absolute (fullpath) for B<PATH>. If the path exists, it will
replace the components with WindowsE<apos> long path names. Otherwise, it
returns a path that may contain short path names.

	$short = '../SYSTEM~2.PPT';
	$long = abspathL ($short);
	print "$short = $long\n";
	# if it exists it could print something like
	# ../SYSTEM~2.PPT = c:\rootdir\subdir\System File.ppt
	# if not, it might print
	# ../SYSTEM~2.PPT = c:\rootdir\subdir\SYSTEM~2.PPT

	# probably not the same because TMP is short path
	chdirL ($ENV {TMP}) or die "unable to change to TMP dir!";
	$curdir = getcwdL ();
	if (abspathL ($curdir) ne $curdir) {
	  print "not the same!\n";
	}

=item X<attribL>attribL ATTRIBS,PATH

Sets file attributes like the DOS attrib command.

B<ATTRIBS> is a string that identifies the attributes to enable or
disable. A plus sign (+) enables and a minus sign (-) disables the
attributes that follow. If not provided, a plus sign is assumed.

The attributes are identified by letters which can be upper or
lower case. The letters and their values are:

=over 4

=item *

B<H>: Hidden.

=item *

B<I>: Not content indexed. This value may not be valid for all file
systems.

=item *

B<R>: Read-only.

=item *

B<S>: System.

=back

	# sets System and hidden but disables read-only
	# could also be '-r+sh', 's-r+h', '+hs-r', etc.
	attribL ('sh-r', $file)
	  or die "unable to set attributes for $file ($^E)";

=item X<copyL>copyL FROM,TO

Copies the B<FROM> file to the B<TO> file. If the file exists it is
overwritten unless it is hidden or read-only. If it does not exist it
inherits the permissions of the parent directory. File attributes are
copied with the file. If the B<FROM> file is a symbolic link the target
is copied and not the symbolic link. If the B<TO> file is a symbolic
link the target is overwritten.

	copyL ($from, $to)
	  or die "unable to copy $from to $to ($^E)";

=item X<shortpathL>shortpathL PATH

Returns the short path of the file. It returns a blank string if it is
unable to get the short path.

	if (shortpathL ($file) eq '') {
	  or die "unable to get shortpath for $file";
	}

=item X<volinfoL>volinfoL PATH

Returns an object with the volume information for the B<PATH>. B<PATH>
can be a relative or fullpath to any object on the volume. The object
elements are:

=over 4

B<maxlen>: The maximum length of path components (the characters between
the backslashes; usually directory names).

B<name>: The name of the volume.

B<serial>: The Windows serial number for the volume.

B<sysflags>: System flags. Indicates the features that are supported by
the file system. Use the following constants to retrieve the individual
values. Import these values into your L<environment|/MODULE EXPORTS> if
you do not want to refer to them with the C<Win32::LongPath::> prefix.

=over 4

=over 4

=item FILE_CASE_PRESERVED_NAMES

=item FILE_CASE_SENSITIVE_SEARCH

=item FILE_FILE_COMPRESSION

=item FILE_NAMED_STREAMS

=item FILE_PERSISTENT_ACLS

=item FILE_READ_ONLY_VOLUME

=item FILE_SEQUENTIAL_WRITE_ONCE

=item FILE_SUPPORTS_ENCRYPTION

=item FILE_SUPPORTS_EXTENDED_ATTRIBUTES

=item FILE_SUPPORTS_HARD_LINKS

=item FILE_SUPPORTS_OBJECT_IDS

=item FILE_SUPPORTS_OPEN_BY_FILE_ID

=item FILE_SUPPORTS_REPARSE_POINTS

=item FILE_SUPPORTS_SPARSE_FILES

=item FILE_SUPPORTS_TRANSACTIONS

=item FILE_SUPPORTS_USN_JOURNAL

=item FILE_UNICODE_ON_DISK

=item FILE_VOLUME_IS_COMPRESSED

=item FILE_VOLUME_QUOTAS

=back

=back

=back

B<NOTE:> See the
L<Microsoft MSDN Library|http://msdn.microsoft.com/library> for more
information about this feature.

	use Win32::LongPath qw(:funcs :volflags);

	$vol = volinfoL ($file)
	  or die "unable to get volinfo for $file";
	if (!($vol->{sysflags} & FILE_SUPPORTS_REPARSE_POINTS)) {
	  die "symbolic links will not work on $vol->{name}!";
	}

=back

=head1 MODULE EXPORTS

All functions are automatically exported by default. The following tags
export specific values:

=over 4

=item *

B<:all>: all values

=item *

B<:funcs>: all functions

=item *

B<:fileattr>: file attributes used by the L</statL> and L</lstatL> functions

=item *

B<:volflags>: system flags used by the L</volinfoL> function

=back

=head1 LIMITATIONS

This module was developed for the Microsoft WinXP and greater environment.
It also supports the Cygwin environment.

=head1 AUTHOR

Robert Boisvert <rdbprog@gmail.com>

=head1 CREDITS

Many thanks to Jan Dubois for getting Windows support started with
L<Win32>. It remains the number one module in use on almost every
Windows installation of Perl.

A big thank you (どうもありがとうございました) to Yuji Shimada for L<Win32::Unicode>.
The concepts used there are the basis for much of Win32::LongPath.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.