Menu
▾
▴
openwebwork-cvs
|
From: Mike G. v. a. <we...@ma...> - 2009-01-25 15:40:08
|
Log Message:
-----------
Changes to support archiving courses.
Modified Files:
--------------
webwork2/lib/WeBWorK/DB:
Schema.pm
webwork2/lib/WeBWorK/DB/Schema/NewSQL:
Std.pm
Revision Data
-------------
Index: Schema.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Schema.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/WeBWorK/DB/Schema.pm -Llib/WeBWorK/DB/Schema.pm -u -r1.12 -r1.13
--- lib/WeBWorK/DB/Schema.pm
+++ lib/WeBWorK/DB/Schema.pm
@@ -54,6 +54,11 @@
'WeBWorK::DB::Schema::Ex' => {},
'WeBWorK::DB::Schema::Ex::RecordExists' => {
isa => 'WeBWorK::DB::Schema::Ex',
+ description => "Record exists",
+ },
+ 'WeBWorK::DB::Schema::Ex::TableMissing' => {
+ isa => 'WeBWorK::DB::Schema::Ex',
+ description =>"missing table",
},
);
Index: Std.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Schema/NewSQL/Std.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -Llib/WeBWorK/DB/Schema/NewSQL/Std.pm -Llib/WeBWorK/DB/Schema/NewSQL/Std.pm -u -r1.19 -r1.20
--- lib/WeBWorK/DB/Schema/NewSQL/Std.pm
+++ lib/WeBWorK/DB/Schema/NewSQL/Std.pm
@@ -291,7 +291,8 @@
my $self = shift;
my $field_name = shift;
my $stmt = $self->_exists_field_stmt($field_name);
- return $self->dbh->do($stmt);
+ my $result = $self->dbh->do($stmt);
+ return ($result eq "1") ? 1 : 0; # failed result is 0E0
}
sub _exists_field_stmt {
@@ -300,7 +301,21 @@
my $sql_table_name = $self->sql_table_name;
return "Describe `$sql_table_name` `$field_name`";
}
+####################################################
+# checking Tables
+####################################################
+sub tableExists {
+ my $self = shift;
+ my $stmt = $self->_exists_table_stmt;
+ my $result = eval { $self->dbh->do($stmt); };
+ ( caught WeBWorK::DB::Schema::Ex::TableMissing ) ? 0:1;
+}
+sub _exists_table_stmt {
+ my $self = shift;
+ my $sql_table_name = $self->sql_table_name;
+ return "Describe `$sql_table_name` ";
+}
################################################################################
@@ -758,9 +773,10 @@
# maps error numbers to exception classes for MySQL
our %MYSQL_ERROR_CODES = (
1062 => 'WeBWorK::DB::Schema::Ex::RecordExists',
+ 1146 => 'WeBWorK::DB::Schema::Ex::TableMissing',
);
-# turns MySQL error codes into excpetions -- WeBWorK::DB::Schema::Ex objects
+# turns MySQL error codes into exceptions -- WeBWorK::DB::Schema::Ex objects
# for known error types, and normal die STRING exceptions for unknown errors.
# This is one method you'd want to override if you were writing a subclass for
# another RDBMS.
|
|
From: Mike G. v. a. <we...@ma...> - 2009-01-25 15:41:48
|
Log Message:
-----------
Changes to support archiving courses.
Modified Files:
--------------
webwork2/lib/WeBWorK/Utils:
CourseManagement.pm
DBUpgrade.pm
Added Files:
-----------
webwork2/lib/WeBWorK/Utils:
CourseIntegrityCheck.pm
Revision Data
-------------
Index: DBUpgrade.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils/DBUpgrade.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WeBWorK/Utils/DBUpgrade.pm -Llib/WeBWorK/Utils/DBUpgrade.pm -u -r1.4 -r1.5
--- lib/WeBWorK/Utils/DBUpgrade.pm
+++ lib/WeBWorK/Utils/DBUpgrade.pm
@@ -25,7 +25,7 @@
use strict;
use warnings;
use WeBWorK::Debug;
-use WeBWorK::Utils::CourseManagement qw/listCourses/;
+#use WeBWorK::Utils::CourseManagement qw/listCourses/;
################################################################################
Index: CourseManagement.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils/CourseManagement.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -Llib/WeBWorK/Utils/CourseManagement.pm -Llib/WeBWorK/Utils/CourseManagement.pm -u -r1.44 -r1.45
--- lib/WeBWorK/Utils/CourseManagement.pm
+++ lib/WeBWorK/Utils/CourseManagement.pm
@@ -33,6 +33,7 @@
use WeBWorK::CourseEnvironment;
use WeBWorK::Debug;
use WeBWorK::Utils qw(runtime_use readDirectory pretty_print_rh);
+use WeBWorK::Utils::DBUpgrade;
our @EXPORT = ();
our @EXPORT_OK = qw(
@@ -44,11 +45,13 @@
archiveCourse
unarchiveCourse
dbLayoutSQLSources
- checkCourseTables
- updateCourseTables
- checkCourseDirectories
+
);
+# checkCourseTables
+# updateCourseTables
+# checkCourseDirectories
+
=head1 FUNCTIONS
=over
@@ -1163,138 +1166,53 @@
print $fh "\n\n\n";
}
}
-=item checkCourseDirectories($courseName)
-
-Checks the course files and directories to make sure they exist and have the correct permissions.
-
-=cut
-
-
-
-=item checkCourseTables($courseName, $dbLayoutName, $ce);
-
-Checks the course tables in the mysql database and insures that they are the same as the ones specified by the databaseLayout
-
-
-=cut
-
-sub checkCourseTables {
- my ($courseName, $dbLayoutName, $ce) = @_;
- my $str='';
- my %both = ();
- my %schema_only = ();
- my %database_only = ();
- ##########################################################
- # fetch schema from course environment and search database
- # for corresponding tables.
- ##########################################################
- my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
- foreach my $table (sort keys %$db) {
- next if $db->{$table}{params}{non_native}; # skip non-native tables
- my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
- my $database_table_exists = ($db->{$table}->can("delete_table")) ? 1:0;
- if ($database_table_exists ) { # exists means the table could be deleted.
- $both{$table_name} = checkTableFields($courseName, $dbLayoutName, $ce, $table);
- } else {
- $schema_only{$table_name} = 1;
- }
- }
- ##########################################################
- # fetch fetch corresponding tables in the database and
- # search for corresponding schema entries.
- ##########################################################
-
- my $dbh =$db->{key}->dbh; # grab any database handle
- my $stmt = "show tables like '$courseName%'"; # mysql request
- my $result = $dbh->selectall_arrayref($stmt) ;
- my @tableNames = map {@$_} @$result; # drill down in the result to the table name level
- foreach my $table (sort @tableNames) {
- $table =~/${courseName}_(.*)/;
- my $schema_name = $1;
- my $exists = exists($db->{$schema_name});
- $database_only{$table}=1 unless $exists;
- }
- print CGI::p($str);
- my $tables_ok = not ( %schema_only || %database_only ); # count number of extraneous tables; 0 means ok
- return ($tables_ok,\%both, \%schema_only, \%database_only); # table in both schema & database; found in schema only; found in database only
-}
-
-=item updateCourseTables($courseName, $dbLayoutName, $ce, $table_names);
-
-Adds schema tables to the database that had been missing from the database.
-
-=cut
-
-sub updateCourseTables {
- my ($courseName, $dbLayoutName, $ce, $table_names) = @_;
- my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
- #die "Programmers: Pass reference to the array of table names to be updated." unless ref($table_names)=~/ARRAY/;
- #warn "table names are ".join(" ", @$table_names);
- my $str='';
- foreach my $table (sort @$table_names) { # remainder copied from db->create_table
- #warn "processing $table";
- next if $table =~ /^_/; # skip non-table self fields (none yet)
- #warn "not a non-table self field";
- next if $db->{$table}{params}{non_native}; # skip non-native tables
- #warn "not a non_native table";
- my $schema_obj = $db->{$table};
-
- if ($schema_obj->can("create_table")) {
- # warn "creating table $schema_obj";
- $schema_obj->create_table;
- $str .= "Table $table created".CGI::br();
- } else {
- warn "Skipping creation of '$table' table: no create_table method\n";
- }
- }
- $str;
-
-}
-=cut
-
-
-
-=item checkTableFields($courseName, $dbLayoutName, $ce, $table);
-
-Checks the course tables in the mysql database and insures that they are the same as the ones specified by the databaseLayout
-
-
-=cut
-sub checkTableFields {
- my ($courseName, $dbLayoutName, $ce,$table) = @_;
- my $str=' ';
- my %both = ();
- my %schema_only = ();
- my %database_only = ();
- ##########################################################
- # fetch schema from course environment and search database
- # for corresponding tables.
- ##########################################################
- my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
- my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
- warn "$table_name is a non native table" if $db->{$table}{params}{non_native}; # skip non-native tables
- my @fields = $db->{$table}->{record}->FIELDS;
- foreach my $field (sort @fields) {
- #my $database_table_exists = ($db->{$table}->can("delete_table")) ? 1:0;
- my $field_name = $db->{$table}->{params}->{fieldOverride}->{$field} ||$field;
- my $database_field_exists = $db->{$table}->tableFieldExists($field_name);
- if ($database_field_exists) {
- $str.="$field =>$field_name, ";
- $both{$field}=1;
- } else {
- $str.="$field =>MISSING, ";
- $schema_only{$field}=1;
- }
-
- }
- ##########################################################
- # fetch fetch corresponding tables in the database and
- # search for corresponding schema entries.
- ##########################################################
-
+#
+#
+# =item checkCourseDirectories($courseName)
+#
+# Checks the course files and directories to make sure they exist and have the correct permissions.
+#
+# =cut
+#
+#
+#
+# =item checkCourseTables($courseName, $dbLayoutName, $ce);
+#
+# Checks the course tables in the mysql database and ensures that they are the
+# same as the ones specified by the databaseLayout
+#
+#
+# =cut
+#
+# sub checkCourseTables {
+# my ($courseName, $dbLayoutName, $ce) = @_;
+# my $str='';
+# my %both = ();
+# my %schema_only = ();
+# my %database_only = ();
+# ##########################################################
+# # fetch schema from course environment and search database
+# # for corresponding tables.
+# ##########################################################
+# my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
+# foreach my $table (sort keys %$db) {
+# next if $db->{$table}{params}{non_native}; # skip non-native tables
+# my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
+# my $database_table_exists = ($db->{$table}->can("delete_table")) ? 1:0;
+# if ($database_table_exists ) { # exists means the table could be deleted.
+# $both{$table_name} = checkTableFields($courseName, $dbLayoutName, $ce, $table);
+# } else {
+# $schema_only{$table_name} = 1;
+# }
+# }
+# ##########################################################
+# # fetch fetch corresponding tables in the database and
+# # search for corresponding schema entries.
+# ##########################################################
+#
# my $dbh =$db->{key}->dbh; # grab any database handle
# my $stmt = "show tables like '$courseName%'"; # mysql request
# my $result = $dbh->selectall_arrayref($stmt) ;
@@ -1305,9 +1223,100 @@
# my $exists = exists($db->{$schema_name});
# $database_only{$table}=1 unless $exists;
# }
-# return (\%both, \%schema_only, \%database_only); # table in both schema & database; found in schema only; found in database only
- return $str."<br/>";
-}
+# print CGI::p($str);
+# my $tables_ok = not ( %schema_only || %database_only ); # count number of extraneous tables; 0 means ok
+# return ($tables_ok,\%both, \%schema_only, \%database_only); # table in both schema & database; found in schema only; found in database only
+# }
+#
+# =item updateCourseTables($courseName, $dbLayoutName, $ce, $table_names);
+#
+# Adds schema tables to the database that had been missing from the database.
+#
+# =cut
+#
+# sub updateCourseTables {
+# my ($courseName, $dbLayoutName, $ce, $table_names) = @_;
+# my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
+# warn "Programmers: Pass reference to the array of table names to be updated." unless ref($table_names)=~/ARRAY/;
+# #warn "table names are ".join(" ", @$table_names);
+# my $str='';
+# foreach my $table (sort @$table_names) { # remainder copied from db->create_table
+# #warn "processing $table";
+# next if $table =~ /^_/; # skip non-table self fields (none yet)
+# #warn "not a non-table self field";
+# next if $db->{$table}{params}{non_native}; # skip non-native tables
+# #warn "not a non_native table";
+# my $schema_obj = $db->{$table};
+#
+# if ($schema_obj->can("create_table")) {
+# # warn "creating table $schema_obj";
+# $schema_obj->create_table;
+# $str .= "Table $table created".CGI::br();
+# } else {
+# warn "Skipping creation of '$table' table: no create_table method\n";
+# }
+# }
+# $str;
+#
+# }
+#
+# =cut
+#
+#
+#
+# =item checkTableFields($courseName, $dbLayoutName, $ce, $table);
+#
+# Checks the course tables in the mysql database and insures that they are the same as the ones specified by the databaseLayout
+#
+#
+# =cut
+#
+#
+# sub checkTableFields {
+# my ($courseName, $dbLayoutName, $ce,$table) = @_;
+# my $str=' ';
+# my %both = ();
+# my %schema_only = ();
+# my %database_only = ();
+# ##########################################################
+# # fetch schema from course environment and search database
+# # for corresponding tables.
+# ##########################################################
+# my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName});
+# my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
+# warn "$table_name is a non native table" if $db->{$table}{params}{non_native}; # skip non-native tables
+# my @fields = $db->{$table}->{record}->FIELDS;
+# foreach my $field (sort @fields) {
+# #my $database_table_exists = ($db->{$table}->can("delete_table")) ? 1:0;
+# my $field_name = $db->{$table}->{params}->{fieldOverride}->{$field} ||$field;
+# my $database_field_exists = $db->{$table}->tableFieldExists($field_name);
+# if ($database_field_exists) {
+# $str.="$field =>$field_name, ";
+# $both{$field}=1;
+# } else {
+# $str.="$field =>MISSING, ";
+# $schema_only{$field}=1;
+# }
+#
+# }
+# ##########################################################
+# # fetch fetch corresponding tables in the database and
+# # search for corresponding schema entries.
+# ##########################################################
+#
+# # my $dbh =$db->{key}->dbh; # grab any database handle
+# # my $stmt = "show tables like '$courseName%'"; # mysql request
+# # my $result = $dbh->selectall_arrayref($stmt) ;
+# # my @tableNames = map {@$_} @$result; # drill down in the result to the table name level
+# # foreach my $table (sort @tableNames) {
+# # $table =~/${courseName}_(.*)/;
+# # my $schema_name = $1;
+# # my $exists = exists($db->{$schema_name});
+# # $database_only{$table}=1 unless $exists;
+# # }
+# # return (\%both, \%schema_only, \%database_only); # table in both schema & database; found in schema only; found in database only
+# return $str."<br/>";
+# }
1;
--- /dev/null
+++ lib/WeBWorK/Utils/CourseIntegrityCheck.pm
@@ -0,0 +1,311 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: webwork2/lib/WeBWorK/Utils/CourseIntegrityCheck.pm,v 1.1 2009/01/25 15:32:13 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+
+package WeBWorK::Utils::CourseIntegrityCheck;
+
+=head1 NAME
+
+WeBWorK::Utils::CourseIntegrityCheck - check that course database tables agree with database schema and
+that course directory structure is correct.
+
+=cut
+
+use strict;
+use warnings;
+use WeBWorK::Debug;
+use WeBWorK::Utils::CourseManagement qw/listCourses/;
+
+################################################################################
+
+sub new {
+ my $invocant = shift;
+ my $class = ref $invocant || $invocant;
+ my $self = bless {}, $class;
+ $self->init(@_);
+ return $self;
+}
+
+sub init {
+ my ($self, %options) = @_;
+
+ $self->{dbh} = DBI->connect(
+ $options{ce}{database_dsn},
+ $options{ce}{database_username},
+ $options{ce}{database_password},
+ {
+ PrintError => 0,
+ RaiseError => 1,
+ },
+ );
+
+ $self->{verbose_sub} = $options{verbose_sub} || \&debug;
+ $self->{confirm_sub} = $options{confirm_sub} || \&ask_permission_stdio;
+ $self->{ce} = $options{ce};
+ my $dbLayoutName = $self->{ce}->{dbLayoutName};
+ $self->{db} =new WeBWorK::DB($self->{ce}->{dbLayouts}->{$dbLayoutName});
+}
+
+sub ce { return shift->{ce} }
+sub db { return shift->{db} }
+sub dbh { return shift->{dbh} }
+sub verbose { my $sub = shift->{verbose_sub}; return &$sub(@_) }
+sub confirm { my $sub = shift->{confirm_sub}; return &$sub(@_) }
+
+sub DESTROY {
+ my ($self) = @_;
+ $self->unlock_database;
+ $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
+}
+
+################################################################################
+=item checkCourseDirectories($courseName)
+
+Checks the course files and directories to make sure they exist and have the correct permissions.
+
+=cut
+
+
+
+=item checkCourseTables($courseName, $dbLayoutName, $ce);
+
+Checks the course tables in the mysql database and ensures that they are the
+same as the ones specified by the databaseLayout
+
+
+=cut
+
+sub checkCourseTables {
+ my ($self, $courseName) = @_;
+ my $str='';
+ my %ok_tables = ();
+ my %schema_only = ();
+ my %database_only = ();
+ my %update_fields = ();
+ ##########################################################
+ # fetch schema from course environment and search database
+ # for corresponding tables.
+ ##########################################################
+ my $db = $self->db;
+ $self->lock_database;
+ foreach my $table (sort keys %$db) {
+ next if $db->{$table}{params}{non_native}; # skip non-native tables
+ my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
+ my $database_table_exists = ($db->{$table}->tableExists) ? 1:0;
+ if ($database_table_exists ) { # exists means the table can be described;
+ my( $fields_ok, $field_str,$fields_both, $fields_schema_only, $fields_database_only) = $self->checkTableFields($courseName, $table);
+ if ($fields_ok) {
+ $ok_tables{$table_name} = 1;
+ } else {
+ $update_fields{$table_name}=[$fields_ok,$fields_both,$fields_schema_only,$fields_database_only];
+ }
+ } else {
+ $schema_only{$table_name} = 1;
+ }
+ }
+ ##########################################################
+ # fetch fetch corresponding tables in the database and
+ # search for corresponding schema entries.
+ ##########################################################
+
+ my $dbh = $self->dbh;
+ my $stmt = "show tables like '${courseName}%'"; # mysql request
+ my $result = $dbh->selectall_arrayref($stmt) ;
+ my @tableNames = map {@$_} @$result; # drill down in the result to the table name level
+ foreach my $table (sort @tableNames) {
+ next unless $table =~/^${courseName}\_(.*)/; #double check that we only have our course tables
+ my $schema_name = $1;
+ my $exists = exists($db->{$schema_name});
+ $database_only{$table}=1 unless $exists;
+ }
+ my $tables_ok = ( scalar(%schema_only) || scalar(%database_only) ||scalar(%update_fields) ) ?0 :1; # count number of extraneous tables; no such tables makes $tables_ok true
+ $self->unlock_database;
+ return ($tables_ok,\%ok_tables, \%schema_only, \%database_only, \%update_fields); # table in both schema & database; found in schema only; found in database only
+}
+
+=item updateCourseTables($courseName, $dbLayoutName, $ce, $table_names);
+
+Adds schema tables to the database that had been missing from the database.
+
+=cut
+
+sub updateCourseTables {
+ my ($self, $courseName, $table_names) = @_;
+ my $db = $self->db;
+ $self->lock_database;
+ warn "Programmers: Pass reference to the array of table names to be updated." unless ref($table_names)=~/ARRAY/;
+ #warn "table names are ".join(" ", @$table_names);
+ my $str='';
+ foreach my $table (sort @$table_names) { # remainder copied from db->create_table
+ next if $table =~ /^_/; # skip non-table self fields (none yet)
+ #warn "not a non-table self field";
+ $table =~ /${courseName}_(.*)/;
+ my $schema_table_name = $1;
+ next if $db->{$schema_table_name}{params}{non_native}; # skip non-native tables
+ #warn "not a non_native table";
+ my $schema_obj = $db->{$schema_table_name};
+ if ($schema_obj->can("create_table")) {
+ # warn "creating table $schema_obj";
+ $schema_obj->create_table;
+ $str .= "Table $table created".CGI::br();
+ } else {
+ warn "Skipping creation of '$table' table: no create_table method\n";
+ }
+ }
+ $self->unlock_database;
+ $str;
+
+}
+
+=cut
+
+
+
+=item checkTableFields($courseName, $dbLayoutName, $ce, $table);
+
+Checks the course tables in the mysql database and insures that they are the same as the ones specified by the databaseLayout
+
+
+=cut
+
+
+sub checkTableFields {
+ my ($self,$courseName, $table) = @_;
+ my $str=' ';
+ my %both = ();
+ my %schema_only = ();
+ my %database_only = ();
+ ##########################################################
+ # fetch schema from course environment and search database
+ # for corresponding tables.
+ ##########################################################
+ my $db = $self->db;
+ my $table_name = (exists $db->{$table}->{params}->{tableOverride})? $db->{$table}->{params}->{tableOverride}:$table;
+ warn "$table_name is a non native table" if $db->{$table}{params}{non_native}; # skip non-native tables
+ my @schema_field_names = $db->{$table}->{record}->FIELDS;
+ my %schema_override_field_names=();
+ foreach my $field (sort @schema_field_names) {
+ my $field_name = $db->{$table}->{params}->{fieldOverride}->{$field} ||$field;
+ $schema_override_field_names{$field_name}=$field;
+ my $database_field_exists = $db->{$table}->tableFieldExists($field_name);
+ if ($database_field_exists) {
+ $str.="$field =>$field_name, ";
+ $both{$field}=1;
+ } else {
+ $str.="$field =>MISSING, ";
+ $schema_only{$field}=1;
+ }
+
+ }
+ ##########################################################
+ # fetch fetch corresponding tables in the database and
+ # search for corresponding schema entries.
+ ##########################################################
+
+ my $dbh =$self->dbh; # grab any database handle
+ my $stmt = "SHOW COLUMNS FROM $table_name"; # mysql request
+ my $result = $dbh->selectall_arrayref($stmt) ;
+ my %database_field_names = map {${$_}[0]=>[$_]} @$result; # drill down in the result to the field name level
+ # result is array: Field | Type | Null | Key | Default | Extra
+ foreach my $field_name (sort keys %database_field_names) {
+ my $exists = exists($schema_override_field_names{$field_name} );
+ $database_only{$table}=1 unless $exists;
+ }
+ my $fields_ok = not ( %schema_only || %database_only ); # count number of extraneous tables; no such tables makes $fields_ok true
+ return ($fields_ok, $str."<br/>",\%both, \%schema_only, \%database_only); # table in both schema & database; found in schema only; found in database only
+}
+
+##############################################################################
+# Database utilities -- borrowed from DBUpgrade.pm ??use or modify??? --MEG
+##############################################################################
+
+sub lock_database {
+ my $self =shift;
+ my $dbh = $self->dbh;
+ my ($lock_status) = $dbh->selectrow_array("SELECT GET_LOCK('dbupgrade', 10)");
+ if (not defined $lock_status) {
+ die "Couldn't obtain lock because an error occurred.\n";
+ }
+ if ($lock_status) {
+ } else {
+ die "Timed out while waiting for lock.\n";
+ }
+}
+
+sub unlock_database {
+ my $self =shift;
+ my $dbh = $self->dbh;
+ my ($lock_status) = $dbh->selectrow_array("SELECT RELEASE_LOCK('dbupgrade')");
+ if (not defined $lock_status) {
+ # die "Couldn't release lock because the lock does not exist.\n";
+ }elsif ($lock_status) {
+ return;
+ } else {
+ die "Couldn't release lock because the lock is not held by this thread.\n";
+ }
+}
+
+##############################################################################
+
+sub load_sql_table_list {
+ my $self =shift;
+ my $dbh = $self->dbh;
+ my $sql_tables_ref = $dbh->selectcol_arrayref("SHOW TABLES");
+ $self->{sql_tables} = {}; @{$self->{sql_tables}}{@$sql_tables_ref} = ();
+}
+
+sub register_sql_table {
+ my $self =shift;
+ my $table = shift;
+ my $dbh = $self->dbh;
+ $self->{sql_tables}{$table} = ();
+}
+
+sub unregister_sql_table {
+ my $self =shift;
+ my $table = shift;
+ my $dbh = $self->dbh;
+ delete $self->{sql_tables}{$table};
+}
+
+sub sql_table_exists {
+ my $self =shift;
+ my $table=shift;
+ my $dbh = $self->dbh;
+ return exists $self->{sql_tables}{$table};
+}
+
+
+################################################################################
+
+sub ask_permission_stdio {
+ my ($prompt, $default) = @_;
+
+ $default = 1 if not defined $default;
+ my $options = $default ? "[Y/n]" : "[y/N]";
+
+ while (1) {
+ print "$prompt $options ";
+ my $resp = <STDIN>;
+ chomp $resp;
+ return $default if $resp eq "";
+ return 1 if lc $resp eq "y";
+ return 0 if lc $resp eq "n";
+ $prompt = 'Please enter "y" or "n".';
+ }
+}
+
+
+1;
\ No newline at end of file
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X