擁抱自由，使用 linux ！

############################################################################
#                                                              parsencl.pl   -  description                                                          #
#                                                               -------------------                                                           #
#                                        copyright            : (C) 2000 by Yu-Chin Tsai                                                      #
#                                                email            : tlinux.tsai@gmail.com                                                          #
############################################################################
############################################################################
#                                                                                                                                                                             #
#   This program is free software; you can redistribute it and#or modify                                       #
#   it under the terms of the GNU General Public License as published by                                       #
#   the Free Software Foundation; either version 2 of the License, or                                              #
#   (at your option) any later version.                                                                                                        #
#                                                                                                                                                                            #
#############################################################################
 
#!/bin/perl -s
use strict;
use Encode;
use LWP;
 
#save as file
open(REC,">ncl.htm");
 
for(my $i=0;$i<100;$i++){
    my $CN=101;  #要查詢的索書號
    $CN=$CN+$i;
    $CN = sprintf "%03d",$CN;
    #取得國x圖x館資料
    my $browser = LWP::UserAgent->new;
    my $url = 'http://xxxx';  #不方便透露
    my $response = $browser->post( $url,
    [
    'CN'=>$CN,            #索書號(結尾要加',')
    'BR'=>'BS',           #典藏地
    'PAGELINE'=>'50',     #每頁資料筆數
    'routine'=>'holding'  #必備(最後一個不必加 ',' )
    ]
    );
    #以上請參考http://lib.ncl.edu.tw/web/cross.htm 自行新增檢索欄位
    warn $CN." ".$response->status_line;
 
    #轉big5 to UTF8
    my $html = encode("utf8", decode("big5", $response->content));
 
    #拿掉垃圾
    $html =~ s/&nbsp\;//ig;
    #print "Source html $html \n\n";
 
    #分析國圖資料html->cvs
    my @table = $html =~ /<table((?:(?!<table).)*)\/table>/igsx; #這邊是重點
    if($#table == 0){
        print REC "$CN no data\n";
        warn "no data\n$html\n\n";
    }
 
    #圖書資料在$table[2]
    my @tr = $table[2] =~ /<tr((?:(?!<tr>).)*)\/tr>/igsx;
    shift(@tr);
    foreach(@tr){
        $_ =~ s/<//ig;
        $_ =~ s/>//ig;
        $_ =~ s/align=left//ig;
        my @td = $_ =~ /td((?:(?!td).)*)\/td/igsx;
        $td[3] =~ s/\s+//ig;
        $td[4] =~ s/\s+//ig;
        $td[5] =~ s/\s+//ig;
        $td[6] =~ s/\s\s+//ig;
        warn "\"$CN\",\"$td[3]\",\"$td[4]\",\"$td[5]\",\"$td[6]\"\n";
        print REC "\"$CN\",\"$td[3]\",\"$td[4]\",\"$td[5]\",\"$td[6]\"\n";
    }
    sleep 5;
}
 
close REC;

h2xs -n module_name

cd module_name
Changes  fallback/  lib/  Makefile.PL  MANIFEST  ppport.h  README  t/  module_name.xs

# 你的 module 的名子, 到 "1;" 為止之間都是程式碼
package module_name;
 
# 如果你的程式有需要 use, 一起加在這邊吧
use 5.008008;
use strict;
use warnings;
use Carp;
 
require Exporter;
use AutoLoader;
 
our @ISA = qw(Exporter);
 
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
 
# This allows declaration       use module_name ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
 
) ] );
 
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
#在這邊輸入你要給別人用的 function name
our @EXPORT = qw(
  hello
);
 
# 版本資訊，make dist 會用到
our $VERSION = '0.01';
 
sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.
 
    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&module_name::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
        no strict 'refs';
        # Fixed between 5.005_53 and 5.005_61
#XXX    if ($] >= 5.00561) {
#XXX        *$AUTOLOAD = sub () { $val };
#XXX    }
#XXX    else {
            *$AUTOLOAD = sub { $val };
#XXX    }
    }
    goto &$AUTOLOAD;
}
 
require XSLoader;
XSLoader::load('module_name', $VERSION);
 
# Preloaded methods go here.
 
# 這邊撰寫你的程式碼
 
sub hello{
    print "hello worldn";
}
 
# Autoload methods go after =cut, and are processed by the autosplit program.
 
# 1; 表示 module 程式 結束, 從最一開始的 "package name" 到此 " 1; " 之間就是你的主要程式碼
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
 
# 開始說明 從 head 到 cut 都是說明, 依照其規則可使用許多tool將說明轉成純文字或是html, 後續會介紹
=head1 NAME
 
# 簡單說明用途
module_name - Perl extension for blah blah blah
 
=head1 SYNOPSIS
 
# 說明如何使用
  use module_name;
  module_name::hello();
  blah blah blah
 
=head1 DESCRIPTION
 
# 更多詳細說明
Stub documentation for module_name, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
 
Blah blah blah.
 
=head2 EXPORT
 
None by default.
 
=head1 SEE ALSO
 
# 參考資訊，可供參考其他相關的 module
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
 
If you have a mailing list set up for your module, mention it here.
 
If you have a web site set up for your module, mention it here.
 
=head1 AUTHOR
 
# 作者資訊
Yu-Chin Tsai, E<lt>thomas@E<gt>
 
=head1 COPYRIGHT AND LICENSE
 
# 版權資訊
Copyright (C) 2007 by Yu-Chin Tsai
 
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
 
# 結束說明 從 head 到 cut 都是說明
=cut
</gt></lt>