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, 0 insertions, 2458 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog deleted file mode 100644 index 3552afb..0000000 --- a/rt/sbin/extract-message-catalog +++ /dev/null @@ -1,272 +0,0 @@ -#!/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 deleted file mode 100644 index 4d9d7bd..0000000 --- a/rt/sbin/extract_pod_tests +++ /dev/null @@ -1,157 +0,0 @@ -#!/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 deleted file mode 100644 index 743d8b9..0000000 --- a/rt/sbin/factory +++ /dev/null @@ -1,513 +0,0 @@ -#!/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 deleted file mode 100644 index 906d349..0000000 --- a/rt/sbin/license_tag +++ /dev/null @@ -1,239 +0,0 @@ -#!/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 deleted file mode 100644 index d98e462..0000000 --- a/rt/sbin/regression_harness +++ /dev/null @@ -1,54 +0,0 @@ -#!/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 deleted file mode 100755 index bcc7bb7..0000000 --- a/rt/sbin/rt-dump-database.in +++ /dev/null @@ -1,168 +0,0 @@ -#!@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 deleted file mode 100644 index 49feba8..0000000 --- a/rt/sbin/rt-setup-database.in +++ /dev/null @@ -1,678 +0,0 @@ -#!@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 deleted file mode 100644 index f79e4e5..0000000 --- a/rt/sbin/rt-test-dependencies.in +++ /dev/null @@ -1,377 +0,0 @@ -#!@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; |