<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Win32::Unicode::File;

use strict;
use warnings;
use 5.008003;
use Carp qw(croak);
use File::Basename qw(basename);
use Scalar::Util qw(blessed);
use Exporter 'import';

use Win32::Unicode::Util;
use Win32::Unicode::Error;
use Win32::Unicode::Constant;
use Win32::Unicode::Console;
use Win32::Unicode::XS;
use Fcntl qw(:seek);

our @EXPORT = qw/file_type file_size copyW moveW unlinkW touchW renameW statW utimeW/;
our @EXPORT_OK = qw/filename_normalize slurp/;
our %EXPORT_TAGS = ('all' =&gt; [@EXPORT, @EXPORT_OK]);

our $VERSION = '0.38';

my %FILE_TYPE_ATTRIBUTES = (
    s =&gt; FILE_ATTRIBUTE_SYSTEM,
    r =&gt; FILE_ATTRIBUTE_READONLY,
    h =&gt; FILE_ATTRIBUTE_HIDDEN,
    d =&gt; FILE_ATTRIBUTE_DIRECTORY,
    a =&gt; FILE_ATTRIBUTE_ARCHIVE,
    n =&gt; FILE_ATTRIBUTE_NORMAL,
    t =&gt; FILE_ATTRIBUTE_TEMPORARY,
    c =&gt; FILE_ATTRIBUTE_COMPRESSED,
    o =&gt; FILE_ATTRIBUTE_OFFLINE,
    i =&gt; FILE_ATTRIBUTE_NOT_CONTENT_INDEXED,
    E =&gt; FILE_ATTRIBUTE_ENCRYPTED,
);

sub new {
    my $class = shift;
    $class = ref $class || $class;

    my $self = bless \do { local *FH }, $class;
    tie *$self, $class, $self;

    $self-&gt;open(@_) or return if @_;
    return $self;
}

sub open {
    my ($self, $attr, $file) = @_;
    croak('Usage: $wfh-&gt;open($attrebute, $filename)') unless defined $attr &amp;&amp; defined $file;

    $file = cygpathw($file) or return if CYGWIN;
    my $utf16_file = utf8_to_utf16(catfile $file) . NULL;

    if ($attr =~ s/(:.*)$//) {
        $self-&gt;binmode($1);
    }

    my $handle = 
        $attr eq '&lt;' || $attr eq 'r' || $attr eq 'rb' ? _create_file(
            $utf16_file,
            GENERIC_READ,
            OPEN_EXISTING,
        ) :
        $attr eq '&gt;' || $attr eq 'w' || $attr eq 'wb' ? _create_file(
            $utf16_file,
            GENERIC_WRITE,
            CREATE_ALWAYS,
        ) :
        $attr eq '&gt;&gt;' || $attr eq 'a' ? _create_file(
            $utf16_file,
            GENERIC_WRITE,
            OPEN_ALWAYS,
        ) :
        $attr eq '+&lt;' || $attr eq 'r+' ? _create_file(
            $utf16_file,
            GENERIC_READ | GENERIC_WRITE,
            OPEN_EXISTING,
        ) :
        $attr eq '+&gt;' || $attr eq 'w+' ? _create_file(
            $utf16_file,
            GENERIC_READ | GENERIC_WRITE,
            CREATE_ALWAYS,
        ) :
        $attr eq '+&gt;&gt;' || $attr eq 'a+' ? _create_file(
            $utf16_file,
            GENERIC_READ | GENERIC_WRITE,
            OPEN_ALWAYS,
        ) :
        croak("'$attr' is unkown attribute")
    or return Win32::Unicode::Error::_set_errno;

    return Win32::Unicode::Error::_set_errno if $handle == INVALID_VALUE;

    *$self-&gt;{_handle} = $handle;
    $self-&gt;binmode if $attr eq 'rb' or $attr eq 'wb';

    $self-&gt;seek(0, 2) if $attr eq '&gt;&gt;' || $attr eq 'a' || $attr eq '+&gt;&gt;' || $attr eq 'a+';

    require Win32::Unicode::Dir;
    *$self-&gt;{_file_path} = File::Spec-&gt;rel2abs($file, Win32::Unicode::Dir::getcwdW());
    *$self-&gt;{_authflush} = 0;

    return $self;
}

