diff options
Diffstat (limited to 'rt/sbin')
| -rw-r--r-- | rt/sbin/extract-message-catalog | 274 | ||||
| -rw-r--r-- | rt/sbin/extract_pod_tests | 159 | ||||
| -rw-r--r-- | rt/sbin/factory | 515 | ||||
| -rw-r--r-- | rt/sbin/license_tag | 243 | ||||
| -rw-r--r-- | rt/sbin/regression_harness | 56 | ||||
| -rwxr-xr-x | rt/sbin/rt-dump-database.in | 173 | ||||
| -rw-r--r-- | rt/sbin/rt-setup-database.in | 712 | ||||
| -rw-r--r-- | rt/sbin/rt-test-dependencies.in | 479 |
8 files changed, 2611 insertions, 0 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog new file mode 100644 index 000000000..34d44ed66 --- /dev/null +++ b/rt/sbin/extract-message-catalog @@ -0,0 +1,274 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED 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|\.svn' ); + 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 "(.*)"\s*?$/$1/ms or warn "$msgid in $file"; + $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr in $file"; + + $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{$_}; + + + + next if (!$f && $_ && !$Lexicon{$_}); + 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..616560b02 --- /dev/null +++ b/rt/sbin/extract_pod_tests @@ -0,0 +1,159 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED 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; +} + + +print $outfh <<EOF; + +use Test::More qw/no_plan/; +use RT; +RT::LoadConfig(); +RT::Init(); + +EOF +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..f72a29675 --- /dev/null +++ b/rt/sbin/factory @@ -0,0 +1,515 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +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 BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED 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) { + $table =~ s/\`//g; + next if ($table eq 'sessions'); + $table = ucfirst($table); + $table =~ s/field/Field/; + $table =~ s/group/Group/; + $table =~ s/custom/Custom/; + $table =~ s/member/Member/; + $table =~ s/Scripaction/ScripAction/g; + $table =~ s/condition/Condition/g; + $table =~ s/value/Value/; + $table =~ s/Acl/ACL/g; + $tablemap{$table} = $table; + $modulemap{$table} = $table; + if ( $table =~ /^(.*)s$/ ) { + $tablemap{$1} = $table; + $modulemap{$1} = $1; + } +} +$tablemap{'CreatedBy'} = 'User'; +$tablemap{'UpdatedBy'} = 'User'; + +my %typemap; +$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 $RecordInit = ""; + my %fields; + + + my $introspection = $dbh->prepare("SELECT * from $table where id is null"); + $introspection->execute(); + my @names =@{ $introspection->{'NAME'}}; + my @types = @{$introspection->{'TYPE'}}; + my @is_blob = @{$introspection->{'mysql_is_blob'}}; + my @is_num = @{$introspection->{'mysql_is_num'}}; + + my %blobness = (); + my %sqltypes = (); + my %numeric = (); + foreach my $name (@names) { + $sqltypes{$name} = shift @types; + $blobness{$name} = (shift @is_blob || "0"); + $numeric{$name} = (shift @is_num || "0"); + } + + + 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'}; + my $length = 0; + if ($type =~ /^(?:.*?)\((\d+)\)$/) { + $length = $1; + } + $fields{$field} = 1; + + #generate the 'accessible' datastructure + + no warnings 'uninitialized'; + + 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 .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, "; + $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 ( exists $typemap{$field} && ( $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"; + + } + + } + + my $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 SortOrder + \$self->OrderByCols( + { ALIAS => 'main', + FIELD => 'SortOrder', + ORDER => 'ASC' }, + { ALIAS => 'main', + FIELD => 'id', + 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 _CoreAccessible { + { + +$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. + +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..ed1d4eb64 --- /dev/null +++ b/rt/sbin/license_tag @@ -0,0 +1,243 @@ +#!/usr/bin/perl + + +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +my $LICENSE = <<'EOL'; + +COPYRIGHT: + +This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC + <jesse@bestpractical.com> + +(Except where explicitly superseded by other copyright notices) + + +LICENSE: + +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. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301 or visit their web page on the internet at +http://www.gnu.org/copyleft/gpl.html. + + +CONTRIBUTION SUBMISSION POLICY: + +(The following paragraph is not intended to limit the rights granted +to you to modify and distribute this software under the terms of +the GNU General Public License and is only of importance to you if +you choose to contribute your changes and enhancements to the +community by submitting them to Best Practical Solutions, LLC.) + +By intentionally submitting any modifications, corrections or +derivatives to this work, or any other work intended for use with +Request Tracker, to Best Practical Solutions, LLC, you confirm that +you are the copyright holder for those contributions and you grant +Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +royalty-free, perpetual, license to use, copy, create derivative +works based on those contributions, and sublicense and distribute +those contributions and any derivatives thereof. + +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 BPS TAGGED BLOCK {{{/ms) { + print "has license section"; + $file =~ s/^%# BEGIN BPS TAGGED BLOCK {{{(.*?)%# END BPS TAGGED BLOCK }}}/%# BEGIN BPS TAGGED BLOCK {{{\n$pmlic%# END BPS TAGGED BLOCK }}}/ms; + + + } else { + print "no license section"; + $file ="%# BEGIN BPS TAGGED BLOCK {{{\n$pmlic%# END BPS TAGGED BLOCK }}}\n". $file; + } + $file =~ s/%# END BPS TAGGED BLOCK }}}(\n+)/%# END BPS TAGGED 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 BPS TAGGED BLOCK {{{/ms) { + print "has license section"; + $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}/ms; + + + } else { + print "no license section"; + $file ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}\n". $file; + } + $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED 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/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 BPS TAGGED BLOCK {{{/ms) { + print "has license section"; + $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}/ms; + + + } else { + print "no license section"; + $file ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}\n". $file; + } + $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED 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 BPS TAGGED BLOCK {{{/ms) { + print "has license section"; + $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}/ms; + + + } else { + print "no license section"; + if ($file =~ /^(#!.*?)\n/) { + + my $lic ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic# END BPS TAGGED BLOCK }}}\n"; + $file =~ s/^(#!.*?)\n/$1\n$lic/; + + } + } + $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED BLOCK }}}\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..1e97a2978 --- /dev/null +++ b/rt/sbin/regression_harness @@ -0,0 +1,56 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED 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-dump-database.in b/rt/sbin/rt-dump-database.in new file mode 100755 index 000000000..734e00b77 --- /dev/null +++ b/rt/sbin/rt-dump-database.in @@ -0,0 +1,173 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; + +use lib "@LOCAL_LIB_PATH@"; +use lib "@RT_LIB_PATH@"; + +use RT; +use XML::Simple; + +RT::LoadConfig(); +RT::Init(); + +my $LocalOnly = @ARGV ? shift(@ARGV) : 1; + +my %RV; +my %Ignore = ( + All => [qw( + id Created Creator LastUpdated LastUpdatedBy + )], + Templates => [qw( + TranslationOf + )], +); + +my $SystemUserId = $RT::SystemUser->Id; +my @classes = qw( + Users Groups Queues ScripActions ScripConditions + Templates Scrips ACL CustomFields +); +foreach my $class (@classes) { + require "RT/$class.pm"; + my $objects = "RT::$class"->new($RT::SystemUser); + $objects->{find_disabled_rows} = 1; + $objects->UnLimit; + + if ($class eq 'CustomFields') { + $objects->OrderByCols( + { FIELD => 'LookupType' }, + { FIELD => 'SortOrder' }, + { FIELD => 'Id' }, + ); + } + else { + $objects->OrderBy( FIELD => 'Id' ); + } + + if ($LocalOnly) { + next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX + $objects->Limit( FIELD => 'LastUpdatedBy', OPERATOR => '!=', VALUE => $SystemUserId ) + unless $class eq 'Groups'; + $objects->Limit( FIELD => 'Id', OPERATOR => '!=', VALUE => $SystemUserId ) + if $class eq 'Users'; + $objects->Limit( FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined' ) + if $class eq 'Groups'; + } + + my %fields; + while (my $obj = $objects->Next) { + next if $obj->can('LastUpdatedBy') and $obj->LastUpdatedBy == $SystemUserId; + + if (!%fields) { + %fields = map { $_ => 1 } keys %{$obj->_ClassAccessible}; + delete @fields{ + @{$Ignore{$class}||=[]}, + @{$Ignore{All}||=[]}, + }; + } + + my $rv; + # next if $obj-> # skip default names + foreach my $field (sort keys %fields) { + my $value = $obj->__Value($field); + $rv->{$field} = $value if length($value); + } + delete $rv->{Disabled} unless $rv->{Disabled}; + + foreach my $record (map { /ACL/ ? 'ACE' : substr($_, 0, -1) } @classes) { + foreach my $key (map "$record$_", ('', 'Id')) { + next unless exists $rv->{$key}; + my $id = $rv->{$key} or next; + my $obj = "RT::$record"->new($RT::SystemUser); + $obj->LoadByCols( Id => $id ) or next; + $rv->{$key} = $obj->__Value('Name') || 0; + } + } + + if ($class eq 'Users' and defined $obj->Privileged) { + $rv->{Privileged} = int($obj->Privileged); + } + elsif ($class eq 'CustomFields') { + my $values = $obj->Values; + while (my $value = $values->Next) { + push @{$rv->{Values}}, { + map { ($_ => $value->__Value($_)) } qw( + Name Description SortOrder + ), + }; + } + } + + if (eval { require RT::Attributes; 1 }) { + my $attributes = $obj->Attributes; + while (my $attribute = $attributes->Next) { + my $content = $attribute->Content; + $rv->{Attributes}{$attribute->Name} = $content if length($content); + } + } + + push @{$RV{$class}}, $rv; + } +} + +print(<< "."); +no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw( + @classes Values +)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml +__DATA__ +. + +print XMLout( + { map { ($_ => ($RV{$_} || [])) } @classes }, + RootName => 'InitialData', + NoAttr => 1, + SuppressEmpty => '', + XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>', +); diff --git a/rt/sbin/rt-setup-database.in b/rt/sbin/rt-setup-database.in new file mode 100644 index 000000000..cf607e286 --- /dev/null +++ b/rt/sbin/rt-setup-database.in @@ -0,0 +1,712 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item); +use vars + qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips @Attributes); + +use lib "@LOCAL_LIB_PATH@"; +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' +); + +unless ( $args{'action'} ) { + help(); + exit(-1); +} + +$| = 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'} ); +} + +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"; + } + + if ( $RT::DatabaseType eq "mysql" ) { + # Check which version we're running + my ($version) = $dbh->selectrow_hashref("show variables like 'version'")->{Value} =~ /^(\d\.\d+)/; + print "*** Warning: RT is unsupported on MySQL versions before 4.0.x\n" if $version < 4; + + # MySQL must have InnoDB support + my $innodb = $dbh->selectrow_hashref("show variables like 'have_innodb'")->{Value}; + if ( $innodb eq "NO" ) { + die "RT requires that MySQL be compiled with InnoDB table support.\n". + "See http://dev.mysql.com/doc/mysql/en/InnoDB.html\n"; + } elsif ( $innodb eq "DISABLED" ) { + die "RT requires that MySQL InnoDB table support be enabled.\n". + ($version < 4 + ? "Add 'innodb_data_file_path=ibdata1:10M:autoextend' to the [mysqld] section of my.cnf\n" + : "Remove the 'skip-innodb' line from your my.cnf file, restart MySQL, and try again.\n"); + } + } + + # SQLite can't deal with the disconnect/reconnect + unless ( $RT::DatabaseType eq 'SQLite' ) { + + $dbh->disconnect; + + if ( $RT::DatabaseType eq "Oracle" ) { + $RT::DatabasePassword = $RT::DatabasePassword; #Warning avidance + $dbh = DBI->connect( $Handle->DSN, ${RT::DatabaseUser}, ${RT::DatabasePassword} ) || die $DBI::errstr; + } else { + $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; + } + drop_db(); +} +elsif ( $args{'action'} eq 'insert_initial' ) { + insert_initial_data(); +} +elsif ( $args{'action'} eq 'insert' ) { + insert_data( $args{'datafile'} || ($args{'datadir'}."/content") ); +} +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\n"; + exit(-1); +} + +# {{{ sub insert_schema +sub insert_schema { + my $base_path = (shift || $RT::EtcPath); + my (@schema); + print "Creating database schema.\n"; + + my $schema_file = $base_path . "/schema." . $RT::DatabaseType; + if ( -f $schema_file ) { + open( SCHEMA, "<$schema_file" ) or die "Can't open $schema_file: $!"; + my @lines = <SCHEMA>; + + my $local_schema_file = $RT::LocalEtcPath . "/schema." . $RT::DatabaseType; + if (-f $local_schema_file) { + open( SCHEMA_LOCAL, "<$local_schema_file" ) + or die "Can't open $local_schema_file: $!"; + push @lines, ';;', <SCHEMA_LOCAL>; + } + + my $statement = ""; + foreach my $line (@lines) { + $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. + $dbh->begin_work or die $dbh->errstr; + 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; + } + } + $dbh->commit or die $dbh->errstr; + } + else { + die "Couldn't find schema file for " . $RT::DatabaseType . "\n"; + } + print "Done setting up database schema.\n"; +} + +# }}} + +# {{{ sub drop_db +sub drop_db { + 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"; + + if ( $RT::DatabaseType eq 'SQLite' ) { + unlink $RT::DatabaseName or warn $!; + return; + } + $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 or update your RT database,"; + 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'); + print "\n"; + 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 $base_path\n" . $@; + } + elsif ( $RT::DatabaseType =~ /^Sybase$/i ) { + do $base_path . "/acl.Sybase" + || die "Couldn't find ACLS for Sybase in $base_path\n" . $@; + } + elsif ( $RT::DatabaseType =~ /^informix$/i ) { + do $base_path . "/acl.Informix" + || die "Couldn't find ACLS for Informix in $base_path\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; + } + } + print "Done setting up database ACLs.\n"; +} + +# }}} + +=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..."; + 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', + LastUpdatedBy => '1', + ); + + unless ( $val ) { + print "$msg\n"; + exit(-1); + } + print "done.\n"; + $RT::Handle->Disconnect() unless $RT::DatabaseType eq 'SQLite'; + +} + +# 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' ); + + print "done.\n"; + } + + # 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::System-Role' ) { + $princ->LoadSystemRoleGroup( $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 ( $return, $msg ) = $new_entry->Create(%$item); + unless( $return ) { + print "(Error: $msg)\n"; + next; + } + + foreach my $value ( @{$values} ) { + my ( $eval, $emsg ) = $new_entry->AddValue(%$value); + print "(Error: $emsg)\n" unless $eval; + } + + if ( $item->{LookupType} && !exists $item->{'Queue'} ) { # enable by default + my $ocf = RT::ObjectCustomField->new($CurrentUser); + $ocf->Create( CustomField => $new_entry->Id ); + } + + 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,$msg) = $new_entry->Create(%$item); + unless ($return) { + print "(Error: $msg)\n"; + next; + } + print $return. "."; + } + + print "done.\n"; + } + + if ( @ScripConditions ) { + print "Creating ScripConditions..."; + + for $item (@ScripConditions) { + my $new_entry = RT::ScripCondition->new($CurrentUser); + my ($return,$msg) = $new_entry->Create(%$item); + unless ($return) { + print "(Error: $msg)\n"; + next; + } + 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"; + } + if ( @Attributes ) { + print "Creating predefined searches..."; + my $sys = RT::System->new($CurrentUser); + + for $item (@Attributes) { + my $obj = delete $item->{Object}; # XXX: make this something loadable + $obj ||= $sys; + my ( $return, $msg ) = $obj->AddAttribute (%$item); + if ( $return ) { + print $return. "."; + } + else { + print "(Error: $msg)\n"; + } + } + print "done.\n"; + } + $RT::Handle->Disconnect() unless $RT::DatabaseType eq 'SQLite'; + print "Done setting up database content.\n"; +} + +=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.in b/rt/sbin/rt-test-dependencies.in new file mode 100644 index 000000000..ea6b9d154 --- /dev/null +++ b/rt/sbin/rt-test-dependencies.in @@ -0,0 +1,479 @@ +#!@PERL@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC +# <jesse@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# 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. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED 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; +my %args; +my %deps; +GetOptions( + \%args, 'v|verbose', + 'install', 'with-MYSQL', + 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE', + 'with-ORACLE', 'with-FASTCGI', + 'with-SPEEDYCGI', 'with-MODPERL1', + 'with-MODPERL2', 'with-DEV', + 'with-STANDALONE', + 'download=s', + 'repository=s' +); + +unless (keys %args) { + help(); + exit(0); +} +# Set up defaults +my %default = ( + 'with-MASON' => 1, + 'with-CORE' => 1, + 'with-CLI' => 1, + 'with-MAILGATE' => 1, + 'with-DEV' => @RT_DEVEL_MODE@, + 'with-STANDALONE' => @RT_STANDALONE@, +); +$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default; + + +{ + my $section; + my %always_show_sections = ( + perl => 1, + users => 1, + ); + + sub section { + my $s = shift; + $section = $s; + print "$s:\n"; + } + + my $any_missing = 0; + sub found { + my $msg = shift; + my $test = shift; + my $extra = shift; + + $any_missing = 1 unless $test; + if ($args{'v'} or not $test or $always_show_sections{$section}) { + print "\t$msg..."; + print $test ? "found" : "MISSING"; + print "\n"; + } + + print "\t\t$extra\n" if defined $extra; + } + + sub conclude { + if ($any_missing) { + print "\nSOMETHING WAS MISSING!\n"; + } else { + print "\nEverything was found.\n"; + } + } +} + +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-standalone Libraries needed to support the standalone simple pure perl server + --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 + +You can also specify -v or --verbose to list the status of all dependencies, +rather than just the missing ones. + +The "RT_FIX_DEPS_CMD" environment variable, if set, will be used +instead of the standard CPAN shell by --install to install any +required modules. It will be called with the module name, or, if +"RT_FIX_DEPS_CMD" contains a "%s", will replace the "%s" with the +module name before calling the program. +. +} + + +sub text_to_hash { + my %hash; + for my $line ( split /\n/, $_[0] ) { + my($key, $value) = $line =~ /(\S+)\s*(\S*)/; + $value ||= ''; + $hash{$key} = $value; + } + + return %hash; +} + +$deps{'CORE'} = [ text_to_hash( << '.') ]; +Digest::base +Digest::MD5 2.27 +DBI 1.37 +Class::ReturnValue 0.40 +Date::Format +DBIx::SearchBuilder 1.50 +Text::Template +File::Spec 0.8 +HTML::Entities +HTML::Scrubber 0.08 +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 +Time::HiRes +File::Temp +Text::Autoformat +Text::Quoted 2.02 +Tree::Simple 1.04 +Regexp::Common +Scalar::Util +Module::Versions::Report 1.03 +Cache::Simple::TimedExpiry +UNIVERSAL::require +Calendar::Simple +CSS::Squish 0.06 +. + +$deps{'MASON'} = [ text_to_hash( << '.') ]; +HTML::Mason 1.23 +Errno +Digest::MD5 2.27 +CGI::Cookie 1.20 +Storable 2.08 +Apache::Session 1.53 +XML::RSS 1.05 +GD +GD::Graph +GD::Text +Text::WikiFormat 0.76 +CSS::Squish 0.06 +. + +$deps{'STANDALONE'} = [ text_to_hash( << '.') ]; +HTTP::Server::Simple 0.07 +HTTP::Server::Simple::Mason 0.09 +. + +$deps{'MAILGATE'} = [ text_to_hash( << '.') ]; +HTML::TreeBuilder +HTML::FormatText +Getopt::Long +LWP::UserAgent +Pod::Usage +. + +$deps{'CLI'} = [ text_to_hash( << '.') ]; +Getopt::Long 2.24 +LWP +HTTP::Request::Common +Text::ParseWords +Term::ReadLine +Term::ReadKey +. + +$deps{'DEV'} = [ text_to_hash( << '.') ]; +Test::Inline +Apache::Test +HTML::Form +HTML::TokeParser +WWW::Mechanize +Test::WWW::Mechanize 1.04 +Module::Refresh 0.03 +Test::Expect 0.30 +XML::Simple +File::Find +. + +$deps{'FASTCGI'} = [ text_to_hash( << '.') ]; +CGI 2.92 +FCGI +CGI::Fast +. + +$deps{'SPEEDYCGI'} = [ text_to_hash( << '.') ]; +CGI 2.92 +CGI::SpeedyCGI +. + + +$deps{'MODPERL1'} = [ text_to_hash( << '.') ]; +CGI 2.92 +Apache::Request +Apache::DBI 0.92 +. + +$deps{'MODPERL2'} = [ text_to_hash( << '.') ]; +CGI 2.92 +Apache::DBI +HTML::Mason 1.31 +. + +$deps{'MYSQL'} = [ text_to_hash( << '.') ]; +DBD::mysql 2.1018 +. +$deps{'ORACLE'} = [ text_to_hash( << '.') ]; +DBD::Oracle +. +$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ]; +DBD::Pg 1.43 +. + +$deps{'SQLITE'} = [ text_to_hash( << '.') ]; +DBD::SQLite 1.00 +. + +if ($args{'download'}) { + + download_mods(); +} + + +check_perl_version(); + +check_users(); + + +foreach my $type (sort grep $args{$_}, keys %args) { + next unless ($type =~ /^with-(.*?)$/); + + $type = $1; + section("$type dependencies"); + + my @missing; + my @deps = @{ $deps{$type} }; + while (@deps) { + my $module = shift @deps; + my $version = shift @deps; + my $ret = test_dep($module, $version); + + push @missing, $module, $version unless $ret; + } + if ( $args{'install'} ) { + while( @missing ) { + resolve_dep(shift @missing, shift @missing); + } + } +} + +conclude(); + +sub test_dep { + my $module = shift; + my $version = shift; + + eval "use $module $version ()"; + if ($@) { + my $error = $@; + $error =~ s/\n(.*)$//s; + undef $error unless $error =~ /this is only/; + found("$module $version", 0, $error); + + return undef; + } else { + my $msg = "$module"; + $msg .= " >=$version" if $version; + found($msg, 1); + return 1; + } +} + +sub resolve_dep { + my $module = shift; + my $version = shift; + + print "\nInstall module $module\n"; + + my $ext = $ENV{'RT_FIX_DEPS_CMD'}; + unless( $ext ) { + my $configured = 1; + { + local @INC = @INC; + if ( $ENV{'HOME'} ) { + unshift @INC, "$ENV{'HOME'}/.cpan"; + } + $configured = eval { require CPAN::MyConfig } || eval { require CPAN::Config }; + } + unless ( $configured ) { + print <<END; +You didn't configure CPAN shell yet. +Please run `@PERL@ -MCPAN -e shell` tool and configure it. +END + exit(1); + } + my $rv = eval { require CPAN; CPAN::Shell->install($module) }; + return $rv unless $@; + + print <<END; +Failed to load module CPAN. + +-------- Error --------- +$@ +------------------------ + +When we tried to start installing RT's perl dependencies, +we were unable to load the CPAN client. This module is usually distributed +with Perl. This usually indicates that your vendor has shipped an unconfigured +or incorrectly configured CPAN client. +The error above may (or may not) give you a hint about what went wrong + +You have several choices about how to install dependencies in +this situatation: + +1) use a different tool to install dependencies by running setting the following + shell environment variable and rerunning this tool: + RT_FIX_DEPS_CMD='@PERL@ -MCPAN -e"install %s"' +2) Attempt to configure CPAN by running: + `@PERL@ -MCPAN -e shell` program from shell. + If this fails, you may have to manually upgrade CPAN (see below) +3) Try to update the CPAN client. Download it from: + http://search.cpan.org/dist/CPAN and try again +4) Install each dependency manually by downloading them one by one from + http://search.cpan.org + +END + exit(1); + } + + if( $ext =~ /\%s/) { + $ext =~ s/\%s/$module/g; # sprintf( $ext, $module ); + } else { + $ext .= " $module"; + } + print "\t\tcommand: '$ext'\n"; + return scalar `$ext 1>&2`; +} + +sub download_mods { + my %modules; + use CPAN; + + foreach my $key (keys %deps) { + my @deps = (@{$deps{$key}}); + while (@deps) { + my $mod = shift @deps; + my $ver = shift @deps; + next if ($mod =~ /^(DBD-|Apache-Request)/); + $modules{$mod} = $ver; + } + } + my @mods = keys %modules; + CPAN::get(); + my $moddir = $args{'download'}; + foreach my $mod (@mods) { + $CPAN::Config->{'build_dir'} = $moddir; + CPAN::get($mod); + } + + opendir(DIR, $moddir); + while ( my $dir = readdir(DIR)) { + print "Dir is $dir\n"; + next if ( $dir =~ /^\.\.?$/); + + # Skip things we've previously tagged + my $out = `svn ls $args{'repository'}/tags/$dir`; + next if ($out); + + if ($dir =~ /^(.*)-(.*?)$/) { + `svn_load_dirs -no_user_input -t tags/$dir -v $args{'repository'} dists/$1 $moddir/$dir`; + `rm -rf $moddir/$dir`; + + } + + } + closedir(DIR); + exit; +} + +sub check_perl_version { + section("perl"); + eval {require 5.008003}; + if ($@) { + found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer."); + exit(1); + } else { + found( ">=5.8.3($])", 1); + } +} + +sub check_users { + section("users"); + found("rt group (@RTGROUP@)", defined getgrnam("@RTGROUP@")); + found("bin owner (@BIN_OWNER@)", defined getpwnam("@BIN_OWNER@")); + found("libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@")); + found("libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@")); + found("web owner (@WEB_USER@)", defined getpwnam("@WEB_USER@")); + found("web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@")); +} + + + +1; |