Perl AIM自动回复
#!/usr/bin/perl
use warnings;
use strict;
use Net::OSCAR qw(:standard);
my $screenname = 'screenname';
my $password = 'password';
my $logfile = '~/aimbot.log';
my $oscar;
$oscar = Net::OSCAR->new(capabilities => [qw(extended_status)]);
$oscar->set_callback_im_in(\&im_in);
$oscar->signon($screenname, $password);
while(1) { $oscar->do_one_loop(); }
sub im_in {
my($oscar, $sender, $message, $is_away) = @_;
# respond to the poor soul still using ICQ
my $response = "Sorry, I am no longer using ICQ. " .
"If you need to contact me, try sending me an " .
"email/Jabber/GTalk message at 'me\@domain.com'. " .
"(This is an automated response.)\n";
$oscar->send_im($sender, $response);
# save the message to the log-file
open (LOG, ">>$logfile") or print "Oops, can't open logfile.\a\n";
print LOG scalar(localtime)." [AWAY] " if $is_away;
print LOG scalar(localtime).(" "x8)."$sender: $message\n";
close LOG
}
Perl perl google soap示例
#!/usr/bin/perl
use SOAP::Lite;
use strict;
use warnings;
@ARGV == 2 or die "Usage: google <query> <number of results 1-10>\n";
my $key='OS7mOjxQFHIztxIYU9yb8y3ibYgY4w2o';
my($query, $maxResults) = @ARGV;
my @params = ($key, $query, 0, $maxResults, 0, '', 0, '', 'latin1', 'latin1');
my $result = SOAP::Lite->service("file:GoogleSearch.wsdl")->doGoogleSearch(@params);
print "Result: \n";
print join "\n", map( { qq{$_->{URL}} } @{$result->{resultElements}} );
Here is the Google include file:
<?xml version="1.0"?>
<!-- WSDL description of the Google Web APIs.
The Google Web APIs are in beta release. All interfaces are subject to
change as we refine and extend our APIs. Please see the terms of use
for more information. -->
<!-- Revision 2002-08-16 -->
<definitions name="GoogleSearch"
targetNamespace="urn:GoogleSearch"
xmlns:typens="urn:GoogleSearch"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
xmlns="http://schemas.xmlsoap.org/wsdl/">
<!-- Types for search - result elements, directory categories -->
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:GoogleSearch">
<xsd:complexType name="GoogleSearchResult">
<xsd:all>
<xsd:element name="documentFiltering" type="xsd:boolean"/>
<xsd:element name="searchComments" type="xsd:string"/>
<xsd:element name="estimatedTotalResultsCount" type="xsd:int"/>
<xsd:element name="estimateIsExact" type="xsd:boolean"/>
<xsd:element name="resultElements" type="typens:ResultElementArray"/>
<xsd:element name="searchQuery" type="xsd:string"/>
<xsd:element name="startIndex" type="xsd:int"/>
<xsd:element name="endIndex" type="xsd:int"/>
<xsd:element name="searchTips" type="xsd:string"/>
<xsd:element name="directoryCategories" type="typens:DirectoryCategoryArray"/>
<xsd:element name="searchTime" type="xsd:double"/>
</xsd:all>
</xsd:complexType>
<xsd:complexType name="ResultElement">
<xsd:all>
<xsd:element name="summary" type="xsd:string"/>
<xsd:element name="URL" type="xsd:string"/>
<xsd:element name="snippet" type="xsd:string"/>
<xsd:element name="title" type="xsd:string"/>
<xsd:element name="cachedSize" type="xsd:string"/>
<xsd:element name="relatedInformationPresent" type="xsd:boolean"/>
<xsd:element name="hostName" type="xsd:string"/>
<xsd:element name="directoryCategory" type="typens:DirectoryCategory"/>
<xsd:element name="directoryTitle" type="xsd:string"/>
</xsd:all>
</xsd:complexType>
<xsd:complexType name="ResultElementArray">
<xsd:complexContent>
<xsd:restriction base="soapenc:Array">
<xsd:attribute ref="soapenc:arrayType" wsdl:arrayType="typens:ResultElement[]"/>
</xsd:restriction>
</xsd:complexContent>
</xsd:complexType>
<xsd:complexType name="DirectoryCategoryArray">
<xsd:complexContent>
<xsd:restriction base="soapenc:Array">
<xsd:attribute ref="soapenc:arrayType" wsdl:arrayType="typens:DirectoryCategory[]"/>
</xsd:restriction>
</xsd:complexContent>
</xsd:complexType>
<xsd:complexType name="DirectoryCategory">
<xsd:all>
<xsd:element name="fullViewableName" type="xsd:string"/>
<xsd:element name="specialEncoding" type="xsd:string"/>
</xsd:all>
</xsd:complexType>
</xsd:schema>
</types>
<!-- Messages for Google Web APIs - cached page, search, spelling. -->
<message name="doGetCachedPage">
<part name="key" type="xsd:string"/>
<part name="url" type="xsd:string"/>
</message>
<message name="doGetCachedPageResponse">
<part name="return" type="xsd:base64Binary"/>
</message>
<message name="doSpellingSuggestion">
<part name="key" type="xsd:string"/>
<part name="phrase" type="xsd:string"/>
</message>
<message name="doSpellingSuggestionResponse">
<part name="return" type="xsd:string"/>
</message>
<!-- note, ie and oe are ignored by server; all traffic is UTF-8. -->
<message name="doGoogleSearch">
<part name="key" type="xsd:string"/>
<part name="q" type="xsd:string"/>
<part name="start" type="xsd:int"/>
<part name="maxResults" type="xsd:int"/>
<part name="filter" type="xsd:boolean"/>
<part name="restrict" type="xsd:string"/>
<part name="safeSearch" type="xsd:boolean"/>
<part name="lr" type="xsd:string"/>
<part name="ie" type="xsd:string"/>
<part name="oe" type="xsd:string"/>
</message>
<message name="doGoogleSearchResponse">
<part name="return" type="typens:GoogleSearchResult"/>
</message>
<!-- Port for Google Web APIs, "GoogleSearch" -->
<portType name="GoogleSearchPort">
<operation name="doGetCachedPage">
<input message="typens:doGetCachedPage"/>
<output message="typens:doGetCachedPageResponse"/>
</operation>
<operation name="doSpellingSuggestion">
<input message="typens:doSpellingSuggestion"/>
<output message="typens:doSpellingSuggestionResponse"/>
</operation>
<operation name="doGoogleSearch">
<input message="typens:doGoogleSearch"/>
<output message="typens:doGoogleSearchResponse"/>
</operation>
</portType>
<!-- Binding for Google Web APIs - RPC, SOAP over HTTP -->
<binding name="GoogleSearchBinding" type="typens:GoogleSearchPort">
<soap:binding style="rpc"
transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="doGetCachedPage">
<soap:operation soapAction="urn:GoogleSearchAction"/>
<input>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<operation name="doSpellingSuggestion">
<soap:operation soapAction="urn:GoogleSearchAction"/>
<input>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<operation name="doGoogleSearch">
<soap:operation soapAction="urn:GoogleSearchAction"/>
<input>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded"
namespace="urn:GoogleSearch"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
</binding>
<!-- Endpoint for Google Web APIs -->
<service name="GoogleSearchService">
<port name="GoogleSearchPort" binding="typens:GoogleSearchBinding">
<soap:address location="http://api.google.com/search/beta2"/>
</port>
</service>
</definitions>
Perl 生成随机密码
srand(time ^ $$);
for ($n = 1; $n <= 6; $n++) {
$ch = 65+rand(26);
if (rand() > 0.5) {
$ch += 32;
}
$pw .= chr($ch);
}
Perl 重命名 - Larry Wall的文件名修复程序
#!/usr/bin/perl
# -w switch is off bc HERE docs cause erroneous messages to be displayed under Cygwin
#From the Perl Cookbook, Ch. 9.9
# rename - Larry's filename fixer
$help = <<EOF;
Usage: rename expr [files]
This script's first argument is Perl code that alters the filename (stored in \$_ ) to reflect how you want the file renamed. It can do this because it uses an eval to do the hard work. It also skips rename calls when the filename is untouched. This lets you simply use wildcards like rename EXPR * instead of making long lists of filenames.
Here are five examples of calling the rename program from your shell:
% rename 's/\.orig$//' *.orig
% rename 'tr/A-Z/a-z/ unless /^Make/' *
% rename '$_ .= ".bad"' *.f
% rename 'print "$_: "; s/foo/bar/ if <STDIN> =~ /^y/i' *
% find /tmp -name '*~' -print | rename 's/^(.+)~$/.#$1/'
The first shell command removes a trailing ".orig" from each filename.
The second converts uppercase to lowercase. Because a translation is used rather than the lc function, this conversion won't be locale-aware. To fix that, you'd have to write:
% rename 'use locale; $_ = lc($_) unless /^Make/' *
The third appends ".bad" to each Fortran file ending in ".f", something a lot of us have wanted to do for a long time.
The fourth prompts the user for the change. Each file's name is printed to standard output and a response is read from standard input. If the user types something starting with a "y" or "Y", any "foo" in the filename is changed to "bar".
The fifth uses find to locate files in /tmp that end with a tilde. It renames these so that instead of ending with a tilde, they start with a dot and a pound sign. In effect, this switches between two common conventions for backup files
EOF
$op = shift or die $help;
chomp(@ARGV = <STDIN>) unless @ARGV;
for (@ARGV) {
$was = $_;
eval $op;
die $@ if $@;
rename($was,$_) unless $was eq $_;
}
Perl 验证IPv4 IP地址是否有效
#!/usr/bin/perl
use strict;
use warnings;
print("What is the IP Address you would like to validate: ");
my $ipaddr = <STDIN>;
chomp($ipaddr);
if( $ipaddr =~ m/^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)$/ )
{
print("IP Address $ipaddr --> VALID FORMAT! \n");
if($1 <= 255 && $2 <= 255 && $3 <= 255 && $4 <= 255)
{
print("IP address: $1.$2.$3.$4 --> All octets within range\n");
}
else
{
print("One of the octets is out of range. All octets must contain a number between 0 and 255 \n");
}
}
else
{
print("IP Address $ipaddr --> NOT IN VALID FORMAT! \n");
}
Perl 将ALT属性插入到尚未具有ALT属性的IMG标记中
#/usr/local/bin/perl -w
use strict;
############################################################
# #
# #
# #
# NOAH SUSSMAN #
# #
# insert_alt #
# #
# Created 5/11/01 at 01:38 PM #
# #
# Insert ALT element into IMG tags that lack it. The alt #
# text inserted is identical to the contents of the <TITLE>#
# tag -- or not. #
# #
# #
############################################################
=item THIS NEEDS TO BE ADJUSTED SO IT WORKS WITH JSP
(02:35:50) VERSUSearth: I'll have to adjust my insert_alt script to take JSP into account next time
(02:36:35) mitiege: yep- I'm guessing you are looking for the first closing sign and inserting before that..
(02:36:47) mitiege: a simple fix would be to put the alt first in the img tag...
(02:37:06) VERSUSearth: yeah that's probably a good idea
=cut
$^I=".bk";
#undef $/; # read in whole file, not just one line
my $text = "" ; #Insert blank alt attribute
while (<>) {
#m{<title>(.*?)</title>}ix;
#my $text = $1; #Use the document title as the ALT text
unless (m{<img.*?alt=.*?>}ix){
s{(<img)(.*?)>}{$1$2 alt="$text">}gsix;
}
print "$_";
}
Perl 在简单的HTML库中显示此目录中的JPEG
#! /usr/bin/perl -w
use strict;
#****************************************************************
# To Do: display a thumbnail link to every image on every page *
#****************************************************************
####
my $start;
print "<html><head><title>Images In This Directory</title></head>\n";
####
print <<BEGINSCRIPT;
<script type="text/javascript">
var counter = -1;
var showstuff = new Array();
BEGINSCRIPT
####
print "showstuff=[";
####
while (<*\.jp*>) { #regex scans working directory and captures any filename with extension beginning "JP"
print "\"$_\","; #print each file name into the array
$start = $_;
}
####
print "];\n";
####
print <<STARTHTML;
function next () {
if (showstuff[counter] != "" && counter < showstuff.length-1) {
document.graphic.src=showstuff[++counter];
}
else {
counter = -1;
next();
}
}
function back () {
if (showstuff[counter] != "" && counter > 0) {
document.graphic.src=showstuff[--counter];
}
else {
counter = showstuff.length;
back();
}
}
</script><body>
<p style="text-align:center">
<img src="" alt="Click one of the links below to see a different image." name="graphic" width="900" />
<p style="text-align:center">
<a href="javascript:back();" style="font-size:30pt;font-weight:bold;"><-- BACK</a>
...
<a href="javascript:next();" style="font-size:30pt;font-weight:bold;">NEXT --></a>
</body></html>
<script>next();</script>
STARTHTML
Perl 创建新文件
# whatever arguments are given at the command line are
# taken to be the names for new text files,
# which are then created:
open OUT, ">$ARGV[0]" or die $!;
seek OUT,0,0 and print OUT "\0";
close OUT;
Perl 大写单词
sub wordcaps {
my $line = shift;
$line =~ s/\b(\w)/\U$1/g;
return $line;
}
Perl 提交带参数的POST查询
#! /usr/bin/perl -w
use strict;
use HTTP::Request::Common;
use LWP::UserAgent;
#The Perl Black Book, Holzner, p. 1247
=item how to call submit_query():
#Method 1.
my %example = (test1 => 'noah', test2 => 'sussman');
submit_query("http://suburbanangst.com/reg.php", %example);
#Method 2.
submit_query("http://suburbanangst.com/reg.php?test1=foo&test2=bar;");
=cut
sub submit_query {
my ($file, %query) = @_;
my $user_agent = LWP::UserAgent->new;
$user_agent->agent("MSIE/5.5 " . $user_agent->agent);
my $request = POST
#'http://suburbanangst.com/reg.php',
$file,
[%query];
my $response = $user_agent->request($request);
print $response->as_string;
}