Ticket #81: sniplocales.pl

#!/usr/bin/perl -w

#
# Renames nodes from "Locale Foo" to "Foo" and sets up redirects
# (c) 2006 Dave Page. Licensed under the same terms as Perl itself
#

use strict;

use OpenGuides::Config;
use DBI;

        my $prefix = 'Locale ';         # NOTE THE SPACE

        my $config_file = $ENV{OPENGUIDES_CONFIG_FILE} || "wiki.conf";
        my $config = OpenGuides::Config->new( file => $config_file )
                or die "Couldn't open and parse config file $config_file";

        my $dsn = 'DBI:' . $config->{'dbtype'} . ':database=' . $config->{dbname};
        my $dbh = DBI->connect($dsn, $config->{'dbuser'}, $config->{'dbpass'})
                or die "Couldn't connect to database!";

        my ($statement, $sth);

        # Engage locking

        $dbh->begin_work();

        # Get a list of nodes prefixed with $prefix

        $sth = $dbh->prepare("SELECT name, text FROM content WHERE name LIKE ?");
        $sth->execute("${prefix}%");
        
        my %prefixednodes = %{ $sth->fetchall_hashref('name') };

        # Get a list of existing nodes without that prefix - these will cause conflict

        my @unprefixednodes = map { s/^${prefix}//; $_ } keys %prefixednodes;

        $statement = "SELECT name FROM content WHERE name IN ( " . join(', ', map { $dbh->quote($_) } @unprefixednodes) . " )";

        $sth = $dbh->prepare($statement);
        $sth->execute();

        my %conflictnodes = %{ $sth->fetchall_hashref('name') } ;

        # Rename all prefixed nodes which don't have conflicts

        foreach my $nodename ( @unprefixednodes ) {
                if ( exists $conflictnodes{$nodename} ) {       # We should perhaps check for a #REDIRECT here before shooting our mouths off
                        if ( $prefixednodes{"${prefix}${nodename}"}{text} eq "#REDIRECT [[$nodename]]" ) {
                                # print "Node $nodename exists, but node ${prefix}${nodename} is a #REDIRECT to it\n";
                        } else {
                                warn "CONFLICT: ${prefix}${nodename} and ${nodename} both exist!\n";
                        }
                        next;
                }

                $dbh->do("UPDATE content SET name = " . $dbh->quote($nodename) . " WHERE name = " . $dbh->quote($prefix . $nodename));
                $dbh->do("UPDATE node SET name = " . $dbh->quote($nodename) . " WHERE name = " . $dbh->quote($prefix . $nodename));
                $dbh->do("UPDATE metadata SET node = " . $dbh->quote($nodename) . " WHERE node = " . $dbh->quote($prefix . $nodename));
                $dbh->do("UPDATE internal_links SET link_from = " . $dbh->quote($nodename) . " WHERE link_from = " . $dbh->quote($prefix . $nodename));
                $dbh->do("UPDATE internal_links SET link_to = " . $dbh->quote($nodename) . " WHERE link_to = " . $dbh->quote($prefix . $nodename));

                $dbh->do("INSERT INTO content (name, version, text, modified, comment) VALUES (" . $dbh->quote($prefix.$nodename)
                        . ", 1, " . $dbh->quote("#REDIRECT [[$nodename]]") . ", NOW(), 'Automatically generated #REDIRECT' )" );
                $dbh->do("INSERT INTO node (name, version, text, modified ) VALUES (" . $dbh->quote($prefix.$nodename)
                        . ", 1, " . $dbh->quote("#REDIRECT [[$nodename]]") . ", NOW() )" );

                print "Node '${prefix}${nodename}' renamed to '$nodename'\n";
        }

        $dbh->rollback();

        $dbh->disconnect();