sub _create_file {
    my $file = shift;
    my $type = shift;
    my $disp = shift;

    return create_file(
        $file,
        $type,
        FILE_SHARE_READ | FILE_SHARE_WRITE,
        $disp,
        FILE_ATTRIBUTE_NORMAL,
    );
}

sub close {
    my $self = shift;
    if (exists *$self-&gt;{_handle}) {
        close_handle(*$self-&gt;{_handle}) or return Win32::Unicode::Error::_set_errno;
        delete *$self-&gt;{_handle};
    }
    return 1;
}

sub fileno {
    my $self = shift;
    return *$self-&gt;{_handle};
}

sub getc {
    my $self = shift;
    $self-&gt;read(my $buf, 1);
    return $buf;
}

sub read {
    my $self   = shift;
    my $into   = \$_[0]; shift;
    my $len    = shift;
    my $offset = shift || 0;

    my ($bytes_read_num, $data) = win32_read_file(*$self-&gt;{_handle}, $len);
    return Win32::Unicode::Error::_set_errno if $bytes_read_num == -1;

    if ($offset &gt; 0) {
        substr($$into, $offset) = $data if length($$into) &gt;= $offset;
    }
    elsif ($offset &lt; 0) {
        croak('Offset outside string') if length($$into) + $offset &lt; 0;
        substr($$into, $offset) = $data;
    }
    else {
        $$into = $data;
    }

    if (*$self-&gt;{_encode} &amp;&amp; length $$into) {
        $$into = *$self-&gt;{_encode}-&gt;decode($$into);
    }

    return $bytes_read_num;
}
*sysread = *read;

