[Perl] OC:Net -> upload & download Server-Client

Introduction

I would like to hold the first open project (or open competition) for network programming in 2009 at [import Code.*]. In this project, you can implement any kind of network program with any programming language. The basic requirement is sharing your code on blog. The winner will be next core founder (wtf...).

Below is my first Perl network program for this project. (Because someone forbids me to post my previous work - Network Programming in C, I switch to Perl. )

Server.pl
#! /usr/bin/perl

###############################################################
# Name:Perl Server Socket
# Description: A simple implementation for uploading &
# downloading in perl socket.
# Date: 2009.05.05
# Programmer: Lin Xin Yu
# Website:http://importcode.blogspot.com
###############################################################

use strict;
use warnings;
use IO::Socket;
use POSIX qw(:sys_wait_h);

#=============== Network Settings =============================

my $MAX_LEN = 1024;
my $host = 'localhost';
my $port = shift || 3456;

#==============================================================
#********** CLIENT ROUTINE ************************************
#==============================================================
sub client_jobs(@){
my $client = shift;

print $client "Welcome to Perl server.\n";
while(defined(my $buf = <$client>)){
if($buf =~ /^upload/){
# get filename from client.
chomp(my $filename = <$client>);

# open file for writing.
unless(open(DEST,"> $filename")){
print $client "not ready for uploading\n";
next;
}
print $client "ready for uploading\n";

# get filesize from client.
chomp(my $filesize = <$client>);

my $len = 0;
my $data = '';
while($len < $filesize && !($buf =~ /^quit/i) ){
$buf = <$client>;
$len += length($buf);
$data .= $buf;
}
chomp $data;

# write data into file
print DEST $data;

print "[$filename] Upload Completed\n";
unless(close DEST){
print "Can't close [$filename]\n";
next;
}
#or die "Can't close file: $filename\n";
}

if($buf =~ /^download/){
# get filename from client.
chomp(my $filename = <$client>);

# open file for writing.
unless(open(SRC,"< $filename")){
print $client "not ready for downloading\n";
next;
}
print $client "ready for downloading\n";

$buf = <$client>;
if($buf =~ /^not ready/){
#print $buf."\n";
unless(close SRC){
print "Can't close [$filename]\n";
next;
}
}

# send filesize to client.
my $filesize = -s $filename;
print $client $filesize."\n";

my $len = 0;
while($len < $filesize){
read(SRC, $buf, $MAX_LEN, 0) or die "Client Aborted!\n";
print $client $buf;
$len += length($buf);
}

# flush socket;
print $client "\n";

#print "[$filename] Download Completed\n";
unless(close SRC){
print "Can't close [$filename]\n";
next;
}
#or die "Can't close file: $filename\n";
}

last if !$buf || $buf =~ /^(?:quit|exit)$/i;
}
close($client);
}

#==============================================================
#********** THIS IS THE MAIN PROGRAM **************************
#==============================================================

# Socket connection for Server.
my $server = new IO::Socket::INET( LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Timeout => 20,
Reuse => 1,)
or die "Socket could not be created,Reason:$!";

# Wait for accepting.
print "Waiting for connection...\n";
while (my $client = $server->accept()){
pipe(README, WRITEME);
if (my $pid = fork) {
# parent
close(WRITEME);
} else {
die "cannot fork: $!" unless defined $pid;
my $peer = gethostbyaddr($client->peeraddr,AF_INET) || $client->peerhost;
my $port = $client->peerport;
warn "Connection from [$peer,$port]\n";

client_jobs($client);
# child
close(README);
}
close(README);
}

close($server);

#=============================================================
#********** END OF THE MAIN PROGRAM **************************
#=============================================================



Client.pl
#! /usr/bin/perl
###############################################################
# Name: Perl Client Socket
# Description: A simple implementation for uploading &
# downloading in perl socket.
# Date: 2009.05.05
# Programmer: Lin Xin Yu
# Website:http://importcode.blogspot.com
###############################################################

use strict;
use warnings;
use IO::Socket;

#=============== Network Settings =============================
my $MAX_LEN = 1024;
my $remote_host = shift || 'localhost';
my $remote_port = shift || 3456;
my $client;

#==============================================================
#********** THIS IS THE MAIN PROGRAM **************************
#==============================================================
$SIG{'INT'}= sub{ print $client "quit\n"; };

# Socket connection for Client.
$client = IO::Socket::INET->new( PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => 'tcp',
Type => SOCK_STREAM,
Timeout => 20)
or die "Couldn't connect to $remote_host:$remote_port : $@\n";

# Print welcome message.
my $buf = <$client>;
print $buf;

# Wait for user input.
print ":";
while(chomp(my $oneLineCommand = <STDIN>)){
last if !$oneLineCommand || $oneLineCommand =~ /^(?:quit|exit)$/i;

my @commands = split(/[ ,]/, $oneLineCommand);
my $option = $commands[0];
shift(@commands);

###### for 'upload' command ######
if($option =~ /^upload/){
foreach my $filename(@commands){
unless (open(SRC,"< $filename")){
print "Fail to open [$filename] for uploading.\n";
next;
}

# send 'upload' command to server.
print $client $option."\n";

# send filename to server.
print $client $filename."\n";

# get upload state from server
$buf = <$client>;
if($buf =~ /^not ready/){
#print $buf."\n";
unless(close SRC){
print "Can't close [$filename]\n";
next;
}
}

# send filesize to server.
my $filesize = -s $filename;
print $client $filesize."\n";

# send data to server.
my $len = 0;
while($len < $filesize){
read(SRC, $buf, $MAX_LEN, 0);
print $client $buf;

$len += length($buf);
print STDERR "\b\b\b\b\b\b\b%".int($len/$filesize*100);
}

print " [$filename] Upload Completed!\n";

# flush socket;
print $client "\n";

unless(close SRC){
print "Can't close [$filename]\n";
next;
}
}
}

###### for 'download' command ######
if($option =~ /^download/){

foreach my $filename(@commands){
# send 'download' command to server.
print $client $option."\n";

# send filename to server.
print $client $filename."\n";

# get download state from server
$buf = <$client>;
if($buf =~ /^not ready/){
#print $buf."\n";
unless(close SRC){
print "Can't close [$filename]\n";
next;
}
}

# send downloading state to server.
unless(open(DEST,"> $filename")){
print "Fail to open [$filename] for downloading.\n";
print $client "not read for downloading\n";
next;
}
print $client "read for downloading\n";

# get filesize from server.
my $filesize = <$client>;
chomp($filesize);
print $filesize;

# get data to server.
my $len = 0;
my $data = '';
while($len < $filesize){
$buf = <$client>;
$len += length($buf);
$data .= $buf;
print STDERR "\b\b\b\b\b\b\b%".int($len/$filesize*100);
}
chomp $data;
print DEST $data;

print " [$filename] Download Completed!\n";

unless(close DEST){
print "Can't close [$filename]\n";
next;
}
}
}

if($option =~ /^(?:help|\?)$/i){
print "usage: \n\tdownload [filename 1] [filename 2] ...\n"
."\tupload [filename 1] [filename 2] ...\n";
}

print "\n:";
}

close($client);

#==============================================================
#********** END OF THE MAIN PROGRAM ***************************
#==============================================================



Note:
Cause I don't really familiar with Perl language, the code might incomplete and ugly.