diff options
Diffstat (limited to 'symbian/demo_pl')
| -rw-r--r-- | symbian/demo_pl | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/symbian/demo_pl b/symbian/demo_pl new file mode 100644 index 0000000000..fbba5f4bf9 --- /dev/null +++ b/symbian/demo_pl @@ -0,0 +1,128 @@ +#!/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"; + |