sub _readline {
    my $self = shift;

    my $encoder;
    if (*$self-&gt;{_encode}) {
        $encoder = *$self-&gt;{_encode};
        delete *$self-&gt;{_encode};
    }

    my $line = '';
    while (index($line, $/) == $[ -1) {
        my $char = $self-&gt;getc;
        last if not defined $char or $char eq '';
        $line .= $char;
    }

    $line =~ s/\015\012/\n/ unless *$self-&gt;{_binmode};

    if ($encoder) {
        $line = $encoder-&gt;decode($line);
        *$self-&gt;{_encode} = $encoder;
    }

    return $line eq '' ? () : $line;
};

sub readline {
    my $self = shift;

    if (wantarray) {
        my @lines;
        while (my $line = $self-&gt;_readline) {
            push @lines, $line;
        }
        return @lines;
    }
    else {
        return $self-&gt;_readline;
    }
}

# no fearture 'say' or $wfh-&gt;say(@_);
sub say {
    my $self = shift;
    local $\ = "\n";
    $self-&gt;print(@_);
}

sub print {
    my $self = shift;
    my $buff = join defined $, ? $, : '', @_;
    $buff .= $\ if defined $\; # maybe use feature 'say'
    $self-&gt;write($buff);
}

sub printf {
    my $self = shift;
    my $format = shift;
    $self-&gt;write(sprintf $format, @_);
}

sub write {
    @_ = ($_[0], $_[1]);
    goto &amp;syswrite;
}

sub syswrite {
    return 0 if @_ &gt; 2 &amp;&amp; !$_[2];
    my ($self, $buff, $len, $offset) = @_;

    $buff =~ s/\r?\n/\r\n/g unless *$self-&gt;{_binmode};
    $buff = *$self-&gt;{_encode}-&gt;encode($buff) if *$self-&gt;{_encode};

    use bytes;

    $buff = substr $buff, $offset if $offset;
    unless (defined $len) {
        $len = length $buff;
    }
    elsif ((my $buff_len = length $buff) &lt; $len) {
        $len = $buff_len;
    }

    croak('got negative length on syswrite()') if $len &lt; 0;

    my $write_size = win32_write_file(*$self-&gt;{_handle}, $buff, $len);
    return Win32::Unicode::Error::_set_errno if $write_size == -1;

    if (*$self-&gt;{_autoflush}) {
        $self-&gt;flush or return;
    }

    return $write_size;
}

sub seek {
    my $self = shift;
    my $low = shift;
    my $whence = shift;

    my $result;
    if (is64int($low)) {
        my ($pos_low, $pos_high);
        if ($low &gt; 0) {
            $pos_low  = $low % _32INT;
            $pos_high = $low / _32INT;
        }
        else {
            $pos_low  = $low % _S32INT;
            $pos_high = $low / _S32INT;
        }
        my $st = set_file_pointer(*$self-&gt;{_handle}, $pos_low, $pos_high, $whence) or return Win32::Unicode::Error::_set_errno;
        return $st-&gt;{high} ? to64int($st-&gt;{high}, $st-&gt;{low}) : $st-&gt;{low};
    }
    else {
        my $high = 0;
        $high = ~0 if $low &lt; 0;
        my $st = set_file_pointer(*$self-&gt;{_handle}, $low, $high, $whence) or return Win32::Unicode::Error::_set_errno;
        return $st-&gt;{high} ? to64int($st-&gt;{high}, $st-&gt;{low}) : $st-&gt;{low};
    }
}
*sysseek = *seek;

sub tell {
    $_[0]-&gt;seek(0, SEEK_CUR);
}

sub flock {
    my $self = shift;
    $self = tied(*$self);
    my $ope = shift;

    croak('Usage: flock $fh, $operation') unless defined $ope;

    return unlock_file(*$self-&gt;{_handle}) if $ope == 8;

    my $result = lock_file(*$self-&gt;{_handle}, $ope);
    unless (defined $result) {
        require Errno;
        $! = Errno::EINVAL();
        return;
    }

    return $result;
}
*flockW = \&amp;flock;

sub unlock {
    shift-&gt;flock(8);
}

sub slurp {
    my $self = shift;
    croak 'Usage: slurp(filename) or $fh-&gt;slurp()' unless defined $self;

    my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
    my $wantarray = wantarray;

    unless (ref $self) {
        my $fh = __PACKAGE__-&gt;new(r =&gt; $self) or croak "Can't read '$self': $!";
        return $fh-&gt;slurp($opts);
    }

    my $org_data = {
        pos     =&gt; $self-&gt;tell,
        binmode =&gt; *$self-&gt;{_binmode},
        encode  =&gt; *$self-&gt;{_encode},
    };

    if (exists $opts-&gt;{binmode}) {
        $self-&gt;binmode($opts-&gt;{binmode});
    }

    my $buf_ref = $opts-&gt;{buf_ref} || \my $buf;
    $$buf_ref   = '';

    my $file_size = $self-&gt;file_size;
    unless ($file_size) {
        return
            $opts-&gt;{scalar_ref} ? $buf_ref :
            $opts-&gt;{array_ref}  ? []       :
            $wantarray          ? ()       : '';
    }

    $self-&gt;seek(0, SEEK_SET);
    my $blk_size  = $opts-&gt;{blk_size} || 1024 * 1024;
    if ($file_size &lt;= $blk_size) {
        $self-&gt;read($$buf_ref, $blk_size);
    }
    else {
        1 while $self-&gt;read($$buf_ref, $blk_size, length $$buf_ref);
    }
    $self-&gt;seek($org_data-&gt;{pos}, SEEK_SET);

    $$buf_ref =~ s/\015\012/\n/g unless *$self-&gt;{_binmode};

    *$self-&gt;{_binmode} = $org_data-&gt;{binmode};
    *$self-&gt;{_encode}  = $org_data-&gt;{encode};

    if ($wantarray || $opts-&gt;{array_ref}) {
        my $sep = $/;
        $sep = '\n\n+' if defined $sep &amp;&amp; $sep eq '';

        my @lines = length $$buf_ref ? $$buf_ref =~ /(.*?$sep|.+)/sg : ();
        chomp @lines if $opts-&gt;{chomp};

        return \@lines if $opts-&gt;{array_ref};
        return @lines;
    }

    return $buf_ref if $opts-&gt;{scalar_ref};
    return $$buf_ref if defined $wantarray;
    return;
}
*readfile = *slurp;

sub write_file {
    my $self = shift;

    if (!ref $self) {
        my $fh = __PACKAGE__-&gt;new(w =&gt; $self) or croak("$self: $!");
        return $fh-&gt;print(@_);
    }

    return $self-&gt;print(@_);
}

sub binmode {
    my $self = shift;
    my $layer = shift;

    if (not defined $layer or $layer eq 1) {
        *$self-&gt;{_binmode} = 1;
        return 1;
    }

    if (defined $layer) {
        if ($layer =~ /:raw/) {
            *$self-&gt;{_binmode} = 1;
        }

        if ($layer =~ /:(utf-?8)/i or $layer =~ /:encoding\(([^\)]+)\)/) {
            *$self-&gt;{_encode} = Encode::find_encoding($1);
        }

        croak("Unknown layer $layer") unless *$self-&gt;{_binmode} or *$self-&gt;{_encode}
    }

    return 1;
}

