Index: README.epoc =================================================================== RCS file: /home/of/devel/CVS/perl/README.epoc,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.5 diff -c -r1.1.1.1 -r1.1.1.1.2.5 *** README.epoc 2000/11/15 20:49:40 1.1.1.1 --- README.epoc 2000/11/15 21:09:01 1.1.1.1.2.5 *************** *** 3,10 **** ===================================================================== Olaf Flebbe ! http://www.linuxstart.com/~oflebbe/perl/perl5.html ! 2000-02-20 ===================================================================== Introduction --- 3,10 ---- ===================================================================== Olaf Flebbe ! http://members.linuxstart.com/~oflebbe/perl/perl5.html ! 2000-09-18 ===================================================================== Introduction *************** *** 13,24 **** EPOC is a OS for palmtops and mobile phones. For more informations look at: http://www.symbian.com/ ! This is a port of Perl version 5.5.650 to EPOC. It runs on the Perl ! Series 5, Series 5mx and the Psion Revo. I have no reports for other ! EPOC devices. - Features are left out, because of restrictions of the POSIX support. - ===================================================================== Installation/Usage ===================================================================== --- 13,23 ---- EPOC is a 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 the Psion Series 5, 5mx, ! 5mx Pro, Psion Revo and on the Ericson M128. I have no report about ! the Psion Netbook or the S7. For information about this hardware ! please refer to http://www.psion.com. ===================================================================== Installation/Usage ===================================================================== *************** *** 33,44 **** this version. (For details look into epoc/createpkg.pl). If you like to use them, you are free to copy them from a current perl release. ! Copy eshell.exe from the same page you got perl to your EPOC device. ! Start eshell.exe with a double tap. Now you can enter: perl -de 0 in order to run the perl debugger. If you are leaving perl, you get into the system screen. You have to ! switch back manually to eshell.exe When perl is running, you will see a task with the name STDOUT in the task list. ====================================================================== --- 32,43 ---- this version. (For details look into epoc/createpkg.pl). If you like to use them, you are free to copy them from a current perl release. ! Get ESHELL from symbian: ! http://developer.epocworld.com/downloads/progs/Eshell.zip Now you can enter: perl -de 0 in order to run the perl debugger. If you are leaving perl, you get into the system screen. You have to ! switch back manually to ESHELL. When perl is running, you will see a task with the name STDOUT in the task list. ====================================================================== *************** *** 58,93 **** ====================================================================== PATH Names ====================================================================== - - Pathnames to executables in eshell.exe have to be written with - backslashes '\', file arguments to perl with slashes '/'. The default - drive of perl is the same as the drive perl.exe is located on, the - default path seems to be '/'. ! i.e. command lines look a little bit funny: ! D:\perl.exe C:/test.pl >C:/output.txt You can automatically search for file on all EPOC drives with a ? as ! the driver letter. For instance ?:\a.txt seraches for C:\a.txt, D:\b.txt (and Z:\a.txt). ====================================================================== Editors ====================================================================== ! You may have a problem to create perl scripts. A cumbersome workaround ! is to use the OPL Editor and exporting to text. ! The OPL+ Editor is quite good. (Shareware: http://www.twiddlebit.com) ! There is a port of vim around: ! http://www.starship.freeserve.co.uk/index.html ====================================================================== Restrictions ====================================================================== ! The following things are left out of this perl port: + backquoting, pipes etc. --- 57,104 ---- ====================================================================== PATH Names ====================================================================== ! 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. ! ! EPOC uses the ?: syntax for establishing a search order: First in C: (RAM), ! then on D: (CF Card) and last in Z: (ROM). ! ! The perl @INC search path is now implemented with '?:'. Your perl ! executable can now 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 You can automatically search for file on all EPOC drives with a ? as ! the driver letter. For instance ?:\a.txt searches for C:\a.txt, D:\b.txt (and Z:\a.txt). ====================================================================== Editors ====================================================================== + + A suitable text-editor can be downloaded + from symbian http://developer.epocworld.com/downloads/progs/Editor.zip ! ==================================================================== ! Features ! ==================================================================== ! The built-in function EPOC::getcwd returns the current directory. ====================================================================== Restrictions ====================================================================== ! Features are left out, because of restrictions of the POSIX support in ! EPOC: + backquoting, pipes etc. *************** *** 119,125 **** You will need the C++ SDK from http://developer.epocworld.com/. You will need to set up the cross SDK from ! http://www.linuxstart.com/~oflebbe You may have to adjust config.sh (cc, cppflags) for your epoc install location. --- 130,136 ---- You will need the C++ SDK from http://developer.epocworld.com/. You will need to set up the cross SDK from ! http://members.linuxstart.com/~oflebbe You may have to adjust config.sh (cc, cppflags) for your epoc install location. *************** *** 131,160 **** Unpack the sources. Build a native perl from this sources... cp epoc/* . ./Configure -S ! make perl cp miniperl.native miniperl make perl perl link.pl perlmain.o lib/auto/DynaLoader/DynaLoader.a \ ! lib/auto/Data/Dumper.a \ lib/auto/File/Glob/Glob.a lib/auto/IO/IO.a \ ! lib/auto/Socket/Socket.a perl.a `cat ext.libs` perl createpkg.pl - wine "G:/bin/makesis perl.pkg perl.sis" - ! ==================================================================== ! Wish List ! ==================================================================== - - Threads ? - - Acess to the GUI? ==================================================================== Support Status ==================================================================== ! I'm offering this port "as is". You can ask me questions, but I can't ! guarantee I'll be able to answer them; I don't know much about Perl ! internals myself; --- 142,168 ---- Unpack the sources. Build a native perl from this sources... + cp epoc/* . ./Configure -S ! make perl.a cp miniperl.native miniperl make perl + make ext/Errno/pm_to_blib perl link.pl perlmain.o lib/auto/DynaLoader/DynaLoader.a \ ! lib/auto/Data/Dumper/Dumper.a \ lib/auto/File/Glob/Glob.a lib/auto/IO/IO.a \ ! lib/auto/Socket/Socket.a \ ! lib/auto/Fcntl/Fcntl.a lib/auto/Sys/Hostname/Hostname.a \ ! perl.a `cat ext.libs` perl createpkg.pl ! wine G:/bin/makesis perl.pkg perl.sis ==================================================================== Support Status ==================================================================== ! I'm offering this port "as is". You can ask me questions, but I can't ! guarantee I'll be able to answer them. Index: mg.c =================================================================== RCS file: /home/of/devel/CVS/perl/mg.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** mg.c 2000/11/15 20:49:40 1.1.1.1 --- mg.c 2000/11/15 21:07:33 1.1.1.1.2.1 *************** *** 903,909 **** int Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) { ! #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else # ifdef PERL_IMPLICIT_SYS --- 903,909 ---- int Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) { ! #if defined(VMS) || defined(EPOC) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else # ifdef PERL_IMPLICIT_SYS Index: perl.c =================================================================== RCS file: /home/of/devel/CVS/perl/perl.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** perl.c 2000/11/15 20:49:40 1.1.1.1 --- perl.c 2000/11/15 21:07:33 1.1.1.1.2.2 *************** *** 817,823 **** PL_origargv = argv; PL_origargc = argc; ! #ifndef VMS /* VMS doesn't have environ array */ PL_origenviron = environ; #endif --- 817,823 ---- PL_origargv = argv; PL_origargc = argc; ! #if !defined( VMS) && !defined(EPOC) /* VMS doesn't have environ array */ PL_origenviron = environ; #endif *************** *** 1225,1231 **** if (xsinit) (*xsinit)(aTHXo); /* in case linked C routines want magical variables */ ! #if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) init_os_extras(); #endif --- 1225,1231 ---- if (xsinit) (*xsinit)(aTHXo); /* in case linked C routines want magical variables */ ! #if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC) init_os_extras(); #endif *************** *** 3188,3194 **** GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, PL_envgv, 'E'); ! #if !defined( VMS) && !defined(EPOC) /* VMS doesn't have 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 --- 3188,3194 ---- GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, PL_envgv, 'E'); ! #if !defined( VMS) && !defined(EPOC) /* VMS doesn't have 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 *************** *** 3311,3317 **** incpush(".", FALSE, FALSE); } ! #if defined(DOSISH) # define PERLLIB_SEP ';' #else # if defined(VMS) --- 3311,3317 ---- incpush(".", FALSE, FALSE); } ! #if defined(DOSISH) || defined(EPOC) # define PERLLIB_SEP ';' #else # if defined(VMS) Index: perl.h =================================================================== RCS file: /home/of/devel/CVS/perl/perl.h,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** perl.h 2000/11/15 20:49:40 1.1.1.1 --- perl.h 2000/11/15 21:07:33 1.1.1.1.2.1 *************** *** 2210,2216 **** # if !defined(DONT_DECLARE_STD) || \ (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ defined(__sgi) || \ ! defined(__DGUX) || defined(EPOC) extern char ** environ; /* environment variables supplied via exec */ # endif # endif --- 2210,2216 ---- # if !defined(DONT_DECLARE_STD) || \ (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ defined(__sgi) || \ ! defined(__DGUX) extern char ** environ; /* environment variables supplied via exec */ # endif # endif Index: pp_sys.c =================================================================== RCS file: /home/of/devel/CVS/perl/pp_sys.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** pp_sys.c 2000/11/15 20:49:41 1.1.1.1 --- pp_sys.c 2000/11/15 21:09:01 1.1.1.1.2.1 *************** *** 2277,2282 **** --- 2277,2286 ---- fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ #endif + #ifdef EPOC + len = sizeof saddr; /* EPOC somehow truncates info */ + #endif + PUSHp((char *)&saddr, len); RETURN; Index: sv.c =================================================================== RCS file: /home/of/devel/CVS/perl/sv.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** sv.c 2000/11/15 20:49:41 1.1.1.1 --- sv.c 2000/11/15 21:07:33 1.1.1.1.2.1 *************** *** 4887,4893 **** } if (GvHV(gv) && !HvNAME(GvHV(gv))) { hv_clear(GvHV(gv)); ! #ifndef VMS /* VMS has no environ array */ if (gv == PL_envgv) environ[0] = Nullch; #endif --- 4887,4893 ---- } if (GvHV(gv) && !HvNAME(GvHV(gv))) { hv_clear(GvHV(gv)); ! #if !defined( VMS) && !defined(EPOC) /* VMS has no environ array */ if (gv == PL_envgv) environ[0] = Nullch; #endif Index: util.c =================================================================== RCS file: /home/of/devel/CVS/perl/util.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** util.c 2000/11/15 20:49:41 1.1.1.1 --- util.c 2000/11/15 21:07:33 1.1.1.1.2.1 *************** *** 1880,1887 **** } } ! #ifndef VMS /* VMS' my_setenv() is in VMS.c */ ! #if !defined(WIN32) && !defined(__CYGWIN__) void Perl_my_setenv(pTHX_ char *nam, char *val) { --- 1880,1888 ---- } } ! #if !defined( VMS) && !defined(EPOC) ! /* VMS' and EPOC's my_setenv() is in VMS.c */ ! #if !defined(WIN32) && !defined(__CYGWIN__) && void Perl_my_setenv(pTHX_ char *nam, char *val) { *************** *** 2047,2053 **** return i; } ! #endif /* !VMS */ #ifdef UNLINK_ALL_VERSIONS I32 --- 2048,2054 ---- return i; } ! #endif /* !VMS && !EPOC*/ #ifdef UNLINK_ALL_VERSIONS I32 Index: util.h =================================================================== RCS file: /home/of/devel/CVS/perl/util.h,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** util.h 2000/11/15 20:49:41 1.1.1.1 --- util.h 2000/11/15 21:05:40 1.1.1.1.2.1 *************** *** 21,31 **** || ((f)[0] && (f)[1] == ':') /* drive name */ \ || ((f)[0] == '\\' && (f)[1] == '\\')) /* UNC path */ # else /* !WIN32 */ ! # ifdef DOSISH # define PERL_FILE_IS_ABSOLUTE(f) \ (*(f) == '/' \ || ((f)[0] && (f)[1] == ':')) /* drive name */ ! # else /* !DOSISH */ # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') # endif /* DOSISH */ # endif /* WIN32 */ --- 21,31 ---- || ((f)[0] && (f)[1] == ':') /* drive name */ \ || ((f)[0] == '\\' && (f)[1] == '\\')) /* UNC path */ # else /* !WIN32 */ ! # if defined( DOSISH) || defined(EPOC) # define PERL_FILE_IS_ABSOLUTE(f) \ (*(f) == '/' \ || ((f)[0] && (f)[1] == ':')) /* drive name */ ! # else /* !DOSISH AND !EPOCISH */ # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') # endif /* DOSISH */ # endif /* WIN32 */ Index: epoc/config.sh =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/config.sh,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.4 diff -c -r1.1.1.1 -r1.1.1.1.2.4 *** epoc/config.sh 2000/11/15 20:49:41 1.1.1.1 --- epoc/config.sh 2000/11/15 21:07:35 1.1.1.1.2.4 *************** *** 33,40 **** apisubversion='' apiversion='' ar='arm-pe-ar' ! archlib='/perl/lib/5.6.0/epoc' ! archlibexp='/perl/lib/5.6.0/epoc' archname64='' archname='epoc' archobjs='epoc.o epocish.o epoc_stubs.o' --- 33,40 ---- apisubversion='' apiversion='' ar='arm-pe-ar' ! archlib='?:/perl/lib/5.6.0/epoc' ! archlibexp='?:/perl/lib/5.6.0/epoc' archname64='' archname='epoc' archobjs='epoc.o epocish.o epoc_stubs.o' *************** *** 79,85 **** crosscompile='define' cryptlib='' csh='csh' ! d_Gconvert='sprintf((b),"%.*g",(n),(x))' d_PRIEldbl='undef' d_PRIFldbl='undef' d_PRIGldbl='undef' --- 79,85 ---- crosscompile='define' cryptlib='' csh='csh' ! d_Gconvert='epoc_gcvt((x),(n),(b))' d_PRIEldbl='undef' d_PRIFldbl='undef' d_PRIGldbl='undef' *************** *** 193,199 **** d_iconv='undef' d_index='undef' d_inetaton='define' ! d_int64t='undef' d_iovec_s='undef' d_isascii='define' d_killpg='undef' --- 193,199 ---- d_iconv='undef' d_index='undef' d_inetaton='define' ! d_int64_t='undef' d_iovec_s='undef' d_isascii='define' d_killpg='undef' *************** *** 381,387 **** eunicefix=':' exe_ext='' expr='expr' ! extensions='Data/Dumper File/Glob IO Socket' fflushNULL='undef' fflushall='define' find='' --- 381,387 ---- eunicefix=':' exe_ext='' expr='expr' ! extensions='Data/Dumper File/Glob IO Socket Fcntl Sys/Hostname Errno' fflushNULL='undef' fflushall='define' find='' *************** *** 478,498 **** ignore_versioned_solibs='' incpath='' inews='' ! installarchlib='/home/olaf/E/lib' ! installbin='/home/olaf/E/bin' ! installman1dir='' ! installman3dir='' ! installprefix='/home/olaf/' installprefixexp='' ! installprivlib='' ! installscript='' ! installsitearch='/home/olaf/E/site/' ! installsitelib='/home/olaf/E/site/lib' installstyle='' installusrbinperl='undef' installvendorlib='' intsize='4' ! known_extensions='Data/Dumper File/Glob IO Socket' ksh='' large='' ld='echo' --- 478,498 ---- ignore_versioned_solibs='' incpath='' inews='' ! installarchlib='/home/of/PERL/perl/lib/5.6.0/epoc' ! installbin='/home/of/PERL/System/Programs/' ! installman1dir='/home/of/PERL/man1' ! installman3dir='/home/of/PERL/man3' ! installprefix='' installprefixexp='' ! installprivlib='/home/of/PERL/perl/lib/5.6.0/' ! installscript='/home/of/PERL/bin/' ! installsitearch='/home/of/PERL/site/lib/site_perl/5.6.0/epoc' ! installsitelib='/home/of/PERL/perl/lib/site_perl/5.6.0' installstyle='' installusrbinperl='undef' installvendorlib='' intsize='4' ! known_extensions='Data/Dumper File/Glob IO Socket Fcntl Sys/Hostname Errno' ksh='' large='' ld='echo' *************** *** 556,562 **** nm='arm-pe-nm' nm_opt='' nm_so_opt='' ! nonxs_ext='' nroff='nroff' o_nonblock='O_NONBLOCK' obj_ext='' --- 556,562 ---- nm='arm-pe-nm' nm_opt='' nm_so_opt='' ! nonxs_ext='Errno' nroff='nroff' o_nonblock='O_NONBLOCK' obj_ext='' *************** *** 569,575 **** pager='' passcat='' patchlevel='' ! path_sep='' perl='' perladmin='' perlpath='' --- 569,575 ---- pager='' passcat='' patchlevel='' ! path_sep=':' perl='' perladmin='' perlpath='' *************** *** 581,588 **** pr='' prefix='' prefixexp='' ! privlib='/perl/lib/5.6.0' ! privlibexp='/perl/lib/5.6.0' prototype='define' ptrsize='4' randbits='31' --- 581,588 ---- pr='' prefix='' prefixexp='' ! privlib='?:/perl/lib/5.6.0' ! privlibexp='?:/perl/lib/5.6.0' prototype='define' ptrsize='4' randbits='31' *************** *** 626,636 **** sig_num='0' sig_num_init='0, 0' signal_t='void' ! sitearch='/perl/lib/site_perl/5.6.0/epoc' ! sitearchexp='/perl/lib/site_perl/5.6.0/epoc' ! sitelib='/perl/lib/site_perl/5.6.0/' ! sitelib_stem='/perl/lib/site_perl' ! sitelibexp='/perl/lib/site_perl/5.6.0/' siteprefix='' siteprefixexp='' sizesize='4' --- 626,636 ---- sig_num='0' sig_num_init='0, 0' signal_t='void' ! sitearch='?:/perl/lib/site_perl/5.6.0/epoc' ! sitearchexp='?:/perl/lib/site_perl/5.6.0/epoc' ! sitelib='?:/perl/lib/site_perl/5.6.0/' ! sitelib_stem='?:/perl/lib/site_perl' ! sitelibexp='?:/perl/lib/site_perl/5.6.0/' siteprefix='' siteprefixexp='' sizesize='4' *************** *** 639,645 **** smail='' small='' so='' ! socksizetype='int' sockethdr='' socketlib='' sort='sort' --- 639,645 ---- smail='' small='' so='' ! socksizetype='size_t' sockethdr='' socketlib='' sort='sort' *************** *** 650,656 **** ssizetype='long' startperl='' startsh='#!/bin/sh' ! static_ext='Data/Dumper File/Glob IO Socket' stdchar='char' stdio_base='' stdio_bufsiz='' --- 650,656 ---- ssizetype='long' startperl='' startsh='#!/bin/sh' ! static_ext='Data/Dumper File/Glob IO Socket Fcntl Sys/Hostname' stdchar='char' stdio_base='' stdio_bufsiz='' *************** *** 787,789 **** --- 787,945 ---- useithreads='undef' inc_version_list=' ' inc_version_list_init='0' + d_madvise='undef' + d_mkdtemp='undef' + d_mkstemp='undef' + d_mkstemps='undef' + d_mmap='undef' + d_mprotect='undef' + d_msync='undef' + d_munmap='undef' + d_qgcvt='undef' + d_socklen_t='undef' + d_vendorarch='' + i_iconv='undef' + i_ieeefp='undef' + i_sunmath='undef' + i_syslog='undef' + i_sysmman='undef' + i_sysutsname='undef' + installvendorarch='' + mmaptype='' + revision='5' + sizesize='4' + socksizetype='int' + + double='undef' + usemorebits='undef' + usemultiplicity='undef' + usemymalloc='n' + usenm='' + useopcode='' + useperlio='undef' + useposix='' + usesfio='' + useshrplib='' + usesocks='undef' + usethreads='undef' + usevendorprefix='' + usevfork='' + usrinc='' + uuname='' + vendorlib='' + vendorlib_stem='' + vendorlibexp='' + vendorprefix='' + vendorprefixexp='' + version='5.6.0' + vi='' + voidflags='15' + xlibpth='' + zcat='' + zip='' + # Configure command line arguments. + config_arg0='' + config_args='' + config_argc=11 + config_arg1='' + config_arg2='' + config_arg3='' + config_arg4='' + config_arg5='' + config_arg6='' + config_arg7='' + config_arg8='' + config_arg9='' + config_arg10='' + config_arg11='' + PERL_REVISION=5 + PERL_VERSION=6 + PERL_SUBVERSION=0 + PERL_API_REVISION=5 + PERL_API_VERSION=6 + PERL_API_SUBVERSION=0 + CONFIGDOTSH=true + # Variables propagated from previous config.sh file. + pp_sys_cflags='' + epocish_cflags='ccflags="$cflags -xc++"' + ivtype='int' + uvtype='unsigned int' + i8type='char' + u8type='unsigned char' + i16type='short' + u16type='unsigned short' + i32type='int' + u32type='unsigned int' + i64type='long long' + u64type='unsigned long long' + d_quad='define' + quadtype='long long' + quadtype='unsigned long long' + quadkind='QUAD_IS_LONG_LONG' + nvtype='double' + ivsize='4' + uvsize='4' + i8size='1' + u8size='1' + i16size='2' + u16size='2' + i32size='4' + u32size='4' + i64size='8' + u64size='8' + d_fs_data_s='undef' + d_fseeko='undef' + d_ldbl_dig='undef' + d_sqrtl='undef' + d_getmnt='undef' + d_statfs_f_flags='undef' + d_statfs_s='undef' + d_ustat='undef' + i_sysstatfs='undef' + i_sysvfs='undef' + i_ustat='undef' + uidsize='2' + uidsign='1' + gidsize='2' + gidsign='1' + ivdformat='"ld"' + uvuformat='"lu"' + uvoformat='"lo"' + uvxformat='"lx"' + uidformat='"hu"' + gidformat='"hu"' + d_strtold='undef' + d_strtoll='undef' + d_strtouq='undef' + d_nv_preserves_uv='define' + use5005threads='undef' + useithreads='undef' + inc_version_list=' ' + inc_version_list_init='0' + d_madvise='undef' + d_mkdtemp='undef' + d_mkstemp='undef' + d_mkstemps='undef' + d_mmap='undef' + d_mprotect='undef' + d_msync='undef' + d_munmap='undef' + d_qgcvt='undef' + d_socklen_t='undef' + d_vendorarch='' + i_iconv='undef' + i_ieeefp='undef' + i_sunmath='undef' + i_syslog='undef' + i_sysmman='undef' + i_sysutsname='undef' + installvendorarch='' + mmaptype='' + revision='5' + sizesize='4' + socksizetype='int' + xs_apiversion='5.005' + d_getcwd='define' + i_sysmode='undef' + d_vendorarch='undef' + Index: epoc/createpkg.pl =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/createpkg.pl,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.6 diff -c -r1.1.1.1 -r1.1.1.1.2.6 *** epoc/createpkg.pl 2000/11/15 20:49:41 1.1.1.1 --- epoc/createpkg.pl 2000/11/19 19:15:45 1.1.1.1.2.6 *************** *** 3,13 **** use File::Find; use Cwd; ! $VERSION="5.5"; ! $PATCH="650"; ! $EPOC_VERSION=19; $CROSSCOMPILEPATH=cwd; ! $CROSSREPLACEPATH="H:\\devel\\perl5.5.650"; sub filefound { --- 3,13 ---- use File::Find; use Cwd; ! $VERSION="5.6"; ! $PATCH="0"; ! $EPOC_VERSION=25; $CROSSCOMPILEPATH=cwd; ! $CROSSREPLACEPATH="H:\\perl"; sub filefound { *************** *** 32,38 **** print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; ! print OUT "\"$CROSSREPLACEPATH\\perlmain.exe\"-\"!:\\perl.exe\"\n"; find(\&filefound, cwd.'/lib'); print OUT "@\"G:\\lib\\stdlib.sis\",(0x0100002c3)\n" --- 32,38 ---- print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; ! print OUT "\"$CROSSREPLACEPATH\\perlmain.exe\"-\"!:\\system\\programs\\perl.exe\"\n"; find(\&filefound, cwd.'/lib'); print OUT "@\"G:\\lib\\stdlib.sis\",(0x0100002c3)\n" Index: epoc/epoc.c =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/epoc.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** epoc/epoc.c 2000/11/15 20:49:41 1.1.1.1 --- epoc/epoc.c 2000/11/15 21:07:35 1.1.1.1.2.2 *************** *** 58,63 **** --- 58,64 ---- } + #ifdef __MARM__ /* Symbian forgot to include __fixunsdfi into the MARM euser.lib */ /* This is from libgcc2.c , gcc-2.7.2.3 */ *************** *** 86,91 **** --- 87,94 ---- return (SItype) a; } + #endif + #include "EXTERN.h" #include "perl.h" #include "XSUB.h" *************** *** 143,147 **** return rc; } ! ! #endif --- 146,209 ---- return rc; } ! static ! XS(epoc_getcwd) /* more or less stolen from win32.c */ ! { ! dXSARGS; ! /* Make the host for current directory */ ! char *buffer; ! int buflen = 256; ! ! char *ptr; ! buffer = (char *) malloc( buflen); ! if (buffer == NULL) { ! XSRETURN_UNDEF; ! } ! while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) { ! buflen *= 2; ! if (NULL == realloc( buffer, buflen)) { ! XSRETURN_UNDEF; ! } ! ! } ! ! /* ! * If ptr != Nullch ! * then it worked, set PV valid, ! * else return 'undef' ! */ ! ! if (ptr) { ! SV *sv = sv_newmortal(); ! char *tptr; ! ! for (tptr = ptr; *tptr != '\0'; tptr++) { ! if (*tptr == '\\') { ! *tptr = '/'; ! } ! } ! sv_setpv(sv, ptr); ! free( buffer); ! ! EXTEND(SP,1); ! SvPOK_on(sv); ! ST(0) = sv; ! XSRETURN(1); ! } ! free( buffer); ! XSRETURN_UNDEF; ! } ! ! ! void ! Perl_init_os_extras(void) ! { ! dTHXo; ! char *file = __FILE__; ! newXS("EPOC::getcwd", epoc_getcwd, file); ! } ! ! void ! Perl_my_setenv(pTHX_ char *nam,char *val) { ! setenv( nam, val, 1); ! } Index: epoc/epoc_stubs.c =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/epoc_stubs.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** epoc/epoc_stubs.c 2000/11/15 20:49:41 1.1.1.1 --- epoc/epoc_stubs.c 2000/11/15 21:07:35 1.1.1.1.2.1 *************** *** 8,15 **** #include - char *environ = 0; - int getgid() {return 0;} int getegid() {return 0;} int geteuid() {return 0;} --- 8,13 ---- *************** *** 31,37 **** int execv() { return -1;} int execvp() { return -1;} ! void Perl_do_exec() {} /*------------------------------------------------------------------*/ /* Two dummy functions implement getproto* */ --- 29,35 ---- int execv() { return -1;} int execvp() { return -1;} ! void Perl_do_exec() {} /*------------------------------------------------------------------*/ /* Two dummy functions implement getproto* */ Index: epoc/epocish.c =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/epocish.c,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** epoc/epocish.c 2000/11/15 20:49:41 1.1.1.1 --- epoc/epocish.c 2000/11/15 21:09:03 1.1.1.1.2.2 *************** *** 6,12 **** * */ ! /* This is indeed C++ Code !! */ #include --- 6,12 ---- * */ ! /* This is C++ Code !! */ #include *************** *** 31,34 **** --- 31,59 ---- return 0; } + + /* Workaround for defect atof(), see java defect list for epoc */ + double epoc_atof( char* str) { + TReal64 aRes; + + while (TChar( *str).IsSpace()) { + str++; + } + + TLex lex( _L( str)); + TInt err = lex.Val( aRes, TChar( '.')); + return aRes; + } + + void epoc_gcvt( double x, int digits, unsigned char *buf) { + TRealFormat trel; + + trel.iPlaces = digits; + trel.iPoint = TChar( '.'); + + TPtr result( buf, 80); + + result.Num( x, trel); + result.Append( TChar( 0)); + } } Index: epoc/epocish.h =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/epocish.h,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** epoc/epocish.h 2000/11/15 20:49:41 1.1.1.1 --- epoc/epocish.h 2000/11/15 21:05:42 1.1.1.1.2.2 *************** *** 121,129 **** /* getsockname returns the size of struct sockaddr_in *without* padding */ #define BOGUS_GETNAME_RETURN 8 - /* Yes, size_t is size_t */ - #define Sock_size_t size_t - /* read() on a socket blocks until buf is filled completly, recv() returns each massage --- 121,126 ---- *************** *** 133,135 **** --- 130,143 ---- /* No /dev/random available*/ #define PERL_NO_DEV_RANDOM + + /* + work around for buggy atof(): + atof() in ER5 stdlib depends on locale. + */ + + double epoc_atof( const char *ptr); + #define atof(a) epoc_atof(a) + + # define init_os_extras Perl_init_os_extras + Index: epoc/link.pl =================================================================== RCS file: /home/of/devel/CVS/perl/epoc/link.pl,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** epoc/link.pl 2000/11/15 20:49:41 1.1.1.1 --- epoc/link.pl 2000/11/15 21:09:03 1.1.1.1.2.2 *************** *** 15,25 **** "--base-file $basname.bas $epoc/lib/eexe.o @objs " . "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); ! system("arm-pe-ld -s -e _E32Startup -o $basname.exe $basname.exp " . "-o $baspe.exe $epoc/lib/eexe.o @objs " . "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); ! system( "wine \"$epoc/bin/petran.exe $baspe.exe $basname.exe " . "-nocall -heap 0x00000400 0x00400000 -stack 0x0000c000 " . ! "-uid1 0x1000007a -uid2 0x100051d8 -uid3 0x00000000 \" "); --- 15,25 ---- "--base-file $basname.bas $epoc/lib/eexe.o @objs " . "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); ! system("arm-pe-ld -s -e _E32Startup $basname.exp " . "-o $baspe.exe $epoc/lib/eexe.o @objs " . "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); ! system( "wine $epoc/bin/petran.exe \"$baspe.exe $basname.exe " . "-nocall -heap 0x00000400 0x00400000 -stack 0x0000c000 " . ! "-uid1 0x1000007a -uid2 0x100051d8 -uid3 0x00000000\" "); Index: lib/AutoLoader.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/AutoLoader.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/AutoLoader.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/AutoLoader.pm 2000/11/15 21:05:45 1.1.1.1.2.1 *************** *** 4,9 **** --- 4,10 ---- our(@EXPORT, @EXPORT_OK, $VERSION); my $is_dosish; + my $is_epoc; my $is_vms; BEGIN { *************** *** 11,16 **** --- 12,18 ---- @EXPORT = @EXPORT = (); @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD); $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32'; + $is_epoc = $^O eq 'epoc'; $is_vms = $^O eq 'VMS'; $VERSION = '5.57'; } *************** *** 51,57 **** $filename = "./$filename"; } } ! elsif ($is_vms) { # XXX todo by VMSmiths $filename = "./$filename"; } --- 53,63 ---- $filename = "./$filename"; } } ! elsif ($is_epoc) { ! unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { ! $filename = "./$filename"; ! } ! }elsif ($is_vms) { # XXX todo by VMSmiths $filename = "./$filename"; } Index: lib/CGI.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/CGI.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/CGI.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/CGI.pm 2000/11/15 21:09:04 1.1.1.1.2.1 *************** *** 17,23 **** # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ ! $CGI::revision = '$Id: CGI.pm,v 1.1.1.1 2000/11/15 20:49:44 of Exp $'; $CGI::VERSION='2.56'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. --- 17,23 ---- # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ ! $CGI::revision = '$Id: CGI.pm,v 1.1.1.1.2.1 2000/11/15 21:09:04 of Exp $'; $CGI::VERSION='2.56'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. *************** *** 103,108 **** --- 103,110 ---- $OS = 'MACINTOSH'; } elsif ($OS=~/os2/i) { $OS = 'OS2'; + } elsif ($OS=~/epoc/) { + $OS = 'EPOC'; } else { $OS = 'UNIX'; } *************** *** 119,125 **** # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { ! UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' }->{$OS}; # This no longer seems to be necessary --- 121,127 ---- # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { ! UNIX=>'/', EPOC=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' }->{$OS}; # This no longer seems to be necessary *************** *** 3281,3287 **** @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", "C:${SL}temp","${SL}tmp","${SL}temp", "${vol}${SL}Temporary Items","${SL}sys\$scratch", ! "${SL}WWW_ROOT"); unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'}; # --- 3283,3289 ---- @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", "C:${SL}temp","${SL}tmp","${SL}temp", "${vol}${SL}Temporary Items","${SL}sys\$scratch", ! "${SL}WWW_ROOT", "C:${SL}system${SL}temp"); unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'}; # Index: lib/Cwd.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/Cwd.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.2 diff -c -r1.1.1.1 -r1.1.1.1.2.2 *** lib/Cwd.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/Cwd.pm 2000/11/19 19:15:06 1.1.1.1.2.2 *************** *** 338,343 **** --- 338,348 ---- return $realpath; } + sub _epoc_cwd { + $ENV{'PWD'} = EPOC::getcwd(); + return $ENV{'PWD'}; + } + { no warnings; # assignments trigger 'subroutine redefined' warning *************** *** 384,389 **** --- 389,401 ---- *getcwd = \&cwd; *fastgetcwd = \&cwd; *fastcwd = \&cwd; + *abs_path = \&fast_abs_path; + } + elsif ($^O eq 'epoc') { + *cwd = \&_epoc_cwd; + *getcwd = \&_epoc_cwd; + *fastgetcwd = \&_epoc_cwd; + *fastcwd = \&_epoc_cwd; *abs_path = \&fast_abs_path; } } Index: lib/File/Basename.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/File/Basename.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/File/Basename.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/File/Basename.pm 2000/11/19 19:15:08 1.1.1.1.2.1 *************** *** 176,182 **** $dirpath ||= ''; # should always be defined } } ! if ($fstype =~ /^MS(DOS|Win32)/i) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/; } --- 176,182 ---- $dirpath ||= ''; # should always be defined } } ! if ($fstype =~ /^MS(DOS|Win32)|epoc/i) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/; } Index: lib/File/Find.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/File/Find.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/File/Find.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/File/Find.pm 2000/11/19 19:15:08 1.1.1.1.2.1 *************** *** 721,727 **** } $File::Find::dont_use_nlink = 1 ! if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; # 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 --- 721,728 ---- } $File::Find::dont_use_nlink = 1 ! if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || ! $^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 Index: lib/File/Path.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/File/Path.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/File/Path.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/File/Path.pm 2000/11/15 21:09:06 1.1.1.1.2.1 *************** *** 106,112 **** # 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'); sub mkpath { my($paths, $verbose, $mode) = @_; --- 106,112 ---- # 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 'epoc'); sub mkpath { my($paths, $verbose, $mode) = @_; Index: lib/File/Spec.pm =================================================================== RCS file: /home/of/devel/CVS/perl/lib/File/Spec.pm,v retrieving revision 1.1.1.1 retrieving revision 1.1.1.1.2.1 diff -c -r1.1.1.1 -r1.1.1.1.2.1 *** lib/File/Spec.pm 2000/11/15 20:49:44 1.1.1.1 --- lib/File/Spec.pm 2000/11/15 21:09:06 1.1.1.1.2.1 *************** *** 8,14 **** my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', ! VMS => 'VMS'); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; --- 8,16 ---- my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', ! VMS => 'VMS', ! epoc => 'Epoc' ! ); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; Index: lib/File/Spec/Epoc.pm =================================================================== RCS file: Epoc.pm diff -N Epoc.pm *** /dev/null Thu Aug 24 11:00:32 2000 --- /tmp/cvsRjIoHF Sun Nov 19 20:34:36 2000 *************** *** 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;