perl/symbian/demo_pl
<<
>>
Prefs
   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
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.