sub eof {
    my $self = shift;

    my $current = $self-&gt;TELL() + 0;
    my $end     = file_size($self) + 0;

    return $current == $end;
}

sub file_path {
    my $self = shift;
    return *$self-&gt;{_file_path} unless @_;
    *$self-&gt;{_file_path} = shift;
}
*path = \&amp;file_path;

sub statW {
    my $file = shift;
    croak('Usage: statW(filename)') unless defined $file;
    my $wantarray = wantarray;
    my $blessed = blessed $file;

    my $fi;
    if ($blessed &amp;&amp; $file-&gt;isa('Win32::Unicode::File') &amp;&amp; *$file-&gt;{_handle}) {
        my $fh = *$file;
        my $file_path = CYGWIN ? Encode::encode_utf8($fh-&gt;{_file_path}) : utf8_to_utf16($fh-&gt;{_file_path}) . NULL;
        $fi = get_stat_data($file_path, $fh-&gt;{_handle}, 0) or return Win32::Unicode::Error::_set_errno;
    }
    elsif ($blessed &amp;&amp; $file-&gt;isa('Win32::Unicode::Dir') &amp;&amp; $file-&gt;{handle}) {
        my $dir_path = CYGWIN ? Encode::encode_utf8($file-&gt;{dir}) : utf8_to_utf16($file-&gt;{dir}) . NULL;
        $fi = get_stat_data($dir_path, $file-&gt;{handle}, 1) or return Win32::Unicode::Error::_set_errno;
    }
    else {
        $file = cygpathw($file) or return if CYGWIN;
        $file = catfile $file;

        my ($handle, $wdir);
        if (file_type(d =&gt; $file)) {
            require Win32::Unicode::Dir;
            $wdir = Win32::Unicode::Dir-&gt;new-&gt;open($file);
            $handle = $wdir-&gt;{handle};
        }
        else {
            $handle = create_file(
                utf8_to_utf16($file) . NULL,
                GENERIC_READ,
                FILE_SHARE_READ,
                OPEN_EXISTING,
                FILE_ATTRIBUTE_NORMAL,
            );
        }
        return Win32::Unicode::Error::_set_errno if $handle == INVALID_VALUE;
        $file = CYGWIN ? Encode::encode_utf8($file) : utf8_to_utf16($file) . NULL;
        $fi = get_stat_data($file, $handle, $wdir ? 1 : 0) or return Win32::Unicode::Error::_set_errno;
        if ($wdir) {
            $wdir-&gt;close or return Win32::Unicode::Error::_set_errno;
        }
        else {
            close_handle($handle) or return Win32::Unicode::Error::_set_errno;
        }
    }

    my $result = $fi;
    unless (CYGWIN) {
        $result-&gt;{blksize} = '';
        $result-&gt;{blocks}  = '';
    }
    $result-&gt;{size} = $fi-&gt;{size_high} ? to64int($fi-&gt;{size_high}, $fi-&gt;{size_low}) : $fi-&gt;{size_low};
    delete $result-&gt;{size_high};
    delete $result-&gt;{size_low};

    return $wantarray ? (
        $result-&gt;{dev},     #  0 dev      device number of filesystem
        $result-&gt;{ino},     #  1 ino      inode number
        $result-&gt;{mode},    #  2 mode     file mode  (type and permissions)
        $result-&gt;{nlink},   #  3 nlink    number of (hard) links to the file
        $result-&gt;{uid},     #  4 uid      numeric user ID of file's owner
        $result-&gt;{gid},     #  5 gid      numeric group ID of file's owner
        $result-&gt;{rdev},    #  6 rdev     the device identifier (special files only)
        $result-&gt;{size},    #  7 size     total size of file, in bytes
        $result-&gt;{atime},   #  8 atime    last access time in seconds since the epoch
        $result-&gt;{mtime},   #  9 mtime    last modify time in seconds since the epoch
        $result-&gt;{ctime},   # 10 ctime    inode change time in seconds since the epoch (*)
        $result-&gt;{blksize}, # 11 blksize  preferred block size for file system I/O
        $result-&gt;{blocks},  # 12 blocks   actual number of blocks allocated
    ) : $result;
}

