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