6 # A "self-extracting archive" for some demo scripts.
9 # helloyou - advanced classic
10 # httpget1 - simple sockets
11 # httpget2 - simple sockets done complex
12 # md5 - core extension
14 # times - more system calls
19 unless (@ARGV && $ARGV[0] =~ /^(?:list|extract|cleanup)$/) {
20 die "$0: Usage: $0 [list|extract|cleanup]\n";
24 my $list = $action eq 'list';
25 my $extract = $action eq 'extract';
26 my $cleanup = $action eq 'cleanup';
30 if (/^-- (.+\.pl)$/) {
32 print "Deleting $1\n";
33 unlink $1 or warn "$0: $1: $!\n";
35 defined $fh && close($fh);
36 open($fh, ">$1") or die "$0: '$1': $!\n";
37 print "Extracting $1\n";
42 print $fh $_ if $extract;
45 defined $fh && close($fh);
49 print "hello world!\n";
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;
60 print "(Using plain sockets)\n";
65 $host = 'www.nokia.com' unless length $host;
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 /: $!";
76 print "Receiving...\n";
77 while (my $line = <S>) {
80 close(S) || die "close: $!";
81 printf "Got %d lines.\n", scalar @line;
84 print "(Using IO::Socket)\n";
88 $host = 'www.nokia.com' unless length $host;
91 IO::Socket::INET->new(Proto => "tcp",
94 print "$host:$port:\nConnected.\n";
95 select($remote); $| = 1; select(STDOUT);
96 print $remote "GET / HTTP/1.0\012\012" || die "GET /: $!";
98 print "Receiving...\n";
99 while (my $line = <$remote>) {
102 close($remote) || die "close: $!";
103 printf "Got %d lines.\n", scalar @line;
105 use Digest::MD5 'md5_hex';
106 print "(Using Digest::MD5)\nMD5 of 'Perl' is:\n";
107 print md5_hex('Perl'), "\n";
109 print "Running in $^O\n";
110 print scalar localtime, "\n";
112 use Time::HiRes qw(time sleep);
113 print CORE::time(), "\n";
116 print "Sleep 1.5 s...\n";
119 print "To one million...\n";
122 print "Cpu ", scalar times(), "\n";
123 for(my $i = 0; $i < 1e6; $i++) {}
124 print "Cpu ", scalar times(), "\n";
127 print "Wall ", $t1 - $t0, "\n";