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
17use strict;
18
19unless (@ARGV && $ARGV[0] =~ /^(?:list|extract|cleanup)$/) {
20   die "$0: Usage: $0 [list|extract|cleanup]\n";
21}
22
23my $action = shift;
24my $list    = $action eq 'list';
25my $extract = $action eq 'extract';
26my $cleanup = $action eq 'cleanup';
27
28my $fh;
29while (<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}
45defined $fh && close($fh);
46exit(0);
47__END__
48-- hello.pl
49print "hello world!\n";
50-- helloyou.pl
51print "What is your name?\n";
52chomp(my $name = <STDIN>);
53print "Hello, $name!\n";
54print "Amazing fact #1:\n";
55printf "Your name has\n%d character%s!\n",
56       length($name), length($name) == 1 ? "" : "s";
57print "Amazing fact #2:\n";
58printf "Your name is\n%s backwards!\n", scalar reverse $name;
59-- httpget1.pl
60print "(Using plain sockets)\n";
61use Socket;
62print "Host? ";
63my $host = <STDIN>;
64chomp($host);
65$host = 'www.nokia.com' unless length $host;
66my $port    = 80;
67my $iaddr   = inet_aton($host)           || die "no host: $host";
68my $paddr   = sockaddr_in($port, $iaddr);
69my $proto   = getprotobyname("tcp");
70socket(S, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
71connect(S, $paddr)                       || die "connect: $!";
72print "$host:$port:\nConnected.\n";
73select(S); $| = 1; select(STDOUT);
74print S "GET / HTTP/1.0\012\012"         || die "GET /: $!";
75my @line;
76print "Receiving...\n";
77while (my $line = <S>) {
78    push @line, $line;
79}
80close(S)                                 || die "close: $!";
81printf "Got %d lines.\n", scalar @line;
82-- httpget2.pl
83use IO::Socket;
84print "(Using IO::Socket)\n";
85print "Host? ";
86my $host = <STDIN>;
87chomp($host);
88$host = 'www.nokia.com' unless length $host;
89my $port = 80;
90my $remote =
91    IO::Socket::INET->new(Proto    => "tcp",
92                          PeerAddr => $host,
93                          PeerPort => $port);
94print "$host:$port:\nConnected.\n";
95select($remote); $| = 1; select(STDOUT);
96print $remote "GET / HTTP/1.0\012\012" || die "GET /: $!";
97my @line;
98print "Receiving...\n";
99while (my $line = <$remote>) {
100    push @line, $line;
101}
102close($remote)                         || die "close: $!";
103printf "Got %d lines.\n", scalar @line;
104-- md5.pl
105use Digest::MD5 'md5_hex';
106print "(Using Digest::MD5)\nMD5 of 'Perl' is:\n";
107print md5_hex('Perl'), "\n";
108-- time.pl
109print "Running in $^O\n";
110print scalar localtime, "\n";
111-- times.pl
112use Time::HiRes qw(time sleep);
113print CORE::time(), "\n";
114print "Hires\n";
115print time(), "\n";
116print "Sleep 1.5 s...\n";
117sleep(1.5);
118print time(), "\n";
119print "To one million...\n";
120my $t0 = time();
121print $t0, "\n";
122print "Cpu  ", scalar times(), "\n";
123for(my $i = 0; $i < 1e6; $i++) {}
124print "Cpu  ", scalar times(), "\n";
125my $t1 = time();
126print $t1, "\n";
127print "Wall ", $t1 - $t0, "\n";
128
129