diff options
| -rw-r--r-- | README.epoc | 105 | ||||
| -rw-r--r-- | doio.c | 2 | ||||
| -rw-r--r-- | epoc/epoc.c | 4 | ||||
| -rw-r--r-- | lib/File/Spec/Epoc.pm | 324 | ||||
| -rw-r--r-- | pod/perlport.pod | 2 | ||||
| -rwxr-xr-x | t/io/fs.t | 2 |
6 files changed, 34 insertions, 405 deletions
diff --git a/README.epoc b/README.epoc index 74ea6b7c7e..a098c2bc72 100644 --- a/README.epoc +++ b/README.epoc @@ -8,17 +8,22 @@ README.epoc - Perl for EPOC =head1 SYNOPSIS -Perl 5 README file for the EPOC operating system. +Perl 5 README file for the EPOC Release 5 operating system. =head1 INTRODUCTION EPOC is an OS for palmtops and mobile phones. For more informations look at: http://www.symbian.com/ -This is a port of perl to EPOC. It runs on ER5 machines: Psion 5mx, -5mx Pro, Psion Revo, Psion Netbook and on the Ericson M128. It runs on -ER3 Hardware (Series 5 classic), too. For more information about this -hardware please refer to http://www.psion.com. +This is a port of perl to the epocemx SDK by Eberhard Mattes, which +itselfs uses the SDK by symbian. Essentially epocemx it is a POSIX +look alike environment for the EPOC OS. For more informations look at: +http://www.windhager.de/~mattes/epocemx/ + +perl and epocemx runs on Epoc Release 5 machines: Psion 5mx, 5mx Pro, +Psion Revo, Psion Netbook and on the Ericson M128. It may run on Epoc +Release 3 Hardware (Series 5 classic), too. For more information about +this hardware please refer to http://www.psion.com. Vendors which like to have support for their devices are free to send me a sample. @@ -26,78 +31,26 @@ me a sample. =head1 INSTALLING PERL ON EPOC You can download a ready-to-install version from -http://www.science-computing.de/o.flebbe/perl. You may find other -versions with some CPAN modules included at this location. +http://www.science-computing.de/o.flebbe/perl. -You will need at least ~4MB free space in order to install and run +You will need at least ~6MB free space in order to install and run perl. +Please install the emxusr.sis package from +http://www.windhager.de/~mattes/epocemx/ first. + Install perl.sis on the EPOC machine. If you do not know how to do that, consult your PsiWin documentation. -Perl itself and its standard library is using 2.5 MB disk space. +Perl itself and its standard library is using 4 MB disk space. Unicode support and some other modules are left out. (For details, please look into epoc/createpkg.pl). If you like to use these modules, you are free to copy them from a current perl release. =head1 STARTING PERL ON EPOC -For ER5 machines, you can get the software Perlstart -http://www.science-computing.de/o.flebbe/perl. It contains file -recognizers for files with the extension .pl and .pm. With it you can -start perl with a double click on the camel icon. Be sure to configure -the perl installation drive first. You can even provide a script with -a special commandline, if needed. - -Alternatively you can use the epocemx shell - -If you have an ER3 machine (i.e. a PSION 5), you may have to supply the -full path to the perl executable C:\system\programs\perl.exe. - -If you need to set the current directory of perl, please use the -command line switch '-x'. See L<perlrun> for details. - -=head1 STOPPING PERL ON EPOC - -You can stop a running perl process in the task list by closing the -application `STDOUT'. You can use the kill command in the epocemx -shell to kill perl. - -=head1 USING PERL ON EPOC - -=head2 I/O Redirection on Epoc - -You can redirect the output with the UNIX bourne shell syntax (this is -built into perl rather then eshell) For instance the following command -line will run the script test.pl with the output redirected to -stdout_file, the errors to stderr_file and input from stdin_file. - -perl test.pl >stdout_file <stdin_file 2>stderr_file - -Alternatively you can use 2>&1 in order to add the standard error -output to stdout. - -=head2 PATH Names on Epoc - -ESHELL looks for executables in ?:/System/Programs. The SIS file -installs perl in this special folder directory. The default drive and -path are the same as folder the executable resides. The EPOC -filesystem is case-preserving, not case-sensitive. - -The EPOC estdlib uses the ?: syntax for establishing a search order: -First in C: (RAM), then on D: (CF Card, if present) and last in Z: -(ROM). For instance ?:\a.txt searches for C:\a.txt, D:\a.txt (and -Z:\a.txt) - -The perl @INC search path is implemented with '?:'. Your perl -executable can live on a different drive than the perl library or even -your scripts. - -ESHELL paths have to be written with backslashes '\', file arguments -to perl with slashes '/'. Remember that I/O redirection is done -internally in perl, so please use slashes for redirects. - -perl.exe C:/test.pl >C:/output.txt +Please use the epocemx shell to start perl. perl integrates with the +conventions of epocemx. =head2 Editors on Epoc @@ -117,16 +70,7 @@ EPOC: =item * -backquoting, pipes etc. - -=item * - -system() does not inherit resources like: file descriptors, -environment etc. - -=item * - -signal, kill, alarm. Do not try to use them. This may be +kill, alarm and signals. Do not try to use them. This may be impossible to implement on EPOC. =item * @@ -161,8 +105,7 @@ Sorry, this is far too short. =item * -You will need the epocemx SDK from Eberhard Mattes. Watch out for an -announcement. +You will need the epocemx SDK from Eberhard Mattes. =item * @@ -183,6 +126,7 @@ Start again from scratch ./Configure -S make cp miniperl.native miniperl + touch miniperl.exe make perl createpkg.pl @@ -193,7 +137,10 @@ Start again from scratch =head1 SUPPORT STATUS OF PERL ON EPOC I'm offering this port "as is". You can ask me questions, but I can't -guarantee I'll be able to answer them. +guarantee I'll be able to answer them. Since the port to epocemx is +quite new, please check the web for updates first. + +Very special thanks to Eberhard Mattes for epocemx. =head1 AUTHOR @@ -202,6 +149,6 @@ http://www.science-computing.de/o.flebbe/perl/ =head1 LAST UPDATE -2001-12-12 +2002-03-26 =cut @@ -752,7 +752,7 @@ Perl_nextargv(pTHX_ register GV *gv) } #endif #ifdef HAS_RENAME -#if !defined(DOSISH) && !defined(__CYGWIN__) +#if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC) if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), diff --git a/epoc/epoc.c b/epoc/epoc.c index 88dca1e7cf..61c8d28cf5 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -11,6 +11,7 @@ #include <stdio.h> #include <sys/unistd.h> #include <process.h> +#include <emx.h> #include "EXTERN.h" @@ -56,7 +57,7 @@ do_aspawn ( void *vreally, void **vmark, void **vsp) { cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0])); - spawnvp( P_WAIT, cmd, argv); + rc = spawnvp( P_WAIT, cmd, argv); free( argv); free( cmd); @@ -125,5 +126,6 @@ Perl_init_os_extras(void) void Perl_my_setenv(pTHX_ char *nam,char *val) { + setenv( nam, val, 1); } diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm index eec5a1a5f6..fc9c8ffc14 100644 --- a/lib/File/Spec/Epoc.pm +++ b/lib/File/Spec/Epoc.pm @@ -28,47 +28,10 @@ o.flebbe@gmx.de =over 4 -=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 @@ -78,298 +41,15 @@ path. On UNIX eliminated successive slashes and successive "/.". 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|(/\.)+/|/|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 + $path =~ s|/\Z(?!\n)|| 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</catpath> 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<catdir()|File::Spec/catdir()>. - - @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<cwd()|Cwd> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()|Cwd>. - -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</rel2abs()>. -This means that it is taken to be relative to L<cwd()|Cwd>. - -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<cwd()|Cwd> is used. If $base is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<cwd()|Cwd>. - -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</canonpath()>. - -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 diff --git a/pod/perlport.pod b/pod/perlport.pod index ef05ecf349..823a2c6366 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -2030,7 +2030,7 @@ distribution available at http://www.cpan.org/src/index.html DG/UX DOS DJGPP 1) DYNIX/ptx - EPOC + EPOC R5 FreeBSD HP-UX IRIX @@ -66,7 +66,7 @@ chdir './tmp'; umask(022); SKIP: { - skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare'); + skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'epoc'); is((umask(0)&0777), 022, 'umask'), } |