Win32::Unicode::Native - override some default method


Win32-Unicode documentation Contained in the Win32-Unicode distribution.

Index


Code Index:

NAME

Top

Win32::Unicode::Native - override some default method

SYNOPSIS

Top

  use Win32::Unicode::Native;

  print $flagged_utf8;

  open my $fh, '<', $unicode_file_name or die error;

  opendir my $dh, $unicode_dir_name or die error;

DESCRIPTION

Top

Wn32::Unicode is a perl unicode-friendly wrapper for win32api. This module standard functions override. But it's limited to just using Win32.

Many features easy to use Perl because I think it looks identical to the standard function.

AUTHOR

Top

Yuji Shimada <xaicron@cpan.org>

SEE ALSO

Top

Win32::Unicode

LICENSE

Top

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


Win32-Unicode documentation Contained in the Win32-Unicode distribution.

package Win32::Unicode::Native;

use strict;
use warnings;
use 5.008003;
use Exporter 'import';

our $VERSION = '0.25';

use Win32::Unicode::Console ':all';
use Win32::Unicode::File    ':all';
use Win32::Unicode::Dir     ':all';
use Win32::Unicode::Process ':all';
use Win32::Unicode::Error ();
use Win32::Unicode::Constant qw/CYGWIN/;
use Win32::Unicode::Util;
use Win32::Unicode::XS;

do {
    @main::ARGV = ();
    my $enc = Encode::find_encoding(CYGWIN ? 'utf8' : 'cp932');
    my $script = $enc->decode($0);
    my @args = @{parse_argv()};
    my $flag = 0;
    while (@args) {
        my $argv = utf16_to_utf8 shift @args;
        unless ($flag) {
            if ($script eq '-e') {
                if ($argv =~ /^\-[a-z0-9]*e$/i) {
                    $flag++;
                    shift @args; # skip next -e
                }
            }
            elsif ($script eq '-') {
                $flag++ if $argv eq '-';
            }
            elsif (rel2abs($script) eq rel2abs($argv)) {
                $0 = $script;
                $flag++;
            }
            next;
        }
        push @main::ARGV, $argv;
    }
    
    sub __FILE__ () { $script }
};

our @EXPORT = qw{
    error
    file_size
    file_type
    dir_size
    open
    close
    opendir
    closedir
    readdir
    flock
    file_list
    dir_list
    __FILE__
    filename_normalize
    slurp
};

my $sub_export = sub {
    for my $method (@_) {
        my ($func) = $method =~ /^(.*)W$/;
        no strict 'refs';
        *{"$func"} = \&{"$method"};
        push @EXPORT, $func;
    }
};

# Win32::Unicode::Console
$sub_export->(qw{
    printfW
    warnW
    dieW
    sayW
});

binmode STDOUT => ':utf8';
tie *STDOUT, 'Win32::Unicode::Console::Tie';

# Win32::Unicode::File
$sub_export->(qw{
    unlinkW
    renameW
    copyW
    moveW
    touchW
    statW
});

*flock = \&Win32::Unicode::File::flock;

sub open {
    local $Carp::CarpLevel = 1;
    my $fh = Win32::Unicode::File->new;
    $fh->open($_[1], $_[2]) or return;
    return $_[0] = $fh;
}

sub close {
    local $Carp::CarpLevel = 1;
    my $fh = $_[0];
    $fh->close or return;
    $_[0] = undef;
    return 1;
}

# Win32::Unicode::Dir
$sub_export->(qw{
    mkdirW
    rmdirW
    chdirW
    findW
    finddepthW
    mkpathW
    rmtreeW
    mvtreeW
    cptreeW
    getcwdW
});

sub opendir {
    local $Carp::CarpLevel = 1;
    my $dh = Win32::Unicode::Dir->new;
    return unless $dh->open($_[1]);
    return $_[0] = $dh;
}

sub closedir {
    local $Carp::CarpLevel = 1;
    my $dh = $_[0];
    $dh->close or return;
    $_[0] = undef;
    return 1;
}

sub readdir {
    local $Carp::CarpLevel = 1;
    my $dh = shift;
    return $dh->fetch;
};

# Win32::Unicode::Error
*error = \&Win32::Unicode::Error::errorW;

# Win32::Unicode::Process
$sub_export->(qw{
    systemW
    execW
});

1;
__END__