sub utimeW {
    my ($atime, $mtime, @files) = @_;
    $atime = $mtime = time if !defined $atime &amp;&amp; !defined $mtime;
    my $ret = 0;
    for my $file (@files) {
        $file = *$file-&gt;{_file_path} if blessed($file) &amp;&amp; $file-&gt;isa('Win32::Unicode::File') &amp;&amp; *$file-&gt;{_handle};
        $file = cygpathw($file) or return if CYGWIN;
        $file = catfile $file;
        my $file_path = CYGWIN ? Encode::encode_utf8($file) : utf8_to_utf16($file) . NULL;
        ++$ret if update_time($atime, $mtime, $file_path);
    }
    return $ret;
}

sub file_type {
    croak('Usage: type(attribute, file_or_dir_name)') unless @_ == 2;
    my $attr = shift;
    my $file = shift;
    $file = cygpathw($file) or return if CYGWIN;
    $file = catfile $file;

    my $get_attr = _get_file_type($file);
    return unless defined $get_attr;
    for (split //, $attr) {
        if ($_ eq 'e') {
            next;
        }

        if ($_ eq 'f') {
            return if $get_attr &amp; $FILE_TYPE_ATTRIBUTES{d};
            next;
        }

        unless (defined $FILE_TYPE_ATTRIBUTES{$_}) {
            Carp::carp "unkown attribute '$_'";
            next;
        }
        return unless $get_attr &amp; $FILE_TYPE_ATTRIBUTES{$_};
    }
    return 1;
}

sub file_size {
    my $file = shift;
    croak('Usage: file_size(filename)') unless defined $file;

    if (ref $file eq __PACKAGE__) {
        my $self = "$file" =~ /GLOB/ ? tied *$file : $file;
        my $st = get_file_size(*$self-&gt;{_handle}) or return Win32::Unicode::Error::_set_errno;
        return $st-&gt;{high} ? to64int($st-&gt;{high}, $st-&gt;{low}) : $st-&gt;{low};
    }

    $file = cygpathw($file) or return if CYGWIN;
    $file = catfile $file;

    return unless file_type(f =&gt; $file);

    my $handle = create_file(
        utf8_to_utf16($file) . NULL,
        GENERIC_READ,
        FILE_SHARE_READ,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
    );
    return Win32::Unicode::Error::_set_errno if $handle == INVALID_VALUE;

    my $st = get_file_size($handle) or return Win32::Unicode::Error::_set_errno;
    close_handle($handle) or return Win32::Unicode::Error::_set_errno;

    return $st-&gt;{high} ? to64int($st-&gt;{high}, $st-&gt;{low}) : $st-&gt;{low};
}

# like unix touch command
sub touchW {
    my @files = @_ ? @_ : ($_);
    my $count = 0;
    for my $file (@files) {
        $file = cygpathw($file) or next if CYGWIN;
        my $utf16_file = utf8_to_utf16(catfile $file) . NULL;
        my $handle = _create_file($utf16_file, GENERIC_WRITE, CREATE_NEW) or next;
        $count++;
        close_handle($handle);
    }
    Win32::Unicode::Error::_set_errno unless $count;
    return $count;
}

# like CORE::unlink
sub unlinkW {
    my @files = @_ ? @_ : ($_);
    my $count = 0;
    for my $file (@files) {
        $file = cygpathw($file) or return if CYGWIN;
        $file = utf8_to_utf16(catfile $file) . NULL;
        $count += delete_file($file) ? 1 : 0;
    }
    Win32::Unicode::Error::_set_errno unless $count;
    return $count;
}

