view release on metacpan or  search on metacpan

lib/Parse/Path/File/Win32.pm  view on Meta::CPAN

package Parse::Path::File::Win32;

our $VERSION = '0.92'; # VERSION
# ABSTRACT: C:\Windows\file\path\support

#############################################################################
# Modules

use Moo;
use sanity;

use Types::Standard qw(StrMatch);

use namespace::clean;
no warnings 'uninitialized';

#############################################################################
# Attributes

has volume => (
   is      => 'rw',
   isa     => StrMatch[ qr/^[A-Za-z]?$/ ],
   default => sub { '' },
);

#############################################################################
# Required Methods

with 'Parse::Path::Role::Path';

sub _build_blueprint { {
   hash_step_regexp => qr{
      # Illegal characters: http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx
      (?<key>[^\x00-\x1F<>:"/\\|?*]*)
   }x,

   array_step_regexp   => qr/\Z.\A/,  # no-op; arrays not supported
   delimiter_regexp    => qr{\\+},    # + to capture repetitive slashes, like foo\\\\\bar

   # no support for escapes
   unescape_translation => [],

   pos_translation => [
      [qr{^\\+$},     0],
      [qr{^\.\.\\*$}, 'X-1'],
      [qr{^\.\\*$},   'X-0'],
      [qr{.?},        'X+1'],
   ],

   delimiter_placement => {
      '0R' => "\\",
      HH   => "\\",
   },

   array_key_sprintf        => '',
   hash_key_stringification => [
      [qr/.?/, '%s'],
   ],
} }

#############################################################################
# Modified Methods

# Remove volume to the path
around path_str2array => sub {
   my ($orig, $self, $path) = (shift, shift, shift);

   $self->volume($1) if ($path =~ s/^([A-Za-z])\://);

   return $self->$orig($path, @_);
};

# Uppercase volume on normalize
around _normalize => sub {
   my ($orig, $self) = (shift, shift);

   $self->volume(uc $self->volume);

   return $self->$orig(@_);
};

# Add volume to the path
around as_string => sub {
   my ($orig, $self) = (shift, shift);

   my $path_str = $self->$orig(@_);
   my $V = $self->volume;

   return ($V ? "$V:" : '').$path_str;
};

42;