*
* VMS-specific routines for perl5
*
- * Last revised: 24-Apr-1999 by Charles Bailey bailey@newman.upenn.edu
- * Version: 5.5.58
+ * Last revised: 15-Aug-1999 by Charles Bailey bailey@newman.upenn.edu
+ * Version: 5.5.60
*/
#include <acedef.h>
static struct dsc$descriptor_s **env_tables = defenv;
static bool will_taint = FALSE; /* tainting active, but no PL_curinterp yet */
+/* True if we shouldn't treat barewords as logicals during directory */
+/* munching */
+static int no_translate_barewords;
+
/*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */
int
vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
if (*dir) strcpy(trndir,dir);
else getcwd(trndir,sizeof trndir - 1);
- while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir,0)) {
+ while (!strpbrk(trndir,"/]:>") && !no_translate_barewords
+ && my_trnlnm(trndir,trndir,0)) {
STRLEN trnlen = strlen(trndir);
/* Trap simple rooted lnms, and return lnm:[000000] */
my_flush(FILE *fp)
{
int res;
- if ((res = fflush(fp)) == 0) {
+ if ((res = fflush(fp)) == 0 && fp) {
#ifdef VMS_DO_SOCKETS
Stat_t s;
if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
# define RTL_USES_UTC 1
#endif
+/*
+ * DEC C previous to 6.0 corrupts the behavior of the /prefix
+ * qualifier with the extern prefix pragma. This provisional
+ * hack circumvents this prefix pragma problem in previous
+ * precompilers.
+ */
+#if defined(__VMS_VER) && __VMS_VER >= 70000000
+# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
+# pragma __extern_prefix save
+# pragma __extern_prefix "" /* set to empty to prevent prefixing */
+# define gmtime decc$__utctz_gmtime
+# define localtime decc$__utctz_localtime
+# define time decc$__utc_time
+# pragma __extern_prefix restore
+
+ struct tm *gmtime(), *localtime();
+
+# endif
+#endif
+
+
static time_t toutc_dst(time_t loc) {
struct tm *rsltmp;
if (rsltmp->tm_isdst) loc -= 3600;
return loc;
}
-#define _toutc(secs) ((secs) == -1 ? -1 : \
+#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toutc_dst(secs) : \
((secs) - utc_offset_secs))))
if (rsltmp->tm_isdst) utc += 3600;
return utc;
}
-#define _toloc(secs) ((secs) == -1 ? -1 : \
+#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toloc_dst(secs) : \
((secs) + utc_offset_secs))))
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
* subset of the applicable information.
*/
-/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
-I32
-Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t *statbufp)
+bool
+Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
{
if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
else {
/*}}}*/
-/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/
+/*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/
I32
-cando_by_name(I32 bit, I32 effective, char *fname)
+cando_by_name(I32 bit, Uid_t effective, char *fname)
{
static char usrname[L_cuserid];
static struct dsc$descriptor_s usrdsc =
init_os_extras()
{
char* file = __FILE__;
+ dTHX;
+ char temp_buff[512];
+ if (my_trnlnm("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", temp_buff, 0)) {
+ no_translate_barewords = TRUE;
+ } else {
+ no_translate_barewords = FALSE;
+ }
newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$;$");
newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");