1

Тема: [Perl, PHP] Скрипт для переноса форума с IPB 1.3.* на punBB 1.3.*

Во время переноса форума security-teams.net я намутил следующий скрипт:

#!/usr/bin/perl
use strict;
use warnings;
use Conf;

# ipb13-to-punbb13.pl
# (c) Alexandr A Alexeev 2012 | http://it-talk.org/

my %renameTable;
my $fileUniqId = 1;

my $userExistsTable = exportUsers();
exportTopics($userExistsTable);
finalize();
dumpRenameTable();

sub dumpRenameTable {
  warn "------ rename.bat -----\n";
  while(my($from, $to) = each %renameTable) {
    warn "move $from $to\n";
  }
}

# === SQL Generation ===

sub exportTopics {
  my ($userExistsTable) = @_;
  my $query = q{
    select tid, title, starter_id, start_date, last_poster_id, last_post,
           starter_name, last_poster_name, views, forum_id, pinned
    from ibf_topics
    order by tid};

  # $query .= " limit 300, 100"; # debug
###  $query .= " limit 300"; # debug

  my $dbh = Conf::getHandle();
  my $sth = $dbh->prepare($query);
  $sth->execute();
  while(my $row = $sth->fetchrow_hashref()) {
    my ($first_post_id, $last_post_id, $replies) = exportPosts($row->{tid}, $userExistsTable);
    next if($replies < 0); # no posts for this topic
    my $newTid = Conf::mapOldTidToNewTid($row->{tid});
    my $newFid = Conf::mapOldFidToNewFid($row->{forum_id});
    my $title = quoteMeta(replaceHTMLEntities($row->{title}));
    my $starter = quoteMeta(replaceHTMLEntities($row->{starter_name}));
    my $last_poster = quoteMeta(replaceHTMLEntities($row->{last_poster_name}));
    print "insert into ${Conf::toPrefix}topics values ($newTid, '$starter', '$title',".
          "$row->{start_date}, $first_post_id, $row->{last_post}, $last_post_id, '$last_poster',".
          "$row->{views}, $replies, 0, $row->{pinned}, null, $newFid );\n";
    warn "TOPIC: http://${Conf::toDomain}/topic$newTid.html\n";
  }

}

sub exportPosts {
  my ($tid, $userExistsTable) = @_;
  my $newTid = Conf::mapOldTidToNewTid($tid);
  my $query = "select pid, author_id, author_name, post_date, post, attach_id, attach_file, attach_type from ibf_posts where topic_id = ? order by post_date";
  my $dbh = Conf::getHandle();
  my $sth = $dbh->prepare($query);
  $sth->execute($tid);

  my ($first_post_id, $last_post_id);
  my $posts = 0;

  while(my $row = $sth->fetchrow_hashref()) {
    my $newPid = Conf::mapOldPidToNewPid($row->{pid});
    my $msg = htmlToBBCode($row->{post}, $newTid);
    my $posterUid = Conf::mapOldUidToNewUid($row->{author_id});
    my $posterEmail = 'null';
    if($posts == 0) {
      $first_post_id = $newPid;
      $msg = exportPoll($tid).$msg;
    }

    $msg .= exportAttach($newTid, $row->{attach_id}, $row->{attach_type}, $row->{attach_file});

    $last_post_id = $newPid;
    unless(defined $userExistsTable->{$posterUid}) {
      $posterUid = 1;
      $posterEmail = "'guest\@example.ru'";
    };
    $msg = quoteMeta($msg);
    my $author = quoteMeta(replaceHTMLEntities($row->{author_name}));
    print qq{insert into ${Conf::toPrefix}posts values ($newPid, '$author', $posterUid, '0.0.0.0',
             $posterEmail, '$msg', 0, $row->{post_date}, null, null, $newTid);\n};
    $posts++;
  }

  unless($posts > 0) {
    # warn "NO POSTS FOR TID = $newTid\n";
    return (0, 0, -1);
  }
  return ($first_post_id, $last_post_id, $posts - 1);
}

