lib/plugins/33distinct

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # keitairc/lib/plugins/33distinct
   3 # based on 'Add link to google maps japan on address-like texts'
   4 # by twk, from http://nonn-et-twk.net/twk/node/51
   5 #
   6 # $Id: 33distinct,v 1.1 2008-08-03 02:36:48 morimoto Exp $
   7 # $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/plugins/33distinct,v $
   8
   9 # The line number (1 incremented) and filename below must be
  10 # actual. see perlsyn.
  11 # line 12 "keitairc/lib/plugins/32address"
  12
  13 use Encode;
  14 use utf8;
  15
  16 my $tokyo_special_wards = '(?:千代田区|中央区|港区|新宿区|文京区|台東区|墨田区|江東区|品川区|目黒区|大田区|世田谷区|渋谷区|中野区|杉並区|豊島区|北区|荒川区|板橋区|練馬区|足立区|葛飾区|江戸川区)';
  17 my $tokyo_cities = '(?:昭島市|あきる野市|稲城市|青梅市|清瀬市|国立市|小金井市|国分寺市|小平市|狛江市|立川市|多摩市|調布市|西東京市|八王子市|羽村市|東久留米市|東村山市|東大和市|日野市|府中市|福生市|町田市|三鷹市|武蔵野市|武蔵村山市)';
  18
  19 my $NO_WHITESPACE_ex = q/[^\s　:：()\[\]［］「」（）、。]/;
  20 my $SHICHOSON_ex = '(?:' . $tokyo_special_wards . '|' . $tokyo_cities . ')';
  21 my $AZA_ex = $NO_WHITESPACE_ex . '{1,20}';
  22 my $BANCHI_ex = q/[\d０-９]/ . '{1,8}'; # 一二三四五六七八九十東西南北無ABC
  23 my $BUILDING1_re = q/^[^\d０-９]+[\d０-９]+(?:(?:[-―－ー]|丁目|番地?|号)[\d０-９]+)+/;
  24 my $BUILDING2_re = q/^(.*(?:丁目|番地?|号))[^地\d０-９]+(?:ビル|$)/;
  25
  26 my $re = {
  27         general =>
  28                 '(?:' . $SHICHOSON_ex . ')' . '[ \t　]*' .
  29                 '(?:' . $AZA_ex . '[ \t　]*' .
  30                   '(?:' . $BANCHI_ex . '(?:丁目|番地?|号)?[-―－ー]?)' . '{1,4}' .
  31                 ')',
  32                 building1 => $BUILDING1_re,
  33                 building2 => $BUILDING2_re,
  34 };
  35
  36 $plugin = {
  37         name => 'distinct',
  38         message_replace_regexp => '(' . $re->{general} . ')',
  39
  40         message_replace_imprementation => sub {
  41                 my ($session_id, $src) = @_;
  42                 my $s = $src;
  43                 $s =~ s/.*($re->{general}).*/$1/;
  44                 # remove building names since google maps rarely recognize them
  45                 $s =~ s/($re->{building1}).*/$1/;
  46                 $s =~ s/$re->{building2}.*/$1/;
  47                 return sprintf('<a href="%s%s/address/%s">%s</a>',
  48                                $::cf->web_root(), $session_id,
  49                                URI::Escape::uri_escape_utf8($s), $src);
  50         },
  51 };
  52
  53 1;