Perl环境安装

在我们开始学习 Perl 语言前，我们需要先安装 Perl 的执行环境。

Perl 可以在以下平台下运行：

Unix (Solaris, Linux, FreeBSD, AIX, HP/UX, SunOS, IRIX etc.)
Win 9x/NT/2000/
WinCE
Macintosh (PPC, 68K)
Solaris (x86, SPARC)
OpenVMS
Alpha (7.2 and later)
Symbian
Debian GNU/kFreeBSD
MirOS BSD
等等...

很多系统平台上已经默认安装了 perl，我们可以通过以下命令来查看是否已安装：

$ perl -v

This is perl 5, version 18, subversion 2 (v5.18.2) built for darwin-thread-multi-2level
(with 2 registered patches, see perl -V for more detail)

Copyright 1987-2013, Larry Wall
……

如果输出以上信息说明已安装，如果还未安装，可以看接下来的安装指导。

安装Perl

我们可以在 Perl 的官网下载对应平台的安装包:https://www.perl.org/get.html

1.1 Unix 和 Linux 安装 Perl

Unix/Linux 系统上 Perl 安装步骤如下：

通过浏览器打开 http://www.perl.org/get.html
下载适用于 Unix/Linux 的源码包
下载 perl-5.x.y.tar.gz 文件后执行以下操作

$ wget https://www.cpan.org/src/5.0/perl-5.28.0.tar.gz
$ tar -xzf perl-5.x.y.tar.gz
$ cd perl-5.x.y
$ ./Configure -de
$ make
$ make test
$ make install

接下来我们如果 perl -v 命令查看是否安装成功。

安装成功后，Perl 的安装路径为 /usr/local/bin ，库安装在 /usr/local/lib/perlXX, XX 为版本号

1.2 Cpanm安装模块

Cpanm是所用过的安装perl模块最方便的方法

cpanm 其实只是一个可执行文件而已。将它下载到 bin 目录，然后添加执行权限就可以用了

1.2.1安装方法

$ wget http://xrl.us/cpanm -O /usr/bin/cpanm; chmod +x /usr/bin/cpanm

1.2.2 使用cpanm

参数名直接为模块名称即可。如:

$ cpanm CGI::Session
$ cpanm Template

注: 如果不是 root 权限，cpanm 也一样能用。它会将模块下载安装到用户的根目录(~)下

为了加快 cpanm 下载速度, 可以指定使用镜像. 并只从镜像下载. 如下:

$ cpanm --mirror http://mirrors.163.com/cpan --mirror-only CGI::Session

1.2.3 安装instmodsh检查模块是否安装

$ cpanm ExtUtils::MakeMaker
$ instmodsh #按小写L即可查看安装的模块

1.3 cpan安装模块

1.3.1 安装cpan

$ yum -y install perl-CPAN

1.3.2 使用

$ perl -MCPAN -e shell

第一次进入是需要进行配置的，按照提示操作即可

cpan[1]> install Net::SNMP     #install后面接模块名称即可 1.2

1.4 Perl模块基本安装

1.4.1 安装基础依赖

$ yum -y install  gcc gcc-c++ gd-devel openssl openssl-devel openssl-perl perl-CPAN

1.4.2 expat

tar –zxvf expat-2.0.1.tar.gz
cd /expat-2.0.1
./configure
make
make install

1.4.3 Sablot

tar –zxvf Sablot-1.0.3.tar.gz
cd /Sablot-1.0.3
./configure 
make 
make install

1.4.4 XML-Sablotron

tar –zxvf XML-Sablotron-1.01.tar.gz 
cd /XML-Sablotron-1.01 
perl Makefile.PL SABLOTLIBPATH=/usr/local/lib SABLOTINCPATH=/usr/local/include 
make 
make install 
ln -s /usr/local/lib/libsablot.so.0 /lib64/libsablot.so.0

输入

perl -e 'use XML::Sablotron;'

可检查安装是否成功

1.4.5 mage::Magick

1. 安装依赖库， JPEG和PNG，首先从如下地址下载安装文件

