diff options
Diffstat (limited to 'rt/sbin')
| -rw-r--r-- | rt/sbin/extract-message-catalog | 272 | ||||
| -rw-r--r-- | rt/sbin/extract_pod_tests | 157 | ||||
| -rw-r--r-- | rt/sbin/factory | 513 | ||||
| -rw-r--r-- | rt/sbin/license_tag | 239 | ||||
| -rw-r--r-- | rt/sbin/regression_harness | 54 | ||||
| -rwxr-xr-x | rt/sbin/rt-dump-database.in | 168 | ||||
| -rw-r--r-- | rt/sbin/rt-setup-database.in | 678 | ||||
| -rw-r--r-- | rt/sbin/rt-test-dependencies.in | 377 |
8 files changed, 2458 insertions, 0 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog new file mode 100644 index 000000000..3552afb81 --- /dev/null +++ b/rt/sbin/extract-message-catalog @@ -0,0 +1,272 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +# 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..4d9d7bd6c --- /dev/null +++ b/rt/sbin/extract_pod_tests @@ -0,0 +1,157 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +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..743d8b90e --- /dev/null +++ b/rt/sbin/factory @@ -0,0 +1,513 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +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..906d34924 --- /dev/null +++ b/rt/sbin/license_tag @@ -0,0 +1,239 @@ +#!/usr/bin/perl + + +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 $LICENSE = <<'EOL'; + +COPYRIGHT: + +This software is Copyright (c) 1996-2005 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. + +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..d98e462c7 --- /dev/null +++ b/rt/sbin/regression_harness @@ -0,0 +1,54 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +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..bcc7bb713 --- /dev/null +++ b/rt/sbin/rt-dump-database.in @@ -0,0 +1,168 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +use strict; +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..49feba845 --- /dev/null +++ b/rt/sbin/rt-setup-database.in @@ -0,0 +1,678 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +use strict; +use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item); +use vars + qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips); + +use lib "@RT_LIB_PATH@"; + +#This drags in RT's config.pm +# We do it in a begin block because RT::Handle needs to know the type to do its +# inheritance +use RT; +use Carp; +use RT::User; +use RT::CurrentUser; +use RT::Template; +use RT::ScripAction; +use RT::ACE; +use RT::Group; +use RT::User; +use RT::Queue; +use RT::ScripCondition; +use RT::CustomField; +use RT::Scrip; + +RT::LoadConfig(); +use Term::ReadKey; +use Getopt::Long; + +my %args; + +GetOptions( + \%args, + 'prompt-for-dba-password', 'force', 'debug', + 'action=s', 'dba=s', 'dba-password=s', 'datafile=s', + 'datadir=s' +); + +$| = 1; #unbuffer that output. + +require RT::Handle; +my $Handle = RT::Handle->new($RT::DatabaseType); +$Handle->BuildDSN; +my $dbh; + +if ( $args{'prompt-for-dba-password'} ) { + $args{'dba-password'} = get_dba_password(); + chomp( $args{'dba-password'} ); +} + +unless ( $args{'action'} ) { + help(); + die; +} +if ( $args{'action'} eq 'init' ) { + $dbh = DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) + || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr"; + print "Now creating a database for RT.\n"; + if ($RT::DatabaseType ne 'Oracle' || + $args{'dba'} ne $RT::DatabaseUser) { + create_db(); + } else { + print "...skipped as ".$args{'dba'} ." is not " . $RT::DatabaseUser . " or we're working with Oracle.\n"; + } + + 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; + $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} ) || die $DBI::errstr; + } + print "Now populating database schema.\n"; + insert_schema(); + print "Now inserting database ACLs\n"; + insert_acl() unless ($RT::DatabaseType eq 'Oracle'); + print "Now inserting RT core system objects\n"; + insert_initial_data(); + print "Now inserting RT data\n"; + insert_data( $RT::EtcPath . "/initialdata" ); +} +elsif ( $args{'action'} eq 'drop' ) { + unless ( $dbh = + DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) ) + { + warn $DBI::errstr; + warn "Database doesn't appear to exist. Aborting database drop."; + exit(0); + } + drop_db(); +} +elsif ( $args{'action'} eq 'insert_initial' ) { + insert_initial_data(); +} +elsif ( $args{'action'} eq 'insert' ) { + insert_data( $args{'datafile'} || ($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'; + exit(-1); +} + +# {{{ sub insert_schema +sub insert_schema { + my $base_path = (shift || $RT::EtcPath); + my (@schema); + print "Creating database schema.\n"; + + if ( -f $base_path . "/schema." . $RT::DatabaseType ) { + no warnings 'unopened'; + + open( SCHEMA, "<" . $base_path . "/schema." . $RT::DatabaseType ); + open( SCHEMA_LOCAL, "<" . $RT::LocalEtcPath . "/schema." . $RT::DatabaseType ); + + my $statement = ""; + foreach my $line (<SCHEMA>, ($_ = ';;'), <SCHEMA_LOCAL>) { + $line =~ s/\#.*//g; + $line =~ s/--.*//g; + $statement .= $line; + if ( $line =~ /;(\s*)$/ ) { + $statement =~ s/;(\s*)$//g; + push @schema, $statement; + $statement = ""; + } + } + + local $SIG{__WARN__} = sub {}; + my $is_local = 0; # local/etc/schema needs to be nonfatal. + $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 $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() 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..f79e4e5c2 --- /dev/null +++ b/rt/sbin/rt-test-dependencies.in @@ -0,0 +1,377 @@ +#!@PERL@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2005 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 }}} +# +# 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', + 'download=s', + 'repository=s' +); + +unless (keys %args) { + help(); + exit(0); +} + +# Set up defaults +$args{'with-MASON'} = 1; +$args{'with-CORE'} = 1; +$args{'with-DEV'} =1; +$args{'with-CLI'} =1; +$args{'with-MAILGATE'} =1; +{ + 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-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. +. +} + + +sub _ { + map { /(\S+)\s*(\S*)/; $1 => ($2 ? $2 :'') } split ( /\n/, $_[0] ); +} + +$deps{'CORE'} = [ _( << '.') ]; +Digest::base +Digest::MD5 2.27 +DBI 1.37 +Test::Inline +Class::ReturnValue 0.40 +DBIx::SearchBuilder 1.26 +Text::Template +File::Spec 0.8 +HTML::Entities +HTML::Scrubber 0.08 +Net::Domain +Log::Dispatch 2.0 +Locale::Maketext 1.06 +Locale::Maketext::Lexicon 0.32 +Locale::Maketext::Fuzzy +MIME::Entity 5.108 +Mail::Mailer 1.57 +Net::SMTP +Text::Wrapper +Time::ParseDate +Time::HiRes +File::Temp +Term::ReadKey +Text::Autoformat +Text::Quoted 1.3 +Tree::Simple 1.04 +Scalar::Util +Module::Versions::Report +Cache::Simple::TimedExpiry +XML::Simple +. + +$deps{'MASON'} = [ _( << '.') ]; +Params::Validate 0.02 +Cache::Cache +Exception::Class 1.14 +HTML::Mason 1.23 +MLDBM +Errno +FreezeThaw +Digest::MD5 2.27 +CGI::Cookie 1.20 +Storable 2.08 +Apache::Session 1.53 +XML::RSS 1.05 +HTTP::Server::Simple 0.07 +HTTP::Server::Simple::Mason 0.09 +Text::WikiFormat +. + +$deps{'MAILGATE'} = [ _( << '.') ]; +HTML::TreeBuilder +HTML::FormatText +Getopt::Long +LWP::UserAgent +. + +$deps{'CLI'} = [ _( << '.') ]; +Getopt::Long 2.24 +. + +$deps{'DEV'} = [ _( << '.') ]; +Regexp::Common +Test::Inline +Apache::Test +HTML::Form +HTML::TokeParser +WWW::Mechanize +Test::WWW::Mechanize +Module::Refresh 0.03 +. + +$deps{'FASTCGI'} = [ _( << '.') ]; +CGI 2.92 +FCGI +CGI::Fast +. + +$deps{'SPEEDYCGI'} = [ _( << '.') ]; +CGI 2.92 +CGI::SpeedyCGI +. + + +$deps{'MODPERL1'} = [ _( << '.') ]; +CGI 2.92 +Apache::Request +Apache::DBI 0.92 +. + +$deps{'MODPERL2'} = [ _( << '.') ]; +CGI 2.92 +Apache::DBI +HTML::Mason 1.31 +. + +$deps{'MYSQL'} = [ _( << '.') ]; +DBD::mysql 2.1018 +. +$deps{'ORACLE'} = [ _( << '.') ]; +DBD::Oracle +. +$deps{'POSTGRESQL'} = [ _( << '.') ]; +DBD::Pg 1.41 +. + +$deps{'SQLITE'} = [ _( << '.') ]; +DBD::SQLite +. + +if ($args{'download'}) { + + download_mods(); +} + + +check_perl_version(); + +check_users(); + + +foreach my $type (keys %args) { + next unless ($type =~ /^with-(.*?)$/); + my $type = $1; + section("$type dependencies"); + my @deps = (@{$deps{$type}}); + while (@deps) { + my $module = shift @deps; + my $version = shift @deps; + my $ret = test_dep($module, $version); + + if ($args{'install'} && !$ret) { + resolve_dep($module); + } + } +} + +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 { + found("$module $version", 1); + return 1; + } +} + +sub resolve_dep { + my $module = shift; + system( qq[@PERL@ -MCPAN -e'install("$module")'] ); +} + +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."); + die; + } 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; |