21495 ktrace RET ktrace 0 21495 ktrace CALL execve(0xbfbfec4e,0xbfbfeb40,0xbfbfeb50) 21495 ktrace NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/bin/perl5.8.8" 21495 ktrace NAMI "/libexec/ld-elf.so.1" 21495 perl5.8.8 RET execve 0 21495 perl5.8.8 CALL mmap(0,0xe18,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 672710656/0x2818c000 21495 perl5.8.8 CALL munmap(0x2818c000,0xe18) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL __sysctl(0xbfbfe8e8,0x2,0x28188998,0xbfbfe8e4,0,0) 21495 perl5.8.8 RET __sysctl 0 21495 perl5.8.8 CALL mmap(0,0x8000,0x3,0x1002,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 672710656/0x2818c000 21495 perl5.8.8 CALL issetugid 21495 perl5.8.8 RET issetugid 0 21495 perl5.8.8 CALL open(0x28184c28,0,0x1b6) 21495 perl5.8.8 NAMI "/etc/libmap.conf" 21495 perl5.8.8 RET open -1 errno 2 No such file or directory 21495 perl5.8.8 CALL open(0x28183e80,0,0) 21495 perl5.8.8 NAMI "/var/run/ld-elf.so.hints" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL read(0x3,0xbfbfe8b0,0x80) 21495 perl5.8.8 GIO fd 3 read 128 bytes 0x0000 4568 6e74 0100 0000 8000 0000 8300 0000 |Ehnt............| 0x0010 0000 0000 8200 0000 0000 0000 0000 0000 |................| 0x0020 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0030 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0050 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0060 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0070 0000 0000 0000 0000 0000 0000 0000 0000 |................| 21495 perl5.8.8 RET read 128/0x80 21495 perl5.8.8 CALL lseek(0x3,0,0x80,0,0) 21495 perl5.8.8 RET lseek 128/0x80 21495 perl5.8.8 CALL read(0x3,0x2818e100,0x83) 21495 perl5.8.8 GIO fd 3 read 131 bytes "/lib:/usr/lib:/usr/lib/compat:/usr/X11R6/lib:/usr/local/lib:/usr/local\ /lib/compat/pkg:/usr/local/lib/mysql:/usr/local/lib/graphviz\0" 21495 perl5.8.8 RET read 131/0x83 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL access(0x28191000,0) 21495 perl5.8.8 NAMI "/lib/libm.so.4" 21495 perl5.8.8 RET access 0 21495 perl5.8.8 CALL open(0x2818d020,0,0) 21495 perl5.8.8 NAMI "/lib/libm.so.4" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL fstat(0x3,0xbfbfe8f0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x3,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 3 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 1424 0000 3400 0000 |.........$..4...| 0x0020 007c 0100 0000 0000 3400 2000 0300 2800 |.|......4. ...(.| 0x0030 1500 1400 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 aa4a 0100 aa4a 0100 0500 0000 |.....J...J......| 0x0050 0010 0000 0100 0000 0050 0100 0050 0100 |.........P...P..| 0x0060 0050 0100 a80a 0000 cc0a 0000 0600 0000 |.P..............| 0x0070 0010 0000 0200 0000 6c58 0100 6c58 0100 |........lX..lX..| 0x0080 6c58 0100 a800 0000 a800 0000 0600 0000 |lX..............| 0x0090 0400 0000 c500 0000 e800 0000 d400 0000 |................| 0x00a0 6500 0000 a800 0000 9900 0000 9c00 0000 |e...............| 0x00b0 4e00 0000 7000 0000 0000 0000 de00 0000 |N...p...........| 0x00c0 0000 0000 ba00 0000 e600 0000 d800 0000 |................| 0x00d0 6400 0000 e700 0000 e000 0000 ca00 0000 |d...............| 0x00e0 4900 0000 8100 0000 db00 0000 5000 0000 |I...........P...| 0x00f0 0000 0000 d700 0000 b800 0000 0000 0000 |................| 0x0100 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0110 b200 0000 3e00 0000 0000 0000 d100 0000 |....>...........| 0x0120 9800 0000 0000 0000 a400 0000 e300 0000 |................| 0x0130 0000 0000 0000 0000 9600 0000 0000 0000 |................| 0x0140 0000 0000 9e00 0000 0000 0000 0000 0000 |................| 0x0150 6c00 0000 0000 0000 0000 0000 6f00 0000 |l...........o...| 0x0160 cb00 0000 0000 0000 0000 0000 6300 0000 |............c...| 0x0170 9000 0000 9500 0000 0000 0000 2600 0000 |............&...| 0x0180 9100 0000 0000 0000 d600 0000 bd00 0000 |................| 0x0190 0000 0000 0000 0000 d900 0000 0000 0000 |................| 0x01a0 0000 0000 d000 0000 ac00 0000 6d00 0000 |............m...| 0x01b0 aa00 0000 c600 0000 bb00 0000 9f00 0000 |................| 0x01c0 7800 0000 cf00 0000 6a00 0000 4300 0000 |x.......j...C...| 0x01d0 0000 0000 5b00 0000 c200 0000 0000 0000 |....[...........| 0x01e0 6800 0000 dd00 0000 0000 0000 a500 0000 |h...............| 0x01f0 7c00 0000 5a00 0000 c400 0000 2d00 0000 ||...Z.......-...| 0x0200 0000 0000 5400 0000 0000 0000 0000 0000 |....T...........| 0x0210 c500 0000 dc00 0000 0000 0000 0000 0000 |................| 0x0220 a600 0000 5800 0000 b500 0000 1900 0000 |....X...........| 0x0230 0000 0000 0000 0000 5d00 0000 7e00 0000 |........]...~...| 0x0240 cc00 0000 0000 0000 1600 0000 0000 0000 |................| 0x0250 0000 0000 9200 0000 9d00 0000 3900 0000 |............9...| 0x0260 0000 0000 0000 0000 c900 0000 e100 0000 |................| 0x0270 8c00 0000 0000 0000 0000 0000 6700 0000 |............g...| 0x0280 9b00 0000 3400 0000 0000 0000 5c00 0000 |....4.......\...| 0x0290 0000 0000 7d00 0000 0000 0000 da00 0000 |....}...........| 0x02a0 c700 0000 c800 0000 3b00 0000 0000 0000 |........;.......| 0x02b0 0000 0000 0000 0000 8d00 0000 e500 0000 |................| 0x02c0 0000 0000 0000 0000 3200 0000 7a00 0000 |........2...z...| 0x02d0 2300 0000 2f00 0000 0000 0000 0000 0000 |#.../...........| 0x02e0 7300 0000 0000 0000 0000 0000 6000 0000 |s...........`...| 0x02f0 1800 0000 2500 0000 2000 0000 9700 0000 |....%... .......| 0x0300 0000 0000 5700 0000 df00 0000 4400 0000 |....W.......D...| 0x0310 2400 0000 b000 0000 d300 0000 e200 0000 |$...............| 0x0320 4f00 0000 1c00 0000 0000 0000 0000 0000 |O...............| 0x0330 6600 0000 b700 0000 0000 0000 b400 0000 |f...............| 0x0340 8300 0000 5500 0000 0000 0000 0000 0000 |....U...........| 0x0350 7200 0000 9300 0000 0000 0000 8000 0000 |r...............| 0x0360 9a00 0000 c000 0000 e400 0000 b900 0000 |................| 0x0370 c300 0000 8e00 0000 0000 0000 0000 0000 |................| 0x0380 7500 0000 cd00 0000 0000 0000 0000 0000 |u...............| 0x0390 d500 0000 b600 0000 1a00 0000 9400 0000 |................| 0x03a0 ae00 0000 c100 0000 b100 0000 8600 0000 |................| 0x03b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0400 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0410 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0420 0000 0000 0000 0000 1400 0000 0000 0000 |................| 0x0430 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0440 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0450 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0460 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0470 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0480 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0490 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04a0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04b0 0000 0000 2700 0000 0000 0000 1d00 0000 |....'...........| 0x04c0 0000 0000 0000 0000 3a00 0000 0000 0000 |........:.......| 0x04d0 2100 0000 0000 0000 0000 0000 0000 0000 |!...............| 0x04e0 3800 0000 0000 0000 4500 0000 0000 0000 |8.......E.......| 0x04f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0500 0000 0000 3f00 0000 2a00 0000 3d00 0000 |....?...*...=...| 0x0510 0000 0000 0000 0000 4000 0000 0000 0000 |........@.......| 0x0520 1f00 0000 0000 0000 0000 0000 5200 0000 |............R...| 0x0530 0000 0000 0000 0000 1b00 0000 0000 0000 |................| 0x0540 0000 0000 0000 0000 4b00 0000 6100 0000 |........K...a...| 0x0550 3c00 0000 0000 0000 0000 0000 0000 0000 |<...............| 0x0560 2800 0000 1500 0000 4800 0000 5e00 0000 |(.......H...^...| 0x0570 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0580 6b00 0000 0000 0000 0000 0000 4a00 0000 |k...........J...| 0x0590 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x05a0 0000 0000 0000 0000 5f00 0000 0000 0000 |........_.......| 0x05b0 6200 0000 0000 0000 0000 0000 3300 0000 |b...........3...| 0x05c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x05d0 6e00 0000 0000 0000 0000 0000 0000 0000 |n...............| 0x05e0 8200 0000 2b00 0000 4200 0000 0000 0000 |....+...B.......| 0x05f0 7900 0000 0000 0000 5100 0000 1700 0000 |y.......Q.......| 0x0600 8500 0000 5900 0000 8f00 0000 0000 0000 |....Y...........| 0x0610 0000 0000 0000 0000 0000 0000 2900 0000 |............)...| 0x0620 8700 0000 7700 0000 0000 0000 8800 0000 |....w...........| 0x0630 7b00 0000 0000 0000 0000 0000 8900 0000 |{...............| 0x0640 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0650 0000 0000 a200 0000 4c00 0000 3700 0000 |........L...7...| 0x0660 a700 0000 2c00 0000 0000 0000 0000 0000 |....,...........| 0x0670 8b00 0000 a900 0000 5600 0000 0000 0000 |........V.......| 0x0680 0000 0000 8a00 0000 2200 0000 0000 0000 |........".......| 0x0690 4100 0000 7400 0000 0000 0000 4600 0000 |A...t.......F...| 0x06a0 6900 0000 a000 0000 0000 0000 0000 0000 |i...............| 0x06b0 ad00 0000 0000 0000 4700 0000 bf00 0000 |........G.......| 0x06c0 3600 0000 0000 0000 5300 0000 b300 0000 |6.......S.......| 0x06d0 0000 0000 0000 0000 7100 0000 7600 0000 |........q...v...| 0x06e0 0000 0000 0000 0000 0000 0000 4d00 0000 |............M...| 0x06f0 a300 0000 8400 0000 ab00 0000 1e00 0000 |................| 0x0700 0000 0000 0000 0000 be00 0000 d200 0000 |................| 0x0710 0000 0000 0000 0000 3000 0000 0000 0000 |........0.......| 0x0720 0000 0000 ce00 0000 7f00 0000 0000 0000 |................| 0x0730 af00 0000 3100 0000 bc00 0000 2e00 0000 |....1...........| 0x0740 0000 0000 0000 0000 a100 0000 3500 0000 |............5...| 0x0750 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0760 0000 0000 9400 0000 0000 0000 0300 0100 |................| 0x0770 0000 0000 5007 0000 0000 0000 0300 0200 |....P...........| 0x0780 0000 0000 d015 0000 0000 0000 0300 0300 |................| 0x0790 0000 0000 881b 0000 0000 0000 0300 0400 |................| 0x07a0 0000 0000 c81b 0000 0000 0000 0300 0500 |................| 0x07b0 0000 0000 801e 0000 0000 0000 0300 0600 |................| 0x07c0 0000 0000 941e 0000 0000 0000 0300 0700 |................| 0x07d0 0000 0000 1424 0000 0000 0000 0300 0800 |.....$..........| 0x07e0 0000 0000 fc15 0100 0000 0000 0300 0900 |................| 0x07f0 0000 0000 2016 0100 0000 0000 0300 0a00 |.... ...........| 0x0800 0000 0000 0050 0100 0000 0000 0300 0b00 |.....P..........| 0x0810 0000 0000 6858 0100 0000 0000 0300 0c00 |....hX..........| 0x0820 0000 0000 6c58 0100 0000 0000 0300 0d00 |....lX..........| 0x0830 0000 0000 1459 0100 0000 0000 0300 0e00 |.....Y..........| 0x0840 0000 0000 1c59 0100 0000 0000 0300 0f00 |.....Y..........| 0x0850 0000 0000 2459 0100 0000 0000 0300 1000 |....$Y..........| 0x0860 0000 0000 2859 0100 0000 0000 0300 1100 |....(Y..........| 0x0870 0000 0000 a85a 0100 0000 0000 0300 1200 |.....Z..........| 0x0880 0000 0000 0000 0000 0000 0000 0300 1300 |................| 0x0890 6c03 0000 80df 0000 5000 0000 1200 0800 |l.......P.......| 0x08a0 0402 0000 ace4 0000 1503 0000 1200 0800 |................| 0x08b0 9604 0000 94aa 0000 a501 0000 1200 0800 |................| 0x08c0 cb03 0000 1012 0100 0000 0000 1200 0800 |................| 0x08d0 c003 0000 fccf 0000 0000 0000 1200 0800 |................| 0x08e0 d404 0000 58ad 0000 4501 0000 1200 0800 |....X...E.......| 0x08f0 ba03 0000 4462 0000 3601 0000 1200 0800 |....Db..6.......| 0x0900 ca02 0000 fc3a 0000 3c00 0000 1200 0800 |.....:..<.......| 0x0910 7b03 0000 104b 0000 3d01 0000 1200 0800 |{....K..=.......| 0x0920 8e05 0000 0811 0100 0000 0000 1200 0800 |................| 0x0930 6601 0000 3069 0000 2c00 0000 1200 0800 |f...0i..,.......| 0x0940 2b03 0000 5cce 0000 0000 0000 1200 0800 |+...\...........| 0x0950 d402 0000 48d6 0000 ae00 0000 1200 0800 |....H...........| 0x0960 9c04 0000 a0ae 0000 d100 0000 1200 0800 |................| 0x0970 1e01 0000 7029 0000 2900 0000 1200 0800 |....p)..).......| 0x0980 9f00 0000 7025 0000 0000 0000 1200 0800 |....p%..........| 0x0990 5304 0000 f4f6 0000 2300 0000 1200 0800 |S.......#.......| 0x09a0 9102 0000 3c38 0000 d600 0000 1200 0800 |....<8..........| 0x09b0 0001 0000 3c28 0000 0800 0000 1200 0800 |....<(..........| 0x09c0 4104 0000 ac71 0000 e806 0000 1200 0800 |A....q..........| 0x09d0 0100 0000 6c58 0100 0000 0000 1100 f1ff |....lX..........| 0x09e0 d302 0000 383b 0000 7a00 0000 1200 0800 |....8;..z.......| 0x09f0 3003 0000 e0de 0000 2100 0000 1200 0800 |0.......!.......| 0x0a00 ba02 0000 203a 0000 6000 0000 1200 0800 |.... :..`.......| 0x0a10 0a02 0000 e8f3 0000 0903 0000 1200 0800 |................| 0x0a20 9d04 0000 2034 0000 e900 0000 1200 0800 |.... 4..........| 0x0a30 7d00 0000 f024 0000 0000 0000 1200 0800 |}....$..........| 0x0a40 0305 0000 8cfa 0000 0000 0000 1200 0800 |................| 0x0a50 b503 0000 4411 0100 0000 0000 1200 0800 |....D...........| 0x0a60 e802 0000 103e 0000 b000 0000 1200 0800 |.....>..........| 0x0a70 fd04 0000 9c11 0100 0000 0000 1200 0800 |................| 0x0a80 8a04 0000 5894 0000 3f02 0000 1200 0800 |....X...?.......| 0x0a90 a803 0000 30cd 0000 0000 0000 1200 0800 |....0...........| 0x0aa0 9004 0000 9ca3 0000 5202 0000 1200 0800 |........R.......| 0x0ab0 1c04 0000 5c6e 0000 5003 0000 1200 0800 |....\n..P.......| 0x0ac0 ed03 0000 606b 0000 9400 0000 1200 0800 |....`k..........| 0x0ad0 5903 0000 204a 0000 6500 0000 1200 0800 |Y... J..e.......| 0x0ae0 f701 0000 f433 0000 2900 0000 1200 0800 |.....3..).......| 0x0af0 2c00 0000 0000 0000 0000 0000 2000 0000 |,........... ...| 0x0b00 5c04 0000 ec80 0000 2900 0000 1200 0800 |\.......).......| 0x0b10 e404 0000 80c9 0000 ee01 0000 1200 0800 |................| 0x0b20 cb02 0000 9cd5 0000 a900 0000 1200 0800 |................| 0x0b30 8b00 0000 4025 0000 0000 0000 1200 0800 |....@%..........| 0x0b40 b900 0000 0026 0000 0000 0000 1200 0800 |.....&..........| 0x0b50 7405 0000 c414 0100 0701 0000 1200 0800 |t...............| 0x0b60 2403 0000 0000 0000 0000 0000 1000 0000 |$...............| 0x0b70 c102 0000 803a 0000 7a00 0000 1200 0800 |.....:..z.......| 0x0b80 8d04 0000 cc89 0000 6f02 0000 1200 0800 |........o.......| 0x0b90 9901 0000 7cd1 0000 0802 0000 1200 0800 |....|...........| 0x0ba0 cc01 0000 3056 0000 2404 0000 1200 0800 |....0V..$.......| 0x0bb0 4005 0000 9c49 0000 1500 0000 1200 0800 |@....I..........| 0x0bc0 5402 0000 c036 0000 2600 0000 1200 0800 |T....6..&.......| 0x0bd0 7503 0000 fc4a 0000 1400 0000 1200 0800 |u....J..........| 0x0be0 d001 0000 8033 0000 2700 0000 1200 0800 |.....3..'.......| 0x0bf0 9200 0000 6425 0000 0000 0000 1200 0800 |....d%..........| 0x0c00 8105 0000 e412 0100 de00 0000 1200 0800 |................| 0x0c10 5f03 0000 58df 0000 2600 0000 1200 0800 |_...X...&.......| 0x0c20 2b01 0000 c829 0000 ca01 0000 1200 0800 |+....)..........| 0x0c30 2805 0000 1c12 0100 c600 0000 1200 0800 |(...............| 0x0c40 5d04 0000 68aa 0000 2900 0000 1200 0800 |]...h...).......| 0x0c50 dc03 0000 c46a 0000 9a00 0000 1200 0800 |.....j..........| 0x0c60 cc04 0000 28ba 0000 0101 0000 1200 0800 |....(...........| 0x0c70 2501 0000 9c29 0000 2900 0000 1200 0800 |%....)..).......| 0x0c80 df01 0000 a833 0000 2300 0000 1200 0800 |.....3..#.......| 0x0c90 e000 0000 6427 0000 0000 0000 1200 0800 |....d'..........| 0x0ca0 2000 0000 801e 0000 0000 0000 1200 0600 | ...............| 0x0cb0 9c02 0000 1439 0000 8700 0000 1200 0800 |.....9..........| 0x0cc0 c501 0000 38cd 0000 0000 0000 1200 0800 |....8...........| 0x0cd0 2305 0000 c4e7 0000 ca00 0000 1200 0800 |#...............| 0x0ce0 3402 0000 8036 0000 0d00 0000 1200 0800 |4....6..........| 0x0cf0 de03 0000 c46a 0000 9a00 0000 2200 0800 |.....j......"...| 0x0d00 b901 0000 3833 0000 2100 0000 1200 0800 |....83..!.......| 0x0d10 2f04 0000 44ec 0000 a107 0000 1200 0800 |/...D...........| 0x0d20 f404 0000 70cb 0000 8601 0000 1200 0800 |....p...........| 0x0d30 e200 0000 08ce 0000 0000 0000 1200 0800 |................| 0x0d40 ef03 0000 606b 0000 9400 0000 2200 0800 |....`k......"...| 0x0d50 4e01 0000 0850 0100 0400 0000 1100 0b00 |N....P..........| 0x0d60 1a05 0000 c413 0100 fe00 0000 1200 0800 |................| 0x0d70 4a04 0000 c480 0000 2600 0000 1200 0800 |J.......&.......| 0x0d80 a800 0000 b825 0000 0000 0000 1200 0800 |.....%..........| 0x0d90 f900 0000 3428 0000 0800 0000 1200 0800 |....4(..........| 0x0da0 f902 0000 3c40 0000 b000 0000 1200 0800 |....<@..........| 0x0db0 8400 0000 1425 0000 0000 0000 1200 0800 |.....%..........| 0x0dc0 e100 0000 5827 0000 0000 0000 1200 0800 |....X'..........| 0x0dd0 ff03 0000 982c 0100 1c00 0000 1100 0a00 |.....,..........| 0x0de0 c202 0000 e8d4 0000 b300 0000 1200 0800 |................| 0x0df0 6603 0000 884a 0000 7100 0000 1200 0800 |f....J..q.......| 0x0e00 e501 0000 f0a5 0000 0002 0000 1200 0800 |................| 0x0e10 7d02 0000 f8cc 0000 0000 0000 1200 0800 |}...............| 0x0e20 3b00 0000 0000 0000 0000 0000 2000 0000 |;........... ...| 0x0e30 1303 0000 d0df 0000 1d00 0000 1200 0800 |................| 0x0e40 7404 0000 3c8e 0000 1302 0000 1200 0800 |t...<...........| 0x0e50 a103 0000 fc60 0000 4501 0000 1200 0800 |.....`..E.......| 0x0e60 4e05 0000 04df 0000 1f00 0000 1200 0800 |N...............| 0x0e70 c000 0000 0c26 0000 0000 0000 1200 0800 |.....&..........| 0x0e80 8004 0000 5090 0000 2c02 0000 1200 0800 |....P...,.......| 0x0e90 3b01 0000 04e0 0000 2e00 0000 1200 0800 |;...............| 0x0ea0 ed00 0000 1828 0000 0000 0000 1200 0800 |.....(..........| 0x0eb0 7d05 0000 1ccf 0000 0000 0000 1200 0800 |}...............| 0x0ec0 ae01 0000 4c68 0000 6b00 0000 1200 0800 |....Lh..k.......| 0x0ed0 a404 0000 0c35 0000 f200 0000 1200 0800 |.....5..........| 0x0ee0 8103 0000 504c 0000 5b01 0000 1200 0800 |....PL..[.......| 0x0ef0 cd00 0000 0427 0000 0000 0000 1200 0800 |.....'..........| 0x0f00 0c01 0000 9828 0000 5600 0000 1200 0800 |.....(..V.......| 0x0f10 ed04 0000 10c4 0000 6e05 0000 1200 0800 |........n.......| 0x0f20 cd04 0000 3cac 0000 1a01 0000 1200 0800 |....<...........| 0x0f30 8a05 0000 98cd 0000 0000 0000 1200 0800 |................| 0x0f40 a401 0000 08cd 0000 0000 0000 1200 0800 |................| 0x0f50 0f03 0000 7842 0000 2307 0000 1200 0800 |....xB..#.......| 0x0f60 b604 0000 d8b2 0000 9d02 0000 1200 0800 |................| 0x0f70 4b04 0000 40aa 0000 2600 0000 1200 0800 |K...@...&.......| 0x0f80 6404 0000 18f7 0000 2600 0000 1200 0800 |d.......&.......| 0x0f90 4604 0000 9478 0000 2f08 0000 1200 0800 |F....x../.......| 0x0fa0 bb03 0000 246d 0000 3801 0000 1200 0800 |....$m..8.......| 0x0fb0 1701 0000 4429 0000 2b00 0000 1200 0800 |....D)..+.......| 0x0fc0 9603 0000 b45e 0000 cb00 0000 1200 0800 |.....^..........| 0x0fd0 a304 0000 74af 0000 f600 0000 1200 0800 |....t...........| 0x0fe0 e700 0000 c027 0000 0000 0000 1200 0800 |.....'..........| 0x0ff0 f402 0000 743f 0000 c800 0000 1200 0800 |....t?..........| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0x16000,0x5,0x20002,0x3,0,0,0) 21495 perl5.8.8 RET mmap 672743424/0x28194000 21495 perl5.8.8 CALL mprotect(0x281a8000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x281a8000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x281a9000,0x1000,0x3,0x12,0x3,0,0x15000,0) 21495 perl5.8.8 RET mmap 672829440/0x281a9000 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL access(0x28191000,0) 21495 perl5.8.8 NAMI "/lib/libcrypt.so.3" 21495 perl5.8.8 RET access 0 21495 perl5.8.8 CALL open(0x2818d040,0,0xbfbfe968) 21495 perl5.8.8 NAMI "/lib/libcrypt.so.3" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL fstat(0x3,0xbfbfe8f0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x3,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 3 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 900e 0000 3400 0000 |............4...| 0x0020 c06c 0000 0000 0000 3400 2000 0300 2800 |.l......4. ...(.| 0x0030 1500 1400 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 c65d 0000 c65d 0000 0500 0000 |.....]...]......| 0x0050 0010 0000 0100 0000 0060 0000 0060 0000 |.........`...`..| 0x0060 0060 0000 0007 0000 3c1d 0100 0600 0000 |.`......<.......| 0x0070 0010 0000 0200 0000 8465 0000 8465 0000 |.........e...e..| 0x0080 8465 0000 a800 0000 a800 0000 0600 0000 |.e..............| 0x0090 0400 0000 4300 0000 4b00 0000 0000 0000 |....C...K.......| 0x00a0 4700 0000 2f00 0000 0000 0000 0000 0000 |G.../...........| 0x00b0 2800 0000 1a00 0000 3400 0000 1600 0000 |(.......4.......| 0x00c0 0000 0000 4000 0000 2d00 0000 0000 0000 |....@...-.......| 0x00d0 0000 0000 0000 0000 3c00 0000 0000 0000 |........<.......| 0x00e0 0000 0000 3800 0000 2300 0000 0000 0000 |....8...#.......| 0x00f0 2500 0000 4300 0000 0000 0000 4100 0000 |%...C.......A...| 0x0100 4800 0000 2200 0000 0000 0000 0000 0000 |H..."...........| 0x0110 4200 0000 0000 0000 0000 0000 4500 0000 |B...........E...| 0x0120 2700 0000 0000 0000 0000 0000 4900 0000 |'...........I...| 0x0130 1900 0000 3d00 0000 2e00 0000 0000 0000 |....=...........| 0x0140 4400 0000 0000 0000 3000 0000 1400 0000 |D.......0.......| 0x0150 2900 0000 2a00 0000 0000 0000 0000 0000 |)...*...........| 0x0160 3600 0000 2000 0000 0000 0000 0000 0000 |6... ...........| 0x0170 0000 0000 0000 0000 0000 0000 3b00 0000 |............;...| 0x0180 0000 0000 3300 0000 3900 0000 3100 0000 |....3...9...1...| 0x0190 4a00 0000 1e00 0000 0000 0000 3500 0000 |J...........5...| 0x01a0 0000 0000 2100 0000 0000 0000 0000 0000 |....!...........| 0x01b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0200 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0210 0000 0000 1800 0000 0000 0000 0000 0000 |................| 0x0220 1700 0000 0000 0000 0000 0000 0000 0000 |................| 0x0230 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0240 0000 0000 0000 0000 1500 0000 0000 0000 |................| 0x0250 0000 0000 0000 0000 0000 0000 1f00 0000 |................| 0x0260 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0270 2400 0000 0000 0000 0000 0000 0000 0000 |$...............| 0x0280 0000 0000 1c00 0000 3200 0000 2b00 0000 |........2...+...| 0x0290 0000 0000 1b00 0000 2c00 0000 0000 0000 |........,.......| 0x02a0 0000 0000 0000 0000 3700 0000 0000 0000 |........7.......| 0x02b0 0000 0000 0000 0000 3a00 0000 0000 0000 |........:.......| 0x02c0 2600 0000 4600 0000 3f00 0000 1d00 0000 |&...F...?.......| 0x02d0 3e00 0000 0000 0000 0000 0000 0000 0000 |>...............| 0x02e0 0000 0000 0000 0000 9400 0000 0000 0000 |................| 0x02f0 0300 0100 0000 0000 d402 0000 0000 0000 |................| 0x0300 0300 0200 0000 0000 8407 0000 0000 0000 |................| 0x0310 0300 0300 0000 0000 040a 0000 0000 0000 |................| 0x0320 0300 0400 0000 0000 ac0a 0000 0000 0000 |................| 0x0330 0300 0500 0000 0000 ec0b 0000 0000 0000 |................| 0x0340 0300 0600 0000 0000 000c 0000 0000 0000 |................| 0x0350 0300 0700 0000 0000 900e 0000 0000 0000 |................| 0x0360 0300 0800 0000 0000 004b 0000 0000 0000 |.........K......| 0x0370 0300 0900 0000 0000 204b 0000 0000 0000 |........ K......| 0x0380 0300 0a00 0000 0000 0060 0000 0000 0000 |.........`......| 0x0390 0300 0b00 0000 0000 8065 0000 0000 0000 |.........e......| 0x03a0 0300 0c00 0000 0000 8465 0000 0000 0000 |.........e......| 0x03b0 0300 0d00 0000 0000 2c66 0000 0000 0000 |........,f......| 0x03c0 0300 0e00 0000 0000 3466 0000 0000 0000 |........4f......| 0x03d0 0300 0f00 0000 0000 3c66 0000 0000 0000 |.................| 0x0c00 ffb3 0400 0000 ffa3 0800 0000 0000 0000 |................| 0x0c10 ffa3 0c00 0000 6800 0000 00e9 e0ff ffff |......h.........| 0x0c20 ffa3 1000 0000 6808 0000 00e9 d0ff ffff |......h.........| 0x0c30 ffa3 1400 0000 6810 0000 00e9 c0ff ffff |......h.........| 0x0c40 ffa3 1800 0000 6818 0000 00e9 b0ff ffff |......h.........| 0x0c50 ffa3 1c00 0000 6820 0000 00e9 a0ff ffff |......h ........| 0x0c60 ffa3 2000 0000 6828 0000 00e9 90ff ffff |.. ...h(........| 0x0c70 ffa3 2400 0000 6830 0000 00e9 80ff ffff |..$...h0........| 0x0c80 ffa3 2800 0000 6838 0000 00e9 70ff ffff |..(...h8....p...| 0x0c90 ffa3 2c00 0000 6840 0000 00e9 60ff ffff |..,...h@....`...| 0x0ca0 ffa3 3000 0000 6848 0000 00e9 50ff ffff |..0...hH....P...| 0x0cb0 ffa3 3400 0000 6850 0000 00e9 40ff ffff |..4...hP....@...| 0x0cc0 ffa3 3800 0000 6858 0000 00e9 30ff ffff |..8...hX....0...| 0x0cd0 ffa3 3c00 0000 6860 0000 00e9 20ff ffff |..<...h`.... ...| 0x0ce0 ffa3 4000 0000 6868 0000 00e9 10ff ffff |..@...hh........| 0x0cf0 ffa3 4400 0000 6870 0000 00e9 00ff ffff |..D...hp........| 0x0d00 ffa3 4800 0000 6878 0000 00e9 f0fe ffff |..H...hx........| 0x0d10 ffa3 4c00 0000 6880 0000 00e9 e0fe ffff |..L...h.........| 0x0d20 ffa3 5000 0000 6888 0000 00e9 d0fe ffff |..P...h.........| 0x0d30 ffa3 5400 0000 6890 0000 00e9 c0fe ffff |..T...h.........| 0x0d40 ffa3 5800 0000 6898 0000 00e9 b0fe ffff |..X...h.........| 0x0d50 ffa3 5c00 0000 68a0 0000 00e9 a0fe ffff |..\...h.........| 0x0d60 ffa3 6000 0000 68a8 0000 00e9 90fe ffff |..`...h.........| 0x0d70 ffa3 6400 0000 68b0 0000 00e9 80fe ffff |..d...h.........| 0x0d80 ffa3 6800 0000 68b8 0000 00e9 70fe ffff |..h...h.....p...| 0x0d90 ffa3 6c00 0000 68c0 0000 00e9 60fe ffff |..l...h.....`...| 0x0da0 ffa3 7000 0000 68c8 0000 00e9 50fe ffff |..p...h.....P...| 0x0db0 ffa3 7400 0000 68d0 0000 00e9 40fe ffff |..t...h.....@...| 0x0dc0 ffa3 7800 0000 68d8 0000 00e9 30fe ffff |..x...h.....0...| 0x0dd0 ffa3 7c00 0000 68e0 0000 00e9 20fe ffff |..|...h..... ...| 0x0de0 ffa3 8000 0000 68e8 0000 00e9 10fe ffff |......h.........| 0x0df0 ffa3 8400 0000 68f0 0000 00e9 00fe ffff |......h.........| 0x0e00 ffa3 8800 0000 68f8 0000 00e9 f0fd ffff |......h.........| 0x0e10 ffa3 8c00 0000 6800 0100 00e9 e0fd ffff |......h.........| 0x0e20 ffa3 9000 0000 6808 0100 00e9 d0fd ffff |......h.........| 0x0e30 ffa3 9400 0000 6810 0100 00e9 c0fd ffff |......h.........| 0x0e40 ffa3 9800 0000 6818 0100 00e9 b0fd ffff |......h.........| 0x0e50 ffa3 9c00 0000 6820 0100 00e9 a0fd ffff |......h ........| 0x0e60 ffa3 a000 0000 6828 0100 00e9 90fd ffff |......h(........| 0x0e70 ffa3 a400 0000 6830 0100 00e9 80fd ffff |......h0........| 0x0e80 ffa3 a800 0000 6838 0100 00e9 70fd ffff |......h8....p...| 0x0e90 5589 e553 e800 0000 005b 81c3 a757 0000 |U..S.....[...W..| 0x0ea0 5180 bbc0 0000 0000 7558 8b93 ac00 0000 |Q.......uX......| 0x0eb0 85d2 741f 83ec 0cff b3c0 f9ff ffe8 befd |..t.............| 0x0ec0 ffff 83c4 10eb 0c90 83c0 0489 83c4 f9ff |................| 0x0ed0 ffff d28b 83c4 f9ff ff8b 1085 d275 e98b |.............u..| 0x0ee0 83b0 0000 0085 c074 1283 ec0c 8d83 40ff |.......t......@.| 0x0ef0 ffff 50e8 08fe ffff 83c4 10c6 83c0 0000 |..P.............| 0x0f00 0001 8b5d fcc9 c390 5589 e553 e800 0000 |...]....U..S....| 0x0f10 005b 81c3 2f57 0000 508b 83bc 0000 0085 |.[../W..P.......| 0x0f20 c074 1983 ec08 8d83 c400 0000 508d 8340 |.t..........P..@| 0x0f30 ffff ff50 e817 ffff ff83 c410 8b83 fcff |...P............| 0x0f40 ffff 85c0 741e 8b83 b800 0000 85c0 7414 |....t.........t.| 0x0f50 83ec 0c8d 83fc ffff ff50 e8e1 feff ff83 |.........P......| 0x0f60 c410 89f6 8b5d fcc9 c390 9090 5589 e557 |.....]......U..W| 0x0f70 5653 83ec 0ce8 0000 0000 5b81 c3c6 5600 |VS........[...V.| 0x0f80 0083 bbc8 f9ff ffff 740a 8d65 f45b 5e5f |........t..e.[^_| 0x0f90 c9c3 89f6 83ec 0c8d 8345 e5ff ff50 e85d |.........E...P.]| 0x0fa0 feff ff83 c410 85c0 8945 f074 308d 83e0 |.........E.t0...| 0x0fb0 f9ff ff31 ff89 45ec 31f6 89f6 83ec 088b |...1..E.1.......| 0x0fc0 45ec ff34 06ff 75f0 e813 feff ff83 c410 |E..4..u.........| 0x0fd0 85c0 741b 4783 c60c 83ff 0376 dfc7 83c8 |..t.G......v....| 0x0fe0 f9ff ff00 0000 008d 65f4 5b5e 5fc9 c389 |........e.[^_...| 0x0ff0 bbc8 f9ff ffeb 9390 5589 e553 e800 0000 |........U..S....| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0x18000,0x5,0x20002,0x3,0,0,0) 21495 perl5.8.8 RET mmap 672833536/0x281aa000 21495 perl5.8.8 CALL mprotect(0x281af000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x281af000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x281b0000,0x1000,0x3,0x12,0x3,0,0x6000,0) 21495 perl5.8.8 RET mmap 672858112/0x281b0000 21495 perl5.8.8 CALL mmap(0x281b1000,0x11000,0x3,0x1012,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 672862208/0x281b1000 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL access(0x28191000,0) 21495 perl5.8.8 NAMI "/lib/libutil.so.5" 21495 perl5.8.8 RET access 0 21495 perl5.8.8 CALL open(0x2818d060,0,0xbfbfe968) 21495 perl5.8.8 NAMI "/lib/libutil.so.5" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL fstat(0x3,0xbfbfe8f0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x3,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 3 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 742e 0000 3400 0000 |........t...4...| 0x0020 a8a6 0000 0000 0000 3400 2000 0300 2800 |........4. ...(.| 0x0030 1500 1400 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 c996 0000 c996 0000 0500 0000 |................| 0x0050 0010 0000 0100 0000 e096 0000 e0a6 0000 |................| 0x0060 e0a6 0000 4c05 0000 6813 0000 0600 0000 |....L...h.......| 0x0070 0010 0000 0200 0000 c498 0000 c4a8 0000 |................| 0x0080 c4a8 0000 a800 0000 a800 0000 0600 0000 |................| 0x0090 0400 0000 c500 0000 e400 0000 0000 0000 |................| 0x00a0 8800 0000 0000 0000 b100 0000 0000 0000 |................| 0x00b0 0000 0000 ac00 0000 c600 0000 0000 0000 |................| 0x00c0 5500 0000 8a00 0000 0000 0000 0000 0000 |U...............| 0x00d0 8b00 0000 0000 0000 3400 0000 0000 0000 |........4.......| 0x00e0 9b00 0000 9e00 0000 1c00 0000 d500 0000 |................| 0x00f0 bb00 0000 6200 0000 0000 0000 a600 0000 |....b...........| 0x0100 c300 0000 df00 0000 2d00 0000 9800 0000 |........-.......| 0x0110 cb00 0000 0000 0000 5600 0000 0000 0000 |........V.......| 0x0120 3900 0000 b600 0000 8f00 0000 0000 0000 |9...............| 0x0130 8900 0000 4d00 0000 7200 0000 d000 0000 |....M...r.......| 0x0140 de00 0000 2200 0000 0000 0000 5f00 0000 |...."......._...| 0x0150 2e00 0000 7300 0000 2500 0000 0000 0000 |....s...%.......| 0x0160 d100 0000 1400 0000 0000 0000 0000 0000 |................| 0x0170 0000 0000 c400 0000 0000 0000 2300 0000 |............#...| 0x0180 9700 0000 1800 0000 bf00 0000 ca00 0000 |................| 0x0190 7a00 0000 6400 0000 d700 0000 4000 0000 |z...d.......@...| 0x01a0 0000 0000 ab00 0000 a500 0000 b800 0000 |................| 0x01b0 0000 0000 8d00 0000 b900 0000 0000 0000 |................| 0x01c0 2c00 0000 0000 0000 c200 0000 0000 0000 |,...............| 0x01d0 6a00 0000 0000 0000 e300 0000 bd00 0000 |j...............| 0x01e0 1900 0000 da00 0000 d400 0000 5300 0000 |............S...| 0x01f0 b300 0000 1b00 0000 5400 0000 c500 0000 |........T.......| 0x0200 0000 0000 cd00 0000 0000 0000 c800 0000 |................| 0x0210 0000 0000 8100 0000 0000 0000 8300 0000 |................| 0x0220 7100 0000 e100 0000 d900 0000 6d00 0000 |q...........m...| 0x0230 6b00 0000 0000 0000 9600 0000 0000 0000 |k...............| 0x0240 5e00 0000 d600 0000 0000 0000 0000 0000 |^...............| 0x0250 0000 0000 3000 0000 8e00 0000 d200 0000 |....0...........| 0x0260 2600 0000 4300 0000 0000 0000 c900 0000 |&...C...........| 0x0270 0000 0000 4700 0000 7700 0000 8600 0000 |....G...w.......| 0x0280 e000 0000 6c00 0000 0000 0000 e200 0000 |....l...........| 0x0290 3200 0000 7600 0000 7400 0000 0000 0000 |2...v...t.......| 0x02a0 d800 0000 1e00 0000 0000 0000 cf00 0000 |................| 0x02b0 0000 0000 0000 0000 aa00 0000 cc00 0000 |................| 0x02c0 7f00 0000 0000 0000 9c00 0000 0000 0000 |................| 0x02d0 8500 0000 0000 0000 0000 0000 4900 0000 |............I...| 0x02e0 ad00 0000 0000 0000 2800 0000 0000 0000 |........(.......| 0x02f0 0000 0000 b500 0000 3800 0000 0000 0000 |........8.......| 0x0300 0000 0000 af00 0000 a200 0000 0000 0000 |................| 0x0310 0000 0000 0000 0000 0000 0000 db00 0000 |................| 0x0320 c100 0000 4500 0000 2700 0000 3d00 0000 |....E...'...=...| 0x0330 0000 0000 0000 0000 dd00 0000 4400 0000 |............D...| 0x0340 5b00 0000 ba00 0000 0000 0000 5900 0000 |[...........Y...| 0x0350 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0360 0000 0000 d300 0000 a400 0000 bc00 0000 |................| 0x0370 c000 0000 1f00 0000 0000 0000 7500 0000 |............u...| 0x0380 8000 0000 9000 0000 9100 0000 dc00 0000 |................| 0x0390 ae00 0000 a300 0000 7c00 0000 0000 0000 |........|.......| 0x03a0 6700 0000 c700 0000 ce00 0000 0000 0000 |g...............| 0x03b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x03f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0400 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0410 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0420 0000 0000 1a00 0000 1600 0000 0000 0000 |................| 0x0430 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0440 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0450 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0460 2100 0000 0000 0000 0000 0000 0000 0000 |!...............| 0x0470 0000 0000 0000 0000 2900 0000 0000 0000 |........).......| 0x0480 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0490 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04a0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04c0 0000 0000 2400 0000 0000 0000 0000 0000 |....$...........| 0x04d0 0000 0000 0000 0000 3e00 0000 0000 0000 |........>.......| 0x04e0 4200 0000 0000 0000 3500 0000 0000 0000 |B.......5.......| 0x04f0 1500 0000 0000 0000 4100 0000 0000 0000 |........A.......| 0x0500 0000 0000 0000 0000 0000 0000 3a00 0000 |............:...| 0x0510 2000 0000 1d00 0000 3100 0000 2b00 0000 | .......1...+...| 0x0520 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0530 3700 0000 0000 0000 0000 0000 0000 0000 |7...............| 0x0540 0000 0000 4a00 0000 0000 0000 6300 0000 |....J.......c...| 0x0550 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0560 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0570 0000 0000 0000 0000 6100 0000 1700 0000 |........a.......| 0x0580 0000 0000 0000 0000 6500 0000 0000 0000 |........e.......| 0x0590 5800 0000 0000 0000 0000 0000 0000 0000 |X...............| 0x05a0 3f00 0000 0000 0000 0000 0000 7900 0000 |?...........y...| 0x05b0 0000 0000 6800 0000 6e00 0000 0000 0000 |....h...n.......| 0x05c0 4e00 0000 0000 0000 5000 0000 0000 0000 |N.......P.......| 0x05d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x05e0 0000 0000 6000 0000 0000 0000 0000 0000 |....`...........| 0x05f0 0000 0000 4600 0000 3600 0000 4800 0000 |....F...6...H...| 0x0600 7e00 0000 0000 0000 0000 0000 0000 0000 |~...............| 0x0610 7800 0000 5c00 0000 0000 0000 0000 0000 |x...\...........| 0x0620 9500 0000 0000 0000 0000 0000 0000 0000 |................| 0x0630 5700 0000 5100 0000 7d00 0000 0000 0000 |W...Q...}.......| 0x0640 7b00 0000 0000 0000 5a00 0000 8700 0000 |{.......Z.......| 0x0650 4c00 0000 8200 0000 0000 0000 0000 0000 |L...............| 0x0660 9200 0000 a700 0000 0000 0000 0000 0000 |................| 0x0670 0000 0000 0000 0000 3300 0000 0000 0000 |........3.......| 0x0680 0000 0000 b400 0000 7000 0000 9900 0000 |........p.......| 0x0690 6f00 0000 5200 0000 5d00 0000 6900 0000 |o...R...]...i...| 0x06a0 9400 0000 4b00 0000 0000 0000 4f00 0000 |....K.......O...| 0x06b0 a000 0000 8c00 0000 b200 0000 0000 0000 |................| 0x06c0 b700 0000 0000 0000 9f00 0000 0000 0000 |................| 0x06d0 0000 0000 b000 0000 be00 0000 6600 0000 |............f...| 0x06e0 0000 0000 0000 0000 a800 0000 9d00 0000 |................| 0x06f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0700 0000 0000 3b00 0000 3c00 0000 2f00 0000 |....;...<.../...| 0x0710 9300 0000 0000 0000 0000 0000 2a00 0000 |............*...| 0x0720 0000 0000 0000 0000 8400 0000 9a00 0000 |................| 0x0730 a100 0000 a900 0000 0000 0000 0000 0000 |................| 0x0740 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0750 0000 0000 9400 0000 0000 0000 0300 0100 |................| 0x0760 0000 0000 4007 0000 0000 0000 0300 0200 |....@...........| 0x0770 0000 0000 8015 0000 0000 0000 0300 0300 |................| 0x0780 0000 0000 681d 0000 0000 0000 0300 0400 |....h...........| 0x0790 0000 0000 681f 0000 0000 0000 0300 0500 |....h...........| 0x07a0 0000 0000 6024 0000 0000 0000 0300 0600 |....`$..........| 0x07b0 0000 0000 7424 0000 0000 0000 0300 0700 |....t$..........| 0x07c0 0000 0000 742e 0000 0000 0000 0300 0800 |....t...........| 0x07d0 0000 0000 b88a 0000 0000 0000 0300 0900 |................| 0x07e0 0000 0000 c48a 0000 0000 0000 0300 0a00 |................| 0x07f0 0000 0000 e0a6 0000 0000 0000 0300 0b00 |................| 0x0800 0000 0000 c0a8 0000 0000 0000 0300 0c00 |................| 0x0810 0000 0000 c4a8 0000 0000 0000 0300 0d00 |................| 0x0820 0000 0000 6ca9 0000 0000 0000 0300 0e00 |....l...........| 0x0830 0000 0000 74a9 0000 0000 0000 0300 0f00 |....t...........| 0x0840 0000 0000 7ca9 0000 0000 0000 0300 1000 |....|...........| 0x0850 0000 0000 80a9 0000 0000 0000 0300 1100 |................| 0x0860 0000 0000 40ac 0000 0000 0000 0300 1200 |....@...........| 0x0870 0000 0000 0000 0000 0000 0000 0300 1300 |................| 0x0880 6801 0000 0000 0000 0000 0000 1000 0000 |h...............| 0x0890 9c03 0000 0052 0000 6200 0000 1200 0800 |.....R..b.......| 0x08a0 e505 0000 0000 0000 0000 0000 1000 0000 |................| 0x08b0 c702 0000 0000 0000 0000 0000 1000 0000 |................| 0x08c0 9a05 0000 707c 0000 4b00 0000 1200 0800 |....p|..K.......| 0x08d0 c800 0000 a431 0000 4802 0000 1200 0800 |.....1..H.......| 0x08e0 c301 0000 0000 0000 0000 0000 1000 0000 |................| 0x08f0 4a06 0000 4889 0000 4001 0000 1200 0800 |J...H...@.......| 0x0900 cc04 0000 0000 0000 0000 0000 1000 0000 |................| 0x0910 fb02 0000 0000 0000 0000 0000 1000 0000 |................| 0x0920 2802 0000 0000 0000 0000 0000 1000 0000 |(...............| 0x0930 ae00 0000 f430 0000 ad00 0000 1200 0800 |.....0..........| 0x0940 b304 0000 d056 0000 e401 0000 1200 0800 |.....V..........| 0x0950 5e05 0000 0000 0000 0000 0000 1000 0000 |^...............| 0x0960 9802 0000 7443 0000 3704 0000 1200 0800 |....tC..7.......| 0x0970 2c03 0000 bc4c 0000 6700 0000 1200 0800 |,....L..g.......| 0x0980 6d05 0000 0000 0000 0000 0000 1000 0000 |m...............| 0x0990 e601 0000 0000 0000 0000 0000 1000 0000 |................| 0x09a0 9e00 0000 0000 0000 0000 0000 1000 0000 |................| 0x09b0 5207 0000 0000 0000 0000 0000 1000 0000 |R...............| 0x09c0 8e02 0000 0000 0000 0000 0000 1000 0000 |................| 0x09d0 3004 0000 5c55 0000 f300 0000 1200 0800 |0...\U..........| 0x09e0 bf02 0000 0000 0000 0000 0000 1000 0000 |................| 0x09f0 8e01 0000 203a 0000 2901 0000 1200 0800 |.... :..).......| 0x0a00 7b00 0000 0000 0000 0000 0000 1000 0000 |{...............| 0x0a10 3606 0000 0000 0000 0000 0000 1000 0000 |6...............| 0x0a20 0100 0000 c4a8 0000 0000 0000 1100 f1ff |................| 0x0a30 5306 0000 5063 0000 3204 0000 1200 0800 |S...Pc..2.......| 0x0a40 df01 0000 0000 0000 0000 0000 1000 0000 |................| 0x0a50 4e04 0000 5056 0000 7f00 0000 1200 0800 |N...PV..........| 0x0a60 5a07 0000 0000 0000 0000 0000 1000 0000 |Z...............| 0x0a70 c503 0000 c452 0000 ca00 0000 1200 0800 |.....R..........| 0x0a80 ab05 0000 0000 0000 0000 0000 1000 0000 |................| 0x0a90 6103 0000 ec4e 0000 c401 0000 1200 0800 |a....N..........| 0x0aa0 8805 0000 0000 0000 0000 0000 1000 0000 |................| 0x0ab0 bb00 0000 0000 0000 0000 0000 1000 0000 |................| 0x0ac0 1704 0000 7c54 0000 aa00 0000 1200 0800 |....|T..........| 0x0ad0 1303 0000 504a 0000 6b02 0000 1200 0800 |....PJ..k.......| 0x0ae0 8706 0000 0000 0000 0000 0000 1000 0000 |................| 0x0af0 5203 0000 d84e 0000 1100 0000 1200 0800 |R....N..........| 0x0b00 cb01 0000 0000 0000 0000 0000 1000 0000 |................| 0x0b10 4604 0000 0877 0000 6c00 0000 1200 0800 |F....w..l.......| 0x0b20 ef04 0000 a45a 0000 b801 0000 1200 0800 |.....Z..........| 0x0b30 ad01 0000 0000 0000 0000 0000 1000 0000 |................| 0x0b40 d000 0000 0000 0000 0000 0000 1000 0000 |................| 0x0b50 2000 0000 0000 0000 0000 0000 2000 0000 | ........... ...| 0x0b60 8901 0000 0000 0000 0000 0000 1000 0000 |................| 0x0b70 9703 0000 0000 0000 0000 0000 1000 0000 |................| 0x0b80 3602 0000 0000 0000 0000 0000 1000 0000 |6...............| 0x0b90 5705 0000 0000 0000 0000 0000 1000 0000 |W...............| 0x0ba0 8002 0000 0000 0000 0000 0000 1000 0000 |................| 0x0bb0 0306 0000 0000 0000 0000 0000 1000 0000 |................| 0x0bc0 a501 0000 4c3b 0000 0101 0000 1200 0800 |....L;..........| 0x0bd0 b403 0000 6452 0000 5f00 0000 1200 0800 |....dR.._.......| 0x0be0 b705 0000 e460 0000 5a00 0000 1200 0800 |.....`..Z.......| 0x0bf0 8e06 0000 b06a 0000 a200 0000 1200 0800 |.....j..........| 0x0c00 6004 0000 e47c 0000 5c00 0000 1200 0800 |`....|..\.......| 0x0c10 e800 0000 0000 0000 0000 0000 1000 0000 |................| 0x0c20 2003 0000 0000 0000 0000 0000 1000 0000 | ...............| 0x0c30 b701 0000 0000 0000 0000 0000 1000 0000 |................| 0x0c40 4803 0000 0000 0000 0000 0000 1000 0000 |H...............| 0x0c50 0906 0000 f061 0000 8a00 0000 1200 0800 |.....a..........| 0x0c60 2b01 0000 5835 0000 a502 0000 1200 0800 |+...X5..........| 0x0c70 c200 0000 0000 0000 0000 0000 1000 0000 |................| 0x0c80 fc01 0000 0000 0000 0000 0000 1000 0000 |................| 0x0c90 d701 0000 503c 0000 8802 0000 1200 0800 |....P<..........| 0x0ca0 de02 0000 0000 0000 0000 0000 1000 0000 |................| 0x0cb0 bf06 0000 0000 0000 0000 0000 1000 0000 |................| 0x0cc0 5301 0000 0000 0000 0000 0000 1000 0000 |S...............| 0x0cd0 8b00 0000 942f 0000 a300 0000 1200 0800 |...../..........| 0x0ce0 aa06 0000 5873 0000 5500 0000 1200 0800 |....Xs..U.......| 0x0cf0 e402 0000 0000 0000 0000 0000 1000 0000 |................| 0x0d00 3b01 0000 0000 0000 0000 0000 1000 0000 |;...............| 0x0d10 6201 0000 6024 0000 0000 0000 1200 0600 |b...`$..........| 0x0d20 2404 0000 2855 0000 3400 0000 1200 0800 |$...(U..4.......| 0x0d30 9407 0000 0000 0000 0000 0000 1000 0000 |................| 0x0d40 fe00 0000 546b 0000 b001 0000 1200 0800 |....Tk..........| 0x0d50 a700 0000 0000 0000 0000 0000 1000 0000 |................| 0x0d60 fa06 0000 0000 0000 0000 0000 1000 0000 |................| 0x0d70 8107 0000 0000 0000 0000 0000 1000 0000 |................| 0x0d80 7004 0000 046d 0000 5200 0000 2200 0800 |p....m..R..."...| 0x0d90 cd02 0000 ac47 0000 b701 0000 1200 0800 |.....G..........| 0x0da0 2c06 0000 0000 0000 0000 0000 1000 0000 |,...............| 0x0db0 9501 0000 0000 0000 0000 0000 1000 0000 |................| 0x0dc0 1802 0000 0000 0000 0000 0000 1000 0000 |................| 0x0dd0 d604 0000 0000 0000 0000 0000 1000 0000 |................| 0x0de0 4203 0000 0000 0000 0000 0000 1000 0000 |B...............| 0x0df0 0903 0000 8c51 0000 7200 0000 1200 0800 |.....Q..r.......| 0x0e00 7d01 0000 0000 0000 0000 0000 1000 0000 |}...............| 0x0e10 7903 0000 0000 0000 0000 0000 1000 0000 |y...............| 0x0e20 d600 0000 0000 0000 0000 0000 1000 0000 |................| 0x0e30 2f00 0000 0000 0000 0000 0000 2000 0000 |/........... ...| 0x0e40 4c05 0000 0000 0000 0000 0000 1000 0000 |L...............| 0x0e50 9a06 0000 686e 0000 ed04 0000 1200 0800 |....hn..........| 0x0e60 1506 0000 7c62 0000 d200 0000 1200 0800 |....|b..........| 0x0e70 b806 0000 0000 0000 0000 0000 1000 0000 |................| 0x0e80 4605 0000 0000 0000 0000 0000 1000 0000 |F...............| 0x0e90 1f07 0000 0000 0000 0000 0000 1000 0000 |................| 0x0ea0 ba07 0000 0000 0000 0000 0000 1000 0000 |................| 0x0eb0 7706 0000 b467 0000 f902 0000 1200 0800 |w....g..........| 0x0ec0 9600 0000 0000 0000 0000 0000 1000 0000 |................| 0x0ed0 7701 0000 0000 0000 0000 0000 1000 0000 |w...............| 0x0ee0 2f02 0000 0000 0000 0000 0000 1000 0000 |/...............| 0x0ef0 a506 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f00 2c07 0000 7477 0000 2e00 0000 1200 0800 |,...tw..........| 0x0f10 a002 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f20 f600 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f30 8803 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f40 1807 0000 0076 0000 d700 0000 1200 0800 |.....v..........| 0x0f50 9204 0000 f484 0000 0002 0000 1200 0800 |................| 0x0f60 1501 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f70 8400 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f80 1105 0000 0000 0000 0000 0000 1000 0000 |................| 0x0f90 7902 0000 d040 0000 3902 0000 1200 0800 |y....@..9.......| 0x0fa0 8907 0000 0000 0000 0000 0000 1000 0000 |................| 0x0fb0 ea02 0000 0000 0000 0000 0000 1000 0000 |................| 0x0fc0 ee03 0000 0000 0000 0000 0000 1000 0000 |................| 0x0fd0 6f01 0000 1c39 0000 0301 0000 1200 0800 |o....9..........| 0x0fe0 ac02 0000 0000 0000 0000 0000 1000 0000 |................| 0x0ff0 0103 0000 6449 0000 8700 0000 1200 0800 |....dI..........| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0xc000,0x5,0x20002,0x3,0,0,0) 21495 perl5.8.8 RET mmap 672931840/0x281c2000 21495 perl5.8.8 CALL mprotect(0x281cb000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x281cb000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x281cc000,0x1000,0x3,0x12,0x3,0,0x9000,0) 21495 perl5.8.8 RET mmap 672972800/0x281cc000 21495 perl5.8.8 CALL mmap(0x281cd000,0x1000,0x3,0x1012,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 672976896/0x281cd000 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL access(0x28191000,0) 21495 perl5.8.8 NAMI "/lib/libc.so.6" 21495 perl5.8.8 RET access 0 21495 perl5.8.8 CALL open(0x2818d080,0,0xbfbfe968) 21495 perl5.8.8 NAMI "/lib/libc.so.6" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL fstat(0x3,0xbfbfe8f0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x3,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 3 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 c0d8 0100 3400 0000 |............4...| 0x0020 885f 0d00 0000 0000 3400 2000 0300 2800 |._......4. ...(.| 0x0030 1e00 1d00 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 32e6 0b00 32e6 0b00 0500 0000 |....2...2.......| 0x0050 0010 0000 0100 0000 00f0 0b00 00f0 0b00 |................| 0x0060 00f0 0b00 0c47 0000 a47f 0100 0600 0000 |.....G..........| 0x0070 0010 0000 0200 0000 2424 0c00 2424 0c00 |........$$..$$..| 0x0080 2424 0c00 b000 0000 b000 0000 0600 0000 |$$..............| 0x0090 0400 0000 0508 0000 d40a 0000 5705 0000 |............W...| 0x00a0 f807 0000 0000 0000 0000 0000 5107 0000 |............Q...| 0x00b0 f705 0000 f901 0000 220a 0000 0004 0000 |........".......| 0x00c0 0000 0000 3d08 0000 5d08 0000 a306 0000 |....=...].......| 0x00d0 4105 0000 8201 0000 0000 0000 1609 0000 |A...............| 0x00e0 0000 0000 f202 0000 7609 0000 dc05 0000 |........v.......| 0x00f0 ad05 0000 0000 0000 5209 0000 aa08 0000 |........R.......| 0x0100 ba0a 0000 c80a 0000 bb04 0000 c201 0000 |................| 0x0110 090a 0000 7c05 0000 8903 0000 4e0a 0000 |....|.......N...| 0x0120 0909 0000 920a 0000 910a 0000 df09 0000 |................| 0x0130 0000 0000 0000 0000 9304 0000 e506 0000 |................| 0x0140 5403 0000 350a 0000 0009 0000 2607 0000 |T...5.......&...| 0x0150 4b07 0000 0709 0000 e902 0000 bf09 0000 |K...............| 0x0160 ab0a 0000 9007 0000 7009 0000 b307 0000 |........p.......| 0x0170 9d07 0000 fe09 0000 5602 0000 d908 0000 |........V.......| 0x0180 0000 0000 0f09 0000 0000 0000 0000 0000 |................| 0x0190 a10a 0000 0507 0000 0000 0000 dc00 0000 |................| 0x01a0 7f0a 0000 6d08 0000 0000 0000 9703 0000 |....m...........| 0x01b0 fc00 0000 990a 0000 d803 0000 9307 0000 |................| 0x01c0 9702 0000 0000 0000 7409 0000 0000 0000 |........t.......| 0x01d0 f308 0000 0000 0000 b306 0000 6f00 0000 |............o...| 0x01e0 8d09 0000 0000 0000 4b08 0000 0000 0000 |........K.......| 0x01f0 5506 0000 af07 0000 0000 0000 9106 0000 |U...............| 0x0200 9208 0000 1502 0000 0000 0000 4308 0000 |............C...| 0x0210 0000 0000 1406 0000 ca09 0000 7308 0000 |............s...| 0x0220 0000 0000 c506 0000 0204 0000 0000 0000 |................| 0x0230 0000 0000 6108 0000 3302 0000 0000 0000 |....a...3.......| 0x0240 de06 0000 0000 0000 0000 0000 ad01 0000 |................| 0x0250 e907 0000 bd01 0000 c507 0000 0f0a 0000 |................| 0x0260 2400 0000 f704 0000 ef08 0000 0000 0000 |$...............| 0x0270 4a09 0000 140a 0000 1c0a 0000 3b04 0000 |J...........;...| 0x0280 ca07 0000 0000 0000 e409 0000 fa09 0000 |................| 0x0290 5101 0000 3908 0000 0000 0000 6509 0000 |Q...9.......e...| 0x02a0 ef06 0000 2307 0000 0000 0000 7a09 0000 |....#.......z...| 0x02b0 3009 0000 3707 0000 b50a 0000 b508 0000 |0...7...........| 0x02c0 5709 0000 1408 0000 f804 0000 3201 0000 |W...........2...| 0x02d0 0000 0000 c309 0000 9207 0000 0203 0000 |................| 0x02e0 e503 0000 0000 0000 0000 0000 0000 0000 |................| 0x02f0 1e09 0000 7207 0000 0000 0000 ac00 0000 |....r...........| 0x0300 7300 0000 9201 0000 6305 0000 0000 0000 |s.......c.......| 0x0310 e800 0000 5009 0000 be05 0000 0000 0000 |....P...........| 0x0320 2a02 0000 da04 0000 8e0a 0000 0000 0000 |*...............| 0x0330 0000 0000 bd09 0000 6f0a 0000 dd08 0000 |........o.......| 0x0340 3c02 0000 0000 0000 9b05 0000 d900 0000 |<...............| 0x0350 b90a 0000 7e07 0000 3b0a 0000 4c07 0000 |....~...;...L...| 0x0360 0000 0000 2b06 0000 f908 0000 0000 0000 |....+...........| 0x0370 0000 0000 3a08 0000 8108 0000 5e06 0000 |....:.......^...| 0x0380 f406 0000 9e08 0000 0000 0000 0000 0000 |................| 0x0390 5b08 0000 7a02 0000 0000 0000 d707 0000 |[...z...........| 0x03a0 a203 0000 5d04 0000 9504 0000 e307 0000 |....]...........| 0x03b0 0000 0000 0000 0000 a807 0000 0000 0000 |................| 0x03c0 0000 0000 9003 0000 0000 0000 6705 0000 |............g...| 0x03d0 3105 0000 0000 0000 d307 0000 0000 0000 |1...............| 0x03e0 c005 0000 3900 0000 8105 0000 e007 0000 |....9...........| 0x03f0 8309 0000 8605 0000 9506 0000 0000 0000 |................| 0x0400 c405 0000 0000 0000 0000 0000 9108 0000 |................| 0x0410 a507 0000 d403 0000 0000 0000 0000 0000 |................| 0x0420 4f0a 0000 f706 0000 0000 0000 1f06 0000 |O...............| 0x0430 4c02 0000 0000 0000 0000 0000 0000 0000 |L...............| 0x0440 ff07 0000 4409 0000 0000 0000 4b09 0000 |....D.......K...| 0x0450 9f03 0000 bb06 0000 0000 0000 5e09 0000 |............^...| 0x0460 0000 0000 f306 0000 0000 0000 700a 0000 |............p...| 0x0470 0d09 0000 c109 0000 d607 0000 0000 0000 |................| 0x0480 a006 0000 0000 0000 0000 0000 0000 0000 |................| 0x0490 7203 0000 e704 0000 0000 0000 9b06 0000 |r...............| 0x04a0 ab09 0000 5a06 0000 a700 0000 0000 0000 |....Z...........| 0x04b0 2409 0000 3408 0000 c308 0000 0109 0000 |$...4...........| 0x04c0 4900 0000 2a01 0000 7c03 0000 0000 0000 |I...*...|.......| 0x04d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04e0 3200 0000 0000 0000 200a 0000 0000 0000 |2....... .......| 0x04f0 aa0a 0000 0801 0000 3e02 0000 0f04 0000 |........>.......| 0x0500 ac06 0000 0000 0000 0409 0000 0000 0000 |................| 0x0510 8a09 0000 3207 0000 0000 0000 b702 0000 |....2...........| 0x0520 b40a 0000 8003 0000 b804 0000 0000 0000 |................| 0x0530 be04 0000 f103 0000 0000 0000 9405 0000 |................| 0x0540 7109 0000 7d07 0000 f108 0000 0000 0000 |q...}...........| 0x0550 0000 0000 6a09 0000 7b04 0000 a207 0000 |....j...{.......| 0x0560 0000 0000 0000 0000 8000 0000 0000 0000 |................| 0x0570 ef07 0000 4400 0000 ac07 0000 0000 0000 |....D...........| 0x0580 0000 0000 8c05 0000 9f08 0000 7008 0000 |............p...| 0x0590 0000 0000 6b0a 0000 4103 0000 c205 0000 |....k...A.......| 0x05a0 2d05 0000 420a 0000 e106 0000 a509 0000 |-...B...........| 0x05b0 0000 0000 0000 0000 2c09 0000 0000 0000 |........,.......| 0x05c0 6804 0000 7209 0000 4102 0000 b304 0000 |h...r...A.......| 0x05d0 c103 0000 0000 0000 a308 0000 0000 0000 |................| 0x05e0 0000 0000 c700 0000 7607 0000 1f0a 0000 |........v.......| 0x05f0 4e00 0000 7806 0000 0000 0000 0000 0000 |N...x...........| 0x0600 5c09 0000 0000 0000 5c08 0000 ab08 0000 |\.......\.......| 0x0610 0509 0000 a506 0000 e008 0000 0000 0000 |................| 0x0620 0000 0000 4500 0000 4a0a 0000 9804 0000 |....E...J.......| 0x0630 d004 0000 cc05 0000 0000 0000 0000 0000 |................| 0x0640 0000 0000 5c03 0000 2708 0000 5a0a 0000 |....\...'...Z...| 0x0650 0000 0000 5f06 0000 0000 0000 0000 0000 |...._...........| 0x0660 fb09 0000 ed07 0000 0000 0000 6d00 0000 |............m...| 0x0670 0000 0000 0000 0000 b505 0000 7809 0000 |............x...| 0x0680 b109 0000 9305 0000 0c03 0000 0000 0000 |................| 0x0690 0000 0000 4708 0000 b706 0000 6803 0000 |....G.......h...| 0x06a0 b104 0000 570a 0000 0000 0000 840a 0000 |....W...........| 0x06b0 ab06 0000 6209 0000 cf06 0000 8a03 0000 |....b...........| 0x06c0 7d0a 0000 6004 0000 5b01 0000 0000 0000 |}...`...[.......| 0x06d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x06e0 4b01 0000 0000 0000 d205 0000 3800 0000 |K...........8...| 0x06f0 fe00 0000 4f09 0000 ac02 0000 0907 0000 |....O...........| 0x0700 0000 0000 0000 0000 4802 0000 ee08 0000 |........H.......| 0x0710 c601 0000 0000 0000 8709 0000 0609 0000 |................| 0x0720 5f0a 0000 e507 0000 0000 0000 2f02 0000 |_.........../...| 0x0730 0000 0000 6906 0000 dc04 0000 c403 0000 |....i...........| 0x0740 3c09 0000 e402 0000 8907 0000 0000 0000 |<...............| 0x0750 3f0a 0000 1d0a 0000 5100 0000 6206 0000 |?.......Q...b...| 0x0760 3c0a 0000 1304 0000 7608 0000 0000 0000 |<.......v.......| 0x0770 c106 0000 0000 0000 0000 0000 8203 0000 |................| 0x0780 2207 0000 430a 0000 3304 0000 0000 0000 |"...C...3.......| 0x0790 7704 0000 0000 0000 d007 0000 0000 0000 |w...............| 0x07a0 0905 0000 2007 0000 c000 0000 6201 0000 |.... .......b...| 0x07b0 e703 0000 b009 0000 b605 0000 b309 0000 |................| 0x07c0 590a 0000 0000 0000 ae0a 0000 0000 0000 |Y...............| 0x07d0 9d01 0000 0000 0000 0000 0000 2c06 0000 |............,...| 0x07e0 6a02 0000 6408 0000 e908 0000 0301 0000 |j...d...........| 0x07f0 7c08 0000 6608 0000 fd02 0000 0000 0000 ||...f...........| 0x0800 0000 0000 cb06 0000 0000 0000 440a 0000 |............D...| 0x0810 f203 0000 ff01 0000 6e07 0000 0000 0000 |........n.......| 0x0820 6d09 0000 c206 0000 e309 0000 0000 0000 |m...............| 0x0830 2209 0000 7e0a 0000 4d07 0000 bf06 0000 |"...~...M.......| 0x0840 9b08 0000 9c03 0000 e809 0000 fb02 0000 |................| 0x0850 3f09 0000 e906 0000 f003 0000 520a 0000 |?...........R...| 0x0860 0000 0000 7a03 0000 4b0a 0000 d209 0000 |....z...K.......| 0x0870 4506 0000 0000 0000 8604 0000 710a 0000 |E...........q...| 0x0880 f105 0000 0000 0000 1d04 0000 a70a 0000 |................| 0x0890 2408 0000 0000 0000 c208 0000 e308 0000 |$...............| 0x08a0 9d0a 0000 b606 0000 aa07 0000 8005 0000 |................| 0x08b0 5804 0000 0000 0000 0000 0000 4309 0000 |X...........C...| 0x08c0 ed09 0000 0c05 0000 8a02 0000 0000 0000 |................| 0x08d0 ea08 0000 0000 0000 8b06 0000 0000 0000 |................| 0x08e0 0000 0000 8a07 0000 6a00 0000 0000 0000 |........j.......| 0x08f0 6207 0000 0c06 0000 0000 0000 aa09 0000 |b...............| 0x0900 c908 0000 4108 0000 3e01 0000 020a 0000 |....A...>.......| 0x0910 0000 0000 7d04 0000 f503 0000 8502 0000 |....}...........| 0x0920 d001 0000 e109 0000 8204 0000 6002 0000 |............`...| 0x0930 3508 0000 770a 0000 660a 0000 ee00 0000 |5...w...f.......| 0x0940 2b02 0000 8c09 0000 1d01 0000 c609 0000 |+...............| 0x0950 8104 0000 0000 0000 5f01 0000 0105 0000 |........_.......| 0x0960 0000 0000 610a 0000 f604 0000 a804 0000 |....a...........| 0x0970 d806 0000 8f08 0000 d308 0000 0000 0000 |................| 0x0980 6905 0000 b701 0000 4909 0000 0000 0000 |i.......I.......| 0x0990 0000 0000 a208 0000 3d0a 0000 6208 0000 |........=...b...| 0x09a0 3c00 0000 0000 0000 d10a 0000 4109 0000 |<...........A...| 0x09b0 4107 0000 cf03 0000 0000 0000 a80a 0000 |A...............| 0x09c0 1307 0000 5e01 0000 0708 0000 e209 0000 |....^...........| 0x09d0 e500 0000 ba08 0000 5304 0000 4d05 0000 |........S...M...| 0x09e0 e708 0000 2100 0000 0403 0000 e901 0000 |....!...........| 0x09f0 6406 0000 ab00 0000 dc03 0000 0000 0000 |d...............| 0x0a00 0000 0000 730a 0000 9c05 0000 810a 0000 |....s...........| 0x0a10 0000 0000 7c01 0000 0000 0000 ef03 0000 |....|...........| 0x0a20 da03 0000 0000 0000 b801 0000 0000 0000 |................| 0x0a30 6700 0000 7909 0000 5301 0000 7d05 0000 |g...y...S...}...| 0x0a40 bf0a 0000 0c0a 0000 0000 0000 0000 0000 |................| 0x0a50 4807 0000 db00 0000 ca03 0000 3f07 0000 |H...........?...| 0x0a60 900a 0000 790a 0000 6000 0000 b608 0000 |....y...`.......| 0x0a70 1c09 0000 640a 0000 ee07 0000 0b06 0000 |....d...........| 0x0a80 7709 0000 0000 0000 bf00 0000 0703 0000 |w...............| 0x0a90 f008 0000 b205 0000 0000 0000 a009 0000 |................| 0x0aa0 dc09 0000 0000 0000 b504 0000 7f09 0000 |................| 0x0ab0 0000 0000 0000 0000 e400 0000 9109 0000 |................| 0x0ac0 3d09 0000 ce06 0000 a00a 0000 0000 0000 |=...............| 0x0ad0 1901 0000 0000 0000 1308 0000 b907 0000 |................| 0x0ae0 bb05 0000 5504 0000 0000 0000 0000 0000 |....U...........| 0x0af0 6a06 0000 0000 0000 6106 0000 c307 0000 |j.......a.......| 0x0b00 0000 0000 d904 0000 8806 0000 e509 0000 |................| 0x0b10 0000 0000 0000 0000 0000 0000 760a 0000 |............v...| 0x0b20 ed06 0000 a302 0000 9f01 0000 0000 0000 |................| 0x0b30 0b0a 0000 ad0a 0000 0000 0000 4405 0000 |............D...| 0x0b40 6d06 0000 0000 0000 bb0a 0000 1909 0000 |m...............| 0x0b50 7700 0000 ed08 0000 0000 0000 7a0a 0000 |w...........z...| 0x0b60 0404 0000 4f04 0000 2202 0000 f601 0000 |....O...".......| 0x0b70 d504 0000 b107 0000 8807 0000 320a 0000 |............2...| 0x0b80 0000 0000 5508 0000 d402 0000 0000 0000 |....U...........| 0x0b90 1009 0000 1907 0000 0e0a 0000 a103 0000 |................| 0x0ba0 eb07 0000 0000 0000 c102 0000 4f00 0000 |............O...| 0x0bb0 010a 0000 eb04 0000 4c09 0000 3609 0000 |........L...6...| 0x0bc0 0000 0000 0000 0000 0000 0000 a405 0000 |................| 0x0bd0 f408 0000 1d06 0000 0000 0000 0000 0000 |................| 0x0be0 fd07 0000 0000 0000 c209 0000 1c05 0000 |................| 0x0bf0 0000 0000 e407 0000 3509 0000 0000 0000 |........5.......| 0x0c00 e905 0000 2707 0000 9907 0000 0000 0000 |....'...........| 0x0c10 7304 0000 8d01 0000 f504 0000 0000 0000 |s...............| 0x0c20 d501 0000 0000 0000 0208 0000 0000 0000 |................| 0x0c30 3407 0000 0000 0000 0f05 0000 b708 0000 |4...............| 0x0c40 d708 0000 0000 0000 9e0a 0000 c708 0000 |................| 0x0c50 8b01 0000 0000 0000 0000 0000 150a 0000 |................| 0x0c60 8e09 0000 6e08 0000 a206 0000 ee01 0000 |....n...........| 0x0c70 1004 0000 b808 0000 a902 0000 4403 0000 |............D...| 0x0c80 180a 0000 0d04 0000 9e07 0000 db09 0000 |................| 0x0c90 0000 0000 7d00 0000 2c03 0000 6c0a 0000 |....}...,...l...| 0x0ca0 ae09 0000 230a 0000 d107 0000 0000 0000 |....#...........| 0x0cb0 240a 0000 0000 0000 e606 0000 9507 0000 |$...............| 0x0cc0 0000 0000 4c08 0000 c607 0000 8e02 0000 |....L...........| 0x0cd0 0000 0000 0000 0000 0000 0000 fb08 0000 |................| 0x0ce0 2101 0000 7c09 0000 0000 0000 fa07 0000 |!...|...........| 0x0cf0 5a00 0000 0000 0000 a707 0000 4606 0000 |Z...........F...| 0x0d00 8508 0000 9909 0000 a605 0000 0000 0000 |................| 0x0d10 4001 0000 e100 0000 ea03 0000 0000 0000 |@...............| 0x0d20 0000 0000 4c05 0000 0000 0000 a409 0000 |....L...........| 0x0d30 8c07 0000 a008 0000 0a06 0000 5801 0000 |............X...| 0x0d40 8409 0000 5905 0000 6b09 0000 0000 0000 |....Y...k.......| 0x0d50 3409 0000 0000 0000 b502 0000 9a06 0000 |4...............| 0x0d60 0000 0000 3807 0000 7b09 0000 c009 0000 |....8...{.......| 0x0d70 d401 0000 6809 0000 d00a 0000 1a0a 0000 |....h...........| 0x0d80 0000 0000 cb08 0000 d602 0000 0000 0000 |................| 0x0d90 3b07 0000 ba07 0000 c60a 0000 0000 0000 |;...............| 0x0da0 3204 0000 9709 0000 4104 0000 4d0a 0000 |2.......A...M...| 0x0db0 1f01 0000 9a04 0000 7004 0000 5f07 0000 |........p..._...| 0x0dc0 6f02 0000 8a0a 0000 e601 0000 9a07 0000 |o...............| 0x0dd0 6f06 0000 b509 0000 ad09 0000 dc06 0000 |o...............| 0x0de0 b301 0000 1e05 0000 0000 0000 0000 0000 |................| 0x0df0 5b07 0000 0000 0000 c301 0000 b900 0000 |[...............| 0x0e00 be07 0000 2500 0000 5500 0000 5808 0000 |....%...U...X...| 0x0e10 e501 0000 8707 0000 fe08 0000 8507 0000 |................| 0x0e20 4f07 0000 2e04 0000 4508 0000 b609 0000 |O.......E.......| 0x0e30 f409 0000 2907 0000 4f05 0000 880a 0000 |....)...O.......| 0x0e40 0000 0000 f909 0000 0906 0000 a608 0000 |................| 0x0e50 d30a 0000 0000 0000 1208 0000 0000 0000 |................| 0x0e60 db01 0000 0000 0000 0000 0000 2103 0000 |............!...| 0x0e70 0000 0000 fe06 0000 7100 0000 9d09 0000 |........q.......| 0x0e80 1d08 0000 dd05 0000 a909 0000 0000 0000 |................| 0x0e90 0000 0000 0000 0000 c207 0000 3809 0000 |............8...| 0x0ea0 4603 0000 0000 0000 f403 0000 0000 0000 |F...............| 0x0eb0 9706 0000 0000 0000 a209 0000 af06 0000 |................| 0x0ec0 0000 0000 bb08 0000 490a 0000 1209 0000 |........I.......| 0x0ed0 0000 0000 d405 0000 f307 0000 0000 0000 |................| 0x0ee0 0000 0000 0000 0000 f703 0000 8d05 0000 |................| 0x0ef0 1709 0000 f204 0000 f209 0000 cb07 0000 |................| 0x0f00 9f0a 0000 c608 0000 7108 0000 1006 0000 |........q.......| 0x0f10 960a 0000 0000 0000 2508 0000 2205 0000 |........%..."...| 0x0f20 0000 0000 7a07 0000 ee02 0000 0000 0000 |....z...........| 0x0f30 6c07 0000 330a 0000 0000 0000 0000 0000 |l...3...........| 0x0f40 7903 0000 0000 0000 1203 0000 2a0a 0000 |y...........*...| 0x0f50 7402 0000 4c0a 0000 1b04 0000 e203 0000 |t...L...........| 0x0f60 0000 0000 ab07 0000 1f08 0000 4b05 0000 |............K...| 0x0f70 0000 0000 d507 0000 9f06 0000 3a09 0000 |............:...| 0x0f80 6009 0000 c904 0000 0000 0000 2a08 0000 |`...........*...| 0x0f90 da08 0000 0000 0000 8002 0000 8e07 0000 |................| 0x0fa0 9609 0000 0000 0000 0000 0000 ed03 0000 |................| 0x0fb0 dc08 0000 0000 0000 0000 0000 9908 0000 |................| 0x0fc0 0000 0000 0000 0000 4008 0000 d404 0000 |........@.......| 0x0fd0 0e04 0000 8b0a 0000 0000 0000 3e08 0000 |............>...| 0x0fe0 0000 0000 630a 0000 6904 0000 0000 0000 |....c...i.......| 0x0ff0 e208 0000 0000 0000 0000 0000 7403 0000 |............t...| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0xd7000,0x5,0x20002,0x3,0,0,0) 21495 perl5.8.8 RET mmap 672980992/0x281ce000 21495 perl5.8.8 CALL mprotect(0x2828c000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x2828c000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x2828d000,0x5000,0x3,0x12,0x3,0,0xbf000,0) 21495 perl5.8.8 RET mmap 673763328/0x2828d000 21495 perl5.8.8 CALL mmap(0x28292000,0x13000,0x3,0x1012,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673783808/0x28292000 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL sysarch(0xa,0xbfbfe960) 21495 perl5.8.8 RET sysarch 0 21495 perl5.8.8 CALL mmap(0,0x4010,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL munmap(0x282a5000,0x4010) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL mmap(0,0x740,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL munmap(0x282a5000,0x740) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL mmap(0,0x258,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL munmap(0x282a5000,0x258) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL mmap(0,0x720,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL munmap(0x282a5000,0x720) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL mprotect(0x281ce000,0xbf000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0,0x56a0,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL munmap(0x282a5000,0x56a0) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL mprotect(0x281ce000,0xbf000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfe930) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL sigprocmask(0x3,0x28187830,0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL readlink(0x282866a3,0xbfbfea60,0x3f) 21495 perl5.8.8 NAMI "/etc/malloc.conf" 21495 perl5.8.8 RET readlink -1 errno 2 No such file or directory 21495 perl5.8.8 CALL issetugid 21495 perl5.8.8 RET issetugid 0 21495 perl5.8.8 CALL mmap(0,0x1000,0x3,0x1002,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673861632/0x282a5000 21495 perl5.8.8 CALL break(0x8175000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8176000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8177000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8178000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8179000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x817f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8181000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8182000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8183000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL getuid 21495 perl5.8.8 RET getuid 1004/0x3ec 21495 perl5.8.8 CALL geteuid 21495 perl5.8.8 RET geteuid 1004/0x3ec 21495 perl5.8.8 CALL getgid 21495 perl5.8.8 RET getgid 1004/0x3ec 21495 perl5.8.8 CALL getegid 21495 perl5.8.8 RET getegid 1004/0x3ec 21495 perl5.8.8 CALL break(0x8184000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL open(0x8153870,0,0x28273975) 21495 perl5.8.8 NAMI "/dev/urandom" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL read(0x3,0xbfbfe9b0,0x4) 21495 perl5.8.8 GIO fd 3 read 4 bytes 0x0000 2922 91f0 |)"..| 21495 perl5.8.8 RET read 4 21495 perl5.8.8 CALL close(0x3) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL break(0x8185000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL gettimeofday(0xbfbfe9f8,0) 21495 perl5.8.8 RET gettimeofday 0 21495 perl5.8.8 CALL break(0x8186000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8187000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8188000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL readlink(0x8154868,0xbfbfe580,0x3ff) 21495 perl5.8.8 NAMI "/proc/curproc/file" 21495 perl5.8.8 RET readlink 52/0x34 21495 perl5.8.8 CALL open(0x8175400,0,0x1b6) 21495 perl5.8.8 NAMI "t/03inject.t" 21495 perl5.8.8 RET open 3 21495 perl5.8.8 CALL fcntl(0x3,0x2,0x1) 21495 perl5.8.8 RET fcntl 0 21495 perl5.8.8 CALL sigaction(0x14,0,0xbfbfe970) 21495 perl5.8.8 RET sigaction 0 21495 perl5.8.8 CALL break(0x8189000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x818a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x818b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x818c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL getpid 21495 perl5.8.8 RET getpid 21495/0x53f7 21495 perl5.8.8 CALL break(0x818d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x818e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x8179600,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/blib.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179580,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/blib.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179600,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/blib.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179580,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/blib.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x818a400,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/blib.pm" 21495 perl5.8.8 RET open 4 21495 perl5.8.8 CALL break(0x818f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x4,0xbfbfb8c0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8190000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x818f000,0x1000) 21495 perl5.8.8 GIO fd 4 read 2106 bytes "package blib; =head1 NAME blib - Use MakeMaker's uninstalled version of a package =head1 SYNOPSIS perl -Mblib script [args...] perl -Mblib=dir script [args...] =head1 DESCRIPTION Looks for MakeMaker-like I<'blib'> directory structure starting in I (or current directory) and working back up to five levels of '.\ .'. Intended for use on command line with B<-M> option as a way of testing arbitrary scripts against an uninstalled version of a package. However it is possible to : use blib; or use blib '..'; etc. if you really must. =head1 BUGS Pollutes global name space for development only task. =head1 AUTHOR Nick Ing-Simmons nik@tiuk.ti.com =cut use Cwd; use File::Spec; use vars qw($VERSION $Verbose); $VERSION = '1.04'; $Verbose = 0; sub import { my $package = shift; my $dir; if ($^O eq "MSWin32" && -f "Win32.xs") { # We don't use getcwd() on Windows because it will internally # call Win32::GetCwd(), which will get the Win32 module loaded. # That means that it would not be possible to run `make test` # for the Win32 module because blib.pm would always load the # installed version before @INC gets updated with the blib path. chomp($dir = `cd`); } else { $dir = getcwd; } if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/\\z--\ ; } if (@_) { $dir = shift; $dir =~ s/blib\\z//; $dir =~ s,/+\\z,,; $dir = File::Spec->curdir unless ($dir); die "$dir is not a directory\\n" unless (-d $dir); } my $i = 5; my($blib, $blib_lib, $blib_arch); while ($i--) { $blib = File::Spec->catdir($dir, "blib"); $blib_lib = File::Spec->catdir($blib, "lib"); if ($^O eq 'MacOS') { $blib_arch = File::Spec->catdir($blib_lib, $MacPerl::Architecture\ ); } else { $blib_arch = File::Spec->catdir($blib, "arch"); } if (-d $blib && -d $blib_arch && -d $blib_lib) { unshift(@INC,$blib_arch,$blib_lib); warn "Using $blib\\n" if $Verbose; return; } $dir = File::Spec->catdir($dir, File::Spec->updir); } die "Cannot find blib even in $dir\\n"; } 1; " 21495 perl5.8.8 RET read 2106/0x83a 21495 perl5.8.8 CALL break(0x8191000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8192000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x4,0,0,0,0x1) 21495 perl5.8.8 RET lseek 2106/0x83a 21495 perl5.8.8 CALL stat(0x8179780,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Cwd.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179700,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Cwd.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8179800,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Cwd.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL break(0x8194000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x5,0xbfbfb2e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8195000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8194000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package Cwd; =head1 NAME Cwd - get pathname of current working directory =head1 SYNOPSIS use Cwd; my $dir = getcwd; use Cwd 'abs_path'; my $abs_path = abs_path($file); =head1 DESCRIPTION This module provides functions for determining the pathname of the current working directory. It is recommended that getcwd (or another *cwd() function) be used in I code to ensure portability. By default, it exports the functions cwd(), getcwd(), fastcwd(), and fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace. =head2 getcwd and friends Each of these functions are called without arguments and return the absolute path of the current working directory. =over 4 =item getcwd my $cwd = getcwd(); Returns the current working directory. Exposes the POSIX function getcwd(3) or re-implements it if it's not available. =item cwd my $cwd = cwd(); The cwd() is the most natural form for the current architecture. For most systems it is identical to `pwd` (but without the trailing line terminator). =item fastcwd my $cwd = fastcwd(); A more dangerous version of getcwd(), but potentially faster. It might conceivably chdir() you out of a directory that it can't chdir() you back into. If fastcwd encounters a problem it will return undef but will probably leave you in a different directory. For a measure of extra security, if everything appears to have worked, the fastcwd() function will check that it leaves you in the same directory that it started in. If it has changed it will C with the message "Unstable directory path, current directory changed unexpectedly". That should never happen. =item fastgetcwd my $cwd = fastgetcwd(); The fastgetcwd() function is provided as a synonym for cwd(). =item getdcwd my $cwd = getdcwd(); my $cwd = getdcwd('C:'); The getdcwd() function is also provided on Win32 to get the current wo\ rking directory on the specified drive, since Windows maintains a separate c\ urrent working directory for each drive. If no drive is specified then the c\ urrent drive is assumed. This function simply calls the Microsoft C library _getdcwd() function\ . =back =head2 abs_path and friends These functions are exported only on request. They each take a single argument and return the absolute pathname for it. If no argument is given they'll use the current working directory. =over 4 =item abs_path my $abs_path = abs_path($file); Uses the same algorithm as getcwd(). Symbolic links and relative-path components ("." and "..") are resolved to return the canonical pathname, just like realpath(3). =item realpath my $abs_path = realpath($file); A synonym for abs_path(). =item fast_abs_path my $abs_path = fast_abs_path($file); A more dangerous, but potentially faster version of abs_path. =back =head2 $ENV{PWD} If you ask to override your chdir() built-in function, use Cwd qw(chdir); then your PWD environment variable will be kept up to date. Note that it will only be kept up to date if all packages which use chdir import it from Cwd. =head1 NOTES =over 4 =item * Since the path seperators are different on some operating systems ('/' on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec modules wherever portability is a concern. =item * Actually, on Mac OS, the C, C and C functions are all aliases for the C function, which, on Mac OS\ , calls `pwd`. Likewise, the C function is an alias for C. =back =head1 AUTHOR Originally by the perl5-porters. Maintained by Ken Williams =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Portions of the C code in this library are copyright (c) 1994 by the Regents of the University of California. All rights reserved. The license on this code is compatible with the licensing of the rest of the distribution - please see the source code in F for the details. =head1 SEE ALSO L =cut use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); $VERSION = '3.2701'; @ISA = qw/ Exporter /; @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32'; @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # sys_cwd may keep the builtin command # All the functionality of this module may provided by builtins, # there is no sense to process the rest of the file. # The best choice may be to have this in BEGIN, but how to return from\ BEGIN? if ($^O eq 'os2') { local $^W = 0; *cwd = defined &sys_cwd ? \\&sys_cwd : \\&_os2_cwd; *getcwd = \\&cwd; *fastgetcwd = \\&cwd; *fastcwd = \\&cwd; *fast_abs_path = \\&sys_abspath if defined &sys_abspath; *abs_path = \\&fast_abs_path; *realpath = \\&fast_abs_path; *fast_realpath = \\&fast_abs_path; return 1; } # If loading the XS stuff doesn't work, we can fall back to pure perl eval { if ( $] >= 5.006 ) { require XSLoader; XSLoader::load( __PACKAGE__, $VERSION ); } else { require DynaLoader; push @ISA, 'DynaLoader'; __PACKAGE__->bootstrap( $VERSION ); } }; # Must be after the DynaLoader stuff: $VERSION = eval $VERSION; # Big nasty table of function aliases my %METHOD_MAP = ( VMS => { cwd => '_vms_cwd', getcwd => '_vms_cwd', fastcwd => '_vms_cwd', fastgetcwd => '_vms_cwd', abs_path => '_vms_abs_path', fast_abs_path => '_vms_abs_path', }, MSWin32 => { # We assume that &_NT_cwd is defined as an XSUB or in the core. cwd => '_NT_cwd', getcwd => '_NT_cwd', fastcwd => '_NT_cwd', fastgetcwd => '_NT_cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, dos => { cwd => '_dos_cwd', getcwd => '_dos_cwd', fastgetcwd => '_dos_cwd', fastcwd => '_dos_cwd', abs_path => 'fast_abs_path', }, qnx => { cwd => '_qnx_cwd', getcwd => '_qnx_cwd', fastgetcwd => '_qnx_cwd', fastcwd => '_qnx_cwd', abs_path => '_qnx_abs_path', fast_abs_path => '_qnx_abs_path', }, cygwin => { getcwd => 'cwd', fastgetcwd => 'cwd', fastcwd => 'cwd', abs_path => 'fast_abs_path', realpath => 'fast_abs_path', }, epoc => { cwd => '_epoc_cwd', getcwd => '_epoc_cwd', fastgetcwd => '_epoc_cwd', fastcwd => '_epoc_cwd', abs_path => 'fast_abs_path', }, MacOS => { getcwd => 'cwd', fastgetcwd => 'cwd', fastcwd => 'cwd', abs_path => 'fast_abs_path', }, ); $METHOD_MAP{NT} = $METHOD_MAP{MSWin32}; $METHOD_MAP{nto} = $METHOD_MAP{qnx}; # Find the pwd command in the expected locations. We assume these # are safe. This prevents _backtick_pwd() consulting $ENV{PATH} # so everything works under taint mode. my $pwd_cmd; foreach my $try ('/bin/pwd', '/usr/bin/pwd', '/QOpenSys/bin/pwd', # OS/400 PASE. ) { if( -x $try ) { $pwd_cmd = $try; last; } } my $found_pwd_cmd = defined($pwd_cmd); unless ($pwd_cmd) { # Isn't this wrong? _backtick_pwd() will fail if somenone has # pwd in their path but it is not /bin/pwd or /usr/bin/pwd? # See [perl #16774]. --jhi $pwd_cmd = 'pwd'; } # Lazy-load Carp sub _carp { require Carp; Carp::carp(@_) } sub _croak { require Carp; Carp::croak(@_) } # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { # Localize %ENV entries in a way that won't create new hash keys my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_E\ NV); local @ENV{@localize}; my $cwd = `$pwd_cmd`; # Belt-and-suspenders in case someone said "undef $/". local $/ = "\\n"; # `pwd` may fail e.g. if the disk is full chomp($cwd) if defined $cwd; $cwd; } # Since some ports may predefine cwd internally (e.g., NT) # we take care not to override an existing definition for cwd(). unless " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL stat(0x8179a80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/strict.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179a00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/strict.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179a80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/strict.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179a00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/strict.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8179b00,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/strict.pm" 21495 perl5.8.8 RET open 6 21495 perl5.8.8 CALL fstat(0x6,0xbfbfad00) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8198000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8197000,0x1000) 21495 perl5.8.8 GIO fd 6 read 3292 bytes "package strict; $strict::VERSION = "1.03"; my %bitmask = ( refs => 0x00000002, subs => 0x00000200, vars => 0x00000400 ); sub bits { my $bits = 0; my @wrong; foreach my $s (@_) { push @wrong, $s unless exists $bitmask{$s}; $bits |= $bitmask{$s} || 0; } if (@wrong) { require Carp; Carp::croak("Unknown 'strict' tag(s) '@wrong'"); } $bits; } my $default_bits = bits(qw(refs subs vars)); sub import { shift; $^H |= @_ ? bits(@_) : $default_bits; } sub unimport { shift; $^H &= ~ (@_ ? bits(@_) : $default_bits); } 1; __END__ =head1 NAME strict - Perl pragma to restrict unsafe constructs =head1 SYNOPSIS use strict; use strict "vars"; use strict "refs"; use strict "subs"; use strict; no strict "vars"; =head1 DESCRIPTION If no import list is supplied, all possible restrictions are assumed. (This is the safest mode to operate in, but is sometimes too strict fo\ r casual programming.) Currently, there are three possible things to be strict about: "subs", "vars", and "refs". =over 6 =item C This generates a runtime error if you use symbolic references (see L). use strict 'refs'; $ref = \\$foo; print $$ref; # ok $ref = "foo"; print $$ref; # runtime error; normally ok $file = "STDOUT"; print $file "Hi!"; # error; note: no comma after $file There is one exception to this rule: $bar = \\&{'foo'}; &$bar; is allowed so that C would not break under stricture. =item C This generates a compile-time error if you access a variable that wasn\ 't declared via C or C, localized via C, or wasn't fully qualified. Because this is to \ avoid variable suicide problems and subtle dynamic scoping issues, a merely local() variable isn't good enough. See L and L. use strict 'vars'; $X::foo = 1; # ok, fully qualified my $foo = 10; # ok, my() var local $foo = 9; # blows up package Cinna; our $bar; # Declares $bar in current package $bar = 'HgS'; # ok, global declared via pragma The local() generated a compile-time error because you just touched a \ global name without fully qualifying it. Because of their special use by sort(), the variables $a and $b are exempted from this check. =item C This disables the poetry optimization, generating a compile-time error\ if you try to use a bareword identifier that's not a subroutine, unless i\ t is a simple identifier (no colons) and that it appears in curly braces\ or on the left hand side of the C<< => >> symbol. use strict 'subs'; $SIG{PIPE} = Plumber; # blows up $SIG{PIPE} = "Plumber"; # just fine: quoted string is always o\ k $SIG{PIPE} = \\&Plumber; # preferred form =back See L. =head1 HISTORY C, with Perl 5.6.1, erroneously permitted to use an unq\ uoted compound identifier (e.g. C) as a hash key (before C<< => >>\ or inside curlies), but without forcing it always to a literal string. Starting with Perl 5.8.1 strict is strict about its restrictions: if unknown restrictions are used, the strict pragma will abort with Unknown 'strict' tag(s) '...' =cut " 21495 perl5.8.8 RET read 3292/0xcdc 21495 perl5.8.8 CALL break(0x8199000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x6,0,0,0,0x1) 21495 perl5.8.8 RET lseek 3292/0xcdc 21495 perl5.8.8 CALL break(0x819a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x819b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x819c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x6) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x8179c80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Exporter.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179b00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Exporter.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179c80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179b00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8179e00,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter.pm" 21495 perl5.8.8 RET open 6 21495 perl5.8.8 CALL fstat(0x6,0xbfbfad00) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x6,0x8197000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes "package Exporter; require 5.006; # Be lean. #use strict; #no strict 'refs'; our $Debug = 0; our $ExportLevel = 0; our $Verbose ||= 0; our $VERSION = '5.63'; our (%Cache); # Carp 1.05+ does this now for us, but we may be running with an old C\ arp $Carp::Internal{Exporter}++; sub as_heavy { require Exporter::Heavy; # Unfortunately, this does not work if the caller is aliased as *nam\ e = \\&foo # Thus the need to create a lot of identical subroutines my $c = (caller(1))[3]; $c =~ s/.*:://; \\&{"Exporter::Heavy::heavy_$c"}; } sub export { goto &{as_heavy()}; } sub import { my $pkg = shift; my $callpkg = caller($ExportLevel); if ($pkg eq "Exporter" and @_ and $_[0] eq "import") { *{$callpkg."::import"} = \\&import; return; } # We *need* to treat @{"$pkg\\::EXPORT_FAIL"} since Carp uses it :-( my($exports, $fail) = (\\@{"$pkg\\::EXPORT"}, \\@{"$pkg\\::EXPORT_FA\ IL"}); return export $pkg, $callpkg, @_ if $Verbose or $Debug or @$fail > 1; my $export_cache = ($Cache{$pkg} ||= {}); my $args = @_ or @_ = @$exports; local $_; if ($args and not %$export_cache) { s/^&//, $export_cache->{$_} = 1 foreach (@$exports, @{"$pkg\\::EXPORT_OK"}); } my $heavy; # Try very hard not to use {} and hence have to enter scope on the \ foreach # We bomb out of the loop with last as soon as heavy is set. if ($args or $fail) { ($heavy = (/\\W/ or $args and not exists $export_cache->{$_} or @$fail and $_ eq $fail->[0])) and last foreach (@_); } else { ($heavy = /\\W/) and last foreach (@_); } return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy; local $SIG{__WARN__} = sub {require Carp; &Carp::carp}; # shortcut for the common case of no type character *{"$callpkg\\::$_"} = \\&{"$pkg\\::$_"} foreach @_; } # Default methods sub export_fail { my $self = shift; @_; } # Unfortunately, caller(1)[3] "does not work" if the caller is aliased\ as # *name = \\&foo. Thus the need to create a lot of identical subrouti\ nes # Otherwise we could have aliased them to export(). sub export_to_level { goto &{as_heavy()}; } sub export_tags { goto &{as_heavy()}; } sub export_ok_tags { goto &{as_heavy()}; } sub require_version { goto &{as_heavy()}; } 1; __END__ =head1 NAME Exporter - Implements default import method for modules =head1 SYNOPSIS In module F: package YourModule; require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(munge frobnicate); # symbols to export on request or package YourModule; use Exporter 'import'; # gives you Exporter's import() method direct\ ly @EXPORT_OK = qw(munge frobnicate); # symbols to export on request In other files which wish to use C: use YourModule qw(frobnicate); # import listed symbols frobnicate ($left, $right) # calls YourModule::frobnicate Take a look at L for some variants you will like to use in modern Perl code. =head1 DESCRIPTION The Exporter module implements an C method which allows a modu\ le to export functions and variables to its users' namespaces. Many modul\ es use Exporter rather than implementing their own C method becau\ se Exporter provides a highly flexible interface, with an implementation \ optimised for the common case. Perl automatically calls the C method when processing a C statement for a module. Modules and C are documented in L and L. Understanding the concept of modules and how the C statement operates is important to understanding the Exporter. =head2 How to Export The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of symbols that are going to be exported into the users name space by default, or which they can request to be exported, respectively. The symbols can represent functions, scalars, arrays, hashes, or typeglobs\ . The symbols must be given by full name with the exception that the ampersand in front of a function is optional, e.g. @EXPORT = qw(afunc $scalar @array); # afunc is a function @" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x819e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x6,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x819f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81a7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x6) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x8179f80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/vars.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179e00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/vars.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179f80,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/vars.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179e00,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/vars.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x819e640,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/vars.pm" 21495 perl5.8.8 RET open 6 21495 perl5.8.8 CALL fstat(0x6,0xbfbfad00) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x81a8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x81a7000,0x1000) 21495 perl5.8.8 GIO fd 6 read 2358 bytes "package vars; use 5.006; our $VERSION = '1.01'; use warnings::register; use strict qw(vars subs); sub import { my $callpack = caller; my ($pack, @imports) = @_; my ($sym, $ch); foreach (@imports) { if (($ch, $sym) = /^([\\$\\@\\%\\*\\&])(.+)/) { if ($sym =~ /\\W/) { # time for a more-detailed check-up if ($sym =~ /^\\w+[[{].*[]}]$/) { require Carp; Carp::croak("Can't declare individual elements of \ hash or array"); } elsif (warnings::enabled() and length($sym) == 1 and\ $sym !~ tr/a-zA-Z//) { warnings::warn("No need to declare built-in vars")\ ; } elsif (($^H &= strict::bits('vars'))) { require Carp; Carp::croak("'$_' is not a valid variable name und\ er strict vars"); } } $sym = "${callpack}::$sym" unless $sym =~ /::/; *$sym = ( $ch eq "\\$" ? \\$$sym : $ch eq "\\@" ? \\@$sym : $ch eq "\\%" ? \\%$sym : $ch eq "\\*" ? \\*$sym : $ch eq "\\&" ? \\&$sym : do { require Carp; Carp::croak("'$_' is not a valid variable name"); }); } else { require Carp; Carp::croak("'$_' is not a valid variable name"); } } }; 1; __END__ =head1 NAME vars - Perl pragma to predeclare global variable names (obsolete) =head1 SYNOPSIS use vars qw($frob @mung %seen); =head1 DESCRIPTION NOTE: For variables in the current package, the functionality provided by this pragma has been superseded by C declarations, available in Perl v5.6.0 or later. See L. This will predeclare all the variables whose names are in the list, allowing you to use them under "use strict", and disabling any typo warnings. Unlike pragmas that affect the C<$^H> hints variable, the C \ and C declarations are not BLOCK-scoped. They are thus effectiv\ e for the entire file in which they appear. You may not rescind such declarations with C or C. Packages such as the B and B that delay loading of subroutines within packages can create problems with package lexicals defined using C. While the B pragma cannot duplicate the effect of package lexicals (total transparency outside of the package), it can act as an acceptable substitute by pre-declaring global symbols, ensuring their availability to the later-loaded routines. See L. =cut " 21495 perl5.8.8 RET read 2358/0x936 21495 perl5.8.8 CALL break(0x81a9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x6,0,0,0,0x1) 21495 perl5.8.8 RET lseek 2358/0x936 21495 perl5.8.8 CALL break(0x81aa000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ab000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x81a0300,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/warnings/register.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0280,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/warnings/register.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0300,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings/register.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0280,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings/register.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81a0380,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings/register.pm" 21495 perl5.8.8 RET open 7 21495 perl5.8.8 CALL break(0x81ac000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ad000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x7,0xbfbfa720) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x81ae000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x81ad000,0x1000) 21495 perl5.8.8 GIO fd 7 read 1023 bytes "package warnings::register; our $VERSION = '1.01'; =pod =head1 NAME warnings::register - warnings import function =head1 SYNOPSIS use warnings::register; =head1 DESCRIPTION Creates a warnings category with the same name as the current package. See L and L for more information on this module\ 's usage. =cut require warnings; sub mkMask { my ($bit) = @_; my $mask = ""; vec($mask, $bit, 1) = 1; return $mask; } sub import { shift; my $package = (caller(0))[0]; if (! defined $warnings::Bits{$package}) { $warnings::Bits{$package} = mkMask($warnings::LAST_BIT); vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1; $warnings::Offsets{$package} = $warnings::LAST_BIT ++; foreach my $k (keys %warnings::Bits) { vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0; } $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT); vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1; } } 1; " 21495 perl5.8.8 RET read 1023/0x3ff 21495 perl5.8.8 CALL lseek(0x7,0,0,0,0x1) 21495 perl5.8.8 RET lseek 1023/0x3ff 21495 perl5.8.8 CALL break(0x81af000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81b3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x81ad000,0x1000) 21495 perl5.8.8 GIO fd 7 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x7) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81a0700,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/warnings.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0680,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/warnings.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0700,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0680,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81a0780,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/warnings.pm" 21495 perl5.8.8 RET open 7 21495 perl5.8.8 CALL fstat(0x7,0xbfbfa720) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x7,0x8193000,0x1000) 21495 perl5.8.8 GIO fd 7 read 4096 bytes "# -*- buffer-read-only: t -*- # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file was created by warnings.pl # Any changes made here will be lost. # package warnings; our $VERSION = '1.05_01'; =head1 NAME warnings - Perl pragma to control optional warnings =head1 SYNOPSIS use warnings; no warnings; use warnings "all"; no warnings "all"; use warnings::register; if (warnings::enabled()) { warnings::warn("some warning"); } if (warnings::enabled("void")) { warnings::warn("void", "some warning"); } if (warnings::enabled($object)) { warnings::warn($object, "some warning"); } warnings::warnif("some warning"); warnings::warnif("void", "some warning"); warnings::warnif($object, "some warning"); =head1 DESCRIPTION The C pragma is a replacement for the command line flag C<-w\ >, but the pragma is limited to the enclosing block, while the flag is gl\ obal. See L for more information. If no import list is supplied, all possible warnings are either enable\ d or disabled. A number of functions are provided to assist module authors. =over 4 =item use warnings::register Creates a new warnings category with the same name as the package wher\ e the call to the pragma is used. =item warnings::enabled() Use the warnings category with the same name as the current package. Return TRUE if that warnings category is enabled in the calling module\ . Otherwise returns FALSE. =item warnings::enabled($category) Return TRUE if the warnings category, C<$category>, is enabled in the calling module. Otherwise returns FALSE. =item warnings::enabled($object) Use the name of the class for the object reference, C<$object>, as the warnings category. Return TRUE if that warnings category is enabled in the first scope where the object is used. Otherwise returns FALSE. =item warnings::warn($message) Print C<$message> to STDERR. Use the warnings category with the same name as the current package. If that warnings category has been set to "FATAL" in the calling modul\ e then die. Otherwise return. =item warnings::warn($category, $message) Print C<$message> to STDERR. If the warnings category, C<$category>, has been set to "FATAL" in the calling module then die. Otherwise return. =item warnings::warn($object, $message) Print C<$message> to STDERR. Use the name of the class for the object reference, C<$object>, as the warnings category. If that warnings category has been set to "FATAL" in the scope where C\ <$object> is first used then die. Otherwise return. =item warnings::warnif($message) Equivalent to: if (warnings::enabled()) { warnings::warn($message) } =item warnings::warnif($category, $message) Equivalent to: if (warnings::enabled($category)) { warnings::warn($category, $message) } =item warnings::warnif($object, $message) Equivalent to: if (warnings::enabled($object)) { warnings::warn($object, $message) } =back See L and L. =cut use Carp (); our %Offsets = ( # Warnings Categories added in Perl 5.008 'all' => 0, 'closure' => 2, 'deprecated' => 4, 'exiting' => 6, 'glob' => 8, 'io' => 10, 'closed' => 12, 'exec' => 14, 'layer' => 16, 'newline' => 18, 'pipe' => 20, 'unopened' => 22, 'misc' => 24, 'numeric' => 26, 'once' => 28, 'overflow' => 30, 'pack' => 32, 'portable' => 34, 'recursion' => 36, 'redefine' => 38, 'regexp' => 40, 'severe' => 42, 'debugging' => 44, 'inplace' => 46, 'internal' => 48, 'malloc' => 50, 'signal' => 52, 'substr' => 54, 'syntax' => 56, 'ambiguous' => 58, 'bareword' => 60, 'digit' => 62, 'parenthesis' => 64, 'precedence' => 66, 'printf' => 68, 'prototype' => 70, 'qw' => 72, 'reserved' => 74, 'semicolon' => 76, 'taint' => 78, 'threads' => 80, 'uninitialized' => 82, 'unpack' => 84, 'untie' => 86, 'utf8' =>" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81b5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x7,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL stat(0x81a0a00,0xbfbfcc20) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Carp.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0980,0xbfbfcb40) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Carp.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0a00,0xbfbfcc20) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Carp.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0980,0xbfbfcb40) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Carp.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81ad080,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Carp.pm" 21495 perl5.8.8 RET open 8 21495 perl5.8.8 CALL break(0x81b6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x8,0xbfbfa140) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x81b7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x8,0x81b6000,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes "package Carp; our $VERSION = '1.09'; # this file is an utra-lightweight stub. The first time a function is # called, Carp::Heavy is loaded, and the real short/longmessmess_jmp # subs are installed our $MaxEvalLen = 0; our $Verbose = 0; our $CarpLevel = 0; our $MaxArgLen = 64; # How much of each argument to print. 0 = all. our $MaxArgNums = 8; # How many arguments to print. 0 = all. require Exporter; our @ISA = ('Exporter'); our @EXPORT = qw(confess croak carp); our @EXPORT_OK = qw(cluck verbose longmess shortmess); our @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode # if the caller specifies verbose usage ("perl -MCarp=verbose script.p\ l") # then the following method will be called by the Exporter which knows # to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the wo\ rd # 'verbose'. sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ } # fixed hooks for stashes to point to sub longmess { goto &longmess_jmp } sub shortmess { goto &shortmess_jmp } # these two are replaced when Carp::Heavy is loaded sub longmess_jmp { local($@, $!); eval { require Carp::Heavy }; return $@ if $@; goto &longmess_real; } sub shortmess_jmp { local($@, $!); eval { require Carp::Heavy }; return $@ if $@; goto &shortmess_real; } sub croak { die shortmess @_ } sub confess { die longmess @_ } sub carp { warn shortmess @_ } sub cluck { warn longmess @_ } 1; __END__ =head1 NAME carp - warn of errors (from perspective of caller) cluck - warn of errors with stack backtrace (not exported by default) croak - die of errors (from perspective of caller) confess - die of errors with stack backtrace =head1 SYNOPSIS use Carp; croak "We're outta here!"; use Carp qw(cluck); cluck "This is how we got here!"; =head1 DESCRIPTION The Carp routines are useful in your own modules because they act like die() or warn(), but with a message which is more likely to be useful to a user of your module. In the case of cluck, confess, and longmess that context is a summary of every call in the call-stack. For a shorter message you can use C or C which report the error as being from where your module was called. There is no guarantee that that is where the error was, but it is a good educated guess. You can also alter the way the output and logic of C works, by changing some global variables in the C namespace. See the section on C below. Here is a more complete description of how c and c work. What they do is search the call-stack for a function call stack where they have not been told that there shouldn't be an error. If every call is marked safe, they give up and give a full stack backtrace instead. In other words they presume that the first likely looking potential suspect is guilty. Their rules for telling whether a call shouldn't generate errors work as follows: =over 4 =item 1. Any call from a package to itself is safe. =item 2. Packages claim that there won't be errors on calls to or from packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or (if that array is empty) C<@ISA>. The ability to override what @ISA says is new in 5.8. =item 3. The trust in item 2 is transitive. If A trusts B, and B trusts C, then A trusts C. So if you do not override C<@ISA> with C<@CARP_NOT>, then this trust relationship is identical to, "inherits from". =item 4. Any call from an internal Perl module is safe. (Nothing keeps user modules from marking themselves as internal to Perl, but this practice is discouraged.) =item 5. Any call to Perl's warning system (eg Carp itself) is safe. (This rule is what keeps it from reporting the error at the point where you call C or C.) =item 6. C<$Carp::CarpLevel> can be set to skip a fixed number of additional call levels. Using this is not recommended because it is very difficult to get it to behave correctly. =back =head2 Forcing a Stack Trace As a debugging aid, you can force Carp to treat a croak as a c" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81b9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x8,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x81ba000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81bb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81bc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x8) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x7,0x8193000,0x1000) 21495 perl5.8.8 GIO fd 7 read 4096 bytes " 88, 'void' => 90, 'y2k' => 92, ); our %Bits = ( 'all' => "\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\x55\\\ x55\\x55\\x55\\x15", # [0..46] 'ambiguous' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\\ x00\\x00\\x00\\x00", # [29] 'bareword' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\\ x00\\x00\\x00\\x00", # [30] 'closed' => "\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [6] 'closure' => "\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [1] 'debugging' => "\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\\ x00\\x00\\x00\\x00", # [22] 'deprecated' => "\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [2] 'digit' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\\ x00\\x00\\x00\\x00", # [31] 'exec' => "\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [7] 'exiting' => "\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [3] 'glob' => "\\x00\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [4] 'inplace' => "\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\\ x00\\x00\\x00\\x00", # [23] 'internal' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\\ x00\\x00\\x00\\x00", # [24] 'io' => "\\x00\\x54\\x55\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [5..11] 'layer' => "\\x00\\x00\\x01\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [8] 'malloc' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x00\\\ x00\\x00\\x00\\x00", # [25] 'misc' => "\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [12] 'newline' => "\\x00\\x00\\x04\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [9] 'numeric' => "\\x00\\x00\\x00\\x04\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [13] 'once' => "\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [14] 'overflow' => "\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [15] 'pack' => "\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [16] 'parenthesis' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x01\\x00\\x00\\x00", # [32] 'pipe' => "\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [10] 'portable' => "\\x00\\x00\\x00\\x00\\x04\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [17] 'precedence' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x04\\x00\\x00\\x00", # [33] 'printf' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x10\\x00\\x00\\x00", # [34] 'prototype' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x40\\x00\\x00\\x00", # [35] 'qw' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x01\\x00\\x00", # [36] 'recursion' => "\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [18] 'redefine' => "\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [19] 'regexp' => "\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\\ x00\\x00\\x00\\x00", # [20] 'reserved' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x04\\x00\\x00", # [37] 'semicolon' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x10\\x00\\x00", # [38] 'severe' => "\\x00\\x00\\x00\\x00\\x00\\x54\\x05\\x00\\\ x00\\x00\\x00\\x00", # [21..25] 'signal' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\\ x00\\x00\\x00\\x00", # [26] 'substr' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\\ x00\\x00\\x00\\x00", # [27] 'syntax' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x55\\\ x55\\x15\\x00\\x00", # [28..38] 'taint' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x40\\x00\\x00", # [39] 'threads' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x01\\x00", # [40] 'uninitialized' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x04\\x00", # [41] 'unopened' => "\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [11] 'unpack' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x10\\x00", # [42] 'untie' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x40\\x00", # [43] 'utf8' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x01", # [44] 'void' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x04", # [45] 'y2k' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x10", # [46] ); our %DeadBits = ( 'all' => "\\xaa\\xaa\\xaa\\xaa\\xaa\\xaa\\xaa\\xaa\\\ xaa\\xaa\\xaa\\x2a", # [0..46] 'ambiguous' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x08\\\ x00\\x00\\x00\\x00", # [29] 'bareword' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x20\\\ x00\\x00\\x00\\x00", # [30] 'closed' => "\\x00\\x20\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [6] 'closure' => "\\x08\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [1] 'debugging' => "\\x00\\x00\\x" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL read(0x7,0x8193000,0x1000) 21495 perl5.8.8 GIO fd 7 read 4096 bytes "00\\x00\\x00\\x20\\x00\\x00\\x00\\x00\\x00\\x00", # [22] 'deprecated' => "\\x20\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [2] 'digit' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\\ x00\\x00\\x00\\x00", # [31] 'exec' => "\\x00\\x80\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [7] 'exiting' => "\\x80\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [3] 'glob' => "\\x00\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [4] 'inplace' => "\\x00\\x00\\x00\\x00\\x00\\x80\\x00\\x00\\\ x00\\x00\\x00\\x00", # [23] 'internal' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x02\\x00\\\ x00\\x00\\x00\\x00", # [24] 'io' => "\\x00\\xa8\\xaa\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [5..11] 'layer' => "\\x00\\x00\\x02\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [8] 'malloc' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x08\\x00\\\ x00\\x00\\x00\\x00", # [25] 'misc' => "\\x00\\x00\\x00\\x02\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [12] 'newline' => "\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [9] 'numeric' => "\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [13] 'once' => "\\x00\\x00\\x00\\x20\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [14] 'overflow' => "\\x00\\x00\\x00\\x80\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [15] 'pack' => "\\x00\\x00\\x00\\x00\\x02\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [16] 'parenthesis' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x02\\x00\\x00\\x00", # [32] 'pipe' => "\\x00\\x00\\x20\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [10] 'portable' => "\\x00\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [17] 'precedence' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x08\\x00\\x00\\x00", # [33] 'printf' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x20\\x00\\x00\\x00", # [34] 'prototype' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x80\\x00\\x00\\x00", # [35] 'qw' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x02\\x00\\x00", # [36] 'recursion' => "\\x00\\x00\\x00\\x00\\x20\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [18] 'redefine' => "\\x00\\x00\\x00\\x00\\x80\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [19] 'regexp' => "\\x00\\x00\\x00\\x00\\x00\\x02\\x00\\x00\\\ x00\\x00\\x00\\x00", # [20] 'reserved' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x08\\x00\\x00", # [37] 'semicolon' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x20\\x00\\x00", # [38] 'severe' => "\\x00\\x00\\x00\\x00\\x00\\xa8\\x0a\\x00\\\ x00\\x00\\x00\\x00", # [21..25] 'signal' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x20\\x00\\\ x00\\x00\\x00\\x00", # [26] 'substr' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\x00\\\ x00\\x00\\x00\\x00", # [27] 'syntax' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xaa\\\ xaa\\x2a\\x00\\x00", # [28..38] 'taint' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x80\\x00\\x00", # [39] 'threads' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x02\\x00", # [40] 'uninitialized' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x08\\x00", # [41] 'unopened' => "\\x00\\x00\\x80\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x00", # [11] 'unpack' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x20\\x00", # [42] 'untie' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x80\\x00", # [43] 'utf8' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x02", # [44] 'void' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x08", # [45] 'y2k' => "\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\\ x00\\x00\\x00\\x20", # [46] ); $NONE = "\\0\\0\\0\\0\\0\\0\\0\\0\\0\\0\\0\\0"; $LAST_BIT = 94 ; $BYTES = 12 ; $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; sub Croaker { require Carp::Heavy; # this initializes %CarpInternal delete $Carp::CarpInternal{'warnings'}; Carp::croak(@_); } sub bits { # called from B::Deparse.pm push @_, 'all' unless @_; my $mask; my $catmask ; my $fatal = 0 ; my $no_fatal = 0 ; foreach my $word ( @_ ) { if ($word eq 'FATAL') { $fatal = 1; $no_fatal = 0; } elsif ($word eq 'NONFATAL') { $fatal = 0; $no_fatal = 1; } elsif ($catmask = $Bits{$word}) { $mask |= $catmask ; $mask |= $DeadBits{$word} if $fatal ; $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; } else { Croaker("Unknown warnings category '$word'")} } return $mask ; } sub import { shift; my $catmask ; my $fatal = 0 ; my $no_f" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81bd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81be000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81bf000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x8193000,0x1000) 21495 perl5.8.8 GIO fd 7 read 3609 bytes "atal = 0 ; my $mask = ${^WARNING_BITS} ; if (vec($mask, $Offsets{'all'}, 1)) { $mask |= $Bits{'all'} ; $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); } push @_, 'all' unless @_; foreach my $word ( @_ ) { if ($word eq 'FATAL') { $fatal = 1; $no_fatal = 0; } elsif ($word eq 'NONFATAL') { $fatal = 0; $no_fatal = 1; } elsif ($catmask = $Bits{$word}) { $mask |= $catmask ; $mask |= $DeadBits{$word} if $fatal ; $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; } else { Croaker("Unknown warnings category '$word'")} } ${^WARNING_BITS} = $mask ; } sub unimport { shift; my $catmask ; my $mask = ${^WARNING_BITS} ; if (vec($mask, $Offsets{'all'}, 1)) { $mask |= $Bits{'all'} ; $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); } push @_, 'all' unless @_; foreach my $word ( @_ ) { if ($word eq 'FATAL') { next; } elsif ($catmask = $Bits{$word}) { $mask &= ~($catmask | $DeadBits{$word} | $All); } else { Croaker("Unknown warnings category '$word'")} } ${^WARNING_BITS} = $mask ; } my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVA\ LUE Regexp)} = (); sub __chk { my $category ; my $offset ; my $isobj = 0 ; if (@_) { # check the category supplied. $category = shift ; if (my $type = ref $category) { Croaker("not an object") if exists $builtin_type{$type}; $category = $type; $isobj = 1 ; } $offset = $Offsets{$category}; Croaker("Unknown warnings category '$category'") unless defined $offset; } else { $category = (caller(1))[0] ; $offset = $Offsets{$category}; Croaker("package '$category' not registered for warnings") unless defined $offset ; } my $this_pkg = (caller(1))[0] ; my $i = 2 ; my $pkg ; if ($isobj) { while (do { { package DB; $pkg = (caller($i++))[0] } } ) { last unless @DB::args && $DB::args[0] =~ /^$category=/ ; } $i -= 2 ; } else { for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) { last if $pkg ne $this_pkg ; } $i = 2 if !$pkg || $pkg eq $this_pkg ; } my $callers_bitmask = (caller($i))[9] ; return ($callers_bitmask, $offset, $i) ; } sub enabled { Croaker("Usage: warnings::enabled([category])") unless @_ == 1 || @_ == 0 ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; return 0 unless defined $callers_bitmask ; return vec($callers_bitmask, $offset, 1) || vec($callers_bitmask, $Offsets{'all'}, 1) ; } sub warn { Croaker("Usage: warnings::warn([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; Carp::croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; Carp::carp($message) ; } sub warnif { Croaker("Usage: warnings::warnif([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; return unless defined $callers_bitmask && (vec($callers_bitmask, $offset, 1) || vec($callers_bitmask, $Offsets{'all'}, 1)) ; Carp::croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; Carp::carp($message) ; } 1; # ex: set ro: " 21495 perl5.8.8 RET read 3609/0xe19 21495 perl5.8.8 CALL break(0x81c0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81c9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x8193000,0x1000) 21495 perl5.8.8 GIO fd 7 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x7) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL break(0x81ca000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81cb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81cc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x6) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x5,0x8194000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "($METHOD_MAP{$^O}{cwd} or defined &cwd) { # The pwd command is not available in some chroot(2)'ed environmen\ ts my $sep = $Config::Config{path_sep} || ':'; my $os = $^O; # Protect $^O from tainting # Try again to find a pwd, this time searching the whole PATH. if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Window\ s my @candidates = split($sep, $ENV{PATH}); while (!$found_pwd_cmd and @candidates) { my $candidate = shift @candidates; $found_pwd_cmd = 1 if -x "$candidate/pwd"; } } # MacOS has some special magic to make `pwd` work. if( $os eq 'MacOS' || $found_pwd_cmd ) { *cwd = \\&_backtick_pwd; } else { *cwd = \\&getcwd; } } if ($^O eq 'cygwin') { # We need to make sure cwd() is called with no args, because it's # got an arg-less prototype and will die if args are present. local $^W = 0; my $orig_cwd = \\&cwd; *cwd = sub { &$orig_cwd() } } # set a reasonable (and very safe) default for fastgetcwd, in case it # isn't redefined later (20001212 rspier) *fastgetcwd = \\&cwd; # A non-XS version of getcwd() - also used to bootstrap the perl build # process, when miniperl is running and no XS loading happens. sub _perl_getcwd { abs_path('.'); } # By John Bazik # # Usage: $cwd = &fastcwd; # # This is a faster version of getcwd. It's also more dangerous becaus\ e # you might chdir out of a directory that you can't chdir back into. sub fastcwd_ { my($odev, $oino, $cdev, $cino, $tdev, $tino); my(@path, $path); local(*DIR); my($orig_cdev, $orig_cino) = stat('.'); ($cdev, $cino) = ($orig_cdev, $orig_cino); for (;;) { my $direntry; ($odev, $oino) = ($cdev, $cino); CORE::chdir('..') || return undef; ($cdev, $cino) = stat('.'); last if $odev == $cdev && $oino == $cino; opendir(DIR, '.') || return undef; for (;;) { $direntry = readdir(DIR); last unless defined $direntry; next if $direntry eq '.'; next if $direntry eq '..'; ($tdev, $tino) = lstat($direntry); last unless $tdev != $odev || $tino != $oino; } closedir(DIR); return undef unless defined $direntry; # should never happen unshift(@path, $direntry); } $path = '/' . join('/', @path); if ($^O eq 'apollo') { $path = "/".$path; } # At this point $path may be tainted (if tainting) and chdir would\ fail. # Untaint it then check that we landed where we started. $path =~ /^(.*)\\z/s # untaint && CORE::chdir($1) or return undef; ($cdev, $cino) = stat('.'); die "Unstable directory path, current directory changed unexpected\ ly" if $cdev != $orig_cdev || $cino != $orig_cino; $path; } if (not defined &fastcwd) { *fastcwd = \\&fastcwd_ } # Keeps track of current working directory in PWD environment var # Usage: # use Cwd 'chdir'; # chdir $newdir; my $chdir_init = 0; sub chdir_init { if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWi\ n32') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) \ { $ENV{'PWD'} = cwd(); } } else { my $wd = cwd(); $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; $ENV{'PWD'} = $wd; } # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.\ *)|s) { my($pd,$pi) = stat($2); my($dd,$di) = stat($1); if (defined $pd and defined $dd and $di == $pi and $dd == $pd)\ { $ENV{'PWD'}="$2$3"; } } $chdir_init = 1; } sub chdir { my $newdir = @_ ? shift : ''; # allow for no arg (chdir to H\ OME dir) $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; chdir_init() unless $chdir_init; my $newpwd; if ($^O eq 'MSWin32') { # get the full path name *before* the chdir() $newpwd = Win32::GetFullPathName($newdir); } return 0 unless CORE::chdir $newdir; if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } elsif ($^O eq 'MacOS') { return $ENV{'PWD'} = cwd(); } elsif ($^O eq 'MSWin32') { $ENV{'PWD'} = $newpwd; return 1; } if" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81cd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ce000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81cf000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8194000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes " (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in $ENV{'PWD'} = cwd(); } elsif ($newdir =~ m#^/#s) { $ENV{'PWD'} = $newdir; } else { my @curdir = split(m#/#,$ENV{'PWD'}); @curdir = ('') unless @curdir; my $component; foreach $component (split(m#/#, $newdir)) { next if $component eq '.'; pop(@curdir),next if $component eq '..'; push(@curdir,$component); } $ENV{'PWD'} = join('/',@curdir) || '/'; } 1; } sub _perl_abs_path { my $start = @_ ? shift : '.'; my($dotdots, $cwd, @pst, @cst, $dir, @tst); unless (@cst = stat( $start )) { _carp("stat($start): $!"); return ''; } unless (-d _) { # Make sure we can be invoked on plain files, not just directo\ ries. # NOTE that this routine assumes that '/' is the only director\ y separator. my ($dir, $file) = $start =~ m{^(.*)/(.+)$} or return cwd() . '/' . $start; # Can't use "-l _" here, because the previous stat was a stat(\ ), not an lstat(). if (-l $start) { my $link_target = readlink($start); die "Can't resolve link $start: $!" unless defined $link_t\ arget; require File::Spec; $link_target = $dir . '/' . $link_target unless File::Spec->file_name_is_absolute($link_target)\ ; return abs_path($link_target); } return $dir ? abs_path($dir) . "/$file" : "/$file"; } $cwd = ''; $dotdots = $start; do { $dotdots .= '/..'; @pst = @cst; local *PARENT; unless (opendir(PARENT, $dotdots)) { # probably a permissions issue. Try the native command. return File::Spec->rel2abs( $start, _backtick_pwd() ); } unless (@cst = stat($dotdots)) { _carp("stat($dotdots): $!"); closedir(PARENT); return ''; } if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) { $dir = undef; } else { do { unless (defined ($dir = readdir(PARENT))) { _carp("readdir($dotdots): $!"); closedir(PARENT); return ''; } $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$di\ r")) } while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] |\ | $tst[1] != $pst[1]); } $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; closedir(PARENT); } while (defined $dir); chop($cwd) unless $cwd eq '/'; # drop the trailing / $cwd; } my $Curdir; sub fast_abs_path { local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage my $cwd = getcwd(); require File::Spec; my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); # Detaint else we'll explode in taint mode. This is safe because # we're not doing anything dangerous with it. ($path) = $path =~ /(.*)/; ($cwd) = $cwd =~ /(.*)/; unless (-e $path) { _croak("$path: No such file or directory"); } unless (-d _) { # Make sure we can be invoked on plain files, not just directo\ ries. my ($vol, $dir, $file) = File::Spec->splitpath($path); return File::Spec->catfile($cwd, $path) unless length $dir; if (-l $path) { my $link_target = readlink($path); die "Can't resolve link $path: $!" unless defined $link_ta\ rget; $link_target = File::Spec->catpath($vol, $dir, $link_targe\ t) unless File::Spec->file_name_is_absolute($link_target)\ ; return fast_abs_path($link_target); } return $dir eq File::Spec->rootdir ? File::Spec->catpath($vol, $dir, $file) : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' .\ $file; } if (!CORE::chdir($path)) { _croak("Cannot chdir to $path: $!"); } my $realpath = getcwd(); if (! ((-d $cwd) && (CORE::chdir($cwd)))) { _croak("Cannot chdir back to $cwd: $!"); } $realpath; } # added function alias to follow principle of least surprise # based on previous aliasing. --tchrist 27-Jan-00 *fast_realpath = \\&fast_abs_path; # --- PORTING SECTION --- # VMS: $ENV{'DEFAULT'} points to default directory at all times # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu # Note: Use of Cwd::chdir() causes the logical name PWD to be defined # in" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81d4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81d9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81da000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81db000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81dc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81dd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81de000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8194000,0x1000) 21495 perl5.8.8 GIO fd 5 read 3126 bytes " the process logical name table as the default device and directory # seen by Perl. This may not be the same as the default device # and directory seen by DCL after Perl exits, since the effects # the CRTL chdir() function persist only until Perl exits. sub _vms_cwd { return $ENV{'DEFAULT'}; } sub _vms_abs_path { return $ENV{'DEFAULT'} unless @_; my $path = shift; if (-l $path) { my $link_target = readlink($path); die "Can't resolve link $path: $!" unless defined $link_target\ ; return _vms_abs_path($link_target); } if (defined &VMS::Filespec::vms_realpath) { my $path = $_[0]; if ($path =~ m#(?<=\\^)/# ) { # Unix format return VMS::Filespec::vms_realpath($path); } # VMS format my $new_path = VMS::Filespec::vms_realname($path); # Perl expects directories to be in directory format $new_path = VMS::Filespec::pathify($new_path) if -d $path; return $new_path; } # Fallback to older algorithm if correct ones are not # available. # may need to turn foo.dir into [.foo] my $pathified = VMS::Filespec::pathify($path); $path = $pathified if defined $pathified; return VMS::Filespec::rmsexpand($path); } sub _os2_cwd { $ENV{'PWD'} = `cmd /c cd`; chomp $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\\\:/:g ; return $ENV{'PWD'}; } sub _win32_cwd { if (defined &DynaLoader::boot_DynaLoader) { $ENV{'PWD'} = Win32::GetCwd(); } else { # miniperl chomp($ENV{'PWD'} = `cd`); } $ENV{'PWD'} =~ s:\\\\:/:g ; return $ENV{'PWD'}; } *_NT_cwd = defined &Win32::GetCwd ? \\&_win32_cwd : \\&_os2_cwd; sub _dos_cwd { if (!defined &Dos::GetCwd) { $ENV{'PWD'} = `command /c cd`; chomp $ENV{'PWD'}; $ENV{'PWD'} =~ s:\\\\:/:g ; } else { $ENV{'PWD'} = Dos::GetCwd(); } return $ENV{'PWD'}; } sub _qnx_cwd { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; $ENV{'PWD'} = `/usr/bin/fullpath -t`; chomp $ENV{'PWD'}; return $ENV{'PWD'}; } sub _qnx_abs_path { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; my $path = @_ ? shift : '.'; local *REALPATH; defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $\ path ) or die "Can't open /usr/bin/fullpath: $!"; my $realpath = ; close REALPATH; chomp $realpath; return $realpath; } sub _epoc_cwd { $ENV{'PWD'} = EPOC::getcwd(); return $ENV{'PWD'}; } # Now that all the base-level functions are set up, alias the # user-level functions to the right places if (exists $METHOD_MAP{$^O}) { my $map = $METHOD_MAP{$^O}; foreach my $name (keys %$map) { local $^W = 0; # assignments trigger 'subroutine redefined' warni\ ng no strict 'refs'; *{$name} = \\&{$map->{$name}}; } } # In case the XS version doesn't load. *abs_path = \\&_perl_abs_path unless defined &abs_path; *getcwd = \\&_perl_getcwd unless defined &getcwd; # added function alias for those of us more # used to the libc function. --tchrist 27-Jan-00 *realpath = \\&abs_path; 1; " 21495 perl5.8.8 RET read 3126/0xc36 21495 perl5.8.8 CALL break(0x81df000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8194000,0x1000) 21495 perl5.8.8 GIO fd 5 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81c6c00,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/XSLoader.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81a0500,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/XSLoader.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81c6c80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/XSLoader.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfb2e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x81e5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x81e4000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "# Generated from XSLoader.pm.PL (resolved %Config::Config value) package XSLoader; $VERSION = "0.10"; #use strict; # enable debug/trace messages from DynaLoader perl code # $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; my $dl_dlext = 'so'; package DynaLoader; # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here\ . # NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && !defined(&dl_error); package XSLoader; sub load { package DynaLoader; die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unle\ ss @_; my($module) = $_[0]; # work with static linking too my $boots = "$module\\::bootstrap"; goto &$boots if defined &$boots; goto retry unless $module and defined &dl_load_file; my @modparts = split(/::/,$module); my $modfname = $modparts[-1]; my $modpname = join('/',@modparts); my $modlibname = (caller())[1]; my $c = @modparts; $modlibname =~ s,[\\\\/][^\\\\/]+$,, while $c--; # Q&D basename my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext"; # print STDERR "XSLoader::load for $module ($file)\\n" if $dl_debug; my $bs = $file; $bs =~ s/(\\.\\w+)?(;\\d*)?$/\\.bs/; # look for .bs 'beside' the l\ ibrary if (-s $bs) { # only read file if it's not empty # print STDERR "BS: $bs ($^O, $dlsrc)\\n" if $dl_debug; eval { do $bs; }; warn "$bs: $@\\n" if $@; } goto retry if not -f $file or -s $bs; my $bootname = "boot_$module"; $bootname =~ s/\\W/_/g; @DynaLoader::dl_require_symbols = ($bootname); my $boot_symbol_ref; # Many dynamic extension loading problems will appear to come from # this section of code: XYZ failed at line 123 of DynaLoader.pm. # Often these errors are actually occurring in the initialisation # C code of the extension XS file. Perl reports the error as being # in this perl code simply because this was the last perl code # it executed. my $libref = dl_load_file($file, 0) or do { require Carp; Carp::croak("Can't load '$file' for module $module: " . dl_err\ or()); }; push(@DynaLoader::dl_librefs,$libref); # record loaded object my @unresolved = dl_undef_symbols(); if (@unresolved) { require Carp; Carp::carp("Undefined symbols present after loading $file: @un\ resolved\\n"); } $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { require Carp; Carp::croak("Can't find '$bootname' symbol in $file\\n"); }; push(@DynaLoader::dl_modules, $module); # record loaded module boot: my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file); # See comment block above push(@DynaLoader::dl_shared_objects, $file); # record files loaded return &$xs(@_); retry: my $bootstrap_inherit = DynaLoader->can('bootstrap_inherit') || XSLoader->can('bootstrap_inherit'); goto &$bootstrap_inherit; } # Versions of DynaLoader prior to 5.6.0 don't have this function. sub bootstrap_inherit { package DynaLoader; my $module = $_[0]; local *DynaLoader::isa = *{"$module\\::ISA"}; local @DynaLoader::isa = (@DynaLoader::isa, 'DynaLoader'); # Cannot goto due to delocalization. Will report errors on a wron\ g line? require DynaLoader; DynaLoader::bootstrap(@_); } 1; __END__ =head1 NAME XSLoader - Dynamically load C libraries into Perl code =head1 VERSION Version 0.10 =head1 SYNOPSIS package YourPackage; use XSLoader; XSLoader::load 'YourPackage', $YourPackage::VERSION; =head1 DESCRIPTION This module defines a standard I interface to the dynamic linking mechanisms available on many platforms. Its primary purpose i\ s to implement cheap automatic dynamic loading of Perl modules. For a more complicated interface, see L. Many (most) features of C are not implemented in C, like for example the C, not honored by C<" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81e7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x81e8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81e9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ea000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81eb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ec000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ed000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81ee000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/Cwd/Cwd.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/Cwd/Cwd.so" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/Cwd/Cwd.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfde90) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL open(0x28192080,0,0xbfbfdde8) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/Cwd/Cwd.so" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfde70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 140d 0000 3400 0000 |............4...| 0x0020 1843 0000 0000 0000 3400 2000 0300 2800 |.C......4. ...(.| 0x0030 1e00 1b00 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 7e1a 0000 7e1a 0000 0500 0000 |....~...~.......| 0x0050 0010 0000 0100 0000 801a 0000 802a 0000 |.............*..| 0x0060 802a 0000 7c01 0000 9801 0000 0600 0000 |.*..|...........| 0x0070 0010 0000 0200 0000 8c1a 0000 8c2a 0000 |.............*..| 0x0080 8c2a 0000 a000 0000 a000 0000 0600 0000 |.*..............| 0x0090 0400 0000 4300 0000 4b00 0000 2800 0000 |....C...K...(...| 0x00a0 4800 0000 0000 0000 3000 0000 0000 0000 |H.......0.......| 0x00b0 2b00 0000 0000 0000 2700 0000 0000 0000 |+.......'.......| 0x00c0 0000 0000 3d00 0000 0000 0000 4700 0000 |....=.......G...| 0x00d0 2000 0000 3a00 0000 3800 0000 2900 0000 | ...:...8...)...| 0x00e0 2e00 0000 4100 0000 1d00 0000 0000 0000 |....A...........| 0x00f0 4000 0000 0000 0000 4600 0000 3e00 0000 |@.......F...>...| 0x0100 4900 0000 2600 0000 2f00 0000 2a00 0000 |I...&.../...*...| 0x0110 3f00 0000 3900 0000 4a00 0000 0000 0000 |?...9...J.......| 0x0120 0000 0000 3200 0000 0000 0000 2300 0000 |....2.......#...| 0x0130 1f00 0000 0000 0000 3100 0000 0000 0000 |........1.......| 0x0140 4400 0000 0000 0000 0000 0000 0000 0000 |D...............| 0x0150 4300 0000 4200 0000 0000 0000 0000 0000 |C...B...........| 0x0160 3500 0000 0000 0000 3400 0000 0000 0000 |5.......4.......| 0x0170 0000 0000 3b00 0000 0000 0000 0000 0000 |....;...........| 0x0180 0000 0000 0000 0000 0000 0000 2500 0000 |............%...| 0x0190 3c00 0000 3300 0000 3700 0000 0000 0000 |<...3...7.......| 0x01a0 2100 0000 3600 0000 0000 0000 0000 0000 |!...6...........| 0x01b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0200 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0210 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0220 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0230 0000 0000 0000 0000 0000 0000 1e00 0000 |................| 0x0240 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0250 0000 0000 1b00 0000 0000 0000 0000 0000 |................| 0x0260 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0270 1c00 0000 0000 0000 0000 0000 0000 0000 |................| 0x0280 0000 0000 0000 0000 2400 0000 0000 0000 |........$.......| 0x0290 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x02a0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x02b0 2d00 0000 0000 0000 2c00 0000 0000 0000 |-.......,.......| 0x02c0 2200 0000 0000 0000 4500 0000 0000 0000 |".......E.......| 0x02d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x02e0 0000 0000 0000 0000 9400 0000 0000 0000 |................| 0x02f0 0300 0100 0000 0000 d402 0000 0000 0000 |................| 0x0300 0300 0200 0000 0000 8407 0000 0000 0000 |................| 0x0310 0300 0300 0000 0000 a009 0000 0000 0000 |................| 0x0320 0300 0400 0000 0000 200a 0000 0000 0000 |........ .......| 0x0330 0300 0500 0000 0000 100b 0000 0000 0000 |................| 0x0340 0300 0600 0000 0000 240b 0000 0000 0000 |........$.......| 0x0350 0300 0700 0000 0000 140d 0000 0000 0000 |................| 0x0360 0300 0800 0000 0000 2419 0000 0000 0000 |........$.......| 0x0370 0300 0900 0000 0000 3019 0000 0000 0000 |........0.......| 0x0380 0300 0a00 0000 0000 802a 0000 0000 0000 |.........*......| 0x0390 0300 0b00 0000 0000 882a 0000 0000 0000 |.........*......| 0x03a0 0300 0c00 0000 0000 8c2a 0000 0000 0000 |.........*......| 0x03b0 0300 0d00 0000 0000 2c2b 0000 0000 0000 |........,+......| 0x03c0 0300 0e00 0000 0000 342b 0000 0000 0000 |........4+......| 0x03d0 0300 0f00 0000 0000 3c2b 0000 0000 0000 |........<+......| 0x03e0 0300 1000 0000 0000 402b 0000 0000 0000 |........@+......| 0x03f0 0300 1100 0000 0000 fc2b 0000 0000 0000 |.........+......| 0x0400 0300 1200 0000 0000 0000 0000 0000 0000 |................| 0x0410 0300 1300 0000 0000 0000 0000 0000 0000 |................| 0x0420 0300 1400 0000 0000 0000 0000 0000 0000 |................| 0x0430 0300 1500 0000 0000 0000 0000 0000 0000 |................| 0x0440 0300 1600 0000 0000 0000 0000 0000 0000 |................| 0x0450 0300 1700 0000 0000 0000 0000 0000 0000 |................| 0x0460 0300 1800 0000 0000 0000 0000 0000 0000 |................| 0x0470 0300 1900 0000 0000 0000 0000 0000 0000 |................| 0x0480 0300 1a00 8200 0000 0000 0000 0000 0000 |................| 0x0490 1000 0000 0501 0000 0000 0000 0000 0000 |................| 0x04a0 1000 0000 8701 0000 0000 0000 0000 0000 |................| 0x04b0 1000 0000 a801 0000 0000 0000 0000 0000 |................| 0x04c0 1000 0000 0100 0000 8c2a 0000 0000 0000 |.........*......| 0x04d0 1100 f1ff be00 0000 0000 0000 0000 0000 |................| 0x04e0 1000 0000 4301 0000 0000 0000 0000 0000 |....C...........| 0x04f0 1000 0000 a700 0000 0000 0000 0000 0000 |................| 0x0500 1000 0000 2c00 0000 0000 0000 0000 0000 |....,...........| 0x0510 2000 0000 2201 0000 0000 0000 0000 0000 | ..."...........| 0x0520 1000 0000 d101 0000 0000 0000 0000 0000 |................| 0x0530 1000 0000 2000 0000 100b 0000 0000 0000 |.... ...........| 0x0540 1200 0600 9100 0000 0000 0000 0000 0000 |................| 0x0550 1000 0000 e600 0000 0000 0000 0000 0000 |................| 0x0560 1000 0000 ee01 0000 0000 0000 0000 0000 |................| 0x0570 1000 0000 b700 0000 0000 0000 0000 0000 |................| 0x0580 1000 0000 3b00 0000 0000 0000 0000 0000 |....;...........| 0x0590 2000 0000 bf00 0000 0000 0000 0000 0000 | ...............| 0x05a0 1000 0000 9900 0000 0000 0000 0000 0000 |................| 0x05b0 1000 0000 cb00 0000 0c11 0000 4c01 0000 |............L...| 0x05c0 1200 0800 9f00 0000 0000 0000 0000 0000 |................| 0x05d0 1000 0000 5b01 0000 0000 0000 0000 0000 |....[...........| 0x05e0 1000 0000 8900 0000 0000 0000 0000 0000 |................| 0x05f0 1000 0000 b401 0000 0000 0000 0000 0000 |................| 0x0600 1000 0000 f901 0000 0000 0000 0000 0000 |................| 0x0610 1000 0000 db01 0000 0000 0000 0000 0000 |................| 0x0620 1000 0000 0a02 0000 fc2b 0000 0000 0000 |.........+......| 0x0630 1000 f1ff 3401 0000 0000 0000 0000 0000 |....4...........| 0x0640 1000 0000 f700 0000 0000 0000 0000 0000 |................| 0x0650 1000 0000 e701 0000 0000 0000 0000 0000 |................| 0x0660 1000 0000 7701 0000 8413 0000 6902 0000 |....w.......i...| 0x0670 1200 0800 da00 0000 0000 0000 0000 0000 |................| 0x0680 1000 0000 7001 0000 0000 0000 0000 0000 |....p...........| 0x0690 1000 0000 2600 0000 2419 0000 0000 0000 |....&...$.......| 0x06a0 1200 0900 0302 0000 fc2b 0000 0000 0000 |.........+......| 0x06b0 1000 f1ff 0a00 0000 402b 0000 0000 0000 |........@+......| 0x06c0 1100 f1ff 1602 0000 182c 0000 0000 0000 |.........,......| 0x06d0 1000 f1ff 1001 0000 0000 0000 0000 0000 |................| 0x06e0 1000 0000 6901 0000 5812 0000 2901 0000 |....i...X...)...| 0x06f0 1200 0800 1601 0000 0000 0000 0000 0000 |................| 0x0700 1000 0000 b000 0000 0000 0000 0000 0000 |................| 0x0710 1000 0000 7d00 0000 0000 0000 0000 0000 |....}...........| 0x0720 1000 0000 6900 0000 0000 0000 0000 0000 |....i...........| 0x0730 2000 0000 c801 0000 f015 0000 0303 0000 | ...............| 0x0740 1200 0800 9901 0000 0000 0000 0000 0000 |................| 0x0750 1000 0000 5300 0000 0000 0000 0000 0000 |....S...........| 0x0760 2000 0000 c500 0000 0000 0000 0000 0000 | ...............| 0x0770 1000 0000 4f01 0000 0000 0000 0000 0000 |....O...........| 0x0780 1000 0000 005f 4459 4e41 4d49 4300 5f47 |....._DYNAMIC._G| 0x0790 4c4f 4241 4c5f 4f46 4653 4554 5f54 4142 |LOBAL_OFFSET_TAB| 0x07a0 4c45 5f00 5f69 6e69 7400 5f66 696e 6900 |LE_._init._fini.| 0x07b0 5f5f 6378 615f 6669 6e61 6c69 7a65 005f |__cxa_finalize._| 0x07c0 5f64 6572 6567 6973 7465 725f 6672 616d |_deregister_fram| 0x07d0 655f 696e 666f 005f 5f72 6567 6973 7465 |e_info.__registe| 0x07e0 725f 6672 616d 655f 696e 666f 005f 4a76 |r_frame_info._Jv| 0x07f0 5f52 6567 6973 7465 7243 6c61 7373 6573 |_RegisterClasses| 0x0800 006f 7065 6e00 7374 7263 7079 0073 7472 |.open.strcpy.str| 0x0810 6e63 7079 0073 7472 7263 6872 006c 7374 |ncpy.strrchr.lst| 0x0820 6174 005f 5f65 7272 6f72 0072 6561 646c |at.__error.readl| 0x0830 696e 6b00 7374 726c 656e 0073 7472 6361 |ink.strlen.strca| 0x0840 7400 6663 6864 6972 0063 6c6f 7365 0058 |t.fchdir.close.X| 0x0850 535f 4377 645f 6661 7374 6377 6400 504c |S_Cwd_fastcwd.PL| 0x0860 5f73 7461 636b 5f73 7000 504c 5f6d 6172 |_stack_sp.PL_mar| 0x0870 6b73 7461 636b 5f70 7472 0050 4c5f 7374 |kstack_ptr.PL_st| 0x0880 6163 6b5f 6261 7365 0050 6572 6c5f 6372 |ack_base.Perl_cr| 0x0890 6f61 6b00 504c 5f6f 7000 5065 726c 5f70 |oak.PL_op.Perl_p| 0x08a0 6164 5f73 7600 5065 726c 5f73 765f 6e65 |ad_sv.Perl_sv_ne| 0x08b0 776d 6f72 7461 6c00 5065 726c 5f67 6574 |wmortal.Perl_get| 0x08c0 6377 645f 7376 0050 6572 6c5f 6d67 5f73 |cwd_sv.Perl_mg_s| 0x08d0 6574 0050 4c5f 7461 696e 7469 6e67 0050 |et.PL_tainting.P| 0x08e0 6572 6c5f 7376 5f6d 6167 6963 0058 535f |erl_sv_magic.XS_| 0x08f0 4377 645f 6765 7463 7764 0058 535f 4377 |Cwd_getcwd.XS_Cw| 0x0900 645f 6162 735f 7061 7468 0050 6572 6c5f |d_abs_path.Perl_| 0x0910 7376 5f32 7076 5f66 6c61 6773 0050 6572 |sv_2pv_flags.Per| 0x0920 6c5f 7376 5f73 6574 7076 6e00 504c 5f73 |l_sv_setpvn.PL_s| 0x0930 765f 756e 6465 6600 5065 726c 5f73 765f |v_undef.Perl_sv_| 0x0940 7365 7473 765f 666c 6167 7300 626f 6f74 |setsv_flags.boot| 0x0950 5f43 7764 0050 6572 6c5f 666f 726d 0050 |_Cwd.Perl_form.P| 0x0960 6572 6c5f 6765 745f 7376 0073 7472 636d |erl_get_sv.strcm| 0x0970 7000 5065 726c 5f6e 6577 5853 0050 4c5f |p.Perl_newXS.PL_| 0x0980 7376 5f79 6573 005f 6564 6174 6100 5f5f |sv_yes._edata.__| 0x0990 6273 735f 7374 6172 7400 5f65 6e64 0000 |bss_start._end..| 0x09a0 802a 0000 0800 0000 842a 0000 0800 0000 |.*.......*......| 0x09b0 c42b 0000 061e 0000 c82b 0000 0623 0000 |.+.......+...#..| 0x09c0 cc2b 0000 0628 0000 d02b 0000 062b 0000 |.+...(...+...+..| 0x09d0 d42b 0000 062e 0000 d82b 0000 0633 0000 |.+.......+...3..| 0x09e0 dc2b 0000 0637 0000 e02b 0000 0639 0000 |.+...7...+...9..| 0x09f0 e42b 0000 063a 0000 e82b 0000 0640 0000 |.+...:...+...@..| 0x0a00 ec2b 0000 0641 0000 f02b 0000 0645 0000 |.+...A...+...E..| 0x0a10 f42b 0000 0648 0000 f82b 0000 064a 0000 |.+...H...+...J..| 0x0a20 4c2b 0000 071b 0000 502b 0000 071c 0000 |L+......P+......| 0x0a30 542b 0000 071d 0000 582b 0000 0720 0000 |T+......X+... ..| 0x0a40 5c2b 0000 0721 0000 602b 0000 0722 0000 |\+...!..`+..."..| 0x0a50 642b 0000 0723 0000 682b 0000 0724 0000 |d+...#..h+...$..| 0x0a60 6c2b 0000 0725 0000 702b 0000 0727 0000 |l+...%..p+...'..| 0x0a70 742b 0000 0729 0000 782b 0000 072a 0000 |t+...)..x+...*..| 0x0a80 7c2b 0000 072b 0000 802b 0000 072c 0000 ||+...+...+...,..| 0x0a90 842b 0000 072d 0000 882b 0000 072f 0000 |.+...-...+.../..| 0x0aa0 8c2b 0000 0730 0000 902b 0000 0731 0000 |.+...0...+...1..| 0x0ab0 942b 0000 0732 0000 982b 0000 0734 0000 |.+...2...+...4..| 0x0ac0 9c2b 0000 0736 0000 a02b 0000 0738 0000 |.+...6...+...8..| 0x0ad0 a42b 0000 073b 0000 a82b 0000 0742 0000 |.+...;...+...B..| 0x0ae0 ac2b 0000 0743 0000 b02b 0000 0744 0000 |.+...C...+...D..| 0x0af0 b42b 0000 0745 0000 b82b 0000 0747 0000 |.+...E...+...G..| 0x0b00 bc2b 0000 0748 0000 c02b 0000 0749 0000 |.+...H...+...I..| 0x0b10 83ec 0ce8 7402 0000 e8d7 0d00 0083 c40c |....t...........| 0x0b20 c300 0000 ffb3 0400 0000 ffa3 0800 0000 |................| 0x0b30 0000 0000 ffa3 0c00 0000 6800 0000 00e9 |..........h.....| 0x0b40 e0ff ffff ffa3 1000 0000 6808 0000 00e9 |..........h.....| 0x0b50 d0ff ffff ffa3 1400 0000 6810 0000 00e9 |..........h.....| 0x0b60 c0ff ffff ffa3 1800 0000 6818 0000 00e9 |..........h.....| 0x0b70 b0ff ffff ffa3 1c00 0000 6820 0000 00e9 |..........h ....| 0x0b80 a0ff ffff ffa3 2000 0000 6828 0000 00e9 |...... ...h(....| 0x0b90 90ff ffff ffa3 2400 0000 6830 0000 00e9 |......$...h0....| 0x0ba0 80ff ffff ffa3 2800 0000 6838 0000 00e9 |......(...h8....| 0x0bb0 70ff ffff ffa3 2c00 0000 6840 0000 00e9 |p.....,...h@....| 0x0bc0 60ff ffff ffa3 3000 0000 6848 0000 00e9 |`.....0...hH....| 0x0bd0 50ff ffff ffa3 3400 0000 6850 0000 00e9 |P.....4...hP....| 0x0be0 40ff ffff ffa3 3800 0000 6858 0000 00e9 |@.....8...hX....| 0x0bf0 30ff ffff ffa3 3c00 0000 6860 0000 00e9 |0.....<...h`....| 0x0c00 20ff ffff ffa3 4000 0000 6868 0000 00e9 | .....@...hh....| 0x0c10 10ff ffff ffa3 4400 0000 6870 0000 00e9 |......D...hp....| 0x0c20 00ff ffff ffa3 4800 0000 6878 0000 00e9 |......H...hx....| 0x0c30 f0fe ffff ffa3 4c00 0000 6880 0000 00e9 |......L...h.....| 0x0c40 e0fe ffff ffa3 5000 0000 6888 0000 00e9 |......P...h.....| 0x0c50 d0fe ffff ffa3 5400 0000 6890 0000 00e9 |......T...h.....| 0x0c60 c0fe ffff ffa3 5800 0000 6898 0000 00e9 |......X...h.....| 0x0c70 b0fe ffff ffa3 5c00 0000 68a0 0000 00e9 |......\...h.....| 0x0c80 a0fe ffff ffa3 6000 0000 68a8 0000 00e9 |......`...h.....| 0x0c90 90fe ffff ffa3 6400 0000 68b0 0000 00e9 |......d...h.....| 0x0ca0 80fe ffff ffa3 6800 0000 68b8 0000 00e9 |......h...h.....| 0x0cb0 70fe ffff ffa3 6c00 0000 68c0 0000 00e9 |p.....l...h.....| 0x0cc0 60fe ffff ffa3 7000 0000 68c8 0000 00e9 |`.....p...h.....| 0x0cd0 50fe ffff ffa3 7400 0000 68d0 0000 00e9 |P.....t...h.....| 0x0ce0 40fe ffff ffa3 7800 0000 68d8 0000 00e9 |@.....x...h.....| 0x0cf0 30fe ffff ffa3 7c00 0000 68e0 0000 00e9 |0.....|...h.....| 0x0d00 20fe ffff ffa3 8000 0000 68e8 0000 00e9 | .........h.....| 0x0d10 10fe ffff 5589 e553 e800 0000 005b 81c3 |....U..S.....[..| 0x0d20 231e 0000 5180 bbbc 0000 0000 7558 8b93 |#...Q.......uX..| 0x0d30 8800 0000 85d2 741f 83ec 0cff b340 ffff |......t......@..| 0x0d40 ffe8 4efe ffff 83c4 10eb 0c90 83c0 0489 |..N.............| 0x0d50 8344 ffff ffff d28b 8344 ffff ff8b 1085 |.D.......D......| 0x0d60 d275 e98b 8390 0000 0085 c074 1283 ec0c |.u.........t....| 0x0d70 8d83 48ff ffff 50e8 78fe ffff 83c4 10c6 |..H...P.x.......| 0x0d80 83bc 0000 0001 8b5d fcc9 c390 5589 e553 |.......]....U..S| 0x0d90 e800 0000 005b 81c3 ab1d 0000 508b 83b4 |.....[......P...| 0x0da0 0000 0085 c074 1983 ec08 8d83 c000 0000 |.....t..........| 0x0db0 508d 8348 ffff ff50 e837 ffff ff83 c410 |P..H...P.7......| 0x0dc0 8b83 fcff ffff 85c0 741e 8b83 b000 0000 |........t.......| 0x0dd0 85c0 7414 83ec 0c8d 83fc ffff ff50 e8f1 |..t..........P..| 0x0de0 feff ff83 c410 89f6 8b5d fcc9 c390 9090 |.........]......| 0x0df0 5589 e556 5381 ec90 0400 00e8 0000 0000 |U..VS...........| 0x0e00 5b81 c340 1d00 00c7 85e4 fbff ff00 0000 |[..@............| 0x0e10 0083 ec08 6a00 8d83 3cee ffff 50e8 a2fe |....j...<...P...| 0x0e20 ffff 83c4 1089 85e0 fbff ff83 bde0 fbff |................| 0x0e30 ff00 7924 83ec 088d 833c eeff ff50 ff75 |..y$.....<...P.u| 0x0e40 0ce8 eefc ffff 83c4 10c7 8574 fbff ff00 |...........t....| 0x0e50 0000 00e9 a602 0000 83ec 0468 ff03 0000 |...........h....| 0x0e60 ff75 08ff 750c e8d9 fdff ff83 c410 8b45 |.u..u..........E| 0x0e70 0c05 ff03 0000 c600 0083 ec08 6a2f ff75 |............j/.u| 0x0e80 0ce8 3efd ffff 83c4 1089 45e8 837d e800 |..>.......E..}..| 0x0e90 745e 8b45 e840 8945 ec8b 45e8 3b45 0c75 |t^.E.@.E..E.;E.u| 0x0ea0 0e8d 833e eeff ff89 85dc fbff ffeb 278d |...>..........'.| 0x0eb0 45e8 ff08 8b45 e83b 450c 760a 8b45 e880 |E....E.;E.v..E..| 0x0ec0 382f 7502 ebe9 8b45 e840 c600 008b 450c |8/u....E.@....E.| 0x0ed0 8985 dcfb ffff 83ec 0cff b5dc fbff ffe8 |................| 0x0ee0 20fd ffff 83c4 1085 c079 0be9 cc01 0000 | ........y......| 0x0ef0 8b45 0c89 45ec 83ec 088d 8578 fbff ff50 |.E..E......x...P| 0x0f00 ff75 ece8 0cfd ffff 83c4 1085 c00f 85a2 |.u..............| 0x0f10 0000 000f b785 80fb ffff 2500 f000 003d |..........%....=| 0x0f20 00a0 0000 755c 8d85 e4fb ffff ff00 83bd |....u\..........| 0x0f30 e4fb ffff 207e 10e8 e8fc ffff c700 3e00 |.... ~........>.| 0x0f40 0000 e975 0100 0083 ec04 68ff 0300 00ff |...u......h.....| 0x0f50 750c ff75 ece8 2afc ffff 83c4 1089 85dc |u..u..*.........| 0x0f60 fbff ff83 bddc fbff ff00 7905 e94b 0100 |..........y..K..| 0x0f70 008b 85dc fbff ff03 450c c600 00e9 f7fe |........E.......| 0x0f80 ffff 0fb7 8580 fbff ff25 00f0 0000 3d00 |.........%....=.| 0x0f90 4000 0075 2083 ec0c ff75 ece8 64fc ffff |@..u ....u..d...| 0x0fa0 83c4 1085 c079 05e9 1001 0000 8d83 40ee |.....y........@.| 0x0fb0 ffff 8945 ec83 ec08 ff75 ec8d 85e8 fbff |...E.....u......| 0x0fc0 ff50 e86d fbff ff83 c410 83ec 0868 0004 |.P.m.........h..| 0x0fd0 0000 ff75 0ce8 bafc ffff 83c4 1085 c075 |...u...........u| 0x0fe0 05e9 d600 0000 8b45 0c80 382f 7512 8b45 |.......E..8/u..E| 0x0ff0 0c40 8038 0075 09c7 45f4 0100 0000 eb07 |.@.8.u..E.......| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0x3000,0x5,0x20002,0x5,0,0,0) 21495 perl5.8.8 RET mmap 673865728/0x282a6000 21495 perl5.8.8 CALL mprotect(0x282a7000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x282a7000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x282a8000,0x1000,0x3,0x12,0x5,0,0x1000,0) 21495 perl5.8.8 RET mmap 673873920/0x282a8000 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL mmap(0,0x258,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673878016/0x282a9000 21495 perl5.8.8 CALL munmap(0x282a9000,0x258) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL sigprocmask(0x3,0x28187830,0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfde90) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL sigprocmask(0x3,0x28187830,0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/bin/pwd" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL getgroups(0,0) 21495 perl5.8.8 RET getgroups 3 21495 perl5.8.8 CALL getgroups(0x3,0x81e6230) 21495 perl5.8.8 RET getgroups 3 21495 perl5.8.8 CALL stat(0x8179980,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179800,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179980,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8179800,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81e5400,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfb2e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package File::Spec; use strict; use vars qw(@ISA $VERSION); $VERSION = '3.2701'; $VERSION = eval $VERSION; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', VMS => 'VMS', epoc => 'Epoc', NetWare => 'Win32', # Yes, File::Spec::Win32 works on Ne\ tWare. symbian => 'Win32', # Yes, File::Spec::Win32 works on sy\ mbian. dos => 'OS2', # Yes, File::Spec::OS2 works on DJGP\ P. cygwin => 'Cygwin'); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; @ISA = ("File::Spec::$module"); 1; __END__ =head1 NAME File::Spec - portably perform operations on file names =head1 SYNOPSIS use File::Spec; $x=File::Spec->catfile('a', 'b', 'c'); which returns 'a/b/c' under Unix. Or: use File::Spec::Functions; $x = catfile('a', 'b', 'c'); =head1 DESCRIPTION This module is designed to support operations commonly performed on fi\ le specifications (usually called "file names", but not to be confused wi\ th the contents of a file, or Perl's file handles), such as concatenating sev\ eral directory and file names into a single path, or determining whether a \ path is rooted. It is based on code directly taken from MakeMaker 5.17, cod\ e written by Andreas KEnig, Andy Dougherty, Charles Bailey, Ilya Zakharevich, Paul Schinder, and others. Since these functions are different for most operating systems, each s\ et of OS specific routines is available in a separate module, including: File::Spec::Unix File::Spec::Mac File::Spec::OS2 File::Spec::Win32 File::Spec::VMS The module appropriate for the current OS is automatically loaded by File::Spec. Since some modules (like VMS) make use of facilities avail\ able only under that OS, it may not be possible to load all modules under a\ ll operating systems. Since File::Spec is object oriented, subroutines should not be called \ directly, as in: File::Spec::catfile('a','b'); but rather as class methods: File::Spec->catfile('a','b'); For simple uses, L provides convenient function\ al forms of these methods. =head1 METHODS =over 2 =item canonpath X No physical check on the filesystem, but a logical cleanup of a path. $cpath = File::Spec->canonpath( $path ) ; Note that this does *not* collapse F sections into F. This is by design. If F on your system is a symlink to F, then F is actually F, not F as a naive F<../>-removal would give you. If you want to do this kind of processing, you probably want C's C function to actually traverse the filesystem cleaning up paths like this. =item catdir X Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS/2. Of course, if this is the root directory, don't cut off the trailing slash :-) $path = File::Spec->catdir( @directories ); =item catfile X Concatenate one or more directory names and a filename to form a complete path ending with a filename $path = File::Spec->catfile( @directories, $filename ); =item curdir X Returns a string representation of the current directory. $curdir = File::Spec->curdir(); =item devnull X Returns a string representation of the null device. $devnull = File::Spec->devnull(); =item rootdir X Returns a string representation of the root directory. $rootdir = File::Spec->rootdir(); =item tmpdir X Returns a string representation of the first writable directory from a list of possible temporary directories. Returns the current directory if no writable temporary directories are found. The list of directori\ es checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{T\ MPDIR}> (unless taint is on) and F. $tmpdir = File::Spec->tmpdir(); =item updir X Returns a string representation of the parent directory. $updir = File::Spec->updir(); =item no_" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81f0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81e5680,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec/Unix.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81e5600,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec/Unix.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81e5680,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Unix.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81e5600,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Unix.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81e5700,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Unix.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfb2e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package File::Spec::Unix; use strict; use vars qw($VERSION); $VERSION = '3.2701'; =head1 NAME File::Spec::Unix - File::Spec for Unix, base for other File::Spec modu\ les =head1 SYNOPSIS require File::Spec::Unix; # Done automatically by File::Spec =head1 DESCRIPTION Methods for manipulating file specifications. Other File::Spec modules, such as File::Spec::Mac, inherit from File::Spec::Unix and override specific methods. =head1 METHODS =over 2 =item canonpath() No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminates successive slashes and successive "/.". $cpath = File::Spec->canonpath( $path ) ; Note that this does *not* collapse F sections into F. This is by design. If F on your system is a symlink to F, then F is actually F, not F as a naive F<../>-removal would give you. If you want to do this kind of processing, you probably want C's C function to actually traverse the filesystem cleaning up paths like this. =cut sub canonpath { my ($self,$path) = @_; return unless defined $path; # Handle POSIX-style node names beginning with double slash (qnx, \ nto) # (POSIX says: "a pathname that begins with two successive slashes # may be interpreted in an implementation-defined manner, although # more than two leading slashes shall be treated as a single slash\ .") my $node = ''; my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto'; if ( $double_slashes_special && $path =~ s{^(//[^/]+)(?:/|\\z)}{/}\ s ) { $node = $1; } # This used to be # $path =~ s|/+|/|g unless ($^O eq 'cygwin'); # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fa\ il # (Mainly because trailing "" directories didn't get stripped). # Why would cygwin avoid collapsing multiple slashes into one? --j\ hi $path =~ s|/{2,}|/|g; # xx////xx -> xx\ /xx $path =~ s{(?:/\\.)+(?:/|\\z)}{/}g; # xx/././xx -> \ xx/xx $path =~ s|^(?:\\./)+||s unless $path eq "./"; # ./xx -> x\ x $path =~ s|^/(?:\\.\\./)+|/|; # /../../xx -> \ xx $path =~ s|^/\\.\\.$|/|; # /.. -> / $path =~ s|/\\z|| unless $path eq "/"; # xx/ -> xx return "$node$path"; } =item catdir() Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS2. Of course, if this is the root directory, don't cut off the trailing slash :-) =cut sub catdir { my $self = shift; $self->canonpath(join('/', @_, '')); # '' because need a trailing \ '/' } =item catfile Concatenate one or more directory names and a filename to form a complete path ending with a filename =cut sub catfile { my $self = shift; my $file = $self->canonpath(pop @_); return $file unless @_; my $dir = $self->catdir(@_); $dir .= "/" unless substr($dir,-1) eq "/"; return $dir.$file; } =item curdir Returns a string representation of the current directory. "." on UNIX\ . =cut sub curdir () { '.' } =item devnull Returns a string representation of the null device. "/dev/null" on UNI\ X. =cut sub devnull () { '/dev/null' } =item rootdir Returns a string representation of the root directory. "/" on UNIX. =cut sub rootdir () { '/' } =item tmpdir Returns a string representation of the first writable directory from the following list or the current directory if none from the list are writable: $ENV{TMPDIR} /tmp Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} is tainted, it is not used. =cut my $tmpdir; sub _tmpdir { return $tmpdir if defined $tmpdir; my $self = shift; my @dirlist = @_; { no strict 'refs'; if (${"\\cTAINT"}) { # Check for taint mode on perl >= 5.8.0 require Scalar::Util; @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; } } foreach (@dirlist) { n" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81f2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x81f3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "ext unless defined && -d && -w _; $tmpdir = $_; last; } $tmpdir = $self->curdir unless defined $tmpdir; $tmpdir = defined $tmpdir && $self->canonpath($tmpdir); return $tmpdir; } sub tmpdir { return $tmpdir if defined $tmpdir; $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ); } =item updir Returns a string representation of the parent directory. ".." on UNIX\ . =cut sub updir () { '..' } =item no_upwards Given a list of file names, strip out those that refer to a parent directory. (Does not strip symlinks, only '.', '..', and equivalents.) =cut sub no_upwards { my $self = shift; return grep(!/^\\.{1,2}\\z/s, @_); } =item case_tolerant Returns a true or false value indicating, respectively, that alphabeti\ c is not or is significant when comparing file specifications. =cut sub case_tolerant () { 0 } =item file_name_is_absolute Takes as argument a path and returns true if it is an absolute path. This does not consult the local filesystem on Unix, Win32, OS/2 or Mac\ OS (Classic). It does consult the working environment for VMS (see L). =cut sub file_name_is_absolute { my ($self,$file) = @_; return scalar($file =~ m:^/:s); } =item path Takes no argument, returns the environment variable PATH as an array. =cut sub path { return () unless exists $ENV{PATH}; my @path = split(':', $ENV{PATH}); foreach (@path) { $_ = '.' if $_ eq '' } return @path; } =item join join is the same as catfile. =cut sub join { my $self = shift; return $self->catfile(@_); } =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_f\ ile ); Splits a path into volume, directory, and filename portions. On system\ s with no concept of volume, returns '' for volume. For systems with no syntax differentiating filenames from directories,\ assumes that the last file is a path unless $no_file is true or a trailing separator or /. or /.. is present. On Unix this means that $n\ o_file true makes this return ( '', $path, '' ). The directory portion may or may not be returned with a trailing '/'. The results can be passed to L to get back a path equivale\ nt to (usually identical to) the original path. =cut sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { $directory = $path; } else { $path =~ m|^ ( (?: .* / (?: \\.\\.?\\z )? )? ) ([^/]*) |xs; $directory = $1; $file = $2; } return ($volume,$directory,$file); } =item splitdir The opposite of L. @dirs = File::Spec->splitdir( $directories ); $directories must be only the directory portion of the path on systems\ that have the concept of a volume or that have path syntax that differ\ entiates files from directories. Unlike just splitting the directories on the separator, empty directory names (C<''>) can be returned, because these are significant on some OSs. On Unix, File::Spec->splitdir( "/a/b//c/" ); Yields: ( '', 'a', 'b', '', 'c', '' ) =cut sub splitdir { return split m|/|, $_[1], -1; # Preserve trailing fields } =item catpath() Takes volume, directory and file portions and returns an entire path. \ Under Unix, $volume is ignored, and directory and file are concatenated. A \ '/' is inserted if needed (though if the directory portion doesn't start with '/' it is not added). On other OSs, $volume is significant. =cut sub catpath { my ($self,$volume,$directory,$file) = @_; if ( $directory ne '' && $file ne '' && substr( $directory, -1 ) ne '/' && substr( $file, 0, 1 ) ne '/' ) { $directory .= "/$file" ; } else { $directory .= $file ; } return $directory ; } =item abs2rel Takes a destination path and an optional base path returns a relative \ path from the base path to the destination path: $rel_path = File::S" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81f4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81f5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81f6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81f7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "pec->abs2rel( $path ) ; $rel_path = File::Spec->abs2rel( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems that have a grammar that indicates filenames, this ignores \ the $base filename. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =cut sub abs2rel { my($self,$path,$base) = @_; $base = $self->_cwd() unless defined $base and length $base; ($path, $base) = map $self->canonpath($_), $path, $base; if (grep $self->file_name_is_absolute($_), $path, $base) { ($path, $base) = map $self->rel2abs($_), $path, $base; } else { # save a couple of cwd()s if both paths are relative ($path, $base) = map $self->catdir('/', $_), $path, $base; } my ($path_volume) = $self->splitpath($path, 1); my ($base_volume) = $self->splitpath($base, 1); # Can't relativize across volumes return $path unless $path_volume eq $base_volume; my $path_directories = ($self->splitpath($path, 1))[1]; my $base_directories = ($self->splitpath($base, 1))[1]; # For UNC paths, the user might give a volume like //foo/bar that # strictly speaking has no directory portion. Treat it as if it # had the root directory for that volume. if (!length($base_directories) and $self->file_name_is_absolute($b\ ase)) { $base_directories = $self->rootdir; } # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); if ($base_directories eq $self->rootdir) { shift @pathchunks; return $self->canonpath( $self->catpath('', $self->catdir( @path\ chunks ), '') ); } while (@pathchunks && @basechunks && $self->_same($pathchunks[0], \ $basechunks[0])) { shift @pathchunks ; shift @basechunks ; } return $self->curdir unless @pathchunks || @basechunks; # $base now contains the directories the resulting relative path # must ascend out of before it can descend to $path_directory. my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pa\ thchunks ); return $self->canonpath( $self->catpath('', $result_dirs, '') ); } sub _same { $_[1] eq $_[2]; } =item rel2abs() Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems that have a grammar that indicates filenames, this ignores the $base filename. Otherwise all path components are assumed to be directories. If $path is absolute, it is cleaned up and returned using L. No checks against the filesystem are made. On VMS, there is interaction with the working environment, as logicals and macros are expanded. Based on code written by Shigio Yamaguchi. =cut sub rel2abs { my ($self,$path,$base ) = @_; # Clean up $path if ( ! $self->file_name_is_absolute( $path ) ) { # Figure out the effective $base and clean it up. if ( !defined( $base ) || $base eq '' ) { $base = $self->_cwd(); } elsif ( ! $self->file_name_is_absolute( $base ) ) { $base = $self->rel2abs( $base ) ; } else { $base = $self->canonpath( $base ) ; } # Glom them together $path = $self->catdir( $base, $path ) ; } return $self->canonpath( $path ) ; } =back =head1 COPYRIGHT" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x81f8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81f9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81fa000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 1519 bytes " Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =cut # Internal routine to File::Spec, no point in making this public since # it is the standard Cwd interface. Most of the platform-specific # File::Spec subclasses use this. sub _cwd { require Cwd; Cwd::getcwd(); } # Internal method to reduce xx\\..\\yy -> yy sub _collapse { my($fs, $path) = @_; my $updir = $fs->updir; my $curdir = $fs->curdir; my($vol, $dirs, $file) = $fs->splitpath($path); my @dirs = $fs->splitdir($dirs); pop @dirs if @dirs && $dirs[-1] eq ''; my @collapsed; foreach my $dir (@dirs) { if( $dir eq $updir and # if we have an updir @collapsed and # and something to colla\ pse length $collapsed[-1] and # and its not the rootdi\ r $collapsed[-1] ne $updir and # nor another updir $collapsed[-1] ne $curdir # nor the curdir ) { # then pop @collapsed; # collapse } else { # else push @collapsed, $dir; # just hang onto it } } return $fs->catpath($vol, $fs->catdir(@collapsed), $file ); } 1; " 21495 perl5.8.8 RET read 1519/0x5ef 21495 perl5.8.8 CALL break(0x81fb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x81fc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8195000,0x1000) 21495 perl5.8.8 GIO fd 5 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x4,0x818f000,0x1000) 21495 perl5.8.8 GIO fd 4 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x4) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL __getcwd(0xbfbfe100,0x3ff) 21495 perl5.8.8 RET __getcwd 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL fstat(0x3,0xbfbfbea0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x3,0x818f000,0x1000) 21495 perl5.8.8 GIO fd 3 read 2648 bytes "use strict; use warnings; use Test::More tests => 1+3+46; BEGIN { use_ok('PAR::Repository') }; chdir('t') if -d 't'; use lib 'lib'; # requires 3 tests to boot require RepoTest; #$RepoTest::Debug = 1; my $tdir = RepoTest->TempDir; my $repodir = File::Spec->catdir($tdir, 'repo'); chdir($tdir); # create new repo, assert it's okay ok(!RepoTest->RunParrepo('create'), 'parrepo create did not die'); ok(-d $repodir, 'parrepo create created a repo dir'); RepoTest->TestRepoFilesExist($repodir); my $testDists = RepoTest->TestDists; my $parfile = 'Test-Kit-0.02-any_arch-any_version.par'; my @test_kit = grep /\\Q$parfile\\E/, @$testDists; ok(scalar(@test_kit) == 1, 'found exactly one Test-Kit dist for testin\ g'); #################### sub check_injection { my $file = shift || $parfile; my ($dn, $dv, $arch, $pv) = PAR::Dist::parse_dist_name($file); ok( -f File::Spec->catfile($repodir, $arch, $pv, $file), 'par was injected' ); # test whether the stuff is in the repository now my $repo = RepoTest->CanOpenRepo($repodir); is_deeply( $repo->query_module(regex => '^Test::Kit$'), [$file, '0.02'], ); is_deeply( $repo->query_dist(regex => '^Test-Kit'), [ $file, { 'Test::Kit' => '0.02', 'Test::Kit::Result' => '0.02', 'Test::Kit::Features' => '0.02', }, ] ); } #################### sub check_removal { my $file = shift || $parfile; my ($dn, $dv, $arch, $pv) = PAR::Dist::parse_dist_name($file); my $repo = RepoTest->CanOpenRepo($repodir); ok( !-f File::Spec->catfile($repodir, $arch, $pv, $file), 'par was removed' ); is_deeply( $repo->query_module(regex => '^Test::Kit$'), [], ); is_deeply( $repo->query_dist(regex => '^Test-Kit'), [] ); } # test injection and removal via parrepo ok(!RepoTest->RunParrepo('inject', '-f', $test_kit[0]), "parrepo didn'\ t complain about injection"); check_injection(); ok(!RepoTest->RunParrepo('remove', '-f', $parfile), 'no error from rem\ ove'); check_removal(); # now re-add it using the API my $repo = RepoTest->CanOpenRepo($repodir); ok($repo->inject('file', $test_kit[0]), "api injection succeeded"); check_injection(); ok ($repo->remove(file => $parfile), 'no error from remove'); check_removal(); # now use the api slightly differently SCOPE: { my $file = $parfile; $file =~ s/any_version/5.8.5/ or die; $file =~ s/any_arch/myarch/ or die; ok($repo->inject('file' => $test_kit[0], arch => 'myarch', perlversi\ on => '5.8.5'), "api injection succeeded"); check_injection($file); ok ($repo->remove(file => $file), 'no error from remove'); check_removal($file); } " 21495 perl5.8.8 RET read 2648/0xa58 21495 perl5.8.8 CALL stat(0x81ac800,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/More.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac780,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/More.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac800,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/More.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac780,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/More.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac800,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/More.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac780,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/More.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac800,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/More.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac780,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/More.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81ac880,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/More.pm" 21495 perl5.8.8 RET open 4 21495 perl5.8.8 CALL fstat(0x4,0xbfbfb8c0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "package Test::More; use 5.006; use strict; # Can't use Carp because it might cause use_ok() to accidentally succe\ ed # even though the module being used forgot to use Carp. Yes, this # actually happened. sub _carp { my($file, $line) = (caller(1))[1,2]; warn @_, " at $file line $line\\n"; } use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); $VERSION = '0.80'; $VERSION = eval $VERSION; # make the alpha version come out as a nu\ mber use Test::Builder::Module; @ISA = qw(Test::Builder::Module); @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply cmp_ok skip todo todo_skip pass fail eq_array eq_hash eq_set $TODO plan can_ok isa_ok diag BAIL_OUT ); =head1 NAME Test::More - yet another framework for writing test scripts =head1 SYNOPSIS use Test::More tests => 23; # or use Test::More qw(no_plan); # or use Test::More skip_all => $reason; BEGIN { use_ok( 'Some::Module' ); } require_ok( 'Some::Module' ); # Various ways to say "ok" ok($got eq $expected, $test_name); is ($got, $expected, $test_name); isnt($got, $expected, $test_name); # Rather than print STDERR "# here's what went wrong\\n" diag("here's what went wrong"); like ($got, qr/expected/, $test_name); unlike($got, qr/expected/, $test_name); cmp_ok($got, '==', $expected, $test_name); is_deeply($got_complex_structure, $expected_complex_structure, $test\ _name); SKIP: { skip $why, $how_many unless $have_some_feature; ok( foo(), $test_name ); is( foo(42), 23, $test_name ); }; TODO: { local $TODO = $why; ok( foo(), $test_name ); is( foo(42), 23, $test_name ); }; can_ok($module, @methods); isa_ok($object, $class); pass($test_name); fail($test_name); BAIL_OUT($why); # UNIMPLEMENTED!!! my @status = Test::More::status; =head1 DESCRIPTION B If you're just getting started writing tests, have a look at Test::Simple first. This is a drop in replacement for Test::Simple which you can switch to once you get the hang of basic testing. The purpose of this module is to provide a wide range of testing utilities. Various ways to say "ok" with better diagnostics, facilities to skip tests, test future features and compare complicated data structures. While you can do almost anything with a simple C function, it doesn't provide good diagnostic output. =head2 I love it when a plan comes together Before anything else, you need a testing plan. This basically declare\ s how many tests your script is going to run to protect against prematur\ e failure. The preferred way to do this is to declare a plan when you C. use Test::More tests => 23; There are rare cases when you will not know beforehand how many tests your script is going to run. In this case, you can declare that you have no plan. (Try to avoid using this as it weakens your test.) use Test::More qw(no_plan); B: using no_plan requires a Test::Harness upgrade else it will think everything has failed. See L). In some cases, you'll want to completely skip an entire testing script\ . use Test::More skip_all => $skip_reason; Your script will declare a skip with the reason why you skipped and exit immediately with a zero (success). See L for details. If you want to control what functions Test::More will export, you have to use the 'import' option. For example, to import everything but 'fail', you'd do: use Test::More tests => 23, import => ['!fail']; Alternatively, you can use the plan() function. Useful for when you have to calculate the number of tests. use Test::More; plan tests => keys %Stuff * 3; or for deciding between running the tests at all: use Test::More; if( $^O eq 'MacOS' ) { plan skip_all => 'Test irrelevant on MacOS'; } else { plan tests => 42; } =cut sub plan { my $tb = Test::More->builder; $tb->plan(@_)" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL lseek(0x4,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL stat(0x81acb00,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/Builder/Module.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca80,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/Builder/Module.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acb00,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/Builder/Module.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca80,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/Builder/Module.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acb00,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/Builder/Module.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca80,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/Builder/Module.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acb00,0xbfbfddc0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder/Module.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca80,0xbfbfdce0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder/Module.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81acb80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder/Module.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL break(0x81fd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x5,0xbfbfb2e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x81fe000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x81fd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 3976 bytes "package Test::Builder::Module; use strict; use Test::Builder; require Exporter; our @ISA = qw(Exporter); our $VERSION = '0.80'; # 5.004's Exporter doesn't have export_to_level. my $_export_to_level = sub { my $pkg = shift; my $level = shift; (undef) = shift; # redundant arg my $callpkg = caller($level); $pkg->export($callpkg, @_); }; =head1 NAME Test::Builder::Module - Base class for test modules =head1 SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1; =head1 DESCRIPTION This is a superclass for Test::Builder-based modules. It provides a handful of common functionality and a method of getting at the underly\ ing Test::Builder object. =head2 Importing Test::Builder::Module is a subclass of Exporter which means your module is also a subclass of Exporter. @EXPORT, @EXPORT_OK, etc... all act normally. A few methods are provided to do the C 23> p\ art for you. =head3 import Test::Builder::Module provides an import() method which acts in the same basic way as Test::More's, setting the plan and controling exporting of functions and variables. This allows your module to set the plan independent of Test::More. All arguments passed to import() are passed onto C<< Your::Module->builder->plan() >> with the exception of C[qw(things to import)]>. use Your::Module import => [qw(this that)], tests => 23; says to import the functions this() and that() as well as set the plan to be 23 tests. import() also sets the exported_to() attribute of your builder to be the caller of the import() function. Additional behaviors can be added to your import() method by overridin\ g import_extra(). =cut sub import { my($class) = shift; # Don't run all this when loading ourself. return 1 if $class eq 'Test::Builder::Module'; my $test = $class->builder; my $caller = caller; $test->exported_to($caller); $class->import_extra(\\@_); my(@imports) = $class->_strip_imports(\\@_); $test->plan(@_); $class->$_export_to_level(1, $class, @imports); } sub _strip_imports { my $class = shift; my $list = shift; my @imports = (); my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'import' ) { push @imports, @{$list->[$idx+1]}; $idx++; } else { push @other, $item; } $idx++; } @$list = @other; return @imports; } =head3 import_extra Your::Module->import_extra(\\@import_args); import_extra() is called by import(). It provides an opportunity for \ you to add behaviors to your module based on its import list. Any extra arguments which shouldn't be passed on to plan() should be stripped off by this method. See Test::More for an example of its use. B This mechanism is I as it feels like a bit of an ugly hack in its current form. =cut sub import_extra {} =head2 Builder Test::Builder::Module provides some methods of getting at the underlyi\ ng Test::Builder object. =head3 builder my $builder = Your::Class->builder; This method returns the Test::Builder object associated with Your::Cla\ ss. It is not a constructor so you can call it as often as you like. This is the preferred way to get the Test::Builder object. You should I get it via C<< Test::Builder->new >> as was previously recommended. The object returned by builder() may change at runtime so you should call builder() inside each function rather than store it in a global. sub ok { my $builder = Your::Class->builder; return $builder->ok(@_); } =cut sub builder { return Test::Builder->new; } 1; " 21495 perl5.8.8 RET read 3976/0xf88 21495 perl5.8.8 CALL break(0x81ff000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 3976/0xf88 21495 perl5.8.8 CALL break(0x8200000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x81ace00,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/Builder.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acd80,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Test/Builder.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ace00,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/Builder.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acd80,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Test/Builder.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ace00,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/Builder.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acd80,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Test/Builder.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ace00,0xbfbfd7e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81acd80,0xbfbfd700) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81ace80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Test/Builder.pm" 21495 perl5.8.8 RET open 6 21495 perl5.8.8 CALL break(0x8201000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x6,0xbfbfad00) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8202000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes "package Test::Builder; use 5.006; use strict; our $VERSION = '0.80'; $VERSION = eval { $VERSION }; # make the alpha version come out as a n\ umber # Make Test::Builder thread-safe for ithreads. BEGIN { use Config; # Load threads::shared when threads are turned on. # 5.8.0's threads are so busted we no longer support them. if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) \ { require threads::shared; # Hack around YET ANOTHER threads::shared bug. It would # occassionally forget the contents of the variable when shari\ ng it. # So we first copy the data, then share, then put our copy bac\ k. *share = sub (\\[$@%]) { my $type = ref $_[0]; my $data; if( $type eq 'HASH' ) { %$data = %{$_[0]}; } elsif( $type eq 'ARRAY' ) { @$data = @{$_[0]}; } elsif( $type eq 'SCALAR' ) { $$data = ${$_[0]}; } else { die("Unknown type: ".$type); } $_[0] = &threads::shared::share($_[0]); if( $type eq 'HASH' ) { %{$_[0]} = %$data; } elsif( $type eq 'ARRAY' ) { @{$_[0]} = @$data; } elsif( $type eq 'SCALAR' ) { ${$_[0]} = $$data; } else { die("Unknown type: ".$type); } return $_[0]; }; } # 5.8.0's threads::shared is busted when threads are off # and earlier Perls just don't have that module at all. else { *share = sub { return $_[0] }; *lock = sub { 0 }; } } =head1 NAME Test::Builder - Backend for building test libraries =head1 SYNOPSIS package My::Test::Module; use base 'Test::Builder::Module'; my $CLASS = __PACKAGE__; sub ok { my($test, $name) = @_; my $tb = $CLASS->builder; $tb->ok($test, $name); } =head1 DESCRIPTION Test::Simple and Test::More have proven to be popular testing modules, but they're not always flexible enough. Test::Builder provides the a building block upon which to write your own test libraries I. =head2 Construction =over 4 =item B my $Test = Test::Builder->new; Returns a Test::Builder object representing the current state of the test. Since you only run one test per program C always returns the same Test::Builder object. No matter how many times you call new(), you're getting the same object. This is called a singleton. This is done so\ that multiple modules share such global information as the test counter and where test output is going. If you want a completely new Test::Builder object different from the singleton, use C. =cut my $Test = Test::Builder->new; sub new { my($class) = shift; $Test ||= $class->create; return $Test; } =item B my $Test = Test::Builder->create; Ok, so there can be more than one Test::Builder object and this is how you get it. You might use this instead of C if you're testing a Test::Builder based module, but otherwise you probably want C. B: the implementation is not complete. C, for example, i\ s still shared amongst B Test::Builder objects, even ones created u\ sing this method. Also, the method name may change in the future. =cut sub create { my $class = shift; my $self = bless {}, $class; $self->reset; return $self; } =item B $Test->reset; Reinitializes the Test::Builder singleton to its original state. Mostly useful for tests run in persistent environments where the same test might be run multiple times in the same process. =cut use vars qw($Level); sub reset { my ($self) = @_; # We leave this a global because it has to be localized and locali\ zing # hash keys is just asking for pain. Also, it was documented. $Level = 1; $self->{Have_Plan} = 0; $self->{No_Plan} = 0; $self->{Original_Pid} = $$; " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8204000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x6,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL stat(0x8200100,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Config.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8200080,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Config.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8200100,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Config.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8200080,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Config.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8200100,0xbfbfd200) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Config.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8200080,0xbfbfd120) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Config.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8200180,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Config.pm" 21495 perl5.8.8 RET open 7 21495 perl5.8.8 CALL break(0x8205000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8206000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x7,0xbfbfa720) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8207000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x8206000,0x1000) 21495 perl5.8.8 GIO fd 7 read 2729 bytes "# This file was created by configpm when Perl was built. Any changes # made to this file will be lost the next time perl is built. package Config; use strict; # use warnings; Pulls in Carp # use vars pulls in Carp @Config::EXPORT = qw(%Config); @Config::EXPORT_OK = qw(myconfig config_sh config_vars config_re); # Need to stub all the functions to make code such as print Config::co\ nfig_sh # keep working sub myconfig; sub config_sh; sub config_vars; sub config_re; my %Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_O\ K); our %Config; # Define our own import method to avoid pulling in the full Exporter: sub import { my $pkg = shift; @_ = @Config::EXPORT unless @_; my @funcs = grep $_ ne '%Config', @_; my $export_Config = @funcs < @_ ? 1 : 0; no strict 'refs'; my $callpkg = caller(0); foreach my $func (@funcs) { die sprintf qq{"%s" is not exported by the %s module\\n}, $func, __PACKAGE__ unless $Export_Cache{$func}; *{$callpkg.'::'.$func} = \\&{$func}; } *{"$callpkg\\::Config"} = \\%Config if $export_Config; return; } die "Perl lib version (v5.8.8) doesn't match executable version ($])" unless $^V; $^V eq v5.8.8 or die "Perl lib version (v5.8.8) doesn't match executable version\ (" . sprintf("v%vd",$^V) . ")"; sub FETCH { my($self, $key) = @_; # check for cached value (which may be undef so we use exists not \ defined) return $self->{$key} if exists $self->{$key}; return $self->fetch_string($key); } sub TIEHASH { bless $_[1], $_[0]; } sub DESTROY { } sub AUTOLOAD { require 'Config_heavy.pl'; goto \\&launcher unless $Config::AUTOLOAD =~ /launcher$/; die "&Config::AUTOLOAD failed on $Config::AUTOLOAD"; } # tie returns the object, so the value returned to require will be tru\ e. tie %Config, 'Config', { archlibexp => '/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.\ 8.8/i386-freebsd-64int', archname => 'i386-freebsd-64int', cc => 'ccache gcc', d_readlink => 'define', d_symlink => 'define', dlsrc => 'dl_dlopen.xs', dont_use_nlink => undef, exe_ext => '', inc_version_list => '', intsize => '4', ldlibpthname => 'LD_LIBRARY_PATH', libpth => '/usr/lib /usr/local/lib', osname => 'freebsd', osvers => '6.0-stable', path_sep => ':', privlibexp => '/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.\ 8.8', scriptdir => '~/Sandpit/snap5.9.x-34591/bin', sitearchexp => '/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/s\ ite_perl/5.8.8/i386-freebsd-64int', sitelibexp => '/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/si\ te_perl/5.8.8', useithreads => undef, usevendorprefix => undef, version => '5.8.8', }; " 21495 perl5.8.8 RET read 2729/0xaa9 21495 perl5.8.8 CALL break(0x8208000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x7,0,0,0,0x1) 21495 perl5.8.8 RET lseek 2729/0xaa9 21495 perl5.8.8 CALL break(0x8209000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x820f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x7,0x8206000,0x1000) 21495 perl5.8.8 GIO fd 7 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x7) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " share($self->{Curr_Test}); $self->{Curr_Test} = 0; $self->{Test_Results} = &share([]); $self->{Exported_To} = undef; $self->{Expected_Tests} = 0; $self->{Skip_All} = 0; $self->{Use_Nums} = 1; $self->{No_Header} = 0; $self->{No_Ending} = 0; $self->{TODO} = undef; $self->_dup_stdhandles unless $^C; return; } =back =head2 Setting up tests These methods are for setting up tests and declaring how many there are. You usually only want to call one of these methods. =over 4 =item B $Test->plan('no_plan'); $Test->plan( skip_all => $reason ); $Test->plan( tests => $num_tests ); A convenient way to set up your tests. Call this and Test::Builder will print the appropriate headers and take the appropriate actions. If you call plan(), don't call any of the other methods below. =cut sub plan { my($self, $cmd, $arg) = @_; return unless $cmd; local $Level = $Level + 1; if( $self->{Have_Plan} ) { $self->croak("You tried to plan twice"); } if( $cmd eq 'no_plan' ) { $self->no_plan; } elsif( $cmd eq 'skip_all' ) { return $self->skip_all($arg); } elsif( $cmd eq 'tests' ) { if( $arg ) { local $Level = $Level + 1; return $self->expected_tests($arg); } elsif( !defined $arg ) { $self->croak("Got an undefined number of tests"); } elsif( !$arg ) { $self->croak("You said to run 0 tests"); } } else { my @args = grep { defined } ($cmd, $arg); $self->croak("plan() doesn't understand @args"); } return 1; } =item B my $max = $Test->expected_tests; $Test->expected_tests($max); Gets/sets the # of tests we expect this test to run and prints out the appropriate headers. =cut sub expected_tests { my $self = shift; my($max) = @_; if( @_ ) { $self->croak("Number of tests must be a positive integer. You\ gave it '$max'") unless $max =~ /^\\+?\\d+$/ and $max > 0; $self->{Expected_Tests} = $max; $self->{Have_Plan} = 1; $self->_print("1..$max\\n") unless $self->no_header; } return $self->{Expected_Tests}; } =item B $Test->no_plan; Declares that this test will run an indeterminate # of tests. =cut sub no_plan { my $self = shift; $self->{No_Plan} = 1; $self->{Have_Plan} = 1; } =item B $plan = $Test->has_plan Find out whether a plan has been defined. $plan is either C (no\ plan has been set), C (indeterminate # of tests) or an integ\ er (the number of expected tests). =cut sub has_plan { my $self = shift; return($self->{Expected_Tests}) if $self->{Expected_Tests}; return('no_plan') if $self->{No_Plan}; return(undef); }; =item B $Test->skip_all; $Test->skip_all($reason); Skips all the tests, using the given $reason. Exits immediately with \ 0. =cut sub skip_all { my($self, $reason) = @_; my $out = "1..0"; $out .= " # Skip $reason" if $reason; $out .= "\\n"; $self->{Skip_All} = 1; $self->_print($out) unless $self->no_header; exit(0); } =item B my $pack = $Test->exported_to; $Test->exported_to($pack); Tells Test::Builder what package you exported your functions to. This method isn't terribly useful since modules which share the same Test::Builder object might get exported to different packages and only the last one will be honored. =cut sub exported_to { my($self, $pack) = @_; if( defined $pack ) { $self->{Exported_To} = $pack; } return $self->{Exported_To}; } =back =head2 Running tests These actually run the tests, analogous to the functions in Test::More\ . They all return true if the test passed, false if the test failed. $name is always optional. =over 4 =item B $Test->ok($test, $name); Your basic test. Pass if $test is true, fail if $test is false. Just like Test::Simple's ok(). =cut sub ok { " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8210000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8211000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8212000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8213000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " my($self, $test, $name) = @_; # $test might contain an object which we don't want to accidentall\ y # store, so we turn it into a boolean. $test = $test ? 1 : 0; $self->_plan_check; lock $self->{Curr_Test}; $self->{Curr_Test}++; # In case $name is a string overloaded object, force it to stringi\ fy. $self->_unoverload_str(\\$name); $self->diag(<todo(); # Capture the value of $TODO for the rest of this ok() call # so it can more easily be found by other routines. local $self->{TODO} = $todo; $self->_unoverload_str(\\$todo); my $out; my $result = &share({}); unless( $test ) { $out .= "not "; @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 ); } else { @$result{ 'ok', 'actual_ok' } = ( 1, $test ); } $out .= "ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; if( defined $name ) { $name =~ s|#|\\\\#|g; # # in a name can confuse Test::Harn\ ess. $out .= " - $name"; $result->{name} = $name; } else { $result->{name} = ''; } if( $todo ) { $out .= " # TODO $todo"; $result->{reason} = $todo; $result->{type} = 'todo'; } else { $result->{reason} = ''; $result->{type} = ''; } $self->{Test_Results}[$self->{Curr_Test}-1] = $result; $out .= "\\n"; $self->_print($out); unless( $test ) { my $msg = $todo ? "Failed (TODO)" : "Failed"; $self->_print_diag("\\n") if $ENV{HARNESS_ACTIVE}; my(undef, $file, $line) = $self->caller; if( defined $name ) { $self->diag(qq[ $msg test '$name'\\n]); $self->diag(qq[ at $file line $line.\\n]); } else { $self->diag(qq[ $msg test at $file line $line.\\n]); } } return $test ? 1 : 0; } sub _unoverload { my $self = shift; my $type = shift; $self->_try(sub { require overload } ) || return; foreach my $thing (@_) { if( $self->_is_object($$thing) ) { if( my $string_meth = overload::Method($$thing, $type) ) { $$thing = $$thing->$string_meth(); } } } } sub _is_object { my($self, $thing) = @_; return $self->_try(sub { ref $thing && $thing->isa('UNIVERSAL') })\ ? 1 : 0; } sub _unoverload_str { my $self = shift; $self->_unoverload(q[""], @_); } sub _unoverload_num { my $self = shift; $self->_unoverload('0+', @_); for my $val (@_) { next unless $self->_is_dualvar($$val); $$val = $$val+0; } } # This is a hack to detect a dualvar such as $! sub _is_dualvar { my($self, $val) = @_; local $^W = 0; my $numval = $val+0; return 1 if $numval != 0 and $numval ne $val; } =item B $Test->is_eq($got, $expected, $name); Like Test::More's is(). Checks if $got eq $expected. This is the string version. =item B $Test->is_num($got, $expected, $name); Like Test::More's is(). Checks if $got == $expected. This is the numeric version. =cut sub is_eq { my($self, $got, $expect, $name) = @_; local $Level = $Level + 1; $self->_unoverload_str(\\$got, \\$expect); if( !defined $got || !defined $expect ) { # undef only matches undef and nothing else my $test = !defined $got && !defined $expect; $self->ok($test, $name); $self->_is_diag($got, 'eq', $expect) unless $test; return $test; } return $self->cmp_ok($got, 'eq', $expect, $name); } sub is_num { my($self, $got, $expect, $name) = @_; local $Level = $Level + 1; $self->_unoverload_num(\\$got, \\$expect); if( !defined $got || !defined $expect ) { # undef only matches undef and nothing else my $test = !defined $got && !defined $expect; $self->ok($test, $name); $self->_is_" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8214000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8215000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8216000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8217000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8218000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8219000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x821a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x821b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x821c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x821d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x821e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes "diag($got, '==', $expect) unless $test; return $test; } return $self->cmp_ok($got, '==', $expect, $name); } sub _is_diag { my($self, $got, $type, $expect) = @_; foreach my $val (\\$got, \\$expect) { if( defined $$val ) { if( $type eq 'eq' ) { # quote and force string context $$val = "'$$val'" } else { # force numeric context $self->_unoverload_num($val); } } else { $$val = 'undef'; } } local $Level = $Level + 1; return $self->diag(sprintf < $Test->isnt_eq($got, $dont_expect, $name); Like Test::More's isnt(). Checks if $got ne $dont_expect. This is the string version. =item B $Test->isnt_num($got, $dont_expect, $name); Like Test::More's isnt(). Checks if $got ne $dont_expect. This is the numeric version. =cut sub isnt_eq { my($self, $got, $dont_expect, $name) = @_; local $Level = $Level + 1; if( !defined $got || !defined $dont_expect ) { # undef only matches undef and nothing else my $test = defined $got || defined $dont_expect; $self->ok($test, $name); $self->_cmp_diag($got, 'ne', $dont_expect) unless $test; return $test; } return $self->cmp_ok($got, 'ne', $dont_expect, $name); } sub isnt_num { my($self, $got, $dont_expect, $name) = @_; local $Level = $Level + 1; if( !defined $got || !defined $dont_expect ) { # undef only matches undef and nothing else my $test = defined $got || defined $dont_expect; $self->ok($test, $name); $self->_cmp_diag($got, '!=', $dont_expect) unless $test; return $test; } return $self->cmp_ok($got, '!=', $dont_expect, $name); } =item B $Test->like($this, qr/$regex/, $name); $Test->like($this, '/$regex/', $name); Like Test::More's like(). Checks if $this matches the given $regex. You'll want to avoid qr// if you want your tests to work before 5.005. =item B $Test->unlike($this, qr/$regex/, $name); $Test->unlike($this, '/$regex/', $name); Like Test::More's unlike(). Checks if $this B the given $regex. =cut sub like { my($self, $this, $regex, $name) = @_; local $Level = $Level + 1; $self->_regex_ok($this, $regex, '=~', $name); } sub unlike { my($self, $this, $regex, $name) = @_; local $Level = $Level + 1; $self->_regex_ok($this, $regex, '!~', $name); } =item B $Test->cmp_ok($this, $type, $that, $name); Works just like Test::More's cmp_ok(). $Test->cmp_ok($big_num, '!=', $other_big_num); =cut my %numeric_cmps = map { ($_, 1) } ("<", "<=", ">", ">=", "==", "!=", "<=>"); sub cmp_ok { my($self, $got, $type, $expect, $name) = @_; # Treat overloaded objects as numbers if we're asked to do a # numeric comparison. my $unoverload = $numeric_cmps{$type} ? '_unoverload_num' : '_unoverload_str'; $self->$unoverload(\\$got, \\$expect); my $test; { local($@,$!,$SIG{__DIE__}); # isolate eval my $code = $self->_caller_context; # Yes, it has to look like this or 5.4.5 won't see the #line # directive. # Don't ask me, man, I just work here. $test = eval " $code" . "\\$got $type \\$expect;"; } local $Level = $Level + 1; my $ok = $self->ok($test, $name); unless( $ok ) { if( $type =~ /^(eq|==)$/ ) { $self->_is_diag($got, $type, $expect); } else { $self->_cmp_diag($got, $type, $expect); } } return $ok; } sub _cmp_diag { my($self, $got, $type, $expect) = @_; $got = defined $got ? "'$got'" : 'undef'; $expect = defined $expect ? "'$expect'" : 'undef'; local $Level = $Level + 1; return $self->diag(sprintf <caller(1); my $code = ''; $code .= "#line $line $file\\n" if defined $file and defined $line\ ; return $code; } =back =head2 Other Testing Methods These are methods which are used in the course of writing a test but a\ re not themselves tests. =over 4 =item B $Test->BAIL_OUT($reason); Indicates to the Test::Harness that things are going so badly all testing should terminate. This includes running any additional test scripts. It will exit with 255. =cut sub BAIL_OUT { my($self, $reason) = @_; $self->{Bailed_Out} = 1; $self->_print("Bail out! $reason"); exit 255; } =for deprecated BAIL_OUT() used to be BAILOUT() =cut *BAILOUT = \\&BAIL_OUT; =item B $Test->skip; $Test->skip($why); Skips the current test, reporting $why. =cut sub skip { my($self, $why) = @_; $why ||= ''; $self->_unoverload_str(\\$why); $self->_plan_check; lock($self->{Curr_Test}); $self->{Curr_Test}++; $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ 'ok' => 1, actual_ok => 1, name => '', type => 'skip', reason => $why, }); my $out = "ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # skip"; $out .= " $why" if length $why; $out .= "\\n"; $self->_print($out); return 1; } =item B $Test->todo_skip; $Test->todo_skip($why); Like skip(), only it will declare the test as failing and TODO. Simil\ ar to print "not ok $tnum # TODO $why\\n"; =cut sub todo_skip { my($self, $why) = @_; $why ||= ''; $self->_plan_check; lock($self->{Curr_Test}); $self->{Curr_Test}++; $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ 'ok' => 1, actual_ok => 0, name => '', type => 'todo_skip', reason => $why, }); my $out = "not ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # TODO & SKIP $why\\n"; $self->_print($out); return 1; } =begin _unimplemented =item B $Test->skip_rest; $Test->skip_rest($reason); Like skip(), only it skips all the rest of the tests you plan to run and terminates the test. If you're running under no_plan, it skips once and terminates the test. =end _unimplemented =back =head2 Test building utility methods These methods are useful when writing your own test methods. =over 4 =item B $Test->maybe_regex(qr/$regex/); $Test->maybe_regex('/$regex/'); Convenience method for building testing functions that take regular expressions as arguments, but need to work before perl 5.005. Takes a quoted regular expression produced by qr//, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding regular expression, or undef if it's argument is not recognised. For example, a version of like(), sans the useful diagnostic messages, could be written as: sub laconic_like { my ($self, $this, $regex, $name) = @_; my $usable_regex = $self->maybe_regex($regex); die "expecting regex, found '$regex'\\n" unless $usable_regex; $self->ok($this =~ m/$usable_regex/, $name); } =cut sub maybe_regex { my ($self, $regex) = @_; my $usable_regex = undef; return $usable_regex unless defined $regex; my($re, $opts); # Check for qr/foo/ if( _is_qr($regex) ) { $usable_regex = $regex; } # Check for '/foo/' or 'm,foo,' elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\\w*) $ }sx \ or (undef, $re, $opts) = $regex =~ m,^ m([^\\w\\s]) (.+) \\1 (\ \\w*) $,sx ) { $usable_regex = length $opts ? "(?$opts)$re" : $re; } return $usable_regex; } sub _is_qr { my $regex = shift; # is_regexp() checks for regexes in a robust manner, say if they'r\ e #" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8228000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8229000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x822a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x822b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x822c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x822d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x822e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " blessed. return re::is_regexp($regex) if defined &re::is_regexp; return ref $regex eq 'Regexp'; } sub _regex_ok { my($self, $this, $regex, $cmp, $name) = @_; my $ok = 0; my $usable_regex = $self->maybe_regex($regex); unless (defined $usable_regex) { $ok = $self->ok( 0, $name ); $self->diag(" '$regex' doesn't look much like a regex to me\ ."); return $ok; } { my $test; my $code = $self->_caller_context; local($@, $!, $SIG{__DIE__}); # isolate eval # Yes, it has to look like this or 5.4.5 won't see the #line # directive. # Don't ask me, man, I just work here. $test = eval " $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; $test = !$test if $cmp eq '!~'; local $Level = $Level + 1; $ok = $self->ok( $test, $name ); } unless( $ok ) { $this = defined $this ? "'$this'" : 'undef'; my $match = $cmp eq '=~' ? "doesn't match" : "matches"; local $Level = $Level + 1; $self->diag(sprintf < my $return_from_code = $Test->try(sub { code }); my($return_from_code, $error) = $Test->try(sub { code }); Works like eval BLOCK except it ensures it has no effect on the rest o\ f the test (ie. $@ is not set) nor is effected by outside interference\ (ie. $SIG{__DIE__}) and works around some quirks in older Perls. $error is what would normally be in $@. It is suggested you use this in place of eval BLOCK. =cut sub _try { my($self, $code) = @_; local $!; # eval can mess up $! local $@; # don't set $@ in the test local $SIG{__DIE__}; # don't trip an outside DIE handler. my $return = eval { $code->() }; return wantarray ? ($return, $@) : $return; } =end private =item B my $is_fh = $Test->is_fh($thing); Determines if the given $thing can be used as a filehandle. =cut sub is_fh { my $self = shift; my $maybe_fh = shift; return 0 unless defined $maybe_fh; return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref return 1 if ref \\$maybe_fh eq 'GLOB'; # its a glob return eval { $maybe_fh->isa("IO::Handle") } || # 5.5.4's tied() and can() doesn't like getting undef eval { (tied($maybe_fh) || '')->can('TIEHANDLE') }; } =back =head2 Test style =over 4 =item B $Test->level($how_high); How far up the call stack should $Test look when reporting where the test failed. Defaults to 1. Setting L<$Test::Builder::Level> overrides. This is typically useful localized: sub my_ok { my $test = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; $TB->ok($test); } To be polite to other functions wrapping your own you usually want to \ increment C<$Level> rather than set it to a constant. =cut sub level { my($self, $level) = @_; if( defined $level ) { $Level = $level; } return $Level; } =item B $Test->use_numbers($on_or_off); Whether or not the test should output numbers. That is, this if true: ok 1 ok 2 ok 3 or this if false ok ok ok Most useful when you can't depend on the test output order, such as when threads or forking is involved. Defaults to on. =cut sub use_numbers { my($self, $use_nums) = @_; if( defined $use_nums ) { $self->{Use_Nums} = $use_nums; } return $self->{Use_Nums}; } =item B $Test->no_diag($no_diag); If set true no diagnostics will be printed. This includes calls to diag(). =item B $Test->no_ending($no_ending); Normally, Test::Builder does some extra diagnostics when the test ends. It also changes the exit code as described below. If this is true, none of that will be done. =item B $Test->no_header($no_header); If set to true, no "1..N" header will be printed. =cut foreach my $attribute (qw(No_Header No_Ending No_Diag)) { my $method = lc $attribute; my $code = sub { my($self, $no) = @_; if( defined $no ) { $self->{$attribute} = $no; } return $self->{$attribute}; }; no strict 'refs'; ## no critic *{__PACKAGE__.'::'.$method} = $code; } =back =head2 Output Controlling where the test output goes. It's ok for your test to change where STDOUT and STDERR point to, Test::Builder's default output settings will not be affected. =over 4 =item B $Test->diag(@msgs); Prints out the given @msgs. Like C, arguments are simply appended together. Normally, it uses the failure_output() handle, but if this is for a TODO test, the todo_output() handle is used. Output will be indented and marked with a # so as not to interfere with test output. A newline will be put on the end if there isn't one already. We encourage using this rather than calling print directly. Returns false. Why? Because diag() is often used in conjunction with a failing test (C) it "passes through" the failure. return ok(...) || diag(...); =for blame transfer Mark Fowler =cut sub diag { my($self, @msgs) = @_; return if $self->no_diag; return unless @msgs; # Prevent printing headers when compiling (i.e. -c) return if $^C; # Smash args together like print does. # Convert undef to 'undef' so its readable. my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; # Escape each line with a #. $msg =~ s/^/# /gm; # Stick a newline on the end if it needs it. $msg .= "\\n" unless $msg =~ /\\n\\Z/; local $Level = $Level + 1; $self->_print_diag($msg); return 0; } =begin _private =item B<_print> $Test->_print(@msgs); Prints to the output() filehandle. =end _private =cut sub _print { my($self, @msgs) = @_; # Prevent printing headers when only compiling. Mostly for when # tests are deparsed with B::Deparse return if $^C; my $msg = join '', @msgs; local($\\, $", $,) = (undef, ' ', ''); my $fh = $self->output; # Escape each line after the first with a # so we don't # confuse Test::Harness. $msg =~ s/\\n(.)/\\n# $1/sg; # Stick a newline on the end if it needs it. $msg .= "\\n" unless $msg =~ /\\n\\Z/; print $fh $msg; } =begin private =item B<_print_diag> $Test->_print_diag(@msg); Like _print, but prints to the current diagnostic filehandle. =end private =cut sub _print_diag { my $self = shift; local($\\, $", $,) = (undef, ' ', ''); my $fh = $self->todo ? $self->todo_output : $self->failure_output; print $fh @_; } =item B $Test->output($fh); $Test->output($file); Where normal "ok/not ok" test output should go. Defaults to STDOUT. =item B $Test->failure_output($fh); $Test->failure_output($file); Where diagnostic output on test failures and diag() should go. Defaults to STDERR. =item B $Test->todo_output($fh); $Test->todo_output($file); Where diagnostics about todo test failures and diag() should go. Defaults to STDOUT. =cut sub output { my($self, $fh) = @_; if( defined $fh ) { $self->{Out_FH} = $self->_new_fh($fh); } return $self->{Out_FH}; } sub failure_output { my($self, $fh) = @_; if( defined $fh ) { $self->{Fail_FH} = $self->_new_fh($fh); } return $self->{Fail_FH}; } sub todo_output { my($self, $fh) = @_; if( defined $fh ) { $self->{Todo_FH} = $self->_new_fh($fh); } return $self->{Todo_FH}; } sub _new_fh { my $self = shift; my($file_or_fh) = shift; my $fh; if( $self->is_fh($file_or_fh) ) { $fh = $file_or_fh; } else { open $fh, ">", $file_or_fh or $self->croak("Can't open test output log $file_or_fh: $!")\ ; _autoflush($fh); } " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8233000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8234000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8235000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8236000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8237000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8238000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8239000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " return $fh; } sub _autoflush { my($fh) = shift; my $old_fh = select $fh; $| = 1; select $old_fh; } my($Testout, $Testerr); sub _dup_stdhandles { my $self = shift; $self->_open_testhandles; # Set everything to unbuffered else plain prints to STDOUT will # come out in the wrong order from our own prints. _autoflush($Testout); _autoflush(\\*STDOUT); _autoflush($Testerr); _autoflush(\\*STDERR); $self->output ($Testout); $self->failure_output($Testerr); $self->todo_output ($Testout); } my $Opened_Testhandles = 0; sub _open_testhandles { my $self = shift; return if $Opened_Testhandles; # We dup STDOUT and STDERR so people can change them in their # test suites while still getting normal test output. open( $Testout, ">&STDOUT") or die "Can't dup STDOUT: $!"; open( $Testerr, ">&STDERR") or die "Can't dup STDERR: $!"; # $self->_copy_io_layers( \\*STDOUT, $Testout ); # $self->_copy_io_layers( \\*STDERR, $Testerr ); $Opened_Testhandles = 1; } sub _copy_io_layers { my($self, $src, $dst) = @_; $self->_try(sub { require PerlIO; my @src_layers = PerlIO::get_layers($src); binmode $dst, join " ", map ":$_", @src_layers if @src_layers; }); } =item carp $tb->carp(@message); Warns with C<@message> but the message will appear to come from the point where the original test function was called (C<$tb->caller>). =item croak $tb->croak(@message); Dies with C<@message> but the message will appear to come from the point where the original test function was called (C<$tb->caller>). =cut sub _message_at_caller { my $self = shift; local $Level = $Level + 1; my($pack, $file, $line) = $self->caller; return join("", @_) . " at $file line $line.\\n"; } sub carp { my $self = shift; warn $self->_message_at_caller(@_); } sub croak { my $self = shift; die $self->_message_at_caller(@_); } sub _plan_check { my $self = shift; unless( $self->{Have_Plan} ) { local $Level = $Level + 2; $self->croak("You tried to run a test without a plan"); } } =back =head2 Test Status and Info =over 4 =item B my $curr_test = $Test->current_test; $Test->current_test($num); Gets/sets the current test number we're on. You usually shouldn't have to set this. If set forward, the details of the missing tests are filled in as 'unk\ nown'. if set backward, the details of the intervening tests are deleted. Yo\ u can erase history if you really want to. =cut sub current_test { my($self, $num) = @_; lock($self->{Curr_Test}); if( defined $num ) { unless( $self->{Have_Plan} ) { $self->croak("Can't change the current test number without\ a plan!"); } $self->{Curr_Test} = $num; # If the test counter is being pushed forward fill in the deta\ ils. my $test_results = $self->{Test_Results}; if( $num > @$test_results ) { my $start = @$test_results ? @$test_results : 0; for ($start..$num-1) { $test_results->[$_] = &share({ 'ok' => 1, actual_ok => undef, reason => 'incrementing test number', type => 'unknown', name => undef }); } } # If backward, wipe history. Its their funeral. elsif( $num < @$test_results ) { $#{$test_results} = $num - 1; } } return $self->{Curr_Test}; } =item B my @tests = $Test->summary; A simple summary of the tests so far. True for pass, false for fail. This is a logical pass/fail, so todos are passes. Of course, test #1 is $tests[0], etc... =cut sub summary { my($self) = shift; return map { $_->{'ok'} } @{ $self->{Test_Results} }; } =item B
my @tests = $Test->details; Like summary(), but with a lot more detail. $tests[$test_num - 1] = " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x823a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x823b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x823c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x823d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x823e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x823f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8240000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " { 'ok' => is the test considered a pass? actual_ok => did it literally say 'ok'? name => name of the test (if any) type => type of test (if any, see below). reason => reason for the above (if any) }; 'ok' is true if Test::Harness will consider the test to be a pass. 'actual_ok' is a reflection of whether or not the test literally printed 'ok' or 'not ok'. This is for examining the result of 'todo' tests. 'name' is the name of the test. 'type' indicates if it was a special test. Normal tests have a type of ''. Type can be one of the following: skip see skip() todo see todo() todo_skip see todo_skip() unknown see below Sometimes the Test::Builder test counter is incremented without it printing any test output, for example, when current_test() is changed. In these cases, Test::Builder doesn't know the result of the test, so it's type is 'unkown'. These details for these tests are filled in. They are considered ok, but the name and actual_ok is left undef. For example "not ok 23 - hole count # TODO insufficient donuts" would result in this structure: $tests[22] = # 23 - 1, since arrays start from 0. { ok => 1, # logically, the test passed since it's todo actual_ok => 0, # in absolute terms, it failed name => 'hole count', type => 'todo', reason => 'insufficient donuts' }; =cut sub details { my $self = shift; return @{ $self->{Test_Results} }; } =item B my $todo_reason = $Test->todo; my $todo_reason = $Test->todo($pack); todo() looks for a $TODO variable in your tests. If set, all tests will be considered 'todo' (see Test::More and Test::Harness for details). Returns the reason (ie. the value of $TODO) if running as todo tests, false otherwise. todo() is about finding the right package to look for $TODO in. It's pretty good at guessing the right package to look at. It first looks \ for the caller based on C<$Level + 1>, since C is usually called i\ nside a test function. As a last resort it will use C. Sometimes there is some confusion about where todo() should be looking for the $TODO variable. If you want to be sure, tell it explicitly what $pack to use. =cut sub todo { my($self, $pack) = @_; return $self->{TODO} if defined $self->{TODO}; $pack = $pack || $self->caller(1) || $self->exported_to; return 0 unless $pack; no strict 'refs'; ## no critic return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'} : 0; } =item B my $package = $Test->caller; my($pack, $file, $line) = $Test->caller; my($pack, $file, $line) = $Test->caller($height); Like the normal caller(), except it reports according to your level(). C<$height> will be added to the level(). =cut sub caller { my($self, $height) = @_; $height ||= 0; my @caller = CORE::caller($self->level + $height + 1); return wantarray ? @caller : $caller[0]; } =back =cut =begin _private =over 4 =item B<_sanity_check> $self->_sanity_check(); Runs a bunch of end of test sanity checks to make sure reality came through ok. If anything is wrong it will die with a fairly friendly error message. =cut #'# sub _sanity_check { my $self = shift; $self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negativ\ e number of tests!'); $self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test}, 'Somehow your tests ran without a plan!'); $self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} }, 'Somehow you got a different number of results than tests ra\ n!'); } =item B<_whoa> $self->_whoa($check, $description); A sanity check, similar to assert(). If the $check is true, something has gone horribly wrong. It will die with the given $description and a note to contact the author. =cut sub _whoa { my($self, $check, $desc) = @_; if( $check ) { local $Level =" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8241000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8242000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8243000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 4096 bytes " $Level + 1; $self->croak(<<"WHOA"); WHOA! $desc This should never happen! Please contact the author immediately! WHOA } } =item B<_my_exit> _my_exit($exit_num); Perl seems to have some trouble with exiting inside an END block. 5.0\ 05_03 and 5.6.1 both seem to do odd things. Instead, this function edits $? directly. It should ONLY be called from inside an END block. It doesn't actually exit, that's your job. =cut sub _my_exit { $? = $_[0]; return 1; } =back =end _private =cut sub _ending { my $self = shift; my $real_exit_code = $?; $self->_sanity_check(); # Don't bother with an ending if this is a forked copy. Only the \ parent # should do the ending. if( $self->{Original_Pid} != $$ ) { return; } # Exit if plan() was never called. This is so "require Test::Simp\ le" # doesn't puke. if( !$self->{Have_Plan} ) { return; } # Don't do an ending if we bailed out. if( $self->{Bailed_Out} ) { return; } # Figure out if we passed or failed and print helpful messages. my $test_results = $self->{Test_Results}; if( @$test_results ) { # The plan? We have no plan. if( $self->{No_Plan} ) { $self->_print("1..$self->{Curr_Test}\\n") unless $self->no\ _header; $self->{Expected_Tests} = $self->{Curr_Test}; } # Auto-extended arrays and elements which aren't explicitly # filled in with a shared reference will puke under 5.8.0 # ithreads. So we have to fill them in by hand. :( my $empty_result = &share({}); for my $idx ( 0..$self->{Expected_Tests}-1 ) { $test_results->[$idx] = $empty_result unless defined $test_results->[$idx]; } my $num_failed = grep !$_->{'ok'}, @{$test_results}[0..$self->{Curr_Test}-1\ ]; my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; if( $num_extra < 0 ) { my $s = $self->{Expected_Tests} == 1 ? '' : 's'; $self->diag(<<"FAIL"); Looks like you planned $self->{Expected_Tests} test$s but only ran $se\ lf->{Curr_Test}. FAIL } elsif( $num_extra > 0 ) { my $s = $self->{Expected_Tests} == 1 ? '' : 's'; $self->diag(<<"FAIL"); Looks like you planned $self->{Expected_Tests} test$s but ran $num_ext\ ra extra. FAIL } if ( $num_failed ) { my $num_tests = $self->{Curr_Test}; my $s = $num_failed == 1 ? '' : 's'; my $qualifier = $num_extra == 0 ? '' : ' run'; $self->diag(<<"FAIL"); Looks like you failed $num_failed test$s of $num_tests$qualifier. FAIL } if( $real_exit_code ) { $self->diag(<<"FAIL"); Looks like your test died just after $self->{Curr_Test}. FAIL _my_exit( 255 ) && return; } my $exit_code; if( $num_failed ) { $exit_code = $num_failed <= 254 ? $num_failed : 254; } elsif( $num_extra != 0 ) { $exit_code = 255; } else { $exit_code = 0; } _my_exit( $exit_code ) && return; } elsif ( $self->{Skip_All} ) { _my_exit( 0 ) && return; } elsif ( $real_exit_code ) { $self->diag(<<'FAIL'); Looks like your test died before it could output anything. FAIL _my_exit( 255 ) && return; } else { $self->diag("No tests run!\\n"); _my_exit( 255 ) && return; } } END { $Test->_ending if defined $Test and !$Test->no_ending; } =head1 EXIT CODES If all your tests passed, Test::Builder will exit with zero (which is normal). If anything failed it will exit with how many failed. If you run less (or more) tests than you planned, the missing (or extras) will be considered failures. If no tests were ever run Test::Builder will throw a warning and exit with 255. If the test died, even after having successfully completed all its tests, it will still be considered a failure and will exit wi" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8244000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8245000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8246000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8247000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8248000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8249000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x824a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x824b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x824c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x824d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 1306 bytes "th 255. So the exit codes are... 0 all tests successful 255 test died or all passed but wrong # of tests r\ un any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. =head1 THREADS In perl 5.8.1 and later, Test::Builder is thread-safe. The test number is shared amongst all threads. This means if one thread sets the test number using current_test() they will all be effected. While versions earlier than 5.8.1 had threads they contain too many bugs to support. Test::Builder is only thread-aware if threads.pm is loaded I Test::Builder. =head1 EXAMPLES CPAN can provide the best examples. Test::Simple, Test::More, Test::Exception and Test::Differences all use Test::Builder. =head1 SEE ALSO Test::Simple, Test::More, Test::Harness =head1 AUTHORS Original code by chromatic, maintained by Michael G Schwern Eschwern@pobox.comE =head1 COPYRIGHT Copyright 2002, 2004 by chromatic Echromatic@wgz.orgE and Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; " 21495 perl5.8.8 RET read 1306/0x51a 21495 perl5.8.8 CALL read(0x6,0x8201000,0x1000) 21495 perl5.8.8 GIO fd 6 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x6) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL dup(0x1) 21495 perl5.8.8 RET dup 6 21495 perl5.8.8 CALL getdtablesize 21495 perl5.8.8 RET getdtablesize 11095/0x2b57 21495 perl5.8.8 CALL fcntl(0x6,0x3,0) 21495 perl5.8.8 RET fcntl 2 21495 perl5.8.8 CALL fstat(0x6,0x8173660) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL fcntl(0x6,0x2,0x1) 21495 perl5.8.8 RET fcntl 0 21495 perl5.8.8 CALL fcntl(0x6,0x3,0) 21495 perl5.8.8 RET fcntl 2 21495 perl5.8.8 CALL dup(0x2) 21495 perl5.8.8 RET dup 7 21495 perl5.8.8 CALL fcntl(0x7,0x3,0) 21495 perl5.8.8 RET fcntl 2 21495 perl5.8.8 CALL fstat(0x7,0x8173660) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL fcntl(0x7,0x2,0x1) 21495 perl5.8.8 RET fcntl 0 21495 perl5.8.8 CALL fcntl(0x7,0x3,0) 21495 perl5.8.8 RET fcntl 2 21495 perl5.8.8 CALL break(0x824e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x81fd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "; } # This implements "use Test::More 'no_diag'" but the behavior is # deprecated. sub import_extra { my $class = shift; my $list = shift; my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'no_diag' ) { $class->builder->no_diag(1); } else { push @other, $item; } $idx++; } @$list = @other; } =head2 Test names By convention, each test is assigned a number in order. This is largely done automatically for you. However, it's often very useful t\ o assign a name to each test. Which would you rather see: ok 4 not ok 5 ok 6 or ok 4 - basic multi-variable not ok 5 - simple exponential ok 6 - force == mass * acceleration The later gives you some idea of what failed. It also makes it easier to find the test in your script, simply search for "simple exponential". All test functions take a name argument. It's optional, but highly suggested that you use it. =head2 I'm ok, you're not ok. The basic purpose of this module is to print out either "ok #" or "not ok #" depending on if a given test succeeded or failed. Everything else is just gravy. All of the following print "ok" or "not ok" depending on if the test succeeded or failed. They all also return true or false, respectively. =over 4 =item B ok($got eq $expected, $test_name); This simply evaluates any expression (C<$got eq $expected> is just a simple example) and uses that to determine if the test succeeded or failed. A true expression passes, a false one fails. Very simple. For example: ok( $exp{9} == 81, 'simple exponential' ); ok( Film->can('db_Main'), 'set_db()' ); ok( $p->tests == 4, 'saw tests' ); ok( !grep !defined $_, @items, 'items populated' ); (Mnemonic: "This is ok.") $test_name is a very short description of the test that will be printe\ d out. It makes it very easy to find a test in your script when it fail\ s and gives others an idea of your intentions. $test_name is optional, but we B strongly encourage its use. Should an ok() fail, it will produce some diagnostics: not ok 18 - sufficient mucus # Failed test 'sufficient mucus' # in foo.t at line 42. This is the same as Test::Simple's ok() routine. =cut sub ok ($;$) { my($test, $name) = @_; my $tb = Test::More->builder; $tb->ok($test, $name); } =item B =item B is ( $got, $expected, $test_name ); isnt( $got, $expected, $test_name ); Similar to ok(), is() and isnt() compare their two arguments with C and C respectively and use the result of that to determine if the test succeeded or failed. So these: # Is the ultimate answer 42? is( ultimate_answer(), 42, "Meaning of Life" ); # $foo isn't empty isnt( $foo, '', "Got some foo" ); are similar to these: ok( ultimate_answer() eq 42, "Meaning of Life" ); ok( $foo ne '', "Got some foo" ); (Mnemonic: "This is that." "This isn't that.") So why use these? They produce better diagnostics on failure. ok() cannot know what you are testing for (beyond the name), but is() and isnt() know what the test was and why it failed. For example this test: my $foo = 'waffle'; my $bar = 'yarblokos'; is( $foo, $bar, 'Is foo the same as bar?' ); Will produce something like this: not ok 17 - Is foo the same as bar? # Failed test 'Is foo the same as bar?' # in foo.t at line 139. # got: 'waffle' # expected: 'yarblokos' So you can figure out what went wrong without rerunning the test. You are encouraged to use is() and isnt() over ok() where possible, however do not be tempted to use them to find out if something is true or false! # XXX BAD! is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); This does not check if C is true, it checks if it returns 1. Very different. Similar caveats exist for false and 0" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes ". In these cases, use ok(). ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); For those grammatical pedants out there, there's an C function which is an alias of isnt(). =cut sub is ($$;$) { my $tb = Test::More->builder; $tb->is_eq(@_); } sub isnt ($$;$) { my $tb = Test::More->builder; $tb->isnt_eq(@_); } *isn't = \\&isnt; =item B like( $got, qr/expected/, $test_name ); Similar to ok(), like() matches $got against the regex C\ . So this: like($got, qr/expected/, 'this is like that'); is similar to: ok( $got =~ /expected/, 'this is like that'); (Mnemonic "This is like that".) The second argument is a regular expression. It may be given as a regex reference (i.e. C) or (for better compatibility with older perls) as a string that looks like a regex (alternative delimiters are currently not supported): like( $got, '/expected/', 'this is like that' ); Regex options may be placed on the end (C<'/expected/i'>). Its advantages over ok() are similar to that of is() and isnt(). Bett\ er diagnostics on failure. =cut sub like ($$;$) { my $tb = Test::More->builder; $tb->like(@_); } =item B unlike( $got, qr/expected/, $test_name ); Works exactly as like(), only it checks if $got B match the given pattern. =cut sub unlike ($$;$) { my $tb = Test::More->builder; $tb->unlike(@_); } =item B cmp_ok( $got, $op, $expected, $test_name ); Halfway between ok() and is() lies cmp_ok(). This allows you to compare two arguments using any binary perl operator. # ok( $got eq $expected ); cmp_ok( $got, 'eq', $expected, 'this eq that' ); # ok( $got == $expected ); cmp_ok( $got, '==', $expected, 'this == that' ); # ok( $got && $expected ); cmp_ok( $got, '&&', $expected, 'this && that' ); ...etc... Its advantage over ok() is when the test fails you'll know what $got and $expected were: not ok 1 # Failed test in foo.t at line 12. # '23' # && # undef It's also useful in those cases where you are comparing numbers and is()'s use of C will interfere: cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); =cut sub cmp_ok($$$;$) { my $tb = Test::More->builder; $tb->cmp_ok(@_); } =item B can_ok($module, @methods); can_ok($object, @methods); Checks to make sure the $module or $object can do these @methods (works with functions, too). can_ok('Foo', qw(this that whatever)); is almost exactly like saying: ok( Foo->can('this') && Foo->can('that') && Foo->can('whatever') ); only without all the typing and with a better interface. Handy for quickly testing an interface. No matter how many @methods you check, a single can_ok() call counts as one test. If you desire otherwise, use: foreach my $meth (@methods) { can_ok('Foo', $meth); } =cut sub can_ok ($@) { my($proto, @methods) = @_; my $class = ref $proto || $proto; my $tb = Test::More->builder; unless( $class ) { my $ok = $tb->ok( 0, "->can(...)" ); $tb->diag(' can_ok() called with empty class or reference')\ ; return $ok; } unless( @methods ) { my $ok = $tb->ok( 0, "$class->can(...)" ); $tb->diag(' can_ok() called with no methods'); return $ok; } my @nok = (); foreach my $method (@methods) { $tb->_try(sub { $proto->can($method) }) or push @nok, $method; } my $name; $name = @methods == 1 ? "$class->can('$methods[0]')" : "$class->can(...)"; my $ok = $tb->ok( !@nok, $name ); $tb->diag(map " $class->can('$_') failed\\n", @nok); return $ok; } =item B isa_ok($object, $class, $object_name); isa_ok($ref, $type, $ref_name); Checks to see if the given C<< $object->isa($class) >>. Also checks t\ o make sure the object was defined in the first place. Handy for this sort of thing: my $obj = Some::Module->new; isa_ok( $obj, 'S" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x824f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8250000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "ome::Module' ); where you'd otherwise have to write my $obj = Some::Module->new; ok( defined $obj && $obj->isa('Some::Module') ); to safeguard against your test script blowing up. It works on references, too: isa_ok( $array_ref, 'ARRAY' ); The diagnostics of this test normally just refer to 'the object'. If you'd like them to be more specific, you can supply an $object_name (for example 'Test customer'). =cut sub isa_ok ($$;$) { my($object, $class, $obj_name) = @_; my $tb = Test::More->builder; my $diag; $obj_name = 'The object' unless defined $obj_name; my $name = "$obj_name isa $class"; if( !defined $object ) { $diag = "$obj_name isn't defined"; } elsif( !ref $object ) { $diag = "$obj_name isn't a reference"; } else { # We can't use UNIVERSAL::isa because we want to honor isa() o\ verrides my($rslt, $error) = $tb->_try(sub { $object->isa($class) }); if( $error ) { if( $error =~ /^Can't call method "isa" on unblessed refer\ ence/ ) { # Its an unblessed reference if( !UNIVERSAL::isa($object, $class) ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"\ ; } } else { die <isa on your object and got some weird error. Here's the error. $error WHOA } } elsif( !$rslt ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } my $ok; if( $diag ) { $ok = $tb->ok( 0, $name ); $tb->diag(" $diag\\n"); } else { $ok = $tb->ok( 1, $name ); } return $ok; } =item B =item B pass($test_name); fail($test_name); Sometimes you just want to say that the tests have passed. Usually the case is you've got some complicated condition that is difficult to wedge into an ok(). In this case, you can simply use pass() (to declare the test ok) or fail (for not ok). They are synonyms for ok(1) and ok(0). Use these very, very, very sparingly. =cut sub pass (;$) { my $tb = Test::More->builder; $tb->ok(1, @_); } sub fail (;$) { my $tb = Test::More->builder; $tb->ok(0, @_); } =back =head2 Module tests You usually want to test if the module you're testing loads ok, rather than just vomiting if its load fails. For such purposes we have C and C. =over 4 =item B BEGIN { use_ok($module); } BEGIN { use_ok($module, @imports); } These simply use the given $module and test to make sure the load happened ok. It's recommended that you run use_ok() inside a BEGIN block so its functions are exported at compile-time and prototypes are properly honored. If @imports are given, they are passed through to the use. So this: BEGIN { use_ok('Some::Module', qw(foo bar)) } is like doing this: use Some::Module qw(foo bar); Version numbers can be checked like so: # Just like "use Some::Module 1.02" BEGIN { use_ok('Some::Module', 1.02) } Don't try to do this: BEGIN { use_ok('Some::Module'); ...some code that depends on the use... ...happening at compile time... } because the notion of "compile-time" is relative. Instead, you want: BEGIN { use_ok('Some::Module') } BEGIN { ...some code that depends on the use... } =cut sub use_ok ($;@) { my($module, @imports) = @_; @imports = () unless @imports; my $tb = Test::More->builder; my($pack,$filename,$line) = caller; my $code; if( @imports == 1 and $imports[0] =~ /^\\d+(?:\\.\\d+)?$/ ) { # probably a version check. Perl needs to see the bare number # for it to work with non-Exporter based modules. $code = <ok( $eval_result, "use $module;" ); unless( $ok ) { chomp $eval_error; $@ =~ s{^BEGIN failed--compilation aborted at .*$} {BEGIN failed--compilation aborted at $filename line $\ line.}m; $tb->diag(< require_ok($module); require_ok($file); Like use_ok(), except it requires the $module or $file. =cut sub require_ok ($) { my($module) = shift; my $tb = Test::More->builder; my $pack = caller; # Try to deterine if we've been given a module name or file. # Module names must be barewords, files not. $module = qq['$module'] unless _is_module_name($module); my $code = <ok( $eval_result, "require $module;" ); unless( $ok ) { chomp $eval_error; $tb->diag(< I'm not quite sure what will happen with filehandles. =over 4 =item B is_deeply( $got, $expected, $test_name ); Similar to is(), except that if $got and $expected are references, it does a deep comparison walking each data structure to see if they are equivalent. If the two structures are different, it will display the place where they start differing. is_deeply() compares the dereferenced values of references, the references themselves (except for their type) are ignored. This means aspects such as blessing and ties are not considered "different". is_deeply() current has very limited handling of function reference and globs. It merely checks if they have the same referent. This may improve in the future. Test::Differences and Test::Deep provide more in-depth functionality along these lines. =cut use vars qw(@Data_Stack %Refs_Seen); my $DNE = bless [], 'Does::Not::Exist'; sub _dne { ref $_[0] eq ref $DNE; } sub is_deeply { my $tb = Test::More->builder; unless( @_ == 2 or @_ == 3 ) { my $msg = <ok(0); } my($got, $expected, $name) = @_; $tb->_unoverload_str(\\$expected, \\$got); my $ok; if( !ref $got and !ref $expected ) { # neither is a\ reference $ok = $tb->is_eq($got, $expected, $name); } elsif( !ref $got xor !ref $expected ) { # one's a reference, o\ ne isn't $ok = $tb->ok(0, $name); $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); } else { # both references local @Data_Stack = (); if( _deep_check($got, $expected) ) { $ok = $tb->ok(1, $name); } else { $ok = $tb->ok(0, $name); $tb->diag(_format_stack(@Data_Stack)); } } return $ok; } sub _format_stack { my(@Stack) = @_; my $var = '$FOO'; my $did_arrow = 0; foreach my $entry (@Stack) { my $type = $entry->{type} || ''; " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8256000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8257000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8258000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8259000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x825a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes " my $idx = $entry->{'idx'}; if( $type eq 'HASH' ) { $var .= "->" unless $did_arrow++; $var .= "{$idx}"; } elsif( $type eq 'ARRAY' ) { $var .= "->" unless $did_arrow++; $var .= "[$idx]"; } elsif( $type eq 'REF' ) { $var = "\\${$var}"; } } my @vals = @{$Stack[-1]{vals}}[0,1]; my @vars = (); ($vars[0] = $var) =~ s/\\$FOO/ \\$got/; ($vars[1] = $var) =~ s/\\$FOO/\\$expected/; my $out = "Structures begin differing at:\\n"; foreach my $idx (0..$#vals) { my $val = $vals[$idx]; $vals[$idx] = !defined $val ? 'undef' : _dne($val) ? "Does not exist" : ref $val ? "$val" : "'$val'"; } $out .= "$vars[0] = $vals[0]\\n"; $out .= "$vars[1] = $vals[1]\\n"; $out =~ s/^/ /msg; return $out; } sub _type { my $thing = shift; return '' if !ref $thing; for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) { return $type if UNIVERSAL::isa($thing, $type); } return ''; } =back =head2 Diagnostics If you pick the right test function, you'll usually get a good idea of what went wrong when it failed. But sometimes it doesn't work out that way. So here we have ways for you to write your own diagnostic messages which are safer than just C. =over 4 =item B diag(@diagnostic_message); Prints a diagnostic message which is guaranteed not to interfere with test output. Like C @diagnostic_message is simply concatenated together. Handy for this sort of thing: ok( grep(/foo/, @users), "There's a foo user" ) or diag("Since there's no foo, check that /etc/bar is set up righ\ t"); which would produce: not ok 42 - There's a foo user # Failed test 'There's a foo user' # in foo.t at line 52. # Since there's no foo, check that /etc/bar is set up right. You might remember C with the mnemonic C. B The exact formatting of the diagnostic output is still changing, but it is guaranteed that whatever you throw at it it won't interfere with the test. =cut sub diag { my $tb = Test::More->builder; $tb->diag(@_); } =back =head2 Conditional tests Sometimes running a test under certain conditions will cause the test script to die. A certain function or method isn't implemented (such as fork() on MacOS), some resource isn't available (like a net connection) or a module isn't available. In these cases it's necessary to skip tests, or declare that they are supposed to fail but will work in the future (a todo test). For more details on the mechanics of skip and todo tests see L. The way Test::More handles this is with a named block. Basically, a block of tests which can be skipped over or made todo. It's best if I just show you... =over 4 =item B SKIP: { skip $why, $how_many if $condition; ...normal testing code goes here... } This declares a block of tests that might be skipped, $how_many tests there are, $why and under what $condition to skip them. An example is the easiest way to illustrate: SKIP: { eval { require HTML::Lint }; skip "HTML::Lint not installed", 2 if $@; my $lint = new HTML::Lint; isa_ok( $lint, "HTML::Lint" ); $lint->parse( $html ); is( $lint->errors, 0, "No errors found in HTML" ); } If the user does not have HTML::Lint installed, the whole block of code I. Test::More will output special ok's which Test::Harness interprets as skipped, but passing, tests. It's important that $how_many accurately reflects the number of tests in the SKIP block so the # of tests run will match up with your plan. If your plan is C $how_many is optional and will default to 1\ . It's perfectly safe to nest SKIP blocks. Each SKIP block must have the label C, or Test::More can't work its magic." 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x825b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x825c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x825d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x825e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x825f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8260000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes " You don't skip tests which are failing because there's a bug in your program, or for which you don't yet have code written. For that you use TODO. Read on. =cut #'# sub skip { my($why, $how_many) = @_; my $tb = Test::More->builder; unless( defined $how_many ) { # $how_many can only be avoided when no_plan is in use. _carp "skip() needs to know \\$how_many tests are in the block\ " unless $tb->has_plan eq 'no_plan'; $how_many = 1; } if( defined $how_many and $how_many =~ /\\D/ ) { _carp "skip() was passed a non-numeric number of tests. Did y\ ou get the arguments backwards?"; $how_many = 1; } for( 1..$how_many ) { $tb->skip($why); } local $^W = 0; last SKIP; } =item B TODO: { local $TODO = $why if $condition; ...normal testing code goes here... } Declares a block of tests you expect to fail and $why. Perhaps it's because you haven't fixed a bug or haven't finished a new feature: TODO: { local $TODO = "URI::Geller not finished"; my $card = "Eight of clubs"; is( URI::Geller->your_card, $card, 'Is THIS your card?' ); my $spoon; URI::Geller->bend_spoon; is( $spoon, 'bent', "Spoon bending, that's original" ); } With a todo block, the tests inside are expected to fail. Test::More will run the tests normally, but print out special flags indicating they are "todo". Test::Harness will interpret failures as being ok. Should anything succeed, it will report it as an unexpected success. You then know the thing you had todo is done and can remove the TODO flag. The nice part about todo tests, as opposed to simply commenting out a block of tests, is it's like having a programmatic todo list. You kno\ w how much work is left to be done, you're aware of what bugs there are, and you'll know immediately when they're fixed. Once a todo test starts succeeding, simply move it outside the block. When the block is empty, delete it. B: TODO tests require a Test::Harness upgrade else it will treat it as a normal failure. See L). =item B TODO: { todo_skip $why, $how_many if $condition; ...normal testing code... } With todo tests, it's best to have the tests actually run. That way you'll know when they start passing. Sometimes this isn't possible. Often a failing test will cause the whole program to die or hang, even inside an C with and using C. In these extreme cases you have no choice but to skip over the broken tests entirely. The syntax and behavior is similar to a C except the tests will be marked as failing but todo. Test::Harness will interpret them as passing. =cut sub todo_skip { my($why, $how_many) = @_; my $tb = Test::More->builder; unless( defined $how_many ) { # $how_many can only be avoided when no_plan is in use. _carp "todo_skip() needs to know \\$how_many tests are in the \ block" unless $tb->has_plan eq 'no_plan'; $how_many = 1; } for( 1..$how_many ) { $tb->todo_skip($why); } local $^W = 0; last TODO; } =item When do I use SKIP vs. TODO? B, use SKIP. This includes optional modules that aren't installed, running under an OS that doesn't have some feature (like fork() or symlinks), or may\ be you need an Internet connection and one isn't available. B, use TODO. This is for any code you haven't written yet, or bugs you have yet to fix, but want to put tests in your testing script (always a good idea). =back =head2 Test control =over 4 =item B BAIL_OUT($reason); Indicates to the harness that things are going so badly all testing should terminate. This includes the running any additional test scrip\ ts. This is typically used when testing cannot continue such as a critical module failing to compile or a necessary external util" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8261000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8262000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8263000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "ity not being available such as a database connection failing. The test will exit with 255. =cut sub BAIL_OUT { my $reason = shift; my $tb = Test::More->builder; $tb->BAIL_OUT($reason); } =back =head2 Discouraged comparison functions The use of the following functions is discouraged as they are not actually testing functions and produce no diagnostics to help figure out what went wrong. They were written before is_deeply() existed because I couldn't figure out how to display a useful diff of two arbitrary data structures. These functions are usually used inside an ok(). ok( eq_array(\\@got, \\@expected) ); C can do that better and with diagnostics. is_deeply( \\@got, \\@expected ); They may be deprecated in future versions. =over 4 =item B my $is_eq = eq_array(\\@got, \\@expected); Checks if two arrays are equivalent. This is a deep check, so multi-level structures are handled correctly. =cut #'# sub eq_array { local @Data_Stack; _deep_check(@_); } sub _eq_array { my($a1, $a2) = @_; if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) { warn "eq_array passed a non-array ref"; return 0; } return 1 if $a1 eq $a2; my $ok = 1; my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; for (0..$max) { my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, \ $e2] }; $ok = _deep_check($e1,$e2); pop @Data_Stack if $ok; last unless $ok; } return $ok; } sub _deep_check { my($e1, $e2) = @_; my $tb = Test::More->builder; my $ok = 0; # Effectively turn %Refs_Seen into a stack. This avoids picking u\ p # the same referenced used twice (such as [\\$a, \\$a]) to be cons\ idered # circular. local %Refs_Seen = %Refs_Seen; { # Quiet uninitialized value warnings when comparing undefs. local $^W = 0; $tb->_unoverload_str(\\$e1, \\$e2); # Either they're both references or both not. my $same_ref = !(!ref $e1 xor !ref $e2); my $not_ref = (!ref $e1 and !ref $e2); if( defined $e1 xor defined $e2 ) { $ok = 0; } elsif ( _dne($e1) xor _dne($e2) ) { $ok = 0; } elsif ( $same_ref and ($e1 eq $e2) ) { $ok = 1; } elsif ( $not_ref ) { push @Data_Stack, { type => '', vals => [$e1, $e2] }; $ok = 0; } else { if( $Refs_Seen{$e1} ) { return $Refs_Seen{$e1} eq $e2; } else { $Refs_Seen{$e1} = "$e2"; } my $type = _type($e1); $type = 'DIFFERENT' unless _type($e2) eq $type; if( $type eq 'DIFFERENT' ) { push @Data_Stack, { type => $type, vals => [$e1, $e2] \ }; $ok = 0; } elsif( $type eq 'ARRAY' ) { $ok = _eq_array($e1, $e2); } elsif( $type eq 'HASH' ) { $ok = _eq_hash($e1, $e2); } elsif( $type eq 'REF' ) { push @Data_Stack, { type => $type, vals => [$e1, $e2] \ }; $ok = _deep_check($$e1, $$e2); pop @Data_Stack if $ok; } elsif( $type eq 'SCALAR' ) { push @Data_Stack, { type => 'REF', vals => [$e1, $e2] \ }; $ok = _deep_check($$e1, $$e2); pop @Data_Stack if $ok; } elsif( $type ) { push @Data_Stack, { type => $type, vals => [$e1, $e2] \ }; $ok = 0; } else { _whoa(1, "No type in _deep_check"); } } } return $ok; } sub _whoa { my($check, $desc) = @_; if( $check ) { die < my $is_eq = eq_hash(\\%got, \\%expected); Determines if the two hashes contain the same keys and values. T" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8264000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8265000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8266000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8267000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8268000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8269000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "his is a deep check. =cut sub eq_hash { local @Data_Stack; return _deep_check(@_); } sub _eq_hash { my($a1, $a2) = @_; if( grep !_type($_) eq 'HASH', $a1, $a2 ) { warn "eq_hash passed a non-hash ref"; return 0; } return 1 if $a1 eq $a2; my $ok = 1; my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; foreach my $k (keys %$bigger) { my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $\ e2] }; $ok = _deep_check($e1, $e2); pop @Data_Stack if $ok; last unless $ok; } return $ok; } =item B my $is_eq = eq_set(\\@got, \\@expected); Similar to eq_array(), except the order of the elements is B important. This is a deep check, but the irrelevancy of order only applies to the top level. ok( eq_set(\\@got, \\@expected) ); Is better written: is_deeply( [sort @got], [sort @expected] ); B By historical accident, this is not a true set comparison. While the order of elements does not matter, duplicate elements do. B eq_set() does not know how to deal with references at the top level. The following is an example of a comparison which might not wo\ rk: eq_set([\\1, \\2], [\\2, \\1]); Test::Deep contains much better set comparison functions. =cut sub eq_set { my($a1, $a2) = @_; return 0 unless @$a1 == @$a2; # There's faster ways to do this, but this is easiest. local $^W = 0; # It really doesn't matter how we sort them, as long as both array\ s are # sorted with the same algorithm. # # Ensure that references are not accidentally treated the same as \ a # string containing the reference. # # Have to inline the sort routine due to a threading/sort bug. # See [rt.cpan.org 6782] # # I don't know how references would be sorted so we just don't sor\ t # them. This means eq_set doesn't really work with refs. return eq_array( [grep(ref, @$a1), sort( grep(!ref, @$a1) )], [grep(ref, @$a2), sort( grep(!ref, @$a2) )], ); } =back =head2 Extending and Embedding Test::More Sometimes the Test::More interface isn't quite enough. Fortunately, Test::More is built on top of Test::Builder which provides a single, unified backend for any test library to use. This means two test libraries which both use Test::Builder B. If you simply want to do a little tweaking of how the tests behave, you can access the underlying Test::Builder object like so: =over 4 =item B my $test_builder = Test::More->builder; Returns the Test::Builder object underlying Test::More for you to play with. =back =head1 EXIT CODES If all your tests passed, Test::Builder will exit with zero (which is normal). If anything failed it will exit with how many failed. If you run less (or more) tests than you planned, the missing (or extras) will be considered failures. If no tests were ever run Test::Builder will throw a warning and exit with 255. If the test died, even after having successfully completed all its tests, it will still be considered a failure and will exit with 255. So the exit codes are... 0 all tests successful 255 test died or all passed but wrong # of tests r\ un any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. B This behavior may go away in future versions. =head1 CAVEATS and NOTES =over 4 =item Backwards compatibility Test::More works with Perls as old as 5.6.0. =item Overloaded objects String overloaded objects are compared B (or in cmp_ok()'s case, strings or numbers as appropriate to the comparison op). This prevents Test::More from piercing an object's interface allowing better blackbox testing. So if a function starts returning overloaded objects instead of bare strings your tests won't notice the difference. Th" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x826a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x826b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x826c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x826d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x826e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 2877 bytes "is is good. However, it does mean that functions like is_deeply() cannot be used t\ o test the internals of string overloaded objects. In this case I would suggest Test::Deep which contains more flexible testing functions for complex data structures. =item Threads Test::More will only be aware of threads if "use threads" has been don\ e I Test::More is loaded. This is ok: use threads; use Test::More; This may cause problems: use Test::More use threads; 5.8.1 and above are supported. Anything below that has too many bugs. =item Test::Harness upgrade no_plan and todo depend on new Test::Harness features and fixes. If you're going to distribute tests that use no_plan or todo your end-users will have to upgrade Test::Harness to the latest one on CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness will work fine. Installing Test::More should also upgrade Test::Harness. =back =head1 HISTORY This is a case of convergent evolution with Joshua Pritikin's Test module. I was largely unaware of its existence when I'd first written my own ok() routines. This module exists because I can't figure out how to easily wedge test names into Test's interface (along with a few other problems). The goal here is to have a testing utility that's simple to learn, quick to use and difficult to trip yourself up with while still providing more flexibility than the existing Test.pm. As such, the names of the most common routines are kept tiny, special cases and magic side-effects are kept to a minimum. WYSIWYG. =head1 SEE ALSO L if all this confuses you and you just want to write some tests. You can upgrade to Test::More later (it's forward compatible). L is the old testing module. Its main benefit is that it has been distributed with Perl since 5.004_05. L for details on how your test results are interpreted by Perl. L for more ways to test complex data structures. And it plays well with Test::More. L is like XUnit but more perlish. L gives you more powerful complex data structure testing. L is XUnit style testing. L shows the idea of embedded testing. L installs a whole bunch of useful test modules. =head1 AUTHORS Michael G Schwern Eschwern@pobox.comE with much inspiration from Joshua Pritikin's Test module and lots of help from Barrie Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa gang. =head1 BUGS See F to report and view bugs. =head1 COPYRIGHT Copyright 2001-2002, 2004-2006 by Michael G Schwern Eschwern@pobox\ .comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; " 21495 perl5.8.8 RET read 2877/0xb3d 21495 perl5.8.8 CALL read(0x4,0x81ee000,0x1000) 21495 perl5.8.8 GIO fd 4 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x4) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL fstat(0x6,0xbfbfe380) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL ioctl(0x6,TIOCGETA,0xbfbfe3c0) 21495 perl5.8.8 RET ioctl 0 21495 perl5.8.8 CALL write(0x6,0x81ee000,0x6) 21495 perl5.8.8 GIO fd 6 wrote 6 bytes "1..50 " 21495 perl5.8.8 RET write 6 21495 perl5.8.8 CALL stat(0x81aca00,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Exporter/Heavy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac880,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/Exporter/Heavy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca00,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Exporter/Heavy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac880,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/Exporter/Heavy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca00,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Exporter/Heavy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac880,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/Exporter/Heavy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81aca00,0xbfbfe3a0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter/Heavy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ac880,0xbfbfe2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter/Heavy.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x823df80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/Exporter/Heavy.pm" 21495 perl5.8.8 RET open 4 21495 perl5.8.8 CALL fstat(0x4,0xbfbfb8c0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x826f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x826e000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "package Exporter::Heavy; use strict; no strict 'refs'; # On one line so MakeMaker will see it. require Exporter; our $VERSION = $Exporter::VERSION; # Carp 1.05+ does this now for us, but we may be running with an old C\ arp $Carp::Internal{'Exporter::Heavy'}++; =head1 NAME Exporter::Heavy - Exporter guts =head1 SYNOPSIS (internal use only) =head1 DESCRIPTION No user-serviceable parts inside. =cut # # We go to a lot of trouble not to 'require Carp' at file scope, # because Carp requires Exporter, and something has to give. # sub _rebuild_cache { my ($pkg, $exports, $cache) = @_; s/^&// foreach @$exports; @{$cache}{@$exports} = (1) x @$exports; my $ok = \\@{"${pkg}::EXPORT_OK"}; if (@$ok) { s/^&// foreach @$ok; @{$cache}{@$ok} = (1) x @$ok; } } sub heavy_export { # First make import warnings look like they're coming from the "us\ e". local $SIG{__WARN__} = sub { my $text = shift; if ($text =~ s/ at \\S*Exporter\\S*.pm line \\d+.*\\n//) { require Carp; local $Carp::CarpLevel = 1; # ignore package calling us to\ o. Carp::carp($text); } else { warn $text; } }; local $SIG{__DIE__} = sub { require Carp; local $Carp::CarpLevel = 1; # ignore package calling us to\ o. Carp::croak("$_[0]Illegal null symbol in \\@${1}::EXPORT") if $_[0] =~ /^Unable to create sub named "(.*?)::"/; }; my($pkg, $callpkg, @imports) = @_; my($type, $sym, $cache_is_current, $oops); my($exports, $export_cache) = (\\@{"${pkg}::EXPORT"}, $Exporter::Cache{$pkg} ||= {}); if (@imports) { if (!%$export_cache) { _rebuild_cache ($pkg, $exports, $export_cache); $cache_is_current = 1; } if (grep m{^[/!:]}, @imports) { my $tagsref = \\%{"${pkg}::EXPORT_TAGS"}; my $tagdata; my %imports; my($remove, $spec, @names, @allexports); # negated first item implies starting with default set: unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/; foreach $spec (@imports){ $remove = $spec =~ s/^!//; if ($spec =~ s/^://){ if ($spec eq 'DEFAULT'){ @names = @$exports; } elsif ($tagdata = $tagsref->{$spec}) { @names = @$tagdata; } else { warn qq["$spec" is not defined in %${pkg}::EXP\ ORT_TAGS]; ++$oops; next; } } elsif ($spec =~ m:^/(.*)/$:){ my $patn = $1; @allexports = keys %$export_cache unless @allexpor\ ts; # only do keys once @names = grep(/$patn/, @allexports); # not anchore\ d by default } else { @names = ($spec); # is a normal symbol name } warn "Import ".($remove ? "del":"add").": @names " if $Exporter::Verbose; if ($remove) { foreach $sym (@names) { delete $imports{$sym} } } else { @imports{@names} = (1) x @names; } } @imports = keys %imports; } my @carp; foreach $sym (@imports) { if (!$export_cache->{$sym}) { if ($sym =~ m/^\\d/) { $pkg->VERSION($sym); # inherit from UNIVERSAL # If the version number was the only thing specifi\ ed # then we should act as if nothing was specified: if (@imports == 1) { @imports = @$exports; last; } # We need a way to emulate 'use Foo ()' but still # allow an easy version check: "use Foo 1.23, ''"; if (@imports == 2 and !$imports[1]) { @imports = (); last; } } elsif ($sym !~ s/^&// || !$export_cache->{$sym}) { # Last chance - see if they've updated EXPORT_OK s\ ince we # cached it. unless ($cache_is_current) { %$export_cache = (); _rebuild_cache ($pkg, $exports, $export_cache)\ ; $cache_is_current = 1; } if (!$export_cache->{$sym}) { # accumulate the non-exports push @carp, qq["$sym" is not exported by the $pkg module\ \\n]; $oops++; } } } } if ($oops) { require Carp; Carp::croak("@{carp}Can't continue after import errors"); } } else { @imports = @$exports; } my($fail, $fail_cache) = (\\@{"${pkg}::EXPORT_FAIL"}, $Exporter::FailCache{$pkg} ||=" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8271000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x4,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x8272000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8273000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8274000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8275000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8276000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8277000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8278000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8279000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x826e000,0x1000) 21495 perl5.8.8 GIO fd 4 read 2395 bytes " {}); if (@$fail) { if (!%$fail_cache) { # Build cache of symbols. Optimise the lookup by adding # barewords twice... both with and without a leading &. # (Technique could be applied to $export_cache at cost of \ memory) my @expanded = map { /^\\w/ ? ($_, '&'.$_) : $_ } @$fail; warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter:\ :Verbose; @{$fail_cache}{@expanded} = (1) x @expanded; } my @failed; foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->\ {$sym} } if (@failed) { @failed = $pkg->export_fail(@failed); foreach $sym (@failed) { require Carp; Carp::carp(qq["$sym" is not implemented by the $pkg mo\ dule ], "on this architecture"); } if (@failed) { require Carp; Carp::croak("Can't continue after import errors"); } } } warn "Importing into $callpkg from $pkg: ", join(", ",sort @imports) if $Exporter::Verbose; foreach $sym (@imports) { # shortcut for the common case of no type character (*{"${callpkg}::$sym"} = \\&{"${pkg}::$sym"}, next) unless $sym =~ s/^(\\W)//; $type = $1; no warnings 'once'; *{"${callpkg}::$sym"} = $type eq '&' ? \\&{"${pkg}::$sym"} : $type eq '$' ? \\${"${pkg}::$sym"} : $type eq '@' ? \\@{"${pkg}::$sym"} : $type eq '%' ? \\%{"${pkg}::$sym"} : $type eq '*' ? *{"${pkg}::$sym"} : do { require Carp; Carp::croak("Can't export symbol: $type\ $sym") }; } } sub heavy_export_to_level { my $pkg = shift; my $level = shift; (undef) = shift; # XXX redundant arg my $callpkg = caller($level); $pkg->export($callpkg, @_); } # Utility functions sub _push_tags { my($pkg, $var, $syms) = @_; my @nontag = (); my $export_tags = \\%{"${pkg}::EXPORT_TAGS"}; push(@{"${pkg}::$var"}, map { $export_tags->{$_} ? @{$export_tags->{$_}} : scalar(push(@nontag,$_),$_) } (@$syms) ? @$syms : keys %$export_tags); if (@nontag and $^W) { # This may change to a die one day require Carp; Carp::carp(join(", ", @nontag)." are not tags of $pkg"); } } sub heavy_require_version { my($self, $wanted) = @_; my $pkg = ref $self || $self; return ${pkg}->VERSION($wanted); } sub heavy_export_tags { _push_tags((caller)[0], "EXPORT", \\@_); } sub heavy_export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \\@_); } 1; " 21495 perl5.8.8 RET read 2395/0x95b 21495 perl5.8.8 CALL break(0x827a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x827b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x827c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x827d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x827e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x827f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8280000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x826e000,0x1000) 21495 perl5.8.8 GIO fd 4 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x4) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81efa00,0xbfbfdf30) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/PAR/Repository.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ef980,0xbfbfde50) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/PAR/Repository.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efa00,0xbfbfdf30) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/PAR/Repository.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81ef980,0xbfbfde50) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/PAR/Repository.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81efa80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/PAR/Repository.pm" 21495 perl5.8.8 RET open 4 21495 perl5.8.8 CALL break(0x8281000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x4,0xbfbfb450) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8282000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x4,0x8281000,0x1000) 21495 perl5.8.8 GIO fd 4 read 4096 bytes "package PAR::Repository; use 5.006; use strict; use warnings; use Carp qw/croak/; use File::Spec::Functions qw/catfile catdir splitpath/; use File::Path qw/mkpath/; use PAR::Dist qw//; use YAML::Syck qw//; use File::Copy qw//; use Cwd qw//; use Archive::Zip qw//; use File::Temp qw//; use version qw//; use PAR::Indexer qw//; use base qw/ PAR::Repository::Zip PAR::Repository::DBM PAR::Repository::Query /; use constant REPOSITORY_INFO_FILE => 'repository_info.yml'; our $VERSION = '0.16'; our $VERBOSE = 0; # template for a repository_info.yml file our $Info_Template = { repository_version => $VERSION, }; # Hash of compatible PAR::Repository versions our $Compatible_Versions = { $VERSION => 1, '0.15' => 1, '0.14' => 1, '0.13' => 1, '0.12' => 1, '0.11' => 1, '0.10' => 1, '0.03' => 1, '0.02' => 1, }; =head1 NAME PAR::Repository - Create and modify PAR repositories =head1 SYNOPSIS # Usually, you want to use the 'parrepo' script which comes with # this distribution. use PAR::Repository; my $repo = PAR::Repository->new( path => '/path/to/repository' ); # creates a new repository if it doesn't exist, opens it if it # does exist. $repo->inject( file => 'Foo-Bar-0.01-x86_64-linux-gnu-thread-multi-5.8.7.par' ); $repo->remove( file => '...' ); $repo->query_module(regex => 'Foo::Bar'); =head1 DESCRIPTION This module is intended for creation and maintenance of PAR repositori\ es. A PAR repository is collection of F<.par> archives which contain Perl \ code and associated libraries for use on specific platforms. In the most co\ mmon case, these archives differ from CPAN distributions in that they ship \ the (possibly compiled) output of C in the F subdirectory of \ the CPAN distribution's build directory. You can access a PAR repository using the L m\ odule or the L module which provides syntactic sugar around the client. L allows you to load libraries from repositories on demand. =head2 PAR REPOSITORIES A PAR repository is, basically, just a directory with certain stuff in\ it. It contains: =over 2 =item modules_dists.dbm.zip An index that maps module names to file names. Details can be found in L. =item symlinks.dbm.zip An index that maps file names to other files. You shouldn't have to ca\ re about it. Details can be found in L. =item scripts_dists.dbm.zip An index that maps script names to file names. Details can be found in L. =item repository_info.yml A simple YAML file which contains meta information for the repository. It currently contains the following bits of information: =item dbm_checksums.txt A text file associating the DBM files with their MD5 checksums. (new i\ n 0.15) =over 2 =item repository_version The version of PAR::Repository this repository was created with. When opening an existing repository, PAR::Repository checks that the repository was created by a compatible PAR::Repository version. Similarily, PAR::Repository::Client checks that the repository has a compatible version. =back =item I directories Your system architecture is identified with a certain string. For example, my development box is C. For every such architecture for which there are PAR archives in the repository, there is a directory with the name of the architecture. There is one special directory called C which is meant for PAR archives that are architecture independent. (Usually I modules.) In every such architecture directory, there is a number of directories for every Perl version. (5.6.0, 5.6.1, 5.8.0, ...) Again, there is a special directory for modules that work with any version of Perl. This directory is called C. Of course, a module won't run with Perl 4 and probably not even with 5.001. Whether a module works with I of perl is something you need to decide when injecting modules into the repository and depe\ nds on the scope of the" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8284000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8285000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x4,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x8286000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x81efd00,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Spec/Functions.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efc80,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Spec/Functions.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efd00,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Spec/Functions.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efc80,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Spec/Functions.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efd00,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec/Functions.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efc80,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Spec/Functions.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efd00,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Functions.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81efc80,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Functions.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x81efd80,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Spec/Functions.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL break(0x8287000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8288000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x5,0xbfbfae70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8289000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x8288000,0x1000) 21495 perl5.8.8 GIO fd 5 read 1858 bytes "package File::Spec::Functions; use File::Spec; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); $VERSION = '3.2701'; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( canonpath catdir catfile curdir rootdir updir no_upwards file_name_is_absolute path ); @EXPORT_OK = qw( devnull tmpdir splitpath splitdir catpath abs2rel rel2abs case_tolerant ); %EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] ); foreach my $meth (@EXPORT, @EXPORT_OK) { my $sub = File::Spec->can($meth); no strict 'refs'; *{$meth} = sub {&$sub('File::Spec', @_)}; } 1; __END__ =head1 NAME File::Spec::Functions - portably perform operations on file names =head1 SYNOPSIS use File::Spec::Functions; $x = catfile('a','b'); =head1 DESCRIPTION This module exports convenience functions for all of the class methods provided by File::Spec. For a reference of available functions, please consult L, which contains the entire set, and which is inherited by the modules f\ or other platforms. For further information, please see L, L, L, or L. =head2 Exports The following functions are exported by default. canonpath catdir catfile curdir rootdir updir no_upwards file_name_is_absolute path The following functions are exported only by request. devnull tmpdir splitpath splitdir catpath abs2rel rel2abs case_tolerant All the functions may be imported using the C<:ALL> tag. =head1 COPYRIGHT Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker =cut " 21495 perl5.8.8 RET read 1858/0x742 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 1858/0x742 21495 perl5.8.8 CALL break(0x828a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x828b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x828c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL break(0x828d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x828a200,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Path.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81eff00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Path.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a200,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Path.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81eff00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Path.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a200,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Path.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81eff00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Path.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a200,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Path.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x81eff00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Path.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x828a280,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Path.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfae70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x828e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828d000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package File::Path; use 5.005_04; use strict; use Cwd 'getcwd'; use File::Basename (); use File::Spec (); BEGIN { if ($] < 5.006) { # can't say 'opendir my $dh, $dirname' # need to initialise $dh eval "use Symbol"; } } use Exporter (); use vars qw($VERSION @ISA @EXPORT); $VERSION = '2.04'; @ISA = qw(Exporter); @EXPORT = qw(mkpath rmtree); my $Is_VMS = $^O eq 'VMS'; my $Is_MacOS = $^O eq 'MacOS'; # These OSes complain if you want to remove a file that you have no # write permission to: my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 Mac\ OS os2); sub _carp { require Carp; goto &Carp::carp; } sub _croak { require Carp; goto &Carp::croak; } sub _error { my $arg = shift; my $message = shift; my $object = shift; if ($arg->{error}) { $object = '' unless defined $object; push @{${$arg->{error}}}, {$object => "$message: $!"}; } else { _carp(defined($object) ? "$message for $object: $!" : "$messag\ e: $!"); } } sub mkpath { my $old_style = ( UNIVERSAL::isa($_[0],'ARRAY') or (@_ == 2 and (defined $_[1] ? $_[1] =~ /\\A\\d+\\z/ : 1)) or (@_ == 3 and (defined $_[1] ? $_[1] =~ /\\A\\d+\\z/ : 1) and (defined $_[2] ? $_[2] =~ /\\A\\d+\\z/ : 1) ) ) ? 1 : 0; my $arg; my $paths; if ($old_style) { my ($verbose, $mode); ($paths, $verbose, $mode) = @_; $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); $arg->{verbose} = defined $verbose ? $verbose : 0; $arg->{mode} = defined $mode ? $mode : 0777; } else { if (@_ > 0 and UNIVERSAL::isa($_[-1], 'HASH')) { $arg = pop @_; exists $arg->{mask} and $arg->{mode} = delete $arg->{mask}\ ; $arg->{mode} = 0777 unless exists $arg->{mode}; ${$arg->{error}} = [] if exists $arg->{error}; } else { @{$arg}{qw(verbose mode)} = (0, 0777); } $paths = [@_]; } return _mkpath($arg, $paths); } sub _mkpath { my $arg = shift; my $paths = shift; local($")=$Is_MacOS ? ":" : "/"; my(@created,$path); foreach $path (@$paths) { next unless length($path); $path .= '/' if $^O eq 'os2' and $path =~ /^\\w:\\z/s; # featu\ re of CRT # Logic wants Unix paths, so go with the flow. if ($Is_VMS) { next if $path eq '/'; $path = VMS::Filespec::unixify($path); } next if -d $path; my $parent = File::Basename::dirname($path); unless (-d $parent or $path eq $parent) { push(@created,_mkpath($arg, [$parent])); } print "mkdir $path\\n" if $arg->{verbose}; if (mkdir($path,$arg->{mode})) { push(@created, $path); } else { my $save_bang = $!; my ($e, $e1) = ($save_bang, $^E); $e .= "; $e1" if $e ne $e1; # allow for another process to have created it meanwhile if (!-d $path) { $! = $save_bang; if ($arg->{error}) { push @{${$arg->{error}}}, {$path => $e}; } else { _croak("mkdir $path: $e"); } } } } return @created; } sub rmtree { my $old_style = ( UNIVERSAL::isa($_[0],'ARRAY') or (@_ == 2 and (defined $_[1] ? $_[1] =~ /\\A\\d+\\z/ : 1)) or (@_ == 3 and (defined $_[1] ? $_[1] =~ /\\A\\d+\\z/ : 1) and (defined $_[2] ? $_[2] =~ /\\A\\d+\\z/ : 1) ) ) ? 1 : 0; my $arg; my $paths; if ($old_style) { my ($verbose, $safe); ($paths, $verbose, $safe) = @_; $arg->{verbose} = defined $verbose ? $verbose : 0; $arg->{safe} = defined $safe ? $safe : 0; if (defined($paths) and length($paths)) { $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); } else { _car" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8290000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL stat(0x828a500,0xbfbfd370) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Basename.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a480,0xbfbfd290) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Basename.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a500,0xbfbfd370) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Basename.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a480,0xbfbfd290) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Basename.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a500,0xbfbfd370) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Basename.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a480,0xbfbfd290) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Basename.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a500,0xbfbfd370) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Basename.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a480,0xbfbfd290) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Basename.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x828a580,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Basename.pm" 21495 perl5.8.8 RET open 8 21495 perl5.8.8 CALL break(0x8291000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x8,0xbfbfa890) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8292000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x8,0x8291000,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes "=head1 NAME File::Basename - Parse file paths into directory, filename and suffix. =head1 SYNOPSIS use File::Basename; ($name,$path,$suffix) = fileparse($fullname,@suffixlist); $name = fileparse($fullname,@suffixlist); $basename = basename($fullname,@suffixlist); $dirname = dirname($fullname); =head1 DESCRIPTION These routines allow you to parse file paths into their directory, fil\ ename and suffix. B: C and C emulate the behaviours, and quirks, of the shell and C functions of the same name. See each function's documentation for details. If your concern is just parsing paths it is safer to use L's C and C methods. It is guaranteed that # Where $path_separator is / for Unix, \\ for Windows, etc... dirname($path) . $path_separator . basename($path); is equivalent to the original path for all systems but VMS. =cut package File::Basename; # A bit of juggling to insure that C always works, si\ nce # File::Basename is used during the Perl build, when the re extension \ may # not be available. BEGIN { unless (eval { require re; }) { eval ' sub re::import { $^H |= 0x00100000; } ' } # HINT_RE_TAINT import re 'taint'; } use strict; use 5.006; use warnings; our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(fileparse fileparse_set_fstype basename dirname); $VERSION = "2.77"; fileparse_set_fstype($^O); =over 4 =item C X my($filename, $directories, $suffix) = fileparse($path); my($filename, $directories, $suffix) = fileparse($path, @suffixes)\ ; my $filename = fileparse($path, @suffixes)\ ; The C routine divides a file path into its $directories, \ $filename and (optionally) the filename $suffix. $directories contains everything up to and including the last directory separator in the $path including the volume (if applicable). The remainder of the $path is the $filename. # On Unix returns ("baz", "/foo/bar/", "") fileparse("/foo/bar/baz"); # On Windows returns ("baz", "C:\\foo\\bar\\", "") fileparse("C:\\foo\\bar\\baz"); # On Unix returns ("", "/foo/bar/baz/", "") fileparse("/foo/bar/baz/"); If @suffixes are given each element is a pattern (either a string or a C) matched against the end of the $filename. The matching portion is removed and becomes the $suffix. # On Unix returns ("baz", "/foo/bar/", ".txt") fileparse("/foo/bar/baz.txt", qr/\\.[^.]*/); If type is non-Unix (see C) then the pattern matching for suffix removal is performed case-insensitively, since those systems are not case-sensitive when opening existing files. You are guaranteed that C<$directories . $filename . $suffix> will denote the same location as the original $path. =cut sub fileparse { my($fullname,@suffices) = @_; unless (defined $fullname) { require Carp; Carp::croak("fileparse(): need a valid pathname"); } my $orig_type = ''; my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase); my($taint) = substr($fullname,0,0); # Is $fullname tainted? if ($type eq "VMS" and $fullname =~ m{/} ) { # We're doing Unix emulation $orig_type = $type; $type = 'Unix'; } my($dirpath, $basename); if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\\\\/])?)(.*)/s); $dirpath .= '.\\\\' unless $dirpath =~ /[\\\\\\/]\\z/; } elsif ($type eq "OS2") { ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\\\/])?)(.*)#s); $dirpath = './' unless $dirpath; # Can't be 0 $dirpath .= '/' unless $dirpath =~ m#[\\\\/]\\z#; } elsif ($type eq "MacOS") { ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s); $dirpath = ':' unless $dirpath; } elsif ($type eq "AmigaOS") { ($dirpath,$basename) = ($fullname =~ /(.*[:\\/])?(.*)/s); $dirpath = './' unless $dirpath; } elsif ($type eq 'VMS' ) { ($dirpath,$basename) = (" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8294000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x8,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x8295000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x828a800,0xbfbfcdf0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/re.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a780,0xbfbfcd10) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/re.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a800,0xbfbfcdf0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/re.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a780,0xbfbfcd10) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/re.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a800,0xbfbfcdf0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/re.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a780,0xbfbfcd10) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/re.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x828a880,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/re.pm" 21495 perl5.8.8 RET open 9 21495 perl5.8.8 CALL break(0x8296000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8297000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL fstat(0x9,0xbfbfa310) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x8298000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x9,0x8297000,0x1000) 21495 perl5.8.8 GIO fd 9 read 4096 bytes "package re; our $VERSION = 0.06_01; =head1 NAME re - Perl pragma to alter regular expression behaviour =head1 SYNOPSIS use re 'taint'; ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here $pat = '(?{ $foo = 1 })'; use re 'eval'; /foo${pat}bar/; # won't fail (when not under -T swi\ tch) { no re 'taint'; # the default ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here no re 'eval'; # the default /foo${pat}bar/; # disallowed (with or without -T sw\ itch) } use re 'debug'; # NOT lexically scoped (as others a\ re) /^(.*)$/s; # output debugging info during # compile and run time use re 'debugcolor'; # same as 'debug', but with colored\ output ... (We use $^X in these examples because it's tainted by default.) =head1 DESCRIPTION When C is in effect, and a tainted string is the targe\ t of a regex, the regex memories (or values returned by the m// operator in list context) are tainted. This feature is useful when regex opera\ tions on tainted data aren't meant to extract safe substrings, but to perfor\ m other transformations. When C is in effect, a regex is allowed to contain C<(?{ ... })> zero-width assertions even if regular expression contain\ s variable interpolation. That is normally disallowed, since it is a potential security risk. Note that this pragma is ignored when the re\ gular expression is obtained from tainted data, i.e. evaluation is always disallowed with tainted regular expressions. See L. For the purpose of this pragma, interpolation of precompiled regular expressions (i.e., the result of C) is I considered variabl\ e interpolation. Thus: /foo${pat}bar/ I allowed if $pat is a precompiled regular expression, even if $pat contains C<(?{ ... })> assertions. When C is in effect, perl emits debugging messages whe\ n compiling and using regular expressions. The output is the same as th\ at obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the B<-Dr> switch. It may be quite voluminous depending on the complexity of the match. Using C instead of C enables a form of output that can be used to get a colorful display on terminals that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a comma-separated list of C properties to use for highlighting strings on/off, pre-point part on/off. See L for additional info. The directive C is I, as the other directives are. It has both compile-time and run-time effects. See L. =cut # N.B. File::Basename contains a literal for 'taint' as a fallback. I\ f # taint is changed here, File::Basename must be updated as well. my %bitmask = ( taint => 0x00100000, # HINT_RE_TAINT eval => 0x00200000, # HINT_RE_EVAL ); sub setcolor { eval { # Ignore errors require Term::Cap; my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning\ . my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue'; my @props = split /,/, $props; my $colors = join "\\t", map {$terminal->Tputs($_,1)} @props; $colors =~ s/\\0//g; $ENV{PERL_RE_COLORS} = $colors; }; } my $installed = 0; sub _load_unload { my $on = shift; require XSLoader; XSLoader::load('re'); install($on); } sub bits { my $on = shift; my $bits = 0; unless (@_) { require Carp; Carp::carp("Useless use of \\"re\\" pragma"); } foreach my $idx (0..$#_){ my $s=$_[$idx]; if ($s eq 'debug' or $s eq 'debugcolor') { setcolor() if $s eq 'debugcolor'; _load_unload($on); } elsif (exists $bitmask{$s}) { $bits |= $bitmask{$s}; } else { require Carp; Carp::carp("Unknown \\"re\\" subpragma '$s' (known ones ar\ e: ", join(', ', map {qq('$_')} 'debug', 'debugcolor'\ , sort keys %bitmask), ")"); } } $bits; } sub import { shift; $^H |= bits(1, @_); } sub unimport { " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x829a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x9,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x829b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x829c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x829d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x829e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x9,0x8297000,0x1000) 21495 perl5.8.8 GIO fd 9 read 42 bytes " shift; $^H &= ~ bits(0, @_); } 1; " 21495 perl5.8.8 RET read 42/0x2a 21495 perl5.8.8 CALL read(0x9,0x8297000,0x1000) 21495 perl5.8.8 GIO fd 9 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x9) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL read(0x8,0x8291000,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes "$fullname =~ /^(.*[:>\\]])?(.*)/s); $dirpath ||= ''; # should always be defined } else { # Default to Unix semantics. ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s); if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.\ *)}) { # dev:[000000] is top of VMS tree, similar to Unix '/' # so strip it off and treat the rest as "normal" my $devspec = $1; my $remainder = $3; ($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s); $dirpath ||= ''; # should always be defined $dirpath = $devspec.$dirpath; } $dirpath = './' unless $dirpath; } my $tail = ''; my $suffix = ''; if (@suffices) { foreach $suffix (@suffices) { my $pat = ($igncase ? '(?i)' : '') . "($suffix)\\$"; if ($basename =~ s/$pat//s) { $taint .= substr($suffix,0,0); $tail = $1 . $tail; } } } # Ensure taint is propgated from the path to its pieces. $tail .= $taint; wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail) : ($basename .= $taint); } =item C X X my $filename = basename($path); my $filename = basename($path, @suffixes); This function is provided for compatibility with the Unix shell comman\ d C. It does B always return the file name portion of\ a path as you might expect. To be safe, if you want the file name porti\ on of a path use C. C returns the last level of a filepath even if the last level is clearly directory. In effect, it is acting like C for paths. This differs from C's behaviour. # Both return "bar" basename("/foo/bar"); basename("/foo/bar/"); @suffixes work as in C except all regex metacharacters ar\ e quoted. # These two function calls are equivalent. my $filename = basename("/foo/bar/baz.txt", ".txt"); my $filename = fileparse("/foo/bar/baz.txt", qr/\\Q.txt\\E/); Also note that in order to be compatible with the shell command, C does not strip off a suffix if it is identical to the remaining characters in the filename. =cut sub basename { my($path) = shift; # From BSD basename(1) # The basename utility deletes any prefix ending with the last slash\ `/' # character present in string (after first stripping trailing slashe\ s) _strip_trailing_sep($path); my($basename, $dirname, $suffix) = fileparse( $path, map("\\Q$_\\E",\ @_) ); # From BSD basename(1) # The suffix is not stripped if it is identical to the remaining # characters in string. if( length $suffix and !length $basename ) { $basename = $suffix; } # Ensure that basename '/' == '/' if( !length $basename ) { $basename = $dirname; } return $basename; } =item C X This function is provided for compatibility with the Unix shell command C and has inherited some of its quirks. In spite \ of its name it does B always return the directory name as you might expect. To be safe, if you want the directory name of a path use C. Only on VMS (where there is no ambiguity between the file and director\ y portions of a path) and AmigaOS (possibly due to an implementation qui\ rk in this module) does C work like C, returnin\ g just the $directories. # On VMS and AmigaOS my $directories = dirname($path); When using Unix or MSDOS syntax this emulates the C shell \ function which is subtly different from how C works. It returns a\ ll but the last level of a file path even if the last level is clearly a dire\ ctory. In effect, it is not returning the directory portion but simply the pa\ th one level up acting like C for file paths. Also unlike C, C does not include a trailing s\ lash on its returned path. # returns /foo/bar. fileparse() would return /foo/bar/ dirname("/foo/bar/baz"); # also returns /foo/bar despite the fact that baz is clearly a # directory. fileparse() would return /foo/bar" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x829f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x8,0x8291000,0x1000) 21495 perl5.8.8 GIO fd 8 read 3136 bytes "/baz/ dirname("/foo/bar/baz/"); # returns '.'. fileparse() would return 'foo/' dirname("foo/"); Under VMS, if there is no directory information in the $path, then the current default device and directory is used. =cut sub dirname { my $path = shift; my($type) = $Fileparse_fstype; if( $type eq 'VMS' and $path =~ m{/} ) { # Parse as Unix local($File::Basename::Fileparse_fstype) = ''; return dirname($path); } my($basename, $dirname) = fileparse($path); if ($type eq 'VMS') { $dirname ||= $ENV{DEFAULT}; } elsif ($type eq 'MacOS') { if( !length($basename) && $dirname !~ /^[^:]+:\\z/) { _strip_trailing_sep($dirname); ($basename,$dirname) = fileparse $dirname; } $dirname .= ":" unless $dirname =~ /:\\z/; } elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { _strip_trailing_sep($dirname); unless( length($basename) ) { ($basename,$dirname) = fileparse $dirname; _strip_trailing_sep($dirname); } } elsif ($type eq 'AmigaOS') { if ( $dirname =~ /:\\z/) { return $dirname } chop $dirname; $dirname =~ s{[^:/]+\\z}{} unless length($basename); } else { _strip_trailing_sep($dirname); unless( length($basename) ) { ($basename,$dirname) = fileparse $dirname; _strip_trailing_sep($dirname); } } $dirname; } # Strip the trailing path separator. sub _strip_trailing_sep { my $type = $Fileparse_fstype; if ($type eq 'MacOS') { $_[0] =~ s/([^:]):\\z/$1/s; } elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) { $_[0] =~ s/([^:])[\\\\\\/]*\\z/$1/; } else { $_[0] =~ s{(.)/*\\z}{$1}s; } } =item C X my $type = fileparse_set_fstype(); my $previous_type = fileparse_set_fstype($type); Normally File::Basename will assume a file path type native to your cu\ rrent operating system (ie. /foo/bar style on Unix, \\foo\\bar on Windows, e\ tc...). With this function you can override that assumption. Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS", "MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility), "Epoc" and "Unix" (all case-insensitive). If an unrecognized $type is given "Unix" will be assumed. If you've selected VMS syntax, and the file specification you pass to one of these routines contains a "/", they assume you are using Unix emulation and apply the Unix syntax rules instead, for that function call only. =back =cut BEGIN { my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Ep\ oc); my @Types = (@Ignore_Case, qw(Unix)); sub fileparse_set_fstype { my $old = $Fileparse_fstype; if (@_) { my $new_type = shift; $Fileparse_fstype = 'Unix'; # default foreach my $type (@Types) { $Fileparse_fstype = $type if $new_type =~ /^$type/i; } $Fileparse_igncase = (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0; } return $old; } } 1; =head1 SEE ALSO L, L, L " 21495 perl5.8.8 RET read 3136/0xc40 21495 perl5.8.8 CALL break(0x82a1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x8,0x8291000,0x1000) 21495 perl5.8.8 GIO fd 8 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x8) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL break(0x82a8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82a9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82aa000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ab000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ac000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ad000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ae000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828d000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "p ("No root path(s) specified\\n"); return 0; } } else { if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH')) { $arg = pop @_; ${$arg->{error}} = [] if exists $arg->{error}; ${$arg->{result}} = [] if exists $arg->{result}; } else { @{$arg}{qw(verbose safe)} = (0, 0); } $paths = [@_]; } $arg->{prefix} = ''; $arg->{depth} = 0; $arg->{cwd} = getcwd() or do { _error($arg, "cannot fetch initial working directory"); return 0; }; for ($arg->{cwd}) { /\\A(.*)\\Z/; $_ = $1 } # untaint @{$arg}{qw(device inode)} = (stat $arg->{cwd})[0,1] or do { _error($arg, "cannot stat initial working directory", $arg->{c\ wd}); return 0; }; return _rmtree($arg, $paths); } sub _rmtree { my $arg = shift; my $paths = shift; my $count = 0; my $curdir = File::Spec->curdir(); my $updir = File::Spec->updir(); my (@files, $root); ROOT_DIR: foreach $root (@$paths) { if ($Is_MacOS) { $root = ":$root" unless $root =~ /:/; $root .= ":" unless $root =~ /:\\z/; } else { $root =~ s{/\\z}{}; } # since we chdir into each directory, it may not be obvious # to figure out where we are if we generate a message about # a file name. We therefore construct a semi-canonical # filename, anchored from the directory being unlinked (as # opposed to being truly canonical, anchored from the root (/)\ . my $canon = $arg->{prefix} ? File::Spec->catfile($arg->{prefix}, $root) : $root ; my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_D\ IR; if ( -d _ ) { $root = VMS::Filespec::pathify($root) if $Is_VMS; if (!chdir($root)) { # see if we can escalate privileges to get in # (e.g. funny protection mask such as -w- instead of r\ wx) $perm &= 07777; my $nperm = $perm | 0700; if (!($arg->{safe} or $nperm == $perm or chmod($nperm,\ $root))) { _error($arg, "cannot make child directory read-wri\ te-exec", $canon); next ROOT_DIR; } elsif (!chdir($root)) { _error($arg, "cannot chdir to child", $canon); next ROOT_DIR; } } my ($device, $inode, $perm) = (stat $curdir)[0,1,2] or do \ { _error($arg, "cannot stat current working directory", \ $canon); next ROOT_DIR; }; ($ldev eq $device and $lino eq $inode) or _croak("directory $canon changed before chdir, expe\ cted dev=$ldev inode=$lino, actual dev=$device ino=$inode, aborting.")\ ; $perm &= 07777; # don't forget setuid, setgid, sticky bits my $nperm = $perm | 0700; # notabene: 0700 is for making readable in the first place\ , # it's also intended to change it to writable in case we h\ ave # to recurse in which case we are better than rm -rf for # subtrees with strange permissions if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $cu\ rdir))) { _error($arg, "cannot make directory read+writeable", $\ canon); $nperm = $perm; } my $d; $d = gensym() if $] < 5.006; if (!opendir $d, $curdir) { _error($arg, "cannot opendir", $canon); @files = (); } else { no strict 'refs'; if (!defined ${"\\cTAINT"} or ${"\\cTAINT"}) { # Blindly untaint dir names if taint mode is # active, or any perl < 5.006 @files = map { /\\A(.*)\\z/s; $1 } readdir $d; } else { @files = readdir $d; } " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82af000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828d000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes " closedir $d; } if ($Is_VMS) { # Deleting large numbers of files from VMS Files-11 # filesystems is faster if done in reverse ASCIIbetica\ l order. # include '.' to '.;' from blead patch #31775 @files = map {$_ eq '.' ? '.;' : $_} reverse @files; ($root = VMS::Filespec::unixify($root)) =~ s/\\.dir\\z\ //; } @files = grep {$_ ne $updir and $_ ne $curdir} @files; if (@files) { # remove the contained files before the directory itse\ lf my $narg = {%$arg}; @{$narg}{qw(device inode cwd prefix depth)} = ($device, $inode, $updir, $canon, $arg->{depth}+\ 1); $count += _rmtree($narg, \\@files); } # restore directory permissions of required now (in case t\ he rmdir # below fails), while we are still in the directory and ma\ y do so # without a race via '.' if ($nperm != $perm and not chmod($perm, $curdir)) { _error($arg, "cannot reset chmod", $canon); } # don't leave the client code in an unexpected directory chdir($arg->{cwd}) or _croak("cannot chdir to $arg->{cwd} from $canon: $!\ , aborting."); # ensure that a chdir upwards didn't take us somewhere oth\ er # than we expected (see CVE-2002-0435) ($device, $inode) = (stat $curdir)[0,1] or _croak("cannot stat prior working directory $arg->{\ cwd}: $!, aborting."); ($arg->{device} eq $device and $arg->{inode} eq $inode) or _croak("previous directory $arg->{cwd} changed befo\ re entering $canon, expected dev=$ldev inode=$lino, actual dev=$device\ ino=$inode, aborting."); if ($arg->{depth} or !$arg->{keep_root}) { if ($arg->{safe} && ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w\ $root)) { print "skipped $root\\n" if $arg->{verbose}; next ROOT_DIR; } if (!chmod $perm | 0700, $root) { if ($Force_Writeable) { _error($arg, "cannot make directory writeable"\ , $canon); } } print "rmdir $root\\n" if $arg->{verbose}; if (rmdir $root) { push @{${$arg->{result}}}, $root if $arg->{result}\ ; ++$count; } else { _error($arg, "cannot remove directory", $canon); if (!chmod($perm, ($Is_VMS ? VMS::Filespec::fileif\ y($root) : $root)) ) { _error($arg, sprintf("cannot restore permissio\ ns to 0%o",$perm), $canon); } } } } else { # not a directory $root = VMS::Filespec::vmsify("./$root") if $Is_VMS && !File::Spec->file_name_is_absolute($root) && ($root !~ m/(?]+/); # not already in\ VMS syntax if ($arg->{safe} && ($Is_VMS ? !&VMS::Filespec::candelete($root) : !(-l $root || -w $root))) { print "skipped $root\\n" if $arg->{verbose}; next ROOT_DIR; } my $nperm = $perm & 07777 | 0600; if ($nperm != $perm and not chmod $nperm, $root) { if ($Force_Writeable) { _error($arg, "cannot make file writeable", $canon)\ ; } } print "unlink $canon\\n" if $arg->{verbose}; # delete all versions under VMS for (;;) { if (unlink $root) { push @{${$arg->{result}}}, $root if $arg->{result}\ ; } else { _error($arg, "cannot unlink file", $canon); $Force_Writea" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82b6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82b9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ba000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82bb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82bc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82bd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828d000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "ble and chmod($perm, $root) or _error($arg, sprintf("cannot restore permissio\ ns to 0%o",$perm), $canon); last; } ++$count; last unless $Is_VMS && lstat $root; } } } return $count; } 1; __END__ =head1 NAME File::Path - Create or remove directory trees =head1 VERSION This document describes version 2.04 of File::Path, released 2007-11-13. =head1 SYNOPSIS use File::Path; # modern mkpath( 'foo/bar/baz', '/zug/zwang', {verbose => 1} ); rmtree( 'foo/bar/baz', '/zug/zwang', { verbose => 1, error => \\my $err_list } ); # traditional mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); =head1 DESCRIPTION The C function provides a convenient way to create directories of arbitrary depth. Similarly, the C function provides a convenient way to delete an entire directory subtree from the filesystem, much like the Unix command C. Both functions may be called in one of two ways, the traditional, compatible with code written since the dawn of time, and modern, that offers a more flexible and readable idiom. New code should use the modern interface. =head2 FUNCTIONS The modern way of calling C and C is with a list of directories to create, or remove, respectively, followed by an optional hash reference containing keys to control the function's behaviour. =head3 C The following keys are recognised as parameters to C. The function returns the list of files actually created during the call. my @created = mkpath( qw(/tmp /flub /home/nobody), {verbose => 1, mode => 0750}, ); print "created $_\\n" for @created; =over 4 =item mode The numeric permissions mode to apply to each created directory (defaults to 0777), to be modified by the current C. If the directory already exists (and thus does not need to be created), the permissions will not be modified. C is recognised as an alias for this parameter. =item verbose If present, will cause C to print the name of each directory as it is created. By default nothing is printed. =item error If present, will be interpreted as a reference to a list, and will be used to store any errors that are encountered. See the ERROR HANDLING section for more information. If this parameter is not used, certain error conditions may raise a fatal error that will cause the program will halt, unless trapped in an C block. =back =head3 C =over 4 =item verbose If present, will cause C to print the name of each file as it is unlinked. By default nothing is printed. =item safe When set to a true value, will cause C to skip the files for which the process lacks the required privileges needed to delete files, such as delete privileges on VMS. In other words, the code will make no attempt to alter file permissions. Thus, if the process is interrupted, no filesystem object will be left in a more permissive mode. =item keep_root When set to a true value, will cause all files and subdirectories to be removed, except the initially specified directories. This comes in handy when cleaning out an application's scratch directory. rmtree( '/tmp', {keep_root => 1} ); =item result If present, will be interpreted as a reference to a list, and will be used to store the list of all files and directories unlinked during the call. If nothing is unlinked, a reference to an empty list is returned (rather than C). rmtree( '/tmp', {result => \\my $list} ); print "unlinked $_\\n" for @$list; This is a useful alternative to the C key. =item error If present, will be interpreted as a reference to a list, and will be used to store any errors that are encountered. See the ERROR HANDLING section for more information. Removing things is a much more dangerous proposition than creating things. As such, there are certain conditions that C may encounter that are" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/PAR/Dist.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/PAR/Dist.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/PAR/Dist.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/PAR/Dist.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/PAR/Dist.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a400,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/PAR/Dist.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x828a280,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/PAR/Dist.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x82a1b00,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/PAR/Dist.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfae70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package PAR::Dist; require Exporter; use vars qw/$VERSION @ISA @EXPORT @EXPORT_OK $DEBUG/; $VERSION = '0.39'; @ISA = 'Exporter'; @EXPORT = qw/ blib_to_par install_par uninstall_par sign_par verify_par merge_par remove_man get_meta generate_blib_stub /; @EXPORT_OK = qw/ parse_dist_name contains_binaries /; $DEBUG = 0; use strict; use Carp qw/carp croak/; use File::Spec; =head1 NAME PAR::Dist - Create and manipulate PAR distributions =head1 VERSION This document describes version 0.38 of PAR::Dist, released October 16\ , 2008. =head1 SYNOPSIS As a shell command: % perl -MPAR::Dist -eblib_to_par In programs: use PAR::Dist; my $dist = blib_to_par(); # make a PAR file using ./blib/ install_par($dist); # install it into the system uninstall_par($dist); # uninstall it from the system sign_par($dist); # sign it using Module::Signature verify_par($dist); # verify it using Module::Signature install_par("http://foo.com/DBI-1.37-MSWin32-5.8.0.par"); # works \ too install_par("http://foo.com/DBI-1.37"); # auto-appends archname + \ perlver install_par("cpan://SMUELLER/PAR-Packer-0.975"); # uses CPAN autho\ r directory =head1 DESCRIPTION This module creates and manipulates I. They are architecture-specific B files, containing everything under F of CPAN distributions after their C or C stage, a F describing metadata of the original CPAN distribution, and a F detailing all files within it. Digitally signed PAR distributions will also contain a F file. The naming convention for such distributions is: $NAME-$VERSION-$ARCH-$PERL_VERSION.par For example, C corresponds to th\ e 0.01 release of C on CPAN, built for perl 5.8.0 running on C. =head1 FUNCTIONS Several functions are exported by default. Unless otherwise noted, they can take either a hash of named arguments, a single argument (taken as C<$path> by C and C<$dist> by other functions), or no arguments (in which case the first PAR file in the current directory is used). Therefore, under a directory containing only a single F, all invocations below are equivalent: % perl -MPAR::Dist -e"install_par( dist => 'test.par' )" % perl -MPAR::Dist -e"install_par( 'test.par' )" % perl -MPAR::Dist -einstall_par; If C<$dist> resembles a URL, C is called to mirro\ r it locally under C<$ENV{PAR_TEMP}> (or C<$TEMP/par/> if unspecified), and\ the function will act on the fetched local file instead. If the URL begin\ s with C, it will be expanded automatically to the autho\ r's CPAN directory (e.g. C). If C<$dist> does not have a file extension beginning with a letter or underscore, a dash and C<$suffix> ($ARCH-$PERL_VERSION.par by default) will be appended to it. =head2 blib_to_par Takes key/value pairs as parameters or a single parameter indicating t\ he path that contains the F subdirectory. Builds a PAR distribution from the F subdirectory under C\ , or under the current directory if unspecified. If F does not exis\ t, it automatically runs F, F, F or F\ to create it. Returns the filename or the generated PAR distribution. Valid parameters are: =over 2 =item path Sets the path which contains the F subdirectory from which the \ PAR distribution will be generated. =item name, version, suffix These attributes set the name, version and platform specific suffix of the distribution. Name and version can be automatically determined from the distributions F or F files. The suffix is generated from your architecture name and your version o\ f perl by default. =item dist The output filename for the PAR distribution. =item quiet Set to true to suppress as much output as possible. =back =cut sub blib_to_par { @_ = (path => @_) if @_ == 1; my %args = @_" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82bf000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x82c0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "; require Config; # don't use 'my $foo ... if ...' it creates a static variable! my $quiet = $args{quiet} || 0; my $dist; my $path = $args{path}; $dist = File::Spec->rel2abs($args{dist}) if $args{dist}; my $name = $args{name}; my $version = $args{version}; my $suffix = $args{suffix} || "$Config::Config{archname}-$Config:\ :Config{version}.par"; my $cwd; if (defined $path) { require Cwd; $cwd = Cwd::cwd(); chdir $path; } _build_blib() unless -d "blib"; my @files; open MANIFEST, ">", File::Spec->catfile("blib", "MANIFEST") or die\ $!; open META, ">", File::Spec->catfile("blib", "META.yml") or die $!; require File::Find; File::Find::find( sub { next unless $File::Find::name; (-r && !-d) and push ( @files, substr($File::Find::name, 5) ); } , 'blib' ); print MANIFEST join( "\\n", ' ', (sort @files), q( # ) ); close MANIFEST; if (open(OLD_META, "META.yml")) { while () { if (/^distribution_type:/) { print META "distribution_type: par\\n"; } else { print META $_; } if (/^name:\\s+(.*)/) { $name ||= $1; $name =~ s/::/-/g; } elsif (/^version:\\s+.*Module::Build::Version/) { while () { /^\\s+original:\\s+(.*)/ or next; $version ||= $1; last; } } elsif (/^version:\\s+(.*)/) { $version ||= $1; } } close OLD_META; close META; } if ((!$name or !$version) and open(MAKEFILE, "Makefile")) { while () { if (/^DISTNAME\\s+=\\s+(.*)$/) { $name ||= $1; } elsif (/^VERSION\\s+=\\s+(.*)$/) { $version ||= $1; } } } if (not defined($name) or not defined($version)) { # could not determine name or version. Error. my $what; if (not defined $name) { $what = 'name'; $what .= ' and version' if not defined $version; } elsif (not defined $version) { $what = 'version'; } carp("I was unable to determine the $what of the PAR distribut\ ion. Please create a Makefile or META.yml file from which we can infer\ the information or just specify the missing information as an option \ to blib_to_par."); return(); } $name =~ s/\\s+$//; $version =~ s/\\s+$//; my $file = "$name-$version-$suffix"; unlink $file if -f $file; print META << "YAML" if fileno(META); name: $name version: $version build_requires: {} conflicts: {} dist_name: $file distribution_type: par dynamic_config: 0 generated_by: 'PAR::Dist version $PAR::Dist::VERSION' license: unknown YAML close META; mkdir('blib', 0777); chdir('blib'); require Cwd; my $zipoutfile = File::Spec->catfile(File::Spec->updir, $file); _zip(dist => $zipoutfile); chdir(File::Spec->updir); unlink File::Spec->catfile("blib", "MANIFEST"); unlink File::Spec->catfile("blib", "META.yml"); $dist ||= File::Spec->catfile($cwd, $file) if $cwd; if ($dist and $file ne $dist) { rename( $file => $dist ); $file = $dist; } my $pathname = File::Spec->rel2abs($file); if ($^O eq 'MSWin32') { $pathname =~ s!\\\\!/!g; $pathname =~ s!:!|!g; }; print << "." if !$quiet; Successfully created binary distribution '$file'. Its contents are accessible in compliant b" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82c2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82c9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ca000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82cb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82cc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "rowsers as: jar:file://$pathname!/MANIFEST . chdir $cwd if $cwd; return $file; } sub _build_blib { if (-e 'Build') { _system_wrapper($^X, "Build"); } elsif (-e 'Makefile') { _system_wrapper($Config::Config{make}); } elsif (-e 'Build.PL') { _system_wrapper($^X, "Build.PL"); _system_wrapper($^X, "Build"); } elsif (-e 'Makefile.PL') { _system_wrapper($^X, "Makefile.PL"); _system_wrapper($Config::Config{make}); } } =head2 install_par Installs a PAR distribution into the system, using C. Valid parameters are: =over 2 =item dist The .par file to install. The heuristics outlined in the B section above apply. =item prefix This string will be prepended to all installation paths. If it isn't specified, the environment variable C is used as a prefix. =item uninstall_shadows This corresponds to the C option of L. Quoting its manual: If C is set to true, any differing versions through\ out C<@INC> will be uninstalled. This is C. =item verbose This corresponds to the C option of L. Acc\ ording to its manual: If C is true, will print out each file removed. This is C. C values going up to 5 show increasingly more diagnostics out\ put. Default verbosity for PAR::Dist is 1. =back Additionally, you can use several parameters to change the default installation destinations. You don't usually have to worry about this unless you are installing into a user-local directory. The following section outlines the parameter names and default setting\ s: Parameter From To inst_lib blib/lib $Config{installsitelib} (*) inst_archlib blib/arch $Config{installsitearch} inst_script blib/script $Config{installscript} inst_bin blib/bin $Config{installbin} inst_man1dir blib/man1 $Config{installman1dir} inst_man3dir blib/man3 $Config{installman3dir} packlist_read $Config{sitearchexp}/auto/$name/.pac\ klist packlist_write $Config{installsitearch}/auto/$name/\ .packlist The C parameter is used to control where the F<.packli\ st> file is written to. (Necessary for uninstallation.) The C parameter specifies a .packlist file to merge in \ if it exists. By setting any of the above installation targets to C, you can remove that target altogether. For example, passing C undef, inst_man3dir => undef> means that the contain\ ed manual pages won't be installed. This is not available for the packlis\ ts. Finally, you may specify a C parameter. Its value shou\ ld be a reference to a hash of custom installation targets such as custom_targets => { 'blib/my_data' => '/some/path/my_data' } You can use this to install the F<.par> archives contents to arbitrary locations. If only a single parameter is given, it is treated as the C parameter. =cut sub install_par { my %args = &_args; _install_or_uninstall(%args, action => 'install'); } =head2 uninstall_par Uninstalls all previously installed contents of a PAR distribution, using C. Takes almost the same parameters as C, but naturally, the installation target parameters do not apply. The only exception to this is the C parameter which specifies the F<.packlist> file to read the list of installed files from. It defaults to C<$Config::Config{installsitearch}/auto/$name/.packlist\ >. Additionally, the C parameter of C isn't available. =cut sub uninstall_par { my %args = &_args; _install_or_uninstall(%args, action => 'uninstall'); } sub _install_or_uninstall { my %args = &_args; my $name = $args{name}; my $action = $args{action}; my %ENV_copy = %ENV; $ENV{PERL_INSTALL_ROOT} = $args{prefix} if " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82cd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ce000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82cf000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "defined $args{prefix}; require Cwd; my $old_dir = Cwd::cwd(); my ($dist, $tmpdir) = _unzip_to_tmpdir( dist => $args{dist}, subdi\ r => 'blib' ); if ( open (META, File::Spec->catfile('blib', 'META.yml')) ) { while () { next unless /^name:\\s+(.*)/; $name = $1; $name =~ s/\\s+$//; last; } close META; } return if not defined $name or $name eq ''; if (-d 'script') { require ExtUtils::MY; foreach my $file (glob("script/*")) { next unless -T $file; ExtUtils::MY->fixin($file); chmod(0555, $file); } } $name =~ s{::|-}{/}g; require ExtUtils::Install; my $rv; if ($action eq 'install') { my $target = _installation_target( File::Spec->curdir, $name, \ \\%args ); my $custom_targets = $args{custom_targets} || {}; $target->{$_} = $custom_targets->{$_} foreach keys %{$custom_t\ argets}; my $uninstall_shadows = $args{uninstall_shadows}; my $verbose = $args{verbose}; $rv = ExtUtils::Install::install($target, $verbose, 0, $uninst\ all_shadows); } elsif ($action eq 'uninstall') { require Config; my $verbose = $args{verbose}; $rv = ExtUtils::Install::uninstall( $args{packlist_read}||"$Config::Config{installsitearch}/au\ to/$name/.packlist", $verbose ); } %ENV = %ENV_copy; chdir($old_dir); File::Path::rmtree([$tmpdir]); return $rv; } # Returns the default installation target as used by # ExtUtils::Install::install(). First parameter should be the base # directory containing the blib/ we're installing from. # Second parameter should be the name of the distribution for the pack\ list # paths. Third parameter may be a hash reference with user defined key\ s for # the target hash. In fact, any contents that do not start with 'inst_\ ' are # skipped. sub _installation_target { require Config; my $dir = shift; my $name = shift; my $user = shift || {}; # accepted sources (and user overrides) my %sources = ( inst_lib => File::Spec->catdir($dir,"blib","lib"), inst_archlib => File::Spec->catdir($dir,"blib","arch"), inst_bin => File::Spec->catdir($dir,'blib','bin'), inst_script => File::Spec->catdir($dir,'blib','script'), inst_man1dir => File::Spec->catdir($dir,'blib','man1'), inst_man3dir => File::Spec->catdir($dir,'blib','man3'), packlist_read => 'read', packlist_write => 'write', ); # default targets my $target = { read => $Config::Config{sitearchexp}."/auto/$name/.packlist", write => $Config::Config{installsitearch}."/auto/$name/.packlis\ t", $sources{inst_lib} => (_directory_not_empty($sources{inst_archlib})) ? $Config::Config{installsitearch} : $Config::Config{installsitelib}, $sources{inst_archlib} => $Config::Config{installsitearch}, $sources{inst_bin} => $Config::Config{installbin} , $sources{inst_script} => $Config::Config{installscript}, $sources{inst_man1dir} => $Config::Config{installman1dir}, $sources{inst_man3dir} => $Config::Config{installman3dir}, }; # Included for future support for ${flavour}perl external lib inst\ allation # if ($Config::Config{flavour_perl}) { # my $ext = File::Spec->catdir($dir, 'blib', 'ext'); # # from => to # $sources{inst_external_lib} = File::Spec->catdir($ext, 'li\ b'); # $sources{inst_external_bin} = File::Spec->catdir($ext, 'bi\ n'); # $sources{inst_external_include} = File::Spec->catdir($ext, 'i\ nclude'); # $sources{inst_external_src} = File::Spec->catdir($ext, 'sr\ c'); # $target->{ $sources{inst_external_lib} } = $Config::Confi\ g{flavour_install_lib}; # $target->{ $sources{inst_external_bin} } = $Config::Confi\ g{flavour_install_bin}; # $target->{ $sources{inst_external_include} } = $Config::Confi\ g{flavour_install_inclu" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82d0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL stat(0x82c7780,0xbfbfd2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Glob.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82c7700,0xbfbfd1e0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Glob.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82c7780,0xbfbfd2c0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Glob.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82c7700,0xbfbfd1e0) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Glob.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82c7780,0xbfbfd2c0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Glob.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82c7700,0xbfbfd1e0) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Glob.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x82c7800,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Glob.pm" 21495 perl5.8.8 RET open 8 21495 perl5.8.8 CALL fstat(0x8,0xbfbfa7e0) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL break(0x82d1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x8,0x82d0000,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes "package File::Glob; use strict; our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $AUTOLOAD, $DEFAULT_FLAGS); use XSLoader (); @ISA = qw(Exporter); # NOTE: The glob() export is only here for compatibility with 5.6.0. # csh_glob() should not be used directly, unless you know what you're \ doing. @EXPORT_OK = qw( csh_glob bsd_glob glob GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_CSH GLOB_ERR GLOB_ERROR GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE ); %EXPORT_TAGS = ( 'glob' => [ qw( GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_CSH GLOB_ERR GLOB_ERROR GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE glob bsd_glob ) ], ); $VERSION = '1.06'; sub import { require Exporter; my $i = 1; while ($i < @_) { if ($_[$i] =~ /^:(case|nocase|globally)$/) { splice(@_, $i, 1); $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case'; $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase'; if ($1 eq 'globally') { local $^W; *CORE::GLOBAL::glob = \\&File::Glob::csh_glob; } next; } ++$i; } goto &Exporter::import; } sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant(\ ) # XS function. If a constant is not found then control is passed # to the AUTOLOAD in AutoLoader. my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; my ($error, $val) = constant($constname); if ($error) { require Carp; Carp::croak($error); } eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } XSLoader::load 'File::Glob', $VERSION; # Preloaded methods go here. sub GLOB_ERROR { return (constant('GLOB_ERROR'))[1]; } sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() | GLOB_ALPHASORT() } $DEFAULT_FLAGS = GLOB_CSH(); if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) { $DEFAULT_FLAGS |= GLOB_NOCASE(); } # Autoload methods go after =cut, and are processed by the autosplit p\ rogram. sub bsd_glob { my ($pat,$flags) = @_; $flags = $DEFAULT_FLAGS if @_ < 2; return doglob($pat,$flags); } # File::Glob::glob() is deprecated because its prototype is different \ from # CORE::glob() (use bsd_glob() instead) sub glob { splice @_, 1; # don't pass PL_glob_index as flags! goto &bsd_glob; } ## borrowed heavily from gsar's File::DosGlob my %iter; my %entries; sub csh_glob { my $pat = shift; my $cxix = shift; my @pat; # glob without args defaults to $_ $pat = $_ unless defined $pat; # extract patterns $pat =~ s/^\\s+//; # Protect against empty elements in $pat =~ s/\\s+$//; # things like < *.c> and <*.c >. # These alone shouldn't trigger ParseWords. if ($pat =~ /\\s/) { # XXX this is needed for compatibility with the csh # implementation in Perl. Need to support a flag # to disable this behavior. require Text::ParseWords; @pat = Text::ParseWords::parse_line('\\s+',0,$pat); } # assume global context if not provided one $cxix = '_G_' unless defined $cxix; $iter{$cxix} = 0 unless exists $iter{$cxix}; # if we're just beginning, do it all first if ($iter{$cxix} == 0) { if (@pat) { $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pa\ t ]; } else { $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ]; } } # chuck it all out, quick or slow if (wantarray) { delete $iter{$cxix}; return @{delete $entries{$cxix}}; } else { if ($iter{$cxix} = scalar @{$entries{$cxix}}) { return shift @{$entries{$cxix}}; } else { # return undef for EOL delete $iter{$cxix}; delete $entries{$cxix}; return undef; } } } 1; __END__ =head1 NAME Fil" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82d3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x8,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x82d4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82d5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82d6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82d7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82d8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82d9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82da000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82db000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82dc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82dd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x8) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/File/Glob/Glob.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/File/Glob/Glob.so" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/File/Glob/Glob.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfd390) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL open(0x28192100,0,0xbfbfd2e8) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/auto/File/Glob/Glob.so" 21495 perl5.8.8 RET open 8 21495 perl5.8.8 CALL fstat(0x8,0xbfbfd370) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x8,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 2410 0000 3400 0000 |........$...4...| 0x0020 a081 0000 0000 0000 3400 2000 0300 2800 |........4. ...(.| 0x0030 1e00 1b00 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 8a38 0000 8a38 0000 0500 0000 |.....8...8......| 0x0050 0010 0000 0100 0000 8c38 0000 8c48 0000 |.........8...H..| 0x0060 8c48 0000 b401 0000 d401 0000 0600 0000 |.H..............| 0x0070 0010 0000 0200 0000 9838 0000 9848 0000 |.........8...H..| 0x0080 9848 0000 a000 0000 a000 0000 0600 0000 |.H..............| 0x0090 0400 0000 4300 0000 5900 0000 3100 0000 |....C...Y...1...| 0x00a0 5600 0000 1d00 0000 3a00 0000 2e00 0000 |V.......:.......| 0x00b0 3500 0000 0000 0000 0000 0000 0000 0000 |5...............| 0x00c0 0000 0000 4c00 0000 0000 0000 4200 0000 |....L.......B...| 0x00d0 0000 0000 4400 0000 4300 0000 3400 0000 |....D...C...4...| 0x00e0 0000 0000 4b00 0000 1e00 0000 0000 0000 |....K...........| 0x00f0 5000 0000 0000 0000 0000 0000 4d00 0000 |P...........M...| 0x0100 1c00 0000 4800 0000 3700 0000 0000 0000 |....H...7.......| 0x0110 4e00 0000 0000 0000 5700 0000 0000 0000 |N.......W.......| 0x0120 0000 0000 1b00 0000 0000 0000 2600 0000 |............&...| 0x0130 3000 0000 4a00 0000 0000 0000 0000 0000 |0...J...........| 0x0140 3300 0000 0000 0000 4100 0000 0000 0000 |3.......A.......| 0x0150 5200 0000 5100 0000 0000 0000 0000 0000 |R...Q...........| 0x0160 4500 0000 4f00 0000 5800 0000 0000 0000 |E...O...X.......| 0x0170 0000 0000 2d00 0000 0000 0000 0000 0000 |....-...........| 0x0180 0000 0000 5300 0000 2900 0000 2c00 0000 |....S...)...,...| 0x0190 5500 0000 4700 0000 4000 0000 0000 0000 |U...G...@.......| 0x01a0 2500 0000 3c00 0000 0000 0000 0000 0000 |%...<...........| 0x01b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x01f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0200 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0210 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0220 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0230 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0240 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0250 0000 0000 0000 0000 1f00 0000 2a00 0000 |............*...| 0x0260 0000 0000 2400 0000 2100 0000 0000 0000 |....$...!.......| 0x0270 2f00 0000 0000 0000 2800 0000 2000 0000 |/.......(... ...| 0x0280 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0290 3900 0000 0000 0000 0000 0000 0000 0000 |9...............| 0x02a0 0000 0000 0000 0000 0000 0000 3b00 0000 |............;...| 0x02b0 0000 0000 2700 0000 0000 0000 3f00 0000 |....'.......?...| 0x02c0 0000 0000 3d00 0000 3200 0000 4600 0000 |....=...2...F...| 0x02d0 2300 0000 2b00 0000 0000 0000 0000 0000 |#...+...........| 0x02e0 2200 0000 0000 0000 3800 0000 3600 0000 |".......8...6...| 0x02f0 0000 0000 0000 0000 0000 0000 4900 0000 |............I...| 0x0300 5400 0000 0000 0000 3e00 0000 0000 0000 |T.......>.......| 0x0310 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0320 9400 0000 0000 0000 0300 0100 0000 0000 |................| 0x0330 0c03 0000 0000 0000 0300 0200 0000 0000 |................| 0x0340 9c08 0000 0000 0000 0300 0300 0000 0000 |................| 0x0350 a00b 0000 0000 0000 0300 0400 0000 0000 |................| 0x0360 400c 0000 0000 0000 0300 0500 0000 0000 |@...............| 0x0370 800d 0000 0000 0000 0300 0600 0000 0000 |................| 0x0380 940d 0000 0000 0000 0300 0700 0000 0000 |................| 0x0390 2410 0000 0000 0000 0300 0800 0000 0000 |$...............| 0x03a0 4c35 0000 0000 0000 0300 0900 0000 0000 |L5..............| 0x03b0 5835 0000 0000 0000 0300 0a00 0000 0000 |X5..............| 0x03c0 8c48 0000 0000 0000 0300 0b00 0000 0000 |.H..............| 0x03d0 9448 0000 0000 0000 0300 0c00 0000 0000 |.H..............| 0x03e0 9848 0000 0000 0000 0300 0d00 0000 0000 |.H..............| 0x03f0 3849 0000 0000 0000 0300 0e00 0000 0000 |8I..............| 0x0400 4049 0000 0000 0000 0300 0f00 0000 0000 |@I..............| 0x0410 4849 0000 0000 0000 0300 1000 0000 0000 |HI..............| 0x0420 4c49 0000 0000 0000 0300 1100 0000 0000 |LI..............| 0x0430 404a 0000 0000 0000 0300 1200 0000 0000 |@J..............| 0x0440 0000 0000 0000 0000 0300 1300 0000 0000 |................| 0x0450 0000 0000 0000 0000 0300 1400 0000 0000 |................| 0x0460 0000 0000 0000 0000 0300 1500 0000 0000 |................| 0x0470 0000 0000 0000 0000 0300 1600 0000 0000 |................| 0x0480 0000 0000 0000 0000 0300 1700 0000 0000 |................| 0x0490 0000 0000 0000 0000 0300 1800 0000 0000 |................| 0x04a0 0000 0000 0000 0000 0300 1900 0000 0000 |................| 0x04b0 0000 0000 0000 0000 0300 1a00 db00 0000 |................| 0x04c0 0000 0000 0000 0000 1000 0000 3102 0000 |............1...| 0x04d0 982f 0000 9102 0000 1200 0800 8602 0000 |./..............| 0x04e0 0000 0000 0000 0000 1000 0000 a601 0000 |................| 0x04f0 0000 0000 0000 0000 1000 0000 7a02 0000 |............z...| 0x0500 0000 0000 0000 0000 1000 0000 e600 0000 |................| 0x0510 0000 0000 0000 0000 1000 0000 0100 0000 |................| 0x0520 9848 0000 0000 0000 1100 f1ff ca01 0000 |.H..............| 0x0530 0000 0000 0000 0000 1000 0000 8600 0000 |................| 0x0540 0000 0000 0000 0000 1000 0000 a600 0000 |................| 0x0550 0000 0000 0000 0000 1000 0000 9402 0000 |................| 0x0560 0000 0000 0000 0000 1000 0000 2c00 0000 |............,...| 0x0570 0000 0000 0000 0000 2000 0000 5a02 0000 |........ ...Z...| 0x0580 0000 0000 0000 0000 1000 0000 8d00 0000 |................| 0x0590 0000 0000 0000 0000 1000 0000 b801 0000 |................| 0x05a0 0000 0000 0000 0000 1000 0000 c602 0000 |................| 0x05b0 0000 0000 0000 0000 1000 0000 d701 0000 |................| 0x05c0 0000 0000 0000 0000 1000 0000 b002 0000 |................| 0x05d0 0000 0000 0000 0000 1000 0000 a002 0000 |................| 0x05e0 2c32 0000 f002 0000 1200 0800 bb00 0000 |,2..............| 0x05f0 0000 0000 0000 0000 1000 0000 2000 0000 |............ ...| 0x0600 800d 0000 0000 0000 1200 0600 0d01 0000 |................| 0x0610 0000 0000 0000 0000 1000 0000 8701 0000 |................| 0x0620 0000 0000 0000 0000 1000 0000 ee01 0000 |................| 0x0630 0000 0000 0000 0000 1000 0000 fc01 0000 |................| 0x0640 0000 0000 0000 0000 1000 0000 d702 0000 |................| 0x0650 0000 0000 0000 0000 1000 0000 3b00 0000 |............;...| 0x0660 0000 0000 0000 0000 2000 0000 5901 0000 |........ ...Y...| 0x0670 0000 0000 0000 0000 1000 0000 b300 0000 |................| 0x0680 0000 0000 0000 0000 1000 0000 4901 0000 |............I...| 0x0690 0000 0000 0000 0000 1000 0000 6601 0000 |............f...| 0x06a0 f82c 0000 9f02 0000 1200 0800 2302 0000 |.,..........#...| 0x06b0 0000 0000 0000 0000 1000 0000 2901 0000 |............)...| 0x06c0 0000 0000 0000 0000 1000 0000 5f01 0000 |............_...| 0x06d0 0000 0000 0000 0000 1000 0000 e202 0000 |................| 0x06e0 0000 0000 0000 0000 1000 0000 ba02 0000 |................| 0x06f0 0000 0000 0000 0000 1000 0000 f302 0000 |................| 0x0700 404a 0000 0000 0000 1000 f1ff 9801 0000 |@J..............| 0x0710 0000 0000 0000 0000 1000 0000 5101 0000 |............Q...| 0x0720 0000 0000 0000 0000 1000 0000 0c02 0000 |................| 0x0730 0000 0000 0000 0000 1000 0000 ac00 0000 |................| 0x0740 0000 0000 0000 0000 1000 0000 7b01 0000 |............{...| 0x0750 0000 0000 0000 0000 1000 0000 3c01 0000 |............<...| 0x0760 d025 0000 8100 0000 1200 0800 9400 0000 |.%..............| 0x0770 0000 0000 0000 0000 1000 0000 9d00 0000 |................| 0x0780 0000 0000 0000 0000 1000 0000 7d00 0000 |............}...| 0x0790 0011 0000 6201 0000 1200 0800 2600 0000 |....b.......&...| 0x07a0 4c35 0000 0000 0000 1200 0900 5a01 0000 |L5..........Z...| 0x07b0 0000 0000 0000 0000 1000 0000 6c02 0000 |............l...| 0x07c0 0000 0000 0000 0000 1000 0000 ec02 0000 |................| 0x07d0 404a 0000 0000 0000 1000 f1ff 0a00 0000 |@J..............| 0x07e0 4c49 0000 0000 0000 1100 f1ff ff02 0000 |LI..............| 0x07f0 604a 0000 0000 0000 1000 f1ff cc00 0000 |`J..............| 0x0800 0000 0000 0000 0000 1000 0000 4802 0000 |............H...| 0x0810 0000 0000 0000 0000 1000 0000 4e02 0000 |............N...| 0x0820 0000 0000 0000 0000 1000 0000 e701 0000 |................| 0x0830 0000 0000 0000 0000 1000 0000 c300 0000 |................| 0x0840 0000 0000 0000 0000 1000 0000 6900 0000 |............i...| 0x0850 0000 0000 0000 0000 2000 0000 fa00 0000 |........ .......| 0x0860 0000 0000 0000 0000 1000 0000 5300 0000 |............S...| 0x0870 0000 0000 0000 0000 2000 0000 1702 0000 |........ .......| 0x0880 0000 0000 0000 0000 1000 0000 1e01 0000 |................| 0x0890 0000 0000 0000 0000 1000 0000 005f 4459 |............._DY| 0x08a0 4e41 4d49 4300 5f47 4c4f 4241 4c5f 4f46 |NAMIC._GLOBAL_OF| 0x08b0 4653 4554 5f54 4142 4c45 5f00 5f69 6e69 |FSET_TABLE_._ini| 0x08c0 7400 5f66 696e 6900 5f5f 6378 615f 6669 |t._fini.__cxa_fi| 0x08d0 6e61 6c69 7a65 005f 5f64 6572 6567 6973 |nalize.__deregis| 0x08e0 7465 725f 6672 616d 655f 696e 666f 005f |ter_frame_info._| 0x08f0 5f72 6567 6973 7465 725f 6672 616d 655f |_register_frame_| 0x0900 696e 666f 005f 4a76 5f52 6567 6973 7465 |info._Jv_Registe| 0x0910 7243 6c61 7373 6573 0062 7364 5f67 6c6f |rClasses.bsd_glo| 0x0920 6200 6765 7465 6e76 0067 6574 7569 6400 |b.getenv.getuid.| 0x0930 6765 7470 7775 6964 0067 6574 7077 6e61 |getpwuid.getpwna| 0x0940 6d00 7173 6f72 7400 7374 7263 6d70 005f |m.qsort.strcmp._| 0x0950 5f65 7272 6f72 0072 6561 6464 6972 0063 |_error.readdir.c| 0x0960 6c6f 7365 6469 7200 504c 5f6d 656d 6f72 |losedir.PL_memor| 0x0970 795f 7772 6170 0050 6572 6c5f 6372 6f61 |y_wrap.Perl_croa| 0x0980 6b00 5065 726c 5f73 6166 6573 7973 7265 |k.Perl_safesysre| 0x0990 616c 6c6f 6300 5065 726c 5f73 6166 6573 |alloc.Perl_safes| 0x09a0 7973 6d61 6c6c 6f63 0050 6572 6c5f 7361 |ysmalloc.Perl_sa| 0x09b0 6665 7379 7366 7265 6500 5f5f 5f74 6f6c |fesysfree.___tol| 0x09c0 6f77 6572 005f 4375 7272 656e 7452 756e |ower._CurrentRun| 0x09d0 654c 6f63 616c 6500 6273 645f 676c 6f62 |eLocale.bsd_glob| 0x09e0 6672 6565 0073 7472 6c63 7079 006f 7065 |free.strlcpy.ope| 0x09f0 6e64 6972 006c 7374 6174 006d 656d 636d |ndir.lstat.memcm| 0x0a00 7000 5853 5f46 696c 655f 5f47 6c6f 625f |p.XS_File__Glob_| 0x0a10 646f 676c 6f62 0050 4c5f 7374 6163 6b5f |doglob.PL_stack_| 0x0a20 7370 0050 4c5f 6d61 726b 7374 6163 6b5f |sp.PL_markstack_| 0x0a30 7074 7200 504c 5f73 7461 636b 5f62 6173 |ptr.PL_stack_bas| 0x0a40 6500 5065 726c 5f73 765f 3270 765f 666c |e.Perl_sv_2pv_fl| 0x0a50 6167 7300 5065 726c 5f73 765f 3269 765f |ags.Perl_sv_2iv_| 0x0a60 666c 6167 7300 504c 5f73 7461 636b 5f6d |flags.PL_stack_m| 0x0a70 6178 0050 6572 6c5f 7374 6163 6b5f 6772 |ax.Perl_stack_gr| 0x0a80 6f77 0073 7472 6c65 6e00 5065 726c 5f6e |ow.strlen.Perl_n| 0x0a90 6577 5356 7076 6e00 5065 726c 5f73 765f |ewSVpvn.Perl_sv_| 0x0aa0 326d 6f72 7461 6c00 504c 5f74 6169 6e74 |2mortal.PL_taint| 0x0ab0 6564 0050 4c5f 7461 696e 7469 6e67 0050 |ed.PL_tainting.P| 0x0ac0 6572 6c5f 7376 5f6d 6167 6963 0058 535f |erl_sv_magic.XS_| 0x0ad0 4669 6c65 5f5f 476c 6f62 5f63 6f6e 7374 |File__Glob_const| 0x0ae0 616e 7400 504c 5f6f 7000 5065 726c 5f70 |ant.PL_op.Perl_p| 0x0af0 6164 5f73 7600 5065 726c 5f73 765f 6e65 |ad_sv.Perl_sv_ne| 0x0b00 776d 6f72 7461 6c00 5065 726c 5f6e 6577 |wmortal.Perl_new| 0x0b10 5356 7076 6600 504c 5f73 765f 756e 6465 |SVpvf.PL_sv_unde| 0x0b20 6600 5065 726c 5f73 765f 7365 7469 7600 |f.Perl_sv_setiv.| 0x0b30 5065 726c 5f6d 675f 7365 7400 626f 6f74 |Perl_mg_set.boot| 0x0b40 5f46 696c 655f 5f47 6c6f 6200 5065 726c |_File__Glob.Perl| 0x0b50 5f66 6f72 6d00 5065 726c 5f67 6574 5f73 |_form.Perl_get_s| 0x0b60 7600 5065 726c 5f6e 6577 5853 5f66 6c61 |v.Perl_newXS_fla| 0x0b70 6773 0050 6572 6c5f 6e65 7758 5300 504c |gs.Perl_newXS.PL| 0x0b80 5f73 765f 7965 7300 5f65 6461 7461 005f |_sv_yes._edata._| 0x0b90 5f62 7373 5f73 7461 7274 005f 656e 6400 |_bss_start._end.| 0x0ba0 8c48 0000 0800 0000 9048 0000 0800 0000 |.H.......H......| 0x0bb0 f849 0000 061c 0000 fc49 0000 061f 0000 |.I.......I......| 0x0bc0 004a 0000 0622 0000 044a 0000 0626 0000 |.J..."...J...&..| 0x0bd0 084a 0000 062e 0000 0c4a 0000 0631 0000 |.J.......J...1..| 0x0be0 104a 0000 0635 0000 144a 0000 0639 0000 |.J...5...J...9..| 0x0bf0 184a 0000 063b 0000 1c4a 0000 063d 0000 |.J...;...J...=..| 0x0c00 204a 0000 0640 0000 244a 0000 0642 0000 | J...@..$J...B..| 0x0c10 284a 0000 0644 0000 2c4a 0000 064f 0000 |(J...D..,J...O..| 0x0c20 304a 0000 0650 0000 344a 0000 0654 0000 |0J...P..4J...T..| 0x0c30 384a 0000 0656 0000 3c4a 0000 0657 0000 |8J...V.....I...A..| 0x0d10 c049 0000 0743 0000 c449 0000 0745 0000 |.I...C...I...E..| 0x0d20 c849 0000 0746 0000 cc49 0000 0747 0000 |.I...F...I...G..| 0x0d30 d049 0000 0748 0000 d449 0000 074a 0000 |.I...H...I...J..| 0x0d40 d849 0000 074b 0000 dc49 0000 0751 0000 |.I...K...I...Q..| 0x0d50 e049 0000 0752 0000 e449 0000 0753 0000 |.I...R...I...S..| 0x0d60 e849 0000 0754 0000 ec49 0000 0755 0000 |.I...T...I...U..| 0x0d70 f049 0000 0756 0000 f449 0000 0758 0000 |.I...V...I...X..| 0x0d80 83ec 0ce8 1403 0000 e88f 2700 0083 c40c |..........'.....| 0x0d90 c300 0000 ffb3 0400 0000 ffa3 0800 0000 |................| 0x0da0 0000 0000 ffa3 0c00 0000 6800 0000 00e9 |..........h.....| 0x0db0 e0ff ffff ffa3 1000 0000 6808 0000 00e9 |..........h.....| 0x0dc0 d0ff ffff ffa3 1400 0000 6810 0000 00e9 |..........h.....| 0x0dd0 c0ff ffff ffa3 1800 0000 6818 0000 00e9 |..........h.....| 0x0de0 b0ff ffff ffa3 1c00 0000 6820 0000 00e9 |..........h ....| 0x0df0 a0ff ffff ffa3 2000 0000 6828 0000 00e9 |...... ...h(....| 0x0e00 90ff ffff ffa3 2400 0000 6830 0000 00e9 |......$...h0....| 0x0e10 80ff ffff ffa3 2800 0000 6838 0000 00e9 |......(...h8....| 0x0e20 70ff ffff ffa3 2c00 0000 6840 0000 00e9 |p.....,...h@....| 0x0e30 60ff ffff ffa3 3000 0000 6848 0000 00e9 |`.....0...hH....| 0x0e40 50ff ffff ffa3 3400 0000 6850 0000 00e9 |P.....4...hP....| 0x0e50 40ff ffff ffa3 3800 0000 6858 0000 00e9 |@.....8...hX....| 0x0e60 30ff ffff ffa3 3c00 0000 6860 0000 00e9 |0.....<...h`....| 0x0e70 20ff ffff ffa3 4000 0000 6868 0000 00e9 | .....@...hh....| 0x0e80 10ff ffff ffa3 4400 0000 6870 0000 00e9 |......D...hp....| 0x0e90 00ff ffff ffa3 4800 0000 6878 0000 00e9 |......H...hx....| 0x0ea0 f0fe ffff ffa3 4c00 0000 6880 0000 00e9 |......L...h.....| 0x0eb0 e0fe ffff ffa3 5000 0000 6888 0000 00e9 |......P...h.....| 0x0ec0 d0fe ffff ffa3 5400 0000 6890 0000 00e9 |......T...h.....| 0x0ed0 c0fe ffff ffa3 5800 0000 6898 0000 00e9 |......X...h.....| 0x0ee0 b0fe ffff ffa3 5c00 0000 68a0 0000 00e9 |......\...h.....| 0x0ef0 a0fe ffff ffa3 6000 0000 68a8 0000 00e9 |......`...h.....| 0x0f00 90fe ffff ffa3 6400 0000 68b0 0000 00e9 |......d...h.....| 0x0f10 80fe ffff ffa3 6800 0000 68b8 0000 00e9 |......h...h.....| 0x0f20 70fe ffff ffa3 6c00 0000 68c0 0000 00e9 |p.....l...h.....| 0x0f30 60fe ffff ffa3 7000 0000 68c8 0000 00e9 |`.....p...h.....| 0x0f40 50fe ffff ffa3 7400 0000 68d0 0000 00e9 |P.....t...h.....| 0x0f50 40fe ffff ffa3 7800 0000 68d8 0000 00e9 |@.....x...h.....| 0x0f60 30fe ffff ffa3 7c00 0000 68e0 0000 00e9 |0.....|...h.....| 0x0f70 20fe ffff ffa3 8000 0000 68e8 0000 00e9 | .........h.....| 0x0f80 10fe ffff ffa3 8400 0000 68f0 0000 00e9 |..........h.....| 0x0f90 00fe ffff ffa3 8800 0000 68f8 0000 00e9 |..........h.....| 0x0fa0 f0fd ffff ffa3 8c00 0000 6800 0100 00e9 |..........h.....| 0x0fb0 e0fd ffff ffa3 9000 0000 6808 0100 00e9 |..........h.....| 0x0fc0 d0fd ffff ffa3 9400 0000 6810 0100 00e9 |..........h.....| 0x0fd0 c0fd ffff ffa3 9800 0000 6818 0100 00e9 |..........h.....| 0x0fe0 b0fd ffff ffa3 9c00 0000 6820 0100 00e9 |..........h ....| 0x0ff0 a0fd ffff ffa3 a000 0000 6828 0100 00e9 |..........h(....| 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL mmap(0,0x5000,0x5,0x20002,0x8,0,0,0) 21495 perl5.8.8 RET mmap 673878016/0x282a9000 21495 perl5.8.8 CALL mprotect(0x282ac000,0x1000,0x7) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mprotect(0x282ac000,0x1000,0x5) 21495 perl5.8.8 RET mprotect 0 21495 perl5.8.8 CALL mmap(0x282ad000,0x1000,0x3,0x12,0x8,0,0x3000,0) 21495 perl5.8.8 RET mmap 673894400/0x282ad000 21495 perl5.8.8 CALL close(0x8) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL mmap(0,0x2c8,0x3,0x1000,0xffffffff,0,0,0) 21495 perl5.8.8 RET mmap 673898496/0x282ae000 21495 perl5.8.8 CALL munmap(0x282ae000,0x2c8) 21495 perl5.8.8 RET munmap 0 21495 perl5.8.8 CALL sigprocmask(0x3,0x28187830,0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfd390) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL sigprocmask(0x3,0x28187830,0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL break(0x82de000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82df000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "de}; # $target->{ $sources{inst_external_src} } = $Config::Confi\ g{flavour_install_src}; # } # insert user overrides foreach my $key (keys %$user) { my $value = $user->{$key}; if (not defined $value and $key ne 'packlist_read' and $key ne\ 'packlist_write') { # undef means "remove" delete $target->{ $sources{$key} }; } elsif (exists $sources{$key}) { # overwrite stuff, don't let the user create new entries $target->{ $sources{$key} } = $value; } } return $target; } sub _directory_not_empty { require File::Find; my($dir) = @_; my $files = 0; File::Find::find(sub { return if $_ eq ".exists"; if (-f) { $File::Find::prune++; $files = 1; } }, $dir); return $files; } =head2 sign_par Digitally sign a PAR distribution using C or B, via B. =cut sub sign_par { my %args = &_args; _verify_or_sign(%args, action => 'sign'); } =head2 verify_par Verify the digital signature of a PAR distribution using C or B, via B. Returns a boolean value indicating whether verification passed; C<$!> is set to the return code of C. =cut sub verify_par { my %args = &_args; $! = _verify_or_sign(%args, action => 'verify'); return ( $! == Module::Signature::SIGNATURE_OK() ); } =head2 merge_par I Since version 0.32 of PAR::Dist, this function requires a YAM\ L reader. The order of precedence is: YAML YAML::Syck YAML::Tiny YAML::XS Merges two or more PAR distributions into one. First argument must be the name of the distribution you want to merge all others into. Any following arguments will be interpreted as the file names of further PAR distributions to merge into the first one. merge_par('foo.par', 'bar.par', 'baz.par') This will merge the distributions C, C and C into the distribution C. C will be overwritten! The original META.yml of C is retained, but augmented with an\ y C sections from the other C<.par> files. =cut sub merge_par { my $base_par = shift; my @additional_pars = @_; require Cwd; require File::Copy; require File::Path; require File::Find; # parameter checking if (not defined $base_par) { croak "First argument to merge_par() must be the .par archive \ to modify."; } if (not -f $base_par or not -r _ or not -w _) { croak "'$base_par' is not a file or you do not have enough per\ missions to read and modify it."; } foreach (@additional_pars) { if (not -f $_ or not -r _) { croak "'$_' is not a file or you do not have enough permis\ sions to read it."; } } # The unzipping will change directories. Remember old dir. my $old_cwd = Cwd::cwd(); # Unzip the base par to a temp. dir. (undef, my $base_dir) = _unzip_to_tmpdir( dist => $base_par, subdir => 'blib' ); my $blibdir = File::Spec->catdir($base_dir, 'blib'); # move the META.yml to the (main) temp. dir. my $main_meta_file = File::Spec->catfile($base_dir, 'META.yml'); File::Copy::move( File::Spec->catfile($blibdir, 'META.yml'), $main_meta_file ); # delete (incorrect) MANIFEST unlink File::Spec->catfile($blibdir, 'MANIFEST'); # extract additional pars and merge foreach my $par (@additional_pars) { # restore original directory because the par path # might have been relative! chdir($old_cwd); (undef, my $add_dir) = _unzip_to_tmpdir( dist => $par ); # merge the meta (at least the provides info) into the main me\ ta.yml my $meta_file = File::Spec->catfile($add_dir, 'META.yml'); if (-f $meta_file) { _merge_meta($main_meta_file, $meta_file); } my @files; my @dirs; # I hate File::Find # And I hate writ" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82e0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "ing portable code, too. File::Find::find( {wanted =>sub { my $file = $File::Find::name; push @files, $file if -f $file; push @dirs, $file if -d _; }}, $add_dir ); my ($vol, $subdir, undef) = File::Spec->splitpath( $add_dir, 1\ ); my @dir = File::Spec->splitdir( $subdir ); # merge directory structure foreach my $dir (@dirs) { my ($v, $d, undef) = File::Spec->splitpath( $dir, 1 ); my @d = File::Spec->splitdir( $d ); shift @d foreach @dir; # remove tmp dir from path my $target = File::Spec->catdir( $blibdir, @d ); mkdir($target); } # merge files foreach my $file (@files) { my ($v, $d, $f) = File::Spec->splitpath( $file ); my @d = File::Spec->splitdir( $d ); shift @d foreach @dir; # remove tmp dir from path my $target = File::Spec->catfile( File::Spec->catdir( $blibdir, @d ), $f ); File::Copy::copy($file, $target) or die "Could not copy '$file' to '$target': $!"; } chdir($old_cwd); File::Path::rmtree([$add_dir]); } # delete (copied) MANIFEST and META.yml unlink File::Spec->catfile($blibdir, 'MANIFEST'); unlink File::Spec->catfile($blibdir, 'META.yml'); chdir($base_dir); my $resulting_par_file = Cwd::abs_path(blib_to_par(quiet => 1)); chdir($old_cwd); File::Copy::move($resulting_par_file, $base_par); File::Path::rmtree([$base_dir]); } sub _merge_meta { my $meta_orig_file = shift; my $meta_extra_file = shift; return() if not defined $meta_orig_file or not -f $meta_orig_file; return 1 if not defined $meta_extra_file or not -f $meta_extra_file; my $yaml_functions = _get_yaml_functions(); die "Cannot merge META.yml files without a YAML reader/writer" if !exists $yaml_functions->{LoadFile} or !exists $yaml_functions->{DumpFile}; my $orig_meta = $yaml_functions->{LoadFile}->($meta_orig_file); my $extra_meta = $yaml_functions->{LoadFile}->($meta_extra_file); # I seem to remember there was this incompatibility between the diff\ erent # YAML implementations with regards to "document" handling: my $orig_tree = (ref($orig_meta) eq 'ARRAY' ? $orig_meta->[0] : $or\ ig_meta); my $extra_tree = (ref($extra_meta) eq 'ARRAY' ? $extra_meta->[0] : $\ extra_meta); # do nothing if the extra meta has no provides field. return() if not exists $extra_tree->{provides}; my $extra_provides = $extra_tree->{provides}; $orig_tree->{provides} = {} if not defined $orig_tree->{provides}; my $orig_provides = $orig_tree->{provides}; # two level clone is enough wrt META spec 1.4 # overwrite the original provides since we're also overwriting the f\ iles. foreach my $module (keys %$extra_provides) { my $extra_mod_hash = $extra_provides->{$module}; my %mod_hash; $mod_hash{$_} = $extra_mod_hash->{$_} for keys %$extra_mod_hash; $orig_provides->{$module} = \\%mod_hash; } $yaml_functions->{DumpFile}->($meta_orig_file, $orig_meta); return 1; } =head2 remove_man Remove the man pages from a PAR distribution. Takes one named parameter: I which should be the name (and path) of the PAR distribution file. The calling conventions outlined in the C section above apply. The PAR archive will be extracted, stripped of all C and C subdirectories and then repackaged into the original file. =cut sub remove_man { my %args = &_args; my $par = $args{dist}; require Cwd; require File::Copy; require File::Path; require File::Find; # parameter checking if (not defined $par) { croak "First argument to remove_man() must be the .par archive\ to modify."; } if (not -f $par or not -r _ or not -w _) { croak "'$par' is not a file or you do not have enough permissi\ ons to read and modify it."; } # Th" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82e7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82e9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ea000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82eb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ec000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ed000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "e unzipping will change directories. Remember old dir. my $old_cwd = Cwd::cwd(); # Unzip the base par to a temp. dir. (undef, my $base_dir) = _unzip_to_tmpdir( dist => $par, subdir => 'blib' ); my $blibdir = File::Spec->catdir($base_dir, 'blib'); # move the META.yml to the (main) temp. dir. File::Copy::move( File::Spec->catfile($blibdir, 'META.yml'), File::Spec->catfile($base_dir, 'META.yml') ); # delete (incorrect) MANIFEST unlink File::Spec->catfile($blibdir, 'MANIFEST'); opendir DIRECTORY, 'blib' or die $!; my @dirs = grep { /^blib\\/(?:man\\d*|html)$/ } grep { -d $_ } map { File::Spec->catfile('blib', $_) } readdir DIRECTORY; close DIRECTORY; File::Path::rmtree(\\@dirs); chdir($base_dir); my $resulting_par_file = Cwd::abs_path(blib_to_par()); chdir($old_cwd); File::Copy::move($resulting_par_file, $par); File::Path::rmtree([$base_dir]); } =head2 get_meta Opens a PAR archive and extracts the contained META.yml file. Returns the META.yml file as a string. Takes one named parameter: I. If only one parameter is passed, it is treated as the I parameter. (Have a look at the description in the C section above.) Returns undef if no PAR archive or no META.yml within the archive were found. =cut sub get_meta { my %args = &_args; my $dist = $args{dist}; return undef if not defined $dist or not -r $dist; require Cwd; require File::Path; # The unzipping will change directories. Remember old dir. my $old_cwd = Cwd::cwd(); # Unzip the base par to a temp. dir. (undef, my $base_dir) = _unzip_to_tmpdir( dist => $dist, subdir => 'blib' ); my $blibdir = File::Spec->catdir($base_dir, 'blib'); my $meta = File::Spec->catfile($blibdir, 'META.yml'); if (not -r $meta) { return undef; } open FH, '<', $meta or die "Could not open file '$meta' for reading: $!"; local $/ = undef; my $meta_text = ; close FH; chdir($old_cwd); File::Path::rmtree([$base_dir]); return $meta_text; } sub _unzip { my %args = &_args; my $dist = $args{dist}; my $path = $args{path} || File::Spec->curdir; return unless -f $dist; # Try fast unzipping first if (eval { require Archive::Unzip::Burst; 1 }) { my $return = !Archive::Unzip::Burst::unzip($dist, $path); return if $return; # true return value == error (a la system c\ all) } # Then slow unzipping if (eval { require Archive::Zip; 1 }) { my $zip = Archive::Zip->new; local %SIG; $SIG{__WARN__} = sub { print STDERR $_[0] unless $_[0] =~ /\\b\ stat\\b/ }; return unless $zip->read($dist) == Archive::Zip::AZ_OK() and $zip->extractTree('', "$path/") == Archive::Zip:\ :AZ_OK(); } # Then fall back to the system else { undef $!; if (_system_wrapper(unzip => $dist, '-d', $path)) { die "Failed to unzip '$dist' to path '$path': Could neithe\ r load " . "Archive::Zip nor (successfully) run the system 'unz\ ip' (unzip said: $!)"; } } return 1; } sub _zip { my %args = &_args; my $dist = $args{dist}; if (eval { require Archive::Zip; 1 }) { my $zip = Archive::Zip->new; $zip->addTree( File::Spec->curdir, '' ); $zip->writeToFileNamed( $dist ) == Archive::Zip::AZ_OK() or di\ e $!; } else { undef $!; if (_system_wrapper(qw(zip -r), $dist, File::Spec->curdir)) { die "Failed to zip '" .File::Spec->curdir(). "' to '$dist'\ : Could neither load " . "Archive::Zip nor (successfully) run the system 'zip\ ' (zip said: $!)"; } } return 1; } # This sub munges the arguments to most of the PAR::Dist functions # into a hash. On the way, it downloads PAR archives as necessary, etc\ . sub _args { # default to the first .par in the CWD if (not @_) { " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82ee000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ef000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f0000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f1000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f2000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f3000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f4000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f5000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "@_ = (glob('*.par'))[0]; } # single argument => it's a distribution file name or URL @_ = (dist => @_) if @_ == 1; my %args = @_; $args{name} ||= $args{dist}; # If we are installing from an URL, we want to munge the # distribution name so that it is in form "Module-Name" if (defined $args{name}) { $args{name} =~ s/^\\w+:\\/\\///; my @elems = parse_dist_name($args{name}); # @elems is name, version, arch, perlversion if (defined $elems[0]) { $args{name} = $elems[0]; } else { $args{name} =~ s/^.*\\/([^\\/]+)$/$1/; $args{name} =~ s/^([0-9A-Za-z_-]+)-\\d+\\..+$/$1/; } } # append suffix if there is none if ($args{dist} and not $args{dist} =~ /\\.[a-zA-Z_][^.]*$/) { require Config; my $suffix = $args{suffix}; $suffix ||= "$Config::Config{archname}-$Config::Config{version\ }.par"; $args{dist} .= "-$suffix"; } # download if it's an URL if ($args{dist} and $args{dist} =~ m!^\\w+://!) { $args{dist} = _fetch(dist => $args{dist}) } return %args; } # Download PAR archive, but only if necessary (mirror!) my %escapes; sub _fetch { my %args = @_; if ($args{dist} =~ s/^file:\\/\\///) { return $args{dist} if -e $args{dist}; return; } require LWP::Simple; $ENV{PAR_TEMP} ||= File::Spec->catdir(File::Spec->tmpdir, 'par'); mkdir $ENV{PAR_TEMP}, 0777; %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255 unless \ %escapes; $args{dist} =~ s{^cpan://((([a-zA-Z])[a-zA-Z])[-_a-zA-Z]+)/} {http://www.cpan.org/modules/by-authors/id/\\U$3/$\ 2/$1\\E/}; my $file = $args{dist}; $file =~ s/([^\\w\\.])/$escapes{$1}/g; $file = File::Spec->catfile( $ENV{PAR_TEMP}, $file); my $rc = LWP::Simple::mirror( $args{dist}, $file ); if (!LWP::Simple::is_success($rc) and $rc != 304) { die "Error $rc: ", LWP::Simple::status_message($rc), " ($args{\ dist})\\n"; } return $file if -e $file; return; } sub _verify_or_sign { my %args = &_args; require File::Path; require Module::Signature; die "Module::Signature version 0.25 required" unless Module::Signature->VERSION >= 0.25; require Cwd; my $cwd = Cwd::cwd(); my $action = $args{action}; my ($dist, $tmpdir) = _unzip_to_tmpdir($args{dist}); $action ||= (-e 'SIGNATURE' ? 'verify' : 'sign'); if ($action eq 'sign') { open FH, '>SIGNATURE' unless -e 'SIGNATURE'; open FH, 'MANIFEST' or die $!; local $/; my $out = ; if ($out !~ /^SIGNATURE(?:\\s|$)/m) { $out =~ s/^(?!\\s)/SIGNATURE\\n/m; open FH, '>MANIFEST' or die $!; print FH $out; } close FH; $args{overwrite} = 1 unless exists $args{overwrite}; $args{skip} = 0 unless exists $args{skip}; } my $rv = Module::Signature->can($action)->(%args); _zip(dist => $dist) if $action eq 'sign'; File::Path::rmtree([$tmpdir]); chdir($cwd); return $rv; } sub _unzip_to_tmpdir { my %args = &_args; require File::Temp; my $dist = File::Spec->rel2abs($args{dist}); my $tmpdirname = File::Spec->catdir(File::Spec->tmpdir, "parXXXXX"\ ); my $tmpdir = File::Temp::mkdtemp($tmpdirname) or die "Could not create temporary directory from template '$tmp\ dirname': $!"; my $path = $tmpdir; $path = File::Spec->catdir($tmpdir, $args{subdir}) if defined $arg\ s{subdir}; _unzip(dist => $dist, path => $path); chdir $tmpdir; return ($dist, $tmpdir); } =head2 parse_dist_name First argument must be a distribution file name. The file name is parsed into I, I, I, and I. Returns the results as a list in the above order. If any or all of the above cannot be determined, returns undef instead of the undetermined elements. Supported formats are: Math-Symbolic-0.502-x86_64-linux-gnu-thread-multi-5.8.7 Math-Symbolic-0.502 The ".tar" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x82f6000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f7000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f8000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82f9000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82fa000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82fb000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82fc000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82fd000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82fe000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x82ff000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8300000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8301000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8302000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8303000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8304000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8305000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8306000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes ".gz" or ".par" extensions as well as any preceding paths are stripped before parsing. Starting with C 0.22, versions containing a preceding C are parsed correctly. This function is not exported by default. =cut sub parse_dist_name { my $file = shift; return(undef, undef, undef, undef) if not defined $file; (undef, undef, $file) = File::Spec->splitpath($file); my $version = qr/v?(?:\\d+(?:_\\d+)?|\\d*(?:\\.\\d+(?:_\\d+)?)\ +)/; $file =~ s/\\.(?:par|tar\\.gz|tar)$//i; my @elem = split /-/, $file; my (@dn, $dv, @arch, $pv); while (@elem) { my $e = shift @elem; if ( $e =~ /^$version$/o and not(# if not next token also a version # (assumes an arch string doesnt start with a vers\ ion...) @elem and $elem[0] =~ /^$version$/o ) ) { $dv = $e; last; } push @dn, $e; } my $dn; $dn = join('-', @dn) if @dn; if (not @elem) { return( $dn, $dv, undef, undef); } while (@elem) { my $e = shift @elem; if ($e =~ /^$version|any_version$/) { $pv = $e; last; } push @arch, $e; } my $arch; $arch = join('-', @arch) if @arch; return($dn, $dv, $arch, $pv); } =head2 generate_blib_stub Creates a F subdirectory in the current directory and prepares a F with meta information for a new PAR distribution. First argument should be the name of the PAR distribution in a format understood by C. Alternatively, named arguments resembling those of C are accepted. After running C and injecting files into the F directory, you can create a PAR distribution using C. This function is useful for creating custom PAR distributions from scratch. (I.e. not from an unpacked CPAN distribution) Example: use PAR::Dist; use File::Copy 'copy'; generate_blib_stub( name => 'MyApp', version => '1.00' ); copy('MyApp.pm', 'blib/lib/MyApp.pm'); blib_to_par(); # generates the .par file! C will not overwrite existing files. =cut sub generate_blib_stub { my %args = &_args; my $dist = $args{dist}; require Config; my $name = $args{name}; my $version = $args{version}; my $suffix = $args{suffix}; my ($parse_name, $parse_version, $archname, $perlversion) = parse_dist_name($dist); $name ||= $parse_name; $version ||= $parse_version; $suffix = "$archname-$perlversion" if (not defined $suffix or $suffix eq '') and $archname and $perlversion; $suffix ||= "$Config::Config{archname}-$Config::Config{version}"; if ( grep { not defined $_ } ($name, $version, $suffix) ) { warn "Could not determine distribution meta information from d\ istribution name '$dist'"; return(); } $suffix =~ s/\\.par$//; if (not -f 'META.yml') { open META, '>', 'META.yml' or die "Could not open META.yml file for writing: $!"; print META << "YAML" if fileno(META); name: $name version: $version build_requires: {} conflicts: {} dist_name: $name-$version-$suffix.par distribution_type: par dynamic_config: 0 generated_by: 'PAR::Dist version $PAR::Dist::VERSION' license: unknown YAML close META; } mkdir('blib'); mkdir(File::Spec->catdir('blib', 'lib')); mkdir(File::Spec->catdir('blib', 'script')); return 1; } =head2 contains_binaries This function is not exported by default. Opens a PAR archive tries to determine whether that archive contains platform-specific binary code. Takes one named parameter: I. If only one parameter is passed, it is treated as the I parameter. (Have a look at the description in the C section above.) Throws a fatal error if the PAR archive could not be found. Returns one if the PAR was found to contain binary code and zero otherwise. =cut sub contains_binaries { require File::Find; my %args = &_args; my $dist = $args{dist}; return undef if not defined $dist or not -r $dist; require Cwd; require File::Path; " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8307000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8308000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8309000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x830a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x830b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x830c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 3804 bytes " # The unzipping will change directories. Remember old dir. my $old_cwd = Cwd::cwd(); # Unzip the base par to a temp. dir. (undef, my $base_dir) = _unzip_to_tmpdir( dist => $dist, subdir => 'blib' ); my $blibdir = File::Spec->catdir($base_dir, 'blib'); my $archdir = File::Spec->catdir($blibdir, 'arch'); my $found = 0; File::Find::find( sub { $found++ if -f $_ and not /^\\.exists$/; }, $archdir ); chdir($old_cwd); File::Path::rmtree([$base_dir]); return $found ? 1 : 0; } sub _system_wrapper { if ($DEBUG) { Carp::cluck("Running system call '@_' from:"); } return system(@_); } # stolen from Module::Install::Can # very much internal and subject to change or removal sub _MI_can_run { require ExtUtils::MakeMaker; my ($cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Tries to load any YAML reader writer I know of # returns nothing on failure or hash reference containing # a subset of Load, Dump, LoadFile, DumpFile # entries with sub references on success. sub _get_yaml_functions { # reasoning for the ranking here: # - syck is fast and reasonably complete # - YAML.pm is slow and aging # - Tiny is only a very small subset # - XS is very new and I'm not sure it's ready for prime-time yet # - Parse... is only a reader and only deals with the same subset as\ ::Tiny my @modules = qw(YAML::Syck YAML YAML::Tiny YAML::XS Parse::CPAN::Me\ ta); my %yaml_functions; foreach my $module (@modules) { eval "require $module;"; if (!$@) { warn "PAR::Dist testers/debug info: Using '$module' as YAML impl\ ementation" if $DEBUG; foreach my $sub (qw(Load Dump LoadFile DumpFile)) { no strict 'refs'; my $subref = *{"${module}::$sub"}{CODE}; if (defined $subref and ref($subref) eq 'CODE') { $yaml_functions{$sub} = $subref; } } $yaml_functions{yaml_provider} = $module; last; } } # end foreach module candidates if (not keys %yaml_functions) { warn "Cannot find a working YAML reader/writer implementation. Tri\ ed to load all of '@modules'"; } return(\\%yaml_functions); } sub _check_tools { my $tools = _get_yaml_functions(); if ($DEBUG) { foreach (qw/Load Dump LoadFile DumpFile/) { warn "No YAML support for $_ found.\\n" if not defined $tools->{\ $_}; } } $tools->{zip} = undef; if (eval {require Archive::Zip; 1;}) { warn "Using Archive::Zip as ZIP tool.\\n" if $DEBUG; $tools->{zip} = 'Archive::Zip'; } elsif (_MI_can_run("zip") and _MI_can_run("unzip")) { warn "Using zip/unzip as ZIP tool.\\n" if $DEBUG; $tools->{zip} = 'zip'; } else { warn "Found neither Archive::Zip nor ZIP/UNZIP as valid ZIP tools.\ \\n" if $DEBUG; $tools->{zip} = undef; } return $tools; } 1; =head1 SEE ALSO L, L, L, L =head1 AUTHORS Audrey Tang Ecpan@audreyt.orgE 2003-2007 Steffen Mueller Esmueller@cpan.orgE 2005-2008 PAR has a mailing list, Epar@perl.orgE, that you can write to; send an empty mail to Epar-subscribe@perl.orgE to join the lis\ t and participate in the discussion. Please send bug reports to Ebug-par@rt.cpan.orgE. =head1 COPYRIGHT Copyright 2003-2008 by Audrey Tang Eautrijus@autrijus.orgE. This program is free software; you can redistribute it and/or modify i\ t under the same terms as Perl itself. See L =cut " 21495 perl5.8.8 RET read 3804/0xedc 21495 perl5.8.8 CALL break(0x830d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x830e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x830f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8310000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8311000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x828e000,0x1000) 21495 perl5.8.8 GIO fd 5 read 0 bytes "" 21495 perl5.8.8 RET read 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x82a1c80,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/YAML/Syck.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1b00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/YAML/Syck.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1c80,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/YAML/Syck.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1b00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/YAML/Syck.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1c80,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/YAML/Syck.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1b00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/YAML/Syck.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1c80,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/YAML/Syck.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1b00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/YAML/Syck.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1c80,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/YAML/Syck.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x82a1b00,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/YAML/Syck.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8306600,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/YAML/Syck.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfae70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x82bd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "package YAML::Syck; # See documentation after the __END__ mark. use strict; use vars qw( @ISA @EXPORT $VERSION $Headless $SortKeys $SingleQuote $ImplicitBinary $ImplicitTyping $ImplicitUnicode $UseCode $LoadCode $DumpCode $DeparseObject ); use 5.00307; use Exporter; BEGIN { $VERSION = '1.05'; @EXPORT = qw( Dump Load DumpFile LoadFile ); @ISA = qw( Exporter ); $SortKeys = 1; local $@; eval { require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); 1; } or do { require DynaLoader; push @ISA, 'DynaLoader'; __PACKAGE__->bootstrap($VERSION); }; } use constant QR_MAP => { '' => sub { qr{$_[0]} }, x => sub { qr{$_[0]}x }, i => sub { qr{$_[0]}i }, s => sub { qr{$_[0]}s }, m => sub { qr{$_[0]}m }, ix => sub { qr{$_[0]}ix }, sx => sub { qr{$_[0]}sx }, mx => sub { qr{$_[0]}mx }, si => sub { qr{$_[0]}si }, mi => sub { qr{$_[0]}mi }, ms => sub { qr{$_[0]}sm }, six => sub { qr{$_[0]}six }, mix => sub { qr{$_[0]}mix }, msx => sub { qr{$_[0]}msx }, msi => sub { qr{$_[0]}msi }, msix => sub { qr{$_[0]}msix }, }; sub __qr_helper { if ($_[0] =~ /\\A \\(\\? ([ixsm]*) (?:- (?:[ixsm]*))? : (.*) \ \\) \\z/x) { my $sub = QR_MAP()->{$1} || QR_MAP()->{''}; &$sub($2); } else { qr/$_[0]/; } } sub Dump { $#_ ? join('', map { YAML::Syck::DumpYAML($_) } @_) : YAML::Syck::DumpYAML($_[0]); } sub Load { if (wantarray) { my ($rv) = YAML::Syck::LoadYAML($_[0]); @{$rv}; } else { YAML::Syck::LoadYAML($_[0]); } } # NOTE. The code below (_is_openhandle) avoids to require/load # Scalar::Util unless it is given a ref or glob # as an argument. That is purposeful, so to avoid # the need for this dependency unless strictly necessary. # If that was not the case, Scalar::Util::openhandle could # be used directly. sub _is_openhandle { my $h = shift; if ( ref($h) || ref(\\$h) eq 'GLOB' ) { require Scalar::Util; return Scalar::Util::openhandle($h); } else { return undef; } } sub DumpFile { my $file = shift; if ( _is_openhandle($file) ) { if ($#_) { print {$file} YAML::Syck::DumpYAML($_) for @_; } else { print {$file} YAML::Syck::DumpYAML($_[0]); } } else { local *FH; open FH, "> $file" or die "Cannot write to $file: $!"; if ($#_) { print FH YAML::Syck::DumpYAML($_) for @_; } else { print FH YAML::Syck::DumpYAML($_[0]); } close FH; } } sub LoadFile { my $file = shift; if ( _is_openhandle($file) ) { Load(do { local $/; <$file> }); } else { local *FH; open FH, "< $file" or die "Cannot read from $file: $!"; Load(do { local $/; }); } } 1; __END__ =pod =head1 NAME YAML::Syck - Fast, lightweight YAML loader and dumper =head1 VERSION This document describes version 1.04 of YAML::Syck, released February \ 17, 2008. =head1 SYNOPSIS use YAML::Syck; # Set this for interoperability with other YAML/Syck bindings: # e.g. Load('Yes') becomes 1 and Load('No') becomes ''. $YAML::Syck::ImplicitTyping = 1; $data = Load($yaml); $yaml = Dump($data); # $file can be an IO object, or a filename $data = LoadFile($file); DumpFile($file, $data); # A string with multiple YAML streams in it $yaml = Dump(@data); @data = Load($yaml); =head1 DESCRIPTION This module provides a Perl interface to the B data serializa\ tion library. It exports the C and C functions for converting Perl data structures to YAML strings, and the other way around. B: If you are working with other language's YAML/Syck bindings (such as Ruby), please set C<$YAML::Syck::ImplicitTyping> to C<1> befo\ re calling the C/C functions. The default s" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x8313000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/auto/YAML/Syck/Syck.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/auto/YAML/Syck/Syck.so" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL stat(0x81e5000,0x8173540) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/auto/YAML/Syck/Syck.bs" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL sigprocmask(0x1,0x28187820,0xbfbfd4a0) 21495 perl5.8.8 RET sigprocmask 0 21495 perl5.8.8 CALL open(0x28192180,0,0xbfbfd3f8) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/site_perl/5.8.8/i386-freebsd-64int/auto/YAML/Syck/Syck.so" 21495 perl5.8.8 RET open 8 21495 perl5.8.8 CALL fstat(0x8,0xbfbfd480) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x8,0x281878e0,0x1000) 21495 perl5.8.8 GIO fd 8 read 4096 bytes 0x0000 7f45 4c46 0101 0109 0000 0000 0000 0000 |.ELF............| 0x0010 0300 0300 0100 0000 9040 0000 3400 0000 |.........@..4...| 0x0020 5c67 0300 0000 0000 3400 2000 0300 2800 |\g......4. ...(.| 0x0030 1e00 1b00 0100 0000 0000 0000 0000 0000 |................| 0x0040 0000 0000 eae3 0100 eae3 0100 0500 0000 |................| 0x0050 0010 0000 0100 0000 00e4 0100 00f4 0100 |................| 0x0060 00f4 0100 7806 0000 ac0a 0000 0600 0000 |....x...........| 0x0070 0010 0000 0200 0000 fce5 0100 fcf5 0100 |................| 0x0080 fcf5 0100 a000 0000 a000 0000 0600 0000 |................| 0x0090 0400 0000 0701 0000 2101 0000 0000 0000 |........!.......| 0x00a0 ee00 0000 1101 0000 0000 0000 0000 0000 |................| 0x00b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x00c0 0801 0000 1d01 0000 0000 0000 0000 0000 |................| 0x00d0 c300 0000 5c00 0000 1c01 0000 e900 0000 |....\...........| 0x00e0 0e01 0000 ec00 0000 0000 0000 0000 0000 |................| 0x00f0 1601 0000 0000 0000 8c00 0000 7700 0000 |............w...| 0x0100 1501 0000 a000 0000 bc00 0000 1a01 0000 |................| 0x0110 cd00 0000 eb00 0000 0000 0000 e100 0000 |................| 0x0120 0000 0000 3800 0000 0000 0000 c400 0000 |....8...........| 0x0130 e500 0000 0000 0000 0f01 0000 0000 0000 |................| 0x0140 6100 0000 4700 0000 0000 0000 da00 0000 |a...G...........| 0x0150 b000 0000 1801 0000 5900 0000 e600 0000 |........Y.......| 0x0160 a500 0000 0301 0000 f400 0000 1e00 0000 |................| 0x0170 0000 0000 c500 0000 b600 0000 0000 0000 |................| 0x0180 0000 0000 0000 0000 0000 0000 aa00 0000 |................| 0x0190 6200 0000 5e00 0000 ab00 0000 af00 0000 |b...^...........| 0x01a0 1b01 0000 9500 0000 cf00 0000 4f00 0000 |............O...| 0x01b0 c200 0000 0000 0000 fb00 0000 5100 0000 |............Q...| 0x01c0 3100 0000 0000 0000 cb00 0000 f200 0000 |1...............| 0x01d0 ac00 0000 0d01 0000 dd00 0000 0000 0000 |................| 0x01e0 d200 0000 c900 0000 3d00 0000 0000 0000 |........=.......| 0x01f0 0000 0000 0000 0000 d600 0000 0000 0000 |................| 0x0200 0000 0000 0000 0000 ff00 0000 7500 0000 |............u...| 0x0210 0000 0000 2200 0000 0000 0000 0000 0000 |...."...........| 0x0220 0000 0000 0000 0000 6f00 0000 fc00 0000 |........o.......| 0x0230 0000 0000 b700 0000 0000 0000 0000 0000 |................| 0x0240 0000 0000 0000 0000 0000 0000 bf00 0000 |................| 0x0250 0a01 0000 1c00 0000 3c00 0000 ed00 0000 |........<.......| 0x0260 3b00 0000 6900 0000 b100 0000 4900 0000 |;...i.......I...| 0x0270 0000 0000 0000 0000 b300 0000 6700 0000 |............g...| 0x0280 9800 0000 4800 0000 0000 0000 0000 0000 |....H...........| 0x0290 1401 0000 0601 0000 0901 0000 0000 0000 |................| 0x02a0 4600 0000 2e00 0000 c100 0000 0000 0000 |F...............| 0x02b0 0000 0000 0701 0000 d700 0000 0000 0000 |................| 0x02c0 3600 0000 6400 0000 0000 0000 0000 0000 |6...d...........| 0x02d0 f300 0000 bd00 0000 e200 0000 b800 0000 |................| 0x02e0 cc00 0000 0000 0000 e400 0000 0000 0000 |................| 0x02f0 0c01 0000 0000 0000 9300 0000 1301 0000 |................| 0x0300 0000 0000 9a00 0000 0000 0000 0000 0000 |................| 0x0310 f800 0000 0000 0000 1e01 0000 9900 0000 |................| 0x0320 0000 0000 b200 0000 5d00 0000 b500 0000 |........].......| 0x0330 0201 0000 0000 0000 0000 0000 ae00 0000 |................| 0x0340 0000 0000 f500 0000 0000 0000 0000 0000 |................| 0x0350 f100 0000 d800 0000 8000 0000 0000 0000 |................| 0x0360 e300 0000 a100 0000 6b00 0000 0000 0000 |........k.......| 0x0370 a300 0000 9e00 0000 b400 0000 8a00 0000 |................| 0x0380 7a00 0000 5300 0000 0000 0000 f600 0000 |z...S...........| 0x0390 0000 0000 1201 0000 7e00 0000 0000 0000 |........~.......| 0x03a0 0000 0000 dc00 0000 7600 0000 1901 0000 |........v.......| 0x03b0 2001 0000 0000 0000 0000 0000 d500 0000 | ...............| 0x03c0 9400 0000 0000 0000 0000 0000 fd00 0000 |................| 0x03d0 a800 0000 0000 0000 0000 0000 0000 0000 |................| 0x03e0 0000 0000 0000 0000 7300 0000 0101 0000 |........s.......| 0x03f0 1001 0000 a700 0000 f000 0000 f900 0000 |................| 0x0400 2700 0000 0000 0000 d400 0000 0000 0000 |'...............| 0x0410 c600 0000 0000 0000 9c00 0000 c800 0000 |................| 0x0420 a600 0000 0000 0000 0000 0000 0000 0000 |................| 0x0430 0000 0000 0000 0000 f700 0000 de00 0000 |................| 0x0440 1701 0000 4d00 0000 0000 0000 a200 0000 |....M...........| 0x0450 fa00 0000 9f00 0000 6e00 0000 4c00 0000 |........n...L...| 0x0460 0000 0000 0000 0000 1f01 0000 fe00 0000 |................| 0x0470 0000 0000 0b01 0000 0000 0000 0000 0000 |................| 0x0480 0000 0000 ef00 0000 d000 0000 6d00 0000 |............m...| 0x0490 0001 0000 e800 0000 7000 0000 0000 0000 |........p.......| 0x04a0 0000 0000 6000 0000 0000 0000 0501 0000 |....`...........| 0x04b0 e000 0000 e700 0000 0000 0000 0000 0000 |................| 0x04c0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04d0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04e0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x04f0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0500 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0510 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0520 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0530 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0540 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0550 0000 0000 0000 0000 0000 0000 2400 0000 |............$...| 0x0560 0000 0000 1b00 0000 0000 0000 0000 0000 |................| 0x0570 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0580 2c00 0000 0000 0000 0000 0000 0000 0000 |,...............| 0x0590 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x05a0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x05b0 0000 0000 2300 0000 0000 0000 0000 0000 |....#...........| 0x05c0 2900 0000 0000 0000 0000 0000 0000 0000 |)...............| 0x05d0 3000 0000 0000 0000 3400 0000 0000 0000 |0.......4.......| 0x05e0 0000 0000 0000 0000 2d00 0000 4100 0000 |........-...A...| 0x05f0 0000 0000 0000 0000 2600 0000 0000 0000 |........&.......| 0x0600 2500 0000 0000 0000 0000 0000 0000 0000 |%...............| 0x0610 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0620 2f00 0000 0000 0000 0000 0000 0000 0000 |/...............| 0x0630 0000 0000 5700 0000 0000 0000 0000 0000 |....W...........| 0x0640 0000 0000 0000 0000 0000 0000 2100 0000 |............!...| 0x0650 0000 0000 5b00 0000 2800 0000 4200 0000 |....[...(...B...| 0x0660 5500 0000 0000 0000 0000 0000 0000 0000 |U...............| 0x0670 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0680 0000 0000 2a00 0000 0000 0000 0000 0000 |....*...........| 0x0690 1d00 0000 0000 0000 0000 0000 0000 0000 |................| 0x06a0 4400 0000 0000 0000 0000 0000 4500 0000 |D...........E...| 0x06b0 0000 0000 0000 0000 3300 0000 0000 0000 |........3.......| 0x06c0 0000 0000 7c00 0000 0000 0000 0000 0000 |....|...........| 0x06d0 0000 0000 8500 0000 0000 0000 0000 0000 |................| 0x06e0 3a00 0000 6c00 0000 0000 0000 0000 0000 |:...l...........| 0x06f0 0000 0000 0000 0000 0000 0000 3f00 0000 |............?...| 0x0700 0000 0000 5a00 0000 0000 0000 0000 0000 |....Z...........| 0x0710 0000 0000 5400 0000 5800 0000 8400 0000 |....T...X.......| 0x0720 0000 0000 0000 0000 0000 0000 8700 0000 |................| 0x0730 3500 0000 0000 0000 0000 0000 0000 0000 |5...............| 0x0740 3900 0000 5000 0000 5f00 0000 0000 0000 |9...P..._.......| 0x0750 0000 0000 0000 0000 0000 0000 4e00 0000 |............N...| 0x0760 0000 0000 4a00 0000 6500 0000 8f00 0000 |....J...e.......| 0x0770 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0780 0000 0000 8e00 0000 0000 0000 0000 0000 |................| 0x0790 9700 0000 8900 0000 0000 0000 8600 0000 |................| 0x07a0 0000 0000 7f00 0000 ba00 0000 3e00 0000 |............>...| 0x07b0 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x07c0 6600 0000 0000 0000 0000 0000 8800 0000 |f...............| 0x07d0 0000 0000 9d00 0000 0000 0000 7200 0000 |............r...| 0x07e0 0000 0000 9600 0000 0000 0000 7100 0000 |............q...| 0x07f0 ad00 0000 2b00 0000 c700 0000 0000 0000 |....+...........| 0x0800 a900 0000 8100 0000 0000 0000 bb00 0000 |................| 0x0810 d100 0000 0000 0000 9b00 0000 d300 0000 |................| 0x0820 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0830 7900 0000 0000 0000 8b00 0000 0000 0000 |y...............| 0x0840 0000 0000 0000 0000 4b00 0000 0000 0000 |........K.......| 0x0850 5200 0000 0000 0000 a400 0000 0000 0000 |R...............| 0x0860 7400 0000 0000 0000 d900 0000 0000 0000 |t...............| 0x0870 4300 0000 b900 0000 7b00 0000 0000 0000 |C.......{.......| 0x0880 6800 0000 9200 0000 0000 0000 0000 0000 |h...............| 0x0890 0000 0000 ce00 0000 8200 0000 ea00 0000 |................| 0x08a0 0000 0000 6300 0000 7d00 0000 2000 0000 |....c...}... ...| 0x08b0 0000 0000 0000 0000 7800 0000 0000 0000 |........x.......| 0x08c0 8d00 0000 6a00 0000 ca00 0000 0000 0000 |....j...........| 0x08d0 0000 0000 0000 0000 0000 0000 1f00 0000 |................| 0x08e0 0000 0000 0000 0000 0000 0000 3700 0000 |............7...| 0x08f0 df00 0000 9000 0000 0000 0000 0000 0000 |................| 0x0900 0000 0000 0000 0000 0000 0000 5600 0000 |............V...| 0x0910 be00 0000 8300 0000 0000 0000 c000 0000 |................| 0x0920 3200 0000 0000 0000 0000 0000 4000 0000 |2...........@...| 0x0930 0401 0000 9100 0000 db00 0000 0000 0000 |................| 0x0940 0000 0000 0000 0000 0000 0000 0000 0000 |................| 0x0950 9400 0000 0000 0000 0300 0100 0000 0000 |................| 0x0960 3c09 0000 0000 0000 0300 0200 0000 0000 |<...............| 0x0970 4c1b 0000 0000 0000 0300 0300 0000 0000 |L...............| 0x0980 cc2a 0000 0000 0000 0300 0400 0000 0000 |.*..............| 0x0990 f42d 0000 0000 0000 0300 0500 0000 0000 |.-..............| 0x09a0 1c34 0000 0000 0000 0300 0600 0000 0000 |.4..............| 0x09b0 3034 0000 0000 0000 0300 0700 0000 0000 |04..............| 0x09c0 9040 0000 0000 0000 0300 0800 0000 0000 |.@..............| 0x09d0 089f 0100 0000 0000 0300 0900 0000 0000 |................| 0x09e0 209f 0100 0000 0000 0300 0a00 0000 0000 | ...............| 0x09f0 00f4 0100 0000 0000 0300 0b00 0000 0000 |................| 0x0a00 f8f5 0100 0000 0000 0300 0c00 0000 0000 |................| 0x0a10 fcf5 0100 0000 0000 0300 0d00 0000 0000 |................| 0x0a20 9cf6 0100 0000 0000 0300 0e00 0000 0000 |................| 0x0a30 a4f6 0100 0000 0000 0300 0f00 0000 0000 |................| 0x0a40 acf6 0100 0000 0000 0300 1000 0000 0000 |................| 0x0a50 b0f6 0100 0000 0000 0300 1100 0000 0000 |................| 0x0a60 80fa 0100 0000 0000 0300 1200 0000 0000 |................| 0x0a70 0000 0000 0000 0000 0300 1300 0000 0000 |................| 0x0a80 0000 0000 0000 0000 0300 1400 0000 0000 |................| 0x0a90 0000 0000 0000 0000 0300 1500 0000 0000 |................| 0x0aa0 0000 0000 0000 0000 0300 1600 0000 0000 |................| 0x0ab0 0000 0000 0000 0000 0300 1700 0000 0000 |................| 0x0ac0 0000 0000 0000 0000 0300 1800 0000 0000 |................| 0x0ad0 0000 0000 0000 0000 0300 1900 0000 0000 |................| 0x0ae0 0000 0000 0000 0000 0300 1a00 0809 0000 |................| 0x0af0 88e2 0000 f000 0000 1200 0800 150f 0000 |................| 0x0b00 3499 0100 6a01 0000 1200 0800 0c0b 0000 |4...j...........| 0x0b10 0000 0000 0000 0000 1000 0000 e105 0000 |................| 0x0b20 94c7 0000 3800 0000 1200 0800 4102 0000 |....8.......A...| 0x0b30 b45f 0000 5900 0000 1200 0800 b306 0000 |._..Y...........| 0x0b40 60d0 0000 5700 0000 1200 0800 960d 0000 |`...W...........| 0x0b50 0000 0000 0000 0000 1000 0000 120a 0000 |................| 0x0b60 0000 0000 0000 0000 1000 0000 0f0d 0000 |................| 0x0b70 0000 0000 0000 0000 1000 0000 f205 0000 |................| 0x0b80 ccc7 0000 b500 0000 1200 0800 d003 0000 |................| 0x0b90 7c7d 0000 e100 0000 1200 0800 7c0d 0000 ||}..........|...| 0x0ba0 0000 0000 0000 0000 1000 0000 f40d 0000 |................| 0x0bb0 0000 0000 0000 0000 1000 0000 4908 0000 |............I...| 0x0bc0 48da 0000 0101 0000 1200 0800 de03 0000 |H...............| 0x0bd0 607e 0000 e100 0000 1200 0800 160c 0000 |`~..............| 0x0be0 0000 0000 0000 0000 1000 0000 6505 0000 |............e...| 0x0bf0 e4e5 0000 9c01 0000 1200 0800 ae02 0000 |................| 0x0c00 3c64 0000 9400 0000 1200 0800 2b04 0000 | 5.009; my %forced_into_main = map +($_, 1), qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; my %forbidden = (%keywords, %forced_into_main); #=====================================================================\ == # import() - import symbols into user's namespace # # What we actually do is define a function in the caller's namespace # which returns the value. The function we create will normally # be inlined as a constant, thereby avoiding further sub calling # overhead. #=====================================================================\ == sub import { my $class = shift; return unless @_; # Ignore 'use constant;' my $constants; my $multiple = ref $_[0]; my $pkg = caller; my $symtab; my $str_end = $] >= 5.006 ? "\\\\z" : "\\\\Z"; if ($] > 5.009002) { no strict 'refs'; $symtab = \\%{$pkg . '::'}; }; if ( $multiple ) { if (ref $_[0] ne 'HASH') { require Carp; Carp::croak("Invalid reference type '".ref(shift)."' not '\ HASH'"); } $constants = shift; } else { $constants->{+shift} = undef; } foreach my $name ( keys %$constants ) { unless (defined $name) { require Carp; Carp::croak("Can't use undef as constant name"); } # Normal constant name if ($name =~ /^_?[^\\W_0-9]\\w*$str_end/ and !$forbidden{$name\ }) { # Everything is okay # Name forced into main, but we're not in main. Fatal. } elsif ($forced_into_main{$name} and $pkg ne 'main') { require Carp; Carp::croak("Constant name '$name' is forced into main::")\ ; # Starts with double underscore. Fatal. } elsif ($name =~ /^__/) { require Carp; Carp::croak("Constant name '$name' begins with '__'"); # Maybe the name is tolerable } elsif ($name =~ /^[A-Za-z_]\\w*$str_end/) { # Then we'll warn only if you've asked for warnings if (warnings::enabled()) { if ($keywords{$name}) { warnings::warn("Constant name '$name' is a Perl ke\ yword"); } elsif ($forced_into_main{$name}) { warnings::warn("Constant name '$name' is " . "forced into package main::"); } } # Looks like a boolean # use constant FRED == fred; } elsif ($name =~ /^[01]?$str_end/) { require Carp; if (@_) { Carp::croak("Constant name '$name' is invalid"); } else { Carp::croak("Constant name looks like boolean value"); } } else { # Must have bad characters require Carp; Carp::croak("Constant name '$name' has invalid characters"\ ); } { no strict 'refs'; my $full_name = "${pkg}::$name"; $declared{$full_name}++; if ($multiple || @_ == 1) { my $scalar = $multiple ? $constants->{$name} : $_[0]; if ($symtab && !exists $symtab->{$name}) { # No typeglob yet, so we can use a reference as sp\ ace- # efficient proxy for a constant subroutine # The check in Perl_ck_rvconst knows that inlinabl\ e # constants from cv_const_sv are read only. So we \ have to: Internals::SvREADONLY($scalar, 1); $symtab->{$name} = \\$scalar; mro::method_changed_in($pkg); } else { *$full_name = sub () { $scalar }; } } elsif (@_) { my @list = @_; *$full_name = sub () { @list }; } else { *$full_name = sub () { }; } } } } 1; __END__ =head1 NAME constant - Perl pragma to declare constants =head1 SYNOPSIS use constant PI => 4 * atan2(1, 1); use constant DEBUG => 0; print "Pi equals ", PI, "...\\n" if DEBUG; use constant { SEC => 0, MIN => 1, HOUR => 2, MDAY => 3, MON => 4, YEAR => 5, WDAY => 6, YDAY => 7, ISDST => 8, }; use constant WEEKDAYS => qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x831a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL lseek(0x8,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x831b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x831c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x831d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x831e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x831f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8320000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8321000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8322000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8323000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x8) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL break(0x8324000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL close(0x5) 21495 perl5.8.8 RET close 0 21495 perl5.8.8 CALL stat(0x8306780,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Copy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306600,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/arch/File/Copy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306780,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Copy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306600,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/.cpan/build/PAR-Repository-0.16-3C_jJX/blib/lib/File/Copy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306780,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Copy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306600,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/i386-freebsd-64int/File/Copy.pm" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306780,0xbfbfd950) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Copy.pmc" 21495 perl5.8.8 RET stat -1 errno 2 No such file or directory 21495 perl5.8.8 CALL stat(0x8306600,0xbfbfd870) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Copy.pm" 21495 perl5.8.8 RET stat 0 21495 perl5.8.8 CALL open(0x8317100,0,0x1b6) 21495 perl5.8.8 NAMI "/home/nicholas/Sandpit/snap5.9.x-34591/lib/perl5/5.8.8/File/Copy.pm" 21495 perl5.8.8 RET open 5 21495 perl5.8.8 CALL fstat(0x5,0xbfbfae70) 21495 perl5.8.8 RET fstat 0 21495 perl5.8.8 CALL read(0x5,0x82bd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "# File/Copy.pm. Written in 1994 by Aaron Sherman . This # source code has been placed in the public domain by the author. # Please be kind and preserve the documentation. # # Additions copyright 1996 by Charles Bailey. Permission is granted # to distribute the revised code under the same terms as Perl itself. package File::Copy; use 5.006; use strict; use warnings; use Carp; use File::Spec; use Config; # Similarly Scalar::Util # And then we need these games to avoid loading overload, as that will # confuse miniperl during the bootstrap of perl. my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overloa\ d; 1 }; our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy); sub copy; sub syscopy; sub cp; sub mv; # Note that this module implements only *part* of the API defined by # the File/Copy.pm module of the File-Tools-2.0 package. However, tha\ t # package has not yet been updated to work with Perl 5.004, and so it # would be a Bad Thing for the CPAN module to grab it and replace this # module. Therefore, we set this module's version higher than 2.0. $VERSION = '2.13'; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(copy move); @EXPORT_OK = qw(cp mv); $Too_Big = 1024 * 1024 * 2; my $macfiles; if ($^O eq 'MacOS') { $macfiles = eval { require Mac::MoreFiles }; warn 'Mac::MoreFiles could not be loaded; using non-native sys\ copy' if $@ && $^W; } sub _catname { my($from, $to) = @_; if (not defined &basename) { require File::Basename; import File::Basename 'basename'; } if ($^O eq 'MacOS') { # a partial dir name that's valid only in the cwd (e.g. 'tmp') $to = ':' . $to if $to !~ /:/; } return File::Spec->catfile($to, basename($from)); } # _eq($from, $to) tells whether $from and $to are identical sub _eq { my ($from, $to) = map { $Scalar_Util_loaded && Scalar::Util::blessed($_) && overload::Method($_, q{""}) ? "$_" : $_ } (@_); return '' if ( (ref $from) xor (ref $to) ); return $from == $to if ref $from; return $from eq $to; } sub copy { croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ") unless(@_ == 2 || @_ == 3); my $from = shift; my $to = shift; my $size; if (@_) { $size = shift(@_) + 0; croak("Bad buffer size for copy: $size\\n") unless ($size > 0)\ ; } my $from_a_handle = (ref($from) ? (ref($from) eq 'GLOB' || UNIVERSAL::isa($from, 'GLOB') || UNIVERSAL::isa($from, 'IO::Handle')) : (ref(\\$from) eq 'GLOB')); my $to_a_handle = (ref($to) ? (ref($to) eq 'GLOB' || UNIVERSAL::isa($to, 'GLOB') || UNIVERSAL::isa($to, 'IO::Handle')) : (ref(\\$to) eq 'GLOB')); if (_eq($from, $to)) { # works for references, too carp("'$from' and '$to' are identical (not copied)"); # The "copy" was a success as the source and destination conta\ in # the same data. return 1; } if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link\ }) && !($^O eq 'MSWin32' || $^O eq 'os2')) { my @fs = stat($from); if (@fs) { my @ts = stat($to); if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) { carp("'$from' and '$to' are identical (not copied)"); return 0; } } } if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) { $to = _catname($from, $to); } if (defined &syscopy && !$Syscopy_is_copy && !$to_a_handle && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle h\ andles && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/\ iX. && !($from_a_handle && $^O eq 'MSWin32') && !($from_a_handle && $^O eq 'MacOS') && !($from_a_handle && $^O eq 'NetWare') ) { my $copy_to = $to; if ($^O eq 'VMS' && -e $from) { if (! -d $to && ! -d $from) { # VMS has sticky defaults on extensions, which means t\ hat # if there is a null extension on the destination file\ , it # will inherit the extension of the source file # " 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL lseek(0x5,0,0,0,0x1) 21495 perl5.8.8 RET lseek 4096/0x1000 21495 perl5.8.8 CALL break(0x8325000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8326000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8327000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8328000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8329000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x832a000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x832b000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x832c000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x832d000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x82bd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "So add a '.' for a null extension. $copy_to = VMS::Filespec::vmsify($to); my ($vol, $dirs, $file) = File::Spec->splitpath($copy_\ to); $file = $file . '.' unless ($file =~ /(?catpath($vol, $dirs, $file); # Get rid of the old versions to be like UNIX 1 while unlink $copy_to; } } return syscopy($from, $copy_to); } my $closefrom = 0; my $closeto = 0; my ($status, $r, $buf); local($\\) = ''; my $from_h; if ($from_a_handle) { $from_h = $from; } else { $from = _protect($from) if $from =~ /^\\s/s; $from_h = \\do { local *FH }; open $from_h, "<", $from or goto fail_open1; binmode $from_h or die "($!,$^E)"; $closefrom = 1; } # Seems most logical to do this here, in case future changes would\ want to # make this croak for some reason. unless (defined $size) { $size = tied(*$from_h) ? 0 : -s $from_h || 0; $size = 1024 if ($size < 512); $size = $Too_Big if ($size > $Too_Big); } my $to_h; if ($to_a_handle) { $to_h = $to; } else { $to = _protect($to) if $to =~ /^\\s/s; $to_h = \\do { local *FH }; open $to_h, ">", $to or goto fail_open2; binmode $to_h or die "($!,$^E)"; $closeto = 1; } $! = 0; for (;;) { my ($r, $w, $t); defined($r = sysread($from_h, $buf, $size)) or goto fail_inner; last unless $r; for ($w = 0; $w < $r; $w += $t) { $t = syswrite($to_h, $buf, $r - $w, $w) or goto fail_inner; } } close($to_h) || goto fail_open2 if $closeto; close($from_h) || goto fail_open1 if $closefrom; # Use this idiom to avoid uninitialized value warning. return 1; # All of these contortions try to preserve error messages... fail_inner: if ($closeto) { $status = $!; $! = 0; close $to_h; $! = $status unless $!; } fail_open2: if ($closefrom) { $status = $!; $! = 0; close $from_h; $! = $status unless $!; } fail_open1: return 0; } sub move { croak("Usage: move(FROM, TO) ") unless @_ == 2; my($from,$to) = @_; my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts); if (-d $to && ! -d $from) { $to = _catname($from, $to); } ($tosz1,$tomt1) = (stat($to))[7,9]; $fromsz = -s $from; if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) { # will not rename with overwrite unlink $to; } my $rename_to = $to; if (-$^O eq 'VMS' && -e $from) { if (! -d $to && ! -d $from) { # VMS has sticky defaults on extensions, which means that # if there is a null extension on the destination file, it # will inherit the extension of the source file # So add a '.' for a null extension. $rename_to = VMS::Filespec::vmsify($to); my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to\ ); $file = $file . '.' unless ($file =~ /(?catpath($vol, $dirs, $file); # Get rid of the old versions to be like UNIX 1 while unlink $rename_to; } } return 1 if rename $from, $rename_to; # Did rename return an error even though it succeeded, because $to # is on a remote NFS file system, and NFS lost the server's ack? return 1 if defined($fromsz) && !-e $from && # $from dis\ appeared (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's the\ re ((!defined $tosz1) || # not befo\ re or ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was\ changed $tosz2 == $fromsz; # it's all \ there ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did som\ ething { local $@; eval { local $SIG{__DIE__}; copy($from,$to) or die; my($atime, $mtime) = (stat($from))[8,9]; utime($atime, $mtime, $to); unlink($fr" 21495 perl5.8.8 RET read 4096/0x1000 21495 perl5.8.8 CALL break(0x832e000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x832f000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8330000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8331000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8332000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8333000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL break(0x8334000) 21495 perl5.8.8 RET break 0 21495 perl5.8.8 CALL read(0x5,0x82bd000,0x1000) 21495 perl5.8.8 GIO fd 5 read 4096 bytes "om) or die; }; return 1 unless $@; } ($sts,$ossts) = ($! + 0, $^E + 0); ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $\ tosz2; ($!,$^E) = ($sts,$ossts); return 0; } *cp = \\© *mv = \\&move; if ($^O eq 'MacOS') { *_protect = sub { MacPerl::MakeFSSpec($_[0]) }; } else { *_protect = sub { "./$_[0]" }; } # &syscopy is an XSUB under OS/2 unless (defined &syscopy) { if ($^O eq 'VMS') { *syscopy = \\&rmscopy; } elsif ($^O eq 'mpeix') { *syscopy = sub { return 0 unless @_ == 2; # Use the MPE cp program in order to # preserve MPE file attributes. return system('/bin/cp', '-f', $_[0], $_[1]) == 0; }; } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader)\ { # Win32::CopyFile() fill only work if we can load Win32.xs *syscopy = sub { return 0 unless @_ == 2; return Win32::CopyFile(@_, 1); }; } elsif ($macfiles) { *syscopy = sub { my($from, $to) = @_; my($dir, $toname); return 0 unless -e $from; if ($to =~ /(.*:)([^:]+):?$/) { ($dir, $toname) = ($1, $2); } else { ($dir, $toname) = (":", $to); } unlink($to); Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1); }; } else { $Syscopy_is_copy = 1; *syscopy = \\© } } 1; __END__ =head1 NAME File::Copy - Copy files or filehandles =head1 SYNOPSIS use File::Copy; copy("file1","file2") or die "Copy failed: $!"; copy("Copy.pm",\\*STDOUT); move("/dev1/fileA","/dev2/fileB"); use File::Copy "cp"; $n = FileHandle->new("/a/file","r"); cp($n,"x"); =head1 DESCRIPTION The File::Copy module provides two basic functions, C and C, which are useful for getting the contents of a file from one place to another. =over 4 =item copy X X The C function takes two parameters: a file to copy from and a file to copy to. Either argument may be a string, a FileHandle reference or a FileHandle glob. Obviously, if the first argument is a filehandle of some sort, it will be read from, and if it is a file I it will be opened for reading. Likewise, the second argument will be written to (and created if need be). Trying to copy a file on top of itself is a fatal error. B Files are opened in binary mode where applicable. To get a consistent behaviour when copying from a filehandle to a file, use C on the filehandle. An