下载地址:http://sourceforge.net/projects/libpng/files/libpng16/1.6.17/libpng-1.6.17.tar.gz/download

下载地址:http://www.ijg.org/files/jpegsrc.v9.tar.gz

用 tar -zxvf分别解压文件

然后分别按如下步骤进行安装：

cd libpng-1.6.17
./configure
make check
make install

cd jpeg-9a
./configure
make libdir=/usr/lib64
make libdir=/usr/lib64 install

2.安装Image magick

下载地址为：http://www.imagemagick.org/download/ImageMagick.tar.gz

cd ImageMagick-6.9.1
 ./configure –with-perl
 make 
 make install

测试安装结果，输入

/usr/local/bin/convert logo: logo.gif
perl -e 'use Image::Magick;'

1.4.6 enc2xs

安装Encode::HanConvert模块会需要到这个enc2xs

下载地址：https://metacpan.org/pod/distribution/Encode/bin/enc2xs 找到Download下载即可

tar xf Encode-2.98.tar.gz
cd Encode-2.98/
perl Makefile.PL
make test
make install

1.4.7 Finance::Currency::Convert::XE

下载地址:https://metacpan.org/pod/Finance::Currency::Convert::XE

cd Finance-Currency-Convert-XE-0.25
perl Makefile.PL
make test
make install

1.4.8 SOAP::WSDL

下载地址: https://metacpan.org/pod/SOAP::WSDL

tar xf SOAP-WSDL-3.003.tar.gz
cd SOAP-WSDL-3.003/
perl Makefile.PL
make test
make install

1.4.9 libxml-enno

下载地址:https://metacpan.org/release/libxml-enno

tar xf libxml-enno-1.02.tar.gz
cd libxml-enno-1.02/
perl Makefile.PL
make test
make install

1.4.10 IO::Socket::SSL

$ cpanm  IO::Socket::SSL

1.4.11 mod_perl

$ yum -y install mod_perl

1.4.12 安装其他模块

输入

