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