| #!/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"; |
| |