#!/usr/bin/perl -w
# file: ftp_recent.pl
# Figure 6.1: Downloading a single file with Net::FTP
use Net::FTP;
use constant HOST => 'ftp.perl.org';
use constant DIR => '/pub/CPAN';
use constant FILE => 'RECENT';
my $ftp = Net::FTP->new(HOST) or die "Couldn't connect: $@\n";
$ftp->login('anonymous') or die $ftp->message;
$ftp->cwd(DIR) or die $ftp->message;
$ftp->get(FILE) or die $ftp->message;
$ftp->quit;
warn "File retrieved successfully.\n";
(2) Net::Telnet
#!/usr/bin/perl -w
# file:remoteps.pl
use strict;
use Net::Telnet;
use constant HOST => 'phage.cshl.org';
use constant USER => 'lstein';
use constant PASS => 'xyzzy';
my $telnet=Net::Telnet->new(HOST);
$telnet->login(USER,PASS);
my @lines=$telnet->cmd('ps -ef');
print @lines;
(3) LWP::Simple, get()
#!/usr/bin/perl -w
use strict;
use LWP::Simple qw(get);
my $url = shift || "";
my $content = get($url);
print $content;
exit 0;
#最简单方便的get网页的方法。
(4) Expect
#!/usr/bin/perl
use strict;
use Expect;
my $timeout = 2;
my $delay = 1;
my $cmd = "ssh";
my @params = qw/202.108.xx.xx -lusername -p22/;
my $pass = "passwd";
my $exp = Expect->spawn($cmd, @params) or die "Can't spawn $cmd\n";
$exp->expect($timeout, -re=>'[Pp]assword:');
$exp->send_slow($delay, "$pass\r\n");
$exp->interact();
$exp->hard_close();
exit 0;
(5) XML::Simple, XMLin()
#!/usr/bin/perl -w
use strict;
use XML::Simple;
my $text = <
< ?xml version="1.0"? > php net.php.servlet
php *.php
xml
my $x = XMLin($text);
foreach my $tag(keys %$x)
{
my %h = %{$$x{$tag}};
foreach(keys %h)
{
print "$tag => ";
print "$_ => $h{$_}\n";
}
}
exit 0;
(6) Data::Dumper, Dumper()
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
print Dumper(@INC);
print Dumper(%ENV);
exit 0;
(7) IO::Socket
#!/usr/bin/perl -w
use strict;
use IO::Socket;
my $host = "";
my $port = "80";
my $http_head = "GET / HTTP/1.0\nHost: $host:$port\n\n";
my $sock = IO::Socket::INET->new("$host:$port")
or die "Socket() error, Reason : $! \n";
print $sock $http_head;
print <$sock>;
exit 0;
(8) Date::Manip, DateCalc(), UnixDate()
#!/usr/bin/perl
use strict;
use Date::Manip;
my $date1 = "Fri Jun 6 18:31:42 GMT 2003";
my $date2 = "2003/05/06";
my $flag=&Date_Cmp($date1,$date2);
if($flag<0)
{
print "date1 is earlier!\n";
}
elsif($flag==0)
{
print "the two dates are identical!\n";
}
else
{
print "date2 is earlier!\n";
}
exit 0;
(9) Date::Manip, Date_Cmp()
(10) File::Find, find()
#!/usr/bin/perl -w
use strict;
use File::Find;
my $file = "access.log";
my $path = "/";
find(&process, $path);
sub process{ print $File::Find::dir, "$_\n" if(/$file/); }
my $dbh = DBI->connect("dbi:mysql:dbname", 'user','passwd', '')
or die "can't connect!\n";
my $sql = qq/show variables/;
my $sth = $dbh->prepare($sql);
$sth->execute();
#!/usr/bin/perl
use strict;
use Net::POP3;
use Data::Dumper;
my $user = "user";
my $pass = shift or die "Usage : $0 passwd\n";
my $host = "pop3.web.com";#pop3 address
my $p = Net::POP3->new($host) or die "Can't connect $host!\n";
$p->login($user, $pass) or die "user or passwd error!\n";
my $title = $p->list or die "No mail for $user\n";
foreach my $h(keys %$title)
{
my $msg = $p->get($h);
print @$msg;
}
$p->quit;
exit 0;
my $smtp = Net::SMTP->new('smtp.sohu.com', Timeout => 10, Debug => 0)
or die "new error\n";
#$smtp->auth("user", "passwd") or die "auth error\n";
$smtp->mail('some');
$smtp->to('some@some.com');
$smtp->data("chinaunix,哈楼你好啊!\n:)");
$smtp->quit;
my $server = new Net::IMAP::Simple( 'imap.0451.com' );
$server->login( 'user_name', 'passwd');
#show the mailboxs
#map {print "$_\n";} $server->mailboxes();
#show mail's content
my $n = $server->select( 'inbox' ) or die "no this folder\n";
foreach my $msg ( 1..$n )
{
my $lines = $server->get( $msg );
print @$lines;
print "_________________ Press enter key to view another! ...... __________________\n";
read STDIN, my $key, 1;
}
exit 0;
在取得中文的Folder时,会出现乱码的情况,
这个问题现在没有解决。英文的Folder则没问题。
IMAP协议,默认端口为143,可以用telnet登录。
QUOTE:telnet imap.xxx.com 143
2 login user pass
2 list "" *
2 select inbox
......
use Bio::DB::GenBank;
use Bio::SeqIO;
my $gb = new Bio::DB::GenBank;
my $seqout = new Bio::SeqIO(-fh => *STDOUT, -format => 'fasta');
# if you want to get a bunch of sequences use the batch method
my $seqio = $gb->get_Stream_by_id([ qw(27501445 2981014)]);
while( defined ($seq = $seqio->next_seq )) {
$seqout->write_seq($seq);
}
(30) Spreadsheet::ParseExcel
perl解析Excel文件的例子。
QUOTE:#!/usr/bin/perl -w
use strict;
use Spreadsheet::ParseExcel;
use Spreadsheet::ParseExcel::FmtUnicode; #gb support
my $oExcel = new Spreadsheet::ParseExcel;
die "You must provide a filename to $0 to be parsed as an Excel file" unless @ARGV;
my $code = $ARGV[1] || "CP936"; #gb support
my $oFmtJ = Spreadsheet::ParseExcel::FmtUnicode->new(Unicode_Map => $code); #gb support
my $oBook = $oExcel->Parse($ARGV[0], $oFmtJ);
my($iR, $iC, $oWkS, $oWkC);
print "FILE :", $oBook->{File} , "\n";
print "COUNT :", $oBook->{SheetCount} , "\n";
print "AUTHOR:", $oBook->{Author} , "\n"
if defined $oBook->{Author};
$x = $image->Crop(geometry=>'100x100"+100"+100');
warn "$x" if "$x";
$x = $image->Write('x.png');
warn "$x" if "$x";
The script reads three images, crops them, and writes a single image as a GIF animation
sequence. In many cases you may want to access individual images of a sequence. The next
example illustrates how this is done:
Or suppose you want to convert your color image to grayscale:
QUOTE:$image->Quantize(colorspace=>'gray');
Here we annotate an image with a Taipai TrueType font:
$text = 'Works like magick!';
$image->Annotate(font=>'kai.ttf', pointsize=>40, fill=>'green', text=>$text);
Other clever things you can do with a PerlMagick objects include
QUOTE:$i = $#$p"+1"; # return the number of images associated with object p
push(@$q, @$p); # push the images from object p onto object q
@$p = (); # delete the images but not the object p
$p->Convolve([1, 2, 1, 2, 4, 2, 1, 2, 1]); # 3x3 Gaussian kernel