分类目录归档：PERL

获取XML标签内容

发表评论

获取XML标签内容：
# cat sample.xml

<?xml version="1.0"?> 
<catalog> 
   <book id="bk101"> 
      <author>Gambardella, Matthew</author> 
      <title>XML Developer's Guide</title> 
      <genre>Computer</genre> 
      <price>44.95</price> 
      <publish_date>2000-10-01</publish_date> 
      <description>An in-depth look at creating applications with XML.</description> 
   </book> 
   <book id="bk102"> 
      <author>Ralls, Kim</author> 
      <title>Midnight Rain</title> 
      <genre>Fantasy</genre> 
      <price>5.95</price> 
      <publish_date>2000-12-16</publish_date> 
      <description>A former architect battles corporate zombies,  
      an evil sorceress, and her own childhood to become queen  
      of the world.</description> 
   </book> 
   <book id="bk103"> 
      <author>Corets, Eva</author> 
      <title>Maeve Ascendant</title> 
      <genre>Fantasy</genre> 
      <price>5.95</price> 
      <publish_date>2000-11-17</publish_date> 
      <description>After the collapse of a nanotechnology  
      society in England, the young survivors lay the  
      foundation for a new society.</description> 
   </book> 
   <book id="bk104"> 
      <author>Corets, Eva</author> 
      <title>Oberon's Legacy</title> 
      <genre>Fantasy</genre> 
      <price>5.95</price> 
      <publish_date>2001-03-10</publish_date> 
      <description>In post-apocalypse England, the mysterious  
      agent known only as Oberon helps to create a new life  
      for the inhabitants of London. Sequel to Maeve  
      Ascendant.</description> 
   </book> 
   <book id="bk105"> 
      <author>Corets, Eva</author> 
      <title>The Sundered Grail</title> 
      <genre>Fantasy</genre> 
      <price>5.95</price> 
      <publish_date>2001-09-10</publish_date> 
      <description>The two daughters of Maeve, half-sisters,  
      battle one another for control of England. Sequel to  
      Oberon's Legacy.</description> 
   </book> 
</catalog>

You want to pick up the stuff between the “<description>, </description>” tags.

The first occurrence is on a single line. The rest of them span multiple lines and you want the newlines to be preserved. I shall assume that you want the whitespaces to be preserved as well.

Here’s the script –

$
$ perl -lne 'BEGIN{undef $/} while (/<description>(.*?)<\/description>/sg){print $1}' sample.xml
An in-depth look at creating applications with XML.
A former architect battles corporate zombies,
      an evil sorceress, and her own childhood to become queen
      of the world.
After the collapse of a nanotechnology
      society in England, the young survivors lay the
      foundation for a new society.
In post-apocalypse England, the mysterious
      agent known only as Oberon helps to create a new life
      for the inhabitants of London. Sequel to Maeve
      Ascendant.
The two daughters of Maeve, half-sisters,
      battle one another for control of England. Sequel to
      Oberon's Legacy.
$
$

In case you want the newlines preserved, but want to remove the whitespace at the beginning, then –

$
$ perl -lne 'BEGIN{undef $/} while (/<description>(.*?)<\/description>/sg){($x = $1) =~ s/\n\s*/\n/g; print $x}' sample.xml
An in-depth look at creating applications with XML.
A former architect battles corporate zombies,
an evil sorceress, and her own childhood to become queen
of the world.
After the collapse of a nanotechnology
society in England, the young survivors lay the
foundation for a new society.
In post-apocalypse England, the mysterious
agent known only as Oberon helps to create a new life
for the inhabitants of London. Sequel to Maeve
Ascendant.
The two daughters of Maeve, half-sisters,
battle one another for control of England. Sequel to
Oberon's Legacy.
$
$

And in case you want to neither the newline nor the whitespace i.e. each chunk between “<description>” tags on a single line, then –