sub exportAttach {
  my($tid, $id, $type, $fname) = @_;
  return "" unless($type);
  if(($type =~ m#^image/#)&&($id =~ m#post-\d+-\d+#)) {
    # warn "Attach: id = $id, fname = $fname, tid = $tid\n";
    return "\n\n[img]$Conf::newFileBase$id\[/img]";
  } 
  $fname = ($fileUniqId++).'-'.$fname;
  # warn "Attach: tid = $tid, fname = $fname, type = $type, id = $id\n";
  $renameTable{$id} = $fname;
  return "\n\n[url]$Conf::newFileBase$fname\[/url]";
}

sub exportPoll {
  my ($tid) = @_;
  my $dbh = Conf::getHandle();
  my $sth = $dbh->prepare('select poll_question, choices from ibf_polls where tid = ?');
  $sth->execute($tid);
  if(my $row = $sth->fetchrow_hashref()) {
    my $question = replaceHTMLEntities($row->{poll_question});
    my @choices = $row->{choices} =~ /;i:1;s:\d+:"([^"]+)";i:/g;
    return "[b]$question\[/b]\n[list=1]".join("\n",
        map { s/^\s*\d+\s*(\)|\.)//; "[*]".replaceHTMLEntities($_)."[/*]" } @choices
      )."[/list]\n\n";
  } else {
    return "";
  }
}

sub exportUsers {
  my %userExistsTable;
  my $query = qq{select id, name, email, joined, last_post, last_visit
                 from ${Conf::fromPrefix}members where id > 0};
  my $dbh = Conf::getHandle();
  my $sth = $dbh->prepare($query);
  $sth->execute();
  while(my $row = $sth->fetchrow_hashref()) {
    my $uid = Conf::mapOldUidToNewUid($row->{id});
    $userExistsTable{$uid} = 1;
    my $name = quoteMeta(replaceHTMLEntities($row->{name}));
    my $salt = quoteMeta(genSalt());
    print "insert into ${Conf::toPrefix}users values ($uid, 3, '$name','0123456789abcdef0123456789abcdef', '$salt', '$row->{email}',".
          " null, null, null, null, null, null, null, null, null, null, null, null,".
          " 2, 1, 1, 1, 1, 1, 1, 1, 0, 3, 1, 0, 0, 'Russian', 'DarkGreen', 0, null, null, null,".
          " $row->{joined}, '0.0.0.0', $row->{last_visit}, null, null, null, 1, 1, 0, 1);\n";
  }
  return \%userExistsTable;
}

sub finalize {
  print qq{
    UPDATE ${Conf::toPrefix}users AS u SET num_posts = ( SELECT COUNT(*) FROM ${Conf::toPrefix}posts WHERE poster_id = u.id);
    update ${Conf::toPrefix}forums as f set num_topics = (select count(*) from ${Conf::toPrefix}topics where forum_id = f.id);
    update ${Conf::toPrefix}forums as f set num_posts = (select count(*) from ${Conf::toPrefix}posts as p
          left join ${Conf::toPrefix}topics as t on t.id = p.topic_id where t.forum_id = f.id);

    update ${Conf::toPrefix}forums as f set last_post_id = (
      select p.id from ${Conf::toPrefix}posts as p left join ${Conf::toPrefix}topics as t on t.id = p.topic_id
      where t.forum_id = f.id order by p.posted desc limit 1
    );

    update ${Conf::toPrefix}forums as f set last_post = (
      select p.posted from ${Conf::toPrefix}posts as p left join ${Conf::toPrefix}topics as t on t.id = p.topic_id
      where t.forum_id = f.id order by p.posted desc limit 1
    );

    update ${Conf::toPrefix}forums as f set last_poster = (
      select p.poster from ${Conf::toPrefix}posts as p left join ${Conf::toPrefix}topics as t on t.id = p.topic_id
      where t.forum_id = f.id order by p.posted desc limit 1
    );

    update ${Conf::toPrefix}users as u set last_post = (
      select max(posted) from ${Conf::toPrefix}posts as p where p.poster_id = u.id
    );
  };
}

sub genSalt {
  my @chars = ("a".."z", "A".."Z", "0".."9", '!', '@', '#', '$', '%', '^', '&', '*', '(', ')');
  my $salt;
  $salt .= $chars[rand(@chars)] for(0..10);
  return $salt;
}

# === HTML & BBCode ===

sub getNewTopicUrl {
  my $tid = shift;
  $tid = Conf::mapOldTidToNewTid($tid);
  return "http://${Conf::toDomain}/topic$tid.html";
}

sub getNewForumUrl {
  my $fid = shift;
  $fid = Conf::mapOldFidToNewFid($fid);
  return "http://${Conf::toDomain}/forum$fid.html";
}

