diff options
Diffstat (limited to 'rt/sbin')
| -rw-r--r-- | rt/sbin/extract-message-catalog | 246 | ||||
| -rw-r--r-- | rt/sbin/extract_pod_tests | 129 | ||||
| -rw-r--r-- | rt/sbin/factory | 427 | ||||
| -rw-r--r-- | rt/sbin/license_tag | 196 | ||||
| -rw-r--r-- | rt/sbin/regression_harness | 33 | ||||
| -rw-r--r-- | rt/sbin/rt-setup-database | 585 | ||||
| -rw-r--r-- | rt/sbin/rt-setup-database.in | 585 | ||||
| -rw-r--r-- | rt/sbin/rt-test-dependencies | 246 | ||||
| -rw-r--r-- | rt/sbin/rt-test-dependencies.in | 246 |
9 files changed, 2693 insertions, 0 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog new file mode 100644 index 000000000..af7b2c733 --- /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 => 0 }, '.' ); + +# 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 000000000..ed01c7dc2 --- /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 000000000..8abb1922f --- /dev/null +++ b/rt/sbin/factory @@ -0,0 +1,427 @@ +#!/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 000000000..33da2e026 --- /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 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 $LICENSE = <<EOL; + +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. + + +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'); +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 000000000..fc1e29304 --- /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 000000000..f84f290b7 --- /dev/null +++ b/rt/sbin/rt-setup-database @@ -0,0 +1,585 @@ +#!/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"; + create_db(); + + $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(); + 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' ) { + 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; + $statement .= $line; + if ( $line =~ /;(\s*)$/ ) { + $statement =~ s/;(\s*)$//g; + push @schema, $statement; + $statement = ""; + } + } + + foreach my $statement (@schema) { + 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; + } + } + + } + 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' ); + 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; + } + } + 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 =~ /^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/; + } + 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..."; + 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->dbh->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 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 000000000..e49a32ed9 --- /dev/null +++ b/rt/sbin/rt-setup-database.in @@ -0,0 +1,585 @@ +#!@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"; + create_db(); + + $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(); + 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' ) { + 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; + $statement .= $line; + if ( $line =~ /;(\s*)$/ ) { + $statement =~ s/;(\s*)$//g; + push @schema, $statement; + $statement = ""; + } + } + + foreach my $statement (@schema) { + 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; + } + } + + } + 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' ); + 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; + } + } + 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 =~ /^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/; + } + 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..."; + 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->dbh->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 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 000000000..637d33a32 --- /dev/null +++ b/rt/sbin/rt-test-dependencies @@ -0,0 +1,246 @@ +#!/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); +} +$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 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 +DBI 1.18 +Test::Inline +Class::ReturnValue 0.40 +DBIx::SearchBuilder 0.86 +Text::Template +File::Spec 0.8 +HTML::Entities +Net::Domain +Log::Dispatch 2.0 +Locale::Maketext 1.04 +Locale::Maketext::Lexicon 0.25 +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 +. + +$deps{'MASON'} = [ _( << '.') ]; +Params::Validate 0.02 +Cache::Cache +Exception::Class +HTML::Mason 1.16 +MLDBM +Errno +FreezeThaw +Digest::MD5 +CGI::Cookie 1.20 +Storable +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 +FCGI +CGI::Fast +. + +$deps{'SPEEDYCGI'} = [ _( << '.') ]; +CGI +CGI::SpeedyCGI +. + + +$deps{'MODPERL1'} = [ _( << '.') ]; +CGI +Apache::Request +Apache::DBI +. + +$deps{'MODPERL2'} = [ _( << '.') ]; +CGI 2.89 +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 +. + + +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 000000000..6951290c4 --- /dev/null +++ b/rt/sbin/rt-test-dependencies.in @@ -0,0 +1,246 @@ +#!@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); +} +$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 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 +DBI 1.18 +Test::Inline +Class::ReturnValue 0.40 +DBIx::SearchBuilder 0.86 +Text::Template +File::Spec 0.8 +HTML::Entities +Net::Domain +Log::Dispatch 2.0 +Locale::Maketext 1.04 +Locale::Maketext::Lexicon 0.25 +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 +. + +$deps{'MASON'} = [ _( << '.') ]; +Params::Validate 0.02 +Cache::Cache +Exception::Class +HTML::Mason 1.16 +MLDBM +Errno +FreezeThaw +Digest::MD5 +CGI::Cookie 1.20 +Storable +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 +FCGI +CGI::Fast +. + +$deps{'SPEEDYCGI'} = [ _( << '.') ]; +CGI +CGI::SpeedyCGI +. + + +$deps{'MODPERL1'} = [ _( << '.') ]; +CGI +Apache::Request +Apache::DBI +. + +$deps{'MODPERL2'} = [ _( << '.') ]; +CGI 2.89 +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 +. + + +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); +} |