$ perl -MCPAN -e shell
install DBD::SQLite
install IO::Pty
install Test::Pod
install Locale::Object::Currency（很多yes）
install Locale::Currency::Format
install Locale::Object::Currency::Converter
install MIME::Lite(yes)
install Encode::HanConvert
install Date::Simple
install Time::Local
install MIME::Base64
install MIME::Parser
install Mail::POP3Client
install HTTP::Date
install Mail::Message
install MIME::Entity
install Email::MIME::Attachment::Stripper（yes)
install Mail::Message::Head::SpamGroup
install Data::Dump
install HTTP::Request::Common
install File::Copy  #需要perl5.28.0安装
install SOAP::Lite
install Image::Size
install IO::Handle
install LWP::Simple
install Time::Local
install String::Approx
install Lingua::Han::PinYi
install Encode::Guess
install File::Pat
install HTML::LinkExto
install Digest::MD5
install Geography::States
install Time::localtime #需要perl5.28.0安装
install URI::Escap
install Locale::Maketext
install XML::DO
install SOAP::Transport::HTTP
install SOAP::Transport::HTTP::CGI(手动安装SOAP-0.28,再装模块，按q，回车
install FCGI
install CGI::Fas
install Date::Manip(yes)
install Archive::Extract
install Encode::Detect::Detector
install Hash::Merge
install MIME::Base64::URLSaf
install Finance::Currency::Convert::Yahoo
install Math::Polygon
install Geo::Location::TimeZone
install Spreadsheet::WriteExcel
install Font::TTFMetrics
install GD::Image
install WWW::Mechanize
install JSON
install Net::SFTP::Foreign
install Crypt::OpenSSL::RSA  
install WWW::Mechanize::Plugin::FollowMetaRedirect(yes
install Google::Voice
install WWW::Google::DistanceMatrix
install Locale::SubCountry
install Geo::Coder::Google
install Weather::Google
install Geo::IP
install Data::Compare
install XML::Checker::Parser（需要先安装libxml-enno-1.02）
install IO::Lines
install SOAP::Packager::MIME(yes)
install IO::Socket::SSL

如果XML-Sablotron安装报错未定义的函数请直接将以下内容直接覆盖到Processor.h文件中，然后重新编译，make

/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*-
 * The contents of this file are subject to the Mozilla Public
 * License Version 1.1 (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.mozilla.org/MPL/
 * 
 * Software distributed under the License is distributed on an "AS
 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 * implied. See the License for the specific language governing
 * rights and limitations under the License.
 * 
 * The Original Code is the XML::Sablotron module.
 * 
 * The Initial Developer of the Original Code is Ginfer Alliance Ltd.
 * Portions created by Ginger Alliance are 
 * Copyright (C) 1999-2000 Ginger Alliance Ltd..  
 * All Rights Reserved.
 * 
 * Contributor(s): Nicolas Trebst, science+computing ag
 *                 n.trebst@science-computing.de
 * 
 * Alternatively, the contents of this file may be used under the
 * terms of the GNU General Public License Version 2 or later (the
 * "GPL"), in which case the provisions of the GPL are applicable 
 * instead of those above.  If you wish to allow use of your 
 * version of this file only under the terms of the GPL and not to
 * allow others to use your version of this file under the MPL,
 * indicate your decision by deleting the provisions above and
 * replace them with the notice and other provisions required by
 * the GPL.  If you do not delete the provisions above, a recipient
 * may use your version of this file under either the MPL or the
 * GPL.
 */

/*
 *
 *  ../Sablotron.xs includes this file
 *
 */ 



#include "Handler_stubs.h"

/**************************************************************
  message handler
**************************************************************/
MessageHandler mh_handler_vector = {
  MessageHandlerMakeCodeStub,
  MessageHandlerLogStub,
  MessageHandlerErrorStub
};

/*********************
 scheme handler
*********************/
SchemeHandler sh_handler_vector = {
  SchemeHandlerGetAllStub,
  SchemeHandlerFreeMemoryStub,
  SchemeHandlerOpenStub,
  SchemeHandlerGetStub,
  SchemeHandlerPutStub,
  SchemeHandlerCloseStub
};

/*********************
 SAX-like handler
*********************/
SAXHandler sax_handler_vector = {
    SAXHandlerStartDocumentStub,
    SAXHandlerStartElementStub,
    SAXHandlerEndElementStub,
    SAXHandlerStartNamespaceStub,
    SAXHandlerEndNamespaceStub,
    SAXHandlerCommentStub,
    SAXHandlerPIStub,
    SAXHandlerCharactersStub,
    SAXHandlerEndDocumentStub
};

/*********************
 miscellaneous handler
*********************/
MiscHandler xh_handler_vector = {
  MiscHandlerDocumentInfoStub
};



/**************************************************************
  message handler
**************************************************************/
MH_ERROR 
MessageHandlerMakeCodeStub(void *userData, void *processor, int severity, 
	unsigned short facility, 
	unsigned short code) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "MHMakeCode", 10, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSViv(severity)));
    XPUSHs(sv_2mortal(newSViv(facility)));
    XPUSHs(sv_2mortal(newSViv(code)));
    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    SPAGAIN;
	
    ret = POPi;

    PUTBACK;
    FREETMPS;
    LEAVE;
  } else {
    croak("MHMakeCode method missing");
  }
  return ret;
}


MH_ERROR 
MessageHandlerLogStub(void *userData, void *processor, MH_ERROR code, 
	MH_LEVEL level, char **fields) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  char **foo;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);;
  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "MHLog", 5, 0);

  if (gv) {
    dSP;
    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSViv(code)));
    XPUSHs(sv_2mortal(newSViv(level)));
    foo = fields;
    while (*foo) {
      XPUSHs(sv_2mortal(newSVpv(*foo, strlen(*foo))));
      foo++;
    }

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_VOID);

    FREETMPS;
    LEAVE;
  } else {
    croak("MHLog method missing");
  }
  return code;
}


