perl 3.0 patch #23 patch #19, continued
[perl.git] / os2 / eg / os2.pl
1 extproc C:\binp\misc\perl.exe -S
2
3 # os2.pl:  Demonstrates the OS/2 system calls and shows off some of the
4 # features in common with the UNIX version.
5
6 do "syscalls.pl" || die "Cannot load syscalls.pl ($!)";
7
8 # OS/2 version number.
9
10         $version = "  "; syscall($OS2_GetVersion,$version); 
11         ($minor, $major) = unpack("CC", $version);
12         print "You are using OS/2 version ", int($major/10), 
13                         ".", int($minor/10), "\n\n";
14  
15 # Process ID.
16         print "This process ID is $$ and its parent's ID is ", 
17                 getppid(), "\n\n";
18
19 # Priority.
20
21         printf "Current priority is %x\n", getpriority(0,0);
22         print "Changing priority by +5\n";
23         print "Failed!\n" unless setpriority(0,0,+5);
24         printf "Priority is now %x\n\n", getpriority(0,0);
25
26 # Beep.
27         print "Here is an A440.\n\n";
28         syscall($OS2_Beep,440,50);
29
30 # Pipes.  Unlike MS-DOS, OS/2 supports true asynchronous pipes.
31         open(ROT13, '|perl -pe y/a-zA-Z/n-za-mN-ZA-M/') || die;
32         select(ROT13); $|=1; select(STDOUT);
33         print "Type two lines of stuff, and I'll ROT13 it while you wait.\n".
34               "If you type fast, you might be able to type both of your\n".
35               "lines before I get a chance to translate the first line.\n";
36         $_ = <STDIN>; print ROT13 $_;
37         $_ = <STDIN>; print ROT13 $_;
38         close(ROT13);
39         print "Thanks.\n\n";
40
41 # Inspecting the disks.
42         print "Let's look at the disks you have installed...\n\n";
43
44         $x = "\0\0";
45         syscall($OS2_Config, $x, 2);
46         print "You have ", unpack("S", $x), " floppy disks,\n";
47
48         $x = "  ";
49         syscall($OS2_PhysicalDisk, 1, $x, 2, 0, 0);
50         ($numdisks) = unpack("S", $x);
51
52         print "and $numdisks partitionable disks.\n\n";
53         for ($i = 1; $i <= $numdisks; $i++) {
54                 $disk = $i . ":";
55                 $handle = "  ";
56                 syscall($OS2_PhysicalDisk, 2, $handle, 2, $disk, 3);
57                 ($numhandle) = unpack("S", $handle);
58                 $zero = pack("C", 0);
59                 $parmblock = " " x 16;
60                 syscall($OS2_IOCtl, $parmblock, $zero, 0x63, 9, $numhandle);
61                 ($x, $cylinders, $heads, $sect) = unpack("SSSS", $parmblock);
62                 print "Hard drive #$i:\n";
63                 print "   cylinders: $cylinders\n";
64                 print "       heads: $heads\n";
65                 print "    sect/trk: $sect\n";
66                 syscall($OS2_PhysicalDisk, 3, 0, 0, $handle, 2);
67         }
68
69 # I won't bother with the other stuff.  You get the idea.
70