symbian/demo_pl

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