From: Olaf Flebbe Date: Sun, 19 Nov 2000 19:33:30 +0000 (+0100) Subject: [perl 7711: EPOC] updates X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa6a1c441b7e2c8c5e7ee1e3836a41fc8a364e89;hp=07d29b54c8a15c0fd1ebf8765665546568dfb928;p=p5sagit%2Fp5-mst-13.2.git [perl 7711: EPOC] updates Message-ID: <25575.974658810@www23.gmx.net> p4raw-id: //depot/perl@7758 --- diff --git a/MANIFEST b/MANIFEST index 4c7ba72..5c25ff6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -675,6 +675,7 @@ lib/File/Spec/OS2.pm portable operations on OS2 file names lib/File/Spec/Unix.pm portable operations on Unix file names lib/File/Spec/VMS.pm portable operations on VMS file names lib/File/Spec/Win32.pm portable operations on Win32 file names +lib/File/Spec/Epoc.pm portable operations on EPOC file names lib/File/Temp.pm create safe temporary files and file handles lib/File/stat.pm By-name interface to Perl's builtin stat lib/FileCache.pm Keep more files open than the system permits diff --git a/epoc/epocish.c b/epoc/epocish.c index 4963a2e5..a0557cc 100644 --- a/epoc/epocish.c +++ b/epoc/epocish.c @@ -33,8 +33,12 @@ epoc_spawn( char *cmd, char *cmdline) { /* Workaround for defect atof(), see java defect list for epoc */ - double epoc_atof( const char* str) { + double epoc_atof( char* str) { TReal64 aRes; + + while (TChar( *str).IsSpace()) { + str++; + } TLex lex( _L( str)); TInt err = lex.Val( aRes, TChar( '.')); diff --git a/lib/CGI.pm b/lib/CGI.pm index fd06f64..e9c916f 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -119,6 +119,8 @@ if ($OS=~/Win/i) { $OS = 'MACINTOSH'; } elsif ($OS=~/os2/i) { $OS = 'OS2'; +} elsif ($OS=~/epoc/) { + $OS = 'EPOC'; } else { $OS = 'UNIX'; } @@ -135,7 +137,7 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { - UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' + UNIX=>'/', EPOC=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' }->{$OS}; # This no longer seems to be necessary @@ -3274,7 +3276,7 @@ unless ($TMPDIRECTORY) { @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", "C:${SL}temp","${SL}tmp","${SL}temp", "${vol}${SL}Temporary Items", - "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH"); + "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH", "C:${SL}system${SL}temp"); unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'}; # this feature was supposed to provide per-user tmpfiles, but diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 7279591..1ed603b 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -408,7 +408,8 @@ sub _epoc_cwd { *abs_path = \&fast_abs_path; } elsif ($^O eq 'epoc') { - *getcwd = \&_epoc_cwd; + *cwd = \&_epoc_cwd; + *getcwd = \&_epoc_cwd; *fastgetcwd = \&_epoc_cwd; *fastcwd = \&_epoc_cwd; *abs_path = \&fast_abs_path; diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 2432344..75996f2 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -176,7 +176,7 @@ sub fileparse { $dirpath ||= ''; # should always be defined } } - if ($fstype =~ /^MS(DOS|Win32)/i) { + if ($fstype =~ /^MS(DOS|Win32)|epoc/i) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/; } diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 6e6e462..3a621c0 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -759,7 +759,7 @@ if ($^O eq 'VMS') { $File::Find::dont_use_nlink = 1 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || - $^O eq 'cygwin'; + $^O eq 'cygwin' || $^O eq 'epoc'; # Set dont_use_nlink in your hint file if your system's stat doesn't # report the number of links in a directory as an indication diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 8b0772d..3859f24 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -106,7 +106,7 @@ my $Is_VMS = $^O eq 'VMS'; # These OSes complain if you want to remove a file that you have no # write permission to: my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' || - $^O eq 'amigaos' || $^O eq 'MacOS'); + $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc'); sub mkpath { my($paths, $verbose, $mode) = @_; diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 40503c4..3f79d74 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -8,7 +8,8 @@ $VERSION = 0.82 ; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', - VMS => 'VMS'); + VMS => 'VMS', + epoc => 'Epoc'); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm new file mode 100644 index 0000000..65d5e1f --- /dev/null +++ b/lib/File/Spec/Epoc.pm @@ -0,0 +1,378 @@ +package File::Spec::Epoc; + +use strict; +use Cwd; +use vars qw(@ISA); +require File::Spec::Unix; +@ISA = qw(File::Spec::Unix); + +=head1 NAME + +File::Spec::Epoc - methods for Epoc file specs + +=head1 SYNOPSIS + + require File::Spec::Epoc; # Done internally by File::Spec if needed + +=head1 DESCRIPTION + +See File::Spec::Unix for a documentation of the methods provided +there. This package overrides the implementation of these methods, not +the semantics. + +This package is still work in progress ;-) +o.flebbe@gmx.de + + +=over + +=item devnull + +Returns a string representation of the null device. + +=cut + +sub devnull { + return "nul:"; +} + +=item tmpdir + +Returns a string representation of a temporay directory: + +=cut + +my $tmpdir; +sub tmpdir { + return "C:/System/temp"; +} + +sub case_tolerant { + return 1; +} + +sub file_name_is_absolute { + my ($self,$file) = @_; + return scalar($file =~ m{^([a-z?]:)?[\\/]}is); +} + +=item path + +Takes no argument, returns the environment variable PATH as an array. Since +there is no search path supported, it returns undef, sorry. + +=cut +sub path { + return undef; +} + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +path. On UNIX eliminated successive slashes and successive "/.". + +=cut + +sub canonpath { + my ($self,$path) = @_; + $path =~ s/^([a-z]:)/\u$1/s; + + $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx + $path =~ s|(/\.)+/|/|g; # xx/././xx -> 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; +} + +=item splitpath + + ($volume,$directories,$file) = File::Spec->splitpath( $path ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + +Splits a path in to volume, directory, and filename portions. Assumes that +the last file is a path unless the path ends in '\\', '\\.', '\\..' +or $no_file is true. On Win32 this means that $no_file true makes this return +( $volume, $path, undef ). + +Separators accepted are \ and /. + +The results can be passed to L to get back a path equivalent to +(usually identical to) the original path. + +=cut + +sub splitpath { + my ($self,$path, $nofile) = @_; + my ($volume,$directory,$file) = ('','',''); + if ( $nofile ) { + $path =~ + m{^( (?:[a-zA-Z?]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) + (.*) + }xs; + $volume = $1; + $directory = $2; + } + else { + $path =~ + m{^ ( (?: [a-zA-Z?]: | + (?:\\\\|//)[^\\/]+[\\/][^\\/]+ + )? + ) + ( (?:.*[\\\\/](?:\.\.?\z)?)? ) + (.*) + }xs; + $volume = $1; + $directory = $2; + $file = $3; + } + + return ($volume,$directory,$file); +} + + +=item splitdir + +The opposite of L. + + @dirs = File::Spec->splitdir( $directories ); + +$directories must be only the directory portion of the path on systems +that have the concept of a volume or that have path syntax that differentiates +files from directories. + +Unlike just splitting the directories on the separator, leading empty and +trailing directory entries can be returned, because these are significant +on some OSs. So, + + File::Spec->splitdir( "/a/b/c" ); + +Yields: + + ( '', 'a', 'b', '', 'c', '' ) + +=cut + +sub splitdir { + my ($self,$directories) = @_ ; + # + # 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|[\\/]\z| ) { + return split( m|[\\/]|, $directories ); + } + else { + # + # since there was a trailing separator, add a file name to the end, + # then do the split, then replace it with ''. + # + my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; + $directories[ $#directories ]= '' ; + return @directories ; + } +} + + +=item catpath + +Takes volume, directory and file portions and returns an entire path. Under +Unix, $volume is ignored, and this is just like catfile(). On other OSs, +the $volume become significant. + +=cut + +sub catpath { + my ($self,$volume,$directory,$file) = @_; + + # If it's UNC, make sure the glue separator is there, reusing + # whatever separator is first in the $volume + $volume .= $1 + 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]:\z@s && + $volume =~ m@[^\\/]\z@ && + $file =~ m@[^\\/]@ + ) { + $volume =~ m@([\\/])@ ; + my $sep = $1 ? $1 : '\\' ; + $volume .= $sep ; + } + + $volume .= $file ; + + return $volume ; +} + + +=item abs2rel + +Takes a destination path and an optional base path returns a relative path +from the base path to the destination path: + + $rel_path = File::Spec->abs2rel( $destination ) ; + $rel_path = File::Spec->abs2rel( $destination, $base ) ; + +If $base is not present or '', then L is used. If $base is relative, +then it is converted to absolute form using L. This means that it +is taken to be relative to L. + +On systems with the concept of a volume, this assumes that both paths +are on the $destination volume, and ignores the $base volume. + +On systems that have a grammar that indicates filenames, this ignores the +$base filename as well. Otherwise all path components are assumed to be +directories. + +If $path is relative, it is converted to absolute form using L. +This means that it is taken to be relative to L. + +Based on code written by Shigio Yamaguchi. + +No checks against the filesystem are made. + +=cut + +sub abs2rel { + my($self,$path,$base) = @_; + + # Clean up $path + if ( ! $self->file_name_is_absolute( $path ) ) { + $path = $self->rel2abs( $path ) ; + } + else { + $path = $self->canonpath( $path ) ; + } + + # Figure out the effective $base and clean it up. + if ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + elsif ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + else { + $base = $self->canonpath( $base ) ; + } + + # Split up paths + my ( $path_volume, $path_directories, $path_file ) = + $self->splitpath( $path, 1 ) ; + + my ( undef, $base_directories, undef ) = + $self->splitpath( $base, 1 ) ; + + # Now, remove all leading components that are the same + my @pathchunks = $self->splitdir( $path_directories ); + my @basechunks = $self->splitdir( $base_directories ); + + while ( @pathchunks && + @basechunks && + lc( $pathchunks[0] ) eq lc( $basechunks[0] ) + ) { + shift @pathchunks ; + shift @basechunks ; + } + + # No need to catdir, we know these are well formed. + $path_directories = CORE::join( '\\', @pathchunks ); + $base_directories = CORE::join( '\\', @basechunks ); + + # $base_directories now contains the directories the resulting relative + # path must ascend out of before it can descend to $path_directory. So, + # replace all names with $parentDir + + #FA Need to replace between backslashes... + $base_directories =~ s|[^\\]+|..|g ; + + # Glue the two together, using a separator if necessary, and preventing an + # empty result. + + #FA Must check that new directories are not empty. + if ( $path_directories ne '' && $base_directories ne '' ) { + $path_directories = "$base_directories\\$path_directories" ; + } else { + $path_directories = "$base_directories$path_directories" ; + } + + # It makes no sense to add a relative path to a UNC volume + $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ; + + return $self->canonpath( + $self->catpath($path_volume, $path_directories, $path_file ) + ) ; +} + +=item rel2abs + +Converts a relative path to an absolute path. + + $abs_path = File::Spec->rel2abs( $destination ) ; + $abs_path = File::Spec->rel2abs( $destination, $base ) ; + +If $base is not present or '', then L is used. If $base is relative, +then it is converted to absolute form using L. This means that it +is taken to be relative to L. + +Assumes that both paths are on the $base volume, and ignores the +$destination volume. + +On systems that have a grammar that indicates filenames, this ignores the +$base filename as well. Otherwise all path components are assumed to be +directories. + +If $path is absolute, it is cleaned up and returned using L. + +Based on code written by Shigio Yamaguchi. + +No checks against the filesystem are made. + +=cut + +sub rel2abs($;$;) { + my ($self,$path,$base ) = @_; + + if ( ! $self->file_name_is_absolute( $path ) ) { + + if ( !defined( $base ) || $base eq '' ) { + $base = cwd() ; + } + elsif ( ! $self->file_name_is_absolute( $base ) ) { + $base = $self->rel2abs( $base ) ; + } + else { + $base = $self->canonpath( $base ) ; + } + + my ( undef, $path_directories, $path_file ) = + $self->splitpath( $path, 1 ) ; + + my ( $base_volume, $base_directories, undef ) = + $self->splitpath( $base, 1 ) ; + + $path = $self->catpath( + $base_volume, + $self->catdir( $base_directories, $path_directories ), + $path_file + ) ; + } + + return $self->canonpath( $path ) ; +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; diff --git a/perl.c b/perl.c index 932c344..a422550 100644 --- a/perl.c +++ b/perl.c @@ -839,7 +839,7 @@ setuid perl scripts securely.\n"); PL_origargv = argv; PL_origargc = argc; -#if !defined( VMS) && !defined(EPOC) /* VMS doesn't have environ array */ +#ifdef USE_ENVIRON_ARRAY PL_origenviron = environ; #endif @@ -3322,7 +3322,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, PL_envgv, 'E'); -#if !defined( VMS) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) /* VMS doesn't have environ array */ +#ifdef USE_ENVIRON_ARRAY /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory if the environment has been modified since. To avoid this diff --git a/sv.c b/sv.c index 7a6085a..2cc3c43 100644 --- a/sv.c +++ b/sv.c @@ -5134,7 +5134,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash) } if (GvHV(gv) && !HvNAME(GvHV(gv))) { hv_clear(GvHV(gv)); -#if !defined( VMS) && !defined(EPOC) /* VMS has no environ array */ +#ifdef USE_ENVIRON_ARRAY if (gv == PL_envgv) environ[0] = Nullch; #endif