sub quoteMeta {
  my ($text) = @_;
  $text = quotemeta $text;
  $text =~ s#\\%#%#g;
  return $text;
}

sub htmlToBBCode {
  my ($html, $tid) = @_;
  my $old_html = "";
  my $from = quotemeta $Conf::fromDomain;
  $html = fixUrls($html);

  while($html ne $old_html) {
    $old_html = $html;
    $html =~ s/<br>/\n/gsi;
    $html =~ s/<!\-\-emo&(.*?)\-\->.*?<!\-\-endemo\-\->/$1/gsi; 
    $html =~ s#<!--QuoteBegin[^<>]*-->\s*</div><table[^>]*><tr><td>[^<>]*<b>[^<>]*</b>[^<>]*</td></tr><tr><td[^>]*>\s*<!--QuoteEBegin-->((?:[^<>]*|</?b>)*)<!--QuoteEnd-->\s*</td></tr></table><div[^>]*>\s*<!--QuoteEEnd-->#\[quote\]$1\[/quote\]#gsi;
    $html =~ s#<!--SpoilerBegin[^<>]*-->\s*</div><table[^>]*><tr><td>[^<>]*<b>[^<>]*</b>[^<>]*</td></tr><tr><td[^>]*>\s*<!--SpoilerEBegin-->((?:[^<>]*|</?b>)*)<!--SpoilerEnd-->\s*</td></tr></table><div[^>]*>\s*<!--SpoilerEEnd-->#\&lt;SPOILER\&gt;$1\&lt;/SPOILER\&gt;#gsi;
    $html =~ s#<!--c1--></div><table[^>]*><tr><td>[^<>]*(?:<b>[^<>]*</b>)?[^<>]*</td></tr><tr><td[^>]*><!--ec1-->([^<>]*)<!--c2--></td></tr></table><div[^>]*><!--ec2-->#\[code\]$1\[/code\]#gsi;
    $html =~ s/<font.*?>(.*?)<\/font>/$1/gsi;
    $html =~ s#(?:http://)?(?:www\.)?$from(?:/\w+)?/index\.php\?showtopic=(\d+)(?:[&=%/\w]+)?#getNewTopicUrl($1)#gsie;
    $html =~ s#(?:http://)?(?:www\.)?$from(?:/\w+)?/index\.php\?showforum=(\d+)(?:[&=%/\w]+)?#getNewForumUrl($1)#gsie;
    $html =~ s#<a href='(.*?)'.*?>(.*?)</a>#\[url=$1\]$2\[/url\]#gsi;
    $html =~ s#<i>(.*?)</i>#\[i\]$1\[/i\]#gsi;
    $html =~ s#<u>(.*?)</u>#\[i\]$1\[/i\]#gsi;
    $html =~ s#<s>(.*?)</s>#\[s\]$1\[/s\]#gsi;
    $html =~ s#<marquee>(.*?)</marquee>#\[i\]$1\[/i\]#gsi; 
    $html =~ s#<span style='color:([^']+)'>(.*?)</span>#\[color=$1\]$2\[/color\]#gsi;
    $html =~ s#<span style='font-size:[^>]*>(.*?)</span>#$1#gsi;
    $html =~ s#<span style='font-family:[^>]*>(.*?)</span>#$1#gsi;
    $html =~ s#<div align="center">(.*?)</div>#$1#gsi;
    $html =~ s#<img src='([^']+)'[^>]+alt='user posted image'\s*/>#\[img\]$1\[/img\]#gsi;
    $html =~ s#<div align="[^"]+">(.*?)</div>#$1#gsi;
  }

  $html =~ s#<b>(.*?)</b>#\[b\]$1\[/b\]#gsi; # <b> is used in quotes
  $html =~ s#<ul>(.*?)</ul>#htmlListToBBCodeList($1)#gsie;

  if(($html =~ /[<>]/) && ($html !~ /\[doHTML\]/i)) {
    warn "--- looks like htmlToBBCode failed (tid = $tid) ---\n".
         "$html\n--------------------\n";
  }

  $html = replaceHTMLEntities($html); 
  $html = replaceSmiles($html, $tid);
  return $html;
}

