Move XSLoader from ext/ to dist/
[perl.git] / 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