1package URI::file::Win32;
2
3require URI::file::Base;
4@ISA=qw(URI::file::Base);
5
6use strict;
7use URI::Escape qw(uri_unescape);
8
9sub _file_extract_authority
10{
11    my $class = shift;
12
13    return $class->SUPER::_file_extract_authority($_[0])
14	if defined $URI::file::DEFAULT_AUTHORITY;
15
16    return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  # UNC
17    return $1 if $_[0] =~ s,^//([^/]+),,;     # UNC too?
18
19    if ($_[0] =~ s,^([a-zA-Z]:),,) {
20	my $auth = $1;
21	$auth .= "relative" if $_[0] !~ m,^[\\/],;
22	return $auth;
23    }
24    return undef;
25}
26
27sub _file_extract_path
28{
29    my($class, $path) = @_;
30    $path =~ s,\\,/,g;
31    #$path =~ s,//+,/,g;
32    $path =~ s,(/\.)+/,/,g;
33
34    if (defined $URI::file::DEFAULT_AUTHORITY) {
35	$path =~ s,^([a-zA-Z]:),/$1,;
36    }
37
38    return $path;
39}
40
41sub _file_is_absolute {
42    my($class, $path) = @_;
43    return $path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],;
44}
45
46sub file
47{
48    my $class = shift;
49    my $uri = shift;
50    my $auth = $uri->authority;
51    my $rel; # is filename relative to drive specified in authority
52    if (defined $auth) {
53        $auth = uri_unescape($auth);
54	if ($auth =~ /^([a-zA-Z])[:|](relative)?/) {
55	    $auth = uc($1) . ":";
56	    $rel++ if $2;
57	} elsif (lc($auth) eq "localhost") {
58	    $auth = "";
59	} elsif (length $auth) {
60	    $auth = "\\\\" . $auth;  # UNC
61	}
62    } else {
63	$auth = "";
64    }
65
66    my @path = $uri->path_segments;
67    for (@path) {
68	return undef if /\0/;
69	return undef if /\//;
70	#return undef if /\\/;        # URLs with "\" is not uncommon
71    }
72    return undef unless $class->fix_path(@path);
73
74    my $path = join("\\", @path);
75    $path =~ s/^\\// if $rel;
76    $path = $auth . $path;
77    $path =~ s,^\\([a-zA-Z])[:|],\u$1:,;
78
79    return $path;
80}
81
82sub fix_path { 1; }
83
841;
85