Commit | Line | Data |
79072805 |
1 | /* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $ |
2 | * |
3 | * Copyright (c) 1993, Larry Wall |
4 | * |
5 | * You may distribute under the terms of either the GNU General Public |
6 | * License or the Artistic License, as specified in the README file. |
7 | * |
8 | * $Log: hash.c,v $ |
9 | */ |
10 | |
11 | #include "EXTERN.h" |
12 | #include "perl.h" |
13 | |
14 | int |
15 | mg_get(sv) |
16 | SV* sv; |
17 | { |
18 | MAGIC* mg; |
19 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
20 | MGVTBL* vtbl = mg->mg_virtual; |
21 | if (vtbl && vtbl->svt_get) |
22 | (*vtbl->svt_get)(sv, mg); |
23 | } |
24 | return 0; |
25 | } |
26 | |
27 | int |
28 | mg_set(sv) |
29 | SV* sv; |
30 | { |
31 | MAGIC* mg; |
32 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
33 | MGVTBL* vtbl = mg->mg_virtual; |
34 | if (vtbl && vtbl->svt_set) |
35 | (*vtbl->svt_set)(sv, mg); |
36 | } |
37 | return 0; |
38 | } |
39 | |
40 | U32 |
41 | mg_len(sv) |
42 | SV* sv; |
43 | { |
44 | MAGIC* mg; |
45 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
46 | MGVTBL* vtbl = mg->mg_virtual; |
47 | if (vtbl && vtbl->svt_len) |
48 | return (*vtbl->svt_len)(sv, mg); |
49 | } |
93a17b20 |
50 | mg_get(sv); |
79072805 |
51 | if (!SvPOK(sv) && SvNIOK(sv)) |
52 | sv_2pv(sv); |
53 | if (SvPOK(sv)) |
54 | return SvCUR(sv); |
55 | return 0; |
56 | } |
57 | |
58 | int |
59 | mg_clear(sv) |
60 | SV* sv; |
61 | { |
62 | MAGIC* mg; |
63 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
64 | MGVTBL* vtbl = mg->mg_virtual; |
65 | if (vtbl && vtbl->svt_clear) |
66 | (*vtbl->svt_clear)(sv, mg); |
67 | } |
68 | return 0; |
69 | } |
70 | |
93a17b20 |
71 | MAGIC* |
72 | mg_find(sv, type) |
73 | SV* sv; |
74 | char type; |
75 | { |
76 | MAGIC* mg; |
77 | MAGIC** mgp = &SvMAGIC(sv); |
78 | for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { |
79 | if (mg->mg_type == type) |
80 | return mg; |
81 | } |
82 | return 0; |
83 | } |
84 | |
79072805 |
85 | int |
86 | mg_free(sv, type) |
87 | SV* sv; |
88 | char type; |
89 | { |
90 | MAGIC* mg; |
91 | MAGIC** mgp = &SvMAGIC(sv); |
92 | for (mg = *mgp; mg; mg = *mgp) { |
93 | if (mg->mg_type == type) { |
94 | MGVTBL* vtbl = mg->mg_virtual; |
95 | *mgp = mg->mg_moremagic; |
96 | if (vtbl && vtbl->svt_free) |
97 | (*vtbl->svt_free)(sv, mg); |
93a17b20 |
98 | if (mg->mg_ptr && mg->mg_type != 'g') |
79072805 |
99 | Safefree(mg->mg_ptr); |
100 | Safefree(mg); |
101 | } |
102 | else |
103 | mgp = &mg->mg_moremagic; |
104 | } |
105 | return 0; |
106 | } |
107 | |
108 | int |
109 | mg_freeall(sv) |
110 | SV* sv; |
111 | { |
112 | MAGIC* mg; |
113 | MAGIC* moremagic; |
114 | for (mg = SvMAGIC(sv); mg; mg = moremagic) { |
115 | MGVTBL* vtbl = mg->mg_virtual; |
116 | moremagic = mg->mg_moremagic; |
117 | if (vtbl && vtbl->svt_free) |
118 | (*vtbl->svt_free)(sv, mg); |
93a17b20 |
119 | if (mg->mg_ptr && mg->mg_type != 'g') |
79072805 |
120 | Safefree(mg->mg_ptr); |
121 | Safefree(mg); |
122 | } |
123 | SvMAGIC(sv) = 0; |
124 | return 0; |
125 | } |
126 | |
127 | #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) |
128 | #include <signal.h> |
129 | #endif |
130 | |
131 | #ifdef VOIDSIG |
132 | #define handlertype void |
133 | #else |
134 | #define handlertype int |
135 | #endif |
136 | |
137 | static handlertype sighandler(); |
138 | |
93a17b20 |
139 | U32 |
140 | magic_len(sv, mg) |
141 | SV *sv; |
142 | MAGIC *mg; |
143 | { |
144 | register I32 paren; |
145 | register char *s; |
146 | register I32 i; |
147 | |
148 | switch (*mg->mg_ptr) { |
149 | case '1': case '2': case '3': case '4': |
150 | case '5': case '6': case '7': case '8': case '9': case '&': |
151 | if (curpm) { |
152 | paren = atoi(mg->mg_ptr); |
153 | getparen: |
154 | if (curpm->op_pmregexp && |
155 | paren <= curpm->op_pmregexp->nparens && |
156 | (s = curpm->op_pmregexp->startp[paren]) ) { |
157 | i = curpm->op_pmregexp->endp[paren] - s; |
158 | if (i >= 0) |
159 | return i; |
160 | else |
161 | return 0; |
162 | } |
163 | else |
164 | return 0; |
165 | } |
166 | break; |
167 | case '+': |
168 | if (curpm) { |
169 | paren = curpm->op_pmregexp->lastparen; |
170 | goto getparen; |
171 | } |
172 | break; |
173 | case '`': |
174 | if (curpm) { |
175 | if (curpm->op_pmregexp && |
176 | (s = curpm->op_pmregexp->subbeg) ) { |
177 | i = curpm->op_pmregexp->startp[0] - s; |
178 | if (i >= 0) |
179 | return i; |
180 | else |
181 | return 0; |
182 | } |
183 | else |
184 | return 0; |
185 | } |
186 | break; |
187 | case '\'': |
188 | if (curpm) { |
189 | if (curpm->op_pmregexp && |
190 | (s = curpm->op_pmregexp->endp[0]) ) { |
191 | return (STRLEN) (curpm->op_pmregexp->subend - s); |
192 | } |
193 | else |
194 | return 0; |
195 | } |
196 | break; |
197 | case ',': |
198 | return (STRLEN)ofslen; |
199 | case '\\': |
200 | return (STRLEN)orslen; |
201 | } |
202 | magic_get(sv,mg); |
203 | if (!SvPOK(sv) && SvNIOK(sv)) |
204 | sv_2pv(sv); |
205 | if (SvPOK(sv)) |
206 | return SvCUR(sv); |
207 | return 0; |
208 | } |
209 | |
79072805 |
210 | int |
211 | magic_get(sv, mg) |
212 | SV *sv; |
213 | MAGIC *mg; |
214 | { |
215 | register I32 paren; |
216 | register char *s; |
217 | register I32 i; |
218 | |
219 | switch (*mg->mg_ptr) { |
220 | case '\004': /* ^D */ |
221 | sv_setiv(sv,(I32)(debug & 32767)); |
222 | break; |
223 | case '\006': /* ^F */ |
224 | sv_setiv(sv,(I32)maxsysfd); |
225 | break; |
226 | case '\t': /* ^I */ |
227 | if (inplace) |
228 | sv_setpv(sv, inplace); |
229 | else |
230 | sv_setsv(sv,&sv_undef); |
231 | break; |
232 | case '\020': /* ^P */ |
233 | sv_setiv(sv,(I32)perldb); |
234 | break; |
235 | case '\024': /* ^T */ |
236 | sv_setiv(sv,(I32)basetime); |
237 | break; |
238 | case '\027': /* ^W */ |
239 | sv_setiv(sv,(I32)dowarn); |
240 | break; |
241 | case '1': case '2': case '3': case '4': |
242 | case '5': case '6': case '7': case '8': case '9': case '&': |
243 | if (curpm) { |
244 | paren = atoi(GvENAME(mg->mg_obj)); |
245 | getparen: |
246 | if (curpm->op_pmregexp && |
247 | paren <= curpm->op_pmregexp->nparens && |
248 | (s = curpm->op_pmregexp->startp[paren]) ) { |
249 | i = curpm->op_pmregexp->endp[paren] - s; |
250 | if (i >= 0) |
251 | sv_setpvn(sv,s,i); |
252 | else |
253 | sv_setsv(sv,&sv_undef); |
254 | } |
255 | else |
256 | sv_setsv(sv,&sv_undef); |
257 | } |
258 | break; |
259 | case '+': |
260 | if (curpm) { |
261 | paren = curpm->op_pmregexp->lastparen; |
262 | goto getparen; |
263 | } |
264 | break; |
265 | case '`': |
266 | if (curpm) { |
267 | if (curpm->op_pmregexp && |
268 | (s = curpm->op_pmregexp->subbeg) ) { |
269 | i = curpm->op_pmregexp->startp[0] - s; |
270 | if (i >= 0) |
271 | sv_setpvn(sv,s,i); |
272 | else |
273 | sv_setpvn(sv,"",0); |
274 | } |
275 | else |
276 | sv_setpvn(sv,"",0); |
277 | } |
278 | break; |
279 | case '\'': |
280 | if (curpm) { |
281 | if (curpm->op_pmregexp && |
282 | (s = curpm->op_pmregexp->endp[0]) ) { |
283 | sv_setpvn(sv,s, curpm->op_pmregexp->subend - s); |
284 | } |
285 | else |
286 | sv_setpvn(sv,"",0); |
287 | } |
288 | break; |
289 | case '.': |
290 | #ifndef lint |
291 | if (last_in_gv && GvIO(last_in_gv)) { |
292 | sv_setiv(sv,(I32)GvIO(last_in_gv)->lines); |
293 | } |
294 | #endif |
295 | break; |
296 | case '?': |
297 | sv_setiv(sv,(I32)statusvalue); |
298 | break; |
299 | case '^': |
300 | s = GvIO(defoutgv)->top_name; |
301 | if (s) |
302 | sv_setpv(sv,s); |
303 | else { |
304 | sv_setpv(sv,GvENAME(defoutgv)); |
305 | sv_catpv(sv,"_TOP"); |
306 | } |
307 | break; |
308 | case '~': |
309 | s = GvIO(defoutgv)->fmt_name; |
310 | if (!s) |
311 | s = GvENAME(defoutgv); |
312 | sv_setpv(sv,s); |
313 | break; |
314 | #ifndef lint |
315 | case '=': |
316 | sv_setiv(sv,(I32)GvIO(defoutgv)->page_len); |
317 | break; |
318 | case '-': |
319 | sv_setiv(sv,(I32)GvIO(defoutgv)->lines_left); |
320 | break; |
321 | case '%': |
322 | sv_setiv(sv,(I32)GvIO(defoutgv)->page); |
323 | break; |
324 | #endif |
325 | case ':': |
326 | break; |
327 | case '/': |
328 | break; |
329 | case '[': |
330 | sv_setiv(sv,(I32)arybase); |
331 | break; |
332 | case '|': |
333 | if (!GvIO(defoutgv)) |
334 | GvIO(defoutgv) = newIO(); |
335 | sv_setiv(sv, (GvIO(defoutgv)->flags & IOf_FLUSH) != 0 ); |
336 | break; |
337 | case ',': |
338 | sv_setpvn(sv,ofs,ofslen); |
339 | break; |
340 | case '\\': |
341 | sv_setpvn(sv,ors,orslen); |
342 | break; |
343 | case '#': |
344 | sv_setpv(sv,ofmt); |
345 | break; |
346 | case '!': |
347 | sv_setnv(sv,(double)errno); |
348 | sv_setpv(sv, errno ? strerror(errno) : ""); |
349 | SvNOK_on(sv); /* what a wonderful hack! */ |
350 | break; |
351 | case '<': |
352 | sv_setiv(sv,(I32)uid); |
353 | break; |
354 | case '>': |
355 | sv_setiv(sv,(I32)euid); |
356 | break; |
357 | case '(': |
358 | s = buf; |
359 | (void)sprintf(s,"%d",(int)gid); |
360 | goto add_groups; |
361 | case ')': |
362 | s = buf; |
363 | (void)sprintf(s,"%d",(int)egid); |
364 | add_groups: |
365 | while (*s) s++; |
366 | #ifdef HAS_GETGROUPS |
367 | #ifndef NGROUPS |
368 | #define NGROUPS 32 |
369 | #endif |
370 | { |
371 | GROUPSTYPE gary[NGROUPS]; |
372 | |
373 | i = getgroups(NGROUPS,gary); |
374 | while (--i >= 0) { |
375 | (void)sprintf(s," %ld", (long)gary[i]); |
376 | while (*s) s++; |
377 | } |
378 | } |
379 | #endif |
380 | sv_setpv(sv,buf); |
381 | break; |
382 | case '*': |
383 | break; |
384 | case '0': |
385 | break; |
386 | } |
387 | } |
388 | |
389 | int |
390 | magic_getuvar(sv, mg) |
391 | SV *sv; |
392 | MAGIC *mg; |
393 | { |
394 | struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr; |
395 | |
396 | if (uf && uf->uf_val) |
397 | (*uf->uf_val)(uf->uf_index, sv); |
398 | return 0; |
399 | } |
400 | |
401 | int |
402 | magic_setenv(sv,mg) |
403 | SV* sv; |
404 | MAGIC* mg; |
405 | { |
406 | register char *s; |
407 | I32 i; |
408 | s = SvPV(sv); |
409 | my_setenv(mg->mg_ptr,s); |
410 | /* And you'll never guess what the dog had */ |
411 | /* in its mouth... */ |
412 | #ifdef TAINT |
413 | if (s && strEQ(mg->mg_ptr,"PATH")) { |
414 | char *strend = SvEND(sv); |
415 | |
416 | while (s < strend) { |
417 | s = cpytill(tokenbuf,s,strend,':',&i); |
418 | s++; |
419 | if (*tokenbuf != '/' |
420 | || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) |
421 | sv->sv_tainted = 2; |
422 | } |
423 | } |
424 | #endif |
425 | return 0; |
426 | } |
427 | |
428 | int |
429 | magic_setsig(sv,mg) |
430 | SV* sv; |
431 | MAGIC* mg; |
432 | { |
433 | register char *s; |
434 | I32 i; |
435 | s = SvPV(sv); |
436 | i = whichsig(mg->mg_ptr); /* ...no, a brick */ |
437 | if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM"))) |
438 | warn("No such signal: SIG%s", mg->mg_ptr); |
439 | if (strEQ(s,"IGNORE")) |
440 | #ifndef lint |
441 | (void)signal(i,SIG_IGN); |
442 | #else |
443 | ; |
444 | #endif |
445 | else if (strEQ(s,"DEFAULT") || !*s) |
446 | (void)signal(i,SIG_DFL); |
447 | else { |
448 | (void)signal(i,sighandler); |
93a17b20 |
449 | if (!strchr(s,'\'')) { |
79072805 |
450 | sprintf(tokenbuf, "main'%s",s); |
451 | sv_setpv(sv,tokenbuf); |
452 | } |
453 | } |
454 | return 0; |
455 | } |
456 | |
457 | int |
458 | magic_setdbm(sv,mg) |
459 | SV* sv; |
460 | MAGIC* mg; |
461 | { |
462 | HV* hv = (HV*)mg->mg_obj; |
463 | hv_dbmstore(hv,mg->mg_ptr,mg->mg_len,sv); /* XXX slurp? */ |
464 | return 0; |
465 | } |
466 | |
467 | int |
468 | magic_setdbline(sv,mg) |
469 | SV* sv; |
470 | MAGIC* mg; |
471 | { |
472 | OP *o; |
473 | I32 i; |
474 | GV* gv; |
475 | SV** svp; |
476 | |
477 | gv = DBline; |
478 | i = SvTRUE(sv); |
479 | svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE); |
93a17b20 |
480 | if (svp && SvIOK(*svp) && (o = (OP*)SvSTASH(*svp))) |
481 | o->op_private = i; |
79072805 |
482 | else |
483 | warn("Can't break at that line\n"); |
484 | return 0; |
485 | } |
486 | |
487 | int |
488 | magic_getarylen(sv,mg) |
489 | SV* sv; |
490 | MAGIC* mg; |
491 | { |
492 | sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase); |
493 | return 0; |
494 | } |
495 | |
496 | int |
497 | magic_setarylen(sv,mg) |
498 | SV* sv; |
499 | MAGIC* mg; |
500 | { |
501 | av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) - arybase); |
502 | return 0; |
503 | } |
504 | |
505 | int |
506 | magic_getglob(sv,mg) |
507 | SV* sv; |
508 | MAGIC* mg; |
509 | { |
510 | gv_efullname(sv,((GV*)sv));/* a gv value, be nice */ |
511 | return 0; |
512 | } |
513 | |
514 | int |
515 | magic_setglob(sv,mg) |
516 | SV* sv; |
517 | MAGIC* mg; |
518 | { |
519 | register char *s; |
520 | GV* gv; |
521 | |
522 | if (!SvOK(sv)) |
523 | return 0; |
524 | s = SvPOK(sv) ? SvPV(sv) : sv_2pv(sv); |
525 | if (*s == '*' && s[1]) |
526 | s++; |
527 | gv = gv_fetchpv(s,TRUE); |
528 | if (sv == (SV*)gv) |
529 | return 0; |
530 | if (GvGP(sv)) |
531 | gp_free(sv); |
532 | GvGP(sv) = gp_ref(GvGP(gv)); |
533 | if (!GvAV(gv)) |
534 | gv_AVadd(gv); |
535 | if (!GvHV(gv)) |
536 | gv_HVadd(gv); |
537 | if (!GvIO(gv)) |
538 | GvIO(gv) = newIO(); |
539 | return 0; |
540 | } |
541 | |
542 | int |
543 | magic_setsubstr(sv,mg) |
544 | SV* sv; |
545 | MAGIC* mg; |
546 | { |
547 | char *tmps = SvPV(sv); |
548 | if (!tmps) |
549 | tmps = ""; |
550 | sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps,SvCUR(sv)); |
551 | return 0; |
552 | } |
553 | |
554 | int |
555 | magic_setvec(sv,mg) |
556 | SV* sv; |
557 | MAGIC* mg; |
558 | { |
559 | do_vecset(sv); /* XXX slurp this routine */ |
560 | return 0; |
561 | } |
562 | |
563 | int |
93a17b20 |
564 | magic_setmglob(sv,mg) |
565 | SV* sv; |
566 | MAGIC* mg; |
567 | { |
568 | mg->mg_ptr = 0; |
569 | mg->mg_len = 0; |
570 | return 0; |
571 | } |
572 | |
573 | int |
79072805 |
574 | magic_setbm(sv,mg) |
575 | SV* sv; |
576 | MAGIC* mg; |
577 | { |
578 | mg_free(sv, 'B'); |
579 | SvVALID_off(sv); |
580 | return 0; |
581 | } |
582 | |
583 | int |
584 | magic_setuvar(sv,mg) |
585 | SV* sv; |
586 | MAGIC* mg; |
587 | { |
588 | struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr; |
589 | |
590 | if (uf && uf->uf_set) |
591 | (*uf->uf_set)(uf->uf_index, sv); |
592 | return 0; |
593 | } |
594 | |
595 | int |
596 | magic_set(sv,mg) |
597 | SV* sv; |
598 | MAGIC* mg; |
599 | { |
600 | register char *s; |
601 | I32 i; |
602 | switch (*mg->mg_ptr) { |
603 | case '\004': /* ^D */ |
604 | debug = (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) | 32768; |
605 | DEBUG_x(dump_all()); |
606 | break; |
607 | case '\006': /* ^F */ |
608 | maxsysfd = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
609 | break; |
610 | case '\t': /* ^I */ |
611 | if (inplace) |
612 | Safefree(inplace); |
613 | if (SvOK(sv)) |
614 | inplace = savestr(SvPV(sv)); |
615 | else |
616 | inplace = Nullch; |
617 | break; |
618 | case '\020': /* ^P */ |
619 | i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
620 | if (i != perldb) { |
621 | if (perldb) |
622 | oldlastpm = curpm; |
623 | else |
624 | curpm = oldlastpm; |
625 | } |
626 | perldb = i; |
627 | break; |
628 | case '\024': /* ^T */ |
629 | basetime = (time_t)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
630 | break; |
631 | case '\027': /* ^W */ |
632 | dowarn = (bool)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
633 | break; |
634 | case '.': |
635 | if (localizing) |
636 | save_sptr((SV**)&last_in_gv); |
637 | break; |
638 | case '^': |
639 | Safefree(GvIO(defoutgv)->top_name); |
640 | GvIO(defoutgv)->top_name = s = savestr(SvPV(sv)); |
641 | GvIO(defoutgv)->top_gv = gv_fetchpv(s,TRUE); |
642 | break; |
643 | case '~': |
644 | Safefree(GvIO(defoutgv)->fmt_name); |
645 | GvIO(defoutgv)->fmt_name = s = savestr(SvPV(sv)); |
646 | GvIO(defoutgv)->fmt_gv = gv_fetchpv(s,TRUE); |
647 | break; |
648 | case '=': |
649 | GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
650 | break; |
651 | case '-': |
652 | GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
653 | if (GvIO(defoutgv)->lines_left < 0L) |
654 | GvIO(defoutgv)->lines_left = 0L; |
655 | break; |
656 | case '%': |
657 | GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
658 | break; |
659 | case '|': |
660 | if (!GvIO(defoutgv)) |
661 | GvIO(defoutgv) = newIO(); |
662 | GvIO(defoutgv)->flags &= ~IOf_FLUSH; |
663 | if ((SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) != 0) { |
664 | GvIO(defoutgv)->flags |= IOf_FLUSH; |
665 | } |
666 | break; |
667 | case '*': |
668 | i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
669 | multiline = (i != 0); |
670 | break; |
671 | case '/': |
672 | if (SvPOK(sv)) { |
93a17b20 |
673 | nrs = rs = SvPV(sv); |
674 | nrslen = rslen = SvCUR(sv); |
79072805 |
675 | if (rspara = !rslen) { |
93a17b20 |
676 | nrs = rs = "\n\n"; |
677 | nrslen = rslen = 2; |
79072805 |
678 | } |
93a17b20 |
679 | nrschar = rschar = rs[rslen - 1]; |
79072805 |
680 | } |
681 | else { |
93a17b20 |
682 | nrschar = rschar = 0777; /* fake a non-existent char */ |
683 | nrslen = rslen = 1; |
79072805 |
684 | } |
685 | break; |
686 | case '\\': |
687 | if (ors) |
688 | Safefree(ors); |
689 | ors = savestr(SvPV(sv)); |
690 | orslen = SvCUR(sv); |
691 | break; |
692 | case ',': |
693 | if (ofs) |
694 | Safefree(ofs); |
695 | ofs = savestr(SvPV(sv)); |
696 | ofslen = SvCUR(sv); |
697 | break; |
698 | case '#': |
699 | if (ofmt) |
700 | Safefree(ofmt); |
701 | ofmt = savestr(SvPV(sv)); |
702 | break; |
703 | case '[': |
704 | arybase = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
705 | break; |
706 | case '?': |
707 | statusvalue = U_S(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); |
708 | break; |
709 | case '!': |
710 | errno = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); /* will anyone ever use this? */ |
711 | break; |
712 | case '<': |
713 | uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
714 | if (delaymagic) { |
715 | delaymagic |= DM_RUID; |
716 | break; /* don't do magic till later */ |
717 | } |
718 | #ifdef HAS_SETRUID |
719 | (void)setruid((UIDTYPE)uid); |
720 | #else |
721 | #ifdef HAS_SETREUID |
722 | (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1); |
723 | #else |
724 | if (uid == euid) /* special case $< = $> */ |
725 | (void)setuid(uid); |
726 | else |
727 | fatal("setruid() not implemented"); |
728 | #endif |
729 | #endif |
730 | uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
731 | break; |
732 | case '>': |
733 | euid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
734 | if (delaymagic) { |
735 | delaymagic |= DM_EUID; |
736 | break; /* don't do magic till later */ |
737 | } |
738 | #ifdef HAS_SETEUID |
739 | (void)seteuid((UIDTYPE)euid); |
740 | #else |
741 | #ifdef HAS_SETREUID |
742 | (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid); |
743 | #else |
744 | if (euid == uid) /* special case $> = $< */ |
745 | setuid(euid); |
746 | else |
747 | fatal("seteuid() not implemented"); |
748 | #endif |
749 | #endif |
750 | euid = (I32)geteuid(); |
751 | break; |
752 | case '(': |
753 | gid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
754 | if (delaymagic) { |
755 | delaymagic |= DM_RGID; |
756 | break; /* don't do magic till later */ |
757 | } |
758 | #ifdef HAS_SETRGID |
759 | (void)setrgid((GIDTYPE)gid); |
760 | #else |
761 | #ifdef HAS_SETREGID |
762 | (void)setregid((GIDTYPE)gid, (GIDTYPE)-1); |
763 | #else |
764 | if (gid == egid) /* special case $( = $) */ |
765 | (void)setgid(gid); |
766 | else |
767 | fatal("setrgid() not implemented"); |
768 | #endif |
769 | #endif |
770 | gid = (I32)getgid(); |
771 | break; |
772 | case ')': |
773 | egid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); |
774 | if (delaymagic) { |
775 | delaymagic |= DM_EGID; |
776 | break; /* don't do magic till later */ |
777 | } |
778 | #ifdef HAS_SETEGID |
779 | (void)setegid((GIDTYPE)egid); |
780 | #else |
781 | #ifdef HAS_SETREGID |
782 | (void)setregid((GIDTYPE)-1, (GIDTYPE)egid); |
783 | #else |
784 | if (egid == gid) /* special case $) = $( */ |
785 | (void)setgid(egid); |
786 | else |
787 | fatal("setegid() not implemented"); |
788 | #endif |
789 | #endif |
790 | egid = (I32)getegid(); |
791 | break; |
792 | case ':': |
793 | chopset = SvPV(sv); |
794 | break; |
795 | case '0': |
796 | if (!origalen) { |
797 | s = origargv[0]; |
798 | s += strlen(s); |
799 | /* See if all the arguments are contiguous in memory */ |
800 | for (i = 1; i < origargc; i++) { |
801 | if (origargv[i] == s + 1) |
802 | s += strlen(++s); /* this one is ok too */ |
803 | } |
804 | if (origenviron[0] == s + 1) { /* can grab env area too? */ |
805 | my_setenv("NoNeSuCh", Nullch); |
806 | /* force copy of environment */ |
807 | for (i = 0; origenviron[i]; i++) |
808 | if (origenviron[i] == s + 1) |
809 | s += strlen(++s); |
810 | } |
811 | origalen = s - origargv[0]; |
812 | } |
813 | s = SvPV(sv); |
814 | i = SvCUR(sv); |
815 | if (i >= origalen) { |
816 | i = origalen; |
817 | SvCUR_set(sv, i); |
818 | *SvEND(sv) = '\0'; |
819 | Copy(s, origargv[0], i, char); |
820 | } |
821 | else { |
822 | Copy(s, origargv[0], i, char); |
823 | s = origargv[0]+i; |
824 | *s++ = '\0'; |
825 | while (++i < origalen) |
826 | *s++ = ' '; |
827 | } |
828 | break; |
829 | } |
830 | return 0; |
831 | } |
832 | |
833 | I32 |
834 | whichsig(sig) |
835 | char *sig; |
836 | { |
837 | register char **sigv; |
838 | |
839 | for (sigv = sig_name+1; *sigv; sigv++) |
840 | if (strEQ(sig,*sigv)) |
841 | return sigv - sig_name; |
842 | #ifdef SIGCLD |
843 | if (strEQ(sig,"CHLD")) |
844 | return SIGCLD; |
845 | #endif |
846 | #ifdef SIGCHLD |
847 | if (strEQ(sig,"CLD")) |
848 | return SIGCHLD; |
849 | #endif |
850 | return 0; |
851 | } |
852 | |
853 | static handlertype |
854 | sighandler(sig) |
855 | I32 sig; |
856 | { |
857 | dSP; |
858 | GV *gv; |
859 | SV *sv; |
860 | CV *cv; |
861 | CONTEXT *cx; |
862 | AV *oldstack; |
863 | I32 hasargs = 1; |
864 | I32 items = 1; |
865 | I32 gimme = G_SCALAR; |
866 | |
867 | #ifdef OS2 /* or anybody else who requires SIG_ACK */ |
868 | signal(sig, SIG_ACK); |
869 | #endif |
870 | |
871 | gv = gv_fetchpv( |
872 | SvPVnx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), |
873 | TRUE)), TRUE); |
874 | cv = GvCV(gv); |
875 | if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { |
876 | if (sig_name[sig][1] == 'H') |
877 | gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE)), |
878 | TRUE); |
879 | else |
880 | gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE)), |
881 | TRUE); |
882 | cv = GvCV(gv); /* gag */ |
883 | } |
884 | if (!cv) { |
885 | if (dowarn) |
886 | warn("SIG%s handler \"%s\" not defined.\n", |
887 | sig_name[sig], GvENAME(gv) ); |
888 | return; |
889 | } |
890 | |
891 | oldstack = stack; |
892 | SWITCHSTACK(stack, signalstack); |
893 | |
894 | sv = sv_mortalcopy(&sv_undef); |
895 | sv_setpv(sv,sig_name[sig]); |
896 | PUSHs(sv); |
897 | |
898 | ENTER; |
899 | SAVETMPS; |
900 | |
901 | push_return(op); |
902 | push_return(0); |
903 | PUSHBLOCK(cx, CXt_SUB, sp); |
904 | PUSHSUB(cx); |
905 | cx->blk_sub.savearray = GvAV(defgv); |
906 | cx->blk_sub.argarray = av_fake(items, sp); |
907 | GvAV(defgv) = cx->blk_sub.argarray; |
908 | CvDEPTH(cv)++; |
909 | if (CvDEPTH(cv) >= 2) { |
910 | if (CvDEPTH(cv) == 100 && dowarn) |
911 | warn("Deep recursion on subroutine \"%s\"",GvENAME(gv)); |
912 | } |
913 | op = CvSTART(cv); |
914 | PUTBACK; |
915 | run(); /* Does the LEAVE for us. */ |
916 | |
917 | SWITCHSTACK(signalstack, oldstack); |
918 | op = pop_return(); |
919 | |
920 | return; |
921 | } |