Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
ext	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
PerlApp.cpp	15.25 KB	-r--r--r--	2014-12-27 11:49
PerlApp.h	2.3 KB	-r--r--r--	2014-12-27 11:49
PerlApp.hrh	608 B	-r--r--r--	2014-12-27 11:49
PerlAppAif.rss	521 B	-r--r--r--	2014-12-27 11:49
PerlBase.cpp	11.19 KB	-r--r--r--	2014-12-27 11:49
PerlBase.h	4.23 KB	-r--r--r--	2014-12-27 11:49
PerlBase.pod	4.5 KB	-r--r--r--	2014-12-27 11:49
PerlRecog.cpp	1.49 KB	-r--r--r--	2014-12-27 11:49
PerlRecog.mmp	197 B	-r--r--r--	2014-12-27 11:49
PerlUi.cpp	7.63 KB	-r--r--r--	2014-12-27 11:49
PerlUi.h	3.52 KB	-r--r--r--	2014-12-27 11:49
PerlUi.hrh	331 B	-r--r--r--	2014-12-27 11:49
PerlUiS60.rss	2.78 KB	-r--r--r--	2014-12-27 11:49
PerlUiS80.rss	1.89 KB	-r--r--r--	2014-12-27 11:49
PerlUiS90.rss	1.9 KB	-r--r--r--	2014-12-27 11:49
PerlUiUIQ.rss	2.26 KB	-r--r--r--	2014-12-27 11:49
PerlUtil.cpp	2.88 KB	-r--r--r--	2014-12-27 11:49
PerlUtil.h	1.19 KB	-r--r--r--	2014-12-27 11:49
PerlUtil.pod	1.24 KB	-r--r--r--	2014-12-27 11:49
README	558 B	-r--r--r--	2014-12-27 11:49
TODO	6.99 KB	-r--r--r--	2014-12-27 11:49
bld.inf	40 B	-r--r--r--	2014-12-27 11:49
config.pl	27.36 KB	-r--r--r--	2014-12-27 11:49
config.sh	16.55 KB	-r--r--r--	2014-12-27 11:49
cwd.pl	87 B	-r--r--r--	2014-12-27 11:49
demo_pl	3.25 KB	-r--r--r--	2014-12-27 11:49
find_writeable_data.pl	1.41 KB	-r--r--r--	2014-12-27 11:49
hexdump.pl	959 B	-r--r--r--	2014-12-27 11:49
install.cfg	2.32 KB	-r--r--r--	2014-12-27 11:49
makesis.pl	5.41 KB	-r--r--r--	2014-12-27 11:49
port.pl	154 B	-r--r--r--	2014-12-27 11:49
sanity.pl	925 B	-r--r--r--	2014-12-27 11:49
sdk.pl	7.93 KB	-r--r--r--	2014-12-27 11:49
sisify.pl	81.87 KB	-r--r--r--	2014-12-27 11:49
symbian_dll.cpp	639 B	-r--r--r--	2014-12-27 11:49
symbian_proto.h	2.78 KB	-r--r--r--	2014-12-27 11:49
symbian_stubs.c	3.48 KB	-r--r--r--	2014-12-27 11:49
symbian_stubs.h	482 B	-r--r--r--	2014-12-27 11:49
symbian_utils.cpp	13.92 KB	-r--r--r--	2014-12-27 11:49
symbianish.h	7.23 KB	-r--r--r--	2014-12-27 11:49
uid.pl	11 B	-r--r--r--	2014-12-27 11:49
version.pl	494 B	-r--r--r--	2014-12-27 11:49
xsbuild.pl	27.3 KB	-r--r--r--	2014-12-27 11:49

Rename

#!/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";