root/lang/perl/Path-Class-URI/trunk/lib/Path/Class/Unicode.pm @ 25690

Revision 25690, 4.0 kB (checked in by miyagawa, 6 years ago)

Added Path::Class::File->ufile

Line 
1package Path::Class::Unicode;
2
3use strict;
4use 5.008_001;
5our $VERSION = '0.01';
6
7use Exporter::Lite;
8our @EXPORT = qw( ufile udir ufile_from_uri udir_from_uri );
9
10use Encode ();
11use Path::Class;
12use URI::file;
13use Scalar::Util qw(blessed);
14
15sub ufile {
16    __PACKAGE__->new(file(@_));
17}
18
19sub udir {
20    __PACKAGE__->new(dir(@_));
21}
22
23sub Path::Class::File::ufile {
24    my $file = shift;
25    ufile(_decode_filename($file), @_);
26}
27
28sub Path::Class::Dir::udir {
29    my $dir = shift;
30    udir(_decode_filename($dir), @_);
31}
32
33sub ufile_from_uri {
34    my $uri = shift;
35    if ($^O eq "MSWin32") {
36        $uri =~ s!^file:///!file://!g; # remove leading slash for absolute
37        $uri = URI->new($uri) unless blessed $uri;
38        ufile(Encode::decode_utf8($uri->file('win32')));
39    } else {
40        $uri = URI->new($uri) unless blessed $uri;
41        ufile(Encode::decode_utf8($uri->file('unix')));
42    }
43}
44
45sub udir_from_uri {
46    my $uri = shift;
47    if ($^O eq "MSWin32") {
48        $uri =~ s!^file:///!file://!g; # remove leading slash for absolute
49        $uri = URI->new($uri) unless blessed $uri;
50        udir(Encode::decode_utf8($uri->file('win32')));
51    } else {
52        $uri = URI->new($uri) unless blessed $uri;
53        udir(Encode::decode_utf8($uri->file('unix')));
54    }
55}
56
57sub new {
58    my($class, $path) = @_;
59    bless { path => $path }, $class;
60}
61
62sub uri {
63    my $self = shift;
64    my $path = Encode::encode_utf8($self->{path}->stringify);
65    if ($^O eq "MSWin32") {
66        $path =~ tr!\\!/!; # can't use backslash as separator
67        $path = "/$path" if $self->is_absolute; # make "file:///x:/foo/bar/"
68    }
69    if ($self->is_absolute) {
70        return URI->new("file://$path");
71    } else {
72        return URI->new("file:$path");
73    }
74}
75
76our $encoding;
77
78sub init_encoding {
79    unless ($encoding) {
80        $encoding = 'utf-8';
81        if ($^O eq 'MSWin32') {
82            eval {
83                require Win32::API;
84                Win32::API->Import('kernel32', 'UINT GetACP()');
85                $encoding = 'cp'.GetACP();
86            };
87        }
88    }
89}
90
91sub stringify {
92    my $self = shift;
93    init_encoding();
94    Encode::encode($encoding, $self->{path}->stringify);
95}
96
97sub _decode_filename {
98    init_encoding();
99    my $filename = shift;
100    Encode::decode($encoding, "$filename");
101}
102
103sub open {
104    my $self = shift;
105    my $class = $self->is_dir ? "IO::Dir" : "IO::File";
106    $class->new($self->stringify, @_);
107}
108
109sub next {
110    my $self = shift;
111    $self->{path}->{dh} = $self->open unless $self->{path}->{dh};
112    my $file = $self->{path}->next;
113    $file = Encode::encode($encoding, $file) if $file;
114    $file;
115}
116
117use overload (
118    q[""] => 'stringify',
119    fallback => 1,
120);
121
122our $AUTOLOAD;
123sub AUTOLOAD {
124    my $self = shift;
125    (my $method = $AUTOLOAD) =~ s/.*:://;
126    $self->{path}->$method(@_);
127}
128
129sub DESTROY { }
130
1311;
132__END__
133
134=encoding utf-8
135
136=for stopwords TODO UTF-8 filenames cp932 mattn
137
138=head1 NAME
139
140Path::Class::Unicode - Maps Unicode filenames to local encoding and code pages
141
142=head1 SYNOPSIS
143
144  use Path::Class::Unicode;
145
146  # Use ufile() to create Unicode objects
147  my $fn   = "\x{55ed}.txt";
148  my $file = ufile("path", $fn);
149
150  my $fh = $file->open;
151
152  my $fn   = "\x{55ed}.txt";
153  my $file = ufile("/path", $fn);
154  my $uri  = $file->uri;  # file:///path/%E5%97%AD.txt (always utf-8)
155
156  my $fh   = ufile_from_uri($uri)->open;
157
158=head1 DESCRIPTION
159
160Path::Class::Unicode is a Path::Class extension to handle Unicode
161file names by mapping them to local encodings when stringified. It maps
162to UTF-8 for all UNIX systems including Mac OS X and uses Windows code
163page (like cp932 for Japanese) in Win32 systems.
164
165It's very useful if you store file paths using URI representation like
166L<file://> and uses URI escaped UTF-8 characters for non-ASCII
167characters. See L<Path::Class::URI> for details.
168
169=head1 TODO
170
171It would be nice if we could proxy filehandles using Win32API::File.
172
173=head1 AUTHOR
174
175Tatsuhiko Miyagawa E<lt>miyagawa@cpan.orgE<gt>
176
177mattn
178
179=head1 LICENSE
180
181This library is free software; you can redistribute it and/or modify
182it under the same terms as Perl itself.
183
184=head1 SEE ALSO
185
186=cut
Note: See TracBrowser for help on using the browser.