Commit | Line | Data |
---|---|---|
27da23d5 JH |
1 | #!/usr/bin/perl -w |
2 | ||
3 | # | |
4 | # demo_pl | |
5 | # | |
6 | # A "self-extracting archive" for some demo scripts. | |
7 | # | |
8 | # hello - the classic | |
9 | # helloyou - advanced classic | |
10 | # httpget1 - simple sockets | |
11 | # httpget2 - simple sockets done complex | |
12 | # md5 - core extension | |
13 | # time - system call | |
14 | # times - more system calls | |
15 | # | |
16 | ||
17 | use strict; | |
18 | ||
19 | unless (@ARGV && $ARGV[0] =~ /^(?:list|extract|cleanup)$/) { | |
20 | die "$0: Usage: $0 [list|extract|cleanup]\n"; | |
21 | } | |
22 | ||
23 | my $action = shift; | |
24 | my $list = $action eq 'list'; | |
25 | my $extract = $action eq 'extract'; | |
26 | my $cleanup = $action eq 'cleanup'; | |
27 | ||
28 | my $fh; | |
29 | while (<DATA>) { | |
30 | if (/^-- (.+\.pl)$/) { | |
31 | if ($cleanup) { | |
32 | print "Deleting $1\n"; | |
33 | unlink $1 or warn "$0: $1: $!\n"; | |
34 | } elsif ($extract) { | |
35 | defined $fh && close($fh); | |
36 | open($fh, ">$1") or die "$0: '$1': $!\n"; | |
37 | print "Extracting $1\n"; | |
38 | } elsif ($list) { | |
39 | print "$1\n"; | |
40 | } | |
41 | } else { | |
42 | print $fh $_ if $extract; | |
43 | } | |
44 | } | |
45 | defined $fh && close($fh); | |
46 | exit(0); | |
47 | __END__ | |
48 | -- hello.pl | |
49 | print "hello world!\n"; | |
50 | -- helloyou.pl | |
51 | print "What is your name?\n"; | |
52 | chomp(my $name = <STDIN>); | |
53 | print "Hello, $name!\n"; | |
54 | print "Amazing fact #1:\n"; | |
55 | printf "Your name has\n%d character%s!\n", | |
56 | length($name), length($name) == 1 ? "" : "s"; | |
57 | print "Amazing fact #2:\n"; | |
58 | printf "Your name is\n%s backwards!\n", scalar reverse $name; | |
59 | -- httpget1.pl | |
60 | print "(Using plain sockets)\n"; | |
61 | use Socket; | |
62 | print "Host? "; | |
63 | my $host = <STDIN>; | |
64 | chomp($host); | |
65 | $host = 'www.nokia.com' unless length $host; | |
66 | my $port = 80; | |
67 | my $iaddr = inet_aton($host) || die "no host: $host"; | |
68 | my $paddr = sockaddr_in($port, $iaddr); | |
69 | my $proto = getprotobyname("tcp"); | |
70 | socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; | |
71 | connect(S, $paddr) || die "connect: $!"; | |
72 | print "$host:$port:\nConnected.\n"; | |
73 | select(S); $| = 1; select(STDOUT); | |
74 | print S "GET / HTTP/1.0\012\012" || die "GET /: $!"; | |
75 | my @line; | |
76 | print "Receiving...\n"; | |
77 | while (my $line = <S>) { | |
78 | push @line, $line; | |
79 | } | |
80 | close(S) || die "close: $!"; | |
81 | printf "Got %d lines.\n", scalar @line; | |
82 | -- httpget2.pl | |
83 | use IO::Socket; | |
84 | print "(Using IO::Socket)\n"; | |
85 | print "Host? "; | |
86 | my $host = <STDIN>; | |
87 | chomp($host); | |
88 | $host = 'www.nokia.com' unless length $host; | |
89 | my $port = 80; | |
90 | my $remote = | |
91 | IO::Socket::INET->new(Proto => "tcp", | |
92 | PeerAddr => $host, | |
93 | PeerPort => $port); | |
94 | print "$host:$port:\nConnected.\n"; | |
95 | select($remote); $| = 1; select(STDOUT); | |
96 | print $remote "GET / HTTP/1.0\012\012" || die "GET /: $!"; | |
97 | my @line; | |
98 | print "Receiving...\n"; | |
99 | while (my $line = <$remote>) { | |
100 | push @line, $line; | |
101 | } | |
102 | close($remote) || die "close: $!"; | |
103 | printf "Got %d lines.\n", scalar @line; | |
104 | -- md5.pl | |
105 | use Digest::MD5 'md5_hex'; | |
106 | print "(Using Digest::MD5)\nMD5 of 'Perl' is:\n"; | |
107 | print md5_hex('Perl'), "\n"; | |
108 | -- time.pl | |
109 | print "Running in $^O\n"; | |
110 | print scalar localtime, "\n"; | |
111 | -- times.pl | |
112 | use Time::HiRes qw(time sleep); | |
113 | print CORE::time(), "\n"; | |
114 | print "Hires\n"; | |
115 | print time(), "\n"; | |
116 | print "Sleep 1.5 s...\n"; | |
117 | sleep(1.5); | |
118 | print time(), "\n"; | |
119 | print "To one million...\n"; | |
120 | my $t0 = time(); | |
121 | print $t0, "\n"; | |
122 | print "Cpu ", scalar times(), "\n"; | |
123 | for(my $i = 0; $i < 1e6; $i++) {} | |
124 | print "Cpu ", scalar times(), "\n"; | |
125 | my $t1 = time(); | |
126 | print $t1, "\n"; | |
127 | print "Wall ", $t1 - $t0, "\n"; | |
128 |