Commit | Line | Data |
27da23d5 |
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 | |