diff --git a/mozilla/webtools/tinderbox3/scripts/Tinderbox3/DB.pm b/mozilla/webtools/tinderbox3/scripts/Tinderbox3/DB.pm new file mode 100644 index 00000000000..57c527c96fb --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/Tinderbox3/DB.pm @@ -0,0 +1,15 @@ +package Tinderbox3::DB; + +use strict; +use DBI; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(get_dbh); + +sub get_dbh { + my $dbh = DBI->connect("dbi:Pg:dbname=tbox", "jkeiser", "scuttlebutt", { RaiseError => 1, AutoCommit => 0 }); + return $dbh; +} + +1 diff --git a/mozilla/webtools/tinderbox3/scripts/Tinderbox3/Header.pm b/mozilla/webtools/tinderbox3/scripts/Tinderbox3/Header.pm new file mode 100644 index 00000000000..63d681eaa1e --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/Tinderbox3/Header.pm @@ -0,0 +1,31 @@ +package Tinderbox3::Header; + +use strict; + +use CGI::Carp qw(fatalsToBrowser); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(header footer); + +sub header { + my ($p, $title) = @_; + print $p->header; + print < + +Tinderbox - $title + + + +EOM +} + +sub footer { + print < + +EOM +} + +1 diff --git a/mozilla/webtools/tinderbox3/scripts/admin.pl b/mozilla/webtools/tinderbox3/scripts/admin.pl new file mode 100755 index 00000000000..b66e7043b64 --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/admin.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl -wT -I. + +use strict; +use CGI; +use Tinderbox3::Header; +use Tinderbox3::DB; + +my $p = new CGI; +my $dbh = get_dbh(); +header($p, "Global Admin"); + +print "

Administrate Tinderbox

\n"; + +print "\n"; +foreach my $tree (@{$dbh->selectcol_arrayref("SELECT tree_name FROM tbox_tree")}) { + print "\n"; +} + +print "\n"; +print "
Trees
$tree
Add Tree
\n"; + +footer($p); +$dbh->disconnect; diff --git a/mozilla/webtools/tinderbox3/scripts/adminpatch.pl b/mozilla/webtools/tinderbox3/scripts/adminpatch.pl new file mode 100755 index 00000000000..daf51d87c20 --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/adminpatch.pl @@ -0,0 +1,115 @@ +#!/usr/bin/perl -wT -I. + +use CGI; +use Tinderbox3::Header; +use Tinderbox3::DB; +use strict; + +# +# Init +# +my $p = new CGI; + +my $dbh = get_dbh(); +my ($patch_id, $message) = update_patch($p, $dbh); +# Get patch from DB +my $patch_info = $dbh->selectrow_arrayref("SELECT tree_name, patch_name, patch_ref, patch, obsolete FROM tbox_patch WHERE patch_id = ?"); +if (!$patch_info) { + die "Could not get patch!"; +} +my ($tree, $patch_name, $patch_ref, $patch, $obsolete) = @{$patch_info}; +my $bug_id; +if ($patch_ref =~ /Bug\s+(.*)/) { + $bug_id = $1; +} + +header($p, "Edit Patch $patch_name"); + +# +# Edit / Add tree form +# +print "

Edit Patch $patch_name

\n"; + +print "

List Trees"; +if ($tree) { + print " | Edit Sheriff / Tree Status Info | Edit Tree\n"; +} +print "

