home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / dbint.pl < prev    next >
Text File  |  2009-11-06  |  12KB  |  377 lines
  1. # FILE: dbint.pl
  2. # DESCRIPTION: Interfaces to database (MySQL)
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. #*******************************************************************************
  16. # NOTE: To connect to other SQL databases that use syntax similar to MySQL,
  17. # edit the db_connect subroutine, removing 'mysql' and inserting whatever you
  18. # need.  Please keep us advised of progress on integrating other database
  19. # systems by contacting us at support@discusware.com
  20. #
  21. # Create a MySQL database by issuing these commands from the shell:
  22. #     mysqladmin -uroot -p create xxxxxxx
  23. #     mysql -uroot -p mysql
  24. #     > GRANT ALL PRIVILEGES ON xxxxxxx.* TO yyyyyyy@localhost [IDENTIFIED BY 'password'];
  25. #     > exit;
  26. # where 'xxxxxxx' is the name of the database and yyyyyyy is the username
  27. # authorized to access that database (and optionally enter a password)
  28. #*******************************************************************************
  29.  
  30. use strict;
  31. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  32.  
  33. ###
  34. ### sql_lock
  35. ###
  36. ### Gets a file lock using an SQL table rather than a file
  37. ###
  38.  
  39. sub sql_lock {
  40.     my ($fileref, $subroutine, $maxtime) = @_;
  41.     my $dbh = database_dbh();
  42.     my $tries = 0;
  43.     $maxtime = 7 if $maxtime == 0;
  44.     my $timecache = time;
  45.     my $processid = $$;
  46.     my $cachetime = $timecache - $maxtime;
  47.     my @files = ();
  48.     foreach my $f (@{ $fileref }) {
  49.         if ($f eq "*") { push @files, "GLOBAL"; }
  50.         elsif ($f =~ m|.*/(.*)|) { push @files, $1; }
  51.         else { push @files, $f; }
  52.     }
  53.     return 1 if scalar(@files) == 0;
  54.  
  55.     ## Clear out expired locks
  56.  
  57.     db_query("DELETE FROM $PARAMS->{db_prefix}locks WHERE timecreate < $cachetime;");
  58.  
  59.     ## Check for a global lock
  60.  
  61.     my $selectquery1 = db_sql_query(undef, "locks", "select", { filename => "GLOBAL" });
  62.     if ($selectquery1->[0]->{filename} eq "GLOBAL") {
  63.         my $es = read_language()->{'FILELOCKREGEN'}; $es =~ s/\%sec/7/g;
  64.         log_error("dbint.pl", "sql_lock", "Request for lock by $subroutine on GLOBAL failed... [$selectquery1->[0]->{processid},$processid] (GLOBAL LOCK exists)");
  65.         error_message(read_language()->{'FILELOCKERROR'}, "$es [GLOBAL]", 0, 1);
  66.     }
  67.  
  68.     ## Check for lock on topics file for regeneration
  69.  
  70.     if ($subroutine eq "change_board_colors" && scalar(@files) == 1 && $files[0] eq "board-topics.html") {
  71.         my $rv = db_sql_query({ filename => $files[0], processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
  72.         my @rv = @{ $rv };
  73.         return 0 if grep { $_->{FAILURE} == 1 } @rv;
  74.         return 1;
  75.     }
  76.  
  77.     ## Check for lock when regenerating subtopic page
  78.     
  79.     if ($subroutine eq "--REGENERATE-SUBTOPICS--") {
  80.         my $rv = db_sql_query({ filename => $files[0], processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
  81.         my @rv = @{ $rv };
  82.         return 0 if grep { $_->{FAILURE} == 1 } @rv;
  83.         return 1;
  84.     }
  85.  
  86.     ## Lock actual files
  87.  
  88.     my %h = map { $_, 1 } @files;
  89.     my %success_lock = ();
  90.     while (scalar(keys(%h)) > 0 && $tries <= 20) {
  91.         $tries++;
  92.         foreach my $key (keys(%h)) {
  93.             my $rv = db_sql_query({ filename => $key, processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
  94.             my @rv = @{ $rv };
  95.             if (! grep { $_->{FAILURE} == 1 } @rv) {
  96.                 delete $h{$key};
  97.                 $success_lock{$key} = 1;
  98.                 $tries = 0;
  99.                 $PARAMS->{files_locked_list}->{$key} = 1;
  100.             }
  101.         }
  102.     }
  103.  
  104.     ## Was this successful?
  105.  
  106.     return 1 if scalar(keys(%h)) == 0;
  107.  
  108.     ## If not successful, remove any successful locks and give error message
  109.  
  110.     my $fail_file = (keys(%h))[0];
  111.     my @unlocks = grep { $PARAMS->{files_locked_list}->{$_} == 1 && $h{$_} == 0 } keys %{$PARAMS->{files_locked_list}};
  112.     foreach my $suc (@unlocks) { _sql_unlock($suc); }
  113.     log_error("dbint.pl", "sql_lock", "Request for lock by $subroutine on $fail_file failed... [$subroutine,$processid]");
  114.     error_message(read_language()->{'FILELOCKERROR'}, join(" ", read_language()->{FILEISLOCKED}, "[$fail_file]"), 0, 1);
  115. }
  116.  
  117. ###
  118. ### sql_unlock
  119. ###
  120. ### Releases a file lock using an SQL table rather than a file
  121. ###
  122.  
  123. sub sql_unlock {
  124.     my ($fileref) = @_;
  125.     my $sth = database_dbh()->prepare("DELETE FROM $PARAMS->{db_prefix}locks WHERE filename = ?;");
  126.     my @files = ();
  127.     foreach my $f (@{ $fileref }) {
  128.         if ($f eq "*") { push @files, "GLOBAL"; }
  129.         elsif ($f =~ m|.*/(.*)|) { push @files, $1; }
  130.         else { push @files, $f; }
  131.         $PARAMS->{files_locked_list}->{$files[$#files]} = 0;
  132.     }
  133.     map { $sth->execute($_) } @files;
  134.     return 1;
  135. }
  136.  
  137. sub _sql_unlock {
  138.     my ($filename) = @_;
  139.     db_sql_query(undef, "locks", "delete", { filename => $filename });
  140. }
  141.  
  142. ###
  143. ### db_connect
  144. ###
  145. ### Connects you to your database.
  146. ###
  147.  
  148. sub db_connect {
  149.     my ($arg) = @_;
  150.     return $PARAMS->{dbh} if (defined $PARAMS->{dbh} && ! $arg);
  151.     return ($PARAMS->{dbh}, "") if (defined $PARAMS->{dbh} && $arg != 2);
  152.     my $db_param = {};
  153.     touch_createfile("$DCONF->{admin_dir}/data/db.txt");
  154.     if (open(DB_CONFIG, "$DCONF->{admin_dir}/data/db.txt")) {
  155.         my @db = <DB_CONFIG>;
  156.         close (DB_CONFIG);
  157.         foreach my $x (@db) {
  158.             if ($x =~ m|^(\w+)=(.*)|) {
  159.                 $db_param->{$1} = $2;
  160.             }
  161.         }
  162.     } else {
  163.         error_message("Database Connect Error", "Configuration file (db.txt) does not exist or is not readable!");
  164.     }
  165.     $PARAMS->{db_prefix} = $db_param->{prefix} if ! defined $PARAMS->{db_prefix};
  166.     eval 'use DBI;';
  167.     error_message("Database Connect Error", "The chosen Perl distribution does not support the DBI module.", 0, 1) if $@ ne "";
  168.     my $database = $db_param->{'database'};
  169.     $PARAMS->{db_prefix} = defined $db_param->{'prefix'} ? join("", trim($db_param->{'prefix'}), "_") : "";
  170.     my $socket_str = $db_param->{force_socket} ne "" ? ":mysql_socket=$db_param->{force_socket}" : "";
  171.  
  172.     #------------------------------------------------------------------------------------------
  173.     # Note: to use non-MySQL database, you'll need to figure out what to do with this next line
  174.     #
  175. #    DBI->trace(3);
  176.     if (my $h = DBI->connect("DBI:mysql:$database$socket_str", $db_param->{'username'}, $db_param->{'password'}, {PrintError => 0 })) {
  177.     #
  178.     #------------------------------------------------------------------------------------------
  179.  
  180.         return ($h, "") if $arg == 1;
  181.         return $h;
  182.     } else {
  183.         error_message("Database Connect Error", "Could not connect to database <B>$database</B>.<p>Error message is: <FONT COLOR=#800080>$DBI::errstr</FONT>.  Argument is $arg.", 0, 1) if $arg != 2;
  184.         return (undef, $DBI::errstr);
  185.     }
  186. }
  187.  
  188. ###
  189. ### db_sql_query
  190. ###
  191. ### General function to take a hash and convert it into a SQL query
  192. ###
  193.  
  194. sub db_sql_query {
  195.     my ($hash3, $database3, $qtype, $where3, $dbh, $noerr) = @_;
  196.     $dbh = database_dbh() if ! defined $dbh;
  197.     my @nh = defined $hash3 ? (ref $hash3 eq "HASH" ? ($hash3) : @{ $hash3 }) : ();
  198.     my @wh = defined $where3 ? (ref $where3 eq "HASH" ? ($where3) : @{ $where3 }) : ();
  199.     my $hash0 = $nh[0];
  200.     my $where0 = $wh[0];
  201.     my @ar = keys(%{ $hash0 });
  202.     my @d = split(/,/, $database3);
  203.     my @r = ();
  204.     foreach my $database (@d) {
  205.         my $sql_str = "";
  206.         if ($qtype =~ m|^insert$|i || $qtype =~ m|^replace$|i) {
  207.             my $i = $qtype =~ m|^insert$|i ? "INSERT" : "REPLACE";
  208.             $sql_str = "$i INTO $PARAMS->{db_prefix}$database (";
  209.             $sql_str .= join(",", @ar);
  210.             $sql_str .= ") VALUES ";
  211.             $sql_str .= _db_sql_query_questionmarks(\@ar);
  212.         } elsif ($qtype =~ m|^update$|i) {
  213.             $sql_str = "UPDATE $PARAMS->{db_prefix}$database SET ";
  214.             foreach my $a (@ar) {
  215.                 $sql_str .= "$a=?,";
  216.             }
  217.             $sql_str =~ s/,$//;
  218.             $sql_str .= _db_sql_query_where($where0);
  219.         } elsif ($qtype =~ m|^delete$|i) {
  220.             $sql_str = "DELETE FROM $PARAMS->{db_prefix}$database";
  221.             $sql_str .= _db_sql_query_where($where0);
  222.         } elsif ($qtype =~ m|^select$|i) {
  223.             $sql_str = "SELECT * FROM $PARAMS->{db_prefix}$database";
  224.             $sql_str .= _db_sql_query_where($where0);
  225.         }
  226.         $sql_str =~ s/\s+$//;
  227.         $sql_str .= ";";
  228.         if (scalar(@wh) == 0) {
  229.             push @wh, {} until scalar(@wh) >= scalar(@nh);
  230.         }
  231.         if (defined $dbh) {
  232.             my $statement = $sql_str;
  233.             my $sth = undef;
  234.             unless ($sth = $dbh->prepare($statement)) {
  235.                 log_error("dbint.pl", "db_sql_query", "Could not prepare statement [$statement]... " . $dbh->errstr());
  236.                 error_message("Database Query Error", "Could not prepare statement [$statement]... " . $dbh->errstr());
  237.             }
  238.             if (scalar(@wh)) {
  239.                 foreach my $wh (@wh) {
  240.                     my $nh = shift @nh;
  241.                     my @v = values(%{ $nh });
  242.                     push @v, values(%{ $wh }) if $sql_str =~ m| WHERE |;
  243.                     if (! $sth->execute(@v)) {
  244.                         push @r, { FAILURE => 1, FAILURE_MESSAGE => $DBI::errstr, FAILURE_NOTE => $statement };
  245.                         error_message($statement, join("-", @v) . "<br>" . $dbh->errstr()) if ! $noerr;
  246.                         log_error("dbint.pl", "db_sql_query", "Could not execute [$statement]... " . $dbh->errstr());
  247.                         last if $noerr;
  248.                     } else {
  249.                         if ($qtype =~ m|^select$|i) {
  250.                             while (my $h = $sth->fetchrow_hashref()) {
  251.                                 $h->{database} = $database;
  252.                                 $h->{FAILURE} = 0;
  253.                                 push @r, \%{ $h };
  254.                             }
  255.                         } else {
  256.                             push @r, { FAILURE => 0, rows => $sth->rows() };
  257.                         }
  258.                     }
  259.                 }
  260.             } else {
  261.                 $sth->execute();
  262.                 if ($qtype =~ m|^select$|i) {
  263.                     while (my $h = $sth->fetchrow_hashref()) {
  264.                         $h->{database} = $database;
  265.                         $h->{FAILURE} = 0;
  266.                         push @r, \%{ $h };
  267.                     }
  268.                 } else {
  269.                     push @r, { FAILURE => 0, rows => $sth->rows() };
  270.                 }
  271.             }
  272.             $sth->finish();
  273.         } else {
  274.             push @r, $sql_str;
  275.         }
  276.     }
  277.     return \@r;
  278. }
  279.  
  280. sub _db_sql_query_questionmarks {
  281.     my ($arr, $jstr) = @_;
  282.     my $sc = scalar(@{ $arr });
  283.     $jstr = "?," if ! $jstr;
  284.     my $j = $jstr x $sc;
  285.     $j =~ s/,$//;
  286.     return join("", "(", $j, ")");
  287. }
  288.  
  289. sub _db_sql_query_where {
  290.     my ($where) = @_;
  291.     return "" if ref $where ne 'HASH' || keys(%{ $where }) == 0;
  292.     my $sq_st = "";
  293.     foreach my $k (keys(%{ $where })) {
  294.         $sq_st .= "$k=? OR ";
  295.     }
  296.     $sq_st =~ s/OR\s+$//;
  297.     return "" if $sq_st eq "";
  298.     return " WHERE $sq_st";
  299. }
  300.  
  301. ###
  302. ### db_query
  303. ###
  304. ### Prepares and then executes an SQL query, with full debugging messages. Used
  305. ### for more unusual commands (dropping tables, etc.)
  306. ###
  307.  
  308. sub db_query {
  309.     my ($statement, $dbh, $nofail, $executestuff) = @_;
  310.     $dbh = database_dbh() if ! defined $dbh;
  311.     my ($sth);
  312.     unless ($sth = $dbh->prepare($statement)) {
  313.         log_error("dbint.pl", "db_query", "Could not prepare statement [$statement]... " . $dbh->errstr());
  314.         error_message("Database Query Error", "Could not prepare statement [$statement]... " . $dbh->errstr()) if !$nofail;
  315.         return undef;
  316.     }
  317.     unless ($sth->execute(@{$executestuff})) {
  318.         log_error("dbint.pl", "db_query", "Could not execute statement [$statement]... " . $dbh->errstr());
  319.         error_message("Database Query Error", "Could not execute statement [$statement]... " . $dbh->errstr()) if !$nofail;
  320.         return undef;
  321.     }
  322.     $sth->finish();
  323.     return 1;
  324. }
  325.  
  326. ###
  327. ### db_var_val
  328. ###
  329. ### Converts an array of 'var' and 'val' hashes to one suitable for
  330. ### db_sql_query
  331. ###
  332.  
  333. sub db_var_val {
  334.     my $b = {};
  335.     while (my $a = shift @_) {
  336.         $b->{ $a->{var}} = join("", "", $a->{val});
  337.     }
  338.     return $b;
  339. }
  340.  
  341. ###
  342. ### db_defined_val
  343. ###
  344. ### Converts from a series of defined hashes to one suitable for
  345. ### db_sql_query
  346. ###
  347.  
  348. sub db_defined_val {
  349.     my ($hash, $keyset) = @_;
  350.     my @a = ();
  351.     foreach my $k (keys(%{ $hash })) {
  352.         push @a, { $keyset => $k };
  353.     }
  354.     return \@a;
  355. }
  356.  
  357. ###
  358. ### db_fields
  359. ###
  360. ### Produces an array of fields (columns) in a particular database
  361. ###
  362.  
  363. sub db_fields {
  364.     my ($dbh, $table) = @_;
  365.     $dbh = database_dbh() if ! defined $dbh;
  366.     my $sth = $dbh->prepare("SHOW COLUMNS FROM $PARAMS->{db_prefix}$table") or error_message("Database Error", $dbh->errstr() );
  367.     $sth->execute() or error_message("Database Error", $dbh->errstr());
  368.     my @result = ();
  369.     while (my @x = $sth->fetchrow_array() ) {
  370.         push (@result, $x[0]);
  371.     }
  372.     return \@result;
  373. }
  374.  
  375. 1;
  376.  
  377.