MH_ERROR 
MessageHandlerErrorStub(void *userData, void *processor, MH_ERROR code, 
	MH_LEVEL level, char **fields) 
{
  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  char **foo;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);
  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "MHError", 7, 0);

  if (gv) {
    dSP;
    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSViv(code)));
    XPUSHs(sv_2mortal(newSViv(level)));
    foo = fields;
    while (*foo) {
      XPUSHs(sv_2mortal(newSVpv(*foo, strlen(*foo))));
      foo++;
    }

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    FREETMPS;
    LEAVE;
  } else {
    croak("MHError method missing");
  }
  return code;
}


/*********************
 scheme handler
*********************/
int SchemeHandlerGetAllStub(void *userData, void *processor,
    const char *scheme, const char *rest, 
    char **buffer, int *byteCount) {

  SV *wrapper;
  SV *processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;
  SV *value;
  unsigned int len;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "SHGetAll", 8, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSVpv((char*) scheme, strlen(scheme))));
    XPUSHs(sv_2mortal(newSVpv((char*) rest, strlen(rest))));

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    SPAGAIN;
	
    ret = 0; /* oops */
    value = POPs;
    if ( SvOK(value) ) {
      SvPV(value, len);
      *buffer = (char*) malloc(len + 1);
      strcpy(*buffer, SvPV(value, PL_na));
      *byteCount = len + 1;
    } else {
      *byteCount = -1;
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
  } else {
    *byteCount = -1;
  }
  return ret;
}

int SchemeHandlerFreeMemoryStub(void *userData, void *processor,
    char *buffer) {
  unsigned long ret = 0;
  if (buffer) {
    free(buffer);
  }
  return ret;
}

int SchemeHandlerOpenStub(void *userData, void *processor,
    const char *scheme, const char *rest, int *handle) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;
  SV *value;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "SHOpen", 6, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSVpv((char*) scheme, strlen(scheme))));
    XPUSHs(sv_2mortal(newSVpv((char*) rest, strlen(rest))));

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    SPAGAIN;
	
    value = POPs;
    if ( SvOK(value) ) {
      ret = 0;
      SvREFCNT_inc(value);
      *handle = (int) value;
    } else {
      ret = 100;
      *handle = 0;
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
  } else {
    croak("SHOpen method missing");
  }
  return ret;
}

int SchemeHandlerGetStub(void *userData, void *processor,
    int handle, char *buffer, int *byteCount) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;
  SV *value;
  unsigned int len;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "SHGet", 5, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs((SV*)handle);
    XPUSHs(sv_2mortal(newSViv(*byteCount)));
    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    SPAGAIN;
	
    value = POPs;
    if SvOK(value) {
      char *aux;
      aux = SvPV(value, len);
      *byteCount = len < *byteCount ? len : *byteCount;
      strncpy(buffer, aux, *byteCount);
    } else {
      *byteCount = 0;
    }

    ret = 0; /* oops */

    PUTBACK;
    FREETMPS;
    LEAVE;
  } else {
    croak("SHGet method missing");
  }
  return ret;
}

int SchemeHandlerPutStub(void *userData, void *processor,
    int handle, const char *buffer, int *byteCount) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;
  SV *value;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "SHPut", 5, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs((SV*) handle);
    XPUSHs(sv_2mortal(newSVpv((char*) buffer, *byteCount)));
    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), G_SCALAR);

    SPAGAIN;

    value = POPs;
    if (SvOK(value)) {
      ret = 0;
    } else {
      ret = 100;
    }

    PUTBACK;

    FREETMPS;
    LEAVE;
  } else {
    croak("SHPut method missing");
  }
  return ret;
}

int SchemeHandlerCloseStub(void *userData, void *processor,
    int handle) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;
  unsigned long ret = 0;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "SHClose", 7, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs((SV*) handle);

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), 0);

    SvREFCNT_dec((SV*) handle);
    ret = 0;

    FREETMPS;
    LEAVE;
  } else {
    croak("SHClose method missing");
  }
  return ret;
}


/*********************
 SAX-like handler
*********************/
void SAXHandlerStartDocumentStub(void* userData, void *processor)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerStartDocument"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXStartDocument", 16, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXStartDocument method missing");
    }
}

