Changeset 431


Ignore:
Timestamp:
May 11, 2008, 5:04:41 PM (14 years ago)
Author:
Dominic Hargreaves
Message:

fix much tab/whitespace damage; no functional changes.

Location:
wiki-toolkit/trunk
Files:
27 edited

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
Note: See TracChangeset for help on using the changeset viewer.