use
vars
qw( $VERSION $timestamp_fmt )
;
$timestamp_fmt
=
"%Y-%m-%d %H:%M:%S"
;
use
Carp
qw( carp croak )
;
$VERSION
=
'0.28'
;
my
$SCHEMA_VER
= 9;
my
$CAN_USE_ENCODE
;
BEGIN {
eval
" use Encode "
;
$CAN_USE_ENCODE
= $@ ? 0 : 1;
}
sub
new {
my
(
$class
,
@args
) =
@_
;
my
$self
= {};
bless
$self
,
$class
;
return
$self
->_init(
@args
);
}
sub
_init {
my
(
$self
,
%args
) =
@_
;
if
(
$args
{dbh} ) {
$self
->{_dbh} =
$args
{dbh};
$self
->{_external_dbh} = 1;
}
else
{
die
"Must supply a dbname"
unless
defined
$args
{dbname};
$self
->{_dbname} =
$args
{dbname};
$self
->{_dbuser} =
$args
{dbuser} ||
""
;
$self
->{_dbpass} =
$args
{dbpass} ||
""
;
$self
->{_dbhost} =
$args
{dbhost} ||
""
;
$self
->{_dbport} =
$args
{dbport} ||
""
;
$self
->{_charset} =
$args
{charset} ||
"iso-8859-1"
;
my
(
$dbname
,
$dbuser
,
$dbpass
,
$dbhost
,
$dbport
) =
@$self
{
qw(_dbname _dbuser _dbpass _dbhost _dbport)
};
my
$dsn
=
$self
->_dsn(
$dbname
,
$dbhost
,
$dbport
)
or croak
"No data source string provided by class"
;
$self
->{_dbh} = DBI->
connect
(
$dsn
,
$dbuser
,
$dbpass
,
{
PrintError
=> 0,
RaiseError
=> 1,
AutoCommit
=> 1 } )
or croak
"Can't connect to database $dbname using $dsn: "
. DBI->errstr;
}
my
(
$cur_ver
,
$db_ver
) =
$self
->schema_current;
if
(
$db_ver
<
$cur_ver
) {
croak
"Database schema version $db_ver is too old (need $cur_ver)"
;
}
elsif
(
$db_ver
>
$cur_ver
) {
croak
"Database schema version $db_ver is too new (need $cur_ver)"
;
}
return
$self
;
}
sub
handle_pre_plugin_ret {
my
(
$running_total_ref
,
$result
) =
@_
;
if
((
$result
&&
$result
== 0) || !
$result
) {
}
elsif
(
$result
== -1 ||
$result
== 1) {
$$running_total_ref
+=
$result
;
}
else
{
warn
(
"Pre_ plugin returned invalid accept/deny value of '$result'"
);
}
}
sub
retrieve_node {
my
$self
=
shift
;
my
%args
=
scalar
@_
== 1 ? (
name
=>
$_
[0] ) :
@_
;
unless
(
$args
{
'version'
}) {
$args
{
'version'
} =
undef
; }
my
@plugins
= @{
$args
{plugins} || [ ] };
foreach
my
$plugin
(
@plugins
) {
if
(
$plugin
->can(
"pre_retrieve"
) ) {
$plugin
->pre_retrieve(
node
=> \
$args
{
'name'
},
version
=> \
$args
{
'version'
}
);
}
}
unless
(
wantarray
) {
return
$self
->_retrieve_node_data(
%args
);
}
my
%data
=
$self
->_retrieve_node_data(
%args
);
$data
{
'checksum'
} =
$self
->_checksum(
%data
);
return
%data
;
}
sub
_retrieve_node_data {
my
(
$self
,
%args
) =
@_
;
my
%data
=
$self
->_retrieve_node_content(
%args
);
unless
(
wantarray
) {
return
$data
{content};
}
my
$dbh
=
$self
->dbh;
my
$sql
=
"SELECT metadata_type, metadata_value "
.
"FROM node "
.
"INNER JOIN metadata ON (node_id = id) "
.
"WHERE name=? "
.
"AND metadata.version=?"
;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$args
{name},
$data
{version}) or croak
$dbh
->errstr;
my
%metadata
;
while
(
my
(
$type
,
$val
) =
$self
->charset_decode(
$sth
->fetchrow_array ) ) {
if
(
defined
$metadata
{
$type
} ) {
push
@{
$metadata
{
$type
}},
$val
;
}
else
{
$metadata
{
$type
} = [
$val
];
}
}
$data
{metadata} = \
%metadata
;
return
%data
;
}
sub
_retrieve_node_content {
my
(
$self
,
%args
) =
@_
;
croak
"No valid node name supplied"
unless
$args
{name};
my
$dbh
=
$self
->dbh;
my
$sql
;
my
$version_sql_val
;
my
$text_source
;
if
(
$args
{version} ) {
$version_sql_val
=
$dbh
->quote(
$self
->charset_encode(
$args
{version}));
$text_source
=
"content"
;
}
else
{
$version_sql_val
=
"node.version"
;
$text_source
=
"node"
;
}
$sql
=
"SELECT "
.
" $text_source.text, content.version, "
.
" content.modified, content.moderated, "
.
" node.moderate "
.
"FROM node "
.
"INNER JOIN content ON (id = node_id) "
.
"WHERE name="
.
$dbh
->quote(
$self
->charset_encode(
$args
{name}))
.
" AND content.version="
.
$version_sql_val
;
my
@results
=
$self
->charset_decode(
$dbh
->selectrow_array(
$sql
) );
@results
= (
""
, 0,
""
)
unless
scalar
@results
;
my
%data
;
@data
{
qw( content version last_modified moderated node_requires_moderation )
} =
@results
;
return
%data
;
}
sub
_checksum {
my
(
$self
,
%node_data
) =
@_
;
my
$string
=
$node_data
{content};
my
%metadata
= %{
$node_data
{metadata} || {} };
foreach
my
$key
(
sort
keys
%metadata
) {
$string
.=
"\0\0\0"
.
$key
.
"\0\0"
.
join
(
"\0"
,
sort
@{
$metadata
{
$key
}} );
}
return
md5_hex(
$self
->charset_encode(
$string
));
}
sub
_checksum_hashes {
my
(
$self
,
@hashes
) =
@_
;
my
@strings
=
""
;
foreach
my
$hashref
(
@hashes
) {
my
%hash
=
%$hashref
;
my
$substring
=
""
;
foreach
my
$key
(
sort
keys
%hash
) {
$substring
.=
"\0\0"
.
$key
.
"\0"
.
$hash
{
$key
};
}
push
@strings
,
$substring
;
}
my
$string
=
join
(
"\0\0\0"
,
sort
@strings
);
return
md5_hex(
$string
);
}
sub
node_exists {
my
$self
=
shift
;
if
(
scalar
@_
== 1 ) {
my
$node
=
shift
;
return
$self
->_do_old_node_exists(
$node
);
}
else
{
my
%args
=
@_
;
return
$self
->_do_old_node_exists(
$args
{name} )
unless
$args
{ignore_case};
my
$sql
=
$self
->_get_node_exists_ignore_case_sql;
my
$sth
=
$self
->dbh->prepare(
$sql
);
$sth
->execute(
$args
{name} );
my
$found_name
=
$sth
->fetchrow_array ||
""
;
$sth
->finish;
return
lc
(
$found_name
) eq
lc
(
$args
{name}) ? 1 : 0;
}
}
sub
_do_old_node_exists {
my
(
$self
,
$node
) =
@_
;
my
%data
=
$self
->retrieve_node(
$node
) or
return
();
return
$data
{version};
}
sub
verify_checksum {
my
(
$self
,
$node
,
$checksum
) =
@_
;
my
%node_data
=
$self
->_retrieve_node_data(
name
=>
$node
);
return
(
$checksum
eq
$self
->_checksum(
%node_data
) );
}
sub
list_backlinks {
my
(
$self
,
%args
) =
@_
;
my
$node
=
$args
{node};
croak
"Must supply a node name"
unless
$node
;
my
$dbh
=
$self
->dbh;
my
$sql
=
"SELECT link_from FROM internal_links WHERE link_to="
.
$dbh
->quote(
$node
);
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute or croak
$dbh
->errstr;
my
@backlinks
;
while
(
my
(
$backlink
) =
$self
->charset_decode(
$sth
->fetchrow_array ) ) {
push
@backlinks
,
$backlink
;
}
return
@backlinks
;
}
sub
list_dangling_links {
my
$self
=
shift
;
my
$dbh
=
$self
->dbh;
my
$sql
= "SELECT DISTINCT internal_links.link_to
FROM internal_links LEFT JOIN node
ON node.name=internal_links.link_to
WHERE node.version IS NULL";
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute or croak
$dbh
->errstr;
my
@links
;
while
(
my
(
$link
) =
$self
->charset_decode(
$sth
->fetchrow_array ) ) {
push
@links
,
$link
;
}
return
@links
;
}
sub
write_node_post_locking {
my
(
$self
,
%args
) =
@_
;
my
(
$node
,
$content
,
$links_to_ref
,
$metadata_ref
,
$requires_moderation
) =
@args
{
qw( node content links_to metadata requires_moderation)
};
my
$dbh
=
$self
->dbh;
my
$timestamp
=
$self
->_get_timestamp();
my
@links_to
= @{
$links_to_ref
|| [] };
my
$version
;
unless
(
$requires_moderation
) {
$requires_moderation
= 0; }
my
@preplugins
= @{
$args
{plugins} || [ ] };
my
$write_allowed
= 1;
foreach
my
$plugin
(
@preplugins
) {
if
(
$plugin
->can(
"pre_write"
) ) {
handle_pre_plugin_ret(
\
$write_allowed
,
$plugin
->pre_write(
node
=> \
$node
,
content
=> \
$content
,
metadata
=> \
$metadata_ref
)
);
}
}
if
(
$write_allowed
< 1) {
return
-1;
}
my
$sql
=
"SELECT count(*) FROM node WHERE name="
.
$dbh
->quote(
$node
);
my
$exists
= @{
$dbh
->selectcol_arrayref(
$sql
) }[0] || 0;
if
(!
$exists
) {
$version
= 1;
my
$node_content
=
$content
;
if
(
$requires_moderation
) {
$node_content
=
"=== This page has yet to be moderated. ==="
;
}
my
$add_sql
=
"INSERT INTO node "
.
" (name, version, text, modified, moderate) "
.
"VALUES (?, ?, ?, ?, ?)"
;
my
$add_sth
=
$dbh
->prepare(
$add_sql
);
$add_sth
->execute(
map
{
$self
->charset_encode(
$_
) }
(
$node
,
$version
,
$node_content
,
$timestamp
,
$requires_moderation
)
) or croak
"Error updating database: "
. DBI->errstr;
}
$sql
=
"SELECT id, moderate FROM node WHERE name="
.
$dbh
->quote(
$node
);
my
(
$node_id
,
$node_requires_moderation
) =
$dbh
->selectrow_array(
$sql
);
if
(
$exists
) {
$sql
= "SELECT max(content.version) FROM node
INNER JOIN content ON (id = node_id)
WHERE name=" .
$dbh
->quote(
$node
);
$version
= @{
$dbh
->selectcol_arrayref(
$sql
) }[0] || 0;
croak
"Can't get version number"
unless
$version
;
$version
++;
if
(!
$node_requires_moderation
) {
$sql
=
"UPDATE node SET version="
.
$dbh
->quote(
$version
)
.
", text="
.
$dbh
->quote(
$self
->charset_encode(
$content
))
.
", modified="
.
$dbh
->quote(
$timestamp
)
.
" WHERE name="
.
$dbh
->quote(
$self
->charset_encode(
$node
));
$dbh
->
do
(
$sql
) or croak
"Error updating database: "
. DBI->errstr;
}
if
(
$requires_moderation
) {
warn
(
"Moderation not added to existing node '$node', use normal moderation methods instead"
);
}
}
my
$add_sql
=
"INSERT INTO content "
.
" (node_id, version, text, modified, moderated) "
.
"VALUES (?, ?, ?, ?, ?)"
;
my
$add_sth
=
$dbh
->prepare(
$add_sql
);
$add_sth
->execute(
map
{
$self
->charset_encode(
$_
) }
(
$node_id
,
$version
,
$content
,
$timestamp
, (1-
$node_requires_moderation
))
) or croak
"Error updating database: "
. DBI->errstr;
$dbh
->
do
(
"DELETE FROM internal_links WHERE link_from="
.
$dbh
->quote(
$self
->charset_encode(
$node
)) ) or croak
$dbh
->errstr;
foreach
my
$links_to
(
@links_to
) {
$sql
=
"INSERT INTO internal_links (link_from, link_to) VALUES ("
.
join
(
", "
,
map
{
$dbh
->quote(
$self
->charset_encode(
$_
)) } (
$node
,
$links_to
) ) .
")"
;
eval
{
$dbh
->
do
(
$sql
); };
carp
"Couldn't index backlink: "
.
$dbh
->errstr
if
$@;
}
my
%metadata
= %{
$metadata_ref
|| {} };
foreach
my
$type
(
keys
%metadata
) {
my
$val
=
$metadata
{
$type
};
my
@values
= (
ref
$val
and
ref
$val
eq
'ARRAY'
) ?
@$val
: (
$val
);
my
$all_scalars
= 1;
foreach
my
$value
(
@values
) {
$all_scalars
= 0
if
ref
$value
;
}
my
$add_sql
=
"INSERT INTO metadata "
.
" (node_id, version, metadata_type, metadata_value) "
.
"VALUES (?, ?, ?, ?)"
;
my
$add_sth
=
$dbh
->prepare(
$add_sql
);
if
(
$all_scalars
) {
my
%unique
=
map
{
$_
=> 1 }
@values
;
@values
=
keys
%unique
;
foreach
my
$value
(
@values
) {
$add_sth
->execute(
map
{
$self
->charset_encode(
$_
) }
(
$node_id
,
$version
,
$type
,
$value
)
) or croak
$dbh
->errstr;
}
}
else
{
my
$type_to_store
=
"__"
.
$type
.
"__checksum"
;
my
$value_to_store
=
$self
->_checksum_hashes(
@values
);
$add_sth
->execute(
map
{
$self
->charset_encode(
$_
) }
(
$node_id
,
$version
,
$type_to_store
,
$value_to_store
)
) or croak
$dbh
->errstr;
}
}
my
@postplugins
= @{
$args
{plugins} || [ ] };
foreach
my
$plugin
(
@postplugins
) {
if
(
$plugin
->can(
"post_write"
) ) {
$plugin
->post_write(
node
=>
$node
,
node_id
=>
$node_id
,
version
=>
$version
,
content
=>
$content
,
metadata
=>
$metadata_ref
);
}
}
return
1;
}
sub
_get_timestamp {
my
$self
=
shift
;
my
$time
=
shift
||
localtime
;
unless
(
ref
$time
) {
$time
=
localtime
(
$time
);
}
return
$time
->strftime(
$timestamp_fmt
);
}
sub
rename_node {
my
(
$self
,
%args
) =
@_
;
my
(
$old_name
,
$new_name
,
$wiki
,
$create_new_versions
) =
@args
{
qw( old_name new_name wiki create_new_versions )
};
my
$dbh
=
$self
->dbh;
my
$formatter
=
$wiki
->{_formatter};
my
$timestamp
=
$self
->_get_timestamp();
my
@preplugins
= @{
$args
{plugins} || [ ] };
my
$rename_allowed
= 1;
foreach
my
$plugin
(
@preplugins
) {
if
(
$plugin
->can(
"pre_rename"
) ) {
handle_pre_plugin_ret(
\
$rename_allowed
,
$plugin
->pre_rename(
old_name
=> \
$old_name
,
new_name
=> \
$new_name
,
create_new_versions
=> \
$create_new_versions
,
)
);
}
}
if
(
$rename_allowed
< 1) {
return
-1;
}
my
$sql
=
"SELECT id FROM node WHERE name=?"
;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$old_name
);
my
(
$node_id
) =
$sth
->fetchrow_array;
$sth
->finish;
my
@links
;
if
(
$formatter
->can(
"rename_links"
)) {
$sql
=
"SELECT id, name, version "
.
"FROM internal_links "
.
"INNER JOIN node "
.
" ON (link_from = name) "
.
"WHERE link_to = ?"
;
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$old_name
);
while
(
my
@l
=
$sth
->fetchrow_array) {
push
(
@links
, \
@l
); }
}
$sql
=
"UPDATE node SET name=? WHERE id=?"
;
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$new_name
,
$node_id
);
$sql
=
"UPDATE internal_links SET link_from=? WHERE link_from=?"
;
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$new_name
,
$old_name
);
if
(
$formatter
->can(
"rename_links"
)) {
foreach
my
$l
(
@links
) {
my
(
$page_id
,
$page_name
,
$page_version
) =
@$l
;
if
(
$page_name
eq
$old_name
) {
$page_name
=
$new_name
; }
my
%page
=
$self
->retrieve_node(
name
=>
$page_name
,
version
=>
$page_version
);
my
$new_content
=
$formatter
->rename_links(
$old_name
,
$new_name
,
$page
{
'content'
});
if
(
$new_content
ne
$page
{
'content'
}) {
if
(
$create_new_versions
) {
$wiki
->write_node(
$page_name
,
$new_content
,
$page
{checksum},
$page
{metadata}
);
}
else
{
my
$update_sql_a
=
"UPDATE node SET text=? WHERE id=?"
;
my
$update_sql_b
=
"UPDATE content SET text=? "
.
"WHERE node_id=? AND version=?"
;
my
$u_sth
=
$dbh
->prepare(
$update_sql_a
);
$u_sth
->execute(
$new_content
,
$page_id
);
$u_sth
=
$dbh
->prepare(
$update_sql_b
);
$u_sth
->execute(
$new_content
,
$page_id
,
$page_version
);
}
}
}
if
(!
$create_new_versions
) {
$sql
=
"UPDATE internal_links SET link_to=? WHERE link_to=?"
;
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$new_name
,
$old_name
);
}
}
else
{
warn
(
"Internal links not updated following node rename - unsupported by formatter"
);
}
my
@postplugins
= @{
$args
{plugins} || [ ] };
foreach
my
$plugin
(
@postplugins
) {
if
(
$plugin
->can(
"post_rename"
) ) {
$plugin
->post_rename(
old_name
=>
$old_name
,
new_name
=>
$new_name
,
node_id
=>
$node_id
,
);
}
}
}
sub
moderate_node {
my
$self
=
shift
;
my
%args
=
scalar
@_
== 2 ? (
name
=>
$_
[0],
version
=>
$_
[1] ) :
@_
;
my
$dbh
=
$self
->dbh;
my
(
$name
,
$version
) = (
$args
{name},
$args
{version});
my
@plugins
= @{
$args
{plugins} || [ ] };
my
$moderation_allowed
= 1;
foreach
my
$plugin
(
@plugins
) {
if
(
$plugin
->can(
"pre_moderate"
) ) {
handle_pre_plugin_ret(
\
$moderation_allowed
,
$plugin
->pre_moderate(
node
=> \
$name
,
version
=> \
$version
)
);
}
}
if
(
$moderation_allowed
< 1) {
return
-1;
}
my
$id_sql
=
"SELECT id FROM node WHERE name=?"
;
my
$id_sth
=
$dbh
->prepare(
$id_sql
);
$id_sth
->execute(
$name
);
my
(
$node_id
) =
$id_sth
->fetchrow_array;
$id_sth
->finish;
my
$hv_sql
=
"SELECT max(version) "
.
"FROM content "
.
"WHERE node_id = ? "
.
"AND moderated = ?"
;
my
$hv_sth
=
$dbh
->prepare(
$hv_sql
);
$hv_sth
->execute(
$node_id
,
"1"
) or croak
$dbh
->errstr;
my
(
$highest_mod_version
) =
$hv_sth
->fetchrow_array;
$hv_sth
->finish;
unless
(
$highest_mod_version
) {
$highest_mod_version
= 0; }
my
$update_sql
=
"UPDATE content "
.
"SET moderated = ? "
.
"WHERE node_id = ? "
.
"AND version = ?"
;
my
$update_sth
=
$dbh
->prepare(
$update_sql
);
$update_sth
->execute(
"1"
,
$node_id
,
$version
) or croak
$dbh
->errstr;
if
(
int
(
$version
) >
int
(
$highest_mod_version
)) {
my
%new_data
=
$self
->retrieve_node(
name
=>
$name
,
version
=>
$version
);
unless
(
$new_data
{last_modified}) {
$new_data
{last_modified} =
undef
; }
my
$newv_sql
=
"UPDATE node "
.
"SET version=?, text=?, modified=? "
.
"WHERE id = ?"
;
my
$newv_sth
=
$dbh
->prepare(
$newv_sql
);
$newv_sth
->execute(
$version
,
$self
->charset_encode(
$new_data
{content}),
$new_data
{last_modified},
$node_id
) or croak
$dbh
->errstr;
}
else
{
}
@plugins
= @{
$args
{plugins} || [ ] };
foreach
my
$plugin
(
@plugins
) {
if
(
$plugin
->can(
"post_moderate"
) ) {
$plugin
->post_moderate(
node
=>
$name
,
node_id
=>
$node_id
,
version
=>
$version
);
}
}
return
1;
}
sub
set_node_moderation {
my
$self
=
shift
;
my
%args
=
scalar
@_
== 2 ? (
name
=>
$_
[0],
required
=>
$_
[1] ) :
@_
;
my
$dbh
=
$self
->dbh;
my
(
$name
,
$required
) = (
$args
{name},
$args
{required});
my
$id_sql
=
"SELECT id FROM node WHERE name=?"
;
my
$id_sth
=
$dbh
->prepare(
$id_sql
);
$id_sth
->execute(
$name
);
my
(
$node_id
) =
$id_sth
->fetchrow_array;
$id_sth
->finish;
unless
(
$node_id
) {
return
0;
}
my
$mod_sql
=
"UPDATE node "
.
"SET moderate = ? "
.
"WHERE id = ? "
;
my
$mod_sth
=
$dbh
->prepare(
$mod_sql
);
$mod_sth
->execute(
"$required"
,
$node_id
) or croak
$dbh
->errstr;
return
1;
}
sub
delete_node {
my
$self
=
shift
;
my
%args
= (
scalar
@_
== 1 ) ? (
name
=>
$_
[0] ) :
@_
;
my
$dbh
=
$self
->dbh;
my
(
$name
,
$version
,
$wiki
) =
@args
{
qw( name version wiki )
};
my
$id_sql
=
"SELECT id FROM node WHERE name=?"
;
my
$id_sth
=
$dbh
->prepare(
$id_sql
);
$id_sth
->execute(
$name
);
my
(
$node_id
) =
$id_sth
->fetchrow_array;
$id_sth
->finish;
unless
(
$version
) {
my
$sql
;
$sql
=
"DELETE FROM content WHERE node_id = $node_id"
;
$dbh
->
do
(
$sql
) or croak
"Deletion failed: "
. DBI->errstr;
$sql
=
"DELETE FROM internal_links WHERE link_from="
.
$dbh
->quote(
$name
);
$dbh
->
do
(
$sql
) or croak
$dbh
->errstr;
$sql
=
"DELETE FROM metadata WHERE node_id = $node_id"
;
$dbh
->
do
(
$sql
) or croak
$dbh
->errstr;
$sql
=
"DELETE FROM node WHERE id = $node_id"
;
$dbh
->
do
(
$sql
) or croak
"Deletion failed: "
. DBI->errstr;
post_delete_node(
$name
,
$node_id
,
$version
,
$args
{plugins});
return
1;
}
my
%verdata
=
$self
->retrieve_node(
name
=>
$name
,
version
=>
$version
);
unless
(
$verdata
{version}) {
warn
(
"Asked to delete non existant version $version of node $node_id ($name)"
);
return
1;
}
my
$sql
=
"SELECT COUNT(*) FROM content WHERE node_id = $node_id"
;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute() or croak
"Deletion failed: "
.
$dbh
->errstr;
my
(
$count
) =
$sth
->fetchrow_array;
$sth
->finish;
if
(
$count
== 1) {
return
$self
->delete_node(
name
=>
$name
,
plugins
=>
$args
{plugins} );
}
my
%currdata
=
$self
->retrieve_node(
name
=>
$name
);
if
(
$currdata
{version} ==
$version
) {
my
$try
=
$version
- 1;
my
%prevdata
;
until
(
$prevdata
{version} &&
$prevdata
{moderated} ) {
%prevdata
=
$self
->retrieve_node(
name
=>
$name
,
version
=>
$try
,
);
$try
--;
}
my
$sql
="UPDATE node
SET version=?, text=?, modified=?
WHERE name=?";
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
@prevdata
{
qw( version content last_modified )
},
$name
)
or croak
"Deletion failed: "
.
$dbh
->errstr;
$sql
= "DELETE FROM content
WHERE node_id =
$node_id
AND version =
$version
";
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute()
or croak
"Deletion failed: "
.
$dbh
->errstr;
$sql
=
"DELETE FROM internal_links WHERE link_from=?"
;
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$name
)
or croak
"Deletion failed: "
.
$dbh
->errstr;
my
@links_to
;
my
$formatter
=
$wiki
->formatter;
if
(
$formatter
->can(
"find_internal_links"
) ) {
my
@all
=
$formatter
->find_internal_links(
$prevdata
{content},
$prevdata
{metadata} );
my
%unique
=
map
{
$_
=> 1 }
@all
;
@links_to
=
keys
%unique
;
}
$sql
=
"INSERT INTO internal_links (link_from, link_to) VALUES (?,?)"
;
$sth
=
$dbh
->prepare(
$sql
);
foreach
my
$link
(
@links_to
) {
eval
{
$sth
->execute(
$name
,
$link
); };
carp
"Couldn't index backlink: "
.
$dbh
->errstr
if
$@;
}
$sql
= "DELETE FROM metadata
WHERE node_id =
$node_id
AND version =
$version
";
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute()
or croak
"Deletion failed: "
.
$dbh
->errstr;
post_delete_node(
$name
,
$node_id
,
$version
,
$args
{plugins});
return
1;
}
$sql
= "DELETE FROM content
WHERE node_id =
$node_id
AND version=?";
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$version
)
or croak
"Deletion failed: "
.
$dbh
->errstr;
$sql
= "DELETE FROM metadata
WHERE node_id =
$node_id
AND version=?";
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$version
)
or croak
"Deletion failed: "
.
$dbh
->errstr;
post_delete_node(
$name
,
$node_id
,
$version
,
$args
{plugins});
return
1;
}
sub
post_delete_node {
my
(
$name
,
$node_id
,
$version
,
$plugins
) =
@_
;
my
@plugins
= @{
$plugins
|| [ ] };
foreach
my
$plugin
(
@plugins
) {
if
(
$plugin
->can(
"post_delete"
) ) {
$plugin
->post_delete(
node
=>
$name
,
node_id
=>
$node_id
,
version
=>
$version
);
}
}
}
sub
list_recent_changes {
my
$self
=
shift
;
my
%args
=
@_
;
if
(
$args
{since}) {
return
$self
->_find_recent_changes_by_criteria(
%args
);
}
elsif
(
$args
{between_days}) {
return
$self
->_find_recent_changes_by_criteria(
%args
);
}
elsif
(
$args
{days} ) {
my
$now
=
localtime
;
my
$then
=
$now
- ( ONE_DAY *
$args
{days} );
$args
{since} =
$then
;
delete
$args
{days};
return
$self
->_find_recent_changes_by_criteria(
%args
);
}
elsif
(
$args
{last_n_changes} ) {
$args
{limit} =
delete
$args
{last_n_changes};
return
$self
->_find_recent_changes_by_criteria(
%args
);
}
else
{
croak
"Need to supply some criteria to list_recent_changes."
;
}
}
sub
_find_recent_changes_by_criteria {
my
(
$self
,
%args
) =
@_
;
my
(
$since
,
$limit
,
$between_days
,
$ignore_case
,
$metadata_is
,
$metadata_isnt
,
$metadata_was
,
$metadata_wasnt
) =
@args
{
qw( since limit between_days ignore_case
metadata_is metadata_isnt metadata_was metadata_wasnt)
};
my
$dbh
=
$self
->dbh;
my
@where
;
my
@metadata_joins
;
my
$main_table
=
$args
{include_all_changes} ?
"content"
:
"node"
;
if
(
$metadata_is
||
$metadata_isnt
) {
if
(
$metadata_is
) {
my
$i
= 0;
foreach
my
$type
(
keys
%$metadata_is
) {
$i
++;
my
$value
=
$metadata_is
->{
$type
};
croak
"metadata_is must have scalar values"
if
ref
$value
;
my
$mdt
=
"md_is_$i"
;
push
@metadata_joins
, "LEFT JOIN metadata AS
$mdt
ON
$main_table
."
. ((
$main_table
eq
"node"
) ?
"id"
:
"node_id"
)
. "=
$mdt
.node_id
AND
$main_table
.version=
$mdt
.version\n";
push
@where
,
"( "
.
$self
->_get_comparison_sql(
thing1
=>
"$mdt.metadata_type"
,
thing2
=>
$dbh
->quote(
$type
),
ignore_case
=>
$ignore_case
,
)
.
" AND "
.
$self
->_get_comparison_sql(
thing1
=>
"$mdt.metadata_value"
,
thing2
=>
$dbh
->quote(
$self
->charset_encode(
$value
) ),
ignore_case
=>
$ignore_case
,
)
.
" )"
;
}
}
if
(
$metadata_isnt
) {
foreach
my
$type
(
keys
%$metadata_isnt
) {
my
$value
=
$metadata_isnt
->{
$type
};
croak
"metadata_isnt must have scalar values"
if
ref
$value
;
}
my
@omits
=
$self
->_find_recent_changes_by_criteria(
since
=>
$since
,
between_days
=>
$between_days
,
metadata_is
=>
$metadata_isnt
,
ignore_case
=>
$ignore_case
,
);
foreach
my
$omit
(
@omits
) {
push
@where
,
"( node.name != "
.
$dbh
->quote(
$omit
->{name})
.
" OR node.version != "
.
$dbh
->quote(
$omit
->{version})
.
")"
;
}
}
}
else
{
if
(
$metadata_was
) {
$main_table
=
"content"
;
my
$i
= 0;
foreach
my
$type
(
keys
%$metadata_was
) {
$i
++;
my
$value
=
$metadata_was
->{
$type
};
croak
"metadata_was must have scalar values"
if
ref
$value
;
my
$mdt
=
"md_was_$i"
;
push
@metadata_joins
, "LEFT JOIN metadata AS
$mdt
ON
$main_table
.node_id=
$mdt
.node_id
AND
$main_table
.version=
$mdt
.version\n";
push
@where
,
"( "
.
$self
->_get_comparison_sql(
thing1
=>
"$mdt.metadata_type"
,
thing2
=>
$dbh
->quote(
$type
),
ignore_case
=>
$ignore_case
,
)
.
" AND "
.
$self
->_get_comparison_sql(
thing1
=>
"$mdt.metadata_value"
,
thing2
=>
$dbh
->quote(
$self
->charset_encode(
$value
) ),
ignore_case
=>
$ignore_case
,
)
.
" )"
;
}
}
if
(
$metadata_wasnt
) {
$main_table
=
"content"
;
foreach
my
$type
(
keys
%$metadata_wasnt
) {
my
$value
=
$metadata_was
->{
$type
};
croak
"metadata_was must have scalar values"
if
ref
$value
;
}
my
@omits
=
$self
->_find_recent_changes_by_criteria(
since
=>
$since
,
between_days
=>
$between_days
,
metadata_was
=>
$metadata_wasnt
,
ignore_case
=>
$ignore_case
,
);
foreach
my
$omit
(
@omits
) {
push
@where
,
"( node.name != "
.
$dbh
->quote(
$omit
->{name})
.
" OR content.version != "
.
$dbh
->quote(
$omit
->{version})
.
")"
;
}
}
}
if
(
$since
) {
my
$timestamp
=
$self
->_get_timestamp(
$since
);
push
@where
,
"$main_table.modified >= "
.
$dbh
->quote(
$timestamp
);
}
elsif
(
$between_days
) {
my
$now
=
localtime
;
my
(
$start
,
$end
) =
@$between_days
;
(
$start
,
$end
) = (
$end
,
$start
)
if
$start
<
$end
;
my
$ts_start
=
$self
->_get_timestamp(
$now
- (ONE_DAY *
$start
) );
my
$ts_end
=
$self
->_get_timestamp(
$now
- (ONE_DAY *
$end
) );
push
@where
,
"$main_table.modified >= "
.
$dbh
->quote(
$ts_start
);
push
@where
,
"$main_table.modified <= "
.
$dbh
->quote(
$ts_end
);
}
my
$sql
= "SELECT DISTINCT
node.name,
$main_table
.version,
$main_table
.modified
FROM
$main_table
"
. (
(
$main_table
ne
"node"
)
?
"INNER JOIN node ON (id = $main_table.node_id) "
:
""
)
.
join
(
"\n"
,
@metadata_joins
)
. (
scalar
@where
?
" WHERE "
.
join
(
" AND "
,
@where
)
:
""
)
.
" ORDER BY $main_table.modified DESC"
;
if
(
$limit
) {
croak
"Bad argument $limit"
unless
$limit
=~ /^\d+$/;
$sql
.=
" LIMIT $limit"
;
}
my
$nodesref
=
$dbh
->selectall_arrayref(
$sql
);
my
@finds
=
map
{ {
name
=>
$_
->[0],
version
=>
$_
->[1],
last_modified
=>
$_
->[2] }
}
@$nodesref
;
foreach
my
$find
(
@finds
) {
my
%metadata
;
my
$sth
=
$dbh
->prepare( "SELECT metadata_type, metadata_value
FROM node
INNER JOIN metadata
ON (id = node_id)
WHERE name=?
AND metadata.version=?" );
$sth
->execute(
$find
->{name},
$find
->{version} );
while
(
my
(
$type
,
$value
) =
$self
->charset_decode(
$sth
->fetchrow_array ) ) {
if
(
defined
$metadata
{
$type
} ) {
push
@{
$metadata
{
$type
}},
$value
;
}
else
{
$metadata
{
$type
} = [
$value
];
}
}
$find
->{metadata} = \
%metadata
;
}
return
@finds
;
}
sub
list_all_nodes {
my
(
$self
,
%args
) =
@_
;
my
$dbh
=
$self
->dbh;
my
@nodes
;
if
(
$args
{with_details}) {
my
$sql
=
"SELECT id, name, version, moderate FROM node;"
;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute();
while
(
my
@results
=
$sth
->fetchrow_array) {
my
%data
;
@data
{
qw( node_id name version moderate )
} =
@results
;
push
@nodes
, \
%data
;
}
}
else
{
my
$sql
=
"SELECT name FROM node;"
;
my
$raw_nodes
=
$dbh
->selectall_arrayref(
$sql
);
@nodes
= (
map
{
$self
->charset_decode(
$_
->[0] ) } (
@$raw_nodes
) );
}
return
@nodes
;
}
sub
list_node_all_versions {
my
(
$self
,
%args
) =
@_
;
my
(
$node_id
,
$name
,
$with_content
,
$with_metadata
) =
@args
{
qw( node_id name with_content with_metadata )
};
my
$dbh
=
$self
->dbh;
my
$sql
;
unless
(
$node_id
) {
$sql
=
"SELECT id FROM node WHERE name="
.
$dbh
->quote(
$name
);
$node_id
=
$dbh
->selectrow_array(
$sql
);
}
return
()
unless
(
$node_id
);
$sql
=
"SELECT id, name, content.version, content.modified "
;
if
(
$with_content
) {
$sql
.=
", content.text "
;
}
if
(
$with_metadata
) {
$sql
.=
", metadata_type, metadata_value "
;
}
$sql
.=
" FROM node INNER JOIN content ON (id = content.node_id) "
;
if
(
$with_metadata
) {
$sql
.=
" LEFT OUTER JOIN metadata ON (id = metadata.node_id AND content.version = metadata.version) "
;
}
$sql
.=
" WHERE id = ? ORDER BY content.version DESC"
;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$node_id
);
my
%first_data
;
my
$dataref
= \
%first_data
;
my
@versions
;
while
(
my
@results
=
$sth
->fetchrow_array) {
my
%data
=
%$dataref
;
if
(
%data
&&
$data
{
'version'
} !=
$results
[2]) {
push
@versions
,
$dataref
;
%data
= ();
}
else
{
}
@data
{
qw( node_id name version last_modified )
} =
@results
;
my
$i
= 4;
if
(
$with_content
) {
$data
{
'content'
} =
$results
[
$i
];
$i
++;
}
if
(
$with_metadata
) {
my
(
$m_type
,
$m_value
) =
@results
[
$i
,(
$i
+1)];
unless
(
$data
{
'metadata'
}) {
$data
{
'metadata'
} = {}; }
if
(
$m_type
) {
if
(
$data
{
'metadata'
}->{
$m_type
}) {
unless
(
ref
(
$data
{
'metadata'
}->{
$m_type
}) eq
"ARRAY"
) {
$data
{
'metadata'
}->{
$m_type
} = [
$data
{
'metadata'
}->{
$m_type
} ];
}
push
@{
$data
{
'metadata'
}->{
$m_type
}},
$m_value
;
}
else
{
$data
{
'metadata'
}->{
$m_type
} =
$m_value
;
}
}
}
$dataref
= \
%data
;
}
if
(
$dataref
) {
push
@versions
,
$dataref
;
}
return
@versions
;
}
sub
list_nodes_by_metadata {
my
(
$self
,
%args
) =
@_
;
my
(
$type
,
$value
) =
@args
{
qw( metadata_type metadata_value )
};
return
()
unless
$type
;
my
$dbh
=
$self
->dbh;
if
(
$args
{ignore_case} ) {
$type
=
lc
(
$type
);
$value
=
lc
(
$value
);
}
my
$sql
=
$self
->_get_list_by_metadata_sql(
ignore_case
=>
$args
{ignore_case} );
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$type
,
$self
->charset_encode(
$value
) );
my
@nodes
;
while
(
my
(
$id
,
$node
) =
$sth
->fetchrow_array ) {
push
@nodes
,
$node
;
}
return
@nodes
;
}
sub
list_nodes_by_missing_metadata {
my
(
$self
,
%args
) =
@_
;
my
(
$type
,
$value
) =
@args
{
qw( metadata_type metadata_value )
};
return
()
unless
$type
;
my
$dbh
=
$self
->dbh;
if
(
$args
{ignore_case} ) {
$type
=
lc
(
$type
);
$value
=
lc
(
$value
);
}
my
@nodes
;
if
( !
$value
) {
my
$sql
=
$self
->_get_list_by_missing_metadata_sql(
ignore_case
=>
$args
{ignore_case}
);
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$type
);
while
(
my
(
$id
,
$node
) =
$sth
->fetchrow_array ) {
push
@nodes
,
$node
;
}
}
else
{
my
@with
=
$self
->list_nodes_by_metadata(
%args
);
my
%with_hash
;
foreach
my
$node
(
@with
) {
$with_hash
{
$node
} = 1; }
my
@all_nodes
=
$self
->list_all_nodes();
foreach
my
$node
(
@all_nodes
) {
unless
(
$with_hash
{
$node
}) {
push
@nodes
,
$node
;
}
}
}
return
@nodes
;
}
sub
_get_list_by_metadata_sql {
my
(
$self
,
%args
) =
@_
;
if
(
$args
{ignore_case} ) {
return
"SELECT node.id, node.name "
.
"FROM node "
.
"INNER JOIN metadata "
.
" ON (node.id = metadata.node_id "
.
" AND node.version=metadata.version) "
.
"WHERE "
.
$self
->_get_lowercase_compare_sql(
"metadata.metadata_type"
)
.
" AND "
.
$self
->_get_lowercase_compare_sql(
"metadata.metadata_value"
);
}
else
{
return
"SELECT node.id, node.name "
.
"FROM node "
.
"INNER JOIN metadata "
.
" ON (node.id = metadata.node_id "
.
" AND node.version=metadata.version) "
.
"WHERE "
.
$self
->_get_casesensitive_compare_sql(
"metadata.metadata_type"
)
.
" AND "
.
$self
->_get_casesensitive_compare_sql(
"metadata.metadata_value"
);
}
}
sub
_get_list_by_missing_metadata_sql {
my
(
$self
,
%args
) =
@_
;
my
$sql
=
""
;
if
(
$args
{ignore_case} ) {
$sql
=
"SELECT node.id, node.name "
.
"FROM node "
.
"LEFT OUTER JOIN metadata "
.
" ON (node.id = metadata.node_id "
.
" AND node.version=metadata.version "
.
" AND "
.
$self
->_get_lowercase_compare_sql(
"metadata.metadata_type"
)
.
")"
;
}
else
{
$sql
=
"SELECT node.id, node.name "
.
"FROM node "
.
"LEFT OUTER JOIN metadata "
.
" ON (node.id = metadata.node_id "
.
" AND node.version=metadata.version "
.
" AND "
.
$self
->_get_casesensitive_compare_sql(
"metadata.metadata_type"
)
.
")"
;
}
$sql
.=
"WHERE (metadata.metadata_value IS NULL OR LENGTH(metadata.metadata_value) = 0) "
;
return
$sql
;
}
sub
_get_lowercase_compare_sql {
my
(
$self
,
$column
) =
@_
;
return
"lower($column) = ?"
;
}
sub
_get_casesensitive_compare_sql {
my
(
$self
,
$column
) =
@_
;
return
"$column = ?"
;
}
sub
_get_comparison_sql {
my
(
$self
,
%args
) =
@_
;
return
"$args{thing1} = $args{thing2}"
;
}
sub
_get_node_exists_ignore_case_sql {
return
"SELECT name FROM node WHERE name = ? "
;
}
sub
list_unmoderated_nodes {
my
(
$self
,
%args
) =
@_
;
my
$only_where_lastest
=
$args
{
'only_where_latest'
};
my
$sql
=
"SELECT "
.
" id, name, "
.
" node.version AS last_moderated_version, "
.
" content.version AS version "
.
"FROM content "
.
"INNER JOIN node "
.
" ON (id = node_id) "
.
"WHERE moderated = ? "
;
if
(
$only_where_lastest
) {
$sql
.=
"AND node.version = content.version "
;
}
$sql
.=
"ORDER BY name, content.version "
;
my
$dbh
=
$self
->dbh;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
"0"
);
my
@nodes
;
while
(
my
@results
=
$sth
->fetchrow_array) {
my
%data
;
@data
{
qw( node_id name moderated_version version )
} =
@results
;
push
@nodes
, \
%data
;
}
return
@nodes
;
}
sub
list_last_version_before {
my
(
$self
,
$date
) =
@_
;
my
$sql
=
"SELECT "
.
" id, name, "
.
"MAX(content.version) AS version, MAX(content.modified) AS modified "
.
"FROM node "
.
"LEFT OUTER JOIN content "
.
" ON (id = node_id "
.
" AND content.modified <= ?) "
.
"GROUP BY id, name "
.
"ORDER BY id "
;
my
$dbh
=
$self
->dbh;
my
$sth
=
$dbh
->prepare(
$sql
);
$sth
->execute(
$date
);
my
@nodes
;
while
(
my
@results
=
$sth
->fetchrow_array) {
my
%data
;
@data
{
qw( id name version modified )
} =
@results
;
$data
{
'node_id'
} =
$data
{
'id'
};
unless
(
$data
{
'version'
}) {
$data
{
'version'
} =
undef
; }
push
@nodes
, \
%data
;
}
return
@nodes
;
}
sub
list_metadata_by_type {
my
(
$self
,
$type
) =
@_
;
return
0
unless
$type
;
}
sub
schema_current {
my
$self
=
shift
;
my
$dbh
=
$self
->dbh;
my
$sth
;
eval
{
$sth
=
$dbh
->prepare(
"SELECT version FROM schema_info"
) };
if
($@) {
return
(
$SCHEMA_VER
, 0);
}
eval
{
$sth
->execute };
if
($@) {
return
(
$SCHEMA_VER
, 0);
}
my
$version
;
eval
{
$version
=
$sth
->fetchrow_array };
if
($@) {
return
(
$SCHEMA_VER
, 0);
}
else
{
return
(
$SCHEMA_VER
,
$version
);
}
}
sub
dbh {
my
$self
=
shift
;
return
$self
->{_dbh};
}
sub
dbname {
my
$self
=
shift
;
return
$self
->{_dbname};
}
sub
dbuser {
my
$self
=
shift
;
return
$self
->{_dbuser};
}
sub
dbpass {
my
$self
=
shift
;
return
$self
->{_dbpass};
}
sub
dbhost {
my
$self
=
shift
;
return
$self
->{_dbhost};
}
sub
DESTROY {
my
$self
=
shift
;
return
if
$self
->{_external_dbh};
my
$dbh
=
$self
->dbh;
$dbh
->disconnect
if
$dbh
;
}
sub
charset_decode {
my
$self
=
shift
;
my
@input
=
@_
;
if
(
$CAN_USE_ENCODE
) {
my
@output
;
for
(
@input
) {
push
(
@output
, Encode::decode(
$self
->{_charset},
$_
) );
}
return
@output
;
}
return
@input
;
}
sub
charset_encode {
my
$self
=
shift
;
my
@input
=
@_
;
if
(
$CAN_USE_ENCODE
) {
my
@output
;
for
(
@input
) {
push
(
@output
, Encode::encode(
$self
->{_charset},
$_
) );
}
return
@output
;
}
return
@input
;
}
1;