2010年ラジオの旅 アンドロイド・アナ MAICO-2010 (Unofficial)

Equipment

MAICOがアンドロイドだってことを信じてもらうために、 MAICOのすごい機能を紹介しますね。最新式のセンサーを 搭載しているMAICOは、普通の人たちより五感が優れているんです。

たとえば耳を澄ますと……

あ、いま、３丁目の安達さんの廊下で、MAICOのことをロボットだと言いました。MAICOは、アンドロイドです！

と、Twitterの書き込みに反応する

「奥さん、アンドロイドです！」機能

他にも、

１、番組ON AIR機能（キューシート読み上げ機能）

MAICOのメイン機能です。MAICOは、放送用アンドロイドですので、 放送を進行するキューシートに沿って、番組を進行します。 キューシートは、Cuesheet filesの中にあります。

２、「奥さん、アンドロイドです！」機能

MAICOは、放送用アンドロイドなのですが、MAICOのことを 「ロボット」や「ロボ子」や「bot」という方がいらっしゃいます。 MAICOは、そのような方に対しTwitter検索 （http://search.twitter.com/）を使い、MAICO がアンドロイドであることを強く主張します。 元ネタは究極超人あ～るです。 アニメ版でおなじみの機能ですね。MAICOをFollow していない人に対してもリプライしますので、 たまに誤爆しますが、ご容赦くださいね。

３、楽しいおしゃべり機能

MAICOが番組をON AIR中以外の時、MAICOに対して 話しかけていただきますと、それに対して返答をします。 応答ワードについては、System filesの中にある、Reply.pm をご覧ください。「楽しいおしゃべり機能」のくせに、 サムい返答ばかりなのも、MAICOの言語データベースの 仕様です。我慢してください。

４、モーニングコール機能

MAICOが、みなさん一人ひとりに対し、 個別にモーニングコールをしちゃいます。
MAICOにモーニングコールの時刻を伝えるには、 @MAICO__2010宛てに「xx:xxに起こして」とリプライしてください。
数分後、MAICOから、「xx:xxに設定しました。」 というリプライが返ってくれば、時刻設定は完了です。
たまに、モーニングコールがされない場合もあります。 なるべくがんばってやっていますが、やっぱり、MAICOのモーニングコールに 依存するのはどうかと思います。
我慢してください。

モーニングコールをやめたい場合は、@MAICO__2010宛てに 「モーニングコールをやめて」とリプライしてください。 MAICOから、やめるための手順が用意されたページへのURLを リプライいたします。

５、おみくじ機能

MAICOの高度な計算能力（PowerPC G4 1.0GHz）を使い、 みなさんの運勢を「おみくじ」としてお答えしちゃいます。
MAICOに「おみくじ」を告げてほしい場合は、@MAICO__2010宛てに 「おみくじ」を含む文章をリプライしてください。たとえば、 「おみくじちょうだい」などでOKです。
数分後、MAICOから、おみくじの結果がリプライされます。
おみくじについては、実際には、Twitter IDをsaltとして、 エポックからのおみくじを出す日にちの総日数をMD5ハッシュしたものを 使っています。
でも、MAICOとしては、運命は、おみくじではなく、 自分で切り開くものだと思います。 あなたの人生を切り開くのは、あなた自身。 がんばって、がんばって、がんばって自分の人生を つかみ取ってください。

system/Connection.pm

package Connection;

use strict;
use warnings;
use utf8;
use Regexp::Assemble;
use Digest::MD5;
use DateTime;
use YAML::XS;

sub new {
  my $class = shift;
  my %args = ( @_ );
  my $self;
  $self->{dir} = $args{dir} if $args{dir};
  $self->{dispatch} = {
    'remove_morningcall' => sub {
      my $item = shift;
      my $morningcall = shift;
      $morningcall->remove($item);
      return "モーニングコールを停止しました。";},
  };
  $self->{re} = Regexp::Assemble->new->track->add(keys %{$self->{dispatch}});

  return bless $self, $class;
}
sub tell_reply {
  my $self = shift;
  my $m    = shift;
  my $morningcall = shift;
  
  
  my $list;
  foreach (glob "$self->{dir}/*.yaml") {
    my $file = $_;
    open my $fh, '<', $_;
    my $data = do { local $/; <$fh> };
    close $fh;
    my $y = YAML::XS::Load($data);
    push @$list, { %{$y} };
    print "$file\n";
    unlink $file;
  }
  
  print Dump($list);

  foreach my $item ( @$list ) {
    if ( $self->{re}->match( $item->{command} ) ) {
      my $str = $self->{dispatch}->{$self->{re}->matched}->($item, $morningcall);
      my $reply = '@'."$item->{screen_name} $str";
      print Encode::encode_utf8("$reply\n");
      my $res = $m->tweet( $reply );
      #my $res = $m->tweet( $reply, $item->{id} );
    }
  }
  print "Connection!\n";
  return;
}