$
$ perl -lne 'BEGIN{undef $/} while (/<description>(.*?)<\/description>/sg){($x = $1) =~ s/\n\s*//g; print $x}' sample.xml
An in-depth look at creating applications with XML.
A former architect battles corporate zombies, an evil sorceress, and her own childhood to become queen of the world.
After the collapse of a nanotechnology society in England, the young survivors lay the foundation for a new society.
In post-apocalypse England, the mysterious agent known only as Oberon helps to create a new life for the inhabitants of London. Sequel to Maeve Ascendant.
The two daughters of Maeve, half-sisters, battle one another for control of England. Sequel to Oberon's Legacy.
$
$

如何用Net::SMTP发送邮件

发表评论

如下代码为用ESMTP来发送邮件。

#!/usr/bin/perl
use Net::SMTP;
my $mailhost = "smtp.domain.com"; # the smtp host
my $mailfrom = 'user@domain.com'; # your email address
my @mailto = ('user@domain.com', 'user@domain.com'); # the recipient list
my $subject = "此为标题";
my $text = "此为正文\n第二行位于此。";
$smtp = Net::SMTP->new($mailhost, Hello => 'localhost', Timeout => 120, Debug => 1);
# anth login, type your user name and password here
$smtp->auth('user','pass');
foreach my $mailto (@mailto) {
	# Send the From and Recipient for the mail servers that require it
	$smtp->mail($mailfrom);
	$smtp->to($mailto);
	# Start the mail
	$smtp->data();
	# Send the header
	$smtp->datasend("To: $mailto\n");
	$smtp->datasend("From: $mailfrom\n");
	$smtp->datasend("Subject: $subject\n");
	$smtp->datasend("\n");
	# Send the message
	$smtp->datasend("$text\n\n");
	# Send the termination string
	$smtp->dataend();
}
$smtp->quit;

TroubleShooting/Code Analysis

  • 为什么要 $stmp->auth(‘user’,’pass’);
    大部分SMTP服务器为了防止 spam /垃圾邮件，就需要用户验证身份。
    此方法需要另外安装模块：Authen::SASL, 此模块可能系统不自带。
    如果系统为虚拟主机，而此模块无法安装，可使用Socket模块进行最直接的操作。详细的代码可以参考脚本LeoBBS或书籍《Perl网络编程》。
  • Debug => 1
    此段代码用于测试之用，所以开启了Debug，一般测试一次完毕，正式使用的话会关闭它。
  • 需要注意的是发信人和收信人的地址要用单引号，或者用”fayland\@gmail.com”。如果是个变量，需要用正则先将其转换。 
    $mailto =~ s/\@/\\\@/;
  • 我想发送附件，该如何做？
    参考《Perl网络编程》。

邮件发送过程的简单介绍

SMTP协议由文档rfc821定义。
在rfc821协议中定义了两个角色，即发送者（用S表示，指发送邮件的程序）和接收者（用R表示，指SMTP服务器）。

  1. 在 S 和 R 通过套接连接后，S应当先向R表明身份，此过程用helo命令完成，helo后连接发送者的域名（可用localhost）。而R的回答是一个表示连接成功的状态码和服务器身份等。例如： 
    S: helo 1313s.com
R: 220 server.com Simple Mail Transfer Service Ready

    在rfc821定义的状态码中，通常以2或3开头的表示成功，以4或5开头的表示传输过程出现了问题。
    如果是需要服务器身份验证的话，还用发送AUTH LOGIN。

  2. 发送头文件。 
    S: MAIL FROM: 
R: 250 OK
S: RCPT TO: 
R:

    这里的recipient的地址如果是在SMTP同一服务器上且服务器找不到此地址，就会回答”550 No such user here”。

  3. 发送正文。以DATA开始。以两个换行结束。 
    S: DATA
