mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
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.
This commit is contained in:
Igor Todorovski
Karl Williamson
parent
64b69ef9f1
commit
8af62fee44
69
doio.c
69
doio.c
@ -222,57 +222,6 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd)
|
||||
#endif
|
||||
}
|
||||
|
||||
#if defined(OEMVS)
|
||||
#if (__CHARSET_LIB == 1)
|
||||
# include <stdio.h>
|
||||
# include <stdlib.h>
|
||||
|
||||
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);
|
||||
|
||||
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
13
iperlsys.h
13
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_read(fd, buf, count) read((fd), (buf), (count))
|
||||
# define PerlLIO_rename(old, new) rename((old), (new))
|
||||
# define PerlLIO_setmode(fd, mode) setmode((fd), (mode))
|
||||
|
||||
37
util.c
37
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 *
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user