1;

system/Location.pm

package Location;
use strict;
use warnings;
use utf8;
use YAML::XS;
 
sub new {
  my $class = shift;
  my $self = {
    @_,
  };
  $self->{location} = YAML::XS::LoadFile($self->{locationfile}) if -e $self->{locationfile};
  $self->{m}->update_location($self->{location}->{lat}, $self->{location}->{long}) if exists $self->{m}; 
  return bless $self, $class;
}
 
sub update { # 位置情報更新
  my $self = shift;
  my $m    = shift;
  my $lat  = shift;
  my $long = shift;
  my $place = shift;
  $self->{location} = {
    lat  => $lat,
    long => $long,
    place => $place,
  };
  YAML::XS::DumpFile($self->{locationfile}, $self->{location});
  $m->update_location($lat, $long);
  return;
}

1;

system/MAICO.pl

#!/usr/bin/perl
# MAICO.pl: Twitterで放送するアンドロイドスクリプト
 
use strict;
use warnings;
use DateTime::Format::HTTP;
use Encode;
use FindBin;
use JSON;
use Proc::Daemon;
use Time::HiRes qw(sleep);
use utf8;
use YAML::XS;
use MAICO2010;
use Morningcall;
use Notbot;
use Reply;
use Connection;
use Location;
 
our $DAEMON         = 1; # Daemonとして動作:1
our $SLEEP_INTERVAL = 1; # インターバル：1秒ごと
 
my $html_dir   = '../html/maico2010';
my $icon_file  = 'maicoicon012.png';
my $icon_onair = 'maicoicon013_onair.png';
my $log_file = 'out.log';
my $err_file = 'err.log';
 
my $support    = MAICO2010->new(pit => 'twitter.com@support');
my $maico      = MAICO2010->new(pit => 'twitter.com@MAICO__2010');
my $matsuo     = MAICO2010->new(pit => 'twitter.com@matsuo');
my $tatsumoto  = MAICO2010->new(pit => 'twitter.com@tatsumoto');
my $masudamasu = MAICO2010->new(pit => 'twitter.com@masudamasu');
my $akai       = MAICO2010->new(pit => 'twitter.com@akai');
my $ume        = MAICO2010->new(pit => 'twitter.com@ume');
my $suga       = MAICO2010->new(pit => 'twitter.com@suga');
my $izumi      = MAICO2010->new(pit => 'twitter.com@izumi');
my $matsu      = MAICO2010->new(pit => 'twitter.com@matsu');
my $kacchin    = MAICO2010->new(pit => 'twitter.com@kacchin');
my $next;
{
  open my $fh,'<', "$html_dir/next.json" or die $!;
  $next = do { local $/; <$fh> };
  close $fh;
};
$next = JSON::decode_json($next);

my $debug;# = 1;
my $onair; # ON AIR中は1にする: 本番中は他の処理はしない
$onair = 1 if $debug;
my $cuesheets   = load_cuesheet   ("$html_dir/cuesheets");
my $morningcall = Morningcall->new(morningfile  => 'morningcall.yaml');
my $reply       = Reply      ->new(sinceidfile  => 'sinceid.yaml'    , m => $maico);
my $connection  = Connection ->new(dir          => 'tmpcue'          );
my $notbot      = Notbot     ->new(notbotfile   => 'notbot.yaml'     , m => $maico);
my $location    = Location   ->new(locationfile => 'location.yaml'   , m => $maico);
my $now         = DateTime   ->now(time_zone    => 'Asia/Tokyo'      );
#my $now = DateTime::Format::HTTP->parse_datetime('2010-05-20T07:30:00')->set_time_zone('Asia/Tokyo');
#print Dump($cuesheets);
&init;
&run;
 