void SAXHandlerStartElementStub(void* userData, void *processor,
                                const char* name, const char** atts)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;
    char **att;

    /* printf("===> %s\n", "SAXHandlerStartElement"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXStartElement", 15, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) name, strlen(name))));
        att = (char**)atts;
        while (*att) {
            XPUSHs(sv_2mortal(newSVpv(*att, strlen(*att))));
            att++;
        }

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXStartElement method missing");
    }
}

void SAXHandlerEndElementStub(void* userData, void *processor,
                              const char* name)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerEndElement"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXEndElement", 13, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) name, strlen(name))));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXEndElement method missing");
    }
}

void SAXHandlerStartNamespaceStub(void* userData, void *processor,
                                  const char* prefix, const char* uri)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerStartNamespace"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXStartNamespace", 17, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) prefix, strlen(prefix))));
        XPUSHs(sv_2mortal(newSVpv((char*) uri, strlen(uri))));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXStartNamespace method missing");
    }
}

void SAXHandlerEndNamespaceStub(void* userData, void *processor,
                                const char* prefix)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerEndNamespaceStub"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXEndNamespace", 15, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) prefix, strlen(prefix))));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXEndNamespace method missing");
    }
}

void SAXHandlerCommentStub(void* userData, void *processor,
                           const char* contents)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerComment"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXComment", 10, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) contents, strlen(contents))));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXComment method missing");
    }
}

void SAXHandlerPIStub(void* userData, void *processor,
                      const char* target, const char* contents)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerPI"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXPI", 5, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) target, strlen(target))));
        XPUSHs(sv_2mortal(newSVpv((char*) contents, strlen(contents))));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXPI method missing");
    }
}

void SAXHandlerCharactersStub(void* userData, void *processor,
                              const char* contents, int length)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerCharacters"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXCharacters", 13, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        XPUSHs(sv_2mortal(newSVpv((char*) contents, length)));

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXCharacters method missing");
    }
}

void SAXHandlerEndDocumentStub(void* userData, void *processor)
{
    SV *wrapper;
    SV * processor_obj;
    HV *stash;
    GV *gv;

    /* printf("===> %s\n", "SAXHandlerEndDocument"); */

    wrapper = (SV*)userData;
    
    processor_obj = (SV*) SablotGetInstanceData(processor);
    stash = SvSTASH(SvRV(wrapper));
    gv = gv_fetchmeth(stash, "SAXEndDocument", 14, 0);
    
    if (gv) {
        dSP;
        ENTER;
        SAVETMPS;
        
        PUSHMARK(SP);  
        XPUSHs(wrapper);
        if (processor_obj) 
            XPUSHs(processor_obj);
        else
            XPUSHs(&PL_sv_undef);

        PUTBACK;
        
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
        
        FREETMPS;
        LEAVE;
    } else {
        croak("SAXEndDocument method missing");
    }
}


/*********************
 miscellaneous handler
*********************/
void
MiscHandlerDocumentInfoStub(void* userData, void *processor,
                        const char *contentType, 
                        const char *encoding) {

  SV *wrapper;
  SV * processor_obj;
  HV *stash;
  GV *gv;

  wrapper = (SV*)userData;

  processor_obj = (SV*) SablotGetInstanceData(processor);

  stash = SvSTASH(SvRV(wrapper));
  gv = gv_fetchmeth(stash, "XHDocumentInfo", 14, 0);

  if (gv) { 
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);  
    XPUSHs(wrapper);
    if (processor_obj) 
      XPUSHs(processor_obj);
    else
      XPUSHs(&PL_sv_undef);
    XPUSHs(sv_2mortal(newSVpv((char*) contentType, strlen(contentType))));
    XPUSHs(sv_2mortal(newSVpv((char*) encoding, strlen(encoding))));

    PUTBACK;

    perl_call_sv((SV*)GvCV(gv), 0);

    FREETMPS;
    LEAVE;
  } else {
    croak("XHDocumentInfo method missing");
  }
}

https://cnodejs.org/topic/573c7d60f610cbba1dc45274 #安装js

文章部分内容来自：http://www.runoob.com/perl/perl-environment.html

posted @ 2018-10-31 17:04 Belief° 阅读(5485) 评论(0) 收藏举报

刷新页面返回顶部