sub fixUrls {
  my ($html) = @_;
  $html =~ s#_*h_*t_*t_*p_*:_*/_*/#http://#gi;
  $html =~ s#_*h_*t_*t_*p_*s_*:_*/_*/#https://#gi;
  $html =~ s#_*f_*t_*p_*:_*/_*/#ftp://#gi;
  $html =~ s#_*f_*t_*p_*s_*:_*/_*/#ftps://#gi;
  $html =~ s#_*s_*f_*t_*p_*:_*/_*/#sftp://#gi;
  $html =~ s#_*s_*c_*p_*:_*/_*/#scp://#gi;
  $html =~ s#_*s_*s_*h_*:_*/_*/#ssh://#gi;
  return $html;
}

sub htmlListToBBCodeList {
  my ($html) = @_;
  my @items = $html =~ m#<li>([^<>]*)</li>#gsi;
  return "[list=*]\n".join("\n", map { 
      '[*]'.$_.'[/*]'
    } @items)."\n[/list]\n";
}

sub replaceHTMLEntities {
  my ($html) = @_;
  $html =~ s/&quot;/"/gi; 
  $html =~ s/&nbsp;/ /gi; 
  $html =~ s/&lt;/</gi; 
  $html =~ s/&gt;/>/gi; 
  $html =~ s/&#(\d+);/chr($1)/gie; 
  $html =~ s/&amp;/&/gi; 
  return $html;
}

sub replaceSmiles {
  my ($html, $tid) = @_;
  $html =~ s/:angry:/:mad:/gi; 
  $html =~ s/:blink:/;\)/gi; 
  $html =~ s/:(clap|tease):/:D/gi; 
  $html =~ s/:(huh|aaa|shok):/:o/gi; 
  $html =~ s#:unsure:#:/#gi; 
  $html =~ s#:(nyam|craze):#:P#gi;
  $html =~ s#:offtop:#[OFFTOP]#gi;
  $html =~ s#:(bax|mol|wacko|banned|nono|pineer|tomato|drinks|help|box|flowers|dont):#$1\.png#gi;
  $html =~ s#:(join|bu|shut|sorry|gandalf|king|zzz):#$1\.png#gi;

  my @smiles = $html =~ /(:[a-z]+:)/g;
  @smiles = grep { 1 
    && ($_ ne ":mad:") 
    && ($_ ne ":rolleyes:") 
    && ($_ ne ":cool:") 
    && ($_ ne ":lol:") } @smiles;

  if(@smiles) {
    # warn "Unknown smiles: @smiles (tid = $tid)\n";
  }
  return $html;
}

Это не самый красивый код, который я когда либо писал, но он решает задачу и честно говоря я надеюсь, что он мне больше не пригодится.

Как пользоваться скриптом:

1. Найти и устранить коллизии в именах пользователей и их e-mail на двух форумах. Это несложно сделать, если поднять копии баз обоих форумов на одной машине.
2. Залейте все файлы форума из каталога uploads (см conf_global.php) на DropBox или на ваш сервер.
3. Залейте phpbb13-to-punbb13.pl на сервер, где у вас поднят форум на IPB
4. Создайте в одном каталоге со скриптом файл Conf.pm примерно следующего содержания:

#!/usr/bin/perl

package Conf;
use strict;
use warnings;
use DBI;

our $fromPrefix = 'ipb13_';
our $toPrefix = 'punbb13_';

our $fromDomain = 'security-teams.net';
our $toDomain = 'it-talk.org';

our $newFileBase = 'http://dl.dropbox.com/u/12345678/forum_files/';

sub mapOldUidToNewUid {
  return $_[0] + 2000; # max user id
}

sub mapOldTidToNewTid {
  return $_[0] + 3000; # max topic id
}

sub mapOldPidToNewPid {
  return $_[0] + 30_000; # max post id
}

sub mapOldFidToNewFid {
  my $fid = $_[0];

  return 17 if($fid == 1);
  return 35 if($fid == 30);
  return 23 if($fid == 15);
  return 24 if($fid == 34);
  return 10 if($fid == 2);

  return 28 if($fid == 7);
  return 29 if($fid == 9);
  return 30 if($fid == 10);

  return 31 if($fid == 8);
  return 32 if($fid == 6);
  return 33 if($fid == 4);
  return 34 if($fid == 26);

  return 36 if($fid == 37);
  return 37 if($fid == 38);
  return 38 if($fid == 39);
  return 39 if($fid == 40);
  return 40 if($fid == 41);

  return 41 if($fid == 11);
  return 42 if($fid == 12);
  return 43 if($fid == 13);
  return 44 if($fid == 18);

  return 6 if($fid == 16);
  return 19 if($fid == 17);
  return 45 if($fid == 46);
  return 48 if($fid == 35);
  return 46 if($fid == 42);
  return 47 if($fid == 43);

  return 6; # default fid
}