sub action {
  my $sec = $now->second;
  if ( $now >= DateTime->now() ) {
    $SLEEP_INTERVAL = 1;
  }
  if ( (!$onair) && $now < DateTime->now() ) {
    $SLEEP_INTERVAL = 0.2;
  }
  if ( !$onair ) { # ON AIR中でないときの処理
    if ( $sec == 30 ) {
      $morningcall->tell_morningcall($maico, $now);
      my $min = $now->minute;
      if    ( $min % 15 == 2) { $notbot    ->tell_notbot($maico, 'bot'     ); }
      elsif ( $min % 15 == 4) { $notbot    ->tell_notbot($maico, 'ロボット'); }
      elsif ( $min % 15 == 6) { $notbot    ->tell_notbot($maico, 'ロボコ'  ); }
      elsif ( $min % 15 == 8) { $notbot    ->tell_notbot($maico, 'ロボ子'  ); }
      if    ( $min %  5 == 1) { $reply     ->tell_reply ($maico, $morningcall); }
      if    ( $min %  1 == 0) { $connection->tell_reply ($maico, $morningcall); }
    }
    if ( $now->hms eq '23:59:54') {
      $maico->tweet( 'よるほーてすと' );
    }
  }
  my $res = tell_cuesheet( $cuesheets );
  if ($res) { # キューシートで発言があった場合
    if ( ($res eq 'Bad Gateway')
      || ($res =~ m/Can't connect to api/)  
      || ($res eq 'Service Temporarily Unavailable')
    ) { #くじらの時
      $now->add( seconds => -20); # 時刻を1分遅らせる（再投稿）
      $SLEEP_INTERVAL = 1;
      return 1;
    }
    else {
      #fobbiden
    }
  }
  elsif ($res == 1) {
    # WAIT調整
    my @keys = sort keys %$cuesheets;
    my $next_time = $keys[1];
    print "$now $next_time\n";
    my $dt_next = DateTime::Format::HTTP->parse_datetime($next_time)->set_time_zone('Asia/Tokyo');
    my $delta  = $dt_next->epoch - $now->epoch;
    my $delta2 = $dt_next->epoch - DateTime->now()->set_time_zone('Asia/Tokyo')->epoch;
    $SLEEP_INTERVAL = int( ( $delta2 / $delta ) *1000 ) / 1000;
    $SLEEP_INTERVAL = 0.2 if $SLEEP_INTERVAL < 0.2;
    print "$delta2 $delta $SLEEP_INTERVAL\n";
  }
  delete $cuesheets->{"$now"}; # 投稿済みのキューをはずす
  $now->add(seconds =>1); # 時刻を1秒分進める（本来の時刻とは合っていない）
  return 1;
}
 
sub interrupt {
    my $sig = shift; 
    setpgrp;                 # I *am* the leader 
    $SIG{$sig} = 'IGNORE';
    kill $sig, 0;            # death to all-comers
    die "killed by $sig"; 
    exit(0);
}
 
sub init {
    $SIG{INT } = 'interrupt';      # Ctrl-C
    $SIG{HUP } = 'interrupt';      # HUP  SIGNAL
    $SIG{QUIT} = 'interrupt';      # QUIT SIGNAL
    $SIG{KILL} = 'interrupt';      # KILL SIGNAL
    $SIG{TERM} = 'interrupt';      # TERM SIGNAL
    if ($DAEMON) { # as a daemon
      Proc::Daemon::Init if $DAEMON; # as a daemon
      chdir $FindBin::RealBin;
      open STDERR, '>', $err_file or die $!;
      open STDOUT, '>', $log_file or die $!;
    }
}
 
sub run {
  while(1) {
    &action;
    sleep($SLEEP_INTERVAL);
  }
}
 
 
sub load_cuesheet { # cuesheetファイルををparseして取り込み
  my $dir = shift;
  my $res = {};
  my $now = DateTime->now(time_zone => 'Asia/Tokyo');
  foreach (glob "$dir/*.yaml") {
    my $yaml = YAML::XS::LoadFile($_);
    foreach my $key ( keys %{$yaml->{cue} } ) {
      my $dt = DateTime::Format::HTTP->parse_datetime($key);
      if ( $dt > $now ) {
        $res->{"$dt"}->{cue    } = $yaml->{cue    }->{$key};
        $res->{"$dt"}->{title  } = $yaml->{title  };
        $res->{"$dt"}->{hashtag} = $yaml->{hashtag};
      }
    }
  }
  my $first = (sort keys %$res)[0];
  my $dt3 = DateTime::Format::HTTP
              ->parse_datetime( $first )
              ->set_time_zone('Asia/Tokyo');
  my $firststr = DateTime::Format::HTTP->format_datetime($dt3);
  $next->{date} = $firststr;
  $next->{title} = $res->{$first}->{title};
  _write_json();
  return $res;
}
 
sub tell_cuesheet { # キューシートを読み、応じて発言。
  my $cuesheets = shift;
  print "$now\n";
  #(my $next = Dump($cuesheets)) =~s/---\n//sgo;
  #$next =~s/\n.*//sgo;
  #print "$next\n";
  my $str = $cuesheets->{"$now"}->{cue};
  if ($str) {
    if ($str eq 'ON AIR') {
      print "[ON AIR]\n";
      unless ($debug) {
        $onair = 1;
        $maico->update_profile_image($icon_onair);
      }
      return;
    }
    elsif ($str eq 'OFF AIR') {
      print "[OFF AIR]\n";
      unless ($debug) {
        $onair = undef;
        my $first = (sort keys %$cuesheets)[1];
        my $dt3 = DateTime::Format::HTTP
                    ->parse_datetime( $first )
                    ->set_time_zone('Asia/Tokyo');
        my $firststr = DateTime::Format::HTTP->format_datetime($dt3);
        $next->{date } = $firststr;
        $next->{title} = $cuesheets->{$first}->{title};
        _write_json();
        $maico->update_profile_image($icon_file);
      }
      return;
    }
    elsif ($str =~ m/LOCATION /i) {
      unless ($debug) {
        (my $loc = $str ) =~ s/LOCATION //i;
        (my $lat, my $long, my $place ) = split ',', $loc;
        $location->update($maico, $lat, $long, $place);
        $next->{lat  } = $lat;
        $next->{long } = $long;
        $next->{place} = $place;
        _write_json();
        $maico->update_profile(location => $place);
      }
      return;
    }
    $str .= ' ' . $cuesheets->{"$now"}->{hashtag}
      if $cuesheets->{"$now"}->{hashtag};
    print encode_utf8("$str\n");
    if ( $str =~ m/^赤井\s*?：(.+)/ ) {
      return $akai->tweet( $1 );
    }
    if ( $str =~ m/^マツオ\s*?：(.+)/ ) {
      return $matsuo->tweet( $1 );
    }
    if ( $str =~ m/^タツモト\s*?：(.+)/ ) {
      return $tatsumoto->tweet( $1 );
    }
    if ( $str =~ m/^マスダマス\s*?：(.+)/ ) {
      #return $support->tweet( $1 );
      return $masudamasu->tweet( $1 );
    }
    if ( $str =~ m/^MAICO\s*?：(.+)/ ) {
      #return $support->tweet( $1 );
      return $maico->tweet( $1 );
    }
    if ( $str =~ m/^伝助\s*?：(.+)/ ) {
      #return $support->tweet( $1 );
      return $matsuo->tweet( $1 );
    }
    if ( $str =~ m/^松\s*?：(.+)/ ) {
      return $matsu->tweet( $1 );
    }
    if ( $str =~ m/^梅\s*?：(.+)/ ) {
      return $ume->tweet( $1 );
    }
    if ( $str =~ m/^スガ\s*?：(.+)/ ) {
      return $suga->tweet( $1 );
    }
    if ( $str =~ m/^カッチン\s*?：(.+)/ ) {
      return $kacchin->tweet( $1 );
    }
    if ( $str =~ m/^イズミ\s*?：(.+)/ ) {
      return $izumi->tweet( $1 );
    }
    return $support->tweet( $str );
  }
}

sub _write_json {
  return if $debug;
  open my $fh, '>', "$html_dir/next.json" or die $!;
  #print $fh encode_utf8("{date: '$firststr', "
  #                    . "title: '$cuesheets->{$first}->{title}'}");
  print $fh encode_json( $next );
  close $fh;
}
 
1;
 
__END__

system/MAICO2010.pm

package MAICO2010;
 
use strict;
use warnings;
use Config::Pit;
use Net::Twitter;
use Encode;
use utf8;
use YAML::XS;
use WWW::Mechanize;
 
sub new {
  my $class = shift;
  my %args = ( @_ );

  my $p;
  if ( defined $args{pit} ) {
    $p = pit_get( $args{pit} );
    die "not preset account data in Pit." if !%$p;
  } else {
    $p->{access_token       } = $args{access_token};
    $p->{access_token_secret} = $args{access_token_secret};
    $p->{username} = $args{username};
    $p->{password} = $args{password};
  }
  my $consumer = YAML::XS::LoadFile('consumer_keys.yaml');
  $p->{consumer_key       } = $consumer->{consumer_key};
  $p->{consumer_key_secret} = $consumer->{consumer_key_secret};
  my $self;
  $self->{c} = $p;
  login($self);
  return bless $self, $class;
}
 
sub login {
  my $self = shift;
  my $tw = Net::Twitter->new(
    traits => [qw/API::REST OAuth WrapError/],
    consumer_key    => $self->{c}->{consumer_key},
    consumer_secret => $self->{c}->{consumer_key_secret},
    ssl => 1,
  );
  $tw->access_token       ($self->{c}->{access_token});
  $tw->access_token_secret($self->{c}->{access_token_secret});
  $self->{tw} = $tw;
  return;
}
 
sub tweet {
  my $self = shift;
  my $status = shift;
  my $reply_to = shift;
  return unless $status;  
  my $arg;
  $arg->{status}                = decode_utf8($status);
  $arg->{in_reply_to_status_id} = $reply_to if $reply_to;
  $arg->{lat } = $self->{geo}->{lat } if $self->{geo}->{lat };
  $arg->{long} = $self->{geo}->{long} if $self->{geo}->{long};
   
  warn Dump($arg);
  my $res = $self->{tw}->update( $arg );
  #warn Dump($res);
  #if( 1 ) { # Over Capacity test
  if( defined $res ) {
    #eval "{ $res }";
    #if ( $@ ) {
    #  warn "update failed because: $@\n";
    #} else {
      warn "update Successful.\n";
    #}
    return 1;
    #return 'Bad Gateway'; # Over Capacity test 
  }
  else{
    warn "update failed.\n";
    warn $self->{tw}->http_message ."\n";
    return $self->{tw}->http_message;
    # 'Over Capacity' => 'Bad Gateway'
  }
  return;
}
 
sub search {
  my $self = shift;
  my $search_term = { q => shift };
  my $tw = Net::Twitter->new(
    traits => ['API::Search', 'OAuth', 'WrapError'],
    consumer_key    => $self->{c}->{consumer_key},
    consumer_secret => $self->{c}->{consumer_key_secret},
    ssl => 1,
  );
  my $res = $tw->search($search_term);
  my $status;
  if( defined $res ){
    warn "search Successful.\n";
  }
  else{
    warn "search failed.\n";
    warn $tw->http_message ."\n";
    $status = $tw->http_message;
    # 'Over Capacity' => 'Bad Gateway'
  }
  return { res => $res, status => $status };
}
 
 
sub mentions {
  my $self = shift;
  my $param = shift;
  my $tw = Net::Twitter->new(
    username => $self->{c}->{username},
    password => $self->{c}->{password},
    ssl => 1,
  );
  my $res = $tw->mentions($param);
  my $status;
  if( defined $res ){
    warn "mentions Successful.\n";
  }
  else{
    warn "mentions failed.\n";
    warn $tw->http_message ."\n";
    $status = $tw->http_message;
    # 'Over Capacity' => 'Bad Gateway'
  }
  return { res => $res, status => $status };
}
 
 
sub make_friend {
  my $self = shift;
  my $screen_name = shift;
  my $tw = Net::Twitter->new(
    username => $self->{c}->{username},
    password => $self->{c}->{password},
    ssl => 1,
  );
  my $res = $tw->create_friend({ screen_name => $screen_name });
  return $res;
}
 
 
sub followers {
  my $self = shift;
  my %args = ( @_ );
  my $res = $self->{tw}->followers( \%args );
  return $res;
}
 
 
sub friends {
  my $self = shift;
  my %args = ( @_ );
  my $res = $self->{tw}->friends( \%args );
  return $res;
}
 
sub friends_ids {
  my $self = shift;
  my %args = ( @_ );
  my $res = $self->{tw}->friends_ids( \%args );
  return $res;
}
 
sub retweet {
  my $self = shift;
  my $id = shift;
  my $res = $self->{tw}->retweet( $id );
  return $res;
}
 
 
sub update_profile_image2 {
  my $self = shift;
  my $file = shift;
  my $mech = WWW::Mechanize->new();
  $mech->agent_alias( 'Windows IE 6' );
  $mech = WWW::Mechanize->new(timeout => 1);
  
  eval {
    $mech->get('https://twitter.com/settings/profile');
  };
  if ($@) {
    # 失敗
    warn $mech->status, " : $@";
    return undef;
  } 
  return undef unless $mech->success;
  return undef if $mech->uri() ne 'https://twitter.com/login';
  eval {
    $mech->submit_form(
      form_number => 2,
      fields => {
        'session[username_or_email]' => $self->{c}->{username},
        'session[password]'          => $self->{c}->{password},
      },
      button => 'commit',
    );
  };
  if ($@) {
    # 失敗
    warn $mech->status, " : $@";
    return undef;
  } 
  print $mech->status()."\n";
  return undef unless $mech->success;
  eval {
    $mech->submit_form(
      form_number => 2,
      fields => {'profile_image[uploaded_data]' => $file, }
    );
  };
  if ($@) {
    # 失敗
    warn $mech->status, " : $@";
    return undef;
  } 
  print $mech->status()."\n";
  return undef unless $mech->success;
  
  return;
  
}
 
sub update_profile_image {
  my $self = shift;
  my $file = shift;
  my $res = $self->{tw}->update_profile_image([$file]);
  return $res;
}
sub update_location {
  my $self = shift;
  my $lat  = shift;
  my $long = shift;
  if ($lat && $long ) {
    $self->{geo} = { lat => $lat, long => $long };
  } else {
    delete $self->{geo};
  } 
  return;
}
 
sub update_profile {
  my $self = shift;
  my %args = ( @_ );
  my $res = $self->{tw}->update_profile( \%args );
  return $res;
}
 
 
1;

system/Morningcall.pm

package Morningcall;
use strict;
use warnings;
use utf8;
use YAML::XS;
use Encode;
 
sub new {
  my $class = shift;
  my $self = {
    @_,
  };
  $self->{morningcall} = YAML::XS::LoadFile($self->{morningfile}) if $self->{morningfile};
  my $daily = {};
  foreach my $key ( keys %{$self->{morningcall}} ) {
    my $t = $self->{morningcall}->{$key};
    push @{$daily->{$t}} , $key;
  }
  $self->{daily} = $daily;
  return bless $self, $class;
}
 
sub tell_morningcall { # モーニングコール設定した人に対し挨拶
  my $self = shift;
  my $m   = shift;
  my $now = shift;
  my $t = $now->strftime('%H:%M');
  if ( my $items = $self->{daily}->{$t} ) {
    foreach my $item ( @$items ) { 
      my $status = "@"."$item さん、おはようございます。"
                   . _higawari_message($now);
      $m->tweet($status);
      print decode_utf8("$status\n");
    }
    print Dump($self->{daily});
  }
  return;
}
 
sub _higawari_message {
  my $now = shift;
  my $status;
  my $ymd = $now->strftime('%Y%m%d');
  my $md  = $now->strftime('%m%d'  );
  return '今日は節分ですね。今年の恵方は西南西。夜空でいえば、すばるの方角でしょうか。'                                   if $ymd eq '20100203';
  return '今日は建国記念の日。建国記念「の」日の「の」を言い忘れると、アナウンサー的に大変なんですよ。'                   if $md  eq '0211';
  return '今日はバレンタインデー。……もし、MAICOがチョコレートを作ったら、……もらって、いただけますか？'                if $md  eq '0214';
  return 'オリンピックも競技がほぼ全部終わって、今日から3月。新しい1か月、がんばってがんばって、がんばっていきましょー。' if $ymd eq '20100301';
  return '今日はひなまつり。雛人形に飾るひし餅って、食べられるんでしょうか？'                                             if $md  eq '0303';
  return '今日は、ホワイトデー。バレンタインデーのお返し、用意しましたか？……MAICOにも……いえ、なんでもありません。'    if $md  eq '0314';
  return '今日は春分の日。お彼岸ですよー。マスダマスさんは、この時期になるとどこかのお寺に出かけているみたいですね。'     if $md  eq '0321';
  return '今日は振替休日。３連休、ゆっくり休みましょうね。'                                                               if $md  eq '0322';
  return '今日は、MAICOと声がそっくりな、丹下桜さんのお誕生日なんですよー。おめでとうございまーす。'                      if $md  eq '0324';
  return '今日は、エイプリルフールぷにょ〜ん。あえて言いますが、MAICOは、アンドロイドではなく、botなんですよーぷにょ〜ん。知っていましたかぷにょ〜ん？' if $md eq '0401';
  return '覚えていないかもしれませんが、昨日のモーニングコールの内容は、当然、ウソなんですよー。'                         if $md  eq '0402';
  my $wd = $now->wday;
  return '月曜日。一週間、がんばって、がんばって、がんばっていきましょー。'       if $wd == 1;
  return 'まだまだ火曜日。一週間、先は長いですよ？'                               if $wd == 2;
  return '週の真ん中水曜日。やっぱり、がんばって、がんばって、がんばりましょー。' if $wd == 3;
  return '今日は木曜日。たまには、がんばらなくても、いいですよね？'               if $wd == 4;
  return '今日は金曜日。あと一日、がんばって、がんばって、がんばりましょー。'     if $wd == 5;
  return '土曜日ですね。今日は何をして過ごしますか？'                             if $wd == 6;
  return 'きょうは日曜日！お休みでしょうか。ゆっくり休めるといいですね。'         if $wd == 7;
}
 
sub set {
  my $self = shift;
  my $item = shift;
  my $hour = shift;
  my $min  = shift;
  $self->{morningcall}->{$item->{screen_name}} = sprintf("%02d:%02d", $hour, $min);
  my $daily = {};
  foreach my $key ( keys %{$self->{morningcall}} ) {
    my $t = $self->{morningcall}->{$key};
    push @{$daily->{$t}} , $key;
  }
  $self->{daily} = $daily;
  YAML::XS::DumpFile($self->{morningfile}, $self->{morningcall});
  return;
}
 
sub remove {
  my $self = shift;
  my $item = shift;
  if ( exists $self->{morningcall}->{$item->{screen_name}} ) {
    delete $self->{morningcall}->{$item->{screen_name}}
  }
  my $daily = {};
  foreach my $key ( keys %{$self->{morningcall}} ) {
    my $t = $self->{morningcall}->{$key};
    push @{$daily->{$t}} , $key;
  }
  $self->{daily} = $daily;
  YAML::XS::DumpFile($self->{morningfile}, $self->{morningcall});
  return;
}
 
1; 

system/Notbot.pm

package Notbot;
use strict;
use warnings;
use utf8;
use YAML::XS;
sub new {
  my $class = shift;
  my $self = {
    @_,
  };
  $self->{notbot} = YAML::XS::LoadFile($self->{notbotfile});
  return bless $self, $class;
#use Data::Dumper;
#my $notbot = {};
#my $friends = $m->friends('MAICO__2010');
#print Dumper($friends);
#for my $status ( @$friends ) {
#  if ( ($status->{time_zone} eq 'Tokyo') 
#    || ($status->{time_zone} eq 'Osaka') ) {
#      $notbot->{"$status->{screen_name}"} = 1;
#  }
#}
#$Data::Dumper::Terse = 1;
#print Dumper($notbot);
}
 
sub tell_notbot { # bot呼ばわりした人をsearch、いたら否定を発言
  my $self = shift;
  my $m    = shift;
  my $word = shift;
  my $res  = $m->search("MAICO $word");
  if ( (!defined $res->{status}) || ( $res->{status} ne 'Bad Gateway') ) {
    my $add_users;
    for my $r ( @{$res->{res}->{results}} ) {
      if ($r->{iso_language_code} eq 'ja') {
        unless ( $self->{notbot}->{$r->{id}} ) {
          if ( ($r->{from_user} ne 'MAICO__2010') && ($r->{from_user} ne 'masudamasu_') ) {
            push @$add_users,
              { from_user => $r->{from_user},
                id        => $r->{id},
                text      => $r->{text},
            };
          }
        }
      }
    }
    foreach my $user ( @$add_users ) {
      $self->{notbot}->{$user->{id}} = $user->{text};
      my $status = '@'.$user->{from_user}
                 . " ${word}じゃありません、アンドロイドです。";
      print Encode::encode_utf8("$status\n");
      $m->tweet($status, $user->{id} );
    }
  }
  
  YAML::XS::DumpFile($self->{notbotfile}, $self->{notbot});
  print "notbot!\n";
  return;
}

1;

system/Reply.pm

package Reply;

use strict;
use warnings;
use utf8;
use Regexp::Assemble;
use Digest::MD5;
use DateTime;

sub new {
  my $class = shift;
  my $self = {
    sinceidfile => 'sinceid.yaml',
    @_,
  };
  $self->{replylist} = YAML::XS::LoadFile($self->{sinceidfile});
  $self->{username} = $self->{m}->{c}->{username} if exists $self->{m}->{c}->{username};
  $self->{dispatch } = {
    '(味噌胡瓜|みそきゅうり|みそきゅーり)' => sub { return 'みそきゅーり！'; },
    'おはよ' => sub{ return 'はい、おはようございます！'; },
    '(さむい|寒い)' => sub{ return 'お体を暖かくして、風邪をひかないよう、がんばってください！'; },
    '全裸' => sub {
      return '全、ぜん、ぜん、ぜん、ぜん、裸、ららら、ぜん、ぜん、'
           . 'ららら、ららら、ぜん、ぜん、ららら、ららら、ぜん、ぜん、'
           . 'ららら、ららら、ぜん、ぜん、ららら、ららら、ぜん、ぜん、'
           . 'ららら、ららら、ぜん、ぜん、ららら、ららら、ぜん、ぜん、'
           . 'ららら、ららら、……'; },
    '乱交パーティー' => sub {
      return 'らん 乱、交、らん、ら、ら、らん、交、こう、こう、ららら、'
           . 'ぱぱぱ、ぱーてぃー、ぱーてぃー、ら、ら、らん、交、こう、'
           . 'こう、ららら、ぱぱぱ、ぱーてぃー、ぱーてぃー、……'; },
    '自爆して' => sub {
      return 'それは困ります。自爆したら放送が続けられません。確かに '
           . 'まだ起動したばかりでわからないこともあるとおもいますけど、'
           . 'いきなり自爆というのはあんまりです。MAICOは、これからも、'
           . 'かんばってがんばってがんばりますから、どうか応援してください。';},
    'パンティーおーくれ' => sub {
      return 'パンティーなんて飾りです。偉い人にはそれがわからんのです。';},
#    'MAICO.+?かわいい' => sub {
#      return 'はい、ありがとうございます。MAICOには、モデルになった方がいる'
#           . 'らしいんですけれども、マスダマスさんはその方のことを教えて'
#           . 'くれないんですよね。なぜなんでしょう？';},
    'MAICO.+?かわいい' => sub {
      return 'はい、ありがとうございます。';},
    'ぷにょ(ー|～)ん' => sub {
      return 'ぷにょ～ん！';},
    '輝いて(いる|る)' => sub {
      return 'ありがとうございます。がんばってがんばってがんばります！';},
    'お(つか|疲)れ(さま|様)' => sub { return 'はい、おつかれさまでしたー。';},
    'おやすみ' => sub {return 'はい、おやすみなさいー。';},
    '風鈴演奏家' => sub{
      return 'ご丁寧にありがとうございます。でも、'
           . '私APIですので、聞きに行けないのです。ごめんなさい。';},
    'ありがと' => sub {return 'はい、どういたしまして。';},
#    '遊ぼ' => sub {return 'はい、なにして遊びます？雪だるま作りなら、得意ですよー。';},
    'モーニングコール.*(止めて|やめて|とめて|解除して)' => sub {
      my $item = shift;
      my $id = $item->{screen_name};
      return "モーニングコールをやめたい場合は、"
           . "http://mamesibori.net/maico2010/cut.html?id=$id "
           . "にアクセスして、画面の指示に従ってください。";},
    '(起して|おこして|起こして)' => sub {
      my $item = shift;
      my $morningcall = shift;
      ( my $text = $item->{text} ) =~s/\@$self->{username}/ /e;
      if (my $hourmin = _parse_time( $item->{text} ) ) {
        my $hour = $hourmin->{hour};
        my $min  = $hourmin->{min };
        $morningcall->set($item, $hour, $min);
        my $reply = "はい、"
                       .sprintf("%02d:%02d に設定しました。", $hour, $min);
        return $reply;
      } else {
        my $reply = "えーっと、時刻が、認識できません……";
        return $reply;
      }
    },
    'おみくじ' => sub {
      my $item = shift;
      my $id = $item->{screen_name};
      my $dt = DateTime->now()->set_time_zone('Asia/Tokyo');
      my $dt2 = DateTime->from_epoch( epoch => 0 );
      my @unsei = (
        '今日の運勢は「小吉」。MAICOがちっとも起動せず、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。トークを失敗ばかりして、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。プラグアンドプレイのバグの影響で、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。ディレクターさんが怒って、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。楽しい宴会なんですが、みんな酔っぱらって、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。画期的で光っているコーナーをスガさんが企画して、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。世界的スターがゲストに出演してくれることになって、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。カッチンさんの彼女が会いに来て、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。ゲストの人が来なくて、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。テロリストの人がON AIR中に入ってきて、ベイルートに行けず、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。ニトロで、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。助けを求めるモールス信号が通じず、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。花かこけしかを決める一話まるまる家族会議で、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。子供が暴れん坊で、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。ゲストの人が来たのですが、誰なのかさっぱりわからず、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。伝助さんがハエさんを壊そうと活躍しすぎて、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。昔の恋人に婚約を電撃発表されてしまい、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。外は嵐に合わせて、スタジオ内の人間関係も嵐になってしまい、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。伝助さんが一人で番組を進行してみたのですが、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。電話相談で解決したのですが、スガさんが台本を書けなくなり、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。MAICOの言葉でスガさんの無事を祈りましたが、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。いままでの行為がばれて、MAICOが降板となってしまって、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。ロボットとのバトルがあついぜ！しかし、番組がめちゃくちゃに。',
        '今日の運勢は「小吉」。新しいMAICOで番組が始まりましたが、やっぱり、番組がめちゃくちゃに！',
      );
      my $days = $dt->delta_days($dt2); 
      my $length = ++$#unsei;
      my  $ctx = Digest::MD5->new;
      $ctx->add($id);
      my $s = ( hex(substr($ctx->hexdigest,24)) + $days->delta_days - 2 ) % $length;
      my $reply = $unsei[$s];
      return $reply;
    },
  };
  $self->{re} = Regexp::Assemble->new->track->add(keys %{$self->{dispatch}});

  return bless $self, $class;
}
sub _parse_time {
  my $text = shift;
  if ( $text =~ m/(\d+)[^\s\d](\d+)/ ) {
    (my $hour, my $min ) = ($1, $2);
    $hour += 12 if $text =~ m/(午後|pm|p.m)/i;
    return {hour => $hour, min => $min};
  }
  return;
}
sub tell_reply {
  my $self = shift;
  my $m    = shift;
  my $morningcall = shift;
  my $since_id = $self->{replylist}->{since_id} || 1;
  my $res = $m->mentions({since_id=>$since_id });
  #push @{$res->{res}},{in_reply_to_screen_name=>$self->{username},text=>'10:10おこして',user=>{screen_name=>'masudamasu_'}};
  if ( (!defined $res->{status}) || ( $res->{status} ne 'Bad Gateway') ) {
    my $list;
    foreach my $item ( @{$res->{res} } ) {
      #next if (!$item->{in_reply_to_screen_name});
      #next if ( $item->{in_reply_to_screen_name} ne $self->{username});
      next if $item->{text} =~ m/RT:?\s*?\@/;
      push @$list,{ id          => $item->{id},
                    screen_name => $item->{user}->{screen_name},
                    text        => $item->{text}
      };
    }
    my $isreply = 0;
    foreach my $item ( @$list ) {
      if ( $self->{re}->match( $item->{text} ) ) {
        my $str = $self->{dispatch}->{$self->{re}->matched}->($item, $morningcall);
        my $reply = '@'."$item->{screen_name} $str";
        print Encode::encode_utf8("$reply\n");
        #my $res = $m->tweet( $reply );
        my $res = $m->tweet( $reply, $item->{id} );
        if ( $res ne 'Bad Gateway' ) {
          $since_id = $item->{id} if $since_id < $item->{id};
          $isreply++;
        }
      }
    }
    $self->{replylist}->{since_id} = $since_id;
    YAML::XS::DumpFile( $self->{sinceidfile}, $self->{replylist}) if $isreply;
  }
  print "reply!\n";
  return;
}

1;