# like File::Copy::copy
sub copyW {
    croak('Usage: copyW(from, to [, over])') if @_ &lt; 2;
    my ($from, $to) = _file_name_validete(shift, shift);
    my $over = shift || 0;

    $from = cygpathw($from) or return if CYGWIN;
    $to   = cygpathw($to)   or return if CYGWIN;

    $from = utf8_to_utf16($from) . NULL;
    $to   = utf8_to_utf16($to) . NULL;

    return copy_file($from, $to, !$over) ? 1 : Win32::Unicode::Error::_set_errno;
}

# move file
sub moveW {
    croak('Usage: moveW(from, to [, over])') if @_ &lt; 2;
    my ($from, $to) = _file_name_validete(shift, shift);
    my $over = shift || 0;

    unless (move_file(utf8_to_utf16($from) . NULL, utf8_to_utf16($to) . NULL)) {
        return unless copyW($from, $to, $over);
        return unless unlinkW($from);
    };

    return 1;
}
*renameW = \&amp;moveW;

my $back_to_dir = qr/^\.\.$/;
my $in_dir      = qr#[\\/]$#;

sub _file_name_validete {
    croak('from is a undefined values') unless defined $_[0];
    croak('to is a undefined values')   unless defined $_[1];

    my $from = catfile shift;
    my $to = shift;

    if ($to =~ $back_to_dir or $to =~ $in_dir or (CYGWIN ? file_type(d =&gt; cygpathw($to)) : file_type(d =&gt; $to))) {
        $to = catfile $to, basename($from);
    }
    $to = catfile $to;

    return $from, $to;
}

my %win32_taboo = (
    '\\' =&gt; "\x{ffe5}", # ï¿¥
    '/'  =&gt; "\x{ff0f}", # ï¼
    ':'  =&gt; "\x{ff1a}", # ï¼š
    '*'  =&gt; "\x{ff0a}", # ï¼Š
    '?'  =&gt; "\x{ff1f}", # ï¼Ÿ
    '"'  =&gt; "\x{2033}", # â€³
    '&lt;'  =&gt; "\x{ff1c}", # ï¼œ
    '&gt;'  =&gt; "\x{ff1e}", # ï¼ž
    '|'  =&gt; "\x{ff5c}", # ï½œ
);

sub filename_normalize {
    my $file_name = shift;
    croak('Usage: filename_nomalize($file_name)') unless defined $file_name;
    $file_name =~ s#([\\\/\:\*\?\"\&lt;\&gt;|])#$win32_taboo{$1}#ge;
    return $file_name;
}

sub error {
    return errorW;
}

sub _get_file_type {
    my $file = shift;
    $file = utf8_to_utf16($file) . NULL;
    my $result = get_file_attributes($file);
    if (defined $result &amp;&amp; $result == INVALID_VALUE) {
        return Win32::Unicode::Error::_set_errno;
    }
    return $result;
}

# Tie Handle
sub TIEHANDLE {
    defined $_[1] &amp;&amp; UNIVERSAL::isa($_[1], __PACKAGE__) ? $_[1] : shift-&gt;new(@_);
}
sub OPEN     { shift-&gt;open(@_)    }
sub CLOSE    { shift-&gt;close       }
sub BINMODE  { shift-&gt;binmode(@_) }
sub PRINT    { shift-&gt;print(@_)   }
sub PRINTF   { shift-&gt;printf(@_)  }
sub WRITE    { shift-&gt;write(@_)   }
sub READ     { shift-&gt;read(@_)    }
sub READLINE { shift-&gt;readline    }
sub GETC     { shift-&gt;getc        }
sub SEEK     { shift-&gt;seek(@_)    }
sub TELL     { shift-&gt;tell        }
sub EOF      { shift-&gt;eof         }
sub FILENO   { shift-&gt;fileno      }
sub DESTROY  { shift-&gt;close       }

# IO::File compatibles
sub flush {
    my $self = shift;
    win32_flush_file_buffers(*$self-&gt;{_handle});
}

sub sync {
    croak('sync not implemented');
}

sub autoflush {
    my $self = shift;
    my $prev = *$self-&gt;{_autoflush};
    *$self-&gt;{_autoflush} = @_ &gt; 0 ? $_[0] : 1;
    return $prev;
}

sub printflush {
    my $self = shift;
    $self-&gt;print(@_) &amp;&amp; $self-&gt;flush;
}

sub getline  {
    croak('Usage: $fh-&gt;getline()') unless @_ == 1;
    scalar shift-&gt;readline;
}

