Changeset 431

Show
Ignore:
Timestamp:
05/11/08 17:04:41 (4 years ago)
Author:
dom
Message:

fix much tab/whitespace damage; no functional changes.

Location:
wiki-toolkit/trunk
Files:
27 modified

Legend:

Unmodified
Added
Removed

  • wiki-toolkit/trunk/Makefile.PL

    r430 r431  
    1515if ($Wiki::Toolkit::TestConfig::configured 
    1616    and not (@ARGV and $ARGV[0] eq '-s') 
    17     and not $ENV{WIKI_TOOLKIT_RERUN_CONFIG} 
    18    ) { 
     17    and not $ENV{WIKI_TOOLKIT_RERUN_CONFIG}) { 
    1918    print "\nFor the test suite, we use the database and user info\n" 
    2019        . "specified during the previous run.  If you want to change\n" 
    … …  
    3231        . "preferably relevant to the backend(s) you intend to use live.\n" 
    3332        . "Running the tests under every possible backend combination is\n" 
    34         . "recommended.  To enter an undefined value, accept the empty\n" 
     33        . "recommended.  To enter an undefined value, accept the empty\n" 
    3534        . "string or explicitly enter 'undef'.\n\n" 
    3635        . "****        THESE TESTS ARE DESTRUCTIVE.         ****\n" 
    … …  
    5352    foreach my $store (qw(MySQL Pg)) { 
    5453        my $dbname = $ENV{"WIKI_TOOLKIT_".uc($store)."_DBNAME"}; 
    55         if ($dbname and $dbname ne "undef") { 
    56             $config{$store}{dbname} = $dbname; 
     54        if ($dbname and $dbname ne "undef") { 
     55            $config{$store}{dbname} = $dbname; 
    5756            foreach my $var (qw(dbuser dbpass dbhost)) { 
    5857                my $value = $ENV{"WIKI_TOOLKIT_".uc($store)."_".uc($var)}; 
    59                 if ($value and $value ne "undef") {                 $config{$store}{$var} = $value; 
    60                 } elsif ($value eq "undef") { 
    61                     $config{$store}{$var} = undef; 
    62                 } 
    63             } 
    64         } elsif ($dbname eq "undef") { 
    65             $config{$store}{dbname} = undef; 
    66         } 
     58                if ($value and $value ne "undef") { 
     59                    $config{$store}{$var} = $value; 
     60                } elsif ($value eq "undef") { 
     61                    $config{$store}{$var} = undef; 
     62                } 
     63            } 
     64        } elsif ($dbname eq "undef") { 
     65            $config{$store}{dbname} = undef; 
     66        } 
    6767    } 
    6868 
    … …  
    7676    # Finally ask questions; then check the settings work. 
    7777    my %driver = ( MySQL => "DBD::mysql", 
    78                    Pg    => "DBD::Pg" ); 
     78                   Pg    => "DBD::Pg" ); 
    7979    foreach my $store_type (qw(MySQL Pg)) { 
    8080        # See whether we have the driver installed. 
    … …  
    8282        if ($@) { 
    8383            print "\n$driver{$store_type} not installed... skipping...\n"; 
    84             $config{$store_type}{dbname} = undef; 
    85             next; 
    86         } 
     84            $config{$store_type}{dbname} = undef; 
     85            next; 
     86        } 
    8787 
    8888        # Prompt for the options. 
    … …  
    9090        my $pad = ' ' x (7-length $store_type); 
    9191        $dbname = prompt "\n${pad}Database name for $store_type: ", 
    92                          $config{$store_type}{dbname}; 
     92                         $config{$store_type}{dbname}; 
    9393        undef $dbname unless ($dbname and $dbname ne "undef"); 
    9494        if ($dbname and $dbname ne "undef") { 
    95             $dbuser = prompt "            Database user: ", 
    96                              $config{$store_type}{dbuser}; 
     95            $dbuser = prompt "            Database user: ", 
     96                             $config{$store_type}{dbuser}; 
    9797            undef $dbuser unless ($dbuser and $dbuser ne "undef"); 
    98             $dbpass = prompt "        Database password: ", 
    99                              $config{$store_type}{dbpass}; 
     98            $dbpass = prompt "        Database password: ", 
     99                             $config{$store_type}{dbpass}; 
    100100            undef $dbpass unless ($dbpass and $dbpass ne "undef"); 
    101             $dbhost = prompt "Database host (if needed): ", 
    102                              $config{$store_type}{dbhost}; 
     101            $dbhost = prompt "Database host (if needed): ", 
     102                             $config{$store_type}{dbhost}; 
    103103            undef $dbhost unless ($dbhost and $dbhost ne "undef"); 
    104104 
    … …  
    107107            $config{$store_type}{dbpass} = $dbpass; 
    108108            $config{$store_type}{dbhost} = $dbhost; 
    109         } else { 
     109        } else { 
    110110            print "\nNo database name supplied... skipping...\n"; 
    111             $config{$store_type}{dbname} = undef; 
    112         } 
     111            $config{$store_type}{dbname} = undef; 
     112        } 
    113113    } 
    114114 
    … …  
    121121# If we have a MySQL store configured, we can test the DBIx::FullTextSearch 
    122122# search backend. 
    123 eval { require DBIx::FullTextSearch; 
    124        require Lingua::Stem; 
     123eval { 
     124    require DBIx::FullTextSearch; 
     125    require Lingua::Stem; 
    125126}; 
    126127my $fts_inst = $@ ? 0 : 1; 
    … …  
    172173# Write out the config for next run. 
    173174open OUT, ">lib/Wiki/Toolkit/TestConfig.pm" 
    174   or die "Couldn't open lib/Wiki/Toolkit/TestConfig.pm for writing: $!"; 
     175    or die "Couldn't open lib/Wiki/Toolkit/TestConfig.pm for writing: $!"; 
    175176# warning - blind copy and paste follows.  FIXME. 
    176177print OUT Data::Dumper->new([ \%Wiki::Toolkit::TestConfig::config ], 
    177                             [ '*Wiki::Toolkit::TestConfig::config' ] 
    178                            )->Dump, 
    179   "\$Wiki::Toolkit::TestConfig::configured = 1;\n1;\n"; 
     178                            [ '*Wiki::Toolkit::TestConfig::config' ] 
     179                           )->Dump, 
     180          "\$Wiki::Toolkit::TestConfig::configured = 1;\n1;\n"; 
    180181close OUT; 
    181182 
    … …  
    202203# Write the Makefile. 
    203204WriteMakefile( NAME         => "Wiki::Toolkit", 
    204                VERSION_FROM => "lib/Wiki/Toolkit.pm", 
    205                PREREQ_PM    => { 'Text::WikiFormat' => '0.78', #earlier's buggy 
    206                                  'HTML::PullParser' => 0, 
    207                                  'Digest::MD5' => 0, 
    208                                  'Test::More' => 0, 
    209                                  'Time::Piece' => 0, 
    210                                  %extras }, 
     205               VERSION_FROM => "lib/Wiki/Toolkit.pm", 
     206               PREREQ_PM    => { 'Text::WikiFormat' => '0.78', #earlier's buggy 
     207                                 'HTML::PullParser' => 0, 
     208                                 'Digest::MD5' => 0, 
     209                                 'Test::More' => 0, 
     210                                 'Time::Piece' => 0, 
     211                                 %extras 
     212                               }, 
    211213               EXE_FILES => [ "bin/wiki-toolkit-setupdb", 
    212214                              "bin/wiki-toolkit-rename-node", 
    213215                              "bin/wiki-toolkit-delete-node", 
    214                               "bin/wiki-toolkit-revert-to-date" ], 
    215                clean => { FILES => "Config lib/Wiki/Toolkit/TestConfig.pm " 
    216                                  . "t/sqlite-test.db t/sii-db-file-test.db " 
     216                              "bin/wiki-toolkit-revert-to-date" 
     217                            ], 
     218               clean => { FILES => "Config lib/Wiki/Toolkit/TestConfig.pm " 
     219                                 . "t/sqlite-test.db t/sii-db-file-test.db " 
    217220                                 . "t/node.db t/plucene" 
    218221                        } 
    219              ); 
     222             ); 

  • wiki-toolkit/trunk/bin/wiki-toolkit-delete-node

    r423 r431  
    1414            "nodename=s"     => \$node_name, 
    1515            "version=s"      => \$version, 
    16            ); 
     16          ); 
    1717 
    1818unless (defined($dbtype)) { 
    … …  
    2929 
    3030if(defined($id) and defined($node_name)) { 
    31         print "You should supply either a node name, or an id, but not both.\n"; 
    32         print "Further help can be found by typing 'perldoc $0'\n"; 
    33         exit 1; 
    34 } 
     31    print "You should supply either a node name, or an id, but not both.\n"; 
     32    print "Further help can be found by typing 'perldoc $0'\n"; 
     33    exit 1; 
     34} 
     35 
    3536if(not defined($id) and not defined($node_name)) { 
    36         print "You must supply the id of the node with the --id option,\n"; 
    37         print " or the node name of the node with the --nodename option.\n"; 
    38         print "Further help can be found by typing 'perldoc $0'\n"; 
    39         exit 1; 
     37    print "You must supply the id of the node with the --id option,\n"; 
     38    print " or the node name of the node with the --nodename option.\n"; 
     39    print "Further help can be found by typing 'perldoc $0'\n"; 
     40    exit 1; 
    4041} 
    4142 
    … …  
    4647 
    4748my %setup_modules = ( postgres => "Wiki::Toolkit::Store::Pg", 
    48                       mysql    => "Wiki::Toolkit::Store::MySQL", 
    49                       sqlite  => "Wiki::Toolkit::Store::SQLite" 
     49                      mysql    => "Wiki::Toolkit::Store::MySQL", 
     50                      sqlite  => "Wiki::Toolkit::Store::SQLite" 
    5051); 
    5152 
    … …  
    6869my $store; 
    6970my $args = "dbname=>'$dbname', dbuser=>'$dbuser'"; 
    70 if($dbpass) { $args .= ", dbpass=>'$dbpass'"; } 
    71 if($dbhost) { $args .= ", dbhost=>'$dbhost'"; } 
    72 if($dbport) { $args .= ", dbport=>'$dbport'"; } 
     71if($dbpass) { 
     72    $args .= ", dbpass=>'$dbpass'"; 
     73} 
     74if($dbhost) { 
     75    $args .= ", dbhost=>'$dbhost'"; 
     76} 
     77if($dbport) { 
     78    $args .= ", dbport=>'$dbport'"; 
     79} 
    7380eval "\$store = $class->new($args);"; 
    7481 
    … …  
    7885# If they gave the ID, get the name 
    7986if($id) { 
    80         $node_name = $wiki->store->node_name_for_id($id); 
    81         unless($node_name) { 
    82                 die("No node found with id '$id'\n"); 
    83         } 
     87    $node_name = $wiki->store->node_name_for_id($id); 
     88    unless($node_name) { 
     89        die("No node found with id '$id'\n"); 
     90    } 
    8491} 
    8592 
    … …  
    8794print "Deleting node with name '$node_name'"; 
    8895if($id) { 
    89         print " (id $id)"; 
     96    print " (id $id)"; 
    9097} 
    9198if($version) { 
    92         print " at version $version"; 
     99    print " at version $version"; 
    93100} 
    94101print "\n"; 
    … …  
    100107print "done.\n"; 
    101108 
    102  
    103109=head1 NAME 
    104110 
    … …  
    110116 
    111117  wiki-toolkit-delete-node --type postgres 
    112                    --name mywiki \ 
    113                    --user wiki  \ 
    114                    --pass wiki \ 
    115                    --host 'db.example.com' \ 
    116                    --port 1234 \ 
    117                    --nodename MyNodeName  
     118           --name mywiki \ 
     119           --user wiki  \ 
     120           --pass wiki \ 
     121           --host 'db.example.com' \ 
     122           --port 1234 \ 
     123           --nodename MyNodeName  
    118124 
    119125  wiki-toolkit-delete-node --type postgres 
    120                    --name mywiki \ 
    121                    --user wiki  \ 
    122                    --pass wiki \ 
    123                    --host 'db.example.com' \ 
    124                    --port 1234 \ 
    125                    --id 2 \ 
    126                    --version 7 
     126           --name mywiki \ 
     127           --user wiki  \ 
     128           --pass wiki \ 
     129           --host 'db.example.com' \ 
     130           --port 1234 \ 
     131           --id 2 \ 
     132           --version 7 
    127133 
    128134=head1 DESCRIPTION 

  • wiki-toolkit/trunk/bin/wiki-toolkit-rename-node

    r398 r431  
    1313            "oldname=s"      => \$oldname, 
    1414            "newname=s"      => \$newname, 
    15            ); 
     15          ); 
    1616 
    1717unless (defined($dbtype)) { 
    … …  
    2828 
    2929unless (defined($oldname)) { 
    30         print "You must supply the old node name with the --oldname option.\n"; 
    31         print "Further help can be found by typing 'perldoc $0'\n"; 
    32         exit 1; 
     30    print "You must supply the old node name with the --oldname option.\n"; 
     31    print "Further help can be found by typing 'perldoc $0'\n"; 
     32    exit 1; 
    3333} 
    3434 
    3535unless (defined($newname)) { 
    36         print "You must supply the new node name with the --newname option.\n"; 
    37         print "Further help can be found by typing 'perldoc $0'\n"; 
    38         exit 1; 
     36    print "You must supply the new node name with the --newname option.\n"; 
     37    print "Further help can be found by typing 'perldoc $0'\n"; 
     38    exit 1; 
    3939} 
    4040 
    … …  
    4545 
    4646my %setup_modules = ( postgres => "Wiki::Toolkit::Store::Pg", 
    47                       mysql    => "Wiki::Toolkit::Store::MySQL", 
    48                       sqlite  => "Wiki::Toolkit::Store::SQLite" 
     47                      mysql    => "Wiki::Toolkit::Store::MySQL", 
     48                      sqlite  => "Wiki::Toolkit::Store::SQLite" 
    4949); 
    5050 
    … …  
    6767my $store; 
    6868my $args = "dbname=>'$dbname', dbuser=>'$dbuser'"; 
    69 if($dbpass) { $args .= ", dbpass=>'$dbpass'"; } 
    70 if($dbhost) { $args .= ", dbhost=>'$dbhost'"; } 
    71 if($dbport) { $args .= ", dbport=>'$dbport'"; } 
     69if($dbpass) { 
     70    $args .= ", dbpass=>'$dbpass'"; 
     71} 
     72if($dbhost) { 
     73    $args .= ", dbhost=>'$dbhost'"; 
     74} 
     75if($dbport) { 
     76    $args .= ", dbport=>'$dbport'"; 
     77} 
    7278eval "\$store = $class->new($args);"; 
    7379 
    … …  
    8187print "Renamed '$oldname' to '$newname'\n"; 
    8288 
    83  
    8489=head1 NAME 
    8590 
    … …  
    9297 
    9398  wiki-toolkit-rename-node --type postgres 
    94                    --name mywiki \ 
    95                    --user wiki  \ 
    96                    --pass wiki \ 
    97                    --host 'db.example.com' \ 
    98                    --port 1234 
    99                    --oldname MyOldNodeName \ 
    100                    --nemname FancyNewNodeName 
     99           --name mywiki \ 
     100           --user wiki  \ 
     101           --pass wiki \ 
     102           --host 'db.example.com' \ 
     103           --port 1234 
     104           --oldname MyOldNodeName \ 
     105           --nemname FancyNewNodeName 
    101106 
    102107=head1 DESCRIPTION 

  • wiki-toolkit/trunk/bin/wiki-toolkit-revert-to-date

    r397 r431  
    1313            "date=s"         => \$date, 
    1414            "time=s"         => \$time, 
    15            ); 
     15          ); 
    1616 
    1717unless (defined($dbtype)) { 
    … …  
    2828 
    2929unless (defined($date)) { 
    30         print "You must supply the date with the --date option.\n"; 
    31         print "Further help can be found by typing 'perldoc $0'\n"; 
    32         exit 1; 
     30    print "You must supply the date with the --date option.\n"; 
     31    print "Further help can be found by typing 'perldoc $0'\n"; 
     32    exit 1; 
    3333} 
    3434 
    3535unless ($date =~ /^\d{4}\-\d{2}\-\d{2}$/) { 
    36         print "You must supply the date with --date in the format YYYY-MM-DD.\n"; 
    37         print "Further help can be found by typing 'perldoc $0'\n"; 
    38         exit 1; 
     36    print "You must supply the date with --date in the format YYYY-MM-DD.\n"; 
     37    print "Further help can be found by typing 'perldoc $0'\n"; 
     38    exit 1; 
    3939} 
    4040unless (!$time || $time =~ /^\d{2}:\d{2}:\d{2}$/) { 
    41         print "You must supply either no time, or the time in the format HH:MM:SS.\n"; 
    42         print "Further help can be found by typing 'perldoc $0'\n"; 
    43         exit 1; 
     41    print "You must supply either no time, or the time in the format HH:MM:SS.\n"; 
     42    print "Further help can be found by typing 'perldoc $0'\n"; 
     43    exit 1; 
    4444} 
    4545 
    … …  
    5050 
    5151my %setup_modules = ( postgres => "Wiki::Toolkit::Store::Pg", 
    52                       mysql    => "Wiki::Toolkit::Store::MySQL", 
    53                       sqlite  => "Wiki::Toolkit::Store::SQLite" 
     52                      mysql    => "Wiki::Toolkit::Store::MySQL", 
     53                      sqlite  => "Wiki::Toolkit::Store::SQLite" 
    5454); 
    5555 
    … …  
    7272my $store; 
    7373my $args = "dbname=>'$dbname', dbuser=>'$dbuser'"; 
    74 if($dbpass) { $args .= ", dbpass=>'$dbpass'"; } 
    75 if($dbhost) { $args .= ", dbhost=>'$dbhost'"; } 
    76 if($dbport) { $args .= ", dbport=>'$dbport'"; } 
     74if($dbpass) { 
     75    $args .= ", dbpass=>'$dbpass'"; 
     76} 
     77if($dbhost) { 
     78    $args .= ", dbhost=>'$dbhost'"; 
     79} 
     80if($dbport) { 
     81    $args .= ", dbport=>'$dbport'"; 
     82} 
    7783eval "\$store = $class->new($args);"; 
    7884 
    … …  
    8187 
    8288# Grab the state as of then 
    83 if($time) { $date .= " ".$time; } 
     89if($time) { 
     90    $date .= " ".$time; 
     91} 
    8492print "Reverting to the state as of $date\n"; 
    8593 
    8694my @nodes = $wiki->list_last_version_before($date); 
    8795foreach my $node (@nodes) { 
    88         my %newnode = $wiki->retrieve_node($node->{name}); 
    89         my $thenver = $node->{version}; 
    90         if($thenver) { $thenver = sprintf("v%02d", $thenver); } 
    91         else         { $thenver = "(d)"; } 
    92  
    93         print sprintf('  %03d  - %s (now v%02d) - %s', $node->{id}, $thenver, $newnode{version}, $node->{name})."\n"; 
     96    my %newnode = $wiki->retrieve_node($node->{name}); 
     97    my $thenver = $node->{version}; 
     98    if($thenver) { 
     99        $thenver = sprintf("v%02d", $thenver); } 
     100    else { 
     101        $thenver = "(d)"; 
     102    } 
     103 
     104    print sprintf('  %03d  - %s (now v%02d) - %s', $node->{id}, $thenver, $newnode{version}, $node->{name})."\n"; 
    94105} 
    95106 
    … …  
    98109chomp $ok; 
    99110unless($ok eq "y") { 
    100         die("Aborting revert\n"); 
     111    die("Aborting revert\n"); 
    101112} 
    102113 
    103114# Revert each node 
    104115foreach my $node (@nodes) { 
    105         if($node->{version}) { 
    106                 # Delete versions between now and then 
    107                 my %newnode = $wiki->retrieve_node($node->{name}); 
    108                 for(my $ver=$newnode{version}; $ver>$node->{version}; $ver--) { 
    109                         $wiki->delete_node( 
    110                                                         name=>$node->{name},  
    111                                                         version=>$ver, 
    112                                                         wiki=>$wiki 
    113                         ); 
    114                         print sprintf('Deleted node v%02d of %03d - %s',$ver, $node->{id},$node->{name})."\n"; 
    115                 } 
    116         } else { 
    117                 # No version then, delete 
    118                 $wiki->delete_node( 
    119                                                         name=>$node->{name}, 
    120                                                         wiki=>$wiki 
    121                 ); 
    122                 print sprintf('Deleted node %03d - %s',$node->{id},$node->{name})."\n"; 
    123         } 
     116    if($node->{version}) { 
     117        # Delete versions between now and then 
     118        my %newnode = $wiki->retrieve_node($node->{name}); 
     119        for (my $ver=$newnode{version}; $ver>$node->{version}; $ver--) { 
     120            $wiki->delete_node( 
     121                                name=>$node->{name},  
     122                                version=>$ver, 
     123                                wiki=>$wiki 
     124            ); 
     125            print sprintf('Deleted node v%02d of %03d - %s',$ver, $node->{id},$node->{name})."\n"; 
     126        } 
     127    } else { 
     128        # No version then, delete 
     129        $wiki->delete_node( 
     130                            name=>$node->{name}, 
     131                            wiki=>$wiki 
     132        ); 
     133        print sprintf('Deleted node %03d - %s',$node->{id},$node->{name})."\n"; 
     134    } 
    124135} 
    125136 
    … …  
    127138print "\nDone revert to $date\n"; 
    128139 
    129  
    130140=head1 NAME 
    131141 
    … …  
    138148 
    139149  wiki-toolkit-revert-to-date --type postgres 
    140                    --name mywiki \ 
    141                    --user wiki  \ 
    142                    --pass wiki \ 
    143                    --host 'db.example.com' \ 
    144                    --port 1234 \ 
    145                    --date 2007-01-05 \ 
    146                    --time 11:23:21 
     150           --name mywiki \ 
     151           --user wiki  \ 
     152           --pass wiki \ 
     153           --host 'db.example.com' \ 
     154           --port 1234 \ 
     155           --date 2007-01-05 \ 
     156           --time 11:23:21 
    147157 
    148158=head1 DESCRIPTION 

  • wiki-toolkit/trunk/bin/wiki-toolkit-setupdb

    r235 r431  
    55my ($dbtype, $dbname, $dbuser, $dbpass, $dbhost, $help, $preclear); 
    66GetOptions( "type=s"         => \$dbtype, 
    7             "name=s"         => \$dbname, 
     7            "name=s"         => \$dbname, 
    88            "user=s"         => \$dbuser, 
    99            "pass=s"         => \$dbpass, 
    … …  
    1111            "help"           => \$help, 
    1212            "force-preclear" => \$preclear 
    13            ); 
     13          ); 
    1414 
    1515unless (defined($dbtype)) { 
    … …  
    3131 
    3232my %setup_modules = ( postgres => "Wiki::Toolkit::Setup::Pg", 
    33                       mysql    => "Wiki::Toolkit::Setup::MySQL", 
    34                       sqlite  => "Wiki::Toolkit::Setup::SQLite" 
     33                      mysql    => "Wiki::Toolkit::Setup::MySQL", 
     34                      sqlite  => "Wiki::Toolkit::Setup::SQLite" 
    3535); 
    3636 
    … …  
    6969 
    7070  wiki-toolkit-setupdb --type postgres 
    71                    --name mywiki \ 
    72                    --user wiki  \ 
    73                    --pass wiki \ 
    74                    --host 'db.example.com' 
     71                       --name mywiki \ 
     72                       --user wiki  \ 
     73                       --pass wiki \ 
     74                       --host 'db.example.com' 
    7575 
    7676  # Clear out any existing data and set up a fresh backend from scratch. 
    7777 
    7878  wiki-toolkit-setupdb --type postgres 
    79                    --name mywiki \ 
    80                    --user wiki  \ 
    81                    --pass wiki  \ 
    82                    --force-preclear 
     79                       --name mywiki \ 
     80                       --user wiki  \ 
     81                       --pass wiki  \ 
     82                       --force-preclear 
    8383 
    8484=head1 DESCRIPTION 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit.pm

    r424 r431  
    1515my $CAN_USE_ENCODE; 
    1616BEGIN { 
    17   eval " use Encode "; 
    18   $CAN_USE_ENCODE = $@ ? 0 : 1; 
    19 } 
    20  
     17    eval " use Encode "; 
     18    $CAN_USE_ENCODE = $@ ? 0 : 1; 
     19} 
    2120 
    2221=head1 NAME 
    … …  
    4544 
    4645  my $wiki      = Wiki::Toolkit->new( store     => $store, 
    47                                   search    => $search ); 
     46                                      search    => $search ); 
    4847 
    4948  # Do all the CGI stuff. 
    … …  
    5655      my $cooked = $wiki->format($raw); 
    5756      print_page(node    => $node, 
    58                 content => $cooked); 
     57                content => $cooked); 
    5958  } elsif ($action eq 'preview') { 
    6059      my $submitted_content = $q->param("content"); 
    6160      my $preview_html      = $wiki->format($submitted_content); 
    6261      print_editform(node    => $node, 
    63                      content => $submitted_content, 
    64                      preview => $preview_html); 
     62                     content => $submitted_content, 
     63                     preview => $preview_html); 
    6564  } elsif ($action eq 'commit') { 
    6665      my $submitted_content = $q->param("content"); 
    … …  
    142141           . "of Wiki::Toolkit - the $obsolete_param parameter is no longer used. " 
    143142           . "Please read the documentation with 'perldoc Wiki::Toolkit'" 
    144           if $args{$obsolete_param}; 
     143            if $args{$obsolete_param}; 
    145144    } 
    146145 
    … …  
    158157        my %config; 
    159158        foreach ( qw( extended_links implicit_links allowed_tags 
    160                     macros node_prefix ) ) { 
     159            macros node_prefix ) ) { 
    161160            $config{$_} = $args{$_} if defined $args{$_}; 
    162         } 
     161    } 
    163162        $self->{_formatter} = Wiki::Toolkit::Formatter::Default->new( %config ); 
    164163    } 
    … …  
    219218    my ($self, @rawargs) = @_; 
    220219 
    221         my %args = scalar @rawargs == 1 ? ( name => $rawargs[0] ) : @rawargs; 
     220    my %args = scalar @rawargs == 1 ? ( name => $rawargs[0] ) : @rawargs; 
    222221 
    223222    my @plugins = $self->get_registered_plugins; 
    … …  
    243242 
    244243    my $ret = $self->store->moderate_node( %args ); 
    245         if($ret == -1) { return $ret; } 
    246         return 1; 
     244    if($ret == -1) { return $ret; } 
     245    return 1; 
    247246} 
    248247 
    … …  
    278277sub rename_node { 
    279278    my ($self, @argsarray) = @_; 
    280         my %args = @argsarray; 
    281         if((scalar @argsarray) == 2 || (scalar @argsarray) == 3) { 
    282                 # Missing keys 
    283                 %args = ( 
    284                         old_name => $argsarray[0], 
    285                         new_name => $argsarray[1], 
    286                         create_new_versions => $argsarray[2] 
    287                 ); 
    288         } 
     279    my %args = @argsarray; 
     280    if ((scalar @argsarray) == 2 || (scalar @argsarray) == 3) { 
     281        # Missing keys 
     282        %args = ( 
     283            old_name => $argsarray[0], 
     284            new_name => $argsarray[1], 
     285            create_new_versions => $argsarray[2] 
     286        ); 
     287    } 
    289288 
    290289    my @plugins = $self->get_registered_plugins; 
    291290    $args{plugins} = \@plugins if scalar @plugins; 
    292         $args{wiki} = $self; 
     291    $args{wiki} = $self; 
    293292 
    294293    my $ret = $self->store->rename_node( %args ); 
    295294 
    296         if($ret && $ret == -1) { return $ret; } 
    297         return 1; 
     295    if ($ret && $ret == -1) { 
     296        return $ret; 
     297    } 
     298    return 1; 
    298299} 
    299300 
    … …  
    450451  my @nodes = $wiki->list_unmoderated_nodes(); 
    451452  my @nodes = $wiki->list_unmoderated_nodes( 
    452                                                                                                 only_where_latest => 1 
    453                                                                                         ); 
     453                                                only_where_latest => 1 
     454                                            ); 
    454455 
    455456  $nodes[0]->{'name'}              # The name of the node 
    … …  
    502503 
    503504=item B<list_last_version_before> 
    504         List the last version of every node before a given date. 
    505         If no version existed before that date, will return undef for version. 
    506         Returns a hash of id, name, version and date 
    507  
    508         my @nv = $wiki->list_last_version_before('2007-01-02 10:34:11') 
    509         foreach my $data (@nv) { 
    510                  
    511         } 
     505    List the last version of every node before a given date. 
     506    If no version existed before that date, will return undef for version. 
     507    Returns a hash of id, name, version and date 
     508 
     509    my @nv = $wiki->list_last_version_before('2007-01-02 10:34:11') 
     510    foreach my $data (@nv) { 
     511         
     512    } 
    512513 
    513514=cut 
    … …  
    515516sub list_last_version_before { 
    516517    my ($self,@argsarray) = @_; 
    517  
    518518    return $self->store->list_last_version_before(@argsarray); 
    519519} 
    … …  
    557557 
    558558    # Return false if it doesn't exist 
    559     unless(%node) { return 0; } 
    560     unless($node{node_requires_moderation}) { return 0; } 
     559    unless(%node) { 
     560        return 0; 
     561    } 
     562    unless($node{node_requires_moderation}) { 
     563        return 0; 
     564    } 
    561565 
    562566    # Otherwise return the state of the flag 
    … …  
    587591 
    588592    my @plugins = $self->get_registered_plugins; 
    589         my $plugins_ref = \@plugins if scalar @plugins; 
     593    my $plugins_ref = \@plugins if scalar @plugins; 
    590594 
    591595    return 1 unless $self->node_exists( $args{name} ); 
    … …  
    604608        if ( $new_current_content ) { 
    605609            $search->index_node( $args{name}, $new_current_content ); 
    606         } 
     610        } 
    607611    } 
    608612 
    … …  
    831835 
    832836    my %data = ( node     => $node, 
    833                 content  => $content, 
    834                 checksum => $checksum, 
    835                 metadata => $metadata, 
    836                 requires_moderation => $requires_moderation ); 
     837        content  => $content, 
     838        checksum => $checksum, 
     839        metadata => $metadata, 
     840        requires_moderation => $requires_moderation ); 
    837841    $data{links_to} = \@links_to if scalar @links_to; 
    838842    my @plugins = $self->get_registered_plugins; 
    … …  
    841845    my $store = $self->store; 
    842846    my $ret = $store->check_and_write_node( %data ) or return 0; 
    843         if($ret == -1) { return -1; } 
     847    if($ret == -1) { 
     848        return -1; 
     849    } 
    844850 
    845851    my $search = $self->{_search}; 
    … …  
    871877    # see http://rt.cpan.org/NoAuth/Bug.html?id=7014 
    872878    if ($CAN_USE_ENCODE) { 
    873       if (Encode::is_utf8($raw)) { 
    874         Encode::_utf8_on( $result ); 
    875       } 
     879        if (Encode::is_utf8($raw)) { 
     880            Encode::_utf8_on( $result ); 
     881        } 
    876882    } 
    877883 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Feed/Atom.pm

    r425 r431  
    1414@ISA = qw( Wiki::Toolkit::Feed::Listing ); 
    1515 
    16 sub new 
    17 { 
    18   my $class = shift; 
    19   my $self  = {}; 
    20   bless $self, $class; 
    21  
    22   my %args = @_; 
    23   my $wiki = $args{wiki}; 
    24  
    25   unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) 
    26   { 
    27     croak 'No Wiki::Toolkit object supplied'; 
    28   } 
    29    
    30   $self->{wiki} = $wiki; 
    31    
    32   # Mandatory arguments. 
    33   foreach my $arg (qw/site_name site_url make_node_url atom_link/) 
    34   { 
    35     croak "No $arg supplied" unless $args{$arg}; 
    36     $self->{$arg} = $args{$arg}; 
    37   } 
    38  
    39   # Must-supply-one-of arguments 
    40   my %mustoneof = ( 'html_equiv_link' => ['html_equiv_link','recent_changes_link'] ); 
    41   $self->handle_supply_one_of(\%mustoneof,\%args); 
    42    
    43   # Optional arguments. 
    44   foreach my $arg (qw/site_description software_name software_version software_homepage encoding/) 
    45   { 
    46     $self->{$arg} = $args{$arg} || ''; 
    47   } 
    48  
    49   # Supply some defaults, if a blank string isn't what we want 
    50   unless($self->{encoding}) { 
    51     $self->{encoding} = $self->{wiki}->store->{_charset}; 
    52   } 
    53  
    54   $self->{timestamp_fmt} = $Wiki::Toolkit::Store::Database::timestamp_fmt; 
    55   $self->{utc_offset} = strftime "%z", localtime; 
    56   $self->{utc_offset} =~ s/(..)(..)$/$1:$2/; 
    57    
    58   # Escape any &'s in the urls 
    59   foreach my $key qw(site_url atom_link) { 
    60      my @ands = ($self->{$key} =~ /(\&.{1,6})/g); 
    61      foreach my $and (@ands) { 
    62         if($and ne "&amp;") { 
    63             my $new_and = $and; 
    64             $new_and =~ s/\&/\&amp;/; 
    65             $self->{$key} =~ s/$and/$new_and/; 
     16sub new { 
     17    my $class = shift; 
     18    my $self  = {}; 
     19    bless $self, $class; 
     20 
     21    my %args = @_; 
     22    my $wiki = $args{wiki}; 
     23 
     24    unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) { 
     25        croak 'No Wiki::Toolkit object supplied'; 
     26    } 
     27   
     28    $self->{wiki} = $wiki; 
     29   
     30    # Mandatory arguments. 
     31    foreach my $arg (qw/site_name site_url make_node_url atom_link/) { 
     32        croak "No $arg supplied" unless $args{$arg}; 
     33        $self->{$arg} = $args{$arg}; 
     34    } 
     35 
     36    # Must-supply-one-of arguments 
     37    my %mustoneof = ( 'html_equiv_link' => ['html_equiv_link','recent_changes_link'] ); 
     38    $self->handle_supply_one_of(\%mustoneof,\%args); 
     39   
     40    # Optional arguments. 
     41    foreach my $arg (qw/site_description software_name software_version software_homepage encoding/) { 
     42        $self->{$arg} = $args{$arg} || ''; 
     43    } 
     44 
     45    # Supply some defaults, if a blank string isn't what we want 
     46    unless($self->{encoding}) { 
     47        $self->{encoding} = $self->{wiki}->store->{_charset}; 
     48    } 
     49 
     50    $self->{timestamp_fmt} = $Wiki::Toolkit::Store::Database::timestamp_fmt; 
     51    $self->{utc_offset} = strftime "%z", localtime; 
     52    $self->{utc_offset} =~ s/(..)(..)$/$1:$2/; 
     53   
     54    # Escape any &'s in the urls 
     55    foreach my $key qw(site_url atom_link) { 
     56        my @ands = ($self->{$key} =~ /(\&.{1,6})/g); 
     57        foreach my $and (@ands) { 
     58            if($and ne "&amp;") { 
     59                my $new_and = $and; 
     60                $new_and =~ s/\&/\&amp;/; 
     61                $self->{$key} =~ s/$and/$new_and/; 
     62            } 
    6663        } 
    67      } 
    68   } 
    69  
    70   $self; 
     64    } 
     65 
     66    $self; 
    7167} 
    7268 
    … …  
    7975 
    8076sub build_feed_start { 
    81   my ($self,$atom_timestamp) = @_; 
    82  
    83   my $generator = ''; 
    84    
    85   if ($self->{software_name}) 
    86   { 
    87     $generator  = '  <generator'; 
    88     $generator .= ' uri="' . $self->{software_homepage} . '"'   if $self->{software_homepage}; 
    89     $generator .= ' version=' . $self->{software_version} . '"' if $self->{software_version}; 
    90     $generator .= ">\n"; 
    91     $generator .= $self->{software_name} . "</generator>\n"; 
    92   }                           
    93  
    94   my $subtitle = $self->{site_description} 
     77    my ($self,$atom_timestamp) = @_; 
     78 
     79    my $generator = ''; 
     80   
     81    if ($self->{software_name}) { 
     82        $generator  = '  <generator'; 
     83        $generator .= ' uri="' . $self->{software_homepage} . '"'   if $self->{software_homepage}; 
     84        $generator .= ' version=' . $self->{software_version} . '"' if $self->{software_version}; 
     85        $generator .= ">\n"; 
     86        $generator .= $self->{software_name} . "</generator>\n"; 
     87    }                           
     88 
     89    my $subtitle = $self->{site_description} 
    9590                 ? '<subtitle>' . $self->{site_description} . "</subtitle>\n" 
    9691                 : ''; 
    9792 
    98   $atom_timestamp ||= ''; 
    99  
    100   my $atom = qq{<?xml version="1.0" encoding="} . $self->{encoding} . qq{"?> 
     93    $atom_timestamp ||= ''; 
     94 
     95    my $atom = qq{<?xml version="1.0" encoding="} . $self->{encoding} . qq{"?> 
    10196 
    10297<feed  
    … …  
    113108  $subtitle}; 
    114109   
    115   return $atom; 
     110    return $atom; 
    116111} 
    117112 
    … …  
    135130 
    136131sub generate_node_list_feed { 
    137   my ($self,$atom_timestamp,@nodes) = @_; 
    138  
    139   my $atom = $self->build_feed_start($atom_timestamp); 
    140  
    141   my (@urls, @items); 
    142  
    143   foreach my $node (@nodes) 
    144   { 
    145     my $node_name = $node->{name}; 
    146  
    147     my $item_timestamp = $node->{last_modified}; 
     132    my ($self,$atom_timestamp,@nodes) = @_; 
     133 
     134    my $atom = $self->build_feed_start($atom_timestamp); 
     135 
     136    my (@urls, @items); 
     137 
     138    foreach my $node (@nodes) { 
     139        my $node_name = $node->{name}; 
     140 
     141        my $item_timestamp = $node->{last_modified}; 
    148142     
    149     # Make a Time::Piece object. 
    150     my $time = Time::Piece->strptime($item_timestamp, $self->{timestamp_fmt}); 
    151  
    152     my $utc_offset = $self->{utc_offset}; 
     143        # Make a Time::Piece object. 
     144        my $time = Time::Piece->strptime($item_timestamp, $self->{timestamp_fmt}); 
     145 
     146        my $utc_offset = $self->{utc_offset}; 
    153147     
    154     $item_timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
    155  
    156     my $author      = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || 'Anonymous'; 
    157     my $description = $node->{metadata}{comment}[0]  || 'No description given for node'; 
    158  
    159     $description .= " [$author]" if $author; 
    160  
    161     my $version = $node->{version}; 
    162     my $status  = (1 == $version) ? 'new' : 'updated'; 
    163  
    164     my $major_change = $node->{metadata}{major_change}[0]; 
    165        $major_change = 1 unless defined $major_change; 
    166     my $importance = $major_change ? 'major' : 'minor'; 
    167  
    168     my $url = $self->{make_node_url}->($node_name, $version); 
    169  
    170     # make XML-clean 
    171     my $title =  $node_name; 
    172        $title =~ s/&/&amp;/g; 
    173        $title =~ s/</&lt;/g; 
    174        $title =~ s/>/&gt;/g; 
    175  
    176     # Pop the categories into atom:category elements (4.2.2) 
    177     # We can do this because the spec says: 
    178     #   "This specification assigns no meaning to the content (if any)  
    179     #    of this element." 
    180     # TODO: Decide if we should include the "all categories listing" url 
    181     #        as the scheme (URI) attribute? 
    182     my $category_atom = ""; 
    183     if($node->{metadata}->{category}) { 
    184         foreach my $cat (@{ $node->{metadata}->{category} }) { 
    185             $category_atom .= "    <category term=\"$cat\" />\n"; 
     148        $item_timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
     149 
     150        my $author      = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || 'Anonymous'; 
     151        my $description = $node->{metadata}{comment}[0]  || 'No description given for node'; 
     152 
     153        $description .= " [$author]" if $author; 
     154 
     155        my $version = $node->{version}; 
     156        my $status  = (1 == $version) ? 'new' : 'updated'; 
     157 
     158        my $major_change = $node->{metadata}{major_change}[0]; 
     159        $major_change = 1 unless defined $major_change; 
     160        my $importance = $major_change ? 'major' : 'minor'; 
     161 
     162        my $url = $self->{make_node_url}->($node_name, $version); 
     163 
     164        # make XML-clean 
     165        my $title =  $node_name; 
     166        $title =~ s/&/&amp;/g; 
     167        $title =~ s/</&lt;/g; 
     168        $title =~ s/>/&gt;/g; 
     169 
     170        # Pop the categories into atom:category elements (4.2.2) 
     171        # We can do this because the spec says: 
     172        #   "This specification assigns no meaning to the content (if any)  
     173        #    of this element." 
     174        # TODO: Decide if we should include the "all categories listing" url 
     175        #        as the scheme (URI) attribute? 
     176        my $category_atom = ""; 
     177        if ($node->{metadata}->{category}) { 
     178            foreach my $cat (@{ $node->{metadata}->{category} }) { 
     179                $category_atom .= "    <category term=\"$cat\" />\n"; 
     180            } 
    186181        } 
    187     } 
    188  
    189     # Include geospacial data, if we have it 
    190     my $geo_atom = $self->format_geo($node->{metadata}); 
    191  
    192     # TODO: Find an Atom equivalent of ModWiki, so we can include more info 
     182 
     183        # Include geospacial data, if we have it 
     184        my $geo_atom = $self->format_geo($node->{metadata}); 
     185 
     186        # TODO: Find an Atom equivalent of ModWiki, so we can include more info 
    193187 
    194188     
    195     push @items, qq{ 
     189        push @items, qq{ 
    196190  <entry> 
    197191    <title>$title</title> 
    … …  
    206200}; 
    207201 
    208   } 
    209    
    210   $atom .= join('', @items) . "\n"; 
    211   $atom .= $self->build_feed_end($atom_timestamp); 
    212  
    213   return $atom;    
     202    } 
     203   
     204    $atom .= join('', @items) . "\n"; 
     205    $atom .= $self->build_feed_end($atom_timestamp); 
     206 
     207    return $atom;    
    214208} 
    215209 
    … …  
    224218 
    225219sub generate_node_name_distance_feed { 
    226   my ($self,$atom_timestamp,@nodes) = @_; 
    227  
    228   my $atom = $self->build_feed_start($atom_timestamp); 
    229  
    230   my (@urls, @items); 
    231  
    232   foreach my $node (@nodes) 
    233   { 
    234     my $node_name = $node->{name}; 
    235  
    236     my $url = $self->{make_node_url}->($node_name); 
    237  
    238     # make XML-clean 
    239     my $title =  $node_name; 
    240        $title =~ s/&/&amp;/g; 
    241        $title =~ s/</&lt;/g; 
    242        $title =~ s/>/&gt;/g; 
    243  
    244     # What location stuff do we have? 
    245     my $geo_atom = $self->format_geo($node); 
    246  
    247     push @items, qq{ 
     220    my ($self,$atom_timestamp,@nodes) = @_; 
     221 
     222    my $atom = $self->build_feed_start($atom_timestamp); 
     223 
     224    my (@urls, @items); 
     225 
     226    foreach my $node (@nodes) { 
     227        my $node_name = $node->{name}; 
     228 
     229        my $url = $self->{make_node_url}->($node_name); 
     230 
     231        # make XML-clean 
     232        my $title =  $node_name; 
     233        $title =~ s/&/&amp;/g; 
     234        $title =~ s/</&lt;/g; 
     235        $title =~ s/>/&gt;/g; 
     236 
     237        # What location stuff do we have? 
     238        my $geo_atom = $self->format_geo($node); 
     239 
     240        push @items, qq{ 
    248241  <entry> 
    249242    <title>$title</title> 
    … …  
    254247}; 
    255248 
    256   } 
    257    
    258   $atom .= join('', @items) . "\n"; 
    259   $atom .= $self->build_feed_end($atom_timestamp); 
    260  
    261   return $atom;    
     249    } 
     250   
     251    $atom .= join('', @items) . "\n"; 
     252    $atom .= $self->build_feed_end($atom_timestamp); 
     253 
     254    return $atom;    
    262255} 
    263256 
    … …  
    269262=cut 
    270263 
    271 sub feed_timestamp 
    272 { 
    273   my ($self, $newest_node) = @_; 
    274    
    275   my $time; 
    276   if ($newest_node->{last_modified}) 
    277   { 
    278     $time = Time::Piece->strptime( $newest_node->{last_modified}, $self->{timestamp_fmt} ); 
    279   } else { 
    280     $time = localtime; 
    281   } 
    282  
    283   my $utc_offset = $self->{utc_offset}; 
     264sub feed_timestamp { 
     265    my ($self, $newest_node) = @_; 
     266   
     267    my $time; 
     268    if ($newest_node->{last_modified}) { 
     269        $time = Time::Piece->strptime( $newest_node->{last_modified}, $self->{timestamp_fmt} ); 
     270    } else { 
     271        $time = localtime; 
     272    } 
     273 
     274    my $utc_offset = $self->{utc_offset}; 
    284275     
    285   return $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
     276    return $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
    286277} 
    287278 
    … …  
    416407                     'About This Wiki', 
    417408                     'blah blah blah', 
    418                                  $checksum, 
    419                            { 
    420                        comment  => 'Stub page, please update!', 
    421                                    username => 'Fred', 
    422                      } 
     409                         $checksum, 
     410                         { 
     411                           comment  => 'Stub page, please update!', 
     412                           username => 'Fred', 
     413                         } 
    423414  ); 
    424415 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Feed/Listing.pm

    r424 r431  
    103103=cut 
    104104 
    105 sub recent_changes 
    106 { 
     105sub recent_changes { 
    107106    my ($self, %args) = @_; 
    108107 
    … …  
    114113    my $feed = $self->generate_node_list_feed($feed_timestamp, @changes); 
    115114 
    116     if($args{'also_return_timestamp'}) { 
     115    if ($args{'also_return_timestamp'}) { 
    117116        return ($feed,$feed_timestamp); 
    118117    } else { 
    … …  
    131130=cut 
    132131 
    133 sub node_all_versions 
    134 { 
     132sub node_all_versions { 
    135133    my ($self, %args) = @_; 
    136134 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Feed/RSS.pm

    r425 r431  
    1414@ISA = qw( Wiki::Toolkit::Feed::Listing ); 
    1515 
    16 sub new 
    17 { 
     16sub new { 
    1817    my $class = shift; 
    1918    my $self  = {}; 
    … …  
    2322    my $wiki = $args{wiki}; 
    2423 
    25     unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) 
    26     { 
     24    unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) { 
    2725        croak 'No Wiki::Toolkit object supplied'; 
    2826    } 
    … …  
    3129   
    3230    # Mandatory arguments. 
    33     foreach my $arg (qw/site_name site_url make_node_url/) 
    34     { 
     31    foreach my $arg (qw/site_name site_url make_node_url/) { 
    3532        croak "No $arg supplied" unless $args{$arg}; 
    3633        $self->{$arg} = $args{$arg}; 
    … …  
    4239   
    4340    # Optional arguments. 
    44     foreach my $arg (qw/site_description interwiki_identifier make_diff_url make_history_url encoding 
    45                         software_name software_version software_homepage/) 
    46     { 
     41    foreach my $arg (qw/site_description interwiki_identifier make_diff_url make_history_url encoding software_name software_version software_homepage/) { 
    4742        $self->{$arg} = $args{$arg} || ''; 
    4843    } 
    … …  
    6863 
    6964sub build_feed_start { 
    70   my ($self,$feed_timestamp) = @_; 
    71  
    72   #"http://purl.org/rss/1.0/modules/wiki/" 
    73   return qq{<?xml version="1.0" encoding="}. $self->{encoding} .qq{"?> 
     65    my ($self,$feed_timestamp) = @_; 
     66 
     67    #"http://purl.org/rss/1.0/modules/wiki/" 
     68    return qq{<?xml version="1.0" encoding="}. $self->{encoding} .qq{"?> 
    7469 
    7570<rdf:RDF 
    … …  
    9893    my $rss .= qq{<dc:publisher>} . $self->{site_url} . qq{</dc:publisher>\n}; 
    9994 
    100 if ($self->{software_name}) 
    101 { 
    102   $rss .= qq{<foaf:maker> 
    103   <doap:Project> 
    104     <doap:name>} . $self->{software_name} . qq{</doap:name>\n}; 
    105 } 
    106  
    107 if ($self->{software_name} && $self->{software_homepage}) 
    108 { 
    109   $rss .= qq{    <doap:homepage rdf:resource="} . $self->{software_homepage} . qq{" />\n}; 
    110 } 
    111  
    112 if ($self->{software_name} && $self->{software_version}) 
    113 { 
    114   $rss .= qq{    <doap:release> 
     95    if ($self->{software_name}) { 
     96        $rss .= qq{<foaf:maker> 
     97        <doap:Project> 
     98        <doap:name>} . $self->{software_name} . qq{</doap:name>\n}; 
     99    } 
     100 
     101    if ($self->{software_name} && $self->{software_homepage}) { 
     102        $rss .= qq{    <doap:homepage rdf:resource="} . $self->{software_homepage} . qq{" />\n}; 
     103    } 
     104 
     105    if ($self->{software_name} && $self->{software_version}) { 
     106        $rss .= qq{    <doap:release> 
    115107      <doap:Version> 
    116         <doap:revision>} . $self->{software_version} . qq{</doap:revision> 
     108      <doap:revision>} . $self->{software_version} . qq{</doap:revision> 
    117109      </doap:Version> 
    118110    </doap:release>\n}; 
    119 } 
    120  
    121 if ($self->{software_name}) 
    122 { 
    123   $rss .= qq{  </doap:Project> 
     111    } 
     112 
     113    if ($self->{software_name}) { 
     114        $rss .= qq{  </doap:Project> 
    124115</foaf:maker>\n}; 
    125 } 
    126  
    127 $feed_timestamp ||= ''; 
    128  
    129 $rss .= qq{<title>}   . $self->{site_name}             . qq{</title> 
     116    } 
     117 
     118    $feed_timestamp ||= ''; 
     119 
     120    $rss .= qq{<title>}   . $self->{site_name}             . qq{</title> 
    130121<link>}               . $self->{html_equiv_link}       . qq{</link> 
    131122<description>}        . $self->{site_description}      . qq{</description> 
    … …  
    156147 
    157148sub generate_node_list_feed { 
    158   my ($self,$feed_timestamp,@nodes) = @_; 
    159  
    160   # Start our feed 
    161   my $rss = $self->build_feed_start($feed_timestamp); 
    162   $rss .= qq{ 
     149    my ($self,$feed_timestamp,@nodes) = @_; 
     150 
     151    # Start our feed 
     152    my $rss = $self->build_feed_start($feed_timestamp); 
     153    $rss .= qq{ 
    163154 
    164155<channel rdf:about=""> 
    165156 
    166157}; 
    167   $rss .= $self->build_feed_mid($feed_timestamp); 
    168  
    169   # Generate the items list, and the individiual item entries 
    170   my (@urls, @items); 
    171   foreach my $node (@nodes) 
    172   { 
    173     my $node_name = $node->{name}; 
    174  
    175     my $timestamp = $node->{last_modified}; 
     158    $rss .= $self->build_feed_mid($feed_timestamp); 
     159 
     160    # Generate the items list, and the individiual item entries 
     161    my (@urls, @items); 
     162    foreach my $node (@nodes) { 
     163        my $node_name = $node->{name}; 
     164 
     165        my $timestamp = $node->{last_modified}; 
    176166     
    177     # Make a Time::Piece object. 
    178     my $time = Time::Piece->strptime($timestamp, $self->{timestamp_fmt}); 
    179  
    180     my $utc_offset = $self->{utc_offset}; 
     167        # Make a Time::Piece object. 
     168        my $time = Time::Piece->strptime($timestamp, $self->{timestamp_fmt}); 
     169 
     170        my $utc_offset = $self->{utc_offset}; 
    181171     
    182     $timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
    183  
    184     my $author      = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || ''; 
    185     my $description = $node->{metadata}{comment}[0]  || ''; 
    186  
    187     $description .= " [$author]" if $author; 
    188  
    189     my $version = $node->{version}; 
    190     my $status  = (1 == $version) ? 'new' : 'updated'; 
    191  
    192     my $major_change = $node->{metadata}{major_change}[0]; 
    193        $major_change = 1 unless defined $major_change; 
    194     my $importance = $major_change ? 'major' : 'minor'; 
    195  
    196     my $url = $self->{make_node_url}->($node_name, $version); 
    197  
    198     push @urls, qq{    <rdf:li rdf:resource="$url" />\n}; 
    199  
    200     my $diff_url = ''; 
     172        $timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" ); 
     173 
     174        my $author      = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || ''; 
     175        my $description = $node->{metadata}{comment}[0]  || ''; 
     176 
     177        $description .= " [$author]" if $author; 
     178 
     179        my $version = $node->{version}; 
     180        my $status  = (1 == $version) ? 'new' : 'updated'; 
     181 
     182        my $major_change = $node->{metadata}{major_change}[0]; 
     183        $major_change = 1 unless defined $major_change; 
     184        my $importance = $major_change ? 'major' : 'minor'; 
     185 
     186        my $url = $self->{make_node_url}->($node_name, $version); 
     187 
     188        push @urls, qq{    <rdf:li rdf:resource="$url" />\n}; 
     189 
     190        my $diff_url = ''; 
    201191     
    202     if ($self->{make_diff_url}) 
    203     { 
    204             $diff_url = $self->{make_diff_url}->($node_name); 
    205     } 
    206  
    207     my $history_url = ''; 
     192        if ($self->{make_diff_url}) { 
     193            $diff_url = $self->{make_diff_url}->($node_name); 
     194        } 
     195 
     196        my $history_url = ''; 
    208197     
    209     if ($self->{make_history_url}) 
    210     { 
    211       $history_url = $self->{make_history_url}->($node_name); 
    212     } 
    213  
    214     my $node_url = $self->{make_node_url}->($node_name); 
    215  
    216     my $rdf_url =  $node_url; 
    217        $rdf_url =~ s/\?/\?id=/; 
    218        $rdf_url .= ';format=rdf'; 
    219  
    220     # make XML-clean 
    221     my $title =  $node_name; 
    222        $title =~ s/&/&amp;/g; 
    223        $title =~ s/</&lt;/g; 
    224        $title =~ s/>/&gt;/g; 
    225  
    226     # Pop the categories into dublin core subject elements 
    227     #  (http://dublincore.org/usage/terms/history/#subject-004) 
    228     # TODO: Decide if we should include the "all categories listing" url 
    229     #        as the scheme (URI) attribute? 
    230     my $category_rss = ""; 
    231     if($node->{metadata}->{category}) { 
    232         foreach my $cat (@{ $node->{metadata}->{category} }) { 
    233             $category_rss .= "  <dc:subject>$cat</dc:subject>\n"; 
     198        if ($self->{make_history_url}) { 
     199            $history_url = $self->{make_history_url}->($node_name); 
    234200        } 
    235     } 
    236  
    237     # Include geospacial data, if we have it 
    238     my $geo_rss = $self->format_geo($node->{metadata}); 
    239  
    240     push @items, qq{ 
     201 
     202        my $node_url = $self->{make_node_url}->($node_name); 
     203 
     204        my $rdf_url =  $node_url; 
     205        $rdf_url =~ s/\?/\?id=/; 
     206        $rdf_url .= ';format=rdf'; 
     207 
     208        # make XML-clean 
     209        my $title =  $node_name; 
     210        $title =~ s/&/&amp;/g; 
     211        $title =~ s/</&lt;/g; 
     212        $title =~ s/>/&gt;/g; 
     213 
     214        # Pop the categories into dublin core subject elements 
     215        #  (http://dublincore.org/usage/terms/history/#subject-004) 
     216        # TODO: Decide if we should include the "all categories listing" url 
     217        #        as the scheme (URI) attribute? 
     218        my $category_rss = ""; 
     219        if($node->{metadata}->{category}) { 
     220            foreach my $cat (@{ $node->{metadata}->{category} }) { 
     221                $category_rss .= "  <dc:subject>$cat</dc:subject>\n"; 
     222            } 
     223        } 
     224 
     225        # Include geospacial data, if we have it 
     226        my $geo_rss = $self->format_geo($node->{metadata}); 
     227 
     228        push @items, qq{ 
    241229<item rdf:about="$url"> 
    242230  <title>$title</title> 
    … …  
    255243</item> 
    256244}; 
    257   } 
     245    } 
    258246   
    259   # Output the items list 
    260   $rss .= qq{ 
     247    # Output the items list 
     248    $rss .= qq{ 
    261249 
    262250<items> 
    … …  
    268256}; 
    269257 
    270   # Output the individual item entries 
    271   $rss .= join('', @items) . "\n"; 
    272  
    273   # Finish up 
    274   $rss .= $self->build_feed_end($feed_timestamp); 
     258    # Output the individual item entries 
     259    $rss .= join('', @items) . "\n"; 
     260 
     261    # Finish up 
     262    $rss .= $self->build_feed_end($feed_timestamp); 
    275263  
    276   return $rss;    
     264    return $rss;    
    277265} 
    278266 
    … …  
    288276 
    289277sub generate_node_name_distance_feed { 
    290   my ($self,$feed_timestamp,@nodes) = @_; 
    291  
    292   # Start our feed 
    293   my $rss = $self->build_feed_start($feed_timestamp); 
    294   $rss .= qq{ 
     278    my ($self,$feed_timestamp,@nodes) = @_; 
     279 
     280    # Start our feed 
     281    my $rss = $self->build_feed_start($feed_timestamp); 
     282    $rss .= qq{ 
    295283 
    296284<channel rdf:about=""> 
    297285 
    298286}; 
    299   $rss .= $self->build_feed_mid($feed_timestamp); 
    300  
    301   # Generate the items list, and the individiual item entries 
    302   my (@urls, @items); 
    303   foreach my $node (@nodes) 
    304   { 
    305     my $node_name = $node->{name}; 
    306  
    307     my $url = $self->{make_node_url}->($node_name); 
    308  
    309     push @urls, qq{    <rdf:li rdf:resource="$url" />\n}; 
    310  
    311     my $rdf_url =  $url; 
    312        $rdf_url =~ s/\?/\?id=/; 
    313        $rdf_url .= ';format=rdf'; 
    314  
    315     # make XML-clean 
    316     my $title =  $node_name; 
    317        $title =~ s/&/&amp;/g; 
    318        $title =~ s/</&lt;/g; 
    319        $title =~ s/>/&gt;/g; 
    320  
    321     # What location stuff do we have? 
    322     my $geo_rss = $self->format_geo($node); 
    323  
    324     push @items, qq{ 
     287    $rss .= $self->build_feed_mid($feed_timestamp); 
     288 
     289    # Generate the items list, and the individiual item entries 
     290    my (@urls, @items); 
     291    foreach my $node (@nodes) { 
     292        my $node_name = $node->{name}; 
     293 
     294        my $url = $self->{make_node_url}->($node_name); 
     295 
     296        push @urls, qq{    <rdf:li rdf:resource="$url" />\n}; 
     297 
     298        my $rdf_url =  $url; 
     299        $rdf_url =~ s/\?/\?id=/; 
     300        $rdf_url .= ';format=rdf'; 
     301 
     302        # make XML-clean 
     303        my $title =  $node_name; 
     304        $title =~ s/&/&amp;/g; 
     305        $title =~ s/</&lt;/g; 
     306        $title =~ s/>/&gt;/g; 
     307 
     308        # What location stuff do we have? 
     309        my $geo_rss = $self->format_geo($node); 
     310 
     311        push @items, qq{ 
    325312<item rdf:about="$url"> 
    326313  <title>$title</title> 
    … …  
    330317</item> 
    331318}; 
    332   } 
     319    } 
    333320   
    334   # Output the items list 
    335   $rss .= qq{ 
     321    # Output the items list 
     322    $rss .= qq{ 
    336323 
    337324<items> 
    … …  
    343330}; 
    344331 
    345   # Output the individual item entries 
    346   $rss .= join('', @items) . "\n"; 
    347  
    348   # Finish up 
    349   $rss .= $self->build_feed_end($feed_timestamp); 
     332    # Output the individual item entries 
     333    $rss .= join('', @items) . "\n"; 
     334 
     335    # Finish up 
     336    $rss .= $self->build_feed_end($feed_timestamp); 
    350337  
    351   return $rss;    
     338    return $rss;    
    352339} 
    353340 
    … …  
    363350 
    364351    my $time; 
    365     if ($newest_node->{last_modified}) 
    366     { 
     352    if ($newest_node->{last_modified}) { 
    367353        $time = Time::Piece->strptime( $newest_node->{last_modified}, $self->{timestamp_fmt} ); 
    368354    } else { 
    … …  
    522508                     'About This Wiki', 
    523509                     'blah blah blah', 
    524                                  $checksum, 
    525                            { 
    526                        comment  => 'Stub page, please update!', 
    527                                    username => 'Fred', 
    528                      } 
     510                         $checksum, 
     511                         { 
     512                           comment  => 'Stub page, please update!', 
     513                           username => 'Fred', 
     514                         } 
    529515  ); 
    530516 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Formatter/Default.pm

    r244 r431  
    2929  my $formatter = Wiki::Toolkit::Formatter::Default->new( %config ); 
    3030  my $wiki      = Wiki::Toolkit->new( store     => $store, 
    31                                   formatter => $formatter ); 
     31                                      formatter => $formatter ); 
    3232 
    3333=head1 METHODS 
    … …  
    4242                 allowed_tags    => [qw(b i)],  # defaults to none 
    4343                 macros          => {}, 
    44                  node_prefix     => 'wiki.cgi?node=' ); 
     44                 node_prefix     => 'wiki.cgi?node=' ); 
    4545 
    4646Parameters will default to the values shown above (apart from 
    … …  
    5858 
    5959  macros => { qr/(^|\b)\@SEARCHBOX(\b|$)/ => 
    60                 qq(<form action="wiki.cgi" method="get"> 
     60              qq(<form action="wiki.cgi" method="get"> 
    6161                   <input type="hidden" name="action" value="search"> 
    6262                   <input type="text" size="20" name="terms"> 
    … …  
    7878    # Store the parameters or their defaults. 
    7979    my %defs = ( extended_links  => 0, 
    80                  implicit_links  => 1, 
    81                 allowed_tags    => [], 
    82                 macros          => {}, 
    83                  node_prefix     => 'wiki.cgi?node=', 
    84                ); 
     80                 implicit_links  => 1, 
     81                allowed_tags    => [], 
     82                macros          => {}, 
     83                 node_prefix     => 'wiki.cgi?node=', 
     84               ); 
    8585 
    8686    my %collated = (%defs, %args); 
    … …  
    111111    if (scalar keys %allowed) { 
    112112        # If we are allowing some HTML, parse and get rid of the nasties. 
    113         my $parser = HTML::PullParser->new(doc   => $raw, 
    114                                            start => '"TAG", tag, text', 
    115                                            end   => '"TAG", tag, text', 
    116                                            text  => '"TEXT", tag, text'); 
    117         while (my $token = $parser->get_token) { 
     113        my $parser = HTML::PullParser->new(doc   => $raw, 
     114                                           start => '"TAG", tag, text', 
     115                                           end   => '"TAG", tag, text', 
     116                                           text  => '"TEXT", tag, text'); 
     117        while (my $token = $parser->get_token) { 
    118118            my ($flag, $tag, $text) = @$token; 
    119             if ($flag eq "TAG" and !defined $allowed{lc($tag)}) { 
    120                 $safe .= CGI::escapeHTML($text); 
    121             } else { 
     119            if ($flag eq "TAG" and !defined $allowed{lc($tag)}) { 
     120                $safe .= CGI::escapeHTML($text); 
     121            } else { 
    122122                $safe .= $text; 
    123123            } 
    … …  
    135135 
    136136    return wikiformat($safe, {}, 
    137                       { extended       => $self->{_extended_links}, 
    138                         prefix         => $self->{_node_prefix}, 
    139                         implicit_links => $self->{_implicit_links} } ); 
     137              { extended       => $self->{_extended_links}, 
     138                prefix         => $self->{_node_prefix}, 
     139                implicit_links => $self->{_implicit_links} } ); 
    140140} 
    141141 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Formatter/Multiple.pm

    r236 r431  
    3737 
    3838  my $wiki = Wiki::Toolkit->new( store     => ..., 
    39                              formatter => $formatter ); 
     39                                 formatter => $formatter ); 
    4040  my $output = $wiki->format( "This is some discussion.", 
    4141                              { formatter => "discussion" } ); 
    … …  
    115115 
    116116sub _formatter { 
    117   my $self = shift; 
    118   my $metadata = shift; 
    119   my $label = $metadata->{formatter} || "_DEFAULT"; 
    120   $label = $label->[0] if ref($label); 
    121   return $self->{formatters}{$label} || $self->{formatters}{_DEFAULT}; 
     117    my $self = shift; 
     118    my $metadata = shift; 
     119    my $label = $metadata->{formatter} || "_DEFAULT"; 
     120    $label = $label->[0] if ref($label); 
     121    return $self->{formatters}{$label} || $self->{formatters}{_DEFAULT}; 
    122122} 
    123123 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Formatter/WikiLinkFormatterParent.pm

    r349 r431  
    4040    my ($self, $from, $to, $content) = @_; 
    4141 
    42         # If we support extended (square bracket) links, update those 
    43         if($self->{_extended_links}) { 
    44                 $content =~ s/\[$from\]/\[$to\]/g; 
    45                 $content =~ s/\[$from(\s*|.*?)\]/\[$to$1\]/g; 
    46         } 
     42    # If we support extended (square bracket) links, update those 
     43    if($self->{_extended_links}) { 
     44        $content =~ s/\[$from\]/\[$to\]/g; 
     45        $content =~ s/\[$from(\s*|.*?)\]/\[$to$1\]/g; 
     46    } 
    4747 
    48         # If we support implicit (camelcase) links, update those 
    49         if($self->{_implicit_links}) { 
    50                 $content =~ s/\b$from\b/$to/g; 
    51                 $content =~ s/^$from\b/$to/gm; 
    52                 $content =~ s/\b$from$/$to/gm; 
    53         } 
     48    # If we support implicit (camelcase) links, update those 
     49    if($self->{_implicit_links}) { 
     50        $content =~ s/\b$from\b/$to/g; 
     51        $content =~ s/^$from\b/$to/gm; 
     52        $content =~ s/\b$from$/$to/gm; 
     53    } 
    5454 
    55         return $content; 
     55    return $content; 
    5656} 
    5757 
    … …  
    7272 
    7373    my $foo = wikiformat($raw, 
    74                         { link => sub { 
    75                                         my ($link, $opts) = @_; 
    76                                         $opts ||= {}; 
    77                                         my $title; 
    78                                         ($link, $title) = split(/\|/, $link, 2) 
    79                                                 if $opts->{extended}; 
    80                                         push @Wiki::Toolkit::Formatter::WikiLinkFormatterParent::_links_found, 
    81                                                 $link; 
    82                                         return ""; # don't care about output 
    83                                 } 
    84                         }, 
    85                         { 
    86                                 extended       => $self->{_extended_links}, 
    87                                 prefix         => $self->{_node_prefix}, 
    88                                 implicit_links => $self->{_implicit_links}  
    89                         }  
    90         ); 
     74            { link => sub { 
     75                    my ($link, $opts) = @_; 
     76                    $opts ||= {}; 
     77                    my $title; 
     78                    ($link, $title) = split(/\|/, $link, 2) 
     79                        if $opts->{extended}; 
     80                    push @Wiki::Toolkit::Formatter::WikiLinkFormatterParent::_links_found, 
     81                        $link; 
     82                    return ""; # don't care about output 
     83                } 
     84            }, 
     85            { 
     86                extended       => $self->{_extended_links}, 
     87                prefix         => $self->{_node_prefix}, 
     88                implicit_links => $self->{_implicit_links}  
     89            }  
     90    ); 
    9191 
    9292    my @links = @_links_found; 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Search/Base.pm

    r209 r431  
    99    my $who = (caller(1))[3]; 
    1010    croak "$who is an abstract method which the ".(ref shift). 
    11     " class has not provided"; 
     11          " class has not provided"; 
    1212} 
    1313 
    … …  
    9999    my ($self, $string) = @_; 
    100100    return grep { length > 1            # ignore single characters 
    101                  and ! /^\W*$/ }        # and things composed entirely 
    102                                         #   of non-word characters 
    103           split( /\b/,                  # split at word boundaries 
     101                  and ! /^\W*$/ }       # and things composed entirely 
     102                                        # of non-word characters 
     103           split( /\b/,                 # split at word boundaries 
    104104                       lc($string)      # be case-insensitive 
    105                    ); 
     105                ); 
    106106} 
    107107 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Search/Plucene.pm

    r209 r431  
    5454        my ($self, $query, $default) = @_; 
    5555        my $parser = Plucene::QueryParser->new({ 
    56                         analyzer => Plucene::Analysis::SimpleAnalyzer->new(), 
     56                        analyzer => Plucene::Analysis::SimpleAnalyzer->new(), 
    5757                        default  => $default 
    5858                }); 
    … …  
    7777        return Plucene::Index::Writer->new( 
    7878                $self->_dir, 
    79                 Plucene::Analysis::SimpleAnalyzer->new, 
     79                Plucene::Analysis::SimpleAnalyzer->new, 
    8080                -e catfile($self->_dir, "segments") ? 0 : 1 
    8181        ); 
    … …  
    8989    } 
    9090    local $Plucene::QueryParser::DefaultOperator = "AND" 
    91       unless ( $and_or and lc($and_or) eq "or" ); 
     91        unless ( $and_or and lc($and_or) eq "or" ); 
    9292    my @docs; 
    9393    my $searcher = $self->_searcher; 
    … …  
    118118 
    119119sub index_node { 
    120         my ($self, $node, $content) = @_; 
    121         my $writer = $self->_writer; 
    122         my $doc    = Plucene::Document->new; 
    123         my $fuzzy = $self->canonicalise_title( $node ); 
    124         $doc->add( Plucene::Document::Field->Text( "content", join( " ", $node, $content ) ) ); 
    125         $doc->add( Plucene::Document::Field->Text( "fuzzy", $fuzzy ) ); 
    126         $doc->add( Plucene::Document::Field->Text( "title", $node ) ); 
    127         $doc->add(Plucene::Document::Field->Keyword(id => $node)); 
    128         $doc->add(Plucene::Document::Field->UnStored('text' => join( " ", $node, $content ))); 
    129         $writer->add_document($doc); 
     120    my ($self, $node, $content) = @_; 
     121    my $writer = $self->_writer; 
     122    my $doc    = Plucene::Document->new; 
     123    my $fuzzy = $self->canonicalise_title( $node ); 
     124    $doc->add( Plucene::Document::Field->Text( "content", join( " ", $node, $content ) ) ); 
     125    $doc->add( Plucene::Document::Field->Text( "fuzzy", $fuzzy ) ); 
     126    $doc->add( Plucene::Document::Field->Text( "title", $node ) ); 
     127    $doc->add(Plucene::Document::Field->Keyword(id => $node)); 
     128    $doc->add(Plucene::Document::Field->UnStored('text' => join( " ", $node, $content ))); 
     129    $writer->add_document($doc); 
    130130} 
    131131 
    … …  
    133133 
    134134sub indexed { 
    135         my ($self, $id) = @_; 
    136         my $term = Plucene::Index::Term->new({ field => 'id', text => $id }); 
    137         return $self->_reader->doc_freq($term); 
     135    my ($self, $id) = @_; 
     136    my $term = Plucene::Index::Term->new({ field => 'id', text => $id }); 
     137    return $self->_reader->doc_freq($term); 
    138138} 
    139139 
    140140sub delete_node { 
    141         my ($self, $id) = @_; 
    142         my $reader = $self->_reader; 
    143         $reader->delete_term( 
    144                              Plucene::Index::Term->new({ field => "id", text => $id })); 
    145         $reader->close; 
     141    my ($self, $id) = @_; 
     142    my $reader = $self->_reader; 
     143    $reader->delete_term( 
     144                 Plucene::Index::Term->new({ field => "id", text => $id })); 
     145    $reader->close; 
    146146} 
    147147 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Search/SII.pm

    r209 r431  
    3838                   -username   => $dbuser, 
    3939                   -password   => $dbpass, 
    40                    -hostname   => '', 
     40           -hostname   => '', 
    4141                   -table_name => 'siindex', 
    4242                   -lock_mode  => 'EX' ); 
    … …  
    6262 
    6363    my $map = Search::InvertedIndex->new( -database => $indexdb ) 
    64       or croak "Couldn't set up Search::InvertedIndex map"; 
     64        or croak "Couldn't set up Search::InvertedIndex map"; 
    6565    $map->add_group( -group => "nodes" ); 
    6666    $map->add_group( -group => "fuzzy_titles" ); 
    … …  
    9393    for my $i ( 1 .. $num_results ) { 
    9494        my ($index, $data, $ranking) = $result->entry( -number => $i - 1 ); 
    95         $results{$index} = $ranking; 
     95        $results{$index} = $ranking; 
    9696    } 
    9797    return %results; 
    … …  
    112112    for my $i ( 1 .. $num_results ) { 
    113113        my ($index, $data) = $result->entry( -number => $i - 1 ); 
    114         $results{$data} = $data eq $string ? 2 : 1; 
     114        $results{$data} = $data eq $string ? 2 : 1; 
    115115    } 
    116116    return %results; 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/DBIxFTSMySQL.pm

    r209 r431  
    3737 
    3838sub setup { 
    39   my $dbh = _get_dbh( @_ ); 
     39    my $dbh = _get_dbh( @_ ); 
    4040 
    41   # Drop FTS indexes if they already exist. 
    42   my $fts = DBIx::FullTextSearch->open($dbh, "_content_and_title_fts"); 
    43   $fts->drop if $fts; 
    44   $fts = DBIx::FullTextSearch->open($dbh, "_title_fts"); 
    45   $fts->drop if $fts; 
     41    # Drop FTS indexes if they already exist. 
     42    my $fts = DBIx::FullTextSearch->open($dbh, "_content_and_title_fts"); 
     43    $fts->drop if $fts; 
     44    $fts = DBIx::FullTextSearch->open($dbh, "_title_fts"); 
     45    $fts->drop if $fts; 
    4646 
    47   # Set up FullText indexes and index anything already extant. 
    48   my $fts_all = DBIx::FullTextSearch->create($dbh, "_content_and_title_fts", 
    49                                              frontend       => "table", 
    50                                              backend        => "phrase", 
    51                                              table_name     => "node", 
    52                                              column_name    => ["name","text"], 
    53                                              column_id_name => "name", 
    54                                              stemmer        => "en-uk"); 
     47    # Set up FullText indexes and index anything already extant. 
     48    my $fts_all = DBIx::FullTextSearch->create($dbh, "_content_and_title_fts", 
     49                         frontend       => "table", 
     50                         backend        => "phrase", 
     51                         table_name     => "node", 
     52                         column_name    => ["name","text"], 
     53                         column_id_name => "name", 
     54                         stemmer        => "en-uk"); 
    5555 
    56   my $fts_title = DBIx::FullTextSearch->create($dbh, "_title_fts", 
    57                                                frontend       => "table", 
    58                                                backend        => "phrase", 
    59                                                table_name     => "node", 
    60                                                column_name    => "name", 
    61                                                column_id_name => "name", 
    62                                                stemmer        => "en-uk"); 
     56    my $fts_title = DBIx::FullTextSearch->create($dbh, "_title_fts", 
     57                         frontend       => "table", 
     58                         backend        => "phrase", 
     59                         table_name     => "node", 
     60                         column_name    => "name", 
     61                         column_id_name => "name", 
     62                         stemmer        => "en-uk"); 
    6363 
    64   my $sql = "SELECT name FROM node"; 
    65   my $sth = $dbh->prepare($sql); 
    66   $sth->execute(); 
    67   while (my ($name, $version) = $sth->fetchrow_array) { 
    68     $fts_title->index_document($name); 
    69     $fts_all->index_document($name); 
    70   } 
    71   $sth->finish; 
     64    my $sql = "SELECT name FROM node"; 
     65    my $sth = $dbh->prepare($sql); 
     66    $sth->execute(); 
     67    while (my ($name, $version) = $sth->fetchrow_array) { 
     68        $fts_title->index_document($name); 
     69        $fts_all->index_document($name); 
     70    } 
     71    $sth->finish; 
    7272} 
    7373 
    … …  
    7878    $dsn .= ";host=$dbhost" if $dbhost; 
    7979    my $dbh = DBI->connect($dsn, $dbuser, $dbpass, 
    80                            { PrintError => 1, RaiseError => 1, 
    81                              AutoCommit => 1 } ) 
    82       or croak DBI::errstr; 
     80               { PrintError => 1, RaiseError => 1, 
     81                 AutoCommit => 1 } ) 
     82        or croak DBI::errstr; 
    8383    return $dbh; 
    8484} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/Database.pm

    r424 r431  
    1616# Fetch from the old style database, ready for an upgrade to db version 8 
    1717sub fetch_upgrade_old_to_8 { 
    18         # Compatible with old_to_9 
    19         fetch_upgrade_old_to_9(@_); 
     18    # Compatible with old_to_9 
     19    fetch_upgrade_old_to_9(@_); 
    2020} 
    2121 
    2222# Fetch from the old style database, ready for an upgrade to db version 9 
    2323sub fetch_upgrade_old_to_9 { 
    24         my $dbh = shift; 
    25         my %nodes; 
    26         my %metadatas; 
    27         my %contents; 
    28         my @internal_links; 
    29         my %ids; 
    30  
    31         print "Grabbing and upgrading old data... "; 
    32  
    33         # Grab all the nodes, and give them an ID 
    34         my $sth = $dbh->prepare("SELECT name,version,text,modified FROM node"); 
    35         $sth->execute; 
    36         my $id = 0; 
    37         while( my($name,$version,$text,$modified) = $sth->fetchrow_array) { 
    38                 my %node; 
    39                 $id++; 
    40                 $node{'name'} = $name; 
    41                 $node{'version'} = $version; 
    42                 $node{'text'} = $text; 
    43                 $node{'modified'} = $modified; 
    44                 $node{'id'} = $id; 
    45                 $node{'moderate'} = 0; 
    46                 $nodes{$name} = \%node; 
    47                 $ids{$name} = $id; 
    48         } 
    49         print " read $id nodes...  "; 
    50  
    51         # Grab all the content, and upgrade to ID from name 
    52         $sth = $dbh->prepare("SELECT name,version,text,modified,comment FROM content"); 
    53         $sth->execute; 
    54         while ( my($name,$version,$text,$modified,$comment) = $sth->fetchrow_array) { 
    55                 my $id = $ids{$name}; 
    56                 if($id) { 
    57                         my %content; 
    58                         $content{'node_id'} = $id; 
    59                         $content{'version'} = $version; 
    60                         $content{'text'} = $text; 
    61                         $content{'modified'} = $modified; 
    62                         $content{'comment'} = $comment; 
    63                         $content{'moderated'} = 1; 
    64                         $contents{$id."-".$version} = \%content; 
    65                 } else { 
    66                         warn("There was no node entry for content with name '$name', unable to migrate it!"); 
    67                 } 
    68         } 
    69         print " read ".(scalar keys %contents)." contents...  "; 
    70  
    71         # Grab all the metadata, and upgrade to ID from node 
    72         $sth = $dbh->prepare("SELECT node,version,metadata_type,metadata_value FROM metadata"); 
    73         $sth->execute; 
    74         my $i = 0; 
    75         while( my($node,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) { 
    76                 my $id = $ids{$node}; 
    77                 if($id) { 
    78                         my %metadata; 
    79                         $metadata{'node_id'} = $id; 
    80                         $metadata{'version'} = $version; 
    81                         $metadata{'metadata_type'} = $metadata_type; 
    82                         $metadata{'metadata_value'} = $metadata_value; 
    83                         $metadatas{$id."-".($i++)} = \%metadata; 
    84                 } else { 
    85                         warn("There was no node entry for metadata with name (node) '$node', unable to migrate it!"); 
    86                 } 
    87         } 
    88  
    89         # Grab all the internal links 
    90         $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links"); 
    91         $sth->execute; 
    92         while( my($link_from,$link_to) = $sth->fetchrow_array) { 
    93                 my %il; 
    94                 $il{'link_from'} = $link_from; 
    95                 $il{'link_to'} = $link_to; 
    96                 push @internal_links, \%il; 
    97         } 
    98  
    99         print "done\n"; 
    100  
    101         # Return it all 
    102         return (\%nodes,\%contents,\%metadatas,\@internal_links,\%ids); 
     24    my $dbh = shift; 
     25    my %nodes; 
     26    my %metadatas; 
     27    my %contents; 
     28    my @internal_links; 
     29    my %ids; 
     30 
     31    print "Grabbing and upgrading old data... "; 
     32 
     33    # Grab all the nodes, and give them an ID 
     34    my $sth = $dbh->prepare("SELECT name,version,text,modified FROM node"); 
     35    $sth->execute; 
     36    my $id = 0; 
     37    while( my($name,$version,$text,$modified) = $sth->fetchrow_array) { 
     38        my %node; 
     39        $id++; 
     40        $node{'name'} = $name; 
     41        $node{'version'} = $version; 
     42        $node{'text'} = $text; 
     43        $node{'modified'} = $modified; 
     44        $node{'id'} = $id; 
     45        $node{'moderate'} = 0; 
     46        $nodes{$name} = \%node; 
     47        $ids{$name} = $id; 
     48    } 
     49    print " read $id nodes...  "; 
     50 
     51    # Grab all the content, and upgrade to ID from name 
     52    $sth = $dbh->prepare("SELECT name,version,text,modified,comment FROM content"); 
     53    $sth->execute; 
     54    while ( my($name,$version,$text,$modified,$comment) = $sth->fetchrow_array) { 
     55        my $id = $ids{$name}; 
     56        if($id) { 
     57            my %content; 
     58            $content{'node_id'} = $id; 
     59            $content{'version'} = $version; 
     60            $content{'text'} = $text; 
     61            $content{'modified'} = $modified; 
     62            $content{'comment'} = $comment; 
     63            $content{'moderated'} = 1; 
     64            $contents{$id."-".$version} = \%content; 
     65        } else { 
     66            warn("There was no node entry for content with name '$name', unable to migrate it!"); 
     67        } 
     68    } 
     69    print " read ".(scalar keys %contents)." contents...  "; 
     70 
     71    # Grab all the metadata, and upgrade to ID from node 
     72    $sth = $dbh->prepare("SELECT node,version,metadata_type,metadata_value FROM metadata"); 
     73    $sth->execute; 
     74    my $i = 0; 
     75    while( my($node,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) { 
     76        my $id = $ids{$node}; 
     77        if($id) { 
     78            my %metadata; 
     79            $metadata{'node_id'} = $id; 
     80            $metadata{'version'} = $version; 
     81            $metadata{'metadata_type'} = $metadata_type; 
     82            $metadata{'metadata_value'} = $metadata_value; 
     83            $metadatas{$id."-".($i++)} = \%metadata; 
     84        } else { 
     85            warn("There was no node entry for metadata with name (node) '$node', unable to migrate it!"); 
     86        } 
     87    } 
     88 
     89    # Grab all the internal links 
     90    $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links"); 
     91    $sth->execute; 
     92    while( my($link_from,$link_to) = $sth->fetchrow_array) { 
     93        my %il; 
     94        $il{'link_from'} = $link_from; 
     95        $il{'link_to'} = $link_to; 
     96        push @internal_links, \%il; 
     97    } 
     98 
     99    print "done\n"; 
     100 
     101    # Return it all 
     102    return (\%nodes,\%contents,\%metadatas,\@internal_links,\%ids); 
    103103} 
    104104 
    105105# Fetch from schema version 8, and upgrade to version 9 
    106106sub fetch_upgrade_8_to_9 { 
    107         my $dbh = shift; 
    108         my %nodes; 
    109         my %metadatas; 
    110         my %contents; 
    111         my @internal_links; 
    112  
    113         print "Grabbing and upgrading old data... "; 
    114  
    115         # Grab all the nodes 
    116         my $sth = $dbh->prepare("SELECT id,name,version,text,modified FROM node"); 
    117         $sth->execute; 
    118         while( my($id,$name,$version,$text,$modified) = $sth->fetchrow_array) { 
    119                 my %node; 
    120                 $node{'name'} = $name; 
    121                 $node{'version'} = $version; 
    122                 $node{'text'} = $text; 
    123                 $node{'modified'} = $modified; 
    124                 $node{'id'} = $id; 
    125                 $node{'moderate'} = 0; 
    126                 $nodes{$name} = \%node; 
    127         } 
    128  
    129         # Grab all the content 
    130         $sth = $dbh->prepare("SELECT node_id,version,text,modified,comment FROM content"); 
    131         $sth->execute; 
    132         while ( my($node_id,$version,$text,$modified,$comment) = $sth->fetchrow_array) { 
    133                 my %content; 
    134                 $content{'node_id'} = $node_id; 
    135                 $content{'version'} = $version; 
    136                 $content{'text'} = $text; 
    137                 $content{'modified'} = $modified; 
    138                 $content{'comment'} = $comment; 
    139                 $content{'moderated'} = 1; 
    140                 $contents{$node_id."-".$version} = \%content; 
    141         } 
    142  
    143         # Grab all the metadata 
    144         $sth = $dbh->prepare("SELECT node_id,version,metadata_type,metadata_value FROM metadata"); 
    145         $sth->execute; 
    146         my $i = 0; 
    147         while( my($node_id,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) { 
    148                 my %metadata; 
    149                 $metadata{'node_id'} = $node_id; 
    150                 $metadata{'version'} = $version; 
    151                 $metadata{'metadata_type'} = $metadata_type; 
    152                 $metadata{'metadata_value'} = $metadata_value; 
    153                 $metadatas{$node_id."-".($i++)} = \%metadata; 
    154         } 
    155  
    156         # Grab all the internal links 
    157         $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links"); 
    158         $sth->execute; 
    159         while( my($link_from,$link_to) = $sth->fetchrow_array) { 
    160                 my %il; 
    161                 $il{'link_from'} = $link_from; 
    162                 $il{'link_to'} = $link_to; 
    163                 push @internal_links, \%il; 
    164         } 
    165  
    166         print "done\n"; 
    167  
    168         # Return it all 
    169         return (\%nodes,\%contents,\%metadatas,\@internal_links); 
     107    my $dbh = shift; 
     108    my %nodes; 
     109    my %metadatas; 
     110    my %contents; 
     111    my @internal_links; 
     112 
     113    print "Grabbing and upgrading old data... "; 
     114 
     115    # Grab all the nodes 
     116    my $sth = $dbh->prepare("SELECT id,name,version,text,modified FROM node"); 
     117    $sth->execute; 
     118    while( my($id,$name,$version,$text,$modified) = $sth->fetchrow_array) { 
     119        my %node; 
     120        $node{'name'} = $name; 
     121        $node{'version'} = $version; 
     122        $node{'text'} = $text; 
     123        $node{'modified'} = $modified; 
     124        $node{'id'} = $id; 
     125        $node{'moderate'} = 0; 
     126        $nodes{$name} = \%node; 
     127    } 
     128 
     129    # Grab all the content 
     130    $sth = $dbh->prepare("SELECT node_id,version,text,modified,comment FROM content"); 
     131    $sth->execute; 
     132    while ( my($node_id,$version,$text,$modified,$comment) = $sth->fetchrow_array) { 
     133        my %content; 
     134        $content{'node_id'} = $node_id; 
     135        $content{'version'} = $version; 
     136        $content{'text'} = $text; 
     137        $content{'modified'} = $modified; 
     138        $content{'comment'} = $comment; 
     139        $content{'moderated'} = 1; 
     140        $contents{$node_id."-".$version} = \%content; 
     141    } 
     142 
     143    # Grab all the metadata 
     144    $sth = $dbh->prepare("SELECT node_id,version,metadata_type,metadata_value FROM metadata"); 
     145    $sth->execute; 
     146    my $i = 0; 
     147    while( my($node_id,$version,$metadata_type,$metadata_value) = $sth->fetchrow_array) { 
     148        my %metadata; 
     149        $metadata{'node_id'} = $node_id; 
     150        $metadata{'version'} = $version; 
     151        $metadata{'metadata_type'} = $metadata_type; 
     152        $metadata{'metadata_value'} = $metadata_value; 
     153        $metadatas{$node_id."-".($i++)} = \%metadata; 
     154    } 
     155 
     156    # Grab all the internal links 
     157    $sth = $dbh->prepare("SELECT link_from,link_to FROM internal_links"); 
     158    $sth->execute; 
     159    while( my($link_from,$link_to) = $sth->fetchrow_array) { 
     160        my %il; 
     161        $il{'link_from'} = $link_from; 
     162        $il{'link_to'} = $link_to; 
     163        push @internal_links, \%il; 
     164    } 
     165 
     166    print "done\n"; 
     167 
     168    # Return it all 
     169    return (\%nodes,\%contents,\%metadatas,\@internal_links); 
    170170} 
    171171 
    172172# Get the version of the database schema 
    173173sub get_database_version { 
    174         my $dbh = shift; 
    175         my $sql = "SELECT version FROM schema_info"; 
    176         my $sth; 
    177         eval{ $sth = $dbh->prepare($sql) }; 
    178         if($@) { return "old"; } 
    179         eval{ $sth->execute }; 
    180         if($@) { return "old"; } 
    181  
    182         my ($cur_schema) = $sth->fetchrow_array; 
    183         unless($cur_schema) { return "old"; } 
    184  
    185         return $cur_schema; 
     174    my $dbh = shift; 
     175    my $sql = "SELECT version FROM schema_info"; 
     176    my $sth; 
     177    eval{ $sth = $dbh->prepare($sql) }; 
     178    if($@) { return "old"; } 
     179    eval{ $sth->execute }; 
     180    if($@) { return "old"; } 
     181 
     182    my ($cur_schema) = $sth->fetchrow_array; 
     183    unless($cur_schema) { return "old"; } 
     184 
     185    return $cur_schema; 
    186186} 
    187187 
    188188# Is an upgrade to the database required? 
    189189sub get_database_upgrade_required { 
    190         my ($dbh,$VERSION) = @_; 
    191  
    192         # Get the schema version 
    193         my $schema_version = get_database_version($dbh); 
    194  
    195         # Compare it 
    196         my $new_ver = $VERSION * 100; 
    197         if($schema_version eq $new_ver) { 
    198                 # At latest version 
    199                 return undef; 
    200         } else { 
    201                 return $schema_version."_to_".$new_ver; 
    202         } 
     190    my ($dbh,$VERSION) = @_; 
     191 
     192    # Get the schema version 
     193    my $schema_version = get_database_version($dbh); 
     194 
     195    # Compare it 
     196    my $new_ver = $VERSION * 100; 
     197    if($schema_version eq $new_ver) { 
     198        # At latest version 
     199        return undef; 
     200    } else { 
     201        return $schema_version."_to_".$new_ver; 
     202    } 
    203203} 
    204204 
    205205# Put the latest data into the latest database structure 
    206206sub bulk_data_insert { 
    207         my ($dbh, $nodesref, $contentsref, $metadataref, $internallinksref) = @_; 
    208  
    209         print "Bulk inserting upgraded data... "; 
    210  
    211         # Add nodes 
    212         my $sth = $dbh->prepare("INSERT INTO node (id,name,version,text,modified,moderate) VALUES (?,?,?,?,?,?)"); 
    213         foreach my $name (keys %$nodesref) { 
    214                 my %node = %{$nodesref->{$name}}; 
    215                 $sth->execute($node{'id'}, 
     207    my ($dbh, $nodesref, $contentsref, $metadataref, $internallinksref) = @_; 
     208 
     209    print "Bulk inserting upgraded data... "; 
     210 
     211    # Add nodes 
     212    my $sth = $dbh->prepare("INSERT INTO node (id,name,version,text,modified,moderate) VALUES (?,?,?,?,?,?)"); 
     213    foreach my $name (keys %$nodesref) { 
     214        my %node = %{$nodesref->{$name}}; 
     215        $sth->execute($node{'id'}, 
    216216                      $node{'name'}, 
    217217                      $node{'version'}, 
    … …  
    219219                      $node{'modified'}, 
    220220                      $node{'moderate'}); 
    221         } 
    222         print "added ".(scalar keys %$nodesref)." nodes...  "; 
    223  
    224         # Add content 
    225         $sth = $dbh->prepare("INSERT INTO content (node_id,version,text,modified,comment,moderated) VALUES (?,?,?,?,?,?)"); 
    226         foreach my $key (keys %$contentsref) { 
    227                 my %content = %{$contentsref->{$key}}; 
    228                 $sth->execute($content{'node_id'}, 
     221    } 
     222    print "added ".(scalar keys %$nodesref)." nodes...  "; 
     223 
     224    # Add content 
     225    $sth = $dbh->prepare("INSERT INTO content (node_id,version,text,modified,comment,moderated) VALUES (?,?,?,?,?,?)"); 
     226    foreach my $key (keys %$contentsref) { 
     227        my %content = %{$contentsref->{$key}}; 
     228        $sth->execute($content{'node_id'}, 
    229229                      $content{'version'}, 
    230230                      $content{'text'}, 
    … …  
    232232                      $content{'comment'}, 
    233233                      $content{'moderated'}); 
    234         } 
     234    } 
    235235 
    236236    # Add metadata 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/MySQL.pm

    r426 r431  
    1414 
    1515my %create_sql = ( 
    16         schema_info => [ qq| 
     16    schema_info => [ qq| 
    1717CREATE TABLE schema_info ( 
    1818  version   int(10)      NOT NULL default 0 
    … …  
    117117    my %tables = fetch_tables_listing($dbh); 
    118118 
    119         # Do we need to upgrade the schema of existing tables? 
    120         # (Don't check if no tables currently exist) 
    121         my $upgrade_schema; 
    122         my @cur_data; 
    123         if(scalar keys %tables > 0) { 
    124                 $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
    125         } 
    126         if($upgrade_schema) { 
    127                 # Grab current data 
    128                 print "Upgrading: $upgrade_schema\n"; 
    129                 @cur_data = eval("&Wiki::Toolkit::Setup::Database::fetch_upgrade_".$upgrade_schema."(\$dbh)"); 
    130                 if($@) { warn $@; } 
     119    # Do we need to upgrade the schema of existing tables? 
     120    # (Don't check if no tables currently exist) 
     121    my $upgrade_schema; 
     122    my @cur_data; 
     123    if(scalar keys %tables > 0) { 
     124        $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
     125    } 
     126    if($upgrade_schema) { 
     127        # Grab current data 
     128        print "Upgrading: $upgrade_schema\n"; 
     129        @cur_data = eval("&Wiki::Toolkit::Setup::Database::fetch_upgrade_".$upgrade_schema."(\$dbh)"); 
     130        if($@) { warn $@; } 
    131131 
    132132        # Check to make sure we can create, index and drop tables 
    … …  
    137137        } 
    138138         
    139                 # Drop the current tables 
    140                 cleardb($dbh); 
    141  
    142                 # Grab new list of tables 
    143                 %tables = fetch_tables_listing($dbh); 
    144         } 
    145  
    146         # Set up tables if not found 
     139        # Drop the current tables 
     140        cleardb($dbh); 
     141 
     142        # Grab new list of tables 
     143        %tables = fetch_tables_listing($dbh); 
     144    } 
     145 
     146    # Set up tables if not found 
    147147    foreach my $required ( keys %create_sql ) { 
    148148        if ( $tables{$required} ) { 
    … …  
    156156    } 
    157157 
    158         # If upgrading, load in the new data 
    159         if($upgrade_schema) { 
    160                 Wiki::Toolkit::Setup::Database::bulk_data_insert($dbh,@cur_data); 
    161         } 
     158    # If upgrading, load in the new data 
     159    if($upgrade_schema) { 
     160        Wiki::Toolkit::Setup::Database::bulk_data_insert($dbh,@cur_data); 
     161    } 
    162162 
    163163    # Clean up if we made our own dbh. 
    … …  
    167167# Internal method - what Wiki::Toolkit tables are defined? 
    168168sub fetch_tables_listing { 
    169         my $dbh = shift; 
     169    my $dbh = shift; 
    170170 
    171171    # Check what tables exist 
    … …  
    176176        exists $create_sql{$table} and $tables{$table} = 1; 
    177177    } 
    178         return %tables; 
     178    return %tables; 
    179179} 
    180180 
    … …  
    234234        if ( $args{dbh} ) { 
    235235            return $args{dbh}; 
    236         } else { 
     236    } else { 
    237237            return _make_dbh( %args ); 
    238238        } 
    … …  
    259259        if ( $args{dbh} ) { 
    260260            return 0; 
    261         } else { 
     261    } else { 
    262262            return 1; 
    263263        } 
    … …  
    273273    $dsn .= ";host=$args{dbhost}" if $args{dbhost}; 
    274274    my $dbh = DBI->connect($dsn, $args{dbuser}, $args{dbpass}, 
    275                            { PrintError => 1, RaiseError => 1, 
    276                              AutoCommit => 1 } ) 
    277       or croak DBI::errstr; 
     275               { PrintError => 1, RaiseError => 1, 
     276                 AutoCommit => 1 } ) 
     277        or croak DBI::errstr; 
    278278    return $dbh; 
    279279} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/Pg.pm

    r426 r431  
    1414 
    1515my %create_sql = ( 
    16         schema_info => [ qq| 
     16    schema_info => [ qq| 
    1717CREATE TABLE schema_info ( 
    1818  version   integer      NOT NULL default 0 
    … …  
    7575 
    7676my %upgrades = ( 
    77         old_to_8 => [ qq| 
     77    old_to_8 => [ qq| 
    7878CREATE SEQUENCE node_seq; 
    7979ALTER TABLE node ADD COLUMN id INTEGER; 
    … …  
    9191ALTER TABLE content ADD COLUMN node_id INTEGER; 
    9292UPDATE content SET node_id =  
    93         (SELECT id FROM node where node.name = content.name) 
     93    (SELECT id FROM node where node.name = content.name) 
    9494|, qq| 
    9595DELETE FROM content WHERE node_id IS NULL; 
    … …  
    103103ALTER TABLE metadata ADD COLUMN node_id INTEGER; 
    104104UPDATE metadata SET node_id =  
    105         (SELECT id FROM node where node.name = metadata.node) 
     105    (SELECT id FROM node where node.name = metadata.node) 
    106106|, qq| 
    107107DELETE FROM metadata WHERE node_id IS NULL; 
    … …  
    192192    } 
    193193 
    194         # Do we need to upgrade the schema of existing tables? 
    195         # (Don't check if no tables currently exist) 
    196         my $upgrade_schema; 
    197         if(scalar keys %tables > 0) { 
    198                 $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
    199         } else { 
    200                 print "Skipping schema upgrade check - no tables found\n"; 
    201         } 
    202  
    203         # Set up tables if not found 
     194    # Do we need to upgrade the schema of existing tables? 
     195    # (Don't check if no tables currently exist) 
     196    my $upgrade_schema; 
     197    if(scalar keys %tables > 0) { 
     198        $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
     199    } else { 
     200        print "Skipping schema upgrade check - no tables found\n"; 
     201    } 
     202 
     203    # Set up tables if not found 
    204204    foreach my $required ( reverse sort keys %create_sql ) { 
    205205        if ( $tables{$required} ) { 
    … …  
    213213    } 
    214214 
    215         # Do the upgrade if required 
    216         if($upgrade_schema) { 
    217                 print "Upgrading schema: $upgrade_schema\n"; 
    218                 my @updates = @{$upgrades{$upgrade_schema}}; 
    219                 foreach my $update (@updates) { 
    220                         if(ref($update) eq "CODE") { 
    221                                 &$update($dbh); 
    222                         } elsif(ref($update) eq "ARRAY") { 
    223                                 foreach my $nupdate (@$update) { 
    224                                         $dbh->do($nupdate); 
    225                                 } 
    226                         } else { 
    227                                 $dbh->do($update); 
    228                         } 
    229                 } 
    230         } 
     215    # Do the upgrade if required 
     216    if($upgrade_schema) { 
     217        print "Upgrading schema: $upgrade_schema\n"; 
     218        my @updates = @{$upgrades{$upgrade_schema}}; 
     219        foreach my $update (@updates) { 
     220            if(ref($update) eq "CODE") { 
     221                &$update($dbh); 
     222            } elsif(ref($update) eq "ARRAY") { 
     223                foreach my $nupdate (@$update) { 
     224                    $dbh->do($nupdate); 
     225                } 
     226            } else { 
     227                $dbh->do($update); 
     228            } 
     229        } 
     230    } 
    231231 
    232232    # Clean up if we made our own dbh. 
    … …  
    300300        if ( $args{dbh} ) { 
    301301            return $args{dbh}; 
    302         } else { 
     302    } else { 
    303303            return _make_dbh( %args ); 
    304304        } 
    … …  
    325325        if ( $args{dbh} ) { 
    326326            return 0; 
    327         } else { 
     327    } else { 
    328328            return 1; 
    329329        } 
    … …  
    339339    $dsn .= ";host=$args{dbhost}" if $args{dbhost}; 
    340340    my $dbh = DBI->connect($dsn, $args{dbuser}, $args{dbpass}, 
    341                            { PrintError => 1, RaiseError => 1, 
    342                              AutoCommit => 1 } ) 
    343       or croak DBI::errstr; 
     341               { PrintError => 1, RaiseError => 1, 
     342                 AutoCommit => 1 } ) 
     343        or croak DBI::errstr; 
    344344    return $dbh; 
    345345} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/SII.pm

    r209 r431  
    2222                   -username   => $dbuser, 
    2323                   -password   => $dbpass, 
    24                    -hostname   => '', 
     24           -hostname   => '', 
    2525                   -table_name => 'siindex', 
    2626                   -lock_mode  => 'EX' ); 
    … …  
    5454    my $store = $args{store}; 
    5555    if ( $store ) { 
    56         my @nodes = $store->list_all_nodes; 
    57         my $search = Wiki::Toolkit::Search::SII->new( indexdb => $indexdb ); 
    58         foreach my $node ( @nodes ) { 
    59             my $content = $store->retrieve_node( $node ); 
    60             $search->index_node( $node, $content ); 
    61         } 
     56        my @nodes = $store->list_all_nodes; 
     57        my $search = Wiki::Toolkit::Search::SII->new( indexdb => $indexdb ); 
     58        foreach my $node ( @nodes ) { 
     59            my $content = $store->retrieve_node( $node ); 
     60            $search->index_node( $node, $content ); 
     61        } 
    6262    } 
    6363} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Setup/SQLite.pm

    r235 r431  
    1414 
    1515my %create_sql = ( 
    16         schema_info => " 
     16    schema_info => " 
    1717CREATE TABLE schema_info ( 
    1818  version   integer      NOT NULL default 0 
    … …  
    104104    my %tables = fetch_tables_listing($dbh); 
    105105 
    106         # Do we need to upgrade the schema? 
    107         # (Don't check if no tables currently exist) 
    108         my $upgrade_schema; 
    109         my @cur_data;  
    110         if(scalar keys %tables > 0) { 
    111                 $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
    112         } 
    113         if($upgrade_schema) { 
    114                 # Grab current data 
    115                 print "Upgrading: $upgrade_schema\n"; 
    116                 @cur_data = eval("&Wiki::Toolkit::Setup::Database::fetch_upgrade_".$upgrade_schema."(\$dbh)"); 
    117  
    118                 # Drop the current tables 
    119                 cleardb($dbh); 
    120  
    121                 # Grab new list of tables 
    122                 %tables = fetch_tables_listing($dbh); 
    123         } 
    124  
    125         # Set up tables if not found 
     106    # Do we need to upgrade the schema? 
     107    # (Don't check if no tables currently exist) 
     108    my $upgrade_schema; 
     109    my @cur_data;  
     110    if(scalar keys %tables > 0) { 
     111        $upgrade_schema = Wiki::Toolkit::Setup::Database::get_database_upgrade_required($dbh,$VERSION); 
     112    } 
     113    if($upgrade_schema) { 
     114        # Grab current data 
     115        print "Upgrading: $upgrade_schema\n"; 
     116        @cur_data = eval("&Wiki::Toolkit::Setup::Database::fetch_upgrade_".$upgrade_schema."(\$dbh)"); 
     117 
     118        # Drop the current tables 
     119        cleardb($dbh); 
     120 
     121        # Grab new list of tables 
     122        %tables = fetch_tables_listing($dbh); 
     123    } 
     124 
     125    # Set up tables if not found 
    126126    foreach my $required ( keys %create_sql ) { 
    127127        if ( $tables{$required} ) { 
    … …  
    130130            print "Creating table $required... done\n"; 
    131131            $dbh->do($create_sql{$required}) or croak $dbh->errstr; 
    132                 } 
    133     } 
    134  
    135         # Schema version 
    136         $dbh->do("DELETE FROM schema_info"); 
    137         $dbh->do("INSERT INTO schema_info VALUES (". ($VERSION*100) .")"); 
    138  
    139         # If upgrading, load in the new data 
    140         if($upgrade_schema) { 
    141                 Wiki::Toolkit::Setup::Database::bulk_data_insert($dbh,@cur_data); 
    142         } 
     132        } 
     133    } 
     134 
     135    # Schema version 
     136    $dbh->do("DELETE FROM schema_info"); 
     137    $dbh->do("INSERT INTO schema_info VALUES (". ($VERSION*100) .")"); 
     138 
     139    # If upgrading, load in the new data 
     140    if($upgrade_schema) { 
     141        Wiki::Toolkit::Setup::Database::bulk_data_insert($dbh,@cur_data); 
     142    } 
    143143 
    144144    # Clean up if we made our own dbh. 
    … …  
    148148# Internal method - what tables are defined? 
    149149sub fetch_tables_listing { 
    150         my $dbh = shift; 
     150    my $dbh = shift; 
    151151 
    152152    # Check whether tables exist, set them up if not. 
    … …  
    160160        $tables{$table} = 1; 
    161161    } 
    162         return %tables; 
     162    return %tables; 
    163163} 
    164164 
    … …  
    216216        if ( $args{dbh} ) { 
    217217            return $args{dbh}; 
    218         } else { 
     218    } else { 
    219219            return _make_dbh( %args ); 
    220220        } 
    … …  
    236236        if ( $args{dbh} ) { 
    237237            return 0; 
    238         } else { 
     238    } else { 
    239239            return 1; 
    240240        } 
    … …  
    248248    my %args = @_; 
    249249    my $dbh = DBI->connect("dbi:SQLite:dbname=$args{dbname}", "", "", 
    250                            { PrintError => 1, RaiseError => 1, 
    251                              AutoCommit => 1 } ) 
    252       or croak DBI::errstr; 
     250               { PrintError => 1, RaiseError => 1, 
     251                 AutoCommit => 1 } ) 
     252        or croak DBI::errstr; 
    253253    return $dbh; 
    254254} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Store/Database.pm

    r424 r431  
    2121my $CAN_USE_ENCODE; 
    2222BEGIN { 
    23   eval " use Encode "; 
    24   $CAN_USE_ENCODE = $@ ? 0 : 1; 
     23    eval " use Encode "; 
     24    $CAN_USE_ENCODE = $@ ? 0 : 1; 
    2525} 
    2626 
    … …  
    107107        # Connect to database and store the database handle. 
    108108        my ($dbname, $dbuser, $dbpass, $dbhost, $dbport) = 
    109                                @$self{qw(_dbname _dbuser _dbpass _dbhost _dbport)}; 
     109                           @$self{qw(_dbname _dbuser _dbpass _dbhost _dbport)}; 
    110110        my $dsn = $self->_dsn($dbname, $dbhost, $dbport) 
    111111            or croak "No data source string provided by class"; 
    112112        $self->{_dbh} = DBI->connect( $dsn, $dbuser, $dbpass, 
    113                                       { PrintError => 0, RaiseError => 1, 
    114                                         AutoCommit => 1 } ) 
    115           or croak "Can't connect to database $dbname using $dsn: " 
     113                      { PrintError => 0, RaiseError => 1, 
     114                        AutoCommit => 1 } ) 
     115            or croak "Can't connect to database $dbname using $dsn: " 
    116116                   . DBI->errstr; 
    117117    } 
    … …  
    130130#  values from pre_ plugins 
    131131sub handle_pre_plugin_ret { 
    132         my ($running_total_ref,$result) = @_; 
    133  
    134         if(($result && $result == 0) || !$result) { 
    135                 # No opinion, no need to change things 
    136         } elsif($result == -1 || $result == 1) { 
    137                 # Increase or decrease as requested 
    138                 $$running_total_ref += $result; 
    139         } else { 
    140                 # Invalid return code 
    141                 warn("Pre_ plugin returned invalid accept/deny value of '$result'"); 
    142         } 
     132    my ($running_total_ref,$result) = @_; 
     133 
     134    if(($result && $result == 0) || !$result) { 
     135        # No opinion, no need to change things 
     136    } elsif($result == -1 || $result == 1) { 
     137        # Increase or decrease as requested 
     138        $$running_total_ref += $result; 
     139    } else { 
     140        # Invalid return code 
     141        warn("Pre_ plugin returned invalid accept/deny value of '$result'"); 
     142    } 
    143143} 
    144144 
    … …  
    158158  # Or get an earlier version: 
    159159  my %node = $store->retrieve_node(name    => "HomePage", 
    160                                      version => 2 ); 
     160                         version => 2 ); 
    161161  print $node{content}; 
    162162 
    … …  
    189189    my $self = shift; 
    190190    my %args = scalar @_ == 1 ? ( name => $_[0] ) : @_; 
    191         unless($args{'version'}) { $args{'version'} = undef; } 
     191    unless($args{'version'}) { $args{'version'} = undef; } 
    192192 
    193193    # Call pre_retrieve on any plugins, in case they want to tweak anything 
    … …  
    196196        if ( $plugin->can( "pre_retrieve" ) ) { 
    197197            $plugin->pre_retrieve(  
    198                                 node     => \$args{'name'}, 
    199                                 version  => \$args{'version'} 
    200                         ); 
     198                node     => \$args{'name'}, 
     199                version  => \$args{'version'} 
     200            ); 
    201201        } 
    202202    } 
    203203 
    204204    # Note _retrieve_node_data is sensitive to calling context. 
    205         unless(wantarray) { 
    206                 # Scalar context, will return just the content 
    207                 return $self->_retrieve_node_data( %args ); 
    208         } 
     205    unless(wantarray) { 
     206        # Scalar context, will return just the content 
     207        return $self->_retrieve_node_data( %args ); 
     208    } 
    209209 
    210210    my %data = $self->_retrieve_node_data( %args ); 
    211         $data{'checksum'} = $self->_checksum(%data); 
     211    $data{'checksum'} = $self->_checksum(%data); 
    212212    return %data; 
    213213} 
    … …  
    217217    my ($self, %args) = @_; 
    218218    my %data = $self->_retrieve_node_content( %args ); 
    219         unless(wantarray) { 
    220                 # Scalar context, return just the content 
    221                 return $data{content}; 
    222         } 
     219    unless(wantarray) { 
     220        # Scalar context, return just the content 
     221        return $data{content}; 
     222    } 
    223223 
    224224    # If we want additional data then get it.  Note that $data{version} 
    … …  
    237237    while ( my ($type, $val) = $self->charset_decode( $sth->fetchrow_array ) ) { 
    238238        if ( defined $metadata{$type} ) { 
    239                 push @{$metadata{$type}}, $val; 
    240             } else { 
     239            push @{$metadata{$type}}, $val; 
     240        } else { 
    241241            $metadata{$type} = [ $val ]; 
    242242        } 
    … …  
    256256    my $sql; 
    257257 
    258         my $version_sql_val; 
    259         my $text_source; 
     258    my $version_sql_val; 
     259    my $text_source; 
    260260    if ( $args{version} ) { 
    261                 # Version given - get that version, and the content for that version 
    262                 $version_sql_val = $dbh->quote($self->charset_encode($args{version})); 
    263                 $text_source = "content"; 
    264         } else { 
    265                 # No version given, grab latest version (and content for that) 
    266                 $version_sql_val = "node.version"; 
    267                 $text_source = "node"; 
    268         } 
     261        # Version given - get that version, and the content for that version 
     262        $version_sql_val = $dbh->quote($self->charset_encode($args{version})); 
     263        $text_source = "content"; 
     264    } else { 
     265        # No version given, grab latest version (and content for that) 
     266        $version_sql_val = "node.version"; 
     267        $text_source = "node"; 
     268    } 
    269269    $sql = "SELECT " 
    270270         . "     $text_source.text, content.version, " 
    … …  
    338338        my %args = @_; 
    339339        return $self->_do_old_node_exists( $args{name} ) 
    340           unless $args{ignore_case}; 
     340            unless $args{ignore_case}; 
    341341        my $sql = $self->_get_node_exists_ignore_case_sql; 
    342342        my $sth = $self->dbh->prepare( $sql ); 
    … …  
    485485    my @links_to = @{ $links_to_ref || [] }; # default to empty array 
    486486    my $version; 
    487         unless($requires_moderation) { $requires_moderation = 0; } 
     487    unless($requires_moderation) { $requires_moderation = 0; } 
    488488 
    489489    # Call pre_write on any plugins, in case they want to tweak anything 
    490490    my @preplugins = @{ $args{plugins} || [ ] }; 
    491         my $write_allowed = 1; 
     491    my $write_allowed = 1; 
    492492    foreach my $plugin (@preplugins) { 
    493493        if ( $plugin->can( "pre_write" ) ) { 
    494                         handle_pre_plugin_ret( 
    495                                 \$write_allowed, 
    496                                 $plugin->pre_write(  
    497                                         node     => \$node, 
    498                                         content  => \$content, 
    499                                         metadata => \$metadata_ref ) 
    500                         ); 
    501         } 
    502     } 
    503         if($write_allowed < 1) { 
    504                 # The plugins didn't want to allow this action 
    505                 return -1; 
    506         } 
     494            handle_pre_plugin_ret( 
     495                \$write_allowed, 
     496                $plugin->pre_write(  
     497                    node     => \$node, 
     498                    content  => \$content, 
     499                    metadata => \$metadata_ref ) 
     500            ); 
     501        } 
     502    } 
     503    if($write_allowed < 1) { 
     504        # The plugins didn't want to allow this action 
     505        return -1; 
     506    } 
    507507 
    508508    # Either inserting a new page or updating an old one. 
    … …  
    511511 
    512512 
    513         # If it doesn't exist, add it right now 
     513    # If it doesn't exist, add it right now 
    514514    if(! $exists) { 
    515                 # Add in a new version 
     515        # Add in a new version 
    516516        $version = 1; 
    517517 
    518                 # Handle initial moderation 
    519                 my $node_content = $content; 
    520                 if($requires_moderation) { 
    521                         $node_content = "=== This page has yet to be moderated. ==="; 
    522                 } 
    523  
    524                 # Add the node and content 
     518        # Handle initial moderation 
     519        my $node_content = $content; 
     520        if($requires_moderation) { 
     521            $node_content = "=== This page has yet to be moderated. ==="; 
     522        } 
     523 
     524        # Add the node and content 
    525525        my $add_sql =  
    526                         "INSERT INTO node " 
    527                         ."    (name, version, text, modified, moderate) " 
    528                         ."VALUES (?, ?, ?, ?, ?)"; 
    529                 my $add_sth = $dbh->prepare($add_sql); 
    530                 $add_sth->execute( 
    531                         map{ $self->charset_encode($_) } 
    532                                 ($node, $version, $node_content, $timestamp, $requires_moderation) 
    533                 ) or croak "Error updating database: " . DBI->errstr; 
     526            "INSERT INTO node " 
     527            ."    (name, version, text, modified, moderate) " 
     528            ."VALUES (?, ?, ?, ?, ?)"; 
     529        my $add_sth = $dbh->prepare($add_sql); 
     530        $add_sth->execute( 
     531            map{ $self->charset_encode($_) } 
     532                ($node, $version, $node_content, $timestamp, $requires_moderation) 
     533        ) or croak "Error updating database: " . DBI->errstr; 
    534534    } 
    535535 
    536536    # Get the ID of the node we've added / we're about to update 
    537         # Also get the moderation status for it 
     537    # Also get the moderation status for it 
    538538    $sql = "SELECT id, moderate FROM node WHERE name=" . $dbh->quote($node); 
    539539    my ($node_id,$node_requires_moderation) = $dbh->selectrow_array($sql); 
    540540 
    541         # Only update node if it exists, and moderation isn't enabled on the node 
    542         # Whatever happens, if it exists, generate a new version number 
     541    # Only update node if it exists, and moderation isn't enabled on the node 
     542    # Whatever happens, if it exists, generate a new version number 
    543543    if($exists) { 
    544                 # Get the new version number 
     544        # Get the new version number 
    545545        $sql = "SELECT max(content.version) FROM node 
    546546                INNER JOIN content ON (id = node_id) 
    … …  
    550550        $version++; 
    551551 
    552                 # Update the node only if node doesn't require moderation 
    553                 if(!$node_requires_moderation) { 
    554                         $sql = "UPDATE node SET version=" . $dbh->quote($version) 
    555                         . ", text=" . $dbh->quote($self->charset_encode($content)) 
    556                         . ", modified=" . $dbh->quote($timestamp) 
    557                         . " WHERE name=" . $dbh->quote($self->charset_encode($node)); 
    558                         $dbh->do($sql) or croak "Error updating database: " . DBI->errstr; 
    559                 } 
    560  
    561                 # You can't use this to enable moderation on an existing node 
     552        # Update the node only if node doesn't require moderation 
     553        if(!$node_requires_moderation) { 
     554            $sql = "UPDATE node SET version=" . $dbh->quote($version) 
     555            . ", text=" . $dbh->quote($self->charset_encode($content)) 
     556            . ", modified=" . $dbh->quote($timestamp) 
     557            . " WHERE name=" . $dbh->quote($self->charset_encode($node)); 
     558            $dbh->do($sql) or croak "Error updating database: " . DBI->errstr; 
     559        } 
     560 
     561        # You can't use this to enable moderation on an existing node 
    562562        if($requires_moderation) { 
    563563           warn("Moderation not added to existing node '$node', use normal moderation methods instead"); 
    564564        } 
    565         } 
     565    } 
    566566 
    567567 
    568568    # Now node is updated (if required), add to the history 
    569569    my $add_sql =  
    570                 "INSERT INTO content " 
    571                 ."      (node_id, version, text, modified, moderated) " 
    572                 ."VALUES (?, ?, ?, ?, ?)"; 
    573         my $add_sth = $dbh->prepare($add_sql); 
    574         $add_sth->execute( 
    575                 map { $self->charset_encode($_) } 
    576                         ($node_id, $version, $content, $timestamp, (1-$node_requires_moderation)) 
     570        "INSERT INTO content " 
     571        ."    (node_id, version, text, modified, moderated) " 
     572        ."VALUES (?, ?, ?, ?, ?)"; 
     573    my $add_sth = $dbh->prepare($add_sql); 
     574    $add_sth->execute( 
     575        map { $self->charset_encode($_) } 
     576            ($node_id, $version, $content, $timestamp, (1-$node_requires_moderation)) 
    577577    ) or croak "Error updating database: " . DBI->errstr; 
    578578 
    … …  
    621621 
    622622            foreach my $value ( @values ) { 
    623                                 $add_sth->execute( 
     623                $add_sth->execute( 
    624624                    map { $self->charset_encode($_) } 
    625625                        ( $node_id, $version, $type, $value ) 
    626                     ) or croak $dbh->errstr; 
     626                ) or croak $dbh->errstr; 
    627627            } 
    628             } else { 
     628        } else { 
    629629            # Otherwise grab a checksum and store that. 
    630630            my $type_to_store  = "__" . $type . "__checksum"; 
    … …  
    634634                      ( $node_id, $version, $type_to_store, $value_to_store ) 
    635635            )  or croak $dbh->errstr; 
    636             } 
     636        } 
    637637    } 
    638638 
    … …  
    642642        if ( $plugin->can( "post_write" ) ) { 
    643643            $plugin->post_write(  
    644                                 node     => $node, 
    645                                 node_id  => $node_id, 
    646                                 version  => $version, 
    647                                 content  => $content, 
    648                                 metadata => $metadata_ref ); 
     644                node     => $node, 
     645                node_id  => $node_id, 
     646                version  => $version, 
     647                content  => $content, 
     648                metadata => $metadata_ref ); 
    649649        } 
    650650    } 
    … …  
    659659    my $time = shift || localtime; # Overloaded by Time::Piece. 
    660660    unless( ref $time ) { 
    661         $time = localtime($time); # Make it into an object for strftime 
     661    $time = localtime($time); # Make it into an object for strftime 
    662662    } 
    663663    return $time->strftime($timestamp_fmt); # global 
    … …  
    684684    my ($self, %args) = @_; 
    685685    my ($old_name,$new_name,$wiki,$create_new_versions) =  
    686                 @args{ qw( old_name new_name wiki create_new_versions ) }; 
     686        @args{ qw( old_name new_name wiki create_new_versions ) }; 
    687687    my $dbh = $self->dbh; 
    688         my $formatter = $wiki->{_formatter}; 
     688    my $formatter = $wiki->{_formatter}; 
    689689 
    690690    my $timestamp = $self->_get_timestamp(); 
    … …  
    692692    # Call pre_rename on any plugins, in case they want to tweak anything 
    693693    my @preplugins = @{ $args{plugins} || [ ] }; 
    694         my $rename_allowed = 1; 
     694    my $rename_allowed = 1; 
    695695    foreach my $plugin (@preplugins) { 
    696696        if ( $plugin->can( "pre_rename" ) ) { 
    697                         handle_pre_plugin_ret( 
    698                                 \$rename_allowed, 
    699                                 $plugin->pre_rename(  
    700                                         old_name => \$old_name, 
    701                                         new_name => \$new_name, 
    702                                         create_new_versions => \$create_new_versions, 
    703                                 ) 
    704                         ); 
    705         } 
    706     } 
    707         if($rename_allowed < 1) { 
    708                 # The plugins didn't want to allow this action 
    709                 return -1; 
    710         } 
    711  
    712         # Get the ID of the node 
    713         my $sql = "SELECT id FROM node WHERE name=?"; 
    714         my $sth = $dbh->prepare($sql); 
    715         $sth->execute($old_name); 
    716         my ($node_id) = $sth->fetchrow_array; 
     697            handle_pre_plugin_ret( 
     698                \$rename_allowed, 
     699                $plugin->pre_rename(  
     700                    old_name => \$old_name, 
     701                    new_name => \$new_name, 
     702                    create_new_versions => \$create_new_versions, 
     703                ) 
     704            ); 
     705        } 
     706    } 
     707    if($rename_allowed < 1) { 
     708        # The plugins didn't want to allow this action 
     709        return -1; 
     710    } 
     711 
     712    # Get the ID of the node 
     713    my $sql = "SELECT id FROM node WHERE name=?"; 
     714    my $sth = $dbh->prepare($sql); 
     715    $sth->execute($old_name); 
     716    my ($node_id) = $sth->fetchrow_array; 
    717717    $sth->finish; 
    718718 
    719719 
    720         # If the formatter supports it, get a list of the internal 
    721         #  links to the page, which will have their links re-written 
    722         # (Do now before we update the name of the node, in case of 
    723         #  self links) 
    724         my @links; 
    725         if($formatter->can("rename_links")) { 
    726                 # Get a list of the pages that link to the page 
    727                 $sql = "SELECT id, name, version " 
    728                         ."FROM internal_links " 
    729                         ."INNER JOIN node " 
    730                         ."      ON (link_from = name) " 
    731                         ."WHERE link_to = ?"; 
    732                 $sth = $dbh->prepare($sql); 
    733                 $sth->execute($old_name); 
    734  
    735                 # Grab them all, then update, so no locking problems 
    736                 while(my @l = $sth->fetchrow_array) { push (@links, \@l); } 
    737         } 
    738  
    739          
    740         # Rename the node 
    741         $sql = "UPDATE node SET name=? WHERE id=?"; 
    742         $sth = $dbh->prepare($sql); 
    743         $sth->execute($new_name,$node_id); 
    744  
    745  
    746         # Fix the internal links from this page 
    747         # (Otherwise write_node will get confused if we rename links later on) 
    748         $sql = "UPDATE internal_links SET link_from=? WHERE link_from=?"; 
    749         $sth = $dbh->prepare($sql); 
    750         $sth->execute($new_name,$old_name); 
    751  
    752  
    753         # Update the text of internal links, if the formatter supports it 
    754         if($formatter->can("rename_links")) { 
    755                 # Update the linked pages (may include renamed page) 
    756                 foreach my $l (@links) { 
    757                         my ($page_id, $page_name, $page_version) = @$l; 
    758                         # Self link special case 
    759                         if($page_name eq $old_name) { $page_name = $new_name; } 
    760  
    761                         # Grab the latest version of that page 
    762                         my %page = $self->retrieve_node( 
    763                                         name=>$page_name, version=>$page_version 
    764                         ); 
    765  
    766                         # Update the content of the page 
    767                         my $new_content =  
    768                                 $formatter->rename_links($old_name,$new_name,$page{'content'}); 
    769  
    770                         # Did it change? 
    771                         if($new_content ne $page{'content'}) { 
    772                                 # Write the updated page out 
    773                                 if($create_new_versions) { 
    774                                         # Write out as a new version of the node 
    775                                         # (This will also fix our internal links) 
    776                                         $wiki->write_node( 
    777                                                                 $page_name,  
    778                                                                 $new_content, 
    779                                                                 $page{checksum}, 
    780                                                                 $page{metadata} 
    781                                         ); 
    782                                 } else { 
    783                                         # Just update the content 
    784                                         my $update_sql_a = "UPDATE node SET text=? WHERE id=?"; 
    785                                         my $update_sql_b = "UPDATE content SET text=? ". 
    786                                                                            "WHERE node_id=? AND version=?"; 
    787  
    788                                         my $u_sth = $dbh->prepare($update_sql_a); 
    789                                         $u_sth->execute($new_content,$page_id); 
    790                                         $u_sth = $dbh->prepare($update_sql_b); 
    791                                         $u_sth->execute($new_content,$page_id,$page_version); 
    792                                 } 
    793                         } 
    794                 } 
    795  
    796                 # Fix the internal links if we didn't create new versions of the node 
    797                 if(! $create_new_versions) { 
    798                         $sql = "UPDATE internal_links SET link_to=? WHERE link_to=?"; 
    799                         $sth = $dbh->prepare($sql); 
    800                         $sth->execute($new_name,$old_name); 
    801                 } 
    802         } else { 
    803                 warn("Internal links not updated following node rename - unsupported by formatter"); 
    804         } 
     720    # If the formatter supports it, get a list of the internal 
     721    #  links to the page, which will have their links re-written 
     722    # (Do now before we update the name of the node, in case of 
     723    #  self links) 
     724    my @links; 
     725    if($formatter->can("rename_links")) { 
     726        # Get a list of the pages that link to the page 
     727        $sql = "SELECT id, name, version " 
     728            ."FROM internal_links " 
     729            ."INNER JOIN node " 
     730            ."    ON (link_from = name) " 
     731            ."WHERE link_to = ?"; 
     732        $sth = $dbh->prepare($sql); 
     733        $sth->execute($old_name); 
     734 
     735        # Grab them all, then update, so no locking problems 
     736        while(my @l = $sth->fetchrow_array) { push (@links, \@l); } 
     737    } 
     738 
     739     
     740    # Rename the node 
     741    $sql = "UPDATE node SET name=? WHERE id=?"; 
     742    $sth = $dbh->prepare($sql); 
     743    $sth->execute($new_name,$node_id); 
     744 
     745 
     746    # Fix the internal links from this page 
     747    # (Otherwise write_node will get confused if we rename links later on) 
     748    $sql = "UPDATE internal_links SET link_from=? WHERE link_from=?"; 
     749    $sth = $dbh->prepare($sql); 
     750    $sth->execute($new_name,$old_name); 
     751 
     752 
     753    # Update the text of internal links, if the formatter supports it 
     754    if($formatter->can("rename_links")) { 
     755        # Update the linked pages (may include renamed page) 
     756        foreach my $l (@links) { 
     757            my ($page_id, $page_name, $page_version) = @$l; 
     758            # Self link special case 
     759            if($page_name eq $old_name) { $page_name = $new_name; } 
     760 
     761            # Grab the latest version of that page 
     762            my %page = $self->retrieve_node( 
     763                    name=>$page_name, version=>$page_version 
     764            ); 
     765 
     766            # Update the content of the page 
     767            my $new_content =  
     768                $formatter->rename_links($old_name,$new_name,$page{'content'}); 
     769 
     770            # Did it change? 
     771            if($new_content ne $page{'content'}) { 
     772                # Write the updated page out 
     773                if($create_new_versions) { 
     774                    # Write out as a new version of the node 
     775                    # (This will also fix our internal links) 
     776                    $wiki->write_node( 
     777                                $page_name,  
     778                                $new_content, 
     779                                $page{checksum}, 
     780                                $page{metadata} 
     781                    ); 
     782                } else { 
     783                    # Just update the content 
     784                    my $update_sql_a = "UPDATE node SET text=? WHERE id=?"; 
     785                    my $update_sql_b = "UPDATE content SET text=? ". 
     786                                       "WHERE node_id=? AND version=?"; 
     787 
     788                    my $u_sth = $dbh->prepare($update_sql_a); 
     789                    $u_sth->execute($new_content,$page_id); 
     790                    $u_sth = $dbh->prepare($update_sql_b); 
     791                    $u_sth->execute($new_content,$page_id,$page_version); 
     792                } 
     793            } 
     794        } 
     795 
     796        # Fix the internal links if we didn't create new versions of the node 
     797        if(! $create_new_versions) { 
     798            $sql = "UPDATE internal_links SET link_to=? WHERE link_to=?"; 
     799            $sth = $dbh->prepare($sql); 
     800            $sth->execute($new_name,$old_name); 
     801        } 
     802    } else { 
     803        warn("Internal links not updated following node rename - unsupported by formatter"); 
     804    } 
    805805 
    806806    # Call post_rename on any plugins, in case they want to do anything 
    … …  
    809809        if ( $plugin->can( "post_rename" ) ) { 
    810810            $plugin->post_rename(  
    811                                 old_name => $old_name, 
    812                                 new_name => $new_name, 
    813                                 node_id => $node_id, 
    814                         ); 
     811                old_name => $old_name, 
     812                new_name => $new_name, 
     813                node_id => $node_id, 
     814            ); 
    815815        } 
    816816    } 
    … …  
    835835    my $dbh = $self->dbh; 
    836836 
    837         my ($name,$version) = ($args{name},$args{version}); 
     837    my ($name,$version) = ($args{name},$args{version}); 
    838838 
    839839    # Call pre_moderate on any plugins. 
    840840    my @plugins = @{ $args{plugins} || [ ] }; 
    841         my $moderation_allowed = 1; 
     841    my $moderation_allowed = 1; 
    842842    foreach my $plugin (@plugins) { 
    843843        if ( $plugin->can( "pre_moderate" ) ) { 
    844                         handle_pre_plugin_ret( 
    845                                 \$moderation_allowed, 
    846                                 $plugin->pre_moderate(  
    847                                         node     => \$name, 
    848                                         version  => \$version ) 
    849                         ); 
    850         } 
    851     } 
    852         if($moderation_allowed < 1) { 
    853                 # The plugins didn't want to allow this action 
    854                 return -1; 
    855         } 
    856  
    857         # Get the ID of this node 
     844            handle_pre_plugin_ret( 
     845                \$moderation_allowed, 
     846                $plugin->pre_moderate(  
     847                    node     => \$name, 
     848                    version  => \$version ) 
     849            ); 
     850        } 
     851    } 
     852    if($moderation_allowed < 1) { 
     853        # The plugins didn't want to allow this action 
     854        return -1; 
     855    } 
     856 
     857    # Get the ID of this node 
    858858    my $id_sql = "SELECT id FROM node WHERE name=?"; 
    859859    my $id_sth = $dbh->prepare($id_sql); 
    860860    $id_sth->execute($name); 
    861         my ($node_id) = $id_sth->fetchrow_array; 
     861    my ($node_id) = $id_sth->fetchrow_array; 
    862862    $id_sth->finish; 
    863863 
    864         # Check what the current highest moderated version is 
    865         my $hv_sql =  
    866                 "SELECT max(version) " 
    867                 ."FROM content " 
    868                 ."WHERE node_id = ? " 
    869                 ."AND moderated = ?"; 
    870         my $hv_sth = $dbh->prepare($hv_sql); 
    871         $hv_sth->execute($node_id, "1") or croak $dbh->errstr; 
    872         my ($highest_mod_version) = $hv_sth->fetchrow_array; 
     864    # Check what the current highest moderated version is 
     865    my $hv_sql =  
     866        "SELECT max(version) " 
     867        ."FROM content " 
     868        ."WHERE node_id = ? " 
     869        ."AND moderated = ?"; 
     870    my $hv_sth = $dbh->prepare($hv_sql); 
     871    $hv_sth->execute($node_id, "1") or croak $dbh->errstr; 
     872    my ($highest_mod_version) = $hv_sth->fetchrow_array; 
    873873    $hv_sth->finish; 
    874         unless($highest_mod_version) { $highest_mod_version = 0; } 
    875  
    876         # Mark this version as moderated 
    877         my $update_sql =  
    878                 "UPDATE content " 
    879                 ."SET moderated = ? " 
    880                 ."WHERE node_id = ? " 
    881                 ."AND version = ?"; 
    882         my $update_sth = $dbh->prepare($update_sql); 
    883         $update_sth->execute("1", $node_id, $version) or croak $dbh->errstr; 
    884  
    885         # Are we now the highest moderated version? 
    886         if(int($version) > int($highest_mod_version)) { 
    887                 # Newly moderated version is newer than previous moderated version 
    888                 # So, make the current version the latest version 
    889                 my %new_data = $self->retrieve_node( name => $name, version => $version ); 
    890  
    891                 # Make sure last modified is properly null, if not set 
    892                 unless($new_data{last_modified}) { $new_data{last_modified} = undef; } 
    893  
    894                 my $newv_sql =  
    895                         "UPDATE node " 
    896                         ."SET version=?, text=?, modified=? " 
    897                         ."WHERE id = ?"; 
    898                 my $newv_sth = $dbh->prepare($newv_sql); 
    899                 $newv_sth->execute( 
    900                         $version, $self->charset_encode($new_data{content}),  
    901                         $new_data{last_modified}, $node_id 
    902                 ) or croak $dbh->errstr; 
    903         } else { 
    904                 # A higher version is already moderated, so don't change node 
    905         } 
    906  
    907         # TODO: Do something about internal links, if required 
     874    unless($highest_mod_version) { $highest_mod_version = 0; } 
     875 
     876    # Mark this version as moderated 
     877    my $update_sql =  
     878        "UPDATE content " 
     879        ."SET moderated = ? " 
     880        ."WHERE node_id = ? " 
     881        ."AND version = ?"; 
     882    my $update_sth = $dbh->prepare($update_sql); 
     883    $update_sth->execute("1", $node_id, $version) or croak $dbh->errstr; 
     884 
     885    # Are we now the highest moderated version? 
     886    if(int($version) > int($highest_mod_version)) { 
     887        # Newly moderated version is newer than previous moderated version 
     888        # So, make the current version the latest version 
     889        my %new_data = $self->retrieve_node( name => $name, version => $version ); 
     890 
     891        # Make sure last modified is properly null, if not set 
     892        unless($new_data{last_modified}) { $new_data{last_modified} = undef; } 
     893 
     894        my $newv_sql =  
     895            "UPDATE node " 
     896            ."SET version=?, text=?, modified=? " 
     897            ."WHERE id = ?"; 
     898        my $newv_sth = $dbh->prepare($newv_sql); 
     899        $newv_sth->execute( 
     900            $version, $self->charset_encode($new_data{content}),  
     901            $new_data{last_modified}, $node_id 
     902        ) or croak $dbh->errstr; 
     903    } else { 
     904        # A higher version is already moderated, so don't change node 
     905    } 
     906 
     907    # TODO: Do something about internal links, if required 
    908908 
    909909    # Finally call post_moderate on any plugins. 
    … …  
    912912        if ( $plugin->can( "post_moderate" ) ) { 
    913913            $plugin->post_moderate(  
    914                                 node     => $name, 
    915                                 node_id  => $node_id, 
    916                                 version  => $version ); 
    917         } 
    918     } 
    919  
    920         return 1; 
     914                node     => $name, 
     915                node_id  => $node_id, 
     916                version  => $version ); 
     917        } 
     918    } 
     919 
     920    return 1; 
    921921} 
    922922 
    … …  
    937937    my $dbh = $self->dbh; 
    938938 
    939         my ($name,$required) = ($args{name},$args{required}); 
    940  
    941         # Get the ID of this node 
     939    my ($name,$required) = ($args{name},$args{required}); 
     940 
     941    # Get the ID of this node 
    942942    my $id_sql = "SELECT id FROM node WHERE name=?"; 
    943943    my $id_sth = $dbh->prepare($id_sql); 
    944944    $id_sth->execute($name); 
    945         my ($node_id) = $id_sth->fetchrow_array; 
     945    my ($node_id) = $id_sth->fetchrow_array; 
    946946    $id_sth->finish; 
    947947 
    948         # Check we really got an ID 
     948    # Check we really got an ID 
    949949    unless($node_id) { 
    950950        return 0; 
    951951    } 
    952952 
    953         # Mark it as requiring / not requiring moderation 
    954         my $mod_sql =  
    955                 "UPDATE node " 
    956                 ."SET moderate = ? " 
    957                 ."WHERE id = ? "; 
    958         my $mod_sth = $dbh->prepare($mod_sql); 
    959         $mod_sth->execute("$required", $node_id) or croak $dbh->errstr; 
    960  
    961         return 1; 
     953    # Mark it as requiring / not requiring moderation 
     954    my $mod_sql =  
     955        "UPDATE node " 
     956        ."SET moderate = ? " 
     957        ."WHERE id = ? "; 
     958    my $mod_sth = $dbh->prepare($mod_sql); 
     959    $mod_sth->execute("$required", $node_id) or croak $dbh->errstr; 
     960 
     961    return 1; 
    962962} 
    963963 
    … …  
    999999    my $id_sth = $dbh->prepare($id_sql); 
    10001000    $id_sth->execute($name); 
    1001         my ($node_id) = $id_sth->fetchrow_array; 
     1001    my ($node_id) = $id_sth->fetchrow_array; 
    10021002    $id_sth->finish; 
    10031003 
    … …  
    10171017 
    10181018        # And finish it here. 
    1019                 post_delete_node($name,$node_id,$version,$args{plugins}); 
     1019        post_delete_node($name,$node_id,$version,$args{plugins}); 
    10201020        return 1; 
    10211021    } 
    … …  
    10231023    # Skip out early if we're trying to delete a nonexistent version. 
    10241024    my %verdata = $self->retrieve_node( name => $name, version => $version ); 
    1025         unless($verdata{version}) { 
    1026                 warn("Asked to delete non existant version $version of node $node_id ($name)"); 
    1027                 return 1; 
    1028         } 
     1025    unless($verdata{version}) { 
     1026        warn("Asked to delete non existant version $version of node $node_id ($name)"); 
     1027        return 1; 
     1028    } 
    10291029 
    10301030    # Reduce to trivial case if deleting the only version. 
    … …  
    10341034    my ($count) = $sth->fetchrow_array; 
    10351035    $sth->finish; 
    1036         if($count == 1) { 
    1037                 # Only one version, so can do the non version delete 
    1038             return $self->delete_node( name=>$name, plugins=>$args{plugins} ); 
    1039         } 
     1036    if($count == 1) { 
     1037        # Only one version, so can do the non version delete 
     1038        return $self->delete_node( name=>$name, plugins=>$args{plugins} ); 
     1039    } 
    10401040 
    10411041    # Check whether we're deleting the latest (moderated) version. 
    10421042    my %currdata = $self->retrieve_node( name => $name ); 
    10431043    if ( $currdata{version} == $version ) { 
    1044                 # Deleting latest version, so need to update the copy in node 
     1044        # Deleting latest version, so need to update the copy in node 
    10451045        # (Can't just grab version ($version - 1) since it may have been 
    10461046        #  deleted itself, or might not be moderated.) 
    … …  
    10611061        my $sth = $dbh->prepare( $sql ); 
    10621062        $sth->execute( @prevdata{ qw( version content last_modified ) }, $name) 
    1063           or croak "Deletion failed: " . $dbh->errstr; 
    1064  
    1065                 # Remove the current version from content 
     1063            or croak "Deletion failed: " . $dbh->errstr; 
     1064 
     1065        # Remove the current version from content 
    10661066        $sql = "DELETE FROM content  
    10671067                WHERE node_id = $node_id  
    … …  
    10691069        $sth = $dbh->prepare( $sql ); 
    10701070        $sth->execute() 
    1071           or croak "Deletion failed: " . $dbh->errstr; 
    1072  
    1073                 # Update the internal links to reflect the new version 
     1071            or croak "Deletion failed: " . $dbh->errstr; 
     1072 
     1073        # Update the internal links to reflect the new version 
    10741074        $sql = "DELETE FROM internal_links WHERE link_from=?"; 
    10751075        $sth = $dbh->prepare( $sql ); 
    … …  
    10931093        } 
    10941094 
    1095                 # Delete the metadata for the old version 
     1095        # Delete the metadata for the old version 
    10961096        $sql = "DELETE FROM metadata  
    10971097                WHERE node_id = $node_id  
    … …  
    10991099        $sth = $dbh->prepare( $sql ); 
    11001100        $sth->execute() 
    1101           or croak "Deletion failed: " . $dbh->errstr; 
    1102  
    1103                 # All done 
    1104                 post_delete_node($name,$node_id,$version,$args{plugins}); 
     1101            or croak "Deletion failed: " . $dbh->errstr; 
     1102 
     1103        # All done 
     1104        post_delete_node($name,$node_id,$version,$args{plugins}); 
    11051105        return 1; 
    11061106    } 
    … …  
    11131113    $sth = $dbh->prepare( $sql ); 
    11141114    $sth->execute( $version ) 
    1115       or croak "Deletion failed: " . $dbh->errstr; 
     1115        or croak "Deletion failed: " . $dbh->errstr; 
    11161116    $sql = "DELETE FROM metadata  
    11171117            WHERE node_id = $node_id 
    … …  
    11191119    $sth = $dbh->prepare( $sql ); 
    11201120    $sth->execute( $version ) 
    1121       or croak "Deletion failed: " . $dbh->errstr; 
    1122  
    1123         # All done 
    1124         post_delete_node($name,$node_id,$version,$args{plugins}); 
     1121        or croak "Deletion failed: " . $dbh->errstr; 
     1122 
     1123    # All done 
     1124    post_delete_node($name,$node_id,$version,$args{plugins}); 
    11251125    return 1; 
    11261126} 
    … …  
    11291129# Not normally used except when doing low-level maintenance 
    11301130sub node_name_for_id { 
    1131         my ($self, $node_id) = @_; 
     1131    my ($self, $node_id) = @_; 
    11321132    my $dbh = $self->dbh; 
    11331133 
    … …  
    11351135    my $name_sth = $dbh->prepare($name_sql); 
    11361136    $name_sth->execute($node_id); 
    1137         my ($name) = $name_sth->fetchrow_array; 
     1137    my ($name) = $name_sth->fetchrow_array; 
    11381138    $name_sth->finish; 
    11391139 
    1140         return $name; 
     1140    return $name; 
    11411141} 
    11421142 
    11431143# Internal Method 
    11441144sub post_delete_node { 
    1145         my ($name,$node_id,$version,$plugins) = @_; 
     1145    my ($name,$node_id,$version,$plugins) = @_; 
    11461146 
    11471147    # Call post_delete on any plugins, having done the delete 
    … …  
    11501150        if ( $plugin->can( "post_delete" ) ) { 
    11511151            $plugin->post_delete(  
    1152                                 node     => $name, 
    1153                                 node_id  => $node_id, 
    1154                                 version  => $version ); 
     1152                node     => $name, 
     1153                node_id  => $node_id, 
     1154                version  => $version ); 
    11551155        } 
    11561156    } 
    … …  
    12721272    } elsif ( $args{days} ) { 
    12731273        my $now = localtime; 
    1274         my $then = $now - ( ONE_DAY * $args{days} ); 
     1274    my $then = $now - ( ONE_DAY * $args{days} ); 
    12751275        $args{since} = $then; 
    12761276        delete $args{days}; 
    … …  
    12801280        return $self->_find_recent_changes_by_criteria( %args ); 
    12811281    } else { 
    1282         croak "Need to supply some criteria to list_recent_changes."; 
     1282        croak "Need to supply some criteria to list_recent_changes."; 
    12831283    } 
    12841284} 
    … …  
    12881288    my ($since, $limit, $between_days, $ignore_case, $new_only, 
    12891289        $metadata_is,  $metadata_isnt, $metadata_was, $metadata_wasnt, 
    1290         $moderation, $include_all_changes ) = 
     1290    $moderation, $include_all_changes ) = 
    12911291         @args{ qw( since limit between_days ignore_case new_only 
    12921292                    metadata_is metadata_isnt metadata_was metadata_wasnt 
    1293                     moderation include_all_changes) }; 
     1293            moderation include_all_changes) }; 
    12941294    my $dbh = $self->dbh; 
    12951295 
    … …  
    13351335                                                     ) 
    13361336                         . " )"; 
    1337         } 
     1337    } 
    13381338    } 
    13391339 
    … …  
    13421342            my $value  = $metadata_isnt->{$type}; 
    13431343            croak "metadata_isnt must have scalar values" if ref $value; 
    1344         } 
     1344    } 
    13451345        my @omits = $self->_find_recent_changes_by_criteria( 
    13461346            since        => $since, 
    … …  
    13531353                 . "  OR node.version != " . $dbh->quote($omit->{version}) 
    13541354                 . ")"; 
    1355         } 
     1355    } 
    13561356    } 
    13571357 
    … …  
    13871387                my $value  = $metadata_was->{$type}; 
    13881388                croak "metadata_was must have scalar values" if ref $value; 
    1389         } 
     1389    } 
    13901390        my @omits = $self->_find_recent_changes_by_criteria( 
    13911391                since        => $since, 
    … …  
    13981398                 . "  OR content.version != " . $dbh->quote($omit->{version}) 
    13991399                 . ")"; 
    1400         } 
     1400    } 
    14011401        $use_content_table = 1; 
    14021402    } 
    … …  
    14531453        $sql .= " LIMIT $limit"; 
    14541454    } 
    1455 #print "\n\n$sql\n\n"; 
    14561455    my $nodesref = $dbh->selectall_arrayref($sql); 
    14571456    my @finds = map { { name          => $_->[0], 
    1458                         version       => $_->[1], 
    1459                         last_modified => $_->[2] } 
    1460                     } @$nodesref; 
     1457                        version       => $_->[1], 
     1458                        last_modified => $_->[2] } 
     1459                    } @$nodesref; 
    14611460    foreach my $find ( @finds ) { 
    14621461        my %metadata; 
    … …  
    14641463                                  FROM node 
    14651464                                  INNER JOIN metadata  
    1466                                         ON (id = node_id) 
     1465                                  ON (id = node_id) 
    14671466                                  WHERE name=? 
    14681467                                  AND metadata.version=?" ); 
    14691468        $sth->execute( $find->{name}, $find->{version} ); 
    14701469        while ( my ($type, $value) = $self->charset_decode( $sth->fetchrow_array ) ) { 
    1471             if ( defined $metadata{$type} ) { 
     1470        if ( defined $metadata{$type} ) { 
    14721471                push @{$metadata{$type}}, $value; 
    1473             } else { 
     1472        } else { 
    14741473                $metadata{$type} = [ $value ]; 
    14751474            } 
    1476         } 
     1475    } 
    14771476        $find->{metadata} = \%metadata; 
    14781477    } 
    … …  
    14981497    my ($self,%args) = @_; 
    14991498    my $dbh = $self->dbh; 
    1500         my @nodes; 
    1501  
    1502         if($args{with_details}) { 
    1503                 my $sql = "SELECT id, name, version, moderate FROM node;"; 
    1504                 my $sth = $dbh->prepare( $sql ); 
    1505                 $sth->execute(); 
    1506  
    1507                 while(my @results = $sth->fetchrow_array) { 
    1508                         my %data; 
    1509                         @data{ qw( node_id name version moderate ) } = @results; 
    1510                         push @nodes, \%data; 
    1511                 } 
    1512         } else { 
    1513                 my $sql = "SELECT name FROM node;"; 
    1514                 my $raw_nodes = $dbh->selectall_arrayref($sql);  
    1515                 @nodes = ( map { $self->charset_decode( $_->[0] ) } (@$raw_nodes) ); 
    1516         } 
    1517         return @nodes; 
     1499    my @nodes; 
     1500 
     1501    if($args{with_details}) { 
     1502        my $sql = "SELECT id, name, version, moderate FROM node;"; 
     1503        my $sth = $dbh->prepare( $sql ); 
     1504        $sth->execute(); 
     1505 
     1506        while(my @results = $sth->fetchrow_array) { 
     1507            my %data; 
     1508            @data{ qw( node_id name version moderate ) } = @results; 
     1509            push @nodes, \%data; 
     1510        } 
     1511    } else { 
     1512        my $sql = "SELECT name FROM node;"; 
     1513        my $raw_nodes = $dbh->selectall_arrayref($sql);  
     1514        @nodes = ( map { $self->charset_decode( $_->[0] ) } (@$raw_nodes) ); 
     1515    } 
     1516    return @nodes; 
    15181517} 
    15191518 
    … …  
    17161715    } 
    17171716 
    1718         my @nodes; 
    1719  
    1720         # If the don't want to match by value, then we can do it with  
    1721         #  a LEFT OUTER JOIN, and either NULL or LENGTH() = 0 
    1722         if( ! $value ) { 
    1723                 my $sql = $self->_get_list_by_missing_metadata_sql(  
    1724                                                                                 ignore_case => $args{ignore_case} 
    1725                       ); 
    1726                 my $sth = $dbh->prepare( $sql ); 
    1727                 $sth->execute( $type ); 
    1728  
    1729                 while ( my ($id, $node) = $sth->fetchrow_array ) { 
    1730                 push @nodes, $node; 
    1731                 } 
     1717    my @nodes; 
     1718 
     1719    # If the don't want to match by value, then we can do it with  
     1720    #  a LEFT OUTER JOIN, and either NULL or LENGTH() = 0 
     1721    if( ! $value ) { 
     1722        my $sql = $self->_get_list_by_missing_metadata_sql(  
     1723                                        ignore_case => $args{ignore_case} 
     1724              ); 
     1725        my $sth = $dbh->prepare( $sql ); 
     1726        $sth->execute( $type ); 
     1727 
     1728        while ( my ($id, $node) = $sth->fetchrow_array ) { 
     1729            push @nodes, $node; 
     1730        } 
    17321731    } else { 
    1733                 # To find those without the value in this case would involve 
    1734                 #  some seriously brain hurting SQL. 
    1735                 # So, cheat - find those with, and return everything else 
    1736                 my @with = $self->list_nodes_by_metadata(%args); 
    1737                 my %with_hash; 
    1738                 foreach my $node (@with) { $with_hash{$node} = 1; } 
    1739  
    1740                 my @all_nodes = $self->list_all_nodes(); 
    1741                 foreach my $node (@all_nodes) { 
    1742                         unless($with_hash{$node}) { 
    1743                                 push @nodes, $node; 
    1744                         } 
    1745                 } 
    1746         } 
     1732        # To find those without the value in this case would involve 
     1733        #  some seriously brain hurting SQL. 
     1734        # So, cheat - find those with, and return everything else 
     1735        my @with = $self->list_nodes_by_metadata(%args); 
     1736        my %with_hash; 
     1737        foreach my $node (@with) { $with_hash{$node} = 1; } 
     1738 
     1739        my @all_nodes = $self->list_all_nodes(); 
     1740        foreach my $node (@all_nodes) { 
     1741            unless($with_hash{$node}) { 
     1742                push @nodes, $node; 
     1743            } 
     1744        } 
     1745    } 
    17471746 
    17481747    return @nodes; 
    … …  
    17591758 
    17601759sub _get_list_by_metadata_sql { 
    1761         # SQL 99 version 
     1760    # SQL 99 version 
    17621761    #  Can be over-ridden by database-specific subclasses 
    17631762    my ($self, %args) = @_; 
    … …  
    17911790 
    17921791sub _get_list_by_missing_metadata_sql { 
    1793         # SQL 99 version 
     1792    # SQL 99 version 
    17941793    #  Can be over-ridden by database-specific subclasses 
    17951794    my ($self, %args) = @_; 
    17961795 
    1797         my $sql = ""; 
     1796    my $sql = ""; 
    17981797    if ( $args{ignore_case} ) { 
    17991798        $sql = "SELECT node.id, node.name " 
    … …  
    18031802             . "       AND node.version=metadata.version " 
    18041803             . "       AND ". $self->_get_lowercase_compare_sql("metadata.metadata_type") 
    1805                         . ")"; 
     1804            . ")"; 
    18061805    } else { 
    18071806        $sql = "SELECT node.id, node.name " 
    … …  
    18141813    } 
    18151814 
    1816         $sql .= "WHERE (metadata.metadata_value IS NULL OR LENGTH(metadata.metadata_value) = 0) "; 
    1817         return $sql; 
     1815    $sql .= "WHERE (metadata.metadata_value IS NULL OR LENGTH(metadata.metadata_value) = 0) "; 
     1816    return $sql; 
    18181817} 
    18191818 
    18201819sub _get_lowercase_compare_sql { 
    1821         my ($self, $column) = @_; 
    1822         # SQL 99 version 
     1820    my ($self, $column) = @_; 
     1821    # SQL 99 version 
    18231822    #  Can be over-ridden by database-specific subclasses 
    1824         return "lower($column) = ?"; 
     1823    return "lower($column) = ?"; 
    18251824} 
    18261825sub _get_casesensitive_compare_sql { 
    1827         my ($self, $column) = @_; 
    1828         # SQL 99 version 
     1826    my ($self, $column) = @_; 
     1827    # SQL 99 version 
    18291828    #  Can be over-ridden by database-specific subclasses 
    1830         return "$column = ?"; 
     1829    return "$column = ?"; 
    18311830} 
    18321831 
    18331832sub _get_comparison_sql { 
    18341833    my ($self, %args) = @_; 
    1835         # SQL 99 version 
     1834    # SQL 99 version 
    18361835    #  Can be over-ridden by database-specific subclasses 
    18371836    return "$args{thing1} = $args{thing2}"; 
    … …  
    18391838 
    18401839sub _get_node_exists_ignore_case_sql { 
    1841         # SQL 99 version 
     1840    # SQL 99 version 
    18421841    #  Can be over-ridden by database-specific subclasses 
    18431842    return "SELECT name FROM node WHERE name = ? "; 
    … …  
    18641863 
    18651864sub list_unmoderated_nodes { 
    1866         my ($self,%args) = @_; 
    1867  
    1868         my $only_where_lastest = $args{'only_where_latest'}; 
    1869  
    1870         my $sql = 
    1871                 "SELECT " 
    1872                 ."      id, name, " 
    1873                 ."      node.version AS last_moderated_version, " 
    1874                 ."      content.version AS version " 
    1875                 ."FROM content " 
    1876                 ."INNER JOIN node " 
    1877                 ."      ON (id = node_id) " 
    1878                 ."WHERE moderated = ? " 
    1879         ; 
    1880         if($only_where_lastest) { 
    1881                 $sql .= "AND node.version = content.version "; 
    1882         } 
    1883         $sql .= "ORDER BY name, content.version "; 
    1884  
    1885         # Query 
     1865    my ($self,%args) = @_; 
     1866 
     1867    my $only_where_lastest = $args{'only_where_latest'}; 
     1868 
     1869    my $sql = 
     1870        "SELECT " 
     1871        ."    id, name, " 
     1872        ."    node.version AS last_moderated_version, " 
     1873        ."    content.version AS version " 
     1874        ."FROM content " 
     1875        ."INNER JOIN node " 
     1876        ."    ON (id = node_id) " 
     1877        ."WHERE moderated = ? " 
     1878    ; 
     1879    if($only_where_lastest) { 
     1880        $sql .= "AND node.version = content.version "; 
     1881    } 
     1882    $sql .= "ORDER BY name, content.version "; 
     1883 
     1884    # Query 
    18861885    my $dbh = $self->dbh; 
    18871886    my $sth = $dbh->prepare( $sql ); 
    18881887    $sth->execute( "0" ); 
    18891888 
    1890         my @nodes; 
    1891         while(my @results = $sth->fetchrow_array) { 
    1892                 my %data; 
    1893                 @data{ qw( node_id name moderated_version version ) } = @results; 
    1894                 push @nodes, \%data; 
    1895         } 
    1896  
    1897         return @nodes; 
     1889    my @nodes; 
     1890    while(my @results = $sth->fetchrow_array) { 
     1891        my %data; 
     1892        @data{ qw( node_id name moderated_version version ) } = @results; 
     1893        push @nodes, \%data; 
     1894    } 
     1895 
     1896    return @nodes; 
    18981897} 
    18991898 
    … …  
    19061905    my @nv = $wiki->list_last_version_before('2007-01-02 10:34:11') 
    19071906    foreach my $data (@nv) { 
    1908          
     1907         
    19091908    } 
    19101909 
    … …  
    19121911 
    19131912sub list_last_version_before { 
    1914         my ($self, $date) = @_; 
    1915  
    1916         my $sql = 
    1917                 "SELECT " 
    1918                 ."      id, name, " 
    1919                 ."MAX(content.version) AS version, MAX(content.modified) AS modified " 
    1920                 ."FROM node " 
    1921                 ."LEFT OUTER JOIN content " 
    1922                 ."      ON (id = node_id " 
    1923                 ."      AND content.modified <= ?) " 
    1924                 ."GROUP BY id, name " 
    1925                 ."ORDER BY id " 
    1926         ; 
    1927  
    1928         # Query 
     1913    my ($self, $date) = @_; 
     1914 
     1915    my $sql = 
     1916        "SELECT " 
     1917        ."    id, name, " 
     1918        ."MAX(content.version) AS version, MAX(content.modified) AS modified " 
     1919        ."FROM node " 
     1920        ."LEFT OUTER JOIN content " 
     1921        ."    ON (id = node_id " 
     1922        ."      AND content.modified <= ?) " 
     1923        ."GROUP BY id, name " 
     1924        ."ORDER BY id " 
     1925    ; 
     1926 
     1927    # Query 
    19291928    my $dbh = $self->dbh; 
    19301929    my $sth = $dbh->prepare( $sql ); 
    19311930    $sth->execute( $date ); 
    19321931 
    1933         my @nodes; 
    1934         while(my @results = $sth->fetchrow_array) { 
    1935                 my %data; 
    1936                 @data{ qw( id name version modified ) } = @results; 
    1937                 $data{'node_id'} = $data{'id'}; 
    1938                 unless($data{'version'}) { $data{'version'} = undef; } 
    1939                 push @nodes, \%data; 
    1940         } 
    1941  
    1942         return @nodes; 
     1932    my @nodes; 
     1933    while(my @results = $sth->fetchrow_array) { 
     1934        my %data; 
     1935        @data{ qw( id name version modified ) } = @results; 
     1936        $data{'node_id'} = $data{'id'}; 
     1937        unless($data{'version'}) { $data{'version'} = undef; } 
     1938        push @nodes, \%data; 
     1939    } 
     1940 
     1941    return @nodes; 
    19431942} 
    19441943 
    … …  
    19551954 
    19561955sub list_metadata_by_type { 
    1957         my ($self, $type) = @_; 
    1958  
    1959         return 0 unless $type; 
     1956    my ($self, $type) = @_; 
     1957 
     1958    return 0 unless $type; 
    19601959} 
    19611960 
    … …  
    20712070# charset parameter we were passed. Takes a list, returns a list. 
    20722071sub charset_decode { 
    2073   my $self = shift; 
    2074   my @input = @_; 
    2075   if ($CAN_USE_ENCODE) { 
    2076     my @output; 
    2077     for (@input) { 
    2078       push( @output, Encode::decode( $self->{_charset}, $_ ) ); 
    2079     } 
    2080     return @output; 
    2081   } 
    2082   return @input; 
     2072    my $self = shift; 
     2073    my @input = @_; 
     2074    if ($CAN_USE_ENCODE) { 
     2075        my @output; 
     2076        for (@input) { 
     2077            push( @output, Encode::decode( $self->{_charset}, $_ ) ); 
     2078        } 
     2079        return @output; 
     2080    } 
     2081    return @input; 
    20832082} 
    20842083 
    … …  
    20862085# takes a list, returns a list 
    20872086sub charset_encode { 
    2088   my $self = shift; 
    2089   my @input = @_; 
    2090   if ($CAN_USE_ENCODE) { 
    2091     my @output; 
    2092     for (@input) { 
    2093       push( @output, Encode::encode( $self->{_charset}, $_ ) ); 
    2094     } 
    2095     return @output; 
    2096   } 
    2097   return @input; 
     2087    my $self = shift; 
     2088    my @input = @_; 
     2089    if ($CAN_USE_ENCODE) { 
     2090        my @output; 
     2091        for (@input) { 
     2092            push( @output, Encode::encode( $self->{_charset}, $_ ) ); 
     2093        } 
     2094        return @output; 
     2095    } 
     2096    return @input; 
    20982097} 
    20992098 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Store/MySQL.pm

    r390 r431  
    4141 
    4242  $store->check_and_write_node( node     => $node, 
    43                                 checksum => $checksum, 
     43                checksum => $checksum, 
    4444                                %other_args ); 
    4545 
    … …  
    6262    unless ($ok) { 
    6363        $self->_unlock_node($node) or carp "Can't unlock node"; 
    64         return 0; 
     64        return 0; 
    6565    } 
    6666    $ok = $self->write_node_post_locking( %args ); 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Store/Pg.pm

    r424 r431  
    4141 
    4242  $store->check_and_write_node( node     => $node, 
    43                                 checksum => $checksum, 
     43                checksum => $checksum, 
    4444                                %other_args ); 
    4545 
    … …  
    6666        my $error = $@; 
    6767        $dbh->rollback; 
    68         $dbh->{AutoCommit} = 1; 
    69         if ( $error =~ /can't serialize access due to concurrent update/i 
     68        $dbh->{AutoCommit} = 1; 
     69        if ( $error =~ /can't serialize access due to concurrent update/i 
    7070            or $error =~ /could not serialize access due to concurrent update/i 
    7171           ) { 
    … …  
    7676    } else { 
    7777        $dbh->commit; 
    78         $dbh->{AutoCommit} = 1; 
    79         return $ok; 
     78        $dbh->{AutoCommit} = 1; 
     79        return $ok; 
    8080    } 
    8181} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/Store/SQLite.pm

    r338 r431  
    5252 
    5353  $store->check_and_write_node( node     => $node, 
    54                                 checksum => $checksum, 
     54                checksum => $checksum, 
    5555                                %other_args ); 
    5656 
    … …  
    7878        my $error = $@; 
    7979        $dbh->rollback; 
    80         $dbh->{AutoCommit} = 1; 
    81         if (  $error =~ /database is locked/ 
     80        $dbh->{AutoCommit} = 1; 
     81        if ( $error =~ /database is locked/ 
    8282            or $error =~ /DBI connect.+failed/ ) { 
    8383            return 0; 
    … …  
    8787    } else { 
    8888        $dbh->commit; 
    89         $dbh->{AutoCommit} = 1; 
    90         return $ok; 
     89        $dbh->{AutoCommit} = 1; 
     90        return $ok; 
    9191    } 
    9292} 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/TestConfig/Utilities.pm

    r209 r431  
    2323    if ($Wiki::Toolkit::TestConfig::config{$dbtype}->{dbname}) { 
    2424        my %config = %{$Wiki::Toolkit::TestConfig::config{$dbtype}}; 
    25         my $store_class = "Wiki::Toolkit::Store::$dbtype"; 
    26         eval "require $store_class"; 
    27         my $store = $store_class->new( dbname => $config{dbname}, 
    28                                        dbuser => $config{dbuser}, 
    29                                        dbpass => $config{dbpass}, 
    30                                        dbhost => $config{dbhost} ); 
    31         $stores{$dbtype} = $store; 
     25        my $store_class = "Wiki::Toolkit::Store::$dbtype"; 
     26        eval "require $store_class"; 
     27        my $store = $store_class->new( dbname => $config{dbname}, 
     28                                       dbuser => $config{dbuser}, 
     29                                       dbpass => $config{dbpass}, 
     30                                       dbhost => $config{dbhost} ); 
     31        $stores{$dbtype} = $store; 
    3232    } else { 
    33         $stores{$dbtype} = undef; 
     33        $stores{$dbtype} = undef; 
    3434    } 
    3535} 
    … …  
    5757                       -username   => $dbconfig{dbuser}, 
    5858                       -password   => $dbconfig{dbpass}, 
    59                        -hostname   => $dbconfig{dbhost} || "", 
     59                       -hostname   => $dbconfig{dbhost} || "", 
    6060                       -table_name => 'siindex', 
    6161                       -lock_mode  => 'EX' ); 
    … …  
    7777                       -username   => $dbconfig{dbuser}, 
    7878                       -password   => $dbconfig{dbpass}, 
    79                        -hostname   => $dbconfig{dbhost}, 
     79                       -hostname   => $dbconfig{dbhost}, 
    8080                       -table_name => 'siindex', 
    8181                       -lock_mode  => 'EX' ); 
    … …  
    9999my @combinations; # which searches work with which stores. 
    100100push @combinations, { store_name  => "MySQL", 
    101                       store       => $stores{MySQL}, 
    102                       search_name => "DBIxFTSMySQL", 
    103                       search      => $searches{DBIxFTSMySQL} }; 
     101                      store       => $stores{MySQL}, 
     102                      search_name => "DBIxFTSMySQL", 
     103                      search      => $searches{DBIxFTSMySQL} }; 
    104104push @combinations, { store_name  => "MySQL", 
    105                       store       => $stores{MySQL}, 
    106                       search_name => "SIIMySQL", 
    107                       search      => $searches{SIIMySQL} }; 
     105                      store       => $stores{MySQL}, 
     106                      search_name => "SIIMySQL", 
     107                      search      => $searches{SIIMySQL} }; 
    108108push @combinations, { store_name  => "Pg", 
    109                       store       => $stores{Pg}, 
    110                       search_name => "SIIPg", 
    111                       search      => $searches{SIIPg} }; 
     109                      store       => $stores{Pg}, 
     110                      search_name => "SIIPg", 
     111                      search      => $searches{SIIPg} }; 
    112112 
    113113# All stores are compatible with the default S::II search, and with no search. 
    114114foreach my $store_name ( keys %stores ) { 
    115115    push @combinations, { store_name  => $store_name, 
    116                           store       => $stores{$store_name}, 
    117                           search_name => "SII", 
    118                           search      => $searches{SII} }; 
     116                          store       => $stores{$store_name}, 
     117                          search_name => "SII", 
     118                          search      => $searches{SII} }; 
    119119    push @combinations, { store_name  => $store_name, 
    120                           store       => $stores{$store_name}, 
    121                           search_name => "undef", 
    122                           search      => undef }; 
     120                          store       => $stores{$store_name}, 
     121                          search_name => "undef", 
     122                          search      => undef }; 
    123123} 
    124124 
    … …  
    147147        eval "require $setup_class"; 
    148148        { 
    149           no strict "refs"; 
    150           &{"$setup_class\:\:cleardb"}($dbname, $dbuser, $dbpass, $dbhost); 
    151           &{"$setup_class\:\:setup"}($dbname, $dbuser, $dbpass, $dbhost); 
     149            no strict "refs"; 
     150            &{"$setup_class\:\:cleardb"}($dbname, $dbuser, $dbpass, $dbhost); 
     151            &{"$setup_class\:\:setup"}($dbname, $dbuser, $dbpass, $dbhost); 
    152152        } 
    153153    } 

  • wiki-toolkit/trunk/lib/Wiki/Toolkit/TestLib.pm

    r429 r431  
    5252    if ( $configured{$dbtype}{dbname} ) { 
    5353        my %config = %{ $configured{$dbtype} }; 
    54         my $store_class = "Wiki::Toolkit::Store::$dbtype"; 
    55         my $setup_class = "Wiki::Toolkit::Setup::$dbtype"; 
     54        my $store_class = "Wiki::Toolkit::Store::$dbtype"; 
     55        my $setup_class = "Wiki::Toolkit::Setup::$dbtype"; 
    5656        my $dsn = $dsn_prefix{$dbtype}.$config{dbname}; 
    5757        my $err; 
    … …  
    6666                                     params => { 
    6767                                                 dbname => $config{dbname}, 
    68                                                  dbuser => $config{dbuser}, 
    69                                                  dbpass => $config{dbpass}, 
    70                                                  dbhost => $config{dbhost}, 
     68                                                 dbuser => $config{dbuser}, 
     69                                                 dbpass => $config{dbpass}, 
     70                                                 dbhost => $config{dbhost}, 
    7171                                               }, 
    7272                                   }; 
    … …  
    8181                             db_params => { 
    8282                                            dbname => $config{dbname}, 
    83                                             dbuser => $config{dbuser}, 
    84                                             dbpass => $config{dbpass}, 
    85                                             dbhost => $config{dbhost}, 
     83                                            dbuser => $config{dbuser}, 
     84                                            dbpass => $config{dbpass}, 
     85                                            dbhost => $config{dbhost}, 
    8686                                          }, 
    8787                           }; 
    … …  
    9898                                        -username   => $config{dbuser}, 
    9999                                        -password   => $config{dbpass}, 
    100                                         -hostname   => $config{dbhost} || "", 
     100                                        -hostname   => $config{dbhost} || "", 
    101101                                        -table_name => 'siindex', 
    102102                                        -lock_mode  => 'EX', 
    … …  
    119119                                     -username   => $config{dbuser}, 
    120120                                     -password   => $config{dbpass}, 
    121                                      -hostname   => $config{dbhost}, 
     121                                     -hostname   => $config{dbhost}, 
    122122                                     -table_name => 'siindex', 
    123123                                     -lock_mode  => 'EX', 
    … …  
    148148push @wiki_info, { datastore_info => $datastore_info{MySQL}, 
    149149                   dbixfts_info   => $dbixfts_info{MySQL} } 
    150   if ( $datastore_info{MySQL} and $dbixfts_info{MySQL} ); 
     150    if ( $datastore_info{MySQL} and $dbixfts_info{MySQL} ); 
    151151push @wiki_info, { datastore_info => $datastore_info{MySQL}, 
    152152                   sii_info       => $sii_info{MySQL} } 
    153   if ( $datastore_info{MySQL} and $sii_info{MySQL} ); 
     153    if ( $datastore_info{MySQL} and $sii_info{MySQL} ); 
    154154push @wiki_info, { datastore_info => $datastore_info{Pg}, 
    155155                   sii_info       => $sii_info{Pg} } 
    156   if ( $datastore_info{Pg} and $sii_info{Pg} ); 
     156    if ( $datastore_info{Pg} and $sii_info{Pg} ); 
    157157 
    158158# All stores are compatible with the default S::II search, and with Plucene, 
    … …  
    161161    push @wiki_info, { datastore_info => $datastore_info{$dbtype}, 
    162162                       sii_info       => $sii_info{DB_File} } 
    163       if ( $datastore_info{$dbtype} and $sii_info{DB_File} ); 
     163        if ( $datastore_info{$dbtype} and $sii_info{DB_File} ); 
    164164    push @wiki_info, { datastore_info => $datastore_info{$dbtype}, 
    165165                       plucene_path   => $plucene_path } 
    166       if ( $datastore_info{$dbtype} and $plucene_path ); 
     166        if ( $datastore_info{$dbtype} and $plucene_path ); 
    167167    push @wiki_info, { datastore_info => $datastore_info{$dbtype} } 
    168       if $datastore_info{$dbtype}; 
     168        if $datastore_info{$dbtype}; 
    169169} 
    170170 
    … …  
    235235        my %dbconfig = %{ $fts_info{db_params} }; 
    236236        my $dsn = Wiki::Toolkit::Store::MySQL->_dsn( $dbconfig{dbname}, 
    237                                                  $dbconfig{dbhost}  ); 
     237                                                     $dbconfig{dbhost}  ); 
    238238        my $dbh = DBI->connect( $dsn, $dbconfig{dbuser}, $dbconfig{dbpass}, 
    239239                       { PrintError => 0, RaiseError => 1, AutoCommit => 1 } ) 
    240           or croak "Can't connect to $dbconfig{dbname} using $dsn: " . DBI->errstr; 
     240            or croak "Can't connect to $dbconfig{dbname} using $dsn: " . DBI->errstr; 
    241241        require Wiki::Toolkit::Setup::DBIxFTSMySQL; 
    242242        Wiki::Toolkit::Setup::DBIxFTSMySQL::setup( 
    243243                                 @dbconfig{ qw( dbname dbuser dbpass dbhost ) } 
    244                                              ); 
     244                                                 ); 
    245245        require Wiki::Toolkit::Search::DBIxFTS; 
    246246        $wiki_config{search} = Wiki::Toolkit::Search::DBIxFTS->new( dbh => $dbh ); 
    … …  
    260260        if ( -d $dir ) { 
    261261            rmdir $dir or die $!; 
    262         } 
     262    } 
    263263        mkdir $dir or die $!; 
    264264        $wiki_config{search} = Wiki::Toolkit::Search::Plucene->new( path => $dir ); 
    … …  
    280280} 
    281281 
    282  
    283282=back 
    284283