=head2 Wildcard expansion
File specifications containing wildcards are allowed both on
-the command line and within Perl globs (e.g. <CE<lt>*.cE<gt>>). If
+the command line and within Perl globs (e.g. <CE<lt>*.cE<gt>>). If
the wildcard filespec uses VMS syntax, the resultant
filespecs will follow VMS syntax; if a Unix-style filespec is
passed in, Unix-style filespecs will be returned.
+In both cases, VMS wildcard expansion is performed. (csh-style
+wildcard expansion is available if you use C<File::Glob::glob>.)
If the wildcard filespec contains a device or directory
specification, then the resultant filespecs will also contain
a device and directory; otherwise, device and directory
You may also use backticks to invoke a DCL subprocess, whose
output is used as the return value of the expression. The
-string between the backticks is passed directly to lib$spawn
-as the command to execute. In this case, Perl will wait for
-the subprocess to complete before continuing.
+string between the backticks is handled as if it were the
+argument to the C<system> operator (see below). In this case,
+Perl will wait for the subprocess to complete before continuing.
=head1 PERL5LIB and PERLLIB
If the call to C<exec> does not follow a call to C<fork>, it
will cause Perl to exit, and to invoke the command given as
an argument to C<exec> via C<lib$do_command>. If the argument
-begins with a '$' (other than as part of a filespec), then it
+begins with '@' or '$' (other than as part of a filespec), then it
is executed as a DCL command. Otherwise, the first token on
the command line is treated as the filespec of an image to
run, and an attempt is made to invoke it (using F<.Exe> and
The C<system> operator creates a subprocess, and passes its
arguments to the subprocess for execution as a DCL command.
Since the subprocess is created directly via C<lib$spawn()>, any
-valid DCL command string may be specified. If LIST consists
+valid DCL command string may be specified. If the string begins with
+'@', it is treated as a DCL command unconditionally. Otherwise, if
+the first token contains a character used as a delimiter in file
+specification (e.g. C<:> or C<]>), an attempt is made to expand it
+using a default type of F<.Exe> and the process defaults, and if
+successful, the resulting file is invoked via C<MCR>. This allows you
+to invoke an image directly simply by passing the file specification
+to C<system>, a common Unixish idiom. If LIST consists
of the empty string, C<system> spawns an interactive DCL subprocess,
in the same fashion as typiing B<SPAWN> at the DCL prompt.
Perl waits for the subprocess to complete before continuing
=head1 Revision date
-This document was last updated on 26-Feb-1998, for Perl 5,
-patchlevel 5.
+This document was last updated on 26-Feb-2000, for Perl 5,
+patchlevel 6.
=head1 AUTHOR
-Charles Bailey bailey@cor.newman.upenn.edu
-
-Last revision by Dan Sugalski sugalskd@ous.edu
+Charles Bailey <bailey@cor.newman.upenn.edu>
+Dan Sugalski <dan@sidhe.org>
*
* VMS-specific routines for perl5
*
- * Last revised: 15-Aug-1999 by Charles Bailey bailey@newman.upenn.edu
+ * Last revised: 24-Feb-2000 by Charles Bailey bailey@newman.upenn.edu
* Version: 5.5.60
*/
/* munching */
static int no_translate_barewords;
+/* Temp for subprocess commands */
+static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
+
/*{{{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,
}
}
+static unsigned long int setup_cmddsc(char *cmd, int check_img);
+static void vms_execfree();
+
static PerlIO *
safe_popen(char *cmd, char *mode)
{
static int handler_set_up = FALSE;
char mbxname[64];
unsigned short int chan;
- unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */
+ unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
dTHX;
struct pipe_details *info;
struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
DSC$K_CLASS_S, 0};
- cmddsc.dsc$w_length=strlen(cmd);
- cmddsc.dsc$a_pointer=cmd;
- if (cmddsc.dsc$w_length > 255) {
- set_errno(E2BIG); set_vaxc_errno(CLI$_BUFOVF);
- return Nullfp;
- }
-
+ if (!(setup_cmddsc(cmd,0) & 1)) { set_errno(EINVAL); return Nullfp; }
New(1301,info,1,struct pipe_details);
/* create mailbox */
info->completion=0;
if (*mode == 'r') {
- _ckvmssts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
+ _ckvmssts(lib$spawn(&VMScmd, &nl_desc, &namdsc, &flags,
0 /* name */, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
}
else {
- _ckvmssts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
+ _ckvmssts(lib$spawn(&VMScmd, &namdsc, 0 /* sys$output */, &flags,
0 /* name */, &info->pid, &info->completion,
0, popen_completion_ast,info,0,0,0));
}
+ vms_execfree();
if (!handler_set_up) {
_ckvmssts(sys$dclexh(&pipe_exitblock));
handler_set_up = TRUE;
/*}}}*/
-static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
-
static void
vms_execfree() {
if (PL_Cmd) {
- Safefree(PL_Cmd);
+ if (PL_Cmd != VMScmd.dsc$a_pointer) Safefree(PL_Cmd);
PL_Cmd = Nullch;
}
if (VMScmd.dsc$a_pointer) {
static unsigned long int
setup_cmddsc(char *cmd, int check_img)
{
- char resspec[NAM$C_MAXRSS+1];
+ char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
$DESCRIPTOR(defdsc,".EXE");
$DESCRIPTOR(resdsc,resspec);
struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
- register char *s, *rest, *cp;
- register int isdcl = 0;
+ register char *s, *rest, *cp, *wordbreak;
+ register int isdcl;
dTHX;
+ if (strlen(cmd) >
+ (sizeof(vmsspec) > sizeof(resspec) ? sizeof(resspec) : sizeof(vmsspec)))
+ return LIB$_INVARG;
s = cmd;
while (*s && isspace(*s)) s++;
- if (check_img) {
- if (*s == '$') { /* Check whether this is a DCL command: leading $ and */
- isdcl = 1; /* no dev/dir separators (i.e. not a foreign command) */
- for (cp = s; *cp && *cp != '/' && !isspace(*cp); cp++) {
- if (*cp == ':' || *cp == '[' || *cp == '<') {
- isdcl = 0;
- break;
- }
+
+ if (*s == '@' || *s == '$') {
+ vmsspec[0] = *s; rest = s + 1;
+ for (cp = &vmsspec[1]; *rest && isspace(*rest); rest++,cp++) *cp = *rest;
+ }
+ else { cp = vmsspec; rest = s; }
+ if (*rest == '.' || *rest == '/') {
+ char *cp2;
+ for (cp2 = resspec;
+ *rest && !isspace(*rest) && cp2 - resspec < sizeof resspec;
+ rest++, cp2++) *cp2 = *rest;
+ *cp2 = '\0';
+ if (do_tovmsspec(resspec,cp,0)) {
+ s = vmsspec;
+ if (*rest) {
+ for (cp2 = vmsspec + strlen(vmsspec);
+ *rest && cp2 - vmsspec < sizeof vmsspec;
+ rest++, cp2++) *cp2 = *rest;
+ *cp2 = '\0';
}
}
}
- else isdcl = 1;
+ /* Intuit whether verb (first word of cmd) is a DCL command:
+ * - if first nonspace char is '@', it's a DCL indirection
+ * otherwise
+ * - if verb contains a filespec separator, it's not a DCL command
+ * - if it doesn't, caller tells us whether to default to a DCL
+ * command, or to a local image unless told it's DCL (by leading '$')
+ */
+ if (*s == '@') isdcl = 1;
+ else {
+ register char *filespec = strpbrk(s,":<[.;");
+ rest = wordbreak = strpbrk(s," \"\t/");
+ if (!wordbreak) wordbreak = s + strlen(s);
+ if (*s == '$') check_img = 0;
+ if (filespec && (filespec < wordbreak)) isdcl = 0;
+ else isdcl = !check_img;
+ }
+
if (!isdcl) {
- cmd = s;
- while (*s && !isspace(*s)) s++;
- rest = *s ? s : 0;
- imgdsc.dsc$a_pointer = cmd;
- imgdsc.dsc$w_length = s - cmd;
+ imgdsc.dsc$a_pointer = s;
+ imgdsc.dsc$w_length = wordbreak - s;
retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
- if (retsts & 1) {
+ if (!(retsts & 1) && *s == '$') {
+ imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--;
+ retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
_ckvmssts(lib$find_file_end(&cxt));
+ }
+ if (retsts & 1) {
s = resspec;
while (*s && !isspace(*s)) s++;
*s = '\0';
}
/* It's either a DCL command or we couldn't find a suitable image */
VMScmd.dsc$w_length = strlen(cmd);
- if (cmd == PL_Cmd) {
- VMScmd.dsc$a_pointer = PL_Cmd;
- PL_Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
- }
+ if (cmd == PL_Cmd) VMScmd.dsc$a_pointer = PL_Cmd;
else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length);
if (!(retsts & 1)) {
/* just hand off status values likely to be due to user error */
projects / p5sagit/p5-mst-13.2.git / commitdiff