Symbian port of Perl

Message-ID: <B356D8F434D20B40A8CEDAEC305A1F2453D653@esebe105.NOE.Nokia.com>

p4raw-id: //depot/perl@24271

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";
+