sub getlines {
    croak('Usage: $fh-&gt;getlines()') unless @_ == 1;
    croak(q|Can't call $fh-&gt;getlines in a scalar context, use $fh-&gt;getline|)
        unless wantarray;
    shift-&gt;readline;
}

sub getpos {
    croak('Usage: $fh-&gt;getpos()') unless @_ == 1;
    my $pos = shift-&gt;tell;
    return $pos == -1 ? undef : $pos; ## no critic
}

sub setpos {
    croak('Usage: $fh-&gt;setpos($pos)') unless @_ == 2;
    my ($self, $pos) = @_;
    $self-&gt;seek($pos, 0);
    return $pos == -1 ? undef : $pos; ## no critic
}

sub opened {
    my $self = shift;
    return exists *$self-&gt;{_handle} ? 1 : 0;
}

1;
__END__
=head1 NAME

Win32::Unicode::File - Unicode string file utility.

=head1 SYNOPSIS

  use Win32::Unicode::File;

  my $file = "I \x{2665} Perl";

  unlinkW $file or die $!;
  copyW $from, $to or die $!;
  moveW $from, $to or die $!;
  file_type f =&gt; $file ? "$file is file" : "$file is not file";
  my $size = file_size $file;
  touchW $new_file;

=head1 DESCRIPTION

Win32::Unicode::File is Unicode string file utility.

=head1 METHODS

=over

=item B&lt;new([$mode, $file_name])&gt;

Crate a new Win32::Unicode::File instance. At the same time you can open the file to create an instance.

  my $fh = Win32::Unicode::File-&gt;new;
  my $fh = Win32::Unicode::File-&gt;new($mode, $file_name); # create an instance and open the file

=item B&lt;open($mode, $file_name)&gt;

like CORE::open, but compatibility is not an argument. can not be pipe open.

  $fh-&gt;open('&lt;', $file_name) or die $!;

or

  open $fh, '&lt;', $file_name or die $!;

Be useful mode

  &lt;   = r   = rb
  &gt;   = w   = wb
  &gt;&gt;  = a
  +&lt;  = r+
  +&gt;  = w+
  +&gt;&gt; = a+

=item B&lt;close()&gt;

like CORE::close.

  $fh-&gt;close;

or

  close $fh;

=item B&lt;read($buff, $len)&gt;

Like CORE::read.

  $fh-&gt;read(my $buff, $len) or die $!;

or

  read $fh, my $buff, $len;

=item B&lt;readline()&gt;

Like CORE::readline.

  my $line = $fh-&gt;readline;
  my @line = $fh-&gt;readline;

or
  my $line = readline $fh;
  my @line = &lt;$fh&gt;;

=item B&lt;getc()&gt;

Like CORE::getc.

  my $char = $fh-&gt;getc;

or

  my $char = getc $fh;

=item B&lt;print(@str)&gt;

Data write to file.

  $fh-&gt;print(@str);
  print $fh @str;

=item B&lt;printf($format, @str)&gt;

Formatted data write to file.

  $fh-&gt;printf('[%s]', $str);
  printf $fh '%d', $str;

=item B&lt;write(@str)&gt;

Data write to file. alias of $fh-&gt;print

  $fh-&gt;write(@str);

=item B&lt;seek($ofset, $whence)&gt;

Like CORE::seek.

  $fh-&gt;seek(10, 1);

or

  seek $fh, 1024, 2;

=item B&lt;tell()&gt;

Like CORE::tell.

  my $current = $fh-&gt;tell;

or

  my $current = tell $fh;

=item B&lt;eof()&gt;

Like CORE::eof.

  if ($fh-&gt;eof) {
     # ...snip
  }

or

  if (eof $fh) {
     # ...snip
  }

=item B&lt;slurp()&gt;

Read all data from the file.

  my $data = $fh-&gt;slurp;

=item B&lt;binmode($layer)&gt;

  $fh-&gt;binmode(':encoding(cp932)')

or

  binmode $fh, ':raw :utf8';

Currently available now is only the layer below.

  :raw
  :utf8
  :encoding(foo)

=item B&lt;flock($operation)&gt;

Like CORE::flock

  $fh-&gt;flock(2);

=item B&lt;unlock()&gt;

equals to

  $fh-&gt;flock(8);

=item B&lt;error()&gt;

get error message.

  $fh-&gt;error;

=item B&lt;flush&gt;

flush buffers.

  $fh-&gt;flush;

=item B&lt;autoflush()&gt;

enable or dsabile autoflush.

  $fh-&gt;autoflush;    # enable
  $fh-&gt;autoflush(0); # disable
  $fh-&gt;autoflush(1); # enable

=item B&lt;printflush()&gt;

write after flush.

  $fh-&gt;printflush('foobar');

same as

  $fh-&gt;print('foobar') &amp;&amp; $fh-&gt;flush;

=item B&lt;getline()&gt;

Like C&lt;&lt; IO::File::getline &gt;&gt;.

  my $line = $fh-&gt;getline;

=item B&lt;getlines()&gt;

Like C&lt;&lt; IO::File::getlines &gt;&gt;.

  my @$lines = $fh-&gt;getlines;

=item B&lt;getpos()&gt;

Like C&lt;&lt; IO::File::getpos &gt;&gt;.

  my $pos = $fh-&gt;getpos;

=item B&lt;setpos($pos)&gt;

Like C&lt;&lt; IO::File::setpos &gt;&gt;.

  my $pos = $fh-&gt;setpos(10);

=item B&lt;opened()&gt;

Returns true if the object is currentry opened file, false otherwise.

  say $fh-&gt;opened ? 1 : 0;

=back

=head1 FUNCTIONS

=over

=item B&lt;unlinkW($file)&gt;

Like CORE::unlink.

  unlinkW $file or die $!;

=item B&lt;copyW($from, $to)&gt;

Like File::Copy::copy.

  copyW $from, $to or die $!;

=item B&lt;moveW($from, $to)&gt;

Like File::Copy::move.

  moveW $from, $to or die $!;

=item B&lt;renameW($from, $to)&gt;

Alias of moveW.

=item B&lt;touchW($file)&gt;

Like shell command C&lt;touch&gt;.

  touchW $file or die $!;

=item B&lt;statW($file || $fh || $dir || $dh)&gt;

Like CORE::stat.

  my @stat = statW $file or die $!;
  my $stat = statW $file or die $!;

or

  my $fh = Win32::Unicode::File-&gt;new(r =&gt; $file);
  my @stat = statW $fh or die $!;
  my $stat = statW $fh or die $!;

or

  my @stat = statW $dir or die $!;
  my $stat = statW $dir or die $!;

or

  my $dh = Win32::Unicode::Dir-&gt;new-&gt;open($dir);
  my @stat = statW $dh or die $!;
  my $stat = statW $dh or die $!;

If the array context, CORE:: stat like. However, scalar context case in hashref received.

=item B&lt;utimeW($atime, $mtime, $file || $fh)&gt;

Like CORE::utime.

  my $rc = utime($atime, $mtime, $file, $fh);

=item B&lt;file_type('attribute', $file_or_dir)&gt;

Get windows file type

  # attributes
  f =&gt; file
  d =&gt; directory
  e =&gt; exists
  s =&gt; system
  r =&gt; readonly
  h =&gt; hidden
  a =&gt; archive
  n =&gt; normal
  t =&gt; temporary
  c =&gt; compressed
  o =&gt; offline
  i =&gt; not content indexed
  E =&gt; encrypted

  if (file_type d =&gt; $file_ro_dir) {
     # snip
  }
  elsif (file_type fr =&gt; $file_or_dir) { # file type 'file' and 'readonly'
     # snip
  }

=item B&lt;file_size($file)&gt;

Get file size.
near C&lt;-s $file&gt;

  my $size = file_size $file;
  die $! unless defined $size;

=item B&lt;filename_normalize($filename)&gt;

Normalize the characters are not allowed in the file name. not export.

  use Win32::Unicode::File qw(filename_normalize);
  my $nomalized_file_name = filename_normalize($filename);

=back

=head1 AUTHOR

Yuji Shimada E&lt;lt&gt;xaicron@cpan.orgE&lt;gt&gt;

=head1 SEE ALSO

L&lt;Win32::Unicode&gt;

L&lt;Win32::Unicode::File&gt;

L&lt;Win32::Unicode::Error&gt;

=head1 LICENSE

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

=cut
</pre></body></html>