#!/usr/bin/perl
# Filename: BuildSocketTCP.pm
#
# Copyright 2012 Axxeo GmbH
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package BuildSocketTCP;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(readfile checkfile);
use IO::Socket::INET; # provides an object interface to creating and using Socket
use strict ‘vars‘; # this generates a runtime error if you use symbolic references
use constant false => 0;
use constant true => 1;
# flush after every write
$| = 1;
#Create a new instance
sub new {
my $self = {}; # Connect the hash to the package Cocoa.
shift;
my ($ip, $port, $proto, $isserver) = @_;
my $socket;
my $self->{‘ip‘} = $ip;
my $self->{‘port‘} = $port;
if ($isserver == true && $proto == ‘tcp‘)
{
my $socket = new IO::Socket::INET (
#LocalHost => ‘0.0.0.0‘,
LocalPort => $port ||‘7777‘,
Proto => ‘tcp‘,
Listen => 5,
Reuse => 1) or die "* Error Server in Socket Creation : $!\n";
print "TCP Server connected successful be created with port : $port\n";
print "---------------------\n";
$self->{‘sock‘} = $socket;
}
else
{
my $socket = new IO::Socket::INET (
PeerHost => $ip || ‘127.0.0.1‘,
PeerPort => $port ||‘7777‘,
Proto => ‘tcp‘) or die "* Error Client in Socket Creation : $!\n";
print "TCP Client connected successful be created with host : $ip\n";
print "TCP Client connected successful be created with port : $port\n";
print "---------------------\n";
#print "$socket"."\n";
$self->{‘socket‘} = $socket; #将新建的socket作为类似 类属性保存在dict里面
}
#print $self->{‘socket‘}."AAAA\n";
bless ($self); # 这里应该注意只bless self变量本身
return $self; # Return the reference to the hash.
}
#Subroutine to accept the socket
sub acceptSocket
{
my $self = shift;
return $self->{‘socket‘} = $self->{‘sock‘}->accept();
}
#Subroutine to close the socket
sub closeSocket
{
my $self = shift;
$self->{‘socket‘}->close() or die "* Error to close the socket"
}
#Subroutine to send the data
sub sendViasocket
{
my $self = shift;
my ($data_out, $length , $description) = @_;
($self->{‘socket‘})->send($data_out, $length);
($self->{‘socket‘})->flush;
print "Send data successful via tcp socket>> : $description >>: $data_out\n";
}
#Subroutine to recv the data
sub recvViasocket
{
my $self = shift;
my ($length, $description) = @_;
my $data_in;
($self->{‘socket‘})->recv($data_in,$length);
($self->{‘socket‘})->flush;
#print "Recvied data successful via tcp socket: $description >>: $data_in\n";
return $data_in;
}
1;
这只是给大家提供一种思路，毕竟是第一次尝试写类似的东西，难免存在不足之处，希望大家谅解，这样类似与Python语言装饰器的效果，给一些基本的包里面的方法提供了更多扩展和美化的作用，也为后来使用提供了方便。
本文出自 “EIT流浪汉” 博客，请务必保留此出处http://zicowarn.blog.51cto.com/3815716/1614593
尝试自己的Perl语言的包 TCP协议的再包装起到类似python语言装饰器的效果
原文地址：http://zicowarn.blog.51cto.com/3815716/1614593
