load(metamoderations => "Newslash::Model::Metamoderations");
load(moderations => "Newslash::Model::Moderations");
load(networks => "Newslash::Model::Networks");
+load(polls => "Newslash::Model::Polls");
load(relations => "Newslash::Model::Relations");
load(stories =>"Newslash::Model::Stories");
load(submissions => "Newslash::Model::Submissions");
package Newslash::Model::Base;
+use Newslash::Model::Cowrapper -base;
use strict;
use warnings;
use Data::Dumper;
-sub transaction_mode {
- my $self = shift;
- return 0 if !defined $self->{_transactions};
- return ($self->{_transactions} > 0);
-}
-
-sub start_transaction {
- my $self = shift;
-
- if (!defined $self->{_transactions}) {
- $self->{_transactions} = 0;
- }
-
- # already transaction mode
- if ($self->transaction_mode) {
- $self->{_transactions} += 1;
- return $self->{_tr_dbh};
- }
-
- # start new transaction
- $self->connect_db({AutoCommit => 0,});
- $self->{_transactions} = 1;
-
- return $self->{_tr_dbh};
-}
-
-# use external defined dbh
-sub use_transaction {
- my $self = shift;
- my $dbh = shift;
-
- if ($dbh) {
- $self->{_transactions} = 2;
- $self->{_tr_dbh} = $dbh;
- return $dbh;
- }
- return;
-}
-
-sub commit {
- my $self = shift;
- return if !$self->transaction_mode;
-
- if ($self->{_transactions} == 1) {
- $self->{_tr_dbh}->commit;
- $self->{_tr_dbh}->disconnect;
-
- delete $self->{_tr_dbh};
- }
- $self->{_transactions} -= 1;
-}
-
-sub rollback {
- my $self = shift;
- return if !$self->transaction_mode;
-
- #$self->set_error($self->{_tr_dbh}->errstr);
-
- $self->{_tr_dbh}->rollback;
- $self->{_tr_dbh}->disconnect;
- delete $self->{_tr_dbh};
- $self->{_transactions} = 0;
-}
-
-sub connect_db {
- my $self = shift;
- my $options = shift || {};
-
- if ($self->transaction_mode) {
- return $self->{_tr_dbh};
- }
-
- my $DB_HOST = $self->{options}->{Database}->{host};
- my $DB_NAME = $self->{options}->{Database}->{name};
- my $DB_USER = $self->{options}->{Database}->{user};
- my $DB_PASSWORD = $self->{options}->{Database}->{password};
-
- my $settings = 'mysql_read_default_group=libmysqlclient;mysql_read_default_file=/etc/mysql/my.cnf';
- my $attr = {
- mysql_enable_utf8 => 1,
- ShowErrorStatement => 1,
- Callbacks => { # hack to use utf8mb4. see http://d.hatena.ne.jp/hirose31/20141028/1414496347
- connected => sub {
- shift->do('SET NAMES utf8mb4');
- return;
- }
- },
- %$options,
- };
-
- my $dbh = DBI->connect("DBI:mysql:$DB_NAME:$DB_HOST;$settings", $DB_USER, $DB_PASSWORD, $attr);
-
- $self->{_tr_dbh} = $dbh;
- return $dbh;
-
-}
-
-sub disconnect_db {
- my $self = shift;
- return if $self->transaction_mode;
- return if !$self->{_tr_dbh};
-
- return $self->{_tr_dbh}->disconnect;
-}
-
sub import {
my $class = shift;
return unless my $flag = shift;
return 1;
}
-sub table_exists {
- my ($self, $table) = @_;
-
- my $dbh = $self->connect_db;
- my $DB_NAME = $self->{options}->{Database}->{name};
-
- my $sql = <<"EOSQL";
-SELECT * FROM information_schema.TABLES
- WHERE TABLE_SCHEMA = ?
- AND TABLE_NAME = ?
-EOSQL
- my $sth = $dbh->prepare($sql);
- $sth->execute($DB_NAME, $table);
- my $rs = $sth->fetchall_arrayref({});
- $dbh->disconnect;
- if (@$rs == 0) {
- return;
- }
- return 1;
-}
-
-sub new {
- my ($class, $options) = @_;
- $options ||= {};
- my $readonly = $options->{System}->{readonly} ? 1 : 0;
-
- bless {options => $options,
- _error => "",
- _errorno => 0,
- _readonly => $readonly, }, $class;
-}
-
-sub check_readonly {
- my $self = shift;
- if ($self->{_readonly}) {
- $self->set_error("readonly mode");
- return 1;
- }
- return;
-}
-
-sub clear_error {
- my $self = shift;
- $self->{_error} = undef;
- $self->{_errorno} = undef;
-}
-
-sub set_error {
- my ($self, $error, $errorno) =@_;
- $self->{_error} = $error;
- $self->{_errorno} = $errorno if $errorno;
-}
-sub set_errorno {
- my ($self, $errorno) =@_;
- $self->{_errorno} = $errorno;
-}
-
-sub last_error {
- my $self = shift;
- return $self->{_error};
-}
-
-sub last_errorno {
- my $self = shift;
- return $self->{_errorno};
-}
-
sub new_instance_of {
my ($self, $class) = @_;
if ($class !~ m/::/) {
}
-sub generic_select {
- my $self = shift;
- my $table = shift;
- my $options = shift;
- my $params = {@_};
-
- if (!$table) {
- $self->set_error("table no given");
- return;
- }
- my $uniques = $options->{unique_keys} || [];
- my $keys = $options->{keys} || [];
-
- my @arguments;
- my $values;
- my ($orderby, $limit, $where, $unique_query);
-
- ($where, $values, $unique_query) = $self->build_where_clause($uniques, $keys, @_);
- push @arguments, @$values if @$values;
- ($orderby, $values) = $self->build_orderby_clause({columns => $keys}, $params);
- push @arguments, @$values if @$values;
- ($limit, $values) = $self->build_limit_clause($params);
- push @arguments, @$values if @$values;
-
- if ($where) {
- $where = "WHERE " . $where;
- }
- #return if (!$where && !$limit);
-
- my $dbh = $self->connect_db;
- my $generic_sql = <<"EOSQL";
-SELECT * FROM $table
- $where
- $orderby
- $limit
-EOSQL
-
- my $sql = $options->{sql} || $generic_sql;
- #warn Dumper({ sql => $sql, values => \@arguments});
-
- my $sth = $dbh->prepare($sql);
- $sth->execute(@arguments);
- my $rs = $sth->fetchall_arrayref(+{});
- if (!defined $rs) {
- $self->set_error("select failed", $dbh->{mysql_errorno});
- $dbh->disconnect();
- return;
- }
- $dbh->disconnect();
-
- if ($unique_query) {
- $self->clear_error;
- return $rs->[0] if @$rs;
- return;
- }
- return $rs;
-}
-
-#========================================================================
-
-=head2 base_select($table, \@unique_keys, \@keys, @params)
-
-select from table with simple rule.
-
-=over 4
-
-=item Parameters
-
-=over 4
-
-=item $table
-
-target table
-
-=item \@unique_keys
-
-ARRAYREF to unique keys. 'unique key' is a column name
- defined with 'UNIQUE' or 'PRIMARY'
-
-=back
-
-=item \@keys
-
-ARRAYREF to acceptable keys
-
-=back
-
-=item @params
-
-query parameters
-
-=item Return value
-
-when query is executed with unique key, hash of result row.
-
-else, ARRAY of result rows.
-
-=back
-
-=cut
-
-sub base_select {
- my $self = shift;
- my $table = shift;
- my $uniques = shift;
- my $keys = shift;
- my @params = @_;
-
- return if !$table;
- my ($clause, $values, $unique) = $self->build_where_clause($uniques, $keys, @params);
- my $where_clause = "";
- if ($clause) {
- $where_clause = "WHERE " . $clause;
- }
-
- return if !$clause;
- my $dbh = $self->connect_db;
- my $sql = <<"EOSQL";
-SELECT * FROM $table
- $where_clause
-EOSQL
-
- my $sth = $dbh->prepare($sql);
- $sth->execute(@$values);
- my $rs = $sth->fetchall_arrayref(+{});
- $dbh->disconnect();
- return if !$rs;
-
- if ($unique) {
- return $rs->[0] if @$rs;
- return 0;
- }
-
- return $rs;
-}
-
-
-sub build_orderby_clause {
- my $self = shift;
- my $options = shift;
- my $params = shift;
-
- my @clauses;
- my @values;
-
- # build ORDER BY clause
- my $columns = [];
-
- my $use_alias = 0;
- if (ref($options->{columns}) eq 'ARRAY') {
- $columns = $options->{columns};
- }
- elsif (ref($options->{columns}) eq 'HASH') {
- $columns = [keys %{$options->{columns}}];
- $use_alias = 1;
- }
-
- if (defined $params->{order_by}) {
- if (ref($params->{order_by}) eq "ARRAY") {
- for my $k (@{$params->{order_by}}) {
- if (ref($k) eq "HASH") {
- my @keys = keys %$k;
- my $column = shift @keys;
- next if !any {$_ eq $column} @$columns;
-
- my $order = "";
- $order = "DESC" if lc($k->{$column}) eq 'desc';
- $order = "ASC" if lc($k->{$column}) eq 'asc';
-
- if ($use_alias) {
- push @clauses, "ORDER BY $options->{columns}->{$column} $order";
- }
- else {
- push @clauses, "ORDER BY $column $order";
- }
- }
- elsif (any {$_ eq $k} $columns) {
- if ($use_alias) {
- push @clauses, "ORDER BY $options->{columns}->{$k}";
- }
- else {
- push @clauses, "ORDER BY $k";
- }
- }
- }
- }
- elsif (ref($params->{order_by}) eq "HASH") {
- my @keys = keys %{$params->{order_by}};
- for my $k (@keys) {
- next if !any {$_ eq $k} @$columns;
-
- my $order = "";
- $order = "DESC" if lc($params->{order_by}->{$k}) eq 'desc';
- $order = "ASC" if lc($params->{order_by}->{$k}) eq 'asc';
-
- if ($use_alias) {
- push @clauses, "ORDER BY $options->{columns}->{$k} $order";
- }
- else {
- push @clauses, "ORDER BY $k $order";
- }
- }
- }
- elsif (any {$_ eq $params->{order_by} } @$columns) {
- if ($use_alias) {
- push @clauses, "ORDER BY $options->{columns}->{$params->{order_by}}";
- }
- else {
- push @clauses, "ORDER BY $params->{order_by}";
- }
- }
- }
-
- my $clause = join(" ", @clauses) || "";
- #return { clause => $clause, params => \@values };
- return ($clause, \@values);
-}
-
-sub build_limit_clause {
- my $self = shift;
-# my $options = shift;
- my $params = shift;
-
- my @clauses;
- my @values;
-
- if (defined $params->{limit}) {
- push @clauses, "LIMIT ?";
- push @values, $params->{limit};
- if (defined $params->{offset}) {
- push @clauses, "OFFSET ?";
- push @values, $params->{offset};
- }
- }
-
- my $clause = join(" ", @clauses);
- #return { clause => $clause, params => \@values };
- return ($clause, \@values);
-}
-
-#========================================================================
-
-=head2 build_where_clause(\@unique_keys, \@keys, @params)
-
-build SQL's WHERE clause.
-
-=over 4
-
-=item Parameters
-
-=over 4
-
-=item \@unique_keys
-
-ARRAYREF to unique keys. 'unique key' is a column name
- defined with 'UNIQUE' or 'PRIMARY'
-
-=back
-
-=item \@keys
-
-ARRAYREF to acceptable keys
-
-=back
-
-=item @params
-
-query parameters
-
-=item Return value
-
-when list context, returns ($clause, \@values, $unique).
-when scalar context, return hashref like:
- { clause => $clause, values => \@values, unique => $unique };
-
-=back
-
-=cut
-
-sub build_where_clause {
- my $self = shift;
- my $uniques = shift;
- my $keys = shift;
- my $params = { @_ };
-
- my @clauses;
- my @values;
- my $unique = 0;
- if ($uniques && @$uniques) {
- for my $k (@$uniques) {
- if (defined $params->{$k}) {
- push @clauses, "$k = ?";
- push @values, $params->{$k};
- $unique = 1;
- }
- }
- }
- if ($keys && @$keys) {
- for my $k (@$keys) {
- if (defined $params->{$k}) {
- push @clauses, "$k = ?";
- push @values, $params->{$k};
- }
- }
- }
-
- my $clause = "";
- if (@clauses != 0) {
- $clause = join(" AND ", @clauses);
- }
-
- return wantarray ? ($clause, \@values, $unique)
- : { clause => $clause,
- values => \@values,
- unique => $unique, };
-}
-
1;
my $where_clause = @clauses ? 'WHERE ' . join(' AND ', @clauses) : "";
- my ($orderby, $orderby_values) = $self->build_orderby_clause({columns => {timestamp => 'comments.date'}}, $params);
+ my ($orderby, $orderby_values) = $self->build_orderby_clause(keys => {timestamp => 'comments.date'}, params => $params);
if (@$orderby_values) {
push @values, @$orderby_values;
}
$orderby = "ORDER BY comments.cid ASC" if !$orderby;
- my ($limit_clause, $limit_values) = $self->build_limit_clause($params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
if (@$limit_values) {
push @values, @$limit_values;
}
--- /dev/null
+package Newslash::Model::Cowrapper;
+# Cowrapper - Connection Wrapper for MySQL
+
+use strict;
+use warnings;
+use utf8;
+use feature ':5.10';
+
+use List::Util qw(any);
+use DBI;
+
+sub import {
+ my $class = shift;
+ return unless my $flag = shift;
+
+ if ($flag eq '-base') {
+ $flag = $class;
+ } elsif ($flag eq '-strict') {
+ $flag = undef;
+ }
+
+ if ($flag) {
+ my $caller = caller;
+ no strict 'refs';
+ push @{"${caller}::ISA"}, $flag;
+ }
+
+ $_->import for qw(strict warings utf8);
+ feature->import(':5.10');
+}
+
+sub new {
+ my ($class, $options) = @_;
+ $options ||= {};
+ my $readonly = $options->{System}->{readonly} ? 1 : 0;
+
+ bless {options => $options,
+ _error => "",
+ _errorno => 0,
+ _readonly => $readonly, }, $class;
+}
+
+
+######### connect/disconnect functions
+
+sub connect_db {
+ my $self = shift;
+ my $options = shift || {};
+
+ if ($self->transaction_mode) {
+ return $self->{_tr_dbh};
+ }
+
+ my $DB_HOST = $self->{options}->{Database}->{host};
+ my $DB_NAME = $self->{options}->{Database}->{name};
+ my $DB_USER = $self->{options}->{Database}->{user};
+ my $DB_PASSWORD = $self->{options}->{Database}->{password};
+
+ my $settings = 'mysql_read_default_group=libmysqlclient;mysql_read_default_file=/etc/mysql/my.cnf';
+ my $attr = {
+ mysql_enable_utf8 => 1,
+ ShowErrorStatement => 1,
+ Callbacks => { # hack to use utf8mb4. see http://d.hatena.ne.jp/hirose31/20141028/1414496347
+ connected => sub {
+ shift->do('SET NAMES utf8mb4');
+ return;
+ }
+ },
+ %$options,
+ };
+
+ my $dbh = DBI->connect("DBI:mysql:$DB_NAME:$DB_HOST;$settings", $DB_USER, $DB_PASSWORD, $attr);
+
+ $self->{_tr_dbh} = $dbh;
+ return $dbh;
+
+}
+
+sub disconnect_db {
+ my $self = shift;
+ return if $self->transaction_mode;
+ return if !$self->{_tr_dbh};
+
+ return $self->{_tr_dbh}->disconnect;
+}
+
+
+########## Transaction related functions
+
+sub transaction_mode {
+ my $self = shift;
+ return 0 if !defined $self->{_transactions};
+ return ($self->{_transactions} > 0);
+}
+
+sub start_transaction {
+ my $self = shift;
+
+ if (!defined $self->{_transactions}) {
+ $self->{_transactions} = 0;
+ }
+
+ # already transaction mode
+ if ($self->transaction_mode) {
+ $self->{_transactions} += 1;
+ return $self->{_tr_dbh};
+ }
+
+ # start new transaction
+ $self->connect_db({AutoCommit => 0,});
+ $self->{_transactions} = 1;
+
+ return $self->{_tr_dbh};
+}
+
+# use external defined dbh
+sub use_transaction {
+ my $self = shift;
+ my $dbh = shift;
+
+ if ($dbh) {
+ $self->{_transactions} = 2;
+ $self->{_tr_dbh} = $dbh;
+ return $dbh;
+ }
+ return;
+}
+
+sub commit {
+ my $self = shift;
+ return if !$self->transaction_mode;
+
+ if ($self->{_transactions} == 1) {
+ $self->{_tr_dbh}->commit;
+ $self->{_tr_dbh}->disconnect;
+
+ delete $self->{_tr_dbh};
+ }
+ $self->{_transactions} -= 1;
+}
+
+sub rollback {
+ my $self = shift;
+ return if !$self->transaction_mode;
+
+ #$self->set_error($self->{_tr_dbh}->errstr);
+
+ $self->{_tr_dbh}->rollback;
+ $self->{_tr_dbh}->disconnect;
+ delete $self->{_tr_dbh};
+ $self->{_transactions} = 0;
+}
+
+########## Utility functions
+
+sub table_exists {
+ my ($self, $table) = @_;
+
+ my $dbh = $self->connect_db;
+ my $DB_NAME = $self->{options}->{Database}->{name};
+
+ my $sql = <<"EOSQL";
+SELECT * FROM information_schema.TABLES
+ WHERE TABLE_SCHEMA = ?
+ AND TABLE_NAME = ?
+EOSQL
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($DB_NAME, $table);
+ my $rs = $sth->fetchall_arrayref({});
+ $dbh->disconnect;
+ if (@$rs == 0) {
+ return;
+ }
+ return 1;
+}
+
+sub check_readonly {
+ my $self = shift;
+ if ($self->{_readonly}) {
+ $self->set_error("readonly mode");
+ return 1;
+ }
+ return;
+}
+
+########## error handling
+sub clear_error {
+ my $self = shift;
+ $self->{_error} = undef;
+ $self->{_errorno} = undef;
+}
+
+sub set_error {
+ my ($self, $error, $errorno) =@_;
+ $self->{_error} = $error;
+ $self->{_errorno} = $errorno if $errorno;
+}
+sub set_errorno {
+ my ($self, $errorno) =@_;
+ $self->{_errorno} = $errorno;
+}
+
+sub last_error {
+ my $self = shift;
+ return $self->{_error};
+}
+
+sub last_errorno {
+ my $self = shift;
+ return $self->{_errorno};
+}
+
+########## Utility functions
+
+=head2 build_where_clause(uniques => \@unique_keys, keys => \@keys, params => \@params)
+
+build SQL's WHERE clause.
+
+=over 4
+
+=item Parameters
+
+=over 4
+
+=item \@unique_keys
+
+ARRAYREF to unique keys. 'unique key' is a column name
+defined with 'UNIQUE' or 'PRIMARY'.
+
+=back
+
+=item \@keys
+
+ARRAYREF to acceptable keys (column names)
+
+=back
+
+=item \@params
+
+HASHREF to query parameters
+
+=item Return value
+
+when list context, returns ($clause, \@values, $unique).
+when scalar context, return hashref like:
+ { clause => $clause, values => \@values, unique => $unique };
+
+=back
+
+=cut
+
+sub build_where_clause {
+ my $self = shift;
+ my $args = {@_};
+ my $uniques = $args->{uniques};
+ my $keys = $args->{keys};
+ my $params = $args->{params};
+
+ my @clauses;
+ my @values;
+ my $unique = 0;
+ if ($uniques && @$uniques) {
+ for my $k (@$uniques) {
+ if (defined $params->{$k}) {
+ push @clauses, "$k = ?";
+ push @values, $params->{$k};
+ $unique = 1;
+ }
+ }
+ }
+ if ($keys && @$keys) {
+ for my $k (@$keys) {
+ if (defined $params->{$k}) {
+ push @clauses, "$k = ?";
+ push @values, $params->{$k};
+ }
+ }
+ }
+
+ my $clause = "";
+ if (@clauses != 0) {
+ $clause = "WHERE " . join(" AND ", @clauses);
+ }
+
+ return wantarray ? ($clause, \@values, $unique)
+ : { clause => $clause,
+ values => \@values,
+ unique => $unique, };
+}
+
+=head2 build_limit_clause(params => \@params)
+
+build SQL's LIMIT clause.
+
+=over 4
+
+=item Parameters
+
+=over 4
+
+=item \@params
+
+HASHREF to query parameters
+
+=item Return value
+
+when list context, returns ($clause, \@values).
+when scalar context, return hashref like:
+ { clause => $clause, values => \@values };
+
+=back
+
+=cut
+
+sub build_limit_clause {
+ my $self = shift;
+ my $args = {@_};
+
+ my $params = $args->{params};
+
+ my @clauses;
+ my @values;
+ if (defined $params->{limit}) {
+ push @clauses, "LIMIT ?";
+ push @values, $params->{limit};
+ if (defined $params->{offset}) {
+ push @clauses, "OFFSET ?";
+ push @values, $params->{offset};
+ }
+ }
+
+ my $clause = join(" ", @clauses);
+
+ return wantarray ? ($clause, \@values)
+ : { clause => $clause, values => \@values };
+}
+
+=head2 build_orderby_clause(keys => $keys, params => \@params)
+
+build SQL's ORDER BY clause.
+
+=over 4
+
+=item Parameters
+
+=over 4
+
+=item $keys
+
+ARRAYREF or HASHREF.
+if ARRAREF, @$keys contains selectable columns.
+if HASHREF, %$keys is { key1 => alias1, key2 => alias2, ... }.
+
+key is key name used in $order_rule.
+alias is alias (used as key in builded SQL).
+
+=item \@params
+
+HASHREF to query parameters
+
+=item Return value
+
+when list context, returns ($clause, \@values).
+when scalar context, return hashref like:
+ { clause => $clause, values => \@values };
+
+=back
+
+=cut
+
+sub build_orderby_clause {
+ my $self = shift;
+ my $args = {@_};
+
+ my $columns = $args->{keys};
+ my $params = $args->{params};
+ my $order_by = $params->{order_by};
+
+ if (!$columns || !$params || !$order_by) {
+ return wantarray ? ("", [])
+ : { clause => "", values => [] };
+ }
+
+ my @clauses;
+ my @values;
+
+ my $use_alias = 0;
+ if (ref($columns) eq 'HASH') {
+ $columns = [keys %$columns];
+ $use_alias = 1;
+ }
+ elsif (!ref($columns)) {
+ $columns = [$columns];
+ }
+
+ if (ref($order_by) eq "HASH") {
+ my @keys = keys %$order_by;
+ for my $k (@keys) {
+ next if !any {$_ eq $k} @$columns;
+
+ my $order = "";
+ $order = "DESC" if lc($order_by->{$k}) eq 'desc';
+ $order = "ASC" if lc($order_by->{$k}) eq 'asc';
+
+ my $target = "";
+ if ($use_alias && $args->{columns}->{$k}) {
+ $target = $args->{columns}->{$k};
+ }
+ else {
+ $target = $k;
+ }
+ push @clauses, "$target $order" if $target;
+ }
+ }
+ elsif (ref($order_by) eq "ARRAY") {
+ for my $k (@$order_by) {
+ my $order = "";
+ my $col = $k;
+ if (ref($k) eq "HASH") {
+ my @keys = keys %$k;
+ $col = shift @keys;
+ $order = "DESC" if lc($k->{$col}) eq 'desc';
+ $order = "ASC" if lc($k->{$col}) eq 'asc';
+ }
+
+ next if !any {$_ eq $col} @$columns;
+
+ my $target = "";
+ if ($use_alias && $args->{columns}->{$k}) {
+ $target = $args->{columns}->{$k};
+ }
+ else {
+ $target = $k;
+ }
+ push @clauses, "$target $order" if $target;
+ }
+ }
+
+ my $clause = "";
+ if (@clauses) {
+ $clause = "ORDER BY " . join(" ", @clauses);
+ }
+
+ return wantarray ? ($clause, \@values)
+ : { clause => $clause, values => \@values };
+}
+
+########## Select method
+
+=head2 generic_select($table, uniques => $uniques, keys => $keys, params => $params)
+
+build SQL's ORDER BY clause.
+
+=over 4
+
+=item Parameters
+
+=over 4
+
+=item $table
+
+table name
+
+=item $uniques
+
+ARRAYREF to unique keys. 'unique key' is a column name
+defined with 'UNIQUE' or 'PRIMARY'.
+
+=back
+
+=item $keys
+
+ARRAYREF to acceptable keys (column names)
+
+=back
+
+=item $params
+
+HASHREF to query parameters
+
+=item Return value
+
+when list context, returns ($clause, \@values).
+when scalar context, return hashref like:
+ { clause => $clause, values => \@values };
+
+=back
+
+=cut
+
+sub generic_select {
+ my $self = shift;
+ my $table = shift;
+ my $args = {@_};
+ my $params = $args->{params} || {};
+
+ if (!$table) {
+ $self->set_error("table no given");
+ return;
+ }
+
+ my $keys = $args->{keys} || [];
+ my $uniques = $args->{uniques} || [];
+ $keys = [$keys] if !ref($keys);
+ $uniques = [$uniques] if !ref($uniques);
+
+ my @arguments;
+ my ($values, $orderby, $limit, $where, $unique_query);
+
+ ($where, $values, $unique_query) = $self->build_where_clause(uniques => $uniques,
+ keys => $keys,
+ params => $params);
+ push @arguments, @$values if @$values;
+ ($orderby, $values) = $self->build_orderby_clause(keys => $keys, params => $params);
+ push @arguments, @$values if @$values;
+ ($limit, $values) = $self->build_limit_clause(params => $params);
+ push @arguments, @$values if @$values;
+
+ my $dbh = $self->connect_db;
+ my $generic_sql = <<"EOSQL";
+SELECT * FROM $table
+ $where
+ $orderby
+ $limit
+EOSQL
+
+ my $sql = $args->{sql} || $generic_sql;
+
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@arguments);
+ my $rs = $sth->fetchall_arrayref(+{});
+ if (!defined $rs) {
+ $self->set_error("select failed", $dbh->{mysql_errorno});
+ $dbh->disconnect();
+ return;
+ }
+ $dbh->disconnect();
+
+ if ($unique_query) {
+ $self->clear_error;
+ return $rs->[0] if @$rs;
+ return;
+ }
+ return $rs;
+}
+
+########## END OF FILE
+1;
sub select {
my $self = shift;
return $self->generic_select(EVENTS_TABLE_NAME,
- { unique_keys => [qw(event_id)],
- keys => [qw(source_type related_id source_user_id active created_timestamp)],
- }, @_);
+ uniques => [qw(event_id)],
+ keys => [qw(source_type related_id source_user_id active created_timestamp)],
+ params => {@_});
}
sub oldest {
my $self = shift;
my $table_name = MESSAGE_TYPES_TABLE_NAME;
return $self->generic_select($table_name,
- { unique_keys => [qw(message_type_id name)], },
- @_);
+ uniques => [qw(message_type_id name)],
+ params => {@_});
}
sub create {
}
my $uniques = [qw(id)];
my $keys = [qw(uid val mmid)];
- return $self->base_select("metamodlog", $uniques, $keys, %$params);
+ return $self->generic_select("metamodlog",
+ uniques => $uniques,
+ keys => $keys,
+ params => $params);
}
sub select_by_cid {
sub select {
my $self = shift;
- return $self->base_select('moderatorlog', [qw(id)], [qw(uid sid cid active)], @_);
+ return $self->generic_select('moderatorlog',
+ uniques => [qw(id)],
+ keys => [qw(uid sid cid active)],
+ params => {@_});
}
sub select_with_m2 {
sub select {
my $self = shift @_;
- my $people = $self->base_select('people', [], [qw(uid person type perceive fof eof)], @_);
+ my $people = $self->generic_select('people',
+ keys => [qw(uid person type perceive fof eof)],
+ params => {@_});
return $people;
}
# $order_clause = "ORDER BY $k $order";
# }
# }
- my ($order_clause, $order_values) = $self->build_orderby_clause({columns => [qw(commentcount hits time)]}, $params);
+ my ($order_clause, $order_values) = $self->build_orderby_clause(keys => [qw(commentcount hits time)], params => $params);
# build LIMIT clause
my $limit_clause = "";
$params ||= {};
my @values = ($value, );
- my ($limit_clause, $limit_values) = $self->build_limit_clause($params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
push @values, @$limit_values if @$limit_values;
my $dbh = $self->connect_db;
my ($self, $params) = @_;
my @values;
- my ($orderby, $orderby_values) = $self->build_orderby_clause({columns => {timestamp => 'submissions.time'}}, $params);
+ my ($orderby, $orderby_values) = $self->build_orderby_clause(keys => {timestamp => 'submissions.time'}, params => $params);
if (@$orderby_values) {
push @values, @$orderby_values;
}
- my ($limit, $limit_values) = $self->build_limit_clause($params);
+ my ($limit, $limit_values) = $self->build_limit_clause(params => $params);
if (@$limit_values) {
push @values, @$limit_values;
}
sub select {
my $self = shift;
- return $self->base_select('tags', [qw(tagid)], [qw(tagnameid globjid uid private is_active)], @_);
+ return $self->generic_select('tags',
+ uniques => [qw(tagid)],
+ keys => [qw(tagnameid globjid uid private is_active)],
+ params => {@_});
}
sub select_tagnames {
# select global timeline
sub _select_global {
my ($self, $params) = @_;
- my ($limit_clause, $limit_values) = $self->build_limit_clause($params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
my $sql = <<"EOSQL";
SELECT firehose.*,
# select user's timelime
sub _select_user {
my ($self, $uid, $params) = @_;
- my ($limit_clause, $limit_values) = $self->build_limit_clause($params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
my $sql = <<"EOSQL";
SELECT firehose.*,
# select user's friends' timelime
sub _select_friends {
my ($self, $uid, $params) = @_;
- my ($limit_clause, $limit_values) = $self->build_limit_clause($params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
my $sql = <<"EOSQL";
SELECT firehose.*,
my $val = $rs->[0]->{value};
my $types = $self->generic_select("al2_types",
- {keys => ['bitpos',]},
- order_by => { bitpos => 'DESC' }
- );
+ keys => [qw(bitpos)],
+ params => {
+ order_by => { bitpos => 'DESC' },
+ });
#my @sorted_types = sort { ($b->{bitpos} + 0) <=> ($a->{bitpos} + 0) } @$types;
for my $type (@$types) {
return;
}
- my ($clause, $values, $unique) = $self->build_where_clause([qw(uid)], [], @params);
+ my ($where_clause, $values, $unique) = $self->build_where_clause(uniques => [qw(uid)], params => \@params);
return if @$values != 1;
my $new_value = "$column + ?";
}
my $sql = <<"EOSQL";
-UPDATE $table SET $column = $new_value WHERE $clause;
+UPDATE $table SET $column = $new_value $where_clause;
EOSQL
my $dbh = $self->connect_db();
my $rs = $dbh->do($sql, undef, $value, @$values);
$where_clause = "WHERE $where_clause";
};
- my ($limit_clause, $values) = $self->build_limit_clause($params);
+ my ($limit_clause, $values) = $self->build_limit_clause(params => $params);
if ($limit_clause) {
push @q_args, @$values;
}
OSDN Git Service
