sub valmess {
local($disposition,$this) = @_;
- $file = $cwd . '/' . $file unless $file =~ m|^/|;
+ $file = $cwd . '/' . $file unless $file =~ m|^/|s;
if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
$neg = $1;
$tmp = $2;
if ($from_a_handle) {
*FROM = *$from{FILEHANDLE};
} else {
- $from = "./$from" if $from =~ /^\s/;
+ $from = "./$from" if $from =~ /^\s/s;
open(FROM, "< $from\0") or goto fail_open1;
binmode FROM or die "($!,$^E)";
$closefrom = 1;
if ($to_a_handle) {
*TO = *$to{FILEHANDLE};
} else {
- $to = "./$to" if $to =~ /^\s/;
+ $to = "./$to" if $to =~ /^\s/s;
open(TO,"> $to\0") or goto fail_open2;
binmode TO or die "($!,$^E)";
$closeto = 1;
s/\?/.?/g;
#print "regex: '$_', head: '$head'\n";
- my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '$|io }';
+ my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
warn($@), next OUTER if $@;
INNER:
for my $e (@leaves) {
$paths = [$paths] unless ref $paths;
my(@created,$path);
foreach $path (@$paths) {
- $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT
+ $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
next if -d $path;
# Logic wants Unix paths, so go with the flow.
$path = VMS::Filespec::unixify($path) if $Is_VMS;
my($root);
foreach $root (@{$roots}) {
- $root =~ s#/$##;
+ $root =~ s#/\z##;
(undef, undef, my $rp) = lstat $root or next;
$rp &= 07777; # don't forget setuid, setgid, sticky bits
if ( -d _ ) {
# Deleting large numbers of files from VMS Files-11 filesystems
# is faster if done in reverse ASCIIbetical order
@files = reverse @files if $Is_VMS;
- ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
- @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@files);
+ ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
+ @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
$count += rmtree(\@files,$verbose,$safe);
if ($safe &&
($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
shift;
my @args = @_;
my $result = shift @args;
- $result =~ s/:$//;
+ $result =~ s/:\z//;
foreach (@args) {
- s/:$//;
- s/^://;
+ s/:\z//;
+ s/^://s;
$result .= ":$_";
}
return "$result:";
my $file = pop @_;
return $file unless @_;
my $dir = $self->catdir(@_);
- $file =~ s/^://;
+ $file =~ s/^://s;
return $dir.$file;
}
require Mac::Files;
my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
&Mac::Files::kSystemFolderType);
- $system =~ s/:.*$/:/;
+ $system =~ s/:.*\z/:/;
return $system;
}
sub file_name_is_absolute {
my ($self,$file) = @_;
if ($file =~ /:/) {
- return ($file !~ m/^:/);
+ return ($file !~ m/^:/s);
} else {
return (! -e ":$file");
}
my ($volume,$directory,$file) = ('','','');
if ( $nofile ) {
- ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|$))?)(.*)@;
+ ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\z))?)(.*)@;
}
else {
$path =~
m@^( (?: [^:]+: )? )
( (?: .*: )? )
( .* )
- @x;
+ @xs;
$volume = $1;
$directory = $2;
$file = $3;
}
# Make sure non-empty volumes and directories end in ':'
- $volume .= ':' if $volume =~ m@[^:]$@ ;
- $directory .= ':' if $directory =~ m@[^:]$@ ;
+ $volume .= ':' if $volume =~ m@[^:]\z@ ;
+ $directory .= ':' if $directory =~ m@[^:]\z@ ;
return ($volume,$directory,$file);
}
# check to be sure that there will not be any before handling the
# simple case.
#
- if ( $directories !~ m@:$@ ) {
+ if ( $directories !~ m@:\z@ ) {
return split( m@:@, $directories );
}
else {
my $self = shift ;
my $result = shift ;
- $result =~ s@^([^/])@/$1@ ;
+ $result =~ s@^([^/])@/$1@s ;
my $segment ;
for $segment ( @_ ) {
- if ( $result =~ m@[^/]$@ && $segment =~ m@^[^/]@ ) {
+ if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) {
$result .= "/$segment" ;
}
- elsif ( $result =~ m@/$@ && $segment =~ m@^/@ ) {
- $result =~ s@/+$@/@;
- $segment =~ s@^/+@@;
+ elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) {
+ $result =~ s@/+\z@/@;
+ $segment =~ s@^/+@@s;
$result .= "$segment" ;
}
else {
sub file_name_is_absolute {
my ($self,$file) = @_;
- return scalar($file =~ m{^([a-z]:)?[\\/]}i);
+ return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}
sub path {
my ($self,$path) = @_;
$path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
- $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx
- $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx
- $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx
+ $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
+ $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
+ $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
return $path;
}
sub no_upwards {
my $self = shift;
- return grep(!/^\.{1,2}$/, @_);
+ return grep(!/^\.{1,2}\z/s, @_);
}
=item case_tolerant
sub file_name_is_absolute {
my ($self,$file) = @_;
- return scalar($file =~ m:^/:);
+ return scalar($file =~ m:^/:s);
}
=item path
$directory = $path;
}
else {
- $path =~ m|^ ( (?: .* / (?: \.\.?$ )? )? ) ([^/]*) |x;
+ $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
$directory = $1;
$file = $2;
}
# check to be sure that there will not be any before handling the
# simple case.
#
- if ( $directories !~ m|/$| ) {
+ if ( $directories !~ m|/\z| ) {
return split( m|/|, $directories );
}
else {
$complex = 1;
}
}
- else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
+ else { ($macro = unixify($self->{$macro})) =~ s#/\z##; }
$npath = "$head$macro$tail";
}
}
$self = bless {} unless ref $self;
my($fixedpath,$prefix,$name);
- if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) {
- if ($force_path or $path =~ /(?:DIR\)|\])$/) {
+ if ($path =~ m#^\$\([^\)]+\)\z#s || $path =~ m#[/:>\]]#) {
+ if ($force_path or $path =~ /(?:DIR\)|\])\z/) {
$fixedpath = vmspath($self->eliminate_macros($path));
}
else {
$fixedpath = vmsify($self->eliminate_macros($path));
}
}
- elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
+ elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
my($vmspre) = $self->eliminate_macros("\$($prefix)");
# is it a dir or just a name?
- $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : '';
+ $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\z/) ? vmspath($vmspre) : '';
$fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
$fixedpath = vmspath($fixedpath) if $force_path;
}
if (@dirs) {
my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
my ($spath,$sdir) = ($path,$dir);
- $spath =~ s/.dir$//; $sdir =~ s/.dir$//;
- $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
+ $spath =~ s/.dir\z//; $sdir =~ s/.dir\z//;
+ $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s;
$rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
# Special case for VMS absolute directory specs: these will have had device
# prepended during trip through Unix syntax in eliminate_macros(), since
# Unix syntax has no way to express "absolute from the top of this device's
# directory tree".
- if ($spath =~ /^[\[<][^.\-]/) { $rslt =~ s/^[^\[<]+//; }
+ if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
}
else {
- if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
- else { $rslt = vmspath($dir); }
+ if ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; }
+ else { $rslt = vmspath($dir); }
}
return $rslt;
}
if (@files) {
my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
my $spath = $path;
- $spath =~ s/.dir$//;
- if ($spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) {
+ $spath =~ s/.dir\z//;
+ if ($spath =~ /^[^\)\]\/:>]+\)\z/s && basename($file) eq $file) {
$rslt = "$spath$file";
}
else {
sub file_name_is_absolute {
my ($self,$file) = @_;
# If it's a logical name, expand it.
- $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file};
- return scalar($file =~ m!^/! ||
+ $file = $ENV{$file} while $file =~ /^[\w\$\-]+\z/s && $ENV{$file};
+ return scalar($file =~ m!^/!s ||
$file =~ m![<\[][^.\-\]>]! ||
$file =~ /:[^<\[]/);
}
my($self,$path) = @_;
my($dev,$dir,$file) = ('','','');
- vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/;
+ vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
return ($1 || '',$2 || '',$3);
}
my($self,$dirspec) = @_;
$dirspec =~ s/\]\[//g; $dirspec =~ s/\-\-/-.-/g;
my(@dirs) = split('\.', vmspath($dirspec));
- $dirs[0] =~ s/^[\[<]//; $dirs[-1] =~ s/[\]>]$//;
+ $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\z//s;
@dirs;
}
m{^ ( (?: /[^/]* )? )
( (?: .*/(?:[^/]+.dir)? )? )
(.*)
- }x;
+ }xs;
$volume = $1;
$directory = $2;
$file = $3;
m{^ ( (?: (?: (?: [\w\$-]+ (?: "[^"]*")?:: )? [\w\$-]+: )? ) )
( (?:\[.*\])? )
(.*)
- }x;
+ }xs;
$volume = $1;
$directory = $2;
$file = $3;
}
$directory = $1
- if $directory =~ /^\[(.*)\]$/ ;
+ if $directory =~ /^\[(.*)\]\z/s ;
return ($volume,$directory,$file);
}
return File::Spec::Unix::splitdir( $self, @_ )
if ( $directories =~ m{/} ) ;
- $directories =~ s/^\[(.*)\]$/$1/ ;
+ $directories =~ s/^\[(.*)\]\z/$1/s ;
#
# split() likes to forget about trailing null fields, so here we
# check to be sure that there will not be any before handling the
# simple case.
#
- if ( $directories !~ m{\.$} ) {
+ if ( $directories !~ m{\.\z} ) {
return split( m{\.}, $directories );
}
else {
my ($volume,$directory,$file) = @_;
$volume .= ':'
- if $volume =~ /[^:]$/ ;
+ if $volume =~ /[^:]\z/ ;
$directory = "[$directory"
- if $directory =~ /^[^\[]/ ;
+ if $directory =~ /^[^\[]/s ;
$directory .= ']'
- if $directory =~ /[^\]]$/ ;
+ if $directory =~ /[^\]]\z/ ;
return "$volume$directory$file" ;
}
$self->splitpath( $path, 1 ) ;
$path_directories = $1
- if $path_directories =~ /^\[(.*)\]$/ ;
+ if $path_directories =~ /^\[(.*)\]\z/s ;
my ( undef, $base_directories, undef ) =
$self->splitpath( $base, 1 ) ;
$base_directories = $1
- if $base_directories =~ /^\[(.*)\]$/ ;
+ if $base_directories =~ /^\[(.*)\]\z/s ;
# Now, remove all leading components that are the same
my @pathchunks = $self->splitdir( $path_directories );
# @basechunks now contains the directories to climb out of,
# @pathchunks now has the directories to descend in to.
$path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ;
- $path_directories =~ s{\.$}{} ;
+ $path_directories =~ s{\.\z}{} ;
return $self->catpath( '', $path_directories, $path_file ) ;
}
my $sep = '' ;
$sep = '.'
- if ( $base_directories =~ m{[^.]$} &&
- $path_directories =~ m{^[^.]}
+ if ( $base_directories =~ m{[^.]\z} &&
+ $path_directories =~ m{^[^.]}s
) ;
$base_directories = "$base_directories$sep$path_directories" ;
sub file_name_is_absolute {
my ($self,$file) = @_;
- return scalar($file =~ m{^([a-z]:)?[\\/]}i);
+ return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}
=item catfile
sub canonpath {
my ($self,$path) = @_;
- $path =~ s/^([a-z]:)/\u$1/;
+ $path =~ s/^([a-z]:)/\u$1/s;
$path =~ s|/|\\|g;
$path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx
$path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx
- $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx
- $path =~ s|\\$||
- unless $path =~ m#^([A-Z]:)?\\$#; # xx/ -> xx
+ $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx
+ $path =~ s|\\\z||
+ unless $path =~ m#^([A-Z]:)?\\\z#s; # xx/ -> xx
return $path;
}
$path =~
m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? )
(.*)
- }x;
+ }xs;
$volume = $1;
$directory = $2;
}
(?:\\\\|//)[^\\/]+[\\/][^\\/]+
)?
)
- ( (?:.*[\\\\/](?:\.\.?$)?)? )
+ ( (?:.*[\\\\/](?:\.\.?\z)?)? )
(.*)
- }x;
+ }xs;
$volume = $1;
$directory = $2;
$file = $3;
# check to be sure that there will not be any before handling the
# simple case.
#
- if ( $directories !~ m|[\\/]$| ) {
+ if ( $directories !~ m|[\\/]\z| ) {
return split( m|[\\/]|, $directories );
}
else {
# If it's UNC, make sure the glue separator is there, reusing
# whatever separator is first in the $volume
$volume .= $1
- if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+$@ &&
- $directory =~ m@^[^\\/]@
+ if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
+ $directory =~ m@^[^\\/]@s
) ;
$volume .= $directory ;
# If the volume is not just A:, make sure the glue separator is
# there, reusing whatever separator is first in the $volume if possible.
- if ( $volume !~ m@^[a-zA-Z]:$@ &&
- $volume =~ m@[^\\/]$@ &&
+ if ( $volume !~ m@^[a-zA-Z]:\z@s &&
+ $volume =~ m@[^\\/]\z@ &&
$file =~ m@[^\\/]@
) {
$volume =~ m@([\\/])@ ;
}
# It makes no sense to add a relative path to a UNC volume
- $path_volume = '' unless $path_volume =~ m{^[A-Z]:}i ;
+ $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
return $self->canonpath(
$self->catpath($path_volume, $path_directories, $path_file )
projects / p5sagit/p5-mst-13.2.git / commitdiff