\n"; + +print < + + + + + +
Patch Name (just for display):
Bug #:
+ + +EOM + + +footer($p); +$dbh->disconnect; + + +# +# Update / insert the patch +# +sub update_patch { + my ($p, $dbh) = @_; + + my $tree = $p->param('tree') || ""; + + my $action = $p->param('action') || ""; + if ($action eq 'upload_patch') { + my $tree = $p->param('tree') || ""; + my $patch_name = $p->param('_patch_name') || ""; + my $bug_id = $p->param('_bug_id') || ""; + + if (!$patch_name) { die "Must specify a non-blank patch name!"; } + + my $patch_fh = $p->upload('_patch'); + if (!$patch_fh) { die "No patch file uploaded!"; } + my $patch = ""; + while (<$patch_fh>) { + $patch .= $_; + } + + my $rows = $dbh->do("INSERT INTO tbox_patch (tree_name, patch_name, patch_ref, patch_ref_url, patch) VALUES (?, ?, ?, ?, ?)", undef, $tree, $patch_name, "Bug $bug_id", "http://bugzilla.mozilla.org/show_bug.cgi?id=$bug_id", $patch); + + # Update or insert the tree + if ($tree) { + my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree); + if (!$rows) { + die "No tree named $tree!"; + } + } else { + my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors); + if (!$rows) { + die "Passing strange. Insert failed."; + } + $tree = $newtree; + } + $dbh->commit; + } elsif ($action eq 'delete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Delete failed. No such tree / patch."; + } + $dbh->commit; + } elsif ($action eq 'obsolete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Update failed. No such tree / patch."; + } + $dbh->commit; + } + + return $tree; +} + diff --git a/mozilla/webtools/tinderbox3/scripts/admintree.pl b/mozilla/webtools/tinderbox3/scripts/admintree.pl new file mode 100755 index 00000000000..15d0b1bedd3 --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/admintree.pl @@ -0,0 +1,142 @@ +#!/usr/bin/perl -wT -I. + +use CGI; +use Tinderbox3::Header; +use Tinderbox3::Actions; +use Tinderbox3::DB; +use strict; + +# +# Init +# +my $p = new CGI; + +my $dbh = get_dbh(); +my $tree = update_tree($p, $dbh); +my $tree_str = "Edit $tree" || "Add Tree"; +header($p, $tree_str); +process_actions($p, $dbh); + +# +# Get the tree info to fill in the fields +# +my $tree_info; +if (!$tree) { + # XXX Pull these out into defaults elsewhere + $tree_info = [ '', + 'refcount_leaks=Lk,refcount_bloat=Bl,trace_malloc_leaks=Lk,trace_malloc_maxheap=MH,trace_malloc_allocs=A,pageload=Tp,codesize=Z,xulwinopen=Txul,startup=Ts,binary_url=Binary,warnings=Warn', + 'refcount_leaks=Graph,refcount_bloat=Graph,trace_malloc_leaks=Graph,trace_malloc_maxheap=Graph,trace_malloc_allocs=Graph,pageload=Graph,codesize=Graph,xulwinopen=Graph,startup=Graph,binary_url=URL,warnings=Warn', + ]; +} else { + $tree_info = $dbh->selectrow_arrayref("SELECT password, field_short_names, field_processors FROM tbox_tree WHERE tree_name = ?", undef, $tree); +} + +# +# Edit / Add tree form +# +print "

$tree_str

\n"; + +print "

List Trees"; +if ($tree) { + print " | Edit Sheriff / Tree Status Info\n"; +} +print "

