File: pdl.c

package info (click to toggle)
pdl 1%3A2.103-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 6,832 kB
  • sloc: perl: 22,701; ansic: 14,964; sh: 31; makefile: 30; sed: 6
file content (78 lines) | stat: -rw-r--r-- 1,883 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
/******************************
 * pdl.c - perldl spawner
 * Works around a problem with many unices that you can't use an interpreter
 * to run an interpreter -- so "#!/usr/bin/perldl" won't work.
 * This is a compiled piece of code that launches perldl "directly", 
 * so that the poor kernel's mind isn't blown.
 *
 * If you feed in a single non-switch argument it gets prepended with a 
 * "-" to let perldl know that it's an input file.  That way you can be lazy
 * and say "#!/usr/bin/pdl" at the top of your script.
 *
 * CED 21-Jul-2004
 */

#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/wait.h>

int main(int argc, char **argv) {
  char perldl[BUFSIZ];
  int pipes[2];
  int pid,i;
  int status;

  if(pipe(pipes)) {perror("pdl (perldl spawn wrapper)"); exit(1);}
  pid = fork();
  if(pid==0) {
    dup2(pipes[1],1);
    dup2(pipes[1],2);
    exit(system("which perldl"));
  }
  pid = wait(&status);
  if(! WIFEXITED(status) ) {
    fprintf(stderr,"Hmmm... couldn't seem to find perldl anywhere. Quitting.\n");
    goto exit;
  }
  if( read(pipes[0],perldl,BUFSIZ) <= 0 ) {
    fprintf(stderr, "Read error - quitting.\n");
    goto exit;
  }

  /* Remove trailing newline */
  for(i=0;i<BUFSIZ && perldl[i]; i++) 
    if(perldl[i]=='\n' || perldl[i]=='\r')
        perldl[i]='\0';

  if(argc==2) {
    if(argv[1][0]!='-') {
      char **argv2 = malloc((argc+2)*sizeof(char *));
      int i;

      if(!argv2) 
	goto exit;

      for(i=0;i<argc;i++)
	argv2[i+1]=argv[i];

      argv2[1]="-";
      argv2[0]="perldl";
      argv2[argc+1]=0;

      execv(perldl,argv2);
      fprintf(stderr,"couldn't execv %s\n",perldl);
      goto exit;
    }
  }

  argv[0]="perldl";
  execv(perldl,argv);
  fprintf(stderr,"couldn't execv %s (%d args)\n",perldl,argc);
  goto exit;

exit: 
  perror("pdl (perldl trampoline)");
  exit(-1);
}