From 8af62fee448e181e9ce6fbe9ee4ec3baaad1fbd1 Mon Sep 17 00:00:00 2001 From: Igor Todorovski Date: Sun, 18 May 2025 08:56:02 -0600 Subject: [PATCH] Restructure handling extra statbuf flags on z/OS z/OS has extra fields which give the character set associated with the object. Previously, there were a bunch of functions called to deal with these. This all falls away if we #ifdef these fields when accessing the structure. --- doio.c | 69 ++++++++++------------------------------------------- installperl | 4 ---- iperlsys.h | 17 ++----------- util.c | 37 ---------------------------- 4 files changed, 14 insertions(+), 113 deletions(-) diff --git a/doio.c b/doio.c index d0681ad6cc..f0336aa7a7 100644 --- a/doio.c +++ b/doio.c @@ -222,57 +222,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd) #endif } -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) -# include -# include - - static int setccsid(int fd, int ccsid) - { - attrib_t attr; - int rc; - - memset(&attr, 0, sizeof(attr)); - attr.att_filetagchg = 1; - attr.att_filetag.ft_ccsid = ccsid; - attr.att_filetag.ft_txtflag = 1; - - rc = __fchattr(fd, &attr, sizeof(attr)); - return rc; - } - - static void updateccsid(int fd, const char* path, int oflag, int perm) - { - int rc; - if (oflag & O_CREAT) { - rc = setccsid(fd, 819); - } - } - - int asciiopen(const char* path, int oflag) - { - int rc; - int fd = open(path, oflag); - if (fd == -1) { - return fd; - } - updateccsid(fd, path, oflag, -1); - return fd; - } - - int asciiopen3(const char* path, int oflag, int perm) - { - int rc; - int fd = open(path, oflag, perm); - if (fd == -1) { - return fd; - } - updateccsid(fd, path, oflag, perm); - return fd; - } - #endif -#endif - int Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag) { @@ -302,9 +251,6 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm) } #if defined(OEMVS) - #if (__CHARSET_LIB == 1) - #define TEMP_CCSID 819 - #endif static int Internal_Perl_my_mkstemp_cloexec(char *templte) { PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC; @@ -321,9 +267,6 @@ int Perl_my_mkstemp_cloexec(char *templte) { int tempfd = Internal_Perl_my_mkstemp_cloexec(templte); -# if defined(TEMP_CCSID) - setccsid(tempfd, TEMP_CCSID); -# endif return tempfd; } @@ -1471,6 +1414,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) #endif PL_filemode = statbuf.st_mode; fileuid = statbuf.st_uid; +#ifdef __MVS__ + int txtflag = statbuf.st_tag.ft_txtflag; + int ccsid = statbuf.st_tag.ft_ccsid; +#endif filegid = statbuf.st_gid; if (!S_ISREG(PL_filemode)) { ck_warner_d(packWARN(WARN_INPLACE), @@ -1548,6 +1495,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); if (PL_lastfd >= 0) { (void)PerlLIO_fstat(PL_lastfd,&statbuf); +#ifdef __MVS__ + __setfdccsid(PL_lastfd, (txtflag << 16) | ccsid); +#endif #ifdef HAS_FCHMOD (void)fchmod(PL_lastfd,PL_filemode); #else @@ -2558,6 +2508,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } doshell: PERL_FPU_PRE_EXEC +#if defined(OEMVS) + #if (__CHARSET_LIB == 1) + unsetenv("_TAG_REDIR_ERR"); + #endif +#endif PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); PERL_FPU_POST_EXEC S_exec_failed(aTHX_ PL_sh_path, fd, do_report); diff --git a/installperl b/installperl index 3c8af53bef..e2006c5561 100755 --- a/installperl +++ b/installperl @@ -284,7 +284,6 @@ else { strip("$installbin/$perl_verbase$ver$exe_ext"); fix_dep_names("$installbin/$perl_verbase$ver$exe_ext"); chmod(0755, "$installbin/$perl_verbase$ver$exe_ext"); - `chtag -r "$installbin/$perl_verbase$ver$exe_ext"` if ($^O eq 'os390'); } # Install library files. @@ -355,7 +354,6 @@ foreach my $file (@corefiles) { } else { chmod($NON_SO_MODE, "$installarchlib/CORE/$file"); } - `chtag -r "$installarchlib/CORE/$file"` if ($^O eq 'os390'); } } @@ -424,7 +422,6 @@ if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' && eval { CORE::link $instperl, $usrbinperl } ) || eval { symlink $expinstperl, $usrbinperl } || copy($instperl, $usrbinperl); - `chtag -r "$usrbinperl"` if ($^O eq 'os390'); $mainperl_is_instperl = 1; } @@ -719,7 +716,6 @@ sub copy_if_diff { my ($atime, $mtime) = (stat $from)[8,9]; utime $atime, $mtime, $to; } - `chtag -r "$to"` if ($^O eq "os390"); 1; } } diff --git a/iperlsys.h b/iperlsys.h index 40b3c19908..8857f0a753 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -770,21 +770,8 @@ struct IPerlLIOInfo # define PerlLIO_lstat(name, buf) PerlLIO_stat((name), (buf)) # endif # define PerlLIO_mktemp(file) mktemp((file)) -# if defined(OEMVS) -# if (__CHARSET_LIB == 1) - int asciiopen(const char* path, int oflag); - int asciiopen3(const char* path, int oflag, int perm); - -# define PerlLIO_open(file, flag) asciiopen((file), (flag)) -# define PerlLIO_open3(file, flag, perm) asciiopen3((file), (flag), (perm)) -# else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) -# endif -# else -# define PerlLIO_open(file, flag) open((file), (flag)) -# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) -# endif +# define PerlLIO_open(file, flag) open((file), (flag)) +# define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) # define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) # define PerlLIO_rename(old, new) rename((old), (new)) # define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) diff --git a/util.c b/util.c index 982a318011..dbbd184bac 100644 --- a/util.c +++ b/util.c @@ -2534,12 +2534,6 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) /* Close parent's end of error status pipe (if any) */ if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - chgfdccsid(p[THIS], 819); - chgfdccsid(p[THAT], 819); - #endif -#endif /* Now dup our end of _the_ pipe to right position */ if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); @@ -2615,20 +2609,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - PerlIO* io = PerlIO_fdopen(p[This], mode); - if (io) { - chgfdccsid(p[This], 819); - } - return io; - #else return PerlIO_fdopen(p[This], mode); - #endif -#else - return PerlIO_fdopen(p[This], mode); -#endif - #else # if defined(OS2) /* Same, without fork()ing and all extra overhead... */ return my_syspopen4(aTHX_ NULL, mode, n, args); @@ -2706,12 +2687,6 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) #define THAT This if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - chgfdccsid(p[THIS], 819); - chgfdccsid(p[THAT], 819); - #endif -#endif if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); PerlLIO_close(p[THIS]); @@ -2798,19 +2773,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) } if (did_pipes) PerlLIO_close(pp[0]); -#if defined(OEMVS) - #if (__CHARSET_LIB == 1) - PerlIO* io = PerlIO_fdopen(p[This], mode); - if (io) { - chgfdccsid(p[This], 819); - } - return io; - #else return PerlIO_fdopen(p[This], mode); - #endif -#else - return PerlIO_fdopen(p[This], mode); -#endif } #elif defined(__LIBCATAMOUNT__) PerlIO *