sub getHandle {
  return DBI->connect(
      'dbi:mysql:db_name:db_host:3306',
      'db_user',
      'db_password',
      { RaiseError => 1 },
    );
}

1;

5. Выполните следующие команды:

time ./ipb13-to-punbb13.pl 1> import.sql 2> err.txt
cat err.txt | grep TOPIC > topics.txt
cat err.txt | grep -v TOPIC > errors.txt

6. Просмотрите errors.txt на предмет ошибок - в идеале их не должно быть ну или хотя бы быть немного. Скопируйте rename.bat из конца файла.
7. Скопируйте rename.bat в каталог с файлами форума на DropBox'е (или вашем сервере) и запустите. Если вы решили заливать файлы на свой сервер и у вас там UNIX, замените в скрипте команды move на mv и скормите его sh или bash.
8. Импортируйте import.sql в базу вашего форума на punBB (не забудьте сделать резервную копию!)
9. Пройдитесь по топикам из topics.txt и убедитесь, что все перенеслось правильно
10. Настройте перенаправления. Это можно сделать, например, прописав в index.php форума на IPB следующее:

header("HTTP/1.1 301 Moved Permanently");

if(isset($_GET['showtopic'])) {
  $newTid = intval($_GET['showtopic']) + 3000;
  header("Location: http://it-talk.org/topic$newTid.html");
  exit();
}

if(isset($_GET['showuser'])) {
  $newUid = intval($_GET['showuser']) + 2000;
  header("Location: http://it-talk.org/user$newUid.html");
  exit();
}

if(isset($_GET['showforum'])) {
  $newFid = getNewFid(intval($_GET['showforum']));
  header("Location: http://it-talk.org/forum$newFid.html");
  exit();
}

header("Location: http://it-talk.org/");
exit();

function getNewFid($fid) {
        if($fid == 1) { return 17; }
        if($fid == 30) { return 35; }
        if($fid == 15) { return 23; }
        if($fid == 34) { return 24; }
        if($fid == 2) { return 10; }
        if($fid == 7) { return 28; }
        if($fid == 9) { return 29; }
        if($fid == 10) { return 30; }
        if($fid == 8) { return 31; }
        if($fid == 6) { return 32; }
        if($fid == 4) { return 33; }
        if($fid == 26) { return 34; }
        if($fid == 37) { return 36; }
        if($fid == 38) { return 37; }
        if($fid == 39) { return 38; }
        if($fid == 40) { return 39; }
        if($fid == 41) { return 40; }
        if($fid == 11) { return 41; }
        if($fid == 12) { return 42; }
        if($fid == 13) { return 43; }
        if($fid == 18) { return 44; }
        if($fid == 17) { return 19; }
        if($fid == 46) { return 45; }
        if($fid == 35) { return 48; }
        if($fid == 42) { return 46; }
        if($fid == 43) { return 47; }
        return 6;
}

Функцию getNewFid можно тупо скопипастить из Conf.pm (если вы догадались с самого начала написать ее так, чтобы работало и в Perl и в PHP) или сгенерировать из того же Conf.pm с помощью несложного однострочника (как пришлось делать мне).

11. Обновите robots.txt вашего форума на IPB:

User-agent: *
Host: it-talk.org

12.  Администрирование  » Управление  » Пересоздание поискового индекса

-- Дополнение --

TBD:
1. Залить на битбакет
2. Исправить - при переносе в постах должны правится showuser-ссылки
3. Исправить - кажется, я забыл обработать ситуацию, когда для картинок используется тэг [ IMG]
4. Исправить - вырезать точки в конце названий тем
5. Исправить - вырезать лишние пробелы в начале и конце постов
6. Переносить пароли (хранятся в базе punBB, как sha1($salt.sha1($str)), см include/functions.php:forum_hash, а также проверки в login.php)
7. Не переносить пользователей с нулем сообщений/тем

См также: Генератор sitemap.xml для форума на PunBB 1.3.*
См также: Как перенести почти любой форум на PunBB

2

Re: [Perl, PHP] Скрипт для переноса форума с IPB 1.3.* на punBB 1.3.*

Fix: не хватало запроса

    update ${Conf::toPrefix}users as u set last_post = (
      select max(posted) from ${Conf::toPrefix}posts as p where p.poster_id = u.id
    );