summaryrefslogtreecommitdiff
path: root/rt/sbin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/sbin')
-rw-r--r--rt/sbin/extract-message-catalog246
-rw-r--r--rt/sbin/extract_pod_tests129
-rw-r--r--rt/sbin/factory428
-rw-r--r--rt/sbin/license_tag196
-rw-r--r--rt/sbin/regression_harness33
-rw-r--r--rt/sbin/rt-setup-database624
-rw-r--r--rt/sbin/rt-setup-database.in624
-rw-r--r--rt/sbin/rt-test-dependencies278
-rw-r--r--rt/sbin/rt-test-dependencies.in278
9 files changed, 2836 insertions, 0 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog
new file mode 100644
index 0000000..a7ba633
--- /dev/null
+++ b/rt/sbin/extract-message-catalog
@@ -0,0 +1,246 @@
+#!/usr/bin/perl -w
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+# Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org>
+
+use strict;
+
+use File::Find;
+use File::Copy;
+use Regexp::Common;
+use Carp;
+
+use vars qw($DEBUG $FILECAT);
+
+$DEBUG = 1;
+
+@ARGV = <lib/RT/I18N/*.po> unless @ARGV;
+
+$FILECAT = {};
+
+# extract all strings and stuff them into $FILECAT
+File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, '.' );
+
+# ensure proper escaping and [_1] => %1 transformation
+foreach my $str ( sort keys %{$FILECAT} ) {
+ my $entry = $FILECAT->{$str};
+ my $oldstr = $str;
+
+ $str =~ s/\\/\\\\/g;
+ $str =~ s/\"/\\"/g;
+ $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g;
+ $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg;
+ $str =~ s/~([\[\]])/$1/g;
+
+ delete $FILECAT->{$oldstr};
+ $FILECAT->{$str} = $entry;
+}
+
+# update all language dictionaries
+foreach my $dict (@ARGV) {
+ $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
+
+ my $lang = $dict;
+ $lang =~ s|.*/||;
+ $lang =~ s|\.po$||;
+
+ update($lang, $dict);
+}
+
+
+# {{{ pull strings out of the code.
+
+sub extract_strings_from_code {
+ my $file = $_;
+
+ local $/;
+ return if ( -d $_ );
+ return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' );
+ return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
+ return if ( /^[\.#]/ );
+ return if ( -f "$_.in" );
+
+ print "Looking at $File::Find::name\n";
+ my $filename = $File::Find::name;
+ $filename =~ s'^\./'';
+ $filename =~ s'\.in$'';
+
+ unless (open _, $file) {
+ print "Cannot open $file for reading ($!), skipping.\n";
+ return;
+ }
+
+ $_ = <_>;
+
+ # Mason filter: <&|/l>...</&>
+ my $line = 1;
+ while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
+ my ( $vars, $str ) = ( $1, $2 );
+ $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
+ $str =~ s/\\'/\'/g;
+ #print "STR IS $str\n";
+ push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
+ }
+
+ # Localization function: loc(...)
+ $line = 1;
+ pos($_) = 0;
+ while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) {
+ my $match = $1;
+ $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
+
+ my ( $vars, $str );
+ if ( $match =~
+ /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/ ) {
+
+ $str = substr( $1, 1, -1 ); # $str comes before $vars now
+ $vars = $9;
+ }
+ else {
+ next;
+ }
+
+ $vars =~ s/[\n\r]//g;
+ $str =~ s/\\'/\'/g;
+
+ push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ];
+ }
+
+ # Comment-based mark: "..." # loc
+ $line = 1;
+ pos($_) = 0;
+ while (m/\G.*?($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc\s*$/smg) {
+ my $str = substr($1, 1, -1);
+ $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
+ $str =~ s/\\'/\'/g;
+ push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
+ }
+
+ # Comment-based pair mark: "..." => "..." # loc_pair
+ $line = 1;
+ pos($_) = 0;
+ while (m/\G.*?(\w+)\s*=>\s*($RE{delimited}{-delim=>q{'"}}{-keep})[\}\)\],]*\s*\#\s*loc_pair\s*$/smg) {
+ my $key = $1;
+ my $val = substr($2, 1, -1);
+ $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext!
+ $key =~ s/\\'/\'/g;
+ $val =~ s/\\'/\'/g;
+ push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
+ push @{ $FILECAT->{$val} }, [ $filename, $line, '' ];
+ }
+
+ close (_);
+}
+# }}} extract from strings
+
+sub update {
+ my $lang = shift;
+ my $file = shift;
+ my ( %Lexicon, %Header);
+ my $out = '';
+
+ unless (!-e $file or -w $file) {
+ warn "Can't write to $lang, skipping...\n";
+ return;
+ }
+
+ print "Updating $lang...\n";
+
+ my @lines;
+ @lines = (<LEXICON>) if open (LEXICON, $file);
+ @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
+ while (@lines) {
+ my $msghdr = "";
+ $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
+ my $msgid = shift @lines;
+ my $msgstr = "";
+ $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgstr|")/ );
+
+ last unless $msgid;
+
+ chomp $msgid;
+ chomp $msgstr;
+ $msgid =~ s/^msgid "(.*)"$/$1/ or warn $msgid;
+ $msgstr =~ s/^msgstr "(.*)"$/$1/ms or warn $msgstr;
+
+ $Lexicon{$msgid} = $msgstr;
+ $Header{$msgid} = $msghdr;
+ }
+
+ my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
+
+ foreach my $str ( sort keys %{$FILECAT} ) {
+ $Lexicon{$str} ||= '';;
+ }
+ foreach ( sort keys %Lexicon ) {
+ my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
+ my $nospace = $_;
+ $nospace =~ s/ +$//;
+
+ if ( !$Lexicon{$_} and $Lexicon{$nospace} ) {
+ $Lexicon{$_} =
+ $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) );
+ }
+
+ next if !length( $Lexicon{$_} ) and $is_english;
+
+ my %seen;
+ $out .= $Header{$_} if exists $Header{$_};
+ if ( $f && $f !~ /^\s+$/ ) {
+
+ $out .= "#: $f\n";
+ }
+ elsif ($_) {
+ $out .= "#: NOT FOUND IN SOURCE\n";
+ }
+ foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) {
+ my ( $file, $line, $var ) = @{$entry};
+ $var =~ s/^\s*,\s*//;
+ $var =~ s/\s*$//;
+ $out .= "#. ($var)\n" unless $seen{$var}++;
+ }
+ $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
+ }
+
+ open PO, ">$file" or die $!;
+ print PO $out;
+ close PO;
+
+ return 1;
+}
+
+sub escape {
+ my $text = shift;
+ $text =~ s/\b_(\d+)/%$1/;
+ return $text;
+}
+
+__END__
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
diff --git a/rt/sbin/extract_pod_tests b/rt/sbin/extract_pod_tests
new file mode 100644
index 0000000..ed01c7d
--- /dev/null
+++ b/rt/sbin/extract_pod_tests
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.06';
+
+use Pod::Tests;
+use Symbol;
+
+=pod
+
+=head1 NAME
+
+extract_pod_tests - RT-specific variant of pod2tests
+
+=head1 SYNOPSIS
+
+ pod2test [-Mmodule] [input [output]]
+
+=head1 DESCRIPTION
+
+B<pod2test> is a front-end for Test::Inline. It generates the
+"Bodies" of MakeMaker style .t testing files from embedded tests and
+code examples.
+
+If output is not specified, the resulting .t file will go to STDOUT.
+Otherwise, it will go to the given output file. If input is not
+given, it will draw from STDIN.
+
+If the given file contains no tests or code examples, no output will
+be given and no output file will be created.
+
+=cut
+
+my($infile, $outfile) = @ARGV;
+my($infh,$outfh);
+
+
+if( defined $infile ) {
+ $infh = gensym;
+ open($infh, $infile) or
+ die "Can't open the POD file $infile: $!";
+}
+else {
+ $infh = \*STDIN;
+}
+
+unless ($outfile) {
+ ( my $test = $infile ) =~ s/\.(pm|pod)$//;
+ $test =~ s/^lib\W//;
+ $test =~ s/\W/-/;
+ $test =~ s/\//__/g;
+
+ $outfile = "lib/t/autogen/autogen-$test.t";
+}
+
+
+my $p = Pod::Tests->new;
+$p->parse_fh($infh);
+
+# XXX Hack to put the filename into the #line directive
+$p->{file} = $infile || '';
+
+my @tests = $p->build_tests($p->tests);
+my @examples = $p->build_examples($p->examples);
+
+exit unless @tests or @examples;
+
+
+if( defined $outfile) {
+ $outfh = gensym;
+ open($outfh, ">$outfile") or
+ die "Can't open the test file $outfile: $!";
+}
+else {
+ $outfh = \*STDOUT;
+}
+
+
+
+foreach my $test (@tests, @examples) {
+ print $outfh "$test\n";
+}
+
+print $outfh "1;\n";
+
+=pod
+
+=head1 BUGS and CAVEATS
+
+This is a very simple rough cut. It only does very rudimentary tests
+on the examples.
+
+=head1 AUTHOR
+
+
+
+Based on pod2tests by Michael G Schwern <schwern@pobox.com>
+
+=head1 SEE ALSO
+
+L<Test::Inline>
+
+=cut
+
+1;
diff --git a/rt/sbin/factory b/rt/sbin/factory
new file mode 100644
index 0000000..64b0ae3
--- /dev/null
+++ b/rt/sbin/factory
@@ -0,0 +1,428 @@
+#!/usr/bin/perl
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+use DBI;
+
+my $database = shift;
+my $namespace = shift;
+
+my $CollectionBaseclass = 'RT::SearchBuilder';
+my $RecordBaseclass = 'RT::Record';
+
+my $driver = 'mysql';
+my $hostname = 'localhost';
+my $user = 'root';
+my $password = '';
+
+
+my $LicenseBlock = << '.';
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+.
+
+my $Attribution = << '.';
+# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
+# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
+#
+# !! DO NOT EDIT THIS FILE !!
+#
+
+use strict;
+.
+
+my $dsn = "DBI:$driver:database=$database;host=$hostname";
+
+my $dbh = DBI->connect( $dsn, $user, $password );
+
+#get all tables out of database
+my @tables = $dbh->tables();
+
+my ( %tablemap, $typemap, %modulemap );
+
+foreach my $table (@tables) {
+ next if ($table eq 'sessions');
+ $tablemap{$table} = $table;
+ $modulemap{$table} = $table;
+ if ( $table =~ /^(.*)s$/ ) {
+ $tablemap{$1} = $table;
+ $modulemap{$1} = $1;
+ }
+}
+$tablemap{'CreatedBy'} = 'User';
+$tablemap{'UpdatedBy'} = 'User';
+
+$typemap{'id'} = 'ro';
+$typemap{'Creator'} = 'auto';
+$typemap{'Created'} = 'auto';
+$typemap{'Updated'} = 'auto';
+$typemap{'UpdatedBy'} = 'auto';
+$typemap{'LastUpdated'} = 'auto';
+$typemap{'LastUpdatedBy'} = 'auto';
+
+foreach my $table (@tables) {
+ next if ($table eq 'sessions');
+ my $tablesingle = $table;
+ $tablesingle =~ s/s$//;
+ my $tableplural = $tablesingle . "s";
+
+ if ( $tablesingle eq 'ACL' ) {
+ $tablesingle = "ACE";
+ $tableplural = "ACL";
+ }
+
+ my %requirements;
+
+ my $CollectionClassName = $namespace . "::" . $tableplural;
+ my $RecordClassName = $namespace . "::" . $tablesingle;
+
+ my $path = $namespace;
+ $path =~ s/::/\//g;
+
+ my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
+ my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
+
+ #create a collection class
+ my $CreateInParams;
+ my $CreateOutParams;
+ my $ClassAccessible = "";
+ my $FieldsPod = "";
+ my $CreatePod = "";
+ my %fields;
+ my $sth = $dbh->prepare("DESCRIBE $table");
+ $sth->execute;
+
+ while ( my $row = $sth->fetchrow_hashref() ) {
+ my $field = $row->{'Field'};
+ my $type = $row->{'Type'};
+ my $default = $row->{'Default'};
+ $fields{$field} = 1;
+
+ #generate the 'accessible' datastructure
+
+ if ( $typemap{$field} eq 'auto' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1, auto => 1,";
+ }
+ elsif ( $typemap{$field} eq 'ro' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1,";
+ }
+ else {
+ $ClassAccessible .= " $field =>
+ {read => 1, write => 1,";
+
+ }
+
+ $ClassAccessible .= " type => '$type', default => '$default'},\n";
+
+ #generate pod for the accessible fields
+ $FieldsPod .= "
+=head2 $field
+
+Returns the current value of $field.
+(In the database, $field is stored as $type.)
+
+";
+
+ unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
+ $FieldsPod .= "
+
+=head2 Set$field VALUE
+
+
+Set $field to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, $field will be stored as a $type.)
+
+";
+ }
+
+ $FieldsPod .= "
+=cut
+
+";
+
+ if ( $modulemap{$field} ) {
+ $FieldsPod .= "
+=head2 ${field}Obj
+
+Returns the $modulemap{$field} Object which has the id returned by $field
+
+
+=cut
+
+sub ${field}Obj {
+ my \$self = shift;
+ my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
+ \$$field->Load(\$self->__Value('$field'));
+ return(\$$field);
+}
+";
+ $requirements{ $tablemap{$field} } =
+ "use ${namespace}::$modulemap{$field};";
+
+ }
+
+ unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
+
+ #generate create statement
+ $CreateInParams .= " $field => '$default',\n";
+ $CreateOutParams .=
+ " $field => \$args{'$field'},\n";
+
+ #gerenate pod for the create statement
+ $CreatePod .= " $type '$field'";
+ $CreatePod .= " defaults to '$default'" if ($default);
+ $CreatePod .= ".\n";
+
+ }
+
+ }
+
+ $Create = "
+sub Create {
+ my \$self = shift;
+ my \%args = (
+$CreateInParams
+ \@_);
+ \$self->SUPER::Create(
+$CreateOutParams);
+
+}
+";
+ $CreatePod .= "\n=cut\n\n";
+
+ my $CollectionClass = $LicenseBlock . $Attribution .
+
+ "
+
+=head1 NAME
+
+ $CollectionClassName -- Class Description
+
+=head1 SYNOPSIS
+
+ use $CollectionClassName
+
+=head1 DESCRIPTION
+
+
+=head1 METHODS
+
+=cut
+
+package $CollectionClassName;
+
+use $CollectionBaseclass;
+use $RecordClassName;
+
+use vars qw( \@ISA );
+\@ISA= qw($CollectionBaseclass);
+
+
+sub _Init {
+ my \$self = shift;
+ \$self->{'table'} = '$table';
+ \$self->{'primary_key'} = 'id';
+
+";
+
+ if ( $fields{'SortOrder'} ) {
+
+ $CollectionClass .= "
+
+ # By default, order by name
+ \$self->OrderBy( ALIAS => 'main',
+ FIELD => 'SortOrder',
+ ORDER => 'ASC');
+";
+ }
+ $CollectionClass .= "
+ return ( \$self->SUPER::_Init(\@_) );
+}
+
+
+=head2 NewItem
+
+Returns an empty new $RecordClassName item
+
+=cut
+
+sub NewItem {
+ my \$self = shift;
+ return($RecordClassName->new(\$self->CurrentUser));
+}
+" . MagicImport($CollectionClassName);
+
+ my $RecordClassHeader = $Attribution . "
+
+=head1 NAME
+
+$RecordClassName
+
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+package $RecordClassName;
+use $RecordBaseclass;
+";
+
+ foreach my $key ( keys %requirements ) {
+ $RecordClassHeader .= $requirements{$key} . "\n";
+ }
+ $RecordClassHeader .= "
+
+use vars qw( \@ISA );
+\@ISA= qw( $RecordBaseclass );
+
+sub _Init {
+ my \$self = shift;
+
+ \$self->Table('$table');
+ \$self->SUPER::_Init(\@_);
+}
+
+";
+
+ my $RecordClass = $LicenseBlock . $RecordClassHeader . "
+
+$RecordInit
+
+=head2 Create PARAMHASH
+
+Create takes a hash of values and creates a row in the database:
+
+$CreatePod
+
+$Create
+
+$FieldsPod
+
+sub _ClassAccessible {
+ {
+
+$ClassAccessible
+ }
+};
+
+" . MagicImport($RecordClassName);
+
+ print "About to make $RecordClassPath, $CollectionClassPath\n";
+ `mkdir -p $path`;
+
+ open( RECORD, ">$RecordClassPath" );
+ print RECORD $RecordClass;
+ close(RECORD);
+
+ open( COL, ">$CollectionClassPath" );
+ print COL $CollectionClass;
+ close($COL);
+
+}
+
+sub MagicImport {
+ my $class = shift;
+
+ #if (exists \$warnings::{unimport}) {
+ # no warnings qw(redefine);
+
+ my $path = $class;
+ $path =~ s#::#/#gi;
+
+
+ my $content = "
+ eval \"require @{[$class]}_Overlay\";
+ if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
+ die \$@;
+ };
+
+ eval \"require @{[$class]}_Vendor\";
+ if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
+ die \$@;
+ };
+
+ eval \"require @{[$class]}_Local\";
+ if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
+ die \$@;
+ };
+
+
+
+
+=head1 SEE ALSO
+
+This class allows \"overlay\" methods to be placed
+into the following files _Overlay is for a System overlay by the original author,
+_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
+
+These overlay files can contain new subs or subs to replace existing subs in this module.
+
+If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
+
+ no warnings qw(redefine);
+
+so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
+
+@{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local
+
+=cut
+
+
+1;
+";
+
+ return $content;
+}
+
+# }}}
+
diff --git a/rt/sbin/license_tag b/rt/sbin/license_tag
new file mode 100644
index 0000000..689b246
--- /dev/null
+++ b/rt/sbin/license_tag
@@ -0,0 +1,196 @@
+#!/usr/bin/perl
+
+
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+my $LICENSE = <<EOL;
+
+Copyright (c) 1996-2003 Jesse Vincent <jesse\@bestpractical.com>
+
+(Except where explicitly superseded by other copyright notices)
+
+This work is made available to you under the terms of Version 2 of
+the GNU General Public License. A copy of that license should have
+been provided with this software, but in any event can be snarfed
+from www.gnu.org.
+
+This work 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 the GNU
+General Public License for more details.
+
+Unless otherwise specified, all modifications, corrections or
+extensions to this work which alter its source code become the
+property of Best Practical Solutions, LLC when submitted for
+inclusion in the work.
+
+
+EOL
+
+use File::Find;
+
+my @MAKE = qw(Makefile);
+
+File::Find::find({ no_chdir => 1, wanted => \&tag_pm}, 'lib');
+File::Find::find({ no_chdir => 1, wanted => \&tag_mason}, 'html');
+File::Find::find({ no_chdir => 1, wanted => \&tag_script}, 'sbin');
+File::Find::find({ no_chdir => 1, wanted => \&tag_script}, 'bin');
+tag_makefile ('Makefile.in');
+tag_makefile ('README');
+
+
+sub tag_mason {
+ my $pm = $_;
+ next unless (-f $pm);
+ next if ($pm =~ /images/);
+ open(FILE,"<$pm") || die "Failed to open $pm";
+ my $file = (join "", <FILE>);
+ close (FILE);
+ my $pmlic = $LICENSE;
+ $pmlic =~ s/^/%# /mg;
+
+
+ print "$pm - ";
+ if ($file =~ /^%# BEGIN LICENSE BLOCK/ms) {
+ print "has license section";
+ $file =~ s/^%# BEGIN LICENSE BLOCK(.*?)%# END LICENSE BLOCK/%# BEGIN LICENSE BLOCK\n$pmlic%# END LICENSE BLOCK/ms;
+
+
+ } else {
+ print "no license section";
+ $file ="%# BEGIN LICENSE BLOCK\n$pmlic%# END LICENSE BLOCK\n". $file;
+ }
+ $file =~ s/%# END LICENSE BLOCK(\n+)/%# END LICENSE BLOCK\n/mg;
+ print "\n";
+
+
+
+
+ open (FILE, ">$pm") || die "couldn't write new file";
+ print FILE $file;
+ close FILE;
+
+}
+
+
+sub tag_makefile {
+ my $pm = shift;
+ open(FILE,"<$pm") || die "Failed to open $pm";
+ my $file = (join "", <FILE>);
+ close (FILE);
+ my $pmlic = $LICENSE;
+ $pmlic =~ s/^/# /mg;
+
+
+ print "$pm - ";
+ if ($file =~ /^# BEGIN LICENSE BLOCK/ms) {
+ print "has license section";
+ $file =~ s/^# BEGIN LICENSE BLOCK(.*?)# END LICENSE BLOCK/# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK/ms;
+
+
+ } else {
+ print "no license section";
+ $file ="# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK\n". $file;
+ }
+ $file =~ s/# END LICENSE BLOCK(\n+)/# END LICENSE BLOCK\n/mg;
+ print "\n";
+
+
+
+
+ open (FILE, ">$pm") || die "couldn't write new file";
+ print FILE $file;
+ close FILE;
+
+}
+
+
+sub tag_pm {
+ my $pm = $_;
+ next unless $pm =~ /\.pm\z/s;
+ open(FILE,"<$pm") || die "Failed to open $pm";
+ my $file = (join "", <FILE>);
+ close (FILE);
+ my $pmlic = $LICENSE;
+ $pmlic =~ s/^/# /mg;
+
+
+ print "$pm - ";
+ if ($file =~ /^# BEGIN LICENSE BLOCK/ms) {
+ print "has license section";
+ $file =~ s/^# BEGIN LICENSE BLOCK(.*?)# END LICENSE BLOCK/# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK/ms;
+
+
+ } else {
+ print "no license section";
+ $file ="# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK\n". $file;
+ }
+ $file =~ s/# END LICENSE BLOCK(\n+)/# END LICENSE BLOCK\n/mg;
+ print "\n";
+
+
+
+
+ open (FILE, ">$pm") || die "couldn't write new file $pm";
+ print FILE $file;
+ close FILE;
+
+}
+
+
+sub tag_script {
+ my $pm = $_;
+ return unless (-f $pm);
+ open(FILE,"<$pm") || die "Failed to open $pm";
+ my $file = (join "", <FILE>);
+ close (FILE);
+ my $pmlic = $LICENSE;
+ $pmlic =~ s/^/# /msg;
+
+ print "$pm - ";
+ if ($file =~ /^# BEGIN LICENSE BLOCK/ms) {
+ print "has license section";
+ $file =~ s/^# BEGIN LICENSE BLOCK(.*?)# END LICENSE BLOCK/# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK/ms;
+
+
+ } else {
+ print "no license section";
+ if ($file =~ /^(#!.*?)\n/) {
+
+ my $lic ="# BEGIN LICENSE BLOCK\n$pmlic# END LICENSE BLOCK\n";
+ $file =~ s/^(#!.*?)\n/$1\n$lic/;
+
+ }
+ }
+ $file =~ s/# END LICENSE BLOCK(\n+)/# END LICENSE BLOCK\n\n/mg;
+ print "\n";
+
+
+ open (FILE, ">$pm") || die "couldn't write new file";
+ print FILE $file;
+ close FILE;
+
+}
+
diff --git a/rt/sbin/regression_harness b/rt/sbin/regression_harness
new file mode 100644
index 0000000..fc1e293
--- /dev/null
+++ b/rt/sbin/regression_harness
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+open (FH,"make regression|");
+
+my $skip_frontmatter = 1;
+while (<FH>) {
+ next if /^ok/;
+ $skip_frontmatter = 0 if (/autogen/);
+ print $_ unless ($skip_frontmatter);
+}
diff --git a/rt/sbin/rt-setup-database b/rt/sbin/rt-setup-database
new file mode 100644
index 0000000..1781988
--- /dev/null
+++ b/rt/sbin/rt-setup-database
@@ -0,0 +1,624 @@
+#!/usr/bin/perl -w
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+use strict;
+use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item);
+use vars
+ qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips);
+
+use lib "/opt/rt3/lib";
+
+#This drags in RT's config.pm
+# We do it in a begin block because RT::Handle needs to know the type to do its
+# inheritance
+use RT;
+use Carp;
+use RT::User;
+use RT::CurrentUser;
+use RT::Template;
+use RT::ScripAction;
+use RT::ACE;
+use RT::Group;
+use RT::User;
+use RT::Queue;
+use RT::ScripCondition;
+use RT::CustomField;
+use RT::Scrip;
+
+RT::LoadConfig();
+use Term::ReadKey;
+use Getopt::Long;
+
+my %args;
+
+GetOptions(
+ \%args,
+ 'prompt-for-dba-password', 'force', 'debug',
+ 'action=s', 'dba=s', 'dba-password=s', 'datafile=s',
+ 'datadir=s'
+);
+
+$| = 1; #unbuffer that output.
+
+require RT::Handle;
+my $Handle = RT::Handle->new($RT::DatabaseType);
+$Handle->BuildDSN;
+my $dbh;
+
+if ( $args{'prompt-for-dba-password'} ) {
+ $args{'dba-password'} = get_dba_password();
+ chomp( $args{'dba-password'} );
+}
+
+unless ( $args{'action'} ) {
+ help();
+ die;
+}
+if ( $args{'action'} eq 'init' ) {
+ $dbh = DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ print "Now creating a database for RT.\n";
+ if ($RT::DatabaseType ne 'Oracle' ||
+ $args{'dba'} ne $RT::DatabaseUser) {
+ create_db();
+ } else {
+ print "...skipped as ".$args{'dba'} ." is not " . $RT::DatabaseUser . " or we're working with Oracle.\n";
+ }
+
+ $dbh->disconnect;
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die $DBI::errstr;
+
+ print "Now populating database schema.\n";
+ insert_schema();
+ print "Now inserting database ACLs\n";
+ insert_acl() unless ($RT::DatabaseType eq 'Oracle');
+ print "Now inserting RT core system objects\n";
+ insert_initial_data();
+ print "Now inserting RT data\n";
+ insert_data( $RT::EtcPath . "/initialdata" );
+}
+elsif ( $args{'action'} eq 'drop' ) {
+ unless ( $dbh =
+ DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) )
+ {
+ warn $DBI::errstr;
+ warn "Database doesn't appear to exist. Aborting database drop.";
+ exit(0);
+ }
+ drop_db();
+}
+elsif ( $args{'action'} eq 'insert_initial' ) {
+ insert_initial_data();
+}
+elsif ( $args{'action'} eq 'insert' ) {
+ insert_data( $args{'datafile'} );
+}
+elsif ($args{'action'} eq 'acl') {
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ insert_acl($args{'datadir'});
+}
+elsif ($args{'action'} eq 'schema') {
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ insert_schema($args{'datadir'});
+}
+
+else {
+ print STDERR '$0 called with an invalid --action parameter';
+ exit(-1);
+}
+
+# {{{ sub insert_schema
+sub insert_schema {
+ my $base_path = (shift || $RT::EtcPath);
+ my (@schema);
+ print "Creating database schema.\n";
+
+ if ( -f $base_path . "/schema." . $RT::DatabaseType ) {
+ no warnings 'unopened';
+
+ open( SCHEMA, "<" . $base_path . "/schema." . $RT::DatabaseType );
+ open( SCHEMA_LOCAL, "<" . $RT::LocalEtcPath . "/schema." . $RT::DatabaseType );
+
+ my $statement = "";
+ foreach my $line (<SCHEMA>, ($_ = ';;'), <SCHEMA_LOCAL>) {
+ $line =~ s/\#.*//g;
+ $line =~ s/--.*//g;
+ $statement .= $line;
+ if ( $line =~ /;(\s*)$/ ) {
+ $statement =~ s/;(\s*)$//g;
+ push @schema, $statement;
+ $statement = "";
+ }
+ }
+
+ local $SIG{__WARN__} = sub {};
+ my $is_local = 0; # local/etc/schema needs to be nonfatal.
+ foreach my $statement (@schema) {
+ if ($statement =~ /^\s*;$/) { $is_local = 1; next; }
+ print STDERR "SQL: $statement\n" if defined $args{'debug'};
+ my $sth = $dbh->prepare($statement) or die $dbh->errstr;
+ unless ( $sth->execute or $is_local ) {
+ die "Problem with statement:\n $statement\n" . $sth->errstr;
+ }
+ }
+
+ }
+ else {
+ die "Couldn't find schema file for " . $RT::DatabaseType . "\n";
+ }
+ print "schema sucessfully inserted\n";
+
+}
+
+# }}}
+
+# {{{ sub drop_db
+sub drop_db {
+ return if ( $RT::DatabaseType eq 'SQLite' );
+ if ( $RT::DatabaseType eq 'Oracle' ) {
+ print <<END;
+
+To delete the tables and sequences of the RT Oracle database by running
+ \@etc/drop.Oracle
+through SQLPlus.
+
+END
+ return;
+ }
+ unless ( $args{'force'} ) {
+ print <<END;
+
+About to drop $RT::DatabaseType database $RT::DatabaseName on $RT::DatabaseHost.
+WARNING: This will erase all data in $RT::DatabaseName.
+
+END
+ exit unless _yesno();
+
+ }
+
+ print "Dropping $RT::DatabaseType database $RT::DatabaseName.\n";
+
+ $dbh->do("Drop DATABASE $RT::DatabaseName") or warn $DBI::errstr;
+}
+
+# }}}
+
+# {{{ sub create_db
+sub create_db {
+ print "Creating $RT::DatabaseType database $RT::DatabaseName.\n";
+ if ( $RT::DatabaseType eq 'SQLite' ) {
+ return;
+ }
+ elsif ( $RT::DatabaseType eq 'Pg' ) {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName WITH ENCODING='UNICODE'");
+ if ($DBI::errstr) {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName") || die $DBI::errstr;
+ }
+ }
+ elsif ($RT::DatabaseType eq 'Oracle') {
+ insert_acl();
+ }
+ elsif ( $RT::DatabaseType eq 'Informix' ) {
+ $ENV{DB_LOCALE} = 'en_us.utf8';
+ $dbh->do("CREATE DATABASE $RT::DatabaseName WITH BUFFERED LOG");
+ }
+ else {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName") or die $DBI::errstr;
+ }
+}
+
+# }}}
+
+sub get_dba_password {
+ print
+"In order to create a new database and grant RT access to that database,\n";
+ print "this script needs to connect to your "
+ . $RT::DatabaseType
+ . " instance on "
+ . $RT::DatabaseHost . " as "
+ . $args{'dba'} . ".\n";
+ print
+"Please specify that user's database password below. If the user has no database\n";
+ print "password, just press return.\n\n";
+ print "Password: ";
+ ReadMode('noecho');
+ my $password = ReadLine(0);
+ ReadMode('normal');
+ return ($password);
+}
+
+# {{{ sub _yesno
+sub _yesno {
+ print "Proceed [y/N]:";
+ my $x = scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
+# }}}
+
+# {{{ insert_acls
+sub insert_acl {
+
+ my $base_path = (shift || $RT::EtcPath);
+
+ if ( $RT::DatabaseType =~ /^oracle$/i ) {
+ do $base_path . "/acl.Oracle"
+ || die "Couldn't find ACLS for Oracle\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^pg$/i ) {
+ do $base_path . "/acl.Pg" || die "Couldn't find ACLS for Pg\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^mysql$/i ) {
+ do $base_path . "/acl.mysql"
+ || die "Couldn't find ACLS for mysql in " . $RT::EtcPath . "\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^informix$/i ) {
+ do $base_path . "/acl.Informix"
+ || die "Couldn't find ACLS for Informix in " . $RT::EtcPath . "\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^SQLite$/i ) {
+ return;
+ }
+ else {
+ die "Unknown RT database type";
+ }
+
+ my @acl = acl($dbh);
+ foreach my $statement (@acl) {
+ print STDERR $statement if $args{'debug'};
+ my $sth = $dbh->prepare($statement) or die $dbh->errstr;
+ unless ( $sth->execute ) {
+ die "Problem with statement:\n $statement\n" . $sth->errstr;
+ }
+ }
+}
+
+# }}}
+
+=head2 get_system_dsn
+
+Returns a dsn suitable for database creates and drops
+and user creates and drops
+
+=cut
+
+sub get_system_dsn {
+
+ my $dsn = $Handle->DSN;
+
+ #with mysql, you want to connect sans database to funge things
+ if ( $RT::DatabaseType eq 'mysql' ) {
+ $dsn =~ s/dbname=$RT::DatabaseName//;
+
+ # with postgres, you want to connect to database1
+ }
+ elsif ( $RT::DatabaseType eq 'Pg' ) {
+ $dsn =~ s/dbname=$RT::DatabaseName/dbname=template1/;
+ }
+ elsif ( $RT::DatabaseType eq 'Informix' ) {
+ # with Informix, you want to connect sans database:
+ $dsn =~ s/Informix:$RT::DatabaseName/Informix:/;
+ }
+ return $dsn;
+}
+
+sub insert_initial_data {
+
+ RT::InitLogging();
+
+ #connect to the db, for actual RT work
+ require RT::Handle;
+ $RT::Handle = RT::Handle->new();
+ $RT::Handle->Connect();
+
+ #Put together a current user object so we can create a User object
+ my $CurrentUser = new RT::CurrentUser();
+
+ print "Checking for existing system user ($CurrentUser)...";
+ my $test_user = RT::User->new($CurrentUser);
+ $test_user->Load('RT_System');
+ if ( $test_user->id ) {
+ print "found!\n\nYou appear to have a functional RT database.\n"
+ . "Exiting, so as not to clobber your existing data.\n";
+ exit(-1);
+
+ }
+ else {
+ print "not found. This appears to be a new installation.\n";
+ }
+
+ print "Creating system user...";
+ my $RT_System = new RT::User($CurrentUser);
+
+ my ( $val, $msg ) = $RT_System->_BootstrapCreate(
+ Name => 'RT_System',
+ RealName => 'The RT System itself',
+ Comments =>
+'Do not delete or modify this user. It is integral to RT\'s internal database structures',
+ Creator => '1' );
+
+ unless ($val) {
+ print "$msg\n";
+ exit(1);
+ }
+ print "done.\n";
+ $RT::Handle->Disconnect();
+
+}
+
+# load some sort of data into the database
+
+sub insert_data {
+ my $datafile = shift;
+
+ #Connect to the database and get RT::SystemUser and RT::Nobody loaded
+ RT::Init;
+
+ my $CurrentUser = RT::CurrentUser->new();
+ $CurrentUser->LoadByName('RT_System');
+
+ if ( $datafile eq $RT::EtcPath . "/initialdata" ) {
+
+ print "Creating Superuser ACL...";
+
+ my $superuser_ace = RT::ACE->new($CurrentUser);
+ $superuser_ace->_BootstrapCreate(
+ PrincipalId => ACLEquivGroupId( $CurrentUser->Id ),
+ PrincipalType => 'Group',
+ RightName => 'SuperUser',
+ ObjectType => 'RT::System',
+ ObjectId => '1' );
+
+ }
+
+ # Slurp in stuff to insert from the datafile. Possible things to go in here:-
+ # @groups, @users, @acl, @queues, @ScripActions, @ScripConditions, @templates
+
+ require $datafile
+ || die "Couldn't find initial data for import\n" . $@;
+
+ if (@Groups) {
+ print "Creating groups...";
+ foreach $item (@Groups) {
+ my $new_entry = RT::Group->new($CurrentUser);
+ my ( $return, $msg ) = $new_entry->_Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Users) {
+ print "Creating users...";
+ foreach $item (@Users) {
+ my $new_entry = new RT::User($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Queues) {
+ print "Creating queues...";
+ for $item (@Queues) {
+ my $new_entry = new RT::Queue($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@ACL) {
+ print "Creating ACL...";
+ for my $item (@ACL) {
+
+ my ($princ, $object);
+
+ # Global rights or Queue rights?
+ if ($item->{'Queue'}) {
+ $object = RT::Queue->new($CurrentUser);
+ $object->Load( $item->{'Queue'} );
+ } else {
+ $object = $RT::System;
+ }
+
+ # Group rights or user rights?
+ if ($item->{'GroupDomain'}) {
+ $princ = RT::Group->new($CurrentUser);
+ if ($item->{'GroupDomain'} eq 'UserDefined') {
+ $princ->LoadUserDefinedGroup( $item->{'GroupId'} );
+ } elsif ($item->{'GroupDomain'} eq 'SystemInternal') {
+ $princ->LoadSystemInternalGroup( $item->{'GroupType'} );
+ } elsif ($item->{'GroupDomain'} eq 'RT::Queue-Role' &&
+ $item->{'Queue'}) {
+ $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'},
+ Queue => $object->id);
+ } else {
+ $princ->Load( $item->{'GroupId'} );
+ }
+ } else {
+ $princ = RT::User->new($CurrentUser);
+ $princ->Load( $item->{'UserId'} );
+ }
+
+ # Grant it
+ my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
+ Right => $item->{'Right'},
+ Object => $object );
+
+ if ($return) {
+ print $return. ".";
+ }
+ else {
+ print $msg . ".";
+
+ }
+
+ }
+ print "done.\n";
+ }
+ if (@CustomFields) {
+ print "Creating custom fields...";
+ for $item (@CustomFields) {
+ my $new_entry = new RT::CustomField($CurrentUser);
+ my $values = $item->{'Values'};
+ delete $item->{'Values'};
+ my $q = $item->{'Queue'};
+ my $q_obj = RT::Queue->new($CurrentUser);
+ $q_obj->Load($q);
+ if ( $q_obj->Id ) {
+ $item->{'Queue'} = $q_obj->Id;
+ }
+ elsif ( $q == 0 ) {
+ $item->{'Queue'} = 0;
+ }
+ else {
+ print "(Error: Could not find queue " . $q . ")\n"
+ unless ( $q_obj->Id );
+ next;
+ }
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+
+ foreach my $value ( @{$values} ) {
+ my ( $eval, $emsg ) = $new_entry->AddValue(%$value);
+ print "(Error: $emsg)\n" unless ($eval);
+ }
+
+ print "(Error: $msg)\n" unless ($return);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@ScripActions) {
+ print "Creating ScripActions...";
+
+ for $item (@ScripActions) {
+ my $new_entry = RT::ScripAction->new($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@ScripConditions) {
+ print "Creating ScripConditions...";
+
+ for $item (@ScripConditions) {
+ my $new_entry = RT::ScripCondition->new($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@Templates) {
+ print "Creating templates...";
+
+ for $item (@Templates) {
+ my $new_entry = new RT::Template($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Scrips) {
+ print "Creating scrips...";
+
+ for $item (@Scrips) {
+ my $new_entry = new RT::Scrip($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ if ($return) {
+ print $return. ".";
+ }
+ else {
+ print "(Error: $msg)\n";
+ }
+ }
+ print "done.\n";
+ }
+ $RT::Handle->Disconnect();
+
+}
+
+=head2 ACLEquivGroupId
+
+Given a userid, return that user's acl equivalence group
+
+=cut
+
+sub ACLEquivGroupId {
+ my $username = shift;
+ my $user = RT::User->new($RT::SystemUser);
+ $user->Load($username);
+ my $equiv_group = RT::Group->new($RT::SystemUser);
+ $equiv_group->LoadACLEquivalenceGroup($user);
+ return ( $equiv_group->Id );
+}
+
+sub help {
+
+ print <<EOF;
+
+$0: Set up RT's database
+
+--action init Initialize the database
+ drop Drop the database.
+ This will ERASE ALL YOUR DATA
+ insert_initial
+ Insert RT's core system objects
+ insert Insert data into RT's database.
+ By default, will use RT's installation data.
+ To use a local or supplementary datafile, specify it
+ using the '--datafile' option below.
+
+ acl Initialize only the database ACLs
+ To use a local or supplementary datafile, specify it
+ using the '--datadir' option below.
+
+ schema Initialize only the database schema
+ To use a local or supplementary datafile, specify it
+ using the '--datadir' option below.
+
+--datafile /path/to/datafile
+--datadir /path/to/ Used to specify a path to find the local
+ database schema and acls to be installed.
+
+
+--dba dba's username
+--dba-password dba's password
+--prompt-for-dba-password Ask for the database administrator's password interactively
+
+
+EOF
+
+}
+
+1;
diff --git a/rt/sbin/rt-setup-database.in b/rt/sbin/rt-setup-database.in
new file mode 100644
index 0000000..56f4e87
--- /dev/null
+++ b/rt/sbin/rt-setup-database.in
@@ -0,0 +1,624 @@
+#!@PERL@ -w
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+use strict;
+use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item);
+use vars
+ qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips);
+
+use lib "@RT_LIB_PATH@";
+
+#This drags in RT's config.pm
+# We do it in a begin block because RT::Handle needs to know the type to do its
+# inheritance
+use RT;
+use Carp;
+use RT::User;
+use RT::CurrentUser;
+use RT::Template;
+use RT::ScripAction;
+use RT::ACE;
+use RT::Group;
+use RT::User;
+use RT::Queue;
+use RT::ScripCondition;
+use RT::CustomField;
+use RT::Scrip;
+
+RT::LoadConfig();
+use Term::ReadKey;
+use Getopt::Long;
+
+my %args;
+
+GetOptions(
+ \%args,
+ 'prompt-for-dba-password', 'force', 'debug',
+ 'action=s', 'dba=s', 'dba-password=s', 'datafile=s',
+ 'datadir=s'
+);
+
+$| = 1; #unbuffer that output.
+
+require RT::Handle;
+my $Handle = RT::Handle->new($RT::DatabaseType);
+$Handle->BuildDSN;
+my $dbh;
+
+if ( $args{'prompt-for-dba-password'} ) {
+ $args{'dba-password'} = get_dba_password();
+ chomp( $args{'dba-password'} );
+}
+
+unless ( $args{'action'} ) {
+ help();
+ die;
+}
+if ( $args{'action'} eq 'init' ) {
+ $dbh = DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ print "Now creating a database for RT.\n";
+ if ($RT::DatabaseType ne 'Oracle' ||
+ $args{'dba'} ne $RT::DatabaseUser) {
+ create_db();
+ } else {
+ print "...skipped as ".$args{'dba'} ." is not " . $RT::DatabaseUser . " or we're working with Oracle.\n";
+ }
+
+ $dbh->disconnect;
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die $DBI::errstr;
+
+ print "Now populating database schema.\n";
+ insert_schema();
+ print "Now inserting database ACLs\n";
+ insert_acl() unless ($RT::DatabaseType eq 'Oracle');
+ print "Now inserting RT core system objects\n";
+ insert_initial_data();
+ print "Now inserting RT data\n";
+ insert_data( $RT::EtcPath . "/initialdata" );
+}
+elsif ( $args{'action'} eq 'drop' ) {
+ unless ( $dbh =
+ DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) )
+ {
+ warn $DBI::errstr;
+ warn "Database doesn't appear to exist. Aborting database drop.";
+ exit(0);
+ }
+ drop_db();
+}
+elsif ( $args{'action'} eq 'insert_initial' ) {
+ insert_initial_data();
+}
+elsif ( $args{'action'} eq 'insert' ) {
+ insert_data( $args{'datafile'} );
+}
+elsif ($args{'action'} eq 'acl') {
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ insert_acl($args{'datadir'});
+}
+elsif ($args{'action'} eq 'schema') {
+ $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
+ || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
+ insert_schema($args{'datadir'});
+}
+
+else {
+ print STDERR '$0 called with an invalid --action parameter';
+ exit(-1);
+}
+
+# {{{ sub insert_schema
+sub insert_schema {
+ my $base_path = (shift || $RT::EtcPath);
+ my (@schema);
+ print "Creating database schema.\n";
+
+ if ( -f $base_path . "/schema." . $RT::DatabaseType ) {
+ no warnings 'unopened';
+
+ open( SCHEMA, "<" . $base_path . "/schema." . $RT::DatabaseType );
+ open( SCHEMA_LOCAL, "<" . $RT::LocalEtcPath . "/schema." . $RT::DatabaseType );
+
+ my $statement = "";
+ foreach my $line (<SCHEMA>, ($_ = ';;'), <SCHEMA_LOCAL>) {
+ $line =~ s/\#.*//g;
+ $line =~ s/--.*//g;
+ $statement .= $line;
+ if ( $line =~ /;(\s*)$/ ) {
+ $statement =~ s/;(\s*)$//g;
+ push @schema, $statement;
+ $statement = "";
+ }
+ }
+
+ local $SIG{__WARN__} = sub {};
+ my $is_local = 0; # local/etc/schema needs to be nonfatal.
+ foreach my $statement (@schema) {
+ if ($statement =~ /^\s*;$/) { $is_local = 1; next; }
+ print STDERR "SQL: $statement\n" if defined $args{'debug'};
+ my $sth = $dbh->prepare($statement) or die $dbh->errstr;
+ unless ( $sth->execute or $is_local ) {
+ die "Problem with statement:\n $statement\n" . $sth->errstr;
+ }
+ }
+
+ }
+ else {
+ die "Couldn't find schema file for " . $RT::DatabaseType . "\n";
+ }
+ print "schema sucessfully inserted\n";
+
+}
+
+# }}}
+
+# {{{ sub drop_db
+sub drop_db {
+ return if ( $RT::DatabaseType eq 'SQLite' );
+ if ( $RT::DatabaseType eq 'Oracle' ) {
+ print <<END;
+
+To delete the tables and sequences of the RT Oracle database by running
+ \@etc/drop.Oracle
+through SQLPlus.
+
+END
+ return;
+ }
+ unless ( $args{'force'} ) {
+ print <<END;
+
+About to drop $RT::DatabaseType database $RT::DatabaseName on $RT::DatabaseHost.
+WARNING: This will erase all data in $RT::DatabaseName.
+
+END
+ exit unless _yesno();
+
+ }
+
+ print "Dropping $RT::DatabaseType database $RT::DatabaseName.\n";
+
+ $dbh->do("Drop DATABASE $RT::DatabaseName") or warn $DBI::errstr;
+}
+
+# }}}
+
+# {{{ sub create_db
+sub create_db {
+ print "Creating $RT::DatabaseType database $RT::DatabaseName.\n";
+ if ( $RT::DatabaseType eq 'SQLite' ) {
+ return;
+ }
+ elsif ( $RT::DatabaseType eq 'Pg' ) {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName WITH ENCODING='UNICODE'");
+ if ($DBI::errstr) {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName") || die $DBI::errstr;
+ }
+ }
+ elsif ($RT::DatabaseType eq 'Oracle') {
+ insert_acl();
+ }
+ elsif ( $RT::DatabaseType eq 'Informix' ) {
+ $ENV{DB_LOCALE} = 'en_us.utf8';
+ $dbh->do("CREATE DATABASE $RT::DatabaseName WITH BUFFERED LOG");
+ }
+ else {
+ $dbh->do("CREATE DATABASE $RT::DatabaseName") or die $DBI::errstr;
+ }
+}
+
+# }}}
+
+sub get_dba_password {
+ print
+"In order to create a new database and grant RT access to that database,\n";
+ print "this script needs to connect to your "
+ . $RT::DatabaseType
+ . " instance on "
+ . $RT::DatabaseHost . " as "
+ . $args{'dba'} . ".\n";
+ print
+"Please specify that user's database password below. If the user has no database\n";
+ print "password, just press return.\n\n";
+ print "Password: ";
+ ReadMode('noecho');
+ my $password = ReadLine(0);
+ ReadMode('normal');
+ return ($password);
+}
+
+# {{{ sub _yesno
+sub _yesno {
+ print "Proceed [y/N]:";
+ my $x = scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
+# }}}
+
+# {{{ insert_acls
+sub insert_acl {
+
+ my $base_path = (shift || $RT::EtcPath);
+
+ if ( $RT::DatabaseType =~ /^oracle$/i ) {
+ do $base_path . "/acl.Oracle"
+ || die "Couldn't find ACLS for Oracle\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^pg$/i ) {
+ do $base_path . "/acl.Pg" || die "Couldn't find ACLS for Pg\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^mysql$/i ) {
+ do $base_path . "/acl.mysql"
+ || die "Couldn't find ACLS for mysql in " . $RT::EtcPath . "\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^informix$/i ) {
+ do $base_path . "/acl.Informix"
+ || die "Couldn't find ACLS for Informix in " . $RT::EtcPath . "\n" . $@;
+ }
+ elsif ( $RT::DatabaseType =~ /^SQLite$/i ) {
+ return;
+ }
+ else {
+ die "Unknown RT database type";
+ }
+
+ my @acl = acl($dbh);
+ foreach my $statement (@acl) {
+ print STDERR $statement if $args{'debug'};
+ my $sth = $dbh->prepare($statement) or die $dbh->errstr;
+ unless ( $sth->execute ) {
+ die "Problem with statement:\n $statement\n" . $sth->errstr;
+ }
+ }
+}
+
+# }}}
+
+=head2 get_system_dsn
+
+Returns a dsn suitable for database creates and drops
+and user creates and drops
+
+=cut
+
+sub get_system_dsn {
+
+ my $dsn = $Handle->DSN;
+
+ #with mysql, you want to connect sans database to funge things
+ if ( $RT::DatabaseType eq 'mysql' ) {
+ $dsn =~ s/dbname=$RT::DatabaseName//;
+
+ # with postgres, you want to connect to database1
+ }
+ elsif ( $RT::DatabaseType eq 'Pg' ) {
+ $dsn =~ s/dbname=$RT::DatabaseName/dbname=template1/;
+ }
+ elsif ( $RT::DatabaseType eq 'Informix' ) {
+ # with Informix, you want to connect sans database:
+ $dsn =~ s/Informix:$RT::DatabaseName/Informix:/;
+ }
+ return $dsn;
+}
+
+sub insert_initial_data {
+
+ RT::InitLogging();
+
+ #connect to the db, for actual RT work
+ require RT::Handle;
+ $RT::Handle = RT::Handle->new();
+ $RT::Handle->Connect();
+
+ #Put together a current user object so we can create a User object
+ my $CurrentUser = new RT::CurrentUser();
+
+ print "Checking for existing system user ($CurrentUser)...";
+ my $test_user = RT::User->new($CurrentUser);
+ $test_user->Load('RT_System');
+ if ( $test_user->id ) {
+ print "found!\n\nYou appear to have a functional RT database.\n"
+ . "Exiting, so as not to clobber your existing data.\n";
+ exit(-1);
+
+ }
+ else {
+ print "not found. This appears to be a new installation.\n";
+ }
+
+ print "Creating system user...";
+ my $RT_System = new RT::User($CurrentUser);
+
+ my ( $val, $msg ) = $RT_System->_BootstrapCreate(
+ Name => 'RT_System',
+ RealName => 'The RT System itself',
+ Comments =>
+'Do not delete or modify this user. It is integral to RT\'s internal database structures',
+ Creator => '1' );
+
+ unless ($val) {
+ print "$msg\n";
+ exit(1);
+ }
+ print "done.\n";
+ $RT::Handle->Disconnect();
+
+}
+
+# load some sort of data into the database
+
+sub insert_data {
+ my $datafile = shift;
+
+ #Connect to the database and get RT::SystemUser and RT::Nobody loaded
+ RT::Init;
+
+ my $CurrentUser = RT::CurrentUser->new();
+ $CurrentUser->LoadByName('RT_System');
+
+ if ( $datafile eq $RT::EtcPath . "/initialdata" ) {
+
+ print "Creating Superuser ACL...";
+
+ my $superuser_ace = RT::ACE->new($CurrentUser);
+ $superuser_ace->_BootstrapCreate(
+ PrincipalId => ACLEquivGroupId( $CurrentUser->Id ),
+ PrincipalType => 'Group',
+ RightName => 'SuperUser',
+ ObjectType => 'RT::System',
+ ObjectId => '1' );
+
+ }
+
+ # Slurp in stuff to insert from the datafile. Possible things to go in here:-
+ # @groups, @users, @acl, @queues, @ScripActions, @ScripConditions, @templates
+
+ require $datafile
+ || die "Couldn't find initial data for import\n" . $@;
+
+ if (@Groups) {
+ print "Creating groups...";
+ foreach $item (@Groups) {
+ my $new_entry = RT::Group->new($CurrentUser);
+ my ( $return, $msg ) = $new_entry->_Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Users) {
+ print "Creating users...";
+ foreach $item (@Users) {
+ my $new_entry = new RT::User($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Queues) {
+ print "Creating queues...";
+ for $item (@Queues) {
+ my $new_entry = new RT::Queue($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ print "(Error: $msg)" unless ($return);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@ACL) {
+ print "Creating ACL...";
+ for my $item (@ACL) {
+
+ my ($princ, $object);
+
+ # Global rights or Queue rights?
+ if ($item->{'Queue'}) {
+ $object = RT::Queue->new($CurrentUser);
+ $object->Load( $item->{'Queue'} );
+ } else {
+ $object = $RT::System;
+ }
+
+ # Group rights or user rights?
+ if ($item->{'GroupDomain'}) {
+ $princ = RT::Group->new($CurrentUser);
+ if ($item->{'GroupDomain'} eq 'UserDefined') {
+ $princ->LoadUserDefinedGroup( $item->{'GroupId'} );
+ } elsif ($item->{'GroupDomain'} eq 'SystemInternal') {
+ $princ->LoadSystemInternalGroup( $item->{'GroupType'} );
+ } elsif ($item->{'GroupDomain'} eq 'RT::Queue-Role' &&
+ $item->{'Queue'}) {
+ $princ->LoadQueueRoleGroup( Type => $item->{'GroupType'},
+ Queue => $object->id);
+ } else {
+ $princ->Load( $item->{'GroupId'} );
+ }
+ } else {
+ $princ = RT::User->new($CurrentUser);
+ $princ->Load( $item->{'UserId'} );
+ }
+
+ # Grant it
+ my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
+ Right => $item->{'Right'},
+ Object => $object );
+
+ if ($return) {
+ print $return. ".";
+ }
+ else {
+ print $msg . ".";
+
+ }
+
+ }
+ print "done.\n";
+ }
+ if (@CustomFields) {
+ print "Creating custom fields...";
+ for $item (@CustomFields) {
+ my $new_entry = new RT::CustomField($CurrentUser);
+ my $values = $item->{'Values'};
+ delete $item->{'Values'};
+ my $q = $item->{'Queue'};
+ my $q_obj = RT::Queue->new($CurrentUser);
+ $q_obj->Load($q);
+ if ( $q_obj->Id ) {
+ $item->{'Queue'} = $q_obj->Id;
+ }
+ elsif ( $q == 0 ) {
+ $item->{'Queue'} = 0;
+ }
+ else {
+ print "(Error: Could not find queue " . $q . ")\n"
+ unless ( $q_obj->Id );
+ next;
+ }
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+
+ foreach my $value ( @{$values} ) {
+ my ( $eval, $emsg ) = $new_entry->AddValue(%$value);
+ print "(Error: $emsg)\n" unless ($eval);
+ }
+
+ print "(Error: $msg)\n" unless ($return);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@ScripActions) {
+ print "Creating ScripActions...";
+
+ for $item (@ScripActions) {
+ my $new_entry = RT::ScripAction->new($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@ScripConditions) {
+ print "Creating ScripConditions...";
+
+ for $item (@ScripConditions) {
+ my $new_entry = RT::ScripCondition->new($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+
+ print "done.\n";
+ }
+
+ if (@Templates) {
+ print "Creating templates...";
+
+ for $item (@Templates) {
+ my $new_entry = new RT::Template($CurrentUser);
+ my $return = $new_entry->Create(%$item);
+ print $return. ".";
+ }
+ print "done.\n";
+ }
+ if (@Scrips) {
+ print "Creating scrips...";
+
+ for $item (@Scrips) {
+ my $new_entry = new RT::Scrip($CurrentUser);
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ if ($return) {
+ print $return. ".";
+ }
+ else {
+ print "(Error: $msg)\n";
+ }
+ }
+ print "done.\n";
+ }
+ $RT::Handle->Disconnect();
+
+}
+
+=head2 ACLEquivGroupId
+
+Given a userid, return that user's acl equivalence group
+
+=cut
+
+sub ACLEquivGroupId {
+ my $username = shift;
+ my $user = RT::User->new($RT::SystemUser);
+ $user->Load($username);
+ my $equiv_group = RT::Group->new($RT::SystemUser);
+ $equiv_group->LoadACLEquivalenceGroup($user);
+ return ( $equiv_group->Id );
+}
+
+sub help {
+
+ print <<EOF;
+
+$0: Set up RT's database
+
+--action init Initialize the database
+ drop Drop the database.
+ This will ERASE ALL YOUR DATA
+ insert_initial
+ Insert RT's core system objects
+ insert Insert data into RT's database.
+ By default, will use RT's installation data.
+ To use a local or supplementary datafile, specify it
+ using the '--datafile' option below.
+
+ acl Initialize only the database ACLs
+ To use a local or supplementary datafile, specify it
+ using the '--datadir' option below.
+
+ schema Initialize only the database schema
+ To use a local or supplementary datafile, specify it
+ using the '--datadir' option below.
+
+--datafile /path/to/datafile
+--datadir /path/to/ Used to specify a path to find the local
+ database schema and acls to be installed.
+
+
+--dba dba's username
+--dba-password dba's password
+--prompt-for-dba-password Ask for the database administrator's password interactively
+
+
+EOF
+
+}
+
+1;
diff --git a/rt/sbin/rt-test-dependencies b/rt/sbin/rt-test-dependencies
new file mode 100644
index 0000000..c1591b1
--- /dev/null
+++ b/rt/sbin/rt-test-dependencies
@@ -0,0 +1,278 @@
+#!/usr/bin/perl
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+#
+# This is just a basic script that checks to make sure that all
+# the modules needed by RT before you can install it.
+#
+
+use strict;
+no warnings qw(numeric redefine);
+use Getopt::Long;
+use CPAN;
+my %args;
+my %deps;
+GetOptions(\%args,'install', 'with-MYSQL', 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE', 'with-ORACLE', 'with-FASTCGI', 'with-SPEEDYCGI', 'with-MODPERL1', 'with-MODPERL2' ,'with-DEV');
+
+if (!keys %args) {
+ help();
+ exit(0);
+}
+if ($args{'with-MODPERL2'}) {
+ warn_modperl2();
+}
+
+$args{'with-MASON'} = 1;
+$args{'with-CORE'} = 1;
+$args{'with-DEV'} =1;
+$args{'with-CLI'} =1;
+$args{'with-MAILGATE'} =1;
+if ($] < 5.007) {
+$args{'with-I18N-COMPAT'} = 1;
+}
+
+sub warn_modperl2 {
+ print <<'.';
+ NOTE: mod_perl 2.0 isn't quite ready for prime_time just yet;
+ Best Practical Solutions strongly recommends that sites use
+ Apache 1.3 or FastCGI. If you MUST use mod_perl 2.0 (or 1.99),
+ please read the mailing list archives before asking for help.
+.
+ sleep 5;
+}
+
+
+sub help {
+
+ print <<'.';
+
+By default, testdeps determine whether you have
+installed all the perl modules RT needs to run.
+
+ --install Install missing modules
+
+The following switches will tell the tool to check for specific dependencies
+
+ --with-mysql Database interface for MySQL
+ --with-postgresql Database interface for PostgreSQL
+ --with-sqlite Database interface and driver for SQLite (unsupported)
+ --with-oracle Database interface for oracle (unsupported)
+
+ --with-fastcgi Libraries needed to support the fastcgi handler
+ --with-speedycgi Libraries needed to support the speedycgi handler
+ --with-modperl1 Libraries needed to support the modperl 1 handler
+ --with-modperl2 Libraries needed to support the modperl 2 handler
+
+ --with-dev Tools needed for RT development
+.
+}
+
+
+sub _ {
+ map { /(\S+)\s*(\S*)/; $1 => ($2 ? $2 :'') } split ( /\n/, $_[0] );
+}
+
+$deps{'CORE'} = [ _( << '.') ];
+Digest::MD5 2.27
+DBI 1.37
+Test::Inline
+Class::ReturnValue 0.40
+DBIx::SearchBuilder 0.97
+Text::Template
+File::Spec 0.8
+HTML::Entities
+Net::Domain
+Log::Dispatch 2.0
+Locale::Maketext 1.06
+Locale::Maketext::Lexicon 0.32
+Locale::Maketext::Fuzzy
+MIME::Entity 5.108
+Mail::Mailer 1.57
+Net::SMTP
+Text::Wrapper
+Time::ParseDate
+File::Temp
+Term::ReadKey
+Text::Autoformat
+Text::Quoted 1.3
+Scalar::Util
+.
+
+$deps{'MASON'} = [ _( << '.') ];
+Params::Validate 0.02
+Cache::Cache
+Exception::Class
+HTML::Mason 1.16
+MLDBM
+Errno
+FreezeThaw
+Digest::MD5 2.27
+CGI::Cookie 1.20
+Storable 2.08
+Apache::Session 1.53
+.
+
+$deps{'MAILGATE'} = [ _( << '.') ];
+HTML::TreeBuilder
+HTML::FormatText
+Getopt::Long
+LWP::UserAgent
+.
+
+$deps{'CLI'} = [ _( << '.') ];
+Getopt::Long 2.24
+.
+
+$deps{'DEV'} = [ _( << '.') ];
+Regexp::Common
+Time::HiRes
+Test::Inline
+WWW::Mechanize
+.
+
+$deps{'FASTCGI'} = [ _( << '.') ];
+CGI 2.92
+FCGI
+CGI::Fast
+.
+
+$deps{'SPEEDYCGI'} = [ _( << '.') ];
+CGI 2.92
+CGI::SpeedyCGI
+.
+
+
+$deps{'MODPERL1'} = [ _( << '.') ];
+CGI 2.92
+Apache::Request
+Apache::DBI 0.92
+.
+
+$deps{'MODPERL2'} = [ _( << '.') ];
+CGI 2.92
+Apache::DBI
+.
+
+$deps{'I18N-COMPAT'} = [ _( << '.') ];
+Text::Iconv
+Encode::compat 0.04
+.
+
+$deps{'MYSQL'} = [ _( << '.') ];
+DBD::mysql 2.1018
+.
+$deps{'ORACLE'} = [ _( << '.') ];
+DBD::Oracle
+.
+$deps{'POSTGRESQL'} = [ _( << '.') ];
+DBD::Pg
+.
+
+print "perl:\n";
+print "\t5.8.0";
+eval {require 5.008};
+if ($@) {
+print "...missing.\n";
+ eval {require 5.006001};
+ if ($@) {
+ print " RT is known to be non-functional on versions of perl older than 5.6.1. Please upgrade to 5.8.0 or newer";
+ die;
+ } else {
+ print " RT is not supported on perl 5.6.1\n";
+ }
+} else {
+ print "...found\n";
+
+}
+
+
+foreach my $type (keys %args) {
+next unless ($type =~ /^with-(.*?)$/);
+my $type = $1;
+print "$type dependencies:\n";
+ my @deps = (@{$deps{$type}});
+ while (@deps) {
+ my $module = shift @deps;
+ my $version = shift @deps;
+my $ret;
+ $ret =test_dep($module, $version);
+
+if ($args{'install'} && !$ret) {
+ resolve_dep($module);
+}
+}
+}
+sub test_dep {
+ my $module = shift;
+ my $version = shift;
+
+ print "\t$module $version";
+ eval "use $module $version" ;
+ if ($@) {
+ my $error = $@;
+ $error =~ s/\n(.*)$//s;
+ print "...MISSING\n";
+ print "\t\t$error\n" if $error =~ /this is only/;
+
+ return undef;
+ } else {
+ print "...found\n";
+return 1;
+ }
+}
+
+sub resolve_dep {
+ my $module = shift;
+ use CPAN;
+ CPAN::Shell->install($module);
+
+}
+
+
+sub print_help {
+ print << "EOF";
+
+$0 FLAG DBTYPE
+
+
+$0 is a tool for RT that will tell you if you've got all
+the modules RT depends on properly installed.
+
+Flags: (only one flag is valid for a given run)
+
+-quiet will check to see if we've got everything we need
+ and will exit with a return code of (1) if we don't.
+
+-warn will tell you what isn't properly installed
+
+-fix will use CPANPLUS.pm or CPAN.pm to magically make everything better
+
+DBTYPE is one of:
+ oracle, pg, mysql
+
+EOF
+
+ exit(0);
+}
diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in
new file mode 100644
index 0000000..7a15080
--- /dev/null
+++ b/rt/sbin/rt-test-dependencies.in
@@ -0,0 +1,278 @@
+#!@PERL@
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work 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 the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+#
+# This is just a basic script that checks to make sure that all
+# the modules needed by RT before you can install it.
+#
+
+use strict;
+no warnings qw(numeric redefine);
+use Getopt::Long;
+use CPAN;
+my %args;
+my %deps;
+GetOptions(\%args,'install', 'with-MYSQL', 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE', 'with-ORACLE', 'with-FASTCGI', 'with-SPEEDYCGI', 'with-MODPERL1', 'with-MODPERL2' ,'with-DEV');
+
+if (!keys %args) {
+ help();
+ exit(0);
+}
+if ($args{'with-MODPERL2'}) {
+ warn_modperl2();
+}
+
+$args{'with-MASON'} = 1;
+$args{'with-CORE'} = 1;
+$args{'with-DEV'} =1;
+$args{'with-CLI'} =1;
+$args{'with-MAILGATE'} =1;
+if ($] < 5.007) {
+$args{'with-I18N-COMPAT'} = 1;
+}
+
+sub warn_modperl2 {
+ print <<'.';
+ NOTE: mod_perl 2.0 isn't quite ready for prime_time just yet;
+ Best Practical Solutions strongly recommends that sites use
+ Apache 1.3 or FastCGI. If you MUST use mod_perl 2.0 (or 1.99),
+ please read the mailing list archives before asking for help.
+.
+ sleep 5;
+}
+
+
+sub help {
+
+ print <<'.';
+
+By default, testdeps determine whether you have
+installed all the perl modules RT needs to run.
+
+ --install Install missing modules
+
+The following switches will tell the tool to check for specific dependencies
+
+ --with-mysql Database interface for MySQL
+ --with-postgresql Database interface for PostgreSQL
+ --with-sqlite Database interface and driver for SQLite (unsupported)
+ --with-oracle Database interface for oracle (unsupported)
+
+ --with-fastcgi Libraries needed to support the fastcgi handler
+ --with-speedycgi Libraries needed to support the speedycgi handler
+ --with-modperl1 Libraries needed to support the modperl 1 handler
+ --with-modperl2 Libraries needed to support the modperl 2 handler
+
+ --with-dev Tools needed for RT development
+.
+}
+
+
+sub _ {
+ map { /(\S+)\s*(\S*)/; $1 => ($2 ? $2 :'') } split ( /\n/, $_[0] );
+}
+
+$deps{'CORE'} = [ _( << '.') ];
+Digest::MD5 2.27
+DBI 1.37
+Test::Inline
+Class::ReturnValue 0.40
+DBIx::SearchBuilder 0.97
+Text::Template
+File::Spec 0.8
+HTML::Entities
+Net::Domain
+Log::Dispatch 2.0
+Locale::Maketext 1.06
+Locale::Maketext::Lexicon 0.32
+Locale::Maketext::Fuzzy
+MIME::Entity 5.108
+Mail::Mailer 1.57
+Net::SMTP
+Text::Wrapper
+Time::ParseDate
+File::Temp
+Term::ReadKey
+Text::Autoformat
+Text::Quoted 1.3
+Scalar::Util
+.
+
+$deps{'MASON'} = [ _( << '.') ];
+Params::Validate 0.02
+Cache::Cache
+Exception::Class
+HTML::Mason 1.16
+MLDBM
+Errno
+FreezeThaw
+Digest::MD5 2.27
+CGI::Cookie 1.20
+Storable 2.08
+Apache::Session 1.53
+.
+
+$deps{'MAILGATE'} = [ _( << '.') ];
+HTML::TreeBuilder
+HTML::FormatText
+Getopt::Long
+LWP::UserAgent
+.
+
+$deps{'CLI'} = [ _( << '.') ];
+Getopt::Long 2.24
+.
+
+$deps{'DEV'} = [ _( << '.') ];
+Regexp::Common
+Time::HiRes
+Test::Inline
+WWW::Mechanize
+.
+
+$deps{'FASTCGI'} = [ _( << '.') ];
+CGI 2.92
+FCGI
+CGI::Fast
+.
+
+$deps{'SPEEDYCGI'} = [ _( << '.') ];
+CGI 2.92
+CGI::SpeedyCGI
+.
+
+
+$deps{'MODPERL1'} = [ _( << '.') ];
+CGI 2.92
+Apache::Request
+Apache::DBI 0.92
+.
+
+$deps{'MODPERL2'} = [ _( << '.') ];
+CGI 2.92
+Apache::DBI
+.
+
+$deps{'I18N-COMPAT'} = [ _( << '.') ];
+Text::Iconv
+Encode::compat 0.04
+.
+
+$deps{'MYSQL'} = [ _( << '.') ];
+DBD::mysql 2.1018
+.
+$deps{'ORACLE'} = [ _( << '.') ];
+DBD::Oracle
+.
+$deps{'POSTGRESQL'} = [ _( << '.') ];
+DBD::Pg
+.
+
+print "perl:\n";
+print "\t5.8.0";
+eval {require 5.008};
+if ($@) {
+print "...missing.\n";
+ eval {require 5.006001};
+ if ($@) {
+ print " RT is known to be non-functional on versions of perl older than 5.6.1. Please upgrade to 5.8.0 or newer";
+ die;
+ } else {
+ print " RT is not supported on perl 5.6.1\n";
+ }
+} else {
+ print "...found\n";
+
+}
+
+
+foreach my $type (keys %args) {
+next unless ($type =~ /^with-(.*?)$/);
+my $type = $1;
+print "$type dependencies:\n";
+ my @deps = (@{$deps{$type}});
+ while (@deps) {
+ my $module = shift @deps;
+ my $version = shift @deps;
+my $ret;
+ $ret =test_dep($module, $version);
+
+if ($args{'install'} && !$ret) {
+ resolve_dep($module);
+}
+}
+}
+sub test_dep {
+ my $module = shift;
+ my $version = shift;
+
+ print "\t$module $version";
+ eval "use $module $version" ;
+ if ($@) {
+ my $error = $@;
+ $error =~ s/\n(.*)$//s;
+ print "...MISSING\n";
+ print "\t\t$error\n" if $error =~ /this is only/;
+
+ return undef;
+ } else {
+ print "...found\n";
+return 1;
+ }
+}
+
+sub resolve_dep {
+ my $module = shift;
+ use CPAN;
+ CPAN::Shell->install($module);
+
+}
+
+
+sub print_help {
+ print << "EOF";
+
+$0 FLAG DBTYPE
+
+
+$0 is a tool for RT that will tell you if you've got all
+the modules RT depends on properly installed.
+
+Flags: (only one flag is valid for a given run)
+
+-quiet will check to see if we've got everything we need
+ and will exit with a return code of (1) if we don't.
+
+-warn will tell you what isn't properly installed
+
+-fix will use CPANPLUS.pm or CPAN.pm to magically make everything better
+
+DBTYPE is one of:
+ oracle, pg, mysql
+
+EOF
+
+ exit(0);
+}
generated by cgit v1.1 at 2024-06-26 10:02:38 +0000