#!/usr/bin/perl -w
#
# MT tags cache  By Easun(路杨)
# http://easun.org
#
use strict;
use CGI;
# use CGI::Carp qw(fatalsToBrowser); #打开浏览器检错，不需要请删除之。
my $tagdir ='/path/to/yoursiteroot/blog/tag';  #TAG地址的绝对地址没有'/'
my $tagurl='http://yoursite/blog/tag/';  #TAG地址的网络地址，有'/'
my $search_url='http://yoursite/cgi-bin/mtos/mt-search.cgi';  # mt-search.cgi 的 url
### 说明，你还应该在 /path/to/yoursiteroot/blog/tag下建立一个包含 所有 tags 的文本
# 起名叫 tag_list.txt
##

my $q = CGI->new;
my $path_info =  $q->path_info;
     $path_info =~s{^/}{};
     $path_info =~s{/}{;}g;

my ($tag, $page,$r) = split ';', $path_info;

if ($tag eq '')
{
   print $q->redirect('http://yoursite/blog/tag/index.html'); # 这个页面是你建立的一个显示全部tag 的索引页
   exit(0);
}

print $q->header(-charset => 'utf-8');
$r = $page if ($page eq 'r');
$page  = 0 if ($page !~ /^[0-9]+$/);
$page = 1 if ($page  == 0);
undef $r if (!$r);

unless (check_tag($tag,$tagdir) )
{
  # print $q->header(-charset => 'utf-8');
  my $indexfile = $tagdir .'/index.html';
  if  (-s  $indexfile )
  {
     my $t = '没有找到标签(Tag)为'. $tag.'的文章' ;
     my $info = '

<style type="text/css">
#tag-err-box {padding:10px; background: #eee;  border:1px #baa solid; -webkit-border-radius: 8px; -moz-border-radius: 8px;  border-radius: 8px;  }
#tag-err-box h1{margin: 5px auto;  color:red;  font-size:20px; line-height: 1.5; }
</style>
<div id="tag-err-box"><h1>抱歉！ 本站没有找到 标签（Tag） 为 ['.$tag.'] 的文章，请点击以下 Tag 来搜素您需要的内容。</h1></div>';
 
  if (open my $fh, $indexfile) {
          local $/;
          while (<$fh>)  {
          s{<title>(.*?)</title>}{<title>$t</title>};
          s{<easun_tags_err_msg />}{$info};
          print;
          }
          close $fh;
        }

  }
  else{print 'no_tags' ;  }
  exit(0);
}

my $offset = ($page-1) *20 ;
# 真实获取地址，请注意 IncludeBlogs=2 ，换成你自己的 blogID.
my $url=$search_url.'?tag=' .&encode_url($tag). '&IncludeBlogs=2&limit=20&offset='.$offset;
my $filename= &getCacheFileName($tag).&getCacheFileType($tag,$page) ;
my $file= $tagdir .'/'. $filename;

# 如果 r=1，忽略cahe,重新生成生成
# 如果 没有 cache 文件，生成
# 如果 tag_list.txt 文件新于cache，则表示后台更新过，我们重新生成一次
#
if ($r ne 'r') {    
           unless (-s  $file ) { $r = 'r' ;}
           elsif  ( (-M  $file) >  (-M  $tagdir .'/tag_list.txt' )) { $r = 'r' ;}  
           else {;}
}
    
if ($r eq 'r') { &print_url_co_new($url,$file) ;}
else {
        if (open my $fh, $file) {
           while (<$fh>)  { print;}
           close $fh;
        }
        else {print 'no_tags_error' ; }
    }
    
   
exit(0);

sub getCacheFileName {
    my($str) = @_;
    $str =~ s!([^a-zA-Z0-9_.~-])!lc sprintf "%02x", ord($1)!eg;
    $str;
}

sub encode_url {
    my($str) = @_;
    $str =~ s!([^a-zA-Z0-9_.~-])!uc sprintf "%%%02x", ord($1)!eg;
    $str;
}

sub cachefile
{
    my ($file,$result) =@_;
    return 0 unless $$result;
    if (open(my $fh, ">$file")) {
       print $fh $$result;
       close $fh;
       return 1;
       }
    else
       {
          return 0;
       }
}

sub print_url_co_new
{
    my ($url,$file)= @_;

    require LWP::UserAgent;
    require HTTP::Request;
    my $ua = LWP::UserAgent->new;
    $ua->max_size(undef) if $ua->can('max_size');
    my $req = new HTTP::Request(GET => $url);
    my $resp = $ua->request($req);
    return unless $resp->is_success();
    my $result = $resp->content();
    print $result;

    &cachefile($file, \$result) ;
}

sub getCacheFileType
{
    my ($name,$page)= @_;
    $page  = 1 if ($page !~ /^[0-9]+$/);
    $page = 1 if ($page  == 0);
    my $str = ($page == 1) ? '.html' : '_' . $page . '.html';
    $str;
}


sub check_tag
{
    my ($name,$tagdir)= @_;
    my $all_tag_text =  $tagdir .'/tag_list.txt';
    return 1 unless (-s  $all_tag_text);
    if (open my $fh, $all_tag_text) {
        my @list =split ',', <$fh>;
        close $fh;
        foreach (@list)
        {
          if  ( &encode_url($name) eq $_)   { return 1 ; }
         }
   }
    return 0;
}

1;

后台 tag_list.txt 的模板更简单：

<mt:Tags glue=","><$mt:TagName encode_url="1"$></mt:Tags>