\n"; + +print < + + + + + + + +
Tree Name (this is the name used to identify the tree):
Password:
Status Short Names (bloat=Bl,pageload=Tp)
Status Handlers (bloat=Graph,binary_url=URL)
+ + +EOM + +# +# If it's not new, have a list of patches and machines +# +if ($tree) { + # Patch list + print "\n"; + my $sth = $dbh->prepare('SELECT patch_id, patch_name FROM tbox_patch WHERE tree_name = ?'); + $sth->execute($tree); + while (my $patch_info = $sth->fetchrow_arrayref) { + print "\n"; + } + print "\n"; + print "
Patches
$patch_info->[1] (Del | Obsolete)
Upload Patch
\n"; + + # Machine list + print "\n"; + $sth = $dbh->prepare('SELECT machine_id, machine_name FROM tbox_machine WHERE tree_name = ?'); + $sth->execute($tree); + while (my $machine_info = $sth->fetchrow_arrayref) { + print "\n"; + } + # XXX Add this feature in if you decide not to automatically allow machines + # into the federation + # print "\n"; + print "
Machines
$machine_info->[1]
Upload Machine
\n"; +} + + +footer($p); +$dbh->disconnect; + + +# +# Update / Insert the tree and perform other DB operations +# +sub update_tree { + my ($p, $dbh) = @_; + + my $tree = $p->param('tree') || ""; + + my $action = $p->param('action') || ""; + if ($action eq 'edit_tree') { + my $newtree = $p->param('_tree_name') || ""; + my $password = $p->param('_password') || ""; + my $field_short_names = $p->param('_field_short_names') || ""; + my $field_processors = $p->param('_field_processors') || ""; + + if (!$newtree) { die "Must specify a non-blank tree!"; } + + # Update or insert the tree + if ($tree) { + my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree); + if (!$rows) { + die "No tree named $tree!"; + } + } else { + my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors); + if (!$rows) { + die "Passing strange. Insert failed."; + } + $tree = $newtree; + } + $dbh->commit; + } elsif ($action eq 'delete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Delete failed. No such tree / patch."; + } + $dbh->commit; + } elsif ($action eq 'obsolete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Update failed. No such tree / patch."; + } + $dbh->commit; + } + + return $tree; +} + diff --git a/mozilla/webtools/tinderbox3/server/Tinderbox3/DB.pm b/mozilla/webtools/tinderbox3/server/Tinderbox3/DB.pm new file mode 100644 index 00000000000..57c527c96fb --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/Tinderbox3/DB.pm @@ -0,0 +1,15 @@ +package Tinderbox3::DB; + +use strict; +use DBI; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(get_dbh); + +sub get_dbh { + my $dbh = DBI->connect("dbi:Pg:dbname=tbox", "jkeiser", "scuttlebutt", { RaiseError => 1, AutoCommit => 0 }); + return $dbh; +} + +1 diff --git a/mozilla/webtools/tinderbox3/server/Tinderbox3/Header.pm b/mozilla/webtools/tinderbox3/server/Tinderbox3/Header.pm new file mode 100644 index 00000000000..63d681eaa1e --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/Tinderbox3/Header.pm @@ -0,0 +1,31 @@ +package Tinderbox3::Header; + +use strict; + +use CGI::Carp qw(fatalsToBrowser); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(header footer); + +sub header { + my ($p, $title) = @_; + print $p->header; + print < + +Tinderbox - $title + + + +EOM +} + +sub footer { + print < + +EOM +} + +1 diff --git a/mozilla/webtools/tinderbox3/server/admin.pl b/mozilla/webtools/tinderbox3/server/admin.pl new file mode 100755 index 00000000000..b66e7043b64 --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/admin.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl -wT -I. + +use strict; +use CGI; +use Tinderbox3::Header; +use Tinderbox3::DB; + +my $p = new CGI; +my $dbh = get_dbh(); +header($p, "Global Admin"); + +print "

Administrate Tinderbox

\n"; + +print "\n"; +foreach my $tree (@{$dbh->selectcol_arrayref("SELECT tree_name FROM tbox_tree")}) { + print "\n"; +} + +print "\n"; +print "
Trees
$tree
Add Tree
\n"; + +footer($p); +$dbh->disconnect; diff --git a/mozilla/webtools/tinderbox3/server/adminpatch.pl b/mozilla/webtools/tinderbox3/server/adminpatch.pl new file mode 100755 index 00000000000..daf51d87c20 --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/adminpatch.pl @@ -0,0 +1,115 @@ +#!/usr/bin/perl -wT -I. + +use CGI; +use Tinderbox3::Header; +use Tinderbox3::DB; +use strict; + +# +# Init +# +my $p = new CGI; + +my $dbh = get_dbh(); +my ($patch_id, $message) = update_patch($p, $dbh); +# Get patch from DB +my $patch_info = $dbh->selectrow_arrayref("SELECT tree_name, patch_name, patch_ref, patch, obsolete FROM tbox_patch WHERE patch_id = ?"); +if (!$patch_info) { + die "Could not get patch!"; +} +my ($tree, $patch_name, $patch_ref, $patch, $obsolete) = @{$patch_info}; +my $bug_id; +if ($patch_ref =~ /Bug\s+(.*)/) { + $bug_id = $1; +} + +header($p, "Edit Patch $patch_name"); + +# +# Edit / Add tree form +# +print "

Edit Patch $patch_name

\n"; + +print "

List Trees"; +if ($tree) { + print " | Edit Sheriff / Tree Status Info | Edit Tree\n"; +} +print "

\n"; + +print < + + + + + +
Patch Name (just for display):
Bug #:
+ + +EOM + + +footer($p); +$dbh->disconnect; + + +# +# Update / insert the patch +# +sub update_patch { + my ($p, $dbh) = @_; + + my $tree = $p->param('tree') || ""; + + my $action = $p->param('action') || ""; + if ($action eq 'upload_patch') { + my $tree = $p->param('tree') || ""; + my $patch_name = $p->param('_patch_name') || ""; + my $bug_id = $p->param('_bug_id') || ""; + + if (!$patch_name) { die "Must specify a non-blank patch name!"; } + + my $patch_fh = $p->upload('_patch'); + if (!$patch_fh) { die "No patch file uploaded!"; } + my $patch = ""; + while (<$patch_fh>) { + $patch .= $_; + } + + my $rows = $dbh->do("INSERT INTO tbox_patch (tree_name, patch_name, patch_ref, patch_ref_url, patch) VALUES (?, ?, ?, ?, ?)", undef, $tree, $patch_name, "Bug $bug_id", "http://bugzilla.mozilla.org/show_bug.cgi?id=$bug_id", $patch); + + # Update or insert the tree + if ($tree) { + my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree); + if (!$rows) { + die "No tree named $tree!"; + } + } else { + my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors); + if (!$rows) { + die "Passing strange. Insert failed."; + } + $tree = $newtree; + } + $dbh->commit; + } elsif ($action eq 'delete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Delete failed. No such tree / patch."; + } + $dbh->commit; + } elsif ($action eq 'obsolete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Update failed. No such tree / patch."; + } + $dbh->commit; + } + + return $tree; +} + diff --git a/mozilla/webtools/tinderbox3/server/admintree.pl b/mozilla/webtools/tinderbox3/server/admintree.pl new file mode 100755 index 00000000000..15d0b1bedd3 --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/admintree.pl @@ -0,0 +1,142 @@ +#!/usr/bin/perl -wT -I. + +use CGI; +use Tinderbox3::Header; +use Tinderbox3::Actions; +use Tinderbox3::DB; +use strict; + +# +# Init +# +my $p = new CGI; + +my $dbh = get_dbh(); +my $tree = update_tree($p, $dbh); +my $tree_str = "Edit $tree" || "Add Tree"; +header($p, $tree_str); +process_actions($p, $dbh); + +# +# Get the tree info to fill in the fields +# +my $tree_info; +if (!$tree) { + # XXX Pull these out into defaults elsewhere + $tree_info = [ '', + 'refcount_leaks=Lk,refcount_bloat=Bl,trace_malloc_leaks=Lk,trace_malloc_maxheap=MH,trace_malloc_allocs=A,pageload=Tp,codesize=Z,xulwinopen=Txul,startup=Ts,binary_url=Binary,warnings=Warn', + 'refcount_leaks=Graph,refcount_bloat=Graph,trace_malloc_leaks=Graph,trace_malloc_maxheap=Graph,trace_malloc_allocs=Graph,pageload=Graph,codesize=Graph,xulwinopen=Graph,startup=Graph,binary_url=URL,warnings=Warn', + ]; +} else { + $tree_info = $dbh->selectrow_arrayref("SELECT password, field_short_names, field_processors FROM tbox_tree WHERE tree_name = ?", undef, $tree); +} + +# +# Edit / Add tree form +# +print "

$tree_str

\n"; + +print "

List Trees"; +if ($tree) { + print " | Edit Sheriff / Tree Status Info\n"; +} +print "

\n"; + +print < + + + + + + + +
Tree Name (this is the name used to identify the tree):
Password:
Status Short Names (bloat=Bl,pageload=Tp)
Status Handlers (bloat=Graph,binary_url=URL)
+ + +EOM + +# +# If it's not new, have a list of patches and machines +# +if ($tree) { + # Patch list + print "\n"; + my $sth = $dbh->prepare('SELECT patch_id, patch_name FROM tbox_patch WHERE tree_name = ?'); + $sth->execute($tree); + while (my $patch_info = $sth->fetchrow_arrayref) { + print "\n"; + } + print "\n"; + print "
Patches
$patch_info->[1] (Del | Obsolete)
Upload Patch
\n"; + + # Machine list + print "\n"; + $sth = $dbh->prepare('SELECT machine_id, machine_name FROM tbox_machine WHERE tree_name = ?'); + $sth->execute($tree); + while (my $machine_info = $sth->fetchrow_arrayref) { + print "\n"; + } + # XXX Add this feature in if you decide not to automatically allow machines + # into the federation + # print "\n"; + print "
Machines
$machine_info->[1]
Upload Machine
\n"; +} + + +footer($p); +$dbh->disconnect; + + +# +# Update / Insert the tree and perform other DB operations +# +sub update_tree { + my ($p, $dbh) = @_; + + my $tree = $p->param('tree') || ""; + + my $action = $p->param('action') || ""; + if ($action eq 'edit_tree') { + my $newtree = $p->param('_tree_name') || ""; + my $password = $p->param('_password') || ""; + my $field_short_names = $p->param('_field_short_names') || ""; + my $field_processors = $p->param('_field_processors') || ""; + + if (!$newtree) { die "Must specify a non-blank tree!"; } + + # Update or insert the tree + if ($tree) { + my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree); + if (!$rows) { + die "No tree named $tree!"; + } + } else { + my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors); + if (!$rows) { + die "Passing strange. Insert failed."; + } + $tree = $newtree; + } + $dbh->commit; + } elsif ($action eq 'delete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Delete failed. No such tree / patch."; + } + $dbh->commit; + } elsif ($action eq 'obsolete_patch') { + my $patch_id = $p->param('_patch_id') || ""; + if (!$patch_id) { die "Need patch id!" } + my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id); + if (!$rows) { + die "Update failed. No such tree / patch."; + } + $dbh->commit; + } + + return $tree; +} + diff --git a/mozilla/webtools/tinderbox3/sql/create_schema_postgres.sql b/mozilla/webtools/tinderbox3/sql/create_schema_postgres.sql new file mode 100644 index 00000000000..e9cdff0b6e5 --- /dev/null +++ b/mozilla/webtools/tinderbox3/sql/create_schema_postgres.sql @@ -0,0 +1,71 @@ +-- +-- Represents a tree--a set of machines +-- +CREATE TABLE tbox_tree ( + tree_name VARCHAR(200) UNIQUE, + password TEXT, + -- The short names for particular fields that will show up on the main page + field_short_names TEXT, + -- Name the processors that will show the fields (comma separated name=value pairs) + field_processors TEXT +); + +-- +-- A patch (associated with a tree) +-- +CREATE TABLE tbox_patch ( + patch_id SERIAL, + tree_name VARCHAR(200), + patch_name VARCHAR(200), + patch_ref TEXT, + patch_ref_url TEXT, + patch TEXT, + -- obsolete: no Tinderboxes will pick up this patch + obsolete BOOLEAN +); + +-- +-- A tinderbox machine +-- +CREATE TABLE tbox_machine ( + machine_id SERIAL, + tree_name VARCHAR(200), + machine_name VARCHAR(200), + description TEXT +); + +-- +-- A particular build on a machine +-- +CREATE TABLE tbox_build ( + machine_id INTEGER, + build_time TIMESTAMP, + + status_time TIMESTAMP, + status VARCHAR(200), + log TEXT +); + +-- +-- Fields (like Tp and friends) associated with a build +-- +CREATE TABLE tbox_build_field ( + name VARCHAR(200), + value VARCHAR(200) +); + + +-- +-- Tells what patches were on a particular build +-- +CREATE TABLE tbox_build_patch ( + machine_id INTEGER, + build_time TIMESTAMP, + patch_id INTEGER +); + + +-- TODO: +-- comments +-- build commands + diff --git a/mozilla/webtools/tinderbox3/sql/setup-mysql.pl b/mozilla/webtools/tinderbox3/sql/setup-mysql.pl new file mode 100755 index 00000000000..54b93a302c0 --- /dev/null +++ b/mozilla/webtools/tinderbox3/sql/setup-mysql.pl @@ -0,0 +1,189 @@ +#!perl -I.. +use strict; +use Getopt::Long; +use DBI; + +# +# Get arguments +# +my %args; +$args{prefix} = 'ul_'; +$args{drop} = 1; +$args{create} = 1; +$args{defaults} = 1; +GetOptions(\%args, 'host|h:s', 'port|p:s', 'username|u:s', 'password|p:s', + 'prefix|P:s', + 'drop!', 'defaults!', 'create!', + 'help|h|?'); + +my $dbname = shift @ARGV; + +# +# Get help +# +if($args{help} || !$dbname || @ARGV) { + print <connect($connect_string, $args{username}, $args{password}, { RaiseError => 0, AutoCommit => 1 }); +my ($tables, $sequences) = read_tables_sequences($create_file, $args{prefix}); + +# +# Drop tables +# +if($args{drop}) { + drop_schema($dbh, $tables, $sequences); +} + +# +# Create tables +# +if($args{create}) { + execute_sql_file($dbname, \%args, $create_file); +} + +# +# Populate data +# +if($args{defaults}) { + populate_data($dbname, \%args); +} + +$dbh->disconnect; + + +sub generate_create_schema_file { + my ($old_create_schema, $new_create_schema) = @_; + open IN, $old_create_schema; + open OUT, ">$new_create_schema"; + while () { + s/\bserial\b/int4 not null auto_increment primary key/; + s/\bunique\b//; + if (/(create\s*table\s*)(\w+)/i) { + my $new_table_name = lc($2); + s/(create\s*table\s*)(\w+)/\1$new_table_name/i; + } + print OUT; + } + close OUT; + close IN; +} + +# +# Actually drop tables and sequences +# +sub drop_schema { + my ($dbh, $tables, $sequences) = @_; + + foreach my $table (@{$tables}) { + print "Dropping $table"; + if($sequences->{$table}) { + print " (seq: " . join(", ", @{$sequences->{$table}}) . ")"; + } + print " ... \n"; + my $sth; + foreach my $seq (@{$sequences->{$table}}) { + $sth = $dbh->prepare("drop sequence $seq"); + # We don't care if there's an error here + $sth->execute; + } + $sth = $dbh->prepare("drop table $table"); + # We don't care if there's an error here + $sth->execute; + } +} + +# +# Read the list of tables and sequences from the create schema file +# +sub read_tables_sequences { + my ($create_file, $prefix) = @_; + + my @tables; + my %sequences; + my $recent_table; + + # + # Grab the list of tables and sequences + # + open IN, $create_file; + while() { + if(/^\s*create\s*table\s*(\S+)/i) { + $recent_table = $1; + if($recent_table =~ /^ul_(.+)/i) { + $recent_table = "$prefix$1"; + } + unshift @tables, $recent_table; + } + } + close IN; + + return (\@tables, \%sequences); +} + +# +# Populate the initial data +# +sub populate_data { + my ($dbname, $args) = @_; + require UserLogin::mysql; + my $sys = new UserLogin::mysql(%{$args}, db => $dbname); + require UserLoginInit; + UserLoginInit::initial_populate($sys, $args{prefix}); +} + +# +# Execute an SQL file in mysql +# +sub execute_sql_file { + # XXX This doesn't respect the password argument + my ($dbname, $args, $sql_file) = @_; + # Switch the prefix to the new prefix + open OLDFILE, $sql_file; + open NEWFILE, ">$sql_file.new"; + while() { + s/UL_/$args{prefix}/g; + print NEWFILE $_; + } + close NEWFILE; + close OLDFILE; + my @exec_params = ('mysql'); + push @exec_params, ("-h", $args{host}) if $args{host}; + push @exec_params, ("-P", $args{port}) if $args{port}; + push @exec_params, ("-u", $args{username}) if $args{username}; + push @exec_params, ("-p", $args{password}) if $args{password}; + push @exec_params, ("-e", "\\. $sql_file.new", $dbname); + print "Executing " . join(' ', @exec_params) . " ...\n"; + system(@exec_params); + unlink("$sql_file.new"); +} diff --git a/mozilla/webtools/tinderbox3/sql/setup-postgres.pl b/mozilla/webtools/tinderbox3/sql/setup-postgres.pl new file mode 100755 index 00000000000..416a63f0d41 --- /dev/null +++ b/mozilla/webtools/tinderbox3/sql/setup-postgres.pl @@ -0,0 +1,201 @@ +#!/usr/bin/perl -I. +use strict; +use Getopt::Long; +use DBI; + +# +# Get arguments +# +my %args; +$args{prefix} = 'ul_'; +$args{drop} = 1; +$args{create} = 1; +$args{defaults} = 1; +GetOptions(\%args, 'host|h:s', 'port|p:s', 'username|u:s', 'password|p:s', + 'drop!', 'defaults!', 'create!', 'grant|g:s@', + 'help|h|?'); + +my $dbname = shift @ARGV; + +# +# Get help +# +if($args{help} || !$dbname || @ARGV) { + print <connect($connect_string, $args{username}, $args{password}, { RaiseError => 0, AutoCommit => 1 }); +my ($tables, $sequences) = read_tables_sequences($create_file); + +# +# Drop tables +# +if($args{drop}) { + drop_schema($dbh, $tables, $sequences); +} + +# +# Create tables +# +if($args{create}) { + execute_sql_file($dbname, \%args, $create_file); +} + +# +# Grant permissions +# +if($args{grant}) { + grant_permissions($dbh, $tables, $sequences, @{$args{grant}}); +} + +# +# Populate data +# +if($args{defaults}) { + populate_data($dbname, \%args); +} + +$dbh->disconnect; + + +# +# Actually drop tables and sequences +# +sub drop_schema { + my ($dbh, $tables, $sequences) = @_; + + foreach my $table (@{$tables}) { + print "Dropping $table"; + if($sequences->{$table}) { + print " (seq: " . join(", ", @{$sequences->{$table}}) . ")"; + } + print " ... \n"; + my $sth; + foreach my $seq (@{$sequences->{$table}}) { + $sth = $dbh->prepare("drop sequence $seq"); + # We don't care if there's an error here + $sth->execute; + } + $sth = $dbh->prepare("drop table $table"); + # We don't care if there's an error here + $sth->execute; + } +} + +# +# Read the list of tables and sequences from the create schema file +# +sub read_tables_sequences { + my ($create_file) = @_; + + my @tables; + my %sequences; + my $recent_table; + + # + # Grab the list of tables and sequences + # + open IN, $create_file; + while() { + if(/^\s*create\s*table\s*(\S+)/i) { + $recent_table = $1; + if($recent_table =~ /^ul_(.+)/i) { + $recent_table = $1; + } + unshift @tables, $recent_table; + } elsif(/^\s*(\S+)\s*serial/i) { + my $seq; + if(length($recent_table) + length($1) > 26) { + if(length($recent_table) <= 13) { + $seq = $recent_table . "_" . substr($1, 0, 26 - length($recent_table)) . "_seq"; + } elsif(length($1) <= 13) { + $seq = substr($recent_table, 0, 26 - length($1)) . "_" . $1 . "_seq"; + } else { + $seq = substr($recent_table, 0, 13) . "_" . substr($1, 0, 13) . "_seq"; + } + } else { + $seq = $recent_table . "_" . $1 . "_seq"; + } + + push @{$sequences{$recent_table}}, lc($seq); + } + } + close IN; + + return (\@tables, \%sequences); +} + +# +# Grant permissions to the tables to everyone who needs them +# +sub grant_permissions { + my ($dbh, $tables, $sequences, @grants) = @_; + foreach my $grant (@grants) { + print "Granting permissions to $grant ...\n"; + foreach my $table (@{$tables}) { + my $sth = $dbh->prepare("GRANT INSERT,UPDATE,DELETE,SELECT ON $table TO $grant"); + # Don't worry if there's an error + $sth->execute; + foreach my $sequence (@{$sequences->{$table}}) { + my $sth2 = $dbh->prepare("GRANT INSERT,UPDATE,DELETE,SELECT ON $sequence TO $grant"); + # Don't worry if there's an error + $sth2->execute; + } + } + } +} + +# +# Populate the initial data +# +sub populate_data { + my ($dbname, $args) = @_; +} + +# +# Execute an SQL file in psql +# +# +# Execute an SQL file in mysql +# +sub execute_sql_file { + # XXX This doesn't respect the password argument + my ($dbname, $args, $sql_file) = @_; + my @exec_params = ('psql'); + push @exec_params, ("-h", $args{host}) if $args{host}; + push @exec_params, ("-p", $args{port}) if $args{port}; + push @exec_params, ("-U", $args{username}) if $args{username}; + push @exec_params, ("-f", "$sql_file", $dbname); + print "Executing " . join(' ', @exec_params) . " ...\n"; + system(@exec_params); +}