R: 354 Start mail input; end with (两个换行)
S: To: recipient@whereau.com
S: From: someone@somewhere.com
S: subject: title
S: ...
S: text
S: etc.
S:
S:
R: 250 OK
  4. 退出连接。 
    S: QUIT
R: 221 server.com Service closing transmission channel

以上就是简易的连接过程。当开启Net::SMTP的debug的时候，就会输出类似于此连接过程的东西。

继续阅读 →

perl–模块安装方法和常用模块

发表评论

CPAN（Comprehensive　Perl　Archive　Network）是internet上Perl模块最大的集散地，包含了现今公布的几乎所有的perl模块。网址：http://www.cpan.org/

http://search.cpan.org/，可以查找任何一个模块并提供下载

Linux/Unix—perl模块的安装方法

Linux/Unix下安装Perl模块有两种方法：手工安装和自动安装。第一种方法是从CPAN上下载您需要的模块，手工编译、安装。第二种方法是联上internet，使用一个叫做CPAN的模块自动完成下载、编译、安装的全过程。 继续阅读 →

How to pretty-print my.cnf with a one-liner

发表评论

shell：

    awk -F= '! /(^#|^$)/ { if ($2 != "") printf "%-34s = %s\n", $1,$2; else printf "%s\n", $1 }' /etc/my.cnf  
    awk '! /(^#|^$)/ {printf “%-34s %s %s\n”, $1, $2, $3}' /etc/my.cnf

Perl：

    perl -ne 'm/^([^#][^\s=]+)\s*(=.*|)/ && printf("%-35s%s\n", $1, $2)' /etc/my.cnf

kill long running queries

发表评论

Kill long running queries 

#!/usr/bin/perl
# spe - 10/2006

use DBI;
use MIME::Lite;

my $user = "root";
my $password = "password";
my $emailalertfrom = "alert@foo.com";
my $emailalertto = "support@foo.com";
my $mysqladmin = "/usr/bin/mysqladmin";
my $sql = "SHOW FULL PROCESSLIST";
my $killedAQuery = 0;
my $dbhost=`/bin/hostname`;

while (1) {
    $db_handle = 0;
    while ($db_handle == 0) {
        $db_handle = DBI->connect("dbi:mysql:database=mysql;host=127.0.0.1:port=3306;user=".$user.";password=".$password);
        if ($db_handle == 0) {
            sleep(1);
        }
    }

    $statement = $db_handle->prepare($sql)
        or die "Couldn't prepare query '$sql': $DBI::errstr\n";

    $statement->execute()
        or die "Couldn't execute query '$sql': $DBI::errstr\n";
    while (($row_ref = $statement->fetchrow_hashref()) && ($killedAQuery == 0))
    {
        if ($row_ref->{Command} eq "Query") {
            if ($row_ref->{Time} >= 10) {
                @args = ($mysqladmin, "-u".$user, "-p".$password, "kill", $row_ref->{Id});
                $returnCode = system(@args);
                $emailMessage = "A slow query as been detected (more than $row_ref->{Time} seconds). SQLKiller will try to kill this request.\nThe query is:\n$row_ref->{Info}\n\n";
                if ($returnCode != 0) {
                    $emailMessage .= "Result: The SQL request cannot be killed. This SQL request is probably a fake slow query due to an another SQL request. The problematic request is the first killed successfully\n";
                }
                else {
                    $emailMessage .= "Result: The SQL request has been killed successfully\n";
                }
                my $msg = new MIME::Lite 
                    From    =>$emailalertfrom, 
                    To      =>$emailalertto,          
                    Subject =>'[ SQLKILLER ] A query has been killed on '.$dbhost,
                    Type    =>'TEXT',   
                    Data    =>$emailMessage;
                $msg -> send;
                $killedAQuery = 1;
            }
        }
    }
    $statement->finish();
    $db_handle->disconnect();
    if ($killedAQuery == 0) {
        sleep(5);
    }
    else {
        $killedAQuery = 0;
        #sleep(1);
    }
}