今日の 503 で先日お知らせしたとおり、MTOS を少しカスタマイズしてあることを忘れて素の MTOS の最新版にしてしまい、そのままリビルドをかけてしまいました。
ソースは subversion に突っ込んであるので、一度逆方向に merge して、何事もなかったかのようにアップグレードしたもので更新しました。
これに伴い、本来存在してないはずのファイルに関しては、Moved と書き込むことにしました。
vkgtaro さんが先日 DBIx::Class で basename を触ってらした(MT の permalink に entry_id 使ってたので entry_basename 使うよう変更した - 僕ト云フ事＠はてな出張版)のをちょっとパクらせていただき、対応スクリプトをでっち上げました。ありがとうございます。
スクリプトは、以下の通りです。
読者のみなさまにおかれましては、503 の blog.woremacx.com をお楽しみ頂きありがとうございました。
#!/usr/bin/perl use strict; use warnings; use lib qw(MT/lib); use MT::ConfigMgr; my $file = "MT/mt-config.cgi"; my $mgr = MT::ConfigMgr->instance; $mgr->read_config_file($file); my @cfg; push(@cfg, 'dbi:mysql:' . $mgr->get('database')); push(@cfg, $mgr->get('dbuser')); push(@cfg, $mgr->get('dbpassword')); my $schema = MT::Schema->connect(@cfg); my $entries = $schema->resultset('MtEntry')->search({ entry_basename => { LIKE => '%\_%' }, }); while (my $entry = $entries->next) { my ($month, $day) = ($entry->entry_authored_on =~ /^(\d+)-(\d+)-/); my $base = $entry->entry_basename; my $origname = $base . ".html"; my $filename = sprintf("%04d/%02d/%s.html", $month, $day, $base); $base =~ s/_/-/g; my $wrong = sprintf("%04d/%02d/%s.html", $month, $day, $base); if (-e $wrong && -e $filename) { open(my $r, $filename) or die; my $data = do { local $/; <$r>; }; close($r); my ($title) = $data =~ m!<title>(.*?)</title>!s; warn "$title $filename"; open(my $fh, "> $wrong") or die; printf $fh qq{<html><body>Requested entry <a href="%s">%s</a> has moved.</body></html>\n}, $origname, $title; close($fh); } } package MT::Schema; use strict; use warnings; use base 'DBIx::Class::Schema::Loader'; __PACKAGE__->loader_options( relationships => 0, debug => 0, components => [], ); 1;
comment test