From b4b0c7e72d7eaee2fbfc7022022c9698323203dd Mon Sep 17 00:00:00 2001
From: ivan <ivan>
Date: Thu, 31 Dec 2009 13:16:41 +0000
Subject: import rt 3.8.7

---
 rt/sbin/extract-message-catalog  |  141 ++++-
 rt/sbin/factory                  |   17 +-
 rt/sbin/license_tag              |   51 +-
 rt/sbin/merge-rosetta.pl         |  102 ++++
 rt/sbin/rt-attributes-viewer     |  110 ++++
 rt/sbin/rt-attributes-viewer.in  |  110 ++++
 rt/sbin/rt-clean-sessions        |  190 +++++++
 rt/sbin/rt-clean-sessions.in     |  190 +++++++
 rt/sbin/rt-dump-database         |   32 +-
 rt/sbin/rt-dump-database.in      |   32 +-
 rt/sbin/rt-email-dashboards      |  568 +++++++++++++++++++
 rt/sbin/rt-email-dashboards.in   |  568 +++++++++++++++++++
 rt/sbin/rt-email-digest          |  337 ++++++++++++
 rt/sbin/rt-email-digest.in       |  337 ++++++++++++
 rt/sbin/rt-email-group-admin     |  508 +++++++++++++++++
 rt/sbin/rt-email-group-admin.in  |  508 +++++++++++++++++
 rt/sbin/rt-server                |  129 +++++
 rt/sbin/rt-server.in             |  129 +++++
 rt/sbin/rt-setup-database        |  861 +++++++++++------------------
 rt/sbin/rt-setup-database.in     |  861 +++++++++++------------------
 rt/sbin/rt-shredder              |  323 +++++++++++
 rt/sbin/rt-shredder.in           |  323 +++++++++++
 rt/sbin/rt-test-dependencies     |  273 +++++++---
 rt/sbin/rt-test-dependencies.in  |  273 +++++++---
 rt/sbin/rt-validator             | 1118 ++++++++++++++++++++++++++++++++++++++
 rt/sbin/rt-validator.in          | 1118 ++++++++++++++++++++++++++++++++++++++
 rt/sbin/tweak-template-locstring |   55 ++
 27 files changed, 7937 insertions(+), 1327 deletions(-)
 create mode 100644 rt/sbin/merge-rosetta.pl
 create mode 100755 rt/sbin/rt-attributes-viewer
 create mode 100644 rt/sbin/rt-attributes-viewer.in
 create mode 100755 rt/sbin/rt-clean-sessions
 create mode 100644 rt/sbin/rt-clean-sessions.in
 create mode 100755 rt/sbin/rt-email-dashboards
 create mode 100644 rt/sbin/rt-email-dashboards.in
 create mode 100755 rt/sbin/rt-email-digest
 create mode 100644 rt/sbin/rt-email-digest.in
 create mode 100755 rt/sbin/rt-email-group-admin
 create mode 100755 rt/sbin/rt-email-group-admin.in
 create mode 100755 rt/sbin/rt-server
 create mode 100644 rt/sbin/rt-server.in
 create mode 100755 rt/sbin/rt-shredder
 create mode 100755 rt/sbin/rt-shredder.in
 create mode 100755 rt/sbin/rt-validator
 create mode 100644 rt/sbin/rt-validator.in
 create mode 100644 rt/sbin/tweak-template-locstring

(limited to 'rt/sbin')

diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog
index 44f8d51..ce151bd 100644
--- a/rt/sbin/extract-message-catalog
+++ b/rt/sbin/extract-message-catalog
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -59,12 +59,17 @@ use vars qw($DEBUG $FILECAT);
 
 $DEBUG = 1;
 
-@ARGV = <lib/RT/I18N/*.po> unless @ARGV;
+# po dir is for extensions
+@ARGV = (<lib/RT/I18N/*.po>, <lib/RT/I18N/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV;
 
 $FILECAT = {};
 
 # extract all strings and stuff them into $FILECAT
-File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, '.' );
+# scan html dir for extensions
+File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) );
+
+# remove msgid with $ in it.  XXX: perhaps give some warnings here
+$FILECAT = { map { $_ => $FILECAT->{$_} } grep { !m/\$/ } keys %$FILECAT };
 
 # ensure proper escaping and [_1] => %1 transformation
 foreach my $str ( sort keys %{$FILECAT} ) {
@@ -83,11 +88,13 @@ foreach my $str ( sort keys %{$FILECAT} ) {
 
 # update all language dictionaries
 foreach my $dict (@ARGV) {
+    $dict = "lib/RT/I18N/$dict.pot" if ( $dict eq 'rt' );
     $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!;
 
     my $lang = $dict;
     $lang =~ s|.*/||;
     $lang =~ s|\.po$||;
+    $lang =~ s|\.pot$||;
 
     update($lang, $dict);
 }
@@ -101,7 +108,8 @@ sub extract_strings_from_code {
     local $/;
     return if ( -d $_ );
     return if ( $File::Find::dir =~ 'lib/blib|lib/t/autogen|var|m4|local' );
-    return if ( /\.po$|\.bak$|~|,D|,B$|extract-message-catalog$/ );
+    return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ );
+    return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ );
     return if ( /^[\.#]/ );
     return if ( -f "$_.in" );
 
@@ -115,12 +123,20 @@ sub extract_strings_from_code {
         return;
     }
 
+    my $re_space_wo_nl = qr{(?!\n)\s};
+    my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}x;
+    my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}x;
+    my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}x;
+    my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}x;
+    my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep};
+
     $_ = <_>;
 
     # Mason filter: <&|/l>...</&>
     my $line = 1;
     while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) {
         my ( $vars, $str ) = ( $1, $2 );
+        $vars =~ s/[\n\r]//g;
         $line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
         $str =~ s/\\'/\'/g;
         #print "STR IS $str\n";
@@ -136,7 +152,7 @@ sub extract_strings_from_code {
 
         my ( $vars, $str );
         if ( $match =~
-                /\(\s*($RE{delimited}{-delim=>q{'"}}{-keep})(.*?)\s*\)$/s ) {
+                /\(\s*($re_delim)(.*?)\s*\)$/so ) {
 
             $str = substr( $1, 1, -1 );       # $str comes before $vars now
             $vars = $9;
@@ -154,20 +170,59 @@ sub extract_strings_from_code {
     # 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);
+    while (m/\G.*?($re_delim)[\}\)\],;]*$re_loc_suffix/smgo) {
+	my $str = $1;
 	$line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
-	$str  =~ s/\\'/\'/g;
+        unless ( defined $str ) {
+            warn "Couldn't process loc at $filename:$line";
+            next;
+        }
+        $str = substr($str, 1, -1);
+	$str =~ s/\\'/\'/g;
 	push @{ $FILECAT->{$str} }, [ $filename, $line, '' ];
     }
 
+    # Comment-based qw mark: "qw(...)" # loc_qw
+    $line = 1;
+    pos($_) = 0;
+    while (m/\G.*?(?:(qw\([^)]+\))[\}\)\],;]*)?$re_loc_qw_suffix/smgo) {
+        my $str = $1;
+	$line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+        unless ( defined $str ) {
+            warn "Couldn't process loc_qw at $filename:$line";
+            next;
+        }
+        foreach my $value (eval($str)) {
+            push @{ $FILECAT->{$value} }, [ $filename, $line, '' ];
+        }
+    }
+
+    # Comment-based left pair mark: "..." => ... # loc_left_pair
+    $line = 1;
+    pos($_) = 0;
+    while (m/\G.*?(?:(\w+)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smgo) {
+	my $key = $1;
+	$line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+        unless ( defined $key ) {
+            warn "Couldn't process loc_left_pair at $filename:$line";
+            next;
+        }
+	$key  =~ s/\\'/\'/g;
+	push @{ $FILECAT->{$key} }, [ $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) {
+    while (m/\G.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix/smgo) {
 	my $key = $1;
-	my $val = substr($2, 1, -1);
+	my $val = $2;
 	$line += ( () = ( $& =~ /\n/g ) );    # cryptocontext!
+        unless ( defined $key && defined $val ) {
+            warn "Couldn't process loc_pair at $filename:$line";
+            next;
+        }
+	$val = substr($val, 1, -1);
 	$key  =~ s/\\'/\'/g;
 	$val  =~ s/\\'/\'/g;
 	push @{ $FILECAT->{$key} }, [ $filename, $line, '' ];
@@ -196,19 +251,52 @@ sub update {
     @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines;
     while (@lines) {
         my $msghdr = "";
-        $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^msgid/ );
+        $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^(#~ )?msgid/ );
         
         my $msgid  = "";
-        $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(msgid|")/ );
+
+# '#~ ' is the prefix of launchpad for msg that's not found the the source
+# we'll remove the prefix later so we can still show them with our own mark
+
+        $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgid|")/ );
         my $msgstr = "";
-        $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(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";
+
+        $msgid  =~ s/^#~ //mg;
+        $msgstr =~ s/^#~ //mg;
+
+        $msgid  =~ s/^msgid "(.*)"\s*?$/$1/m    or warn "$msgid in $file";
+
+        if ( $msgid eq '' ) {
+            # null msgid, msgstr will have head info
+            $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr  in $file";
+        }
+        else {
+            $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/m or warn "$msgstr  in $file";
+        }
+
+        if ( $msgid ne ''  ) {
+            for my $msg ( \$msgid, \$msgstr ) {
+                if ( $$msg =~ /\n/ ) {
+                    my @lines = split /\n/, $$msg;
+                    $$msg =
+                      shift @lines;   # first line don't need to handle any more
+                    for (@lines) {
+                        if (/^"(.*)"\s*$/) {
+                            $$msg .= $1;
+                        }
+                    }
+                }
+
+                # convert \\n back to \n
+                $$msg =~ s/(?!\\)\\n/\n/g;
+            }
+        }
 
         $Lexicon{$msgid} = $msgstr;
         $Header{$msgid}  = $msghdr;
@@ -217,7 +305,7 @@ sub update {
     my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ );
 
     foreach my $str ( sort keys %{$FILECAT} ) {
-        $Lexicon{$str} ||= '';;
+        $Lexicon{$str} ||= '';
     }
     foreach ( sort keys %Lexicon ) {
         my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } );
@@ -250,7 +338,7 @@ sub update {
             $var =~ s/\s*$//;
             $out .= "#. ($var)\n" unless $seen{$var}++;
         }
-        $out .= "msgid \"$_\"\nmsgstr \"$Lexicon{$_}\"\n\n";
+        $out .= 'msgid ' . fmt($_) . "msgstr \"$Lexicon{$_}\"\n\n";
     }
 
     open PO, ">$file" or die $!;
@@ -266,6 +354,23 @@ sub escape {
     return $text;
 }
 
+sub fmt {
+    my $str = shift;
+    return "\"$str\"\n" unless $str =~ /\n/;
+
+    my $multi_line = ($str =~ /\n(?!\z)/);
+    $str =~ s/\n/\\n"\n"/g;
+
+    if ($str =~ /\n"$/) {
+        chop $str;
+    }
+    else {
+        $str .= "\"\n";
+    }
+    return $multi_line ? qq(""\n"$str) : qq("$str);
+}
+
+
 __END__
 # Local variables:
 # c-indentation-style: bsd
diff --git a/rt/sbin/factory b/rt/sbin/factory
index 6b2d896..78a0159 100644
--- a/rt/sbin/factory
+++ b/rt/sbin/factory
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -49,6 +49,8 @@
 use strict;
 use DBI;
 
+die "Usage: $0 database namespace" if @ARGV != 2;
+
 my $database  = shift;
 my $namespace = shift;
 
@@ -65,8 +67,8 @@ my $LicenseBlock = << '.';
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2008 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -86,7 +88,9 @@ my $LicenseBlock = << '.';
 # 
 # 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.
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
 # 
 # 
 # CONTRIBUTION SUBMISSION POLICY:
@@ -110,6 +114,7 @@ my $LicenseBlock = << '.';
 .
 
 my $Attribution = << '.';
+
 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
 # 
@@ -124,7 +129,7 @@ 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 @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
 
 my ( %tablemap, $typemap, %modulemap );
 
diff --git a/rt/sbin/license_tag b/rt/sbin/license_tag
index ddb4368..f638db6 100644
--- a/rt/sbin/license_tag
+++ b/rt/sbin/license_tag
@@ -4,8 +4,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -51,8 +51,8 @@
 my $LICENSE  = <<'EOL';
 
 COPYRIGHT:
- 
-This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+
+This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
                                          <jesse@bestpractical.com>
 
 (Except where explicitly superseded by other copyright notices)
@@ -101,7 +101,7 @@ 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_mason}, 'share/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');
@@ -110,16 +110,16 @@ tag_makefile ('README');
 
 sub tag_mason {
         my $pm = $_;
-        next unless (-f $pm);
-        next if ($pm =~ /images/);
+        return unless (-f $pm);
+        return if $pm =~ /images/ || $pm =~ /\.(?:png|jpe?g|gif)$/;
         open(FILE,"<$pm") || die "Failed to open $pm";
         my $file = (join "", <FILE>); 
         close (FILE);
+        print "$pm - ";
+        return if another_license($pm => $file) && print "has different license\n";
+
         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;
@@ -147,11 +147,11 @@ sub tag_makefile {
         open(FILE,"<$pm") || die "Failed to open $pm";
         my $file = (join "", <FILE>); 
         close (FILE);
+        print "$pm - ";
+        return if another_license($pm => $file) && print "has different license\n";
+
         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;
@@ -180,11 +180,11 @@ sub tag_pm {
         open(FILE,"<$pm") || die "Failed to open $pm";
         my $file = (join "", <FILE>); 
         close (FILE);
+        print "$pm - ";
+        return if another_license($pm => $file) && print "has different license\n";
+
         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;
@@ -194,7 +194,7 @@ sub tag_pm {
                 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;
+        $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED BLOCK }}}\n\n/mg;
         print "\n";
         
         
@@ -213,10 +213,11 @@ sub tag_script {
         open(FILE,"<$pm") || die "Failed to open $pm";
         my $file = (join "", <FILE>); 
         close (FILE);
+        print "$pm - ";
+        return if another_license($pm => $file) && print "has different license\n";
+
         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;
@@ -241,3 +242,15 @@ sub tag_script {
 
 }
 
+sub another_license {
+    my $name = shift;
+    my $file = shift;
+
+    return 1 if ($name =~ /(?:FCKEditor|scriptaculous)/i);
+
+    return 0 if $file =~ /Copyright\s+\(c\)\s+\d\d\d\d-\d\d\d\d Best Practical Solutions/i;
+    return 1 if $file =~ /\b(copyright|GPL|Public Domain)\b/i; # common
+    return 1 if $file =~ /\(c\)\s+\d\d\d\d(?:-\d\d\d\d)?/i; # prototype
+    return 0;
+}
+
diff --git a/rt/sbin/merge-rosetta.pl b/rt/sbin/merge-rosetta.pl
new file mode 100644
index 0000000..1c4b903
--- /dev/null
+++ b/rt/sbin/merge-rosetta.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use LWP::Simple 'getstore';
+use Locale::PO;
+use Locale::Maketext::Extract;
+use Archive::Extract;
+use File::Temp;
+use File::Copy 'copy';
+
+my $url = shift or die 'must provide rosseta download url or directory';
+
+my $dir;
+
+if ($url =~ m/http/) {
+    $dir = File::Temp::tempdir;
+    my ($fname) = $url =~ m{([^/]+)$};
+    print "Downloading $url\n";
+    getstore($url => "$dir/$fname");
+    print "Extracting $dir/$fname\n";
+    my $ae = Archive::Extract->new(archive => "$dir/$fname");
+    my $ok = $ae->extract( to => $dir );
+}
+else {
+    $dir = $url;
+}
+
+Locale::Maketext::Lexicon::set_option('use_fuzzy', 1);
+Locale::Maketext::Lexicon::set_option('allow_empty', 1);
+
+for (<$dir/rt/*.po>) {
+    my ($name) = m/([\w_]+)\.po/;
+    my $fname = "lib/RT/I18N/$name";
+    my $tmp = File::Temp->new;
+
+    print "$_ -> $fname.po\n";
+
+    # retain the "NOT FOUND IN SOURCE" entries
+    system("sed -e 's/^#~ //' $_ > $tmp");
+    my $ext = Locale::Maketext::Extract->new;
+    $ext->read_po($tmp);
+
+    my $po_orig = Locale::PO->load_file_ashash("$fname.po");
+    # don't want empty vales to override ours.
+    # don't want fuzzy flag as when uploading to rosetta again it's not accepted by rosetta.
+    foreach my $msgid ($ext->msgids) {
+        my $entry = $po_orig->{Locale::PO->quote($msgid)} or next;
+        my $msgstr = $entry->dequote($entry->{msgstr}) or next;
+        $ext->set_msgstr($msgid, $msgstr)
+            if $ext->msgstr($msgid) eq '' && $msgstr;
+    }
+    $ext->write_po("$fname.po");
+}
+
+print "Merging new strings\n";
+system("$^X sbin/extract-message-catalog");
diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-attributes-viewer
new file mode 100755
index 0000000..3dad3ae
--- /dev/null
+++ b/rt/sbin/rt-attributes-viewer
@@ -0,0 +1,110 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+}
+
+my $id = shift;
+usage() unless $id;
+
+sub usage {
+    print STDERR <<END;
+Usage: $0 <attribute id>
+
+Description:
+
+This script deserializes and print content of an attribute defined
+by <attribute id>. May be useful for developers and for troubleshooting
+problems.
+
+END
+    exit 1;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+require RT::Attribute;
+my $attr = RT::Attribute->new( do { no warnings 'once'; $RT::SystemUser } );
+$attr->Load( $id );
+unless ( $attr->id ) {
+    print STDERR "Couldn't load attribute #$id\n";
+    exit 1;
+}
+
+my %res = ();
+$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType);
+
+use Data::Dumper;
+print "Content of attribute #$id: ". Dumper( \%res );
+
diff --git a/rt/sbin/rt-attributes-viewer.in b/rt/sbin/rt-attributes-viewer.in
new file mode 100644
index 0000000..a511289
--- /dev/null
+++ b/rt/sbin/rt-attributes-viewer.in
@@ -0,0 +1,110 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+}
+
+my $id = shift;
+usage() unless $id;
+
+sub usage {
+    print STDERR <<END;
+Usage: $0 <attribute id>
+
+Description:
+
+This script deserializes and print content of an attribute defined
+by <attribute id>. May be useful for developers and for troubleshooting
+problems.
+
+END
+    exit 1;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+require RT::Attribute;
+my $attr = RT::Attribute->new( do { no warnings 'once'; $RT::SystemUser } );
+$attr->Load( $id );
+unless ( $attr->id ) {
+    print STDERR "Couldn't load attribute #$id\n";
+    exit 1;
+}
+
+my %res = ();
+$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType);
+
+use Data::Dumper;
+print "Content of attribute #$id: ". Dumper( \%res );
+
diff --git a/rt/sbin/rt-clean-sessions b/rt/sbin/rt-clean-sessions
new file mode 100755
index 0000000..0092a48
--- /dev/null
+++ b/rt/sbin/rt-clean-sessions
@@ -0,0 +1,190 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+}
+
+use Getopt::Long;
+my %opt;
+GetOptions( \%opt, "older=s", "debug", "help", "skip-user");
+
+
+if ( $opt{help} ) {
+    require Pod::Usage;
+    import Pod::Usage;
+    pod2usage({ -message => "RT Session cleanup tool\n", verbose => 1 });
+    exit 1;    
+}
+
+
+if( $opt{'older'} ) {
+    unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) {
+        print STDERR "wrong format of the 'older' argumnet\n";
+        exit(1);
+    }
+    my ($num,$unit) = ($1, uc($2 ||'D'));
+    my %factor = ( H => 60*60 );
+    $factor{'D'} = $factor{'H'}*24;
+    $factor{'M'} = $factor{'D'}*31;
+    $factor{'Y'} = $factor{'D'}*365;
+    $opt{'older'} = $num * $factor{ $unit };
+}
+
+require RT;
+RT::LoadConfig();
+
+if( $opt{'debug'} ) {
+    RT->Config->Set( LogToScreen => 'debug' );
+} else {
+    RT->Config->Set( LogToScreen => undef );
+}
+
+RT::ConnectToDatabase();
+RT::InitLogging();
+
+require RT::Interface::Web::Session;
+
+if( $opt{'older'} or my $alogoff = int RT->Config->Get('AutoLogoff') ) {
+    my $min;
+    foreach ($alogoff*60, $opt{'older'}) {
+        next unless $_;
+        $min = $_ unless $min;
+        $min = $_ if $_ < $min;
+    }
+
+    RT::Interface::Web::Session->ClearOld( $min );
+}
+
+RT::Interface::Web::Session->ClearByUser
+    unless $opt{'skip-user'};
+
+exit(0);
+
+__END__
+
+=head1 NAME
+
+rt-clean-sessions - clean old and duplicate RT sessions
+
+=head1 SYNOPSIS
+
+    rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]]
+
+    rt-clean sessions
+    rt-clean sessions --debug
+    rt-clean sessions --older 10D
+    rt-clean sessions --debug --older 1M
+    rt-clean sessions --older 10D --skip-user
+
+=head1 DESCRIPTION
+
+Script cleans RT sessions from DB or dir with sessions data.
+Leaves in DB only one session per RT user and sessions that aren't older
+than specified(see options).
+
+Script is safe because data in the sessions is temporary and can be deleted.
+
+=head1 OPTIONS
+
+=over 4
+
+=item older
+
+Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays),
+H(our), M(onth) and Y(ear) are also supported.
+
+For exmaple: C<rt-clean sessions --older 1M> would delete all sessions that are
+older than 1 month.
+
+=item skip-user
+
+By default only one session per user left in the DB, so users that have
+sessions on multiple computers or in different browsers will be logged out.
+Use this option to avoid this.
+
+=item debug
+
+Turn on debug output.
+
+=back
+
+=head1 NOTES
+
+Functionality similar to this is implemented in
+html/Elements/SetupSessionCookie ; however, that does not guarantee
+that a session will be removed from disk and database soon after the
+timeout expires.  This script, if run from a cron job, will ensure
+that the timed out sessions are actually removed from disk; the Mason
+component just ensures that the old sessions are not reusable before
+the cron job gets to them.
+
+=cut
diff --git a/rt/sbin/rt-clean-sessions.in b/rt/sbin/rt-clean-sessions.in
new file mode 100644
index 0000000..ac736e6
--- /dev/null
+++ b/rt/sbin/rt-clean-sessions.in
@@ -0,0 +1,190 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+}
+
+use Getopt::Long;
+my %opt;
+GetOptions( \%opt, "older=s", "debug", "help", "skip-user");
+
+
+if ( $opt{help} ) {
+    require Pod::Usage;
+    import Pod::Usage;
+    pod2usage({ -message => "RT Session cleanup tool\n", verbose => 1 });
+    exit 1;    
+}
+
+
+if( $opt{'older'} ) {
+    unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) {
+        print STDERR "wrong format of the 'older' argumnet\n";
+        exit(1);
+    }
+    my ($num,$unit) = ($1, uc($2 ||'D'));
+    my %factor = ( H => 60*60 );
+    $factor{'D'} = $factor{'H'}*24;
+    $factor{'M'} = $factor{'D'}*31;
+    $factor{'Y'} = $factor{'D'}*365;
+    $opt{'older'} = $num * $factor{ $unit };
+}
+
+require RT;
+RT::LoadConfig();
+
+if( $opt{'debug'} ) {
+    RT->Config->Set( LogToScreen => 'debug' );
+} else {
+    RT->Config->Set( LogToScreen => undef );
+}
+
+RT::ConnectToDatabase();
+RT::InitLogging();
+
+require RT::Interface::Web::Session;
+
+if( $opt{'older'} or my $alogoff = int RT->Config->Get('AutoLogoff') ) {
+    my $min;
+    foreach ($alogoff*60, $opt{'older'}) {
+        next unless $_;
+        $min = $_ unless $min;
+        $min = $_ if $_ < $min;
+    }
+
+    RT::Interface::Web::Session->ClearOld( $min );
+}
+
+RT::Interface::Web::Session->ClearByUser
+    unless $opt{'skip-user'};
+
+exit(0);
+
+__END__
+
+=head1 NAME
+
+rt-clean-sessions - clean old and duplicate RT sessions
+
+=head1 SYNOPSIS
+
+    rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]]
+
+    rt-clean sessions
+    rt-clean sessions --debug
+    rt-clean sessions --older 10D
+    rt-clean sessions --debug --older 1M
+    rt-clean sessions --older 10D --skip-user
+
+=head1 DESCRIPTION
+
+Script cleans RT sessions from DB or dir with sessions data.
+Leaves in DB only one session per RT user and sessions that aren't older
+than specified(see options).
+
+Script is safe because data in the sessions is temporary and can be deleted.
+
+=head1 OPTIONS
+
+=over 4
+
+=item older
+
+Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays),
+H(our), M(onth) and Y(ear) are also supported.
+
+For exmaple: C<rt-clean sessions --older 1M> would delete all sessions that are
+older than 1 month.
+
+=item skip-user
+
+By default only one session per user left in the DB, so users that have
+sessions on multiple computers or in different browsers will be logged out.
+Use this option to avoid this.
+
+=item debug
+
+Turn on debug output.
+
+=back
+
+=head1 NOTES
+
+Functionality similar to this is implemented in
+html/Elements/SetupSessionCookie ; however, that does not guarantee
+that a session will be removed from disk and database soon after the
+timeout expires.  This script, if run from a cron job, will ensure
+that the timed out sessions are actually removed from disk; the Mason
+component just ensures that the old sessions are not reusable before
+the cron job gets to them.
+
+=cut
diff --git a/rt/sbin/rt-dump-database b/rt/sbin/rt-dump-database
index 647781d..6175a10 100755
--- a/rt/sbin/rt-dump-database
+++ b/rt/sbin/rt-dump-database
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -48,8 +48,30 @@
 # END BPS TAGGED BLOCK }}}
 use strict;
 
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
 
 use RT;
 use XML::Simple;
@@ -117,7 +139,7 @@ foreach my $class (@classes) {
 	# next if $obj-> # skip default names
 	foreach my $field (sort keys %fields) {
 	    my $value = $obj->__Value($field);
-	    $rv->{$field} = $value if length($value);
+	    $rv->{$field} = $value if ( defined ($value) && length($value) );
 	}
 	delete $rv->{Disabled} unless $rv->{Disabled};
 
diff --git a/rt/sbin/rt-dump-database.in b/rt/sbin/rt-dump-database.in
index 10670a2..878a209 100755
--- a/rt/sbin/rt-dump-database.in
+++ b/rt/sbin/rt-dump-database.in
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -48,8 +48,30 @@
 # END BPS TAGGED BLOCK }}}
 use strict;
 
-use lib "@LOCAL_LIB_PATH@";
-use lib "@RT_LIB_PATH@";
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
 
 use RT;
 use XML::Simple;
@@ -117,7 +139,7 @@ foreach my $class (@classes) {
 	# next if $obj-> # skip default names
 	foreach my $field (sort keys %fields) {
 	    my $value = $obj->__Value($field);
-	    $rv->{$field} = $value if length($value);
+	    $rv->{$field} = $value if ( defined ($value) && length($value) );
 	}
 	delete $rv->{Disabled} unless $rv->{Disabled};
 
diff --git a/rt/sbin/rt-email-dashboards b/rt/sbin/rt-email-dashboards
new file mode 100755
index 0000000..d46e0fe
--- /dev/null
+++ b/rt/sbin/rt-email-dashboards
@@ -0,0 +1,568 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+use RT::Interface::Web;
+use RT::Interface::Web::Handler;
+use RT::Dashboard;
+use RT::Interface::CLI qw{ CleanEnv loc };
+
+use Getopt::Long;
+use HTML::Mason;
+use HTML::RewriteAttributes::Resources;
+use HTML::RewriteAttributes::Links;
+use MIME::Types;
+use POSIX 'tzset';
+use File::Temp 'tempdir';
+
+# Clean out all the nasties from the environment
+CleanEnv();
+
+# Load the config file
+RT::LoadConfig();
+
+# Connect to the database and get RT::SystemUser and RT::Nobody loaded
+RT::Init();
+
+$HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
+
+no warnings 'once';
+
+# Read in the options
+my %opts;
+GetOptions( \%opts,
+    "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl"
+);
+
+if ($opts{'help'}) {
+    require Pod::Usage;
+    import Pod::Usage;
+    pod2usage(-message => "RT Email Dashboards\n", -verbose => 1);
+    exit 1;
+}
+
+# helper functions
+sub verbose  { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 }
+sub debug    { print loc(@_), "\n" if $opts{debug}; 1 }
+sub error    { $RT::Logger->error(loc(@_)); verbose(@_); 1 }
+sub warning  { $RT::Logger->warning(loc(@_)); verbose(@_); 1 }
+
+my $now = $opts{epoch} || time;
+verbose "Using time [_1]", scalar localtime($now);
+
+my $from = get_from();
+debug "Sending email from [_1]", $from;
+
+# look through each user for her subscriptions
+my $Users = RT::Users->new($RT::SystemUser);
+$Users->LimitToPrivileged;
+
+while (defined(my $user = $Users->Next)) {
+    if ($user->PrincipalObj->Disabled) {
+        debug "Skipping over "
+            . $user->Name
+            . " due to having a disabled account.";
+        next;
+    }
+
+    my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone'));
+    $hour .= ':00';
+    debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]",
+          $user->Name, $hour, $dow, $dom;
+
+    my $currentuser = RT::CurrentUser->new;
+    $currentuser->LoadByName($user->Name);
+
+    # look through this user's subscriptions, are any supposed to be generated
+    # right now?
+    for my $subscription ($user->Attributes->Named('Subscription')) {
+        my $counter = $subscription->SubValue('Counter') || 0;
+
+        if (!$opts{all}) {
+            debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]",
+                $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'),
+                $subscription->SubValue('Dow'), $subscription->SubValue('Dom');
+
+            next if $subscription->SubValue('Frequency') eq 'never';
+
+            # correct hour?
+            next if $subscription->SubValue('Hour') ne $hour;
+
+            # if weekly, correct day of week?
+            if ( $subscription->SubValue('Frequency') eq 'weekly' ) {
+                next if $subscription->SubValue('Dow') ne $dow;
+                my $fow       = $subscription->SubValue('Fow') || 1;
+                if ( $counter % $fow ) {
+                    $subscription->SetSubValues( Counter => $counter + 1 )
+                      unless $opts{'dryrun'};
+                    next;
+                }
+            }
+
+            # if monthly, correct day of month?
+            elsif ($subscription->SubValue('Frequency') eq 'monthly') {
+                next if $subscription->SubValue('Dom') != $dom;
+            }
+
+            elsif ($subscription->SubValue('Frequency') eq 'm-f') {
+                next if $dow eq 'Sunday' || $dow eq 'Saturday';
+            }
+        }
+
+        my $email = $subscription->SubValue('Recipient')
+                 || $user->EmailAddress;
+
+        eval { send_dashboard($currentuser, $email, $subscription) };
+        if ( $@ ) {
+            error 'Caught exception: ' . $@;
+        }
+        else {
+            $subscription->SetSubValues(
+                Counter => $counter + 1 )
+              unless $opts{'dryrun'};
+        }
+    }
+}
+
+sub send_dashboard {
+    my ($currentuser, $email, $subscription) = @_;
+
+    my $rows = $subscription->SubValue('Rows');
+
+    my $dashboard = RT::Dashboard->new($currentuser);
+
+    my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId'));
+
+    # failed to load dashboard. perhaps it was deleted or it changed privacy
+    if (!$ok) {
+        warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]",
+            $subscription->SubValue('DashboardId'),
+            $subscription->Id,
+            $currentuser->Name,
+            $msg;
+
+        my $ok = RT::Interface::Email::SendEmailUsingTemplate(
+            From      => $from,
+            To        => $email,
+            Template  => 'Error: Missing dashboard',
+            Arguments => {
+                SubscriptionObj => $subscription,
+            },
+        );
+
+        # only delete the subscription if the email looks like it went through
+        if ($ok) {
+            my ($deleted, $msg) = $subscription->Delete();
+            if ($deleted) {
+                verbose("Deleted an obsolete subscription: [_1]", $msg);
+            }
+            else {
+                warning("Unable to delete an obsolete subscription: [_1]", $msg);
+            }
+        }
+        else {
+            warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name);
+        }
+
+        return;
+    }
+
+    verbose 'Creating dashboard "[_1]" for user "[_2]":',
+            $dashboard->Name,
+            $currentuser->Name;
+
+    if ($opts{'dryrun'}) {
+        print << "SUMMARY";
+    Dashboard: @{[ $dashboard->Name ]}
+    User:   @{[ $currentuser->Name ]} <$email>
+SUMMARY
+        return;
+    }
+
+    $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
+    my $contents = run_component(
+        '/Dashboards/Render.html',
+        id      => $dashboard->Id,
+        Preview => 0,
+    );
+
+    for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) {
+        $contents =~ s/$_//g;
+    }
+
+    debug "Got [_1] characters of output.", length $contents;
+
+    $contents = HTML::RewriteAttributes::Links->rewrite(
+        $contents,
+        RT->Config->Get('WebURL') . '/Dashboards/Render.html',
+    );
+
+    email_dashboard($currentuser, $email, $dashboard, $subscription, $contents);
+}
+
+sub email_dashboard {
+    my ($currentuser, $email, $dashboard, $subscription, $content) = @_;
+
+    verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>',
+            $dashboard->Name,
+            $currentuser->Name,
+            $email;
+
+    my $subject = sprintf '[%s] ' .  RT->Config->Get('DashboardSubject'),
+        RT->Config->Get('rtname'),
+        ucfirst($subscription->SubValue('Frequency')),
+        $dashboard->Name;
+
+    my $entity = build_email($content, $from, $email, $subject);
+
+    my $ok = RT::Interface::Email::SendEmail(
+        Entity => $entity,
+    );
+
+    debug "Done sending dashboard to [_1] <[_2]>",
+          $currentuser->Name, $email
+              and return if $ok;
+
+    error 'Failed to email dashboard to user [_1] <[_2]>',
+          $currentuser->Name, $email;
+}
+
+sub build_email {
+    my ($content, $from, $to, $subject) = @_;
+    my @parts;
+    my %cid_of;
+
+    $content = HTML::RewriteAttributes::Resources->rewrite($content, sub {
+            my $uri = shift;
+
+            # already attached this object
+            return "cid:$cid_of{$uri}" if $cid_of{$uri};
+
+            $cid_of{$uri} = time() . $$ . int(rand(1e6));
+            my ($data, $filename, $mimetype, $encoding) = get_resource($uri);
+
+            # downgrade non-text strings, because all strings are utf8 by
+            # default, which is wrong for non-text strings.
+            if ( $mimetype !~ m{text/} ) {
+                utf8::downgrade( $data, 1 ) or warning "downgrade $data failed";
+            }
+
+            push @parts, MIME::Entity->build(
+                Top          => 0,
+                Data         => $data,
+                Type         => $mimetype,
+                Encoding     => $encoding,
+                Disposition  => 'inline',
+                Name         => $filename,
+                'Content-Id' => $cid_of{$uri},
+            );
+
+            return "cid:$cid_of{$uri}";
+        },
+        inline_css => sub {
+            my $uri = shift;
+            my ($content) = get_resource($uri);
+            return $content;
+        },
+        inline_imports => 1,
+    );
+
+    my $entity = MIME::Entity->build(
+        From    => $from,
+        To      => $to,
+        Subject => $subject,
+        Type    => "multipart/mixed",
+    );
+
+    $entity->attach(
+        Data        => Encode::encode_utf8($content),
+        Type        => 'text/html',
+        Charset     => 'UTF-8',
+        Disposition => 'inline',
+    );
+
+    for my $part (@parts) {
+        $entity->add_part($part);
+    }
+
+    return $entity;
+}
+
+sub get_from {
+    RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
+}
+
+{
+    my $mason;
+    my $outbuf = '';
+    my $data_dir = '';
+
+    sub mason {
+        unless ($mason) {
+            debug "Creating Mason object.";
+
+            # user may not have permissions on the data directory, so create a
+            # new one
+            $data_dir = tempdir(CLEANUP => 1);
+
+            $mason = HTML::Mason::Interp->new(
+                RT::Interface::Web::Handler->DefaultHandlerArgs,
+                out_method => \$outbuf,
+                autohandler_name => '', # disable forced login and more
+                data_dir => $data_dir,
+            );
+        }
+        return $mason;
+    }
+
+    sub run_component {
+        mason->exec(@_);
+        my $ret = $outbuf;
+        $outbuf = '';
+        return $ret;
+    }
+}
+
+{
+    my %cache;
+
+    sub hour_dow_dom_in {
+        my $tz = shift;
+        return @{$cache{$tz}} if exists $cache{$tz};
+
+        my ($hour, $dow, $dom);
+
+        {
+            local $ENV{'TZ'} = $tz;
+            ## Using POSIX::tzset fixes a bug where the TZ environment variable
+            ## is cached.
+            tzset();
+            (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
+        }
+        tzset(); # return back previous value
+
+        $hour = "0$hour"
+            if length($hour) == 1;
+        $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
+
+        return @{$cache{$tz}} = ($hour, $dow, $dom);
+    }
+}
+
+sub get_resource {
+    my $uri = URI->new(shift);
+    my ($content, $filename, $mimetype, $encoding);
+
+    verbose "Getting resource [_1]", $uri;
+
+    # strip out the equivalent of WebURL, so we start at the correct /
+    my $path = $uri->path;
+    my $webpath = RT->Config->Get('WebPath');
+    $path =~ s/^\Q$webpath//;
+
+    # add a leading / if needed
+    $path = "/$path"
+        unless $path =~ m{^/};
+
+    # grab the query arguments
+    my %args;
+    for (split /&/, ($uri->query||'')) {
+        my ($k, $v) = /^(.*?)=(.*)$/
+            or die "Unable to parse query parameter '$_'";
+
+        for ($k, $v) { s/%(..)/chr hex $1/ge }
+
+        # no value yet, simple key=value
+        if (!exists $args{$k}) {
+            $args{$k} = $v;
+        }
+        # already have key=value, need to upgrade it to key=[value1, value2]
+        elsif (!ref($args{$k})) {
+            $args{$k} = [$args{$k}, $v];
+        }
+        # already key=[value1, value2], just add the new value
+        else {
+            push @{ $args{$k} }, $v;
+        }
+    }
+
+    debug "Running component '[_1]'", $path;
+    $content = run_component($path, %args);
+
+    # guess at the filename from the component name
+    $filename = $1 if $path =~ m{^.*/(.*?)$};
+
+    # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
+    ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
+
+    my $content_type = $HTML::Mason::Commands::r->content_type;
+    if ($content_type) {
+        $mimetype = $content_type;
+
+        # strip down to just a MIME type
+        $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
+    }
+
+    #If all else fails then some conservative and general-purpose defaults are:
+    $mimetype ||= 'application/octet-stream';
+    $encoding ||= 'base64';
+
+    debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
+        $uri,
+        length($content),
+        $filename,
+        $mimetype,
+        $encoding;
+
+    return ($content, $filename, $mimetype, $encoding);
+}
+
+package RT::Dashboard::FakeRequest;
+sub new { bless {}, shift }
+sub header_out { shift }
+sub headers_out { shift }
+sub content_type {
+    my $self = shift;
+    $self->{content_type} = shift if @_;
+    return $self->{content_type};
+}
+
+=head1 NAME
+
+rt-email-dashboards - Send email dashboards
+
+=head1 SYNOPSIS
+
+    /opt/rt3/local/sbin/rt-email-dashboards [options]
+
+=head1 DESCRIPTION
+
+This tool will send users email based on how they have subscribed to
+dashboards. A dashboard is a set of saved searches, the subscription controls
+how often that dashboard is sent and how it's displayed.
+
+Each subscription has an hour, and possibly day of week or day of month. These
+are taken to be in the user's timezone if available, UTC otherwise.
+
+=head1 SETUP
+
+You'll need to have cron run this script every hour. Here's an example crontab
+entry to do this.
+
+    0 * * * * /usr/bin/perl /opt/rt3/local/sbin/rt-email-dashboards
+
+This will run the script every hour on the hour. This may need some further
+tweaking to be run as the correct user.
+
+=head1 OPTIONS
+
+This tool supports a few options. Most are for debugging.
+
+=over 8
+
+=item --help
+
+Display this documentation
+
+=item --dryrun
+
+Figure out which dashboards would be sent, but don't actually generate them
+
+=item --epoch SECONDS
+
+Instead of using the current time to figure out which dashboards should be
+sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
+be Oct 12 19:06:58 GMT 2007).
+
+=item --verbose
+
+Print out some tracing information (such as which dashboards are being
+generated and sent out)
+
+=item --debug
+
+Print out more tracing information (such as each user and subscription that is
+being considered)
+
+=item --all
+
+Ignore subscription frequency when considering each dashboard (should only be
+used with --dryrun)
+
+=back
+
+=cut
+
diff --git a/rt/sbin/rt-email-dashboards.in b/rt/sbin/rt-email-dashboards.in
new file mode 100644
index 0000000..5565435
--- /dev/null
+++ b/rt/sbin/rt-email-dashboards.in
@@ -0,0 +1,568 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+use RT::Interface::Web;
+use RT::Interface::Web::Handler;
+use RT::Dashboard;
+use RT::Interface::CLI qw{ CleanEnv loc };
+
+use Getopt::Long;
+use HTML::Mason;
+use HTML::RewriteAttributes::Resources;
+use HTML::RewriteAttributes::Links;
+use MIME::Types;
+use POSIX 'tzset';
+use File::Temp 'tempdir';
+
+# Clean out all the nasties from the environment
+CleanEnv();
+
+# Load the config file
+RT::LoadConfig();
+
+# Connect to the database and get RT::SystemUser and RT::Nobody loaded
+RT::Init();
+
+$HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
+
+no warnings 'once';
+
+# Read in the options
+my %opts;
+GetOptions( \%opts,
+    "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl"
+);
+
+if ($opts{'help'}) {
+    require Pod::Usage;
+    import Pod::Usage;
+    pod2usage(-message => "RT Email Dashboards\n", -verbose => 1);
+    exit 1;
+}
+
+# helper functions
+sub verbose  { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 }
+sub debug    { print loc(@_), "\n" if $opts{debug}; 1 }
+sub error    { $RT::Logger->error(loc(@_)); verbose(@_); 1 }
+sub warning  { $RT::Logger->warning(loc(@_)); verbose(@_); 1 }
+
+my $now = $opts{epoch} || time;
+verbose "Using time [_1]", scalar localtime($now);
+
+my $from = get_from();
+debug "Sending email from [_1]", $from;
+
+# look through each user for her subscriptions
+my $Users = RT::Users->new($RT::SystemUser);
+$Users->LimitToPrivileged;
+
+while (defined(my $user = $Users->Next)) {
+    if ($user->PrincipalObj->Disabled) {
+        debug "Skipping over "
+            . $user->Name
+            . " due to having a disabled account.";
+        next;
+    }
+
+    my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone'));
+    $hour .= ':00';
+    debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]",
+          $user->Name, $hour, $dow, $dom;
+
+    my $currentuser = RT::CurrentUser->new;
+    $currentuser->LoadByName($user->Name);
+
+    # look through this user's subscriptions, are any supposed to be generated
+    # right now?
+    for my $subscription ($user->Attributes->Named('Subscription')) {
+        my $counter = $subscription->SubValue('Counter') || 0;
+
+        if (!$opts{all}) {
+            debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]",
+                $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'),
+                $subscription->SubValue('Dow'), $subscription->SubValue('Dom');
+
+            next if $subscription->SubValue('Frequency') eq 'never';
+
+            # correct hour?
+            next if $subscription->SubValue('Hour') ne $hour;
+
+            # if weekly, correct day of week?
+            if ( $subscription->SubValue('Frequency') eq 'weekly' ) {
+                next if $subscription->SubValue('Dow') ne $dow;
+                my $fow       = $subscription->SubValue('Fow') || 1;
+                if ( $counter % $fow ) {
+                    $subscription->SetSubValues( Counter => $counter + 1 )
+                      unless $opts{'dryrun'};
+                    next;
+                }
+            }
+
+            # if monthly, correct day of month?
+            elsif ($subscription->SubValue('Frequency') eq 'monthly') {
+                next if $subscription->SubValue('Dom') != $dom;
+            }
+
+            elsif ($subscription->SubValue('Frequency') eq 'm-f') {
+                next if $dow eq 'Sunday' || $dow eq 'Saturday';
+            }
+        }
+
+        my $email = $subscription->SubValue('Recipient')
+                 || $user->EmailAddress;
+
+        eval { send_dashboard($currentuser, $email, $subscription) };
+        if ( $@ ) {
+            error 'Caught exception: ' . $@;
+        }
+        else {
+            $subscription->SetSubValues(
+                Counter => $counter + 1 )
+              unless $opts{'dryrun'};
+        }
+    }
+}
+
+sub send_dashboard {
+    my ($currentuser, $email, $subscription) = @_;
+
+    my $rows = $subscription->SubValue('Rows');
+
+    my $dashboard = RT::Dashboard->new($currentuser);
+
+    my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId'));
+
+    # failed to load dashboard. perhaps it was deleted or it changed privacy
+    if (!$ok) {
+        warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]",
+            $subscription->SubValue('DashboardId'),
+            $subscription->Id,
+            $currentuser->Name,
+            $msg;
+
+        my $ok = RT::Interface::Email::SendEmailUsingTemplate(
+            From      => $from,
+            To        => $email,
+            Template  => 'Error: Missing dashboard',
+            Arguments => {
+                SubscriptionObj => $subscription,
+            },
+        );
+
+        # only delete the subscription if the email looks like it went through
+        if ($ok) {
+            my ($deleted, $msg) = $subscription->Delete();
+            if ($deleted) {
+                verbose("Deleted an obsolete subscription: [_1]", $msg);
+            }
+            else {
+                warning("Unable to delete an obsolete subscription: [_1]", $msg);
+            }
+        }
+        else {
+            warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name);
+        }
+
+        return;
+    }
+
+    verbose 'Creating dashboard "[_1]" for user "[_2]":',
+            $dashboard->Name,
+            $currentuser->Name;
+
+    if ($opts{'dryrun'}) {
+        print << "SUMMARY";
+    Dashboard: @{[ $dashboard->Name ]}
+    User:   @{[ $currentuser->Name ]} <$email>
+SUMMARY
+        return;
+    }
+
+    $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
+    my $contents = run_component(
+        '/Dashboards/Render.html',
+        id      => $dashboard->Id,
+        Preview => 0,
+    );
+
+    for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) {
+        $contents =~ s/$_//g;
+    }
+
+    debug "Got [_1] characters of output.", length $contents;
+
+    $contents = HTML::RewriteAttributes::Links->rewrite(
+        $contents,
+        RT->Config->Get('WebURL') . '/Dashboards/Render.html',
+    );
+
+    email_dashboard($currentuser, $email, $dashboard, $subscription, $contents);
+}
+
+sub email_dashboard {
+    my ($currentuser, $email, $dashboard, $subscription, $content) = @_;
+
+    verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>',
+            $dashboard->Name,
+            $currentuser->Name,
+            $email;
+
+    my $subject = sprintf '[%s] ' .  RT->Config->Get('DashboardSubject'),
+        RT->Config->Get('rtname'),
+        ucfirst($subscription->SubValue('Frequency')),
+        $dashboard->Name;
+
+    my $entity = build_email($content, $from, $email, $subject);
+
+    my $ok = RT::Interface::Email::SendEmail(
+        Entity => $entity,
+    );
+
+    debug "Done sending dashboard to [_1] <[_2]>",
+          $currentuser->Name, $email
+              and return if $ok;
+
+    error 'Failed to email dashboard to user [_1] <[_2]>',
+          $currentuser->Name, $email;
+}
+
+sub build_email {
+    my ($content, $from, $to, $subject) = @_;
+    my @parts;
+    my %cid_of;
+
+    $content = HTML::RewriteAttributes::Resources->rewrite($content, sub {
+            my $uri = shift;
+
+            # already attached this object
+            return "cid:$cid_of{$uri}" if $cid_of{$uri};
+
+            $cid_of{$uri} = time() . $$ . int(rand(1e6));
+            my ($data, $filename, $mimetype, $encoding) = get_resource($uri);
+
+            # downgrade non-text strings, because all strings are utf8 by
+            # default, which is wrong for non-text strings.
+            if ( $mimetype !~ m{text/} ) {
+                utf8::downgrade( $data, 1 ) or warning "downgrade $data failed";
+            }
+
+            push @parts, MIME::Entity->build(
+                Top          => 0,
+                Data         => $data,
+                Type         => $mimetype,
+                Encoding     => $encoding,
+                Disposition  => 'inline',
+                Name         => $filename,
+                'Content-Id' => $cid_of{$uri},
+            );
+
+            return "cid:$cid_of{$uri}";
+        },
+        inline_css => sub {
+            my $uri = shift;
+            my ($content) = get_resource($uri);
+            return $content;
+        },
+        inline_imports => 1,
+    );
+
+    my $entity = MIME::Entity->build(
+        From    => $from,
+        To      => $to,
+        Subject => $subject,
+        Type    => "multipart/mixed",
+    );
+
+    $entity->attach(
+        Data        => Encode::encode_utf8($content),
+        Type        => 'text/html',
+        Charset     => 'UTF-8',
+        Disposition => 'inline',
+    );
+
+    for my $part (@parts) {
+        $entity->add_part($part);
+    }
+
+    return $entity;
+}
+
+sub get_from {
+    RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
+}
+
+{
+    my $mason;
+    my $outbuf = '';
+    my $data_dir = '';
+
+    sub mason {
+        unless ($mason) {
+            debug "Creating Mason object.";
+
+            # user may not have permissions on the data directory, so create a
+            # new one
+            $data_dir = tempdir(CLEANUP => 1);
+
+            $mason = HTML::Mason::Interp->new(
+                RT::Interface::Web::Handler->DefaultHandlerArgs,
+                out_method => \$outbuf,
+                autohandler_name => '', # disable forced login and more
+                data_dir => $data_dir,
+            );
+        }
+        return $mason;
+    }
+
+    sub run_component {
+        mason->exec(@_);
+        my $ret = $outbuf;
+        $outbuf = '';
+        return $ret;
+    }
+}
+
+{
+    my %cache;
+
+    sub hour_dow_dom_in {
+        my $tz = shift;
+        return @{$cache{$tz}} if exists $cache{$tz};
+
+        my ($hour, $dow, $dom);
+
+        {
+            local $ENV{'TZ'} = $tz;
+            ## Using POSIX::tzset fixes a bug where the TZ environment variable
+            ## is cached.
+            tzset();
+            (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
+        }
+        tzset(); # return back previous value
+
+        $hour = "0$hour"
+            if length($hour) == 1;
+        $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
+
+        return @{$cache{$tz}} = ($hour, $dow, $dom);
+    }
+}
+
+sub get_resource {
+    my $uri = URI->new(shift);
+    my ($content, $filename, $mimetype, $encoding);
+
+    verbose "Getting resource [_1]", $uri;
+
+    # strip out the equivalent of WebURL, so we start at the correct /
+    my $path = $uri->path;
+    my $webpath = RT->Config->Get('WebPath');
+    $path =~ s/^\Q$webpath//;
+
+    # add a leading / if needed
+    $path = "/$path"
+        unless $path =~ m{^/};
+
+    # grab the query arguments
+    my %args;
+    for (split /&/, ($uri->query||'')) {
+        my ($k, $v) = /^(.*?)=(.*)$/
+            or die "Unable to parse query parameter '$_'";
+
+        for ($k, $v) { s/%(..)/chr hex $1/ge }
+
+        # no value yet, simple key=value
+        if (!exists $args{$k}) {
+            $args{$k} = $v;
+        }
+        # already have key=value, need to upgrade it to key=[value1, value2]
+        elsif (!ref($args{$k})) {
+            $args{$k} = [$args{$k}, $v];
+        }
+        # already key=[value1, value2], just add the new value
+        else {
+            push @{ $args{$k} }, $v;
+        }
+    }
+
+    debug "Running component '[_1]'", $path;
+    $content = run_component($path, %args);
+
+    # guess at the filename from the component name
+    $filename = $1 if $path =~ m{^.*/(.*?)$};
+
+    # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
+    ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
+
+    my $content_type = $HTML::Mason::Commands::r->content_type;
+    if ($content_type) {
+        $mimetype = $content_type;
+
+        # strip down to just a MIME type
+        $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
+    }
+
+    #If all else fails then some conservative and general-purpose defaults are:
+    $mimetype ||= 'application/octet-stream';
+    $encoding ||= 'base64';
+
+    debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
+        $uri,
+        length($content),
+        $filename,
+        $mimetype,
+        $encoding;
+
+    return ($content, $filename, $mimetype, $encoding);
+}
+
+package RT::Dashboard::FakeRequest;
+sub new { bless {}, shift }
+sub header_out { shift }
+sub headers_out { shift }
+sub content_type {
+    my $self = shift;
+    $self->{content_type} = shift if @_;
+    return $self->{content_type};
+}
+
+=head1 NAME
+
+rt-email-dashboards - Send email dashboards
+
+=head1 SYNOPSIS
+
+    /opt/rt3/local/sbin/rt-email-dashboards [options]
+
+=head1 DESCRIPTION
+
+This tool will send users email based on how they have subscribed to
+dashboards. A dashboard is a set of saved searches, the subscription controls
+how often that dashboard is sent and how it's displayed.
+
+Each subscription has an hour, and possibly day of week or day of month. These
+are taken to be in the user's timezone if available, UTC otherwise.
+
+=head1 SETUP
+
+You'll need to have cron run this script every hour. Here's an example crontab
+entry to do this.
+
+    0 * * * * @PERL@ /opt/rt3/local/sbin/rt-email-dashboards
+
+This will run the script every hour on the hour. This may need some further
+tweaking to be run as the correct user.
+
+=head1 OPTIONS
+
+This tool supports a few options. Most are for debugging.
+
+=over 8
+
+=item --help
+
+Display this documentation
+
+=item --dryrun
+
+Figure out which dashboards would be sent, but don't actually generate them
+
+=item --epoch SECONDS
+
+Instead of using the current time to figure out which dashboards should be
+sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
+be Oct 12 19:06:58 GMT 2007).
+
+=item --verbose
+
+Print out some tracing information (such as which dashboards are being
+generated and sent out)
+
+=item --debug
+
+Print out more tracing information (such as each user and subscription that is
+being considered)
+
+=item --all
+
+Ignore subscription frequency when considering each dashboard (should only be
+used with --dryrun)
+
+=back
+
+=cut
+
diff --git a/rt/sbin/rt-email-digest b/rt/sbin/rt-email-digest
new file mode 100755
index 0000000..29ee1cb
--- /dev/null
+++ b/rt/sbin/rt-email-digest
@@ -0,0 +1,337 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use warnings;
+use strict;
+
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use Date::Format qw( strftime );
+use Getopt::Long;
+use RT;
+use RT::Interface::CLI qw( CleanEnv loc );
+use RT::Interface::Email;
+
+CleanEnv();
+RT::LoadConfig();
+RT::Init();
+
+sub usage {
+    my ($error) = @_;
+    print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n";
+    print loc(
+        "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
+        $0
+    ) . "\n";
+    print "\n\t-m, --mode\t"
+        . loc("Specify whether this is a daily or weekly run.") . "\n";
+    print "\t-p, --print\t"
+        . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
+        . "\n";
+    print "\t-h, --help\t" . loc("Print this message") . "\n";
+
+    if ( $error eq 'help' ) {
+        exit 0;
+    } else {
+        print loc("Error") . ": " . loc($error) . "\n";
+        exit 1;
+    }
+}
+
+my ( $frequency, $print, $help ) = ( '', '', '' );
+GetOptions(
+    'mode=s' => \$frequency,
+    'print'  => \$print,
+    'help'   => \$help,
+);
+
+usage('help') if $help;
+usage("Mode argument must be 'daily' or 'weekly'")
+    unless $frequency =~ /^(daily|weekly)$/;
+
+run( $frequency, $print );
+
+sub run {
+    my $frequency = shift;
+    my $print     = shift;
+
+## Find all the tickets that have been modified within the time frame
+##    described by $frequency.
+
+    my ( $all_digest, $sent_transactions ) = find_transactions($frequency);
+
+## Iterate through our huge hash constructing the digest message
+##    for each user and sending it.
+
+    foreach my $user ( keys %$all_digest ) {
+        my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
+        # Now we have a content head and a content body.  We can send a message.
+        if ( send_digest( $user, $contents_list, $contents_body ) ) {
+            print "Sent message to $user\n";
+            mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
+        } else {
+            print "Failed to send message to $user\n";
+        }
+    }
+}
+exit 0;
+
+# Subroutines.
+
+sub send_digest {
+    my ( $to, $index, $messages ) = @_;
+
+    # Combine the index and the messages.
+
+    my $body = "============== Tickets with activity in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+
+    $body .= $index;
+    $body .= "\n\n============== Messages recorded in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+    $body .= $messages;
+
+    # Load our template.  If we cannot load the template, abort
+    # immediately rather than failing through many loops.
+    my $digest_template = RT::Template->new( RT->SystemUser );
+    my ( $ret, $msg ) = $digest_template->Load('Email Digest');
+    unless ($ret) {
+        print loc("Failed to load template")
+            . " 'Email Digest': "
+            . $msg
+            . ".  Cannot continue.\n";
+        exit 1;
+    }
+    ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
+    unless ($ret) {
+        print loc("Failed to parse template")
+            . " 'Email Digest'.  Cannot continue.\n";
+        exit 1;
+    }
+
+    # Set our sender and recipient.
+    $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') );
+    $digest_template->MIMEObj->head->replace( 'To',   $to );
+
+    if ($print) {
+        $digest_template->MIMEObj->print;
+        return 1;
+    } else {
+        return  RT::Interface::Email::SendEmail( Entity      => $digest_template->MIMEObj)
+    }
+}
+
+=item mark_transactions_sent( $frequency, $user, @txn_list );
+
+Takes a frequency string (either 'daily' or 'weekly'), a user  and one or more
+transaction objects as its arguments.  Marks the given deferred
+notifications as sent.
+
+=cut
+
+sub mark_transactions_sent {
+    my ( $freq, $user, @txns ) = @_;
+    return unless $freq =~ /(daily|weekly)/;
+    return unless @txns;
+    foreach my $txn (@txns) {
+
+        # Grab the attribute, mark the "sent" as true, and store the new
+        # value.
+        if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
+            my $deferred = $attr->Content;
+            $deferred->{$freq}->{$user}->{'_sent'} = 1;
+            $txn->SetAttribute(
+                Name        => 'DeferredRecipients',
+                Description => 'Deferred recipients for this message',
+                Content     => $deferred,
+            );
+        }
+    }
+}
+
+sub since_date {
+    my $frequency = shift;
+
+    # Specify a short time for digest overlap, in case we aren't starting
+    # this process exactly on time.
+    my $OVERLAP_HEDGE = -30;
+
+    my $since_date = RT::Date->new( RT->SystemUser );
+    $since_date->Set( Format => 'unix', Value => time() );
+    if ( $frequency eq 'daily' ) {
+        $since_date->AddDays(-1);
+    } else {
+        $since_date->AddDays(-7);
+    }
+
+    $since_date->AddSeconds($OVERLAP_HEDGE);
+
+    return $since_date;
+}
+
+sub find_transactions {
+    my $frequency  = shift;
+    my $since_date = since_date($frequency);
+
+    my $txns = RT::Transactions->new( RT->SystemUser );
+
+    # First limit to recent transactions.
+    $txns->Limit(
+        FIELD    => 'Created',
+        OPERATOR => '>',
+        VALUE    => $since_date->ISO
+    );
+
+    # Next limit to ticket transactions.
+    $txns->Limit(
+        FIELD           => 'ObjectType',
+        OPERATOR        => '=',
+        VALUE           => 'RT::Ticket',
+        ENTRYAGGREGATOR => 'AND'
+    );
+    my $all_digest        = {};
+    my $sent_transactions = {};
+
+    while ( my $txn = $txns->Next ) {
+        my $ticket = $txn->Ticket;
+        my $queue  = $txn->TicketObj->QueueObj->Name;
+        # Xxx todo - may clobber if two queues have the same name
+        foreach my $user ( $txn->DeferredRecipients($frequency) ) {
+            $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj;
+            $sent_transactions->{$user}->{ $txn->id } = $txn;
+        }
+    }
+
+    return ( $all_digest, $sent_transactions );
+}
+
+sub build_digest_for_user {
+    my $user        = shift;
+    my $user_digest = shift;
+
+    my $contents_list = '';    # Holds the digest index.
+    my $contents_body = '';    # Holds the digest body.
+
+    # Has the user been disabled since a message was deferred on his/her
+    # behalf?
+    my $user_obj = RT::User->new( RT->SystemUser );
+    $user_obj->LoadByEmail($user);
+    if ( $user_obj->PrincipalObj->Disabled ) {
+        print STDERR loc("Skipping disabled user") . " $user\n";
+        next;
+    }
+
+    print loc("Message for user") . " $user:\n\n" if $print;
+    foreach my $queue ( keys %$user_digest ) {
+        $contents_list .= "Queue $queue:\n";
+        $contents_body .= "Queue $queue:\n";
+        foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
+            my $tkt_txns   = $user_digest->{$queue}->{$ticket};
+            my $ticket_obj = RT::Ticket->new( RT->SystemUser );
+            $ticket_obj->Load($ticket);
+
+            # Spit out the index entry for this ticket.
+            my $ticket_title = sprintf(
+                "#%d %s [%s]\t%s\n",
+                $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
+                $ticket_obj->Subject
+            );
+            $contents_list .= $ticket_title;
+
+            # Spit out the messages for the transactions on this ticket.
+            $contents_body .= "\n== $ticket_title\n";
+            foreach my $txn ( sort keys %$tkt_txns ) {
+                my $msg = $tkt_txns->{$txn};
+
+                # $msg contains an RT::Attachment with our outgoing
+                # message.  Print a few headers for clarity's sake.
+                $contents_body .= "From: " . $msg->GetHeader('From') . "\n";
+                my $date = $msg->GetHeader('Date ');
+                unless ($date) {
+                    my $txn_obj = RT::Transaction->new( RT->SystemUser );
+                    $txn_obj->Load($txn);
+                    my $date_obj = RT::Date->new( RT->SystemUser );
+                    $date_obj->Set(
+                        Format => 'sql',
+                        Value  => $txn_obj->Created
+                    );
+                    $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
+                        @{ [ localtime( $date_obj->Unix ) ] } );
+                }
+                $contents_body .= "Date: $date\n\n";
+                $contents_body .= $msg->Content . "\n";
+                $contents_body .= "-------\n";
+            }    # foreach transaction
+        }    # foreach ticket
+    }    # foreach queue
+
+    return ( $contents_list, $contents_body );
+
+}
diff --git a/rt/sbin/rt-email-digest.in b/rt/sbin/rt-email-digest.in
new file mode 100644
index 0000000..2fc7c00
--- /dev/null
+++ b/rt/sbin/rt-email-digest.in
@@ -0,0 +1,337 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use warnings;
+use strict;
+
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use Date::Format qw( strftime );
+use Getopt::Long;
+use RT;
+use RT::Interface::CLI qw( CleanEnv loc );
+use RT::Interface::Email;
+
+CleanEnv();
+RT::LoadConfig();
+RT::Init();
+
+sub usage {
+    my ($error) = @_;
+    print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n";
+    print loc(
+        "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
+        $0
+    ) . "\n";
+    print "\n\t-m, --mode\t"
+        . loc("Specify whether this is a daily or weekly run.") . "\n";
+    print "\t-p, --print\t"
+        . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
+        . "\n";
+    print "\t-h, --help\t" . loc("Print this message") . "\n";
+
+    if ( $error eq 'help' ) {
+        exit 0;
+    } else {
+        print loc("Error") . ": " . loc($error) . "\n";
+        exit 1;
+    }
+}
+
+my ( $frequency, $print, $help ) = ( '', '', '' );
+GetOptions(
+    'mode=s' => \$frequency,
+    'print'  => \$print,
+    'help'   => \$help,
+);
+
+usage('help') if $help;
+usage("Mode argument must be 'daily' or 'weekly'")
+    unless $frequency =~ /^(daily|weekly)$/;
+
+run( $frequency, $print );
+
+sub run {
+    my $frequency = shift;
+    my $print     = shift;
+
+## Find all the tickets that have been modified within the time frame
+##    described by $frequency.
+
+    my ( $all_digest, $sent_transactions ) = find_transactions($frequency);
+
+## Iterate through our huge hash constructing the digest message
+##    for each user and sending it.
+
+    foreach my $user ( keys %$all_digest ) {
+        my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
+        # Now we have a content head and a content body.  We can send a message.
+        if ( send_digest( $user, $contents_list, $contents_body ) ) {
+            print "Sent message to $user\n";
+            mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
+        } else {
+            print "Failed to send message to $user\n";
+        }
+    }
+}
+exit 0;
+
+# Subroutines.
+
+sub send_digest {
+    my ( $to, $index, $messages ) = @_;
+
+    # Combine the index and the messages.
+
+    my $body = "============== Tickets with activity in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+
+    $body .= $index;
+    $body .= "\n\n============== Messages recorded in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+    $body .= $messages;
+
+    # Load our template.  If we cannot load the template, abort
+    # immediately rather than failing through many loops.
+    my $digest_template = RT::Template->new( RT->SystemUser );
+    my ( $ret, $msg ) = $digest_template->Load('Email Digest');
+    unless ($ret) {
+        print loc("Failed to load template")
+            . " 'Email Digest': "
+            . $msg
+            . ".  Cannot continue.\n";
+        exit 1;
+    }
+    ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
+    unless ($ret) {
+        print loc("Failed to parse template")
+            . " 'Email Digest'.  Cannot continue.\n";
+        exit 1;
+    }
+
+    # Set our sender and recipient.
+    $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') );
+    $digest_template->MIMEObj->head->replace( 'To',   $to );
+
+    if ($print) {
+        $digest_template->MIMEObj->print;
+        return 1;
+    } else {
+        return  RT::Interface::Email::SendEmail( Entity      => $digest_template->MIMEObj)
+    }
+}
+
+=item mark_transactions_sent( $frequency, $user, @txn_list );
+
+Takes a frequency string (either 'daily' or 'weekly'), a user  and one or more
+transaction objects as its arguments.  Marks the given deferred
+notifications as sent.
+
+=cut
+
+sub mark_transactions_sent {
+    my ( $freq, $user, @txns ) = @_;
+    return unless $freq =~ /(daily|weekly)/;
+    return unless @txns;
+    foreach my $txn (@txns) {
+
+        # Grab the attribute, mark the "sent" as true, and store the new
+        # value.
+        if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
+            my $deferred = $attr->Content;
+            $deferred->{$freq}->{$user}->{'_sent'} = 1;
+            $txn->SetAttribute(
+                Name        => 'DeferredRecipients',
+                Description => 'Deferred recipients for this message',
+                Content     => $deferred,
+            );
+        }
+    }
+}
+
+sub since_date {
+    my $frequency = shift;
+
+    # Specify a short time for digest overlap, in case we aren't starting
+    # this process exactly on time.
+    my $OVERLAP_HEDGE = -30;
+
+    my $since_date = RT::Date->new( RT->SystemUser );
+    $since_date->Set( Format => 'unix', Value => time() );
+    if ( $frequency eq 'daily' ) {
+        $since_date->AddDays(-1);
+    } else {
+        $since_date->AddDays(-7);
+    }
+
+    $since_date->AddSeconds($OVERLAP_HEDGE);
+
+    return $since_date;
+}
+
+sub find_transactions {
+    my $frequency  = shift;
+    my $since_date = since_date($frequency);
+
+    my $txns = RT::Transactions->new( RT->SystemUser );
+
+    # First limit to recent transactions.
+    $txns->Limit(
+        FIELD    => 'Created',
+        OPERATOR => '>',
+        VALUE    => $since_date->ISO
+    );
+
+    # Next limit to ticket transactions.
+    $txns->Limit(
+        FIELD           => 'ObjectType',
+        OPERATOR        => '=',
+        VALUE           => 'RT::Ticket',
+        ENTRYAGGREGATOR => 'AND'
+    );
+    my $all_digest        = {};
+    my $sent_transactions = {};
+
+    while ( my $txn = $txns->Next ) {
+        my $ticket = $txn->Ticket;
+        my $queue  = $txn->TicketObj->QueueObj->Name;
+        # Xxx todo - may clobber if two queues have the same name
+        foreach my $user ( $txn->DeferredRecipients($frequency) ) {
+            $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj;
+            $sent_transactions->{$user}->{ $txn->id } = $txn;
+        }
+    }
+
+    return ( $all_digest, $sent_transactions );
+}
+
+sub build_digest_for_user {
+    my $user        = shift;
+    my $user_digest = shift;
+
+    my $contents_list = '';    # Holds the digest index.
+    my $contents_body = '';    # Holds the digest body.
+
+    # Has the user been disabled since a message was deferred on his/her
+    # behalf?
+    my $user_obj = RT::User->new( RT->SystemUser );
+    $user_obj->LoadByEmail($user);
+    if ( $user_obj->PrincipalObj->Disabled ) {
+        print STDERR loc("Skipping disabled user") . " $user\n";
+        next;
+    }
+
+    print loc("Message for user") . " $user:\n\n" if $print;
+    foreach my $queue ( keys %$user_digest ) {
+        $contents_list .= "Queue $queue:\n";
+        $contents_body .= "Queue $queue:\n";
+        foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
+            my $tkt_txns   = $user_digest->{$queue}->{$ticket};
+            my $ticket_obj = RT::Ticket->new( RT->SystemUser );
+            $ticket_obj->Load($ticket);
+
+            # Spit out the index entry for this ticket.
+            my $ticket_title = sprintf(
+                "#%d %s [%s]\t%s\n",
+                $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
+                $ticket_obj->Subject
+            );
+            $contents_list .= $ticket_title;
+
+            # Spit out the messages for the transactions on this ticket.
+            $contents_body .= "\n== $ticket_title\n";
+            foreach my $txn ( sort keys %$tkt_txns ) {
+                my $msg = $tkt_txns->{$txn};
+
+                # $msg contains an RT::Attachment with our outgoing
+                # message.  Print a few headers for clarity's sake.
+                $contents_body .= "From: " . $msg->GetHeader('From') . "\n";
+                my $date = $msg->GetHeader('Date ');
+                unless ($date) {
+                    my $txn_obj = RT::Transaction->new( RT->SystemUser );
+                    $txn_obj->Load($txn);
+                    my $date_obj = RT::Date->new( RT->SystemUser );
+                    $date_obj->Set(
+                        Format => 'sql',
+                        Value  => $txn_obj->Created
+                    );
+                    $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
+                        @{ [ localtime( $date_obj->Unix ) ] } );
+                }
+                $contents_body .= "Date: $date\n\n";
+                $contents_body .= $msg->Content . "\n";
+                $contents_body .= "-------\n";
+            }    # foreach transaction
+        }    # foreach ticket
+    }    # foreach queue
+
+    return ( $contents_list, $contents_body );
+
+}
diff --git a/rt/sbin/rt-email-group-admin b/rt/sbin/rt-email-group-admin
new file mode 100755
index 0000000..75b51a5
--- /dev/null
+++ b/rt/sbin/rt-email-group-admin
@@ -0,0 +1,508 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+=head1 NAME
+
+rt-email-group-admin - Command line tool for administrating NotifyGroup actions
+
+=head1 SYNOPSIS
+
+    rt-email-group-admin --list
+    rt-email-group-admin --create 'Notify foo team' --group Foo
+    rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo
+    rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar
+    rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com
+    rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com
+    rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com
+    rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs'
+    rt-email-group-admin --switch 'Notify VIPs'
+    rt-email-group-admin --delete 'Notify user foo@bar.com'
+
+=head1 DESCRIPTION
+
+This script list, create, modify or delete scrip actions in the RT DB. Once
+you've created an action you can use it in a scrip.
+
+For example you can create the following action using this script:
+
+    rt-email-group-admin --create 'Notify developers' --group 'Development Team'
+
+Then you can add the followoing scrip to your Bugs queue:
+    
+    Condition: On Create
+    Action:    Notify developers
+    Template:  Transaction
+    Stage:     TransactionCreate
+
+Your development team will be notified on every new ticket in the queue.
+
+=cut
+
+use warnings;
+use strict;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+RT::LoadConfig;
+RT::Init;
+
+require RT::Principal;
+require RT::User;
+require RT::Group;
+require RT::ScripActions;
+
+use Getopt::Long qw(GetOptions);
+
+our $cmd = 'usage';
+our $opts = {};
+
+sub parse_args {
+    my $tmp;
+    Getopt::Long::Configure( "pass_through" );
+    if ( GetOptions( 'list' => \$tmp ) && $tmp ) {
+        $cmd = 'list';
+    }
+    elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) {
+        $cmd = 'create';
+        $opts->{'name'} = $tmp;
+        $opts->{'groups'} = [];
+        $opts->{'users'} = [];
+        GetOptions( 'comment' => \$opts->{'comment'} );
+        GetOptions( 'group:s@' => $opts->{'groups'} );
+        GetOptions( 'user:s@' => $opts->{'users'} );
+        unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) {
+        $cmd = 'add';
+        $opts->{'name'} = $tmp;
+        $opts->{'groups'} = [];
+        $opts->{'users'} = [];
+        GetOptions( 'group:s@' => $opts->{'groups'} );
+        GetOptions( 'user:s@' => $opts->{'users'} );
+        unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) {
+        $cmd = 'switch';
+        $opts->{'name'} = $tmp;
+    }
+    elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) {
+        $cmd = 'rename';
+        $opts->{'name'} = $tmp;
+        GetOptions( 'newname=s' => \$opts->{'newname'} );
+        unless ( $opts->{'newname'} ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) {
+        $cmd = 'delete';
+        $opts->{'name'} = $tmp;
+    } else {
+        $cmd = 'usage';
+    }
+    
+    return;
+}
+
+sub usage {
+    local $@;
+    eval "require Pod::PlainText;";
+    if ( $@ ) {
+        print "see `perldoc $0`\n";
+    } else {
+        my $parser = Pod::PlainText->new( sentence => 0, width => 78 );
+        $parser->parse_from_file( $0 );
+    }
+}
+
+parse_args();
+
+{
+    eval "main::$cmd()";
+    if ( $@ ) {
+        print STDERR $@ ."\n";
+    }
+}
+
+exit(0);
+
+=head1 USAGE
+
+rt-email-group-admin --COMMAND ARGS
+
+=head1 COMMANDS
+
+=head2 list
+
+Lists actions and its descriptions.
+
+=cut
+
+sub list {
+    my $actions = _get_our_actions();
+    while( my $a = $actions->Next ) {
+        _list( $a );
+    }
+    return;
+}
+
+sub _list {
+    my $action = shift;
+
+    print "Name: ". $action->Name() ."\n";
+    print "Module: ". $action->ExecModule() ."\n";
+
+    my @princ = argument_to_list( $action );
+
+    print "Members: \n";
+    foreach( @princ ) {
+        my $obj = RT::Principal->new( $RT::SystemUser );
+        $obj->Load( $_ );
+        next unless $obj->id;
+
+        print "\t". $obj->PrincipalType;
+        print "\t=> ". $obj->Object->Name;
+        print "(Disabled!!!)" if $obj->Disabled;
+        print "\n";
+    }
+    print "\n";
+    return;
+}
+
+=head2 create NAME [--comment] [--group GNAME] [--user UNAME]
+
+Creates new action with NAME and adds users and/or groups to its
+recipient list. Would be notify as comment if --comment specified.
+
+=cut
+
+sub create {
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit(
+        FIELD => 'Name',
+        VALUE => $opts->{'name'},
+    );
+    if ( $actions->Count ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n";
+        exit(-1);
+    }
+
+    my @groups = _check_groups( @{ $opts->{'groups'} } );
+    my @users  = _check_users( @{ $opts->{'users'} } );    
+    unless ( @users + @groups ) {
+        print STDERR "List of groups and users is empty\n";
+        exit(-1);
+    }
+
+    my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} );
+
+    __add( $action, $_ ) foreach( @users );
+    __add( $action, $_ ) foreach( @groups );
+
+    return;
+}
+
+sub __create_empty {
+    my $name = shift;
+    my $as_comment = shift || 0;
+    require RT::ScripAction;
+    my $action = RT::ScripAction->new( $RT::SystemUser );
+    $action->Create(
+        Name => $name,
+        Description => "Created with rt-email-group-admin script",
+        ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup',
+        Argument => '',
+    );
+
+    return $action;
+}
+
+sub _check_groups
+{
+    return grep { $_ ? 1: do { print STDERR "Group '$_' skipped, doesn't exist\n"; 0; } }
+        map { __check_group($_) } @_;
+}
+
+sub __check_group
+{
+    my $instance = shift;
+    require RT::Group;
+    my $obj = RT::Group->new( $RT::SystemUser );
+    $obj->LoadUserDefinedGroup( $instance );
+    return $obj->id ? $obj : undef;
+}
+
+sub _check_users
+{
+    return grep { $_ ? 1: do { print STDERR "User '$_' skipped, doesn't exist\n"; 0; } }
+        map { __check_user($_) } @_;
+}
+
+sub __check_user
+{
+    my $instance = shift;
+    require RT::User;
+    my $obj = RT::User->new( $RT::SystemUser );
+    $obj->Load( $instance );
+    return $obj->id ? $obj : undef;
+}
+
+=head2 add NAME [--group GNAME] [--user UNAME]
+
+Adds groups and/or users to recipients of the action NAME.
+
+=cut
+
+sub add {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my @groups = _check_groups( @{ $opts->{'groups'} } );
+    my @users = _check_users( @{ $opts->{'users'} } );
+    
+    unless ( @users + @groups ) {
+        print STDERR "List of groups and users is empty\n";
+        exit(-1);
+    }
+
+    __add( $action, $_ ) foreach @users;
+    __add( $action, $_ ) foreach @groups;
+
+    return;
+}
+
+sub __add
+{
+    my $action = shift;
+    my $obj = shift;
+
+    my @cur = argument_to_list( $action );
+
+    my $id = $obj->id;
+    return if grep $_ == $id, @cur;
+
+    push @cur, $id;
+
+    return $action->__Set( Field => 'Argument', Value => join(',', @cur) );
+}
+
+=head2 delete NAME
+
+Deletes action NAME if scrips doesn't use it.
+
+=cut
+
+sub delete {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    require RT::Scrips;
+    my $scrips = RT::Scrips->new( $RT::SystemUser );
+    $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id );
+    if ( $scrips->Count ) {
+        my @sid;
+        while( my $s = $scrips->Next ) {
+            push @sid, $s->id;
+        }
+        print STDERR "ScripAction '". $opts->{'name'} ."'"
+            . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid )
+            . "\n";
+        exit(-1);
+    }
+
+    return __delete( $action );
+}
+
+sub __delete {
+    require DBIx::SearchBuilder::Record;
+    return DBIx::SearchBuilder::Record::Delete( shift );
+}
+
+sub _get_action_by_name {
+    my $name = shift;
+    my $actions = _get_our_actions();
+    $actions->Limit(
+        FIELD => 'Name',
+        VALUE => $name
+    );
+
+    if ( $actions->Count > 1 ) {
+        print STDERR "More then one ScripAction with name '$name'\n";
+    }
+
+    return $actions->First;
+}
+
+=head2 switch NAME
+
+Switch action NAME from notify as correspondence to comment and back.
+
+=cut
+
+sub switch {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my %h = (
+        NotifyGroup => 'NotifyGroupAsComment',
+        NotifyGroupAsComment => 'NotifyGroup'
+    );
+
+    return $action->__Set(
+        Field => 'ExecModule',
+        Value => $h{ $action->ExecModule }
+    );
+}
+
+=head2 rename NAME --newname NEWNAME
+
+Renames action NAME to NEWNAME.
+
+=cut
+
+sub rename {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} );
+    if ( $actions->Count ) {
+        print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n";
+        exit(-1);
+    }
+
+    return $action->__Set(
+        Field => 'Name',
+        Value => $opts->{'newname'},
+    );
+}
+
+=head2 NOTES
+
+If command has option --group or --user then you can use it more then once,
+if other is not specified.
+
+=cut
+
+###############
+#### Utils ####
+###############
+
+sub argument_to_list {
+    my $action = shift;
+    require RT::Action::NotifyGroup;
+    return RT::Action::NotifyGroup->__SplitArg( $action->Argument );
+}
+
+sub _get_our_actions {
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit(
+        FIELD => 'ExecModule',
+        VALUE => 'NotifyGroup',
+        ENTRYAGGREGATOR => 'OR',
+    );
+    $actions->Limit(
+        FIELD => 'ExecModule',
+        VALUE => 'NotifyGroupAsComment',
+        ENTRYAGGREGATOR => 'OR',
+    );
+
+    return $actions;
+}
+
+=head1 AUTHOR
+
+Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt>
+
+=head1 SEE ALSO
+
+L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment>
+
+=cut
diff --git a/rt/sbin/rt-email-group-admin.in b/rt/sbin/rt-email-group-admin.in
new file mode 100755
index 0000000..dd6548f
--- /dev/null
+++ b/rt/sbin/rt-email-group-admin.in
@@ -0,0 +1,508 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+=head1 NAME
+
+rt-email-group-admin - Command line tool for administrating NotifyGroup actions
+
+=head1 SYNOPSIS
+
+    rt-email-group-admin --list
+    rt-email-group-admin --create 'Notify foo team' --group Foo
+    rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo
+    rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar
+    rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com
+    rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com
+    rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com
+    rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs'
+    rt-email-group-admin --switch 'Notify VIPs'
+    rt-email-group-admin --delete 'Notify user foo@bar.com'
+
+=head1 DESCRIPTION
+
+This script list, create, modify or delete scrip actions in the RT DB. Once
+you've created an action you can use it in a scrip.
+
+For example you can create the following action using this script:
+
+    rt-email-group-admin --create 'Notify developers' --group 'Development Team'
+
+Then you can add the followoing scrip to your Bugs queue:
+    
+    Condition: On Create
+    Action:    Notify developers
+    Template:  Transaction
+    Stage:     TransactionCreate
+
+Your development team will be notified on every new ticket in the queue.
+
+=cut
+
+use warnings;
+use strict;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+RT::LoadConfig;
+RT::Init;
+
+require RT::Principal;
+require RT::User;
+require RT::Group;
+require RT::ScripActions;
+
+use Getopt::Long qw(GetOptions);
+
+our $cmd = 'usage';
+our $opts = {};
+
+sub parse_args {
+    my $tmp;
+    Getopt::Long::Configure( "pass_through" );
+    if ( GetOptions( 'list' => \$tmp ) && $tmp ) {
+        $cmd = 'list';
+    }
+    elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) {
+        $cmd = 'create';
+        $opts->{'name'} = $tmp;
+        $opts->{'groups'} = [];
+        $opts->{'users'} = [];
+        GetOptions( 'comment' => \$opts->{'comment'} );
+        GetOptions( 'group:s@' => $opts->{'groups'} );
+        GetOptions( 'user:s@' => $opts->{'users'} );
+        unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) {
+        $cmd = 'add';
+        $opts->{'name'} = $tmp;
+        $opts->{'groups'} = [];
+        $opts->{'users'} = [];
+        GetOptions( 'group:s@' => $opts->{'groups'} );
+        GetOptions( 'user:s@' => $opts->{'users'} );
+        unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) {
+        $cmd = 'switch';
+        $opts->{'name'} = $tmp;
+    }
+    elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) {
+        $cmd = 'rename';
+        $opts->{'name'} = $tmp;
+        GetOptions( 'newname=s' => \$opts->{'newname'} );
+        unless ( $opts->{'newname'} ) {
+            usage();
+            exit(-1);
+        }
+    }
+    elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) {
+        $cmd = 'delete';
+        $opts->{'name'} = $tmp;
+    } else {
+        $cmd = 'usage';
+    }
+    
+    return;
+}
+
+sub usage {
+    local $@;
+    eval "require Pod::PlainText;";
+    if ( $@ ) {
+        print "see `perldoc $0`\n";
+    } else {
+        my $parser = Pod::PlainText->new( sentence => 0, width => 78 );
+        $parser->parse_from_file( $0 );
+    }
+}
+
+parse_args();
+
+{
+    eval "main::$cmd()";
+    if ( $@ ) {
+        print STDERR $@ ."\n";
+    }
+}
+
+exit(0);
+
+=head1 USAGE
+
+rt-email-group-admin --COMMAND ARGS
+
+=head1 COMMANDS
+
+=head2 list
+
+Lists actions and its descriptions.
+
+=cut
+
+sub list {
+    my $actions = _get_our_actions();
+    while( my $a = $actions->Next ) {
+        _list( $a );
+    }
+    return;
+}
+
+sub _list {
+    my $action = shift;
+
+    print "Name: ". $action->Name() ."\n";
+    print "Module: ". $action->ExecModule() ."\n";
+
+    my @princ = argument_to_list( $action );
+
+    print "Members: \n";
+    foreach( @princ ) {
+        my $obj = RT::Principal->new( $RT::SystemUser );
+        $obj->Load( $_ );
+        next unless $obj->id;
+
+        print "\t". $obj->PrincipalType;
+        print "\t=> ". $obj->Object->Name;
+        print "(Disabled!!!)" if $obj->Disabled;
+        print "\n";
+    }
+    print "\n";
+    return;
+}
+
+=head2 create NAME [--comment] [--group GNAME] [--user UNAME]
+
+Creates new action with NAME and adds users and/or groups to its
+recipient list. Would be notify as comment if --comment specified.
+
+=cut
+
+sub create {
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit(
+        FIELD => 'Name',
+        VALUE => $opts->{'name'},
+    );
+    if ( $actions->Count ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n";
+        exit(-1);
+    }
+
+    my @groups = _check_groups( @{ $opts->{'groups'} } );
+    my @users  = _check_users( @{ $opts->{'users'} } );    
+    unless ( @users + @groups ) {
+        print STDERR "List of groups and users is empty\n";
+        exit(-1);
+    }
+
+    my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} );
+
+    __add( $action, $_ ) foreach( @users );
+    __add( $action, $_ ) foreach( @groups );
+
+    return;
+}
+
+sub __create_empty {
+    my $name = shift;
+    my $as_comment = shift || 0;
+    require RT::ScripAction;
+    my $action = RT::ScripAction->new( $RT::SystemUser );
+    $action->Create(
+        Name => $name,
+        Description => "Created with rt-email-group-admin script",
+        ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup',
+        Argument => '',
+    );
+
+    return $action;
+}
+
+sub _check_groups
+{
+    return grep { $_ ? 1: do { print STDERR "Group '$_' skipped, doesn't exist\n"; 0; } }
+        map { __check_group($_) } @_;
+}
+
+sub __check_group
+{
+    my $instance = shift;
+    require RT::Group;
+    my $obj = RT::Group->new( $RT::SystemUser );
+    $obj->LoadUserDefinedGroup( $instance );
+    return $obj->id ? $obj : undef;
+}
+
+sub _check_users
+{
+    return grep { $_ ? 1: do { print STDERR "User '$_' skipped, doesn't exist\n"; 0; } }
+        map { __check_user($_) } @_;
+}
+
+sub __check_user
+{
+    my $instance = shift;
+    require RT::User;
+    my $obj = RT::User->new( $RT::SystemUser );
+    $obj->Load( $instance );
+    return $obj->id ? $obj : undef;
+}
+
+=head2 add NAME [--group GNAME] [--user UNAME]
+
+Adds groups and/or users to recipients of the action NAME.
+
+=cut
+
+sub add {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my @groups = _check_groups( @{ $opts->{'groups'} } );
+    my @users = _check_users( @{ $opts->{'users'} } );
+    
+    unless ( @users + @groups ) {
+        print STDERR "List of groups and users is empty\n";
+        exit(-1);
+    }
+
+    __add( $action, $_ ) foreach @users;
+    __add( $action, $_ ) foreach @groups;
+
+    return;
+}
+
+sub __add
+{
+    my $action = shift;
+    my $obj = shift;
+
+    my @cur = argument_to_list( $action );
+
+    my $id = $obj->id;
+    return if grep $_ == $id, @cur;
+
+    push @cur, $id;
+
+    return $action->__Set( Field => 'Argument', Value => join(',', @cur) );
+}
+
+=head2 delete NAME
+
+Deletes action NAME if scrips doesn't use it.
+
+=cut
+
+sub delete {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    require RT::Scrips;
+    my $scrips = RT::Scrips->new( $RT::SystemUser );
+    $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id );
+    if ( $scrips->Count ) {
+        my @sid;
+        while( my $s = $scrips->Next ) {
+            push @sid, $s->id;
+        }
+        print STDERR "ScripAction '". $opts->{'name'} ."'"
+            . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid )
+            . "\n";
+        exit(-1);
+    }
+
+    return __delete( $action );
+}
+
+sub __delete {
+    require DBIx::SearchBuilder::Record;
+    return DBIx::SearchBuilder::Record::Delete( shift );
+}
+
+sub _get_action_by_name {
+    my $name = shift;
+    my $actions = _get_our_actions();
+    $actions->Limit(
+        FIELD => 'Name',
+        VALUE => $name
+    );
+
+    if ( $actions->Count > 1 ) {
+        print STDERR "More then one ScripAction with name '$name'\n";
+    }
+
+    return $actions->First;
+}
+
+=head2 switch NAME
+
+Switch action NAME from notify as correspondence to comment and back.
+
+=cut
+
+sub switch {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my %h = (
+        NotifyGroup => 'NotifyGroupAsComment',
+        NotifyGroupAsComment => 'NotifyGroup'
+    );
+
+    return $action->__Set(
+        Field => 'ExecModule',
+        Value => $h{ $action->ExecModule }
+    );
+}
+
+=head2 rename NAME --newname NEWNAME
+
+Renames action NAME to NEWNAME.
+
+=cut
+
+sub rename {
+    my $action = _get_action_by_name( $opts->{'name'} );
+    unless ( $action ) {
+        print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+        exit(-1);
+    }
+
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} );
+    if ( $actions->Count ) {
+        print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n";
+        exit(-1);
+    }
+
+    return $action->__Set(
+        Field => 'Name',
+        Value => $opts->{'newname'},
+    );
+}
+
+=head2 NOTES
+
+If command has option --group or --user then you can use it more then once,
+if other is not specified.
+
+=cut
+
+###############
+#### Utils ####
+###############
+
+sub argument_to_list {
+    my $action = shift;
+    require RT::Action::NotifyGroup;
+    return RT::Action::NotifyGroup->__SplitArg( $action->Argument );
+}
+
+sub _get_our_actions {
+    my $actions = RT::ScripActions->new( $RT::SystemUser );
+    $actions->Limit(
+        FIELD => 'ExecModule',
+        VALUE => 'NotifyGroup',
+        ENTRYAGGREGATOR => 'OR',
+    );
+    $actions->Limit(
+        FIELD => 'ExecModule',
+        VALUE => 'NotifyGroupAsComment',
+        ENTRYAGGREGATOR => 'OR',
+    );
+
+    return $actions;
+}
+
+=head1 AUTHOR
+
+Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt>
+
+=head1 SEE ALSO
+
+L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment>
+
+=cut
diff --git a/rt/sbin/rt-server b/rt/sbin/rt-server
new file mode 100755
index 0000000..2c7eca5
--- /dev/null
+++ b/rt/sbin/rt-server
@@ -0,0 +1,129 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use warnings;
+use strict;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+RT::LoadConfig();
+RT->InitLogging();
+if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+
+RT::CheckPerlRequirements();
+RT->InitPluginPaths();
+
+my $port = shift @ARGV || RT->Config->Get('WebPort') || '8080';
+
+
+require RT::Handle;
+my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
+
+unless ( $integrity ) {
+    print STDERR <<EOF;
+    
+RT couldn't connect to the database where tickets are stored.
+If this is a new installation of RT, you should visit the URL below
+to configure RT and initialize your database.
+
+If this is an existing RT installation, this may indicate a database
+connectivity problem.
+
+The error RT got back when trying to connect to your database was:
+
+$msg
+
+EOF
+
+    require RT::Installer;
+    # don't enter install mode if the file exists but is unwritable
+    if (-e RT::Installer->ConfigFile && !-w _) {
+        die "Since your configuration exists but is not writable, I'm refusing to do anything.\n";
+    }
+
+    RT->Config->Set( 'LexiconLanguages' => '*' );
+    RT::I18N->Init;
+
+    RT->InstallMode(1);
+} else {
+    RT->ConnectToDatabase();
+    RT->InitSystemObjects();
+    RT->InitClasses();
+    RT->InitPlugins();
+}
+
+require RT::Interface::Web::Standalone;
+my $server = RT::Interface::Web::Standalone->new;
+$server->net_server('RT::Interface::Web::Standalone::PreFork');
+$server->port($port);
+$server->run();
+
diff --git a/rt/sbin/rt-server.in b/rt/sbin/rt-server.in
new file mode 100644
index 0000000..cd146e0
--- /dev/null
+++ b/rt/sbin/rt-server.in
@@ -0,0 +1,129 @@
+#!@PERL@ -w
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use warnings;
+use strict;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT;
+RT::LoadConfig();
+RT->InitLogging();
+if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
+
+RT::CheckPerlRequirements();
+RT->InitPluginPaths();
+
+my $port = shift @ARGV || RT->Config->Get('WebPort') || '8080';
+
+
+require RT::Handle;
+my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
+
+unless ( $integrity ) {
+    print STDERR <<EOF;
+    
+RT couldn't connect to the database where tickets are stored.
+If this is a new installation of RT, you should visit the URL below
+to configure RT and initialize your database.
+
+If this is an existing RT installation, this may indicate a database
+connectivity problem.
+
+The error RT got back when trying to connect to your database was:
+
+$msg
+
+EOF
+
+    require RT::Installer;
+    # don't enter install mode if the file exists but is unwritable
+    if (-e RT::Installer->ConfigFile && !-w _) {
+        die "Since your configuration exists but is not writable, I'm refusing to do anything.\n";
+    }
+
+    RT->Config->Set( 'LexiconLanguages' => '*' );
+    RT::I18N->Init;
+
+    RT->InstallMode(1);
+} else {
+    RT->ConnectToDatabase();
+    RT->InitSystemObjects();
+    RT->InitClasses();
+    RT->InitPlugins();
+}
+
+require RT::Interface::Web::Standalone;
+my $server = RT::Interface::Web::Standalone->new;
+$server->net_server('RT::Interface::Web::Standalone::PreFork');
+$server->port($port);
+$server->run();
+
diff --git a/rt/sbin/rt-setup-database b/rt/sbin/rt-setup-database
index 49af151..d4a256f 100644
--- a/rt/sbin/rt-setup-database
+++ b/rt/sbin/rt-setup-database
@@ -1,9 +1,9 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -47,41 +47,56 @@
 # 
 # END BPS TAGGED BLOCK }}}
 use strict;
-use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item);
-use vars
-  qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips @Attributes);
+use warnings;
+
+use vars qw($Nobody $SystemUser $item);
 
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
 
 #This drags in  RT's config.pm
 # We do it in a begin block because RT::Handle needs to know the type to do its
 # inheritance
-use RT;
-use Carp;
-use RT::User;
-use RT::CurrentUser;
-use RT::Template;
-use RT::ScripAction;
-use RT::ACE;
-use RT::Group;
-use RT::User;
-use RT::Queue;
-use RT::ScripCondition;
-use RT::CustomField;
-use RT::Scrip;
-
-RT::LoadConfig();
+BEGIN {
+    use RT;
+    RT::LoadConfig();
+    RT::InitClasses();
+}
+
 use Term::ReadKey;
 use Getopt::Long;
 
-my %args;
+$| = 1; # unbuffer all output.
 
+my %args;
 GetOptions(
     \%args,
-    'prompt-for-dba-password', 'force', 'debug',
-    'action=s',                'dba=s', 'dba-password=s', 'datafile=s',
-    'datadir=s'
+    'action=s',
+    'force', 'debug',
+    'dba=s', 'dba-password=s', 'prompt-for-dba-password',
+    'datafile=s', 'datadir=s'
 );
 
 unless ( $args{'action'} ) {
@@ -89,583 +104,321 @@ unless ( $args{'action'} ) {
     exit(-1);
 }
 
-$| = 1;    #unbuffer that output.
-
-require RT::Handle;
-my $Handle = RT::Handle->new($RT::DatabaseType);
-$Handle->BuildDSN;
-my $dbh;
-
-if ( $args{'prompt-for-dba-password'} ) {
-    $args{'dba-password'} = get_dba_password();
-    chomp( $args{'dba-password'} );
-}
-
-if ( $args{'action'} eq 'init' ) {
-    $dbh = DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    print "Now creating a database for RT.\n";
-    if ( $RT::DatabaseType ne 'Oracle' || $args{'dba'} ne $RT::DatabaseUser ) {
-        create_db();
-    } else {
-        print "...skipped as ".$args{'dba'} ." is not " . $RT::DatabaseUser . " or we're working with Oracle.\n";
-    }
-
-    if ( $RT::DatabaseType eq "mysql" ) {
-        # Check which version we're running
-        my ($version) = $dbh->selectrow_hashref("show variables like 'version'")->{Value} =~ /^(\d\.\d+)/;
-        print "*** Warning: RT is unsupported on MySQL versions before 4.0.x\n" if $version < 4;
-
-        # MySQL must have InnoDB support
-        my $innodb = $dbh->selectrow_hashref("show variables like 'have_innodb'")->{Value};
-        if ( $innodb eq "NO" ) {
-            die "RT requires that MySQL be compiled with InnoDB table support.\n".
-              "See http://dev.mysql.com/doc/mysql/en/InnoDB.html\n";
-        } elsif ( $innodb eq "DISABLED" ) {
-            die "RT requires that MySQL InnoDB table support be enabled.\n".
-              ($version < 4
-               ? "Add 'innodb_data_file_path=ibdata1:10M:autoextend' to the [mysqld] section of my.cnf\n"
-               : "Remove the 'skip-innodb' line from your my.cnf file, restart MySQL, and try again.\n");
-        }
-    }
-
-    # SQLite can't deal with the disconnect/reconnect
-    unless ( $RT::DatabaseType eq 'SQLite' ) {
-
-        $dbh->disconnect;
-
-        if ( $RT::DatabaseType eq "Oracle" ) {
-            $RT::DatabasePassword = $RT::DatabasePassword; #Warning avidance
-            $dbh = DBI->connect( $Handle->DSN, ${RT::DatabaseUser}, ${RT::DatabasePassword} ) || die $DBI::errstr;
-        } else {	
-            $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} ) || die $DBI::errstr;
-        }
-    }
-    print "Now populating database schema.\n";
-    insert_schema();
-    print "Now inserting database ACLs\n";
-    insert_acl() unless $RT::DatabaseType eq 'Oracle';
-    print "Now inserting RT core system objects\n";
-    insert_initial_data();
-    print "Now inserting RT data\n";
-    insert_data( $RT::EtcPath . "/initialdata" );
-}
-elsif ( $args{'action'} eq 'drop' ) {
-    unless ( $dbh =
-        DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) )
-    {
-        warn $DBI::errstr;
-        warn "Database doesn't appear to exist. Aborting database drop.";
-        exit;
-    }
-    drop_db();
-}
-elsif ( $args{'action'} eq 'insert' ) {
-    insert_data( $args{'datafile'} || ($args{'datadir'}."/content") );
-}
-elsif ( $args{'action'} eq 'acl' ) {
-    $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    insert_acl($args{'datadir'});
-}
-elsif ( $args{'action'} eq 'schema' ) {
-    $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    insert_schema($args{'datadir'});
-}
-else {
-    print STDERR "$0 called with an invalid --action parameter\n";
+# check and setup @actions
+my @actions = grep $_, split /,/, $args{'action'};
+if ( @actions > 1 && $args{'datafile'} ) {
+    print STDERR "You can not use --datafile option with multiple actions.\n";
     exit(-1);
 }
-
-# {{{ sub insert_schema
-sub insert_schema {
-    my $base_path = (shift || $RT::EtcPath);
-    my (@schema);
-    print "Creating database schema.\n";
-
-    my $schema_file = $base_path . "/schema." . $RT::DatabaseType;
-    if ( -f $schema_file ) {
-        open( SCHEMA, "<$schema_file"  ) or die "Can't open $schema_file: $!";
-	my @lines = <SCHEMA>;
-
-	my $local_schema_file = $RT::LocalEtcPath . "/schema." . $RT::DatabaseType;
-	if (-f $local_schema_file) {
-	    open( SCHEMA_LOCAL, "<$local_schema_file" )
-		or die "Can't open $local_schema_file: $!";
-	    push @lines, ';;', <SCHEMA_LOCAL>;
-	}
-
-        my $statement = "";
-        foreach my $line (@lines) {
-            $line =~ s/\#.*//g;
-            $line =~ s/--.*//g;
-            $statement .= $line;
-            if ( $line =~ /;(\s*)$/ ) {
-                $statement =~ s/;(\s*)$//g;
-                push @schema, $statement;
-                $statement = "";
-            }
-        }
-
-        local $SIG{__WARN__} = sub {};
-        my $is_local = 0; # local/etc/schema needs to be nonfatal.
-        $dbh->begin_work or die $dbh->errstr;
-        foreach my $statement (@schema) {
-            if ( $statement =~ /^\s*;$/ ) { $is_local = 1; next; }
-
-            print STDERR "SQL: $statement\n" if defined $args{'debug'};
-            my $sth = $dbh->prepare($statement) or die $dbh->errstr;
-            unless ( $sth->execute or $is_local ) {
-                die "Problem with statement:\n $statement\n" . $sth->errstr;
-            }
-        }
-        $dbh->commit or die $dbh->errstr;
+foreach ( @actions ) {
+    unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
+        print STDERR "$0 called with an invalid --action parameter.\n";
+        exit(-1);
     }
-    else {
-        die "Couldn't find schema file for " . $RT::DatabaseType . "\n";
+    if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) {
+        print STDERR "You can not mix init, drop or upgrade action with any action.\n";
+        exit(-1);
     }
-    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.
+# convert init to multiple actions
+my $init = 0;
+if ( $actions[0] eq 'init' ) {
+    @actions = qw(create schema acl coredata insert);
+    $init = 1;
+}
 
-END
-        return;
-    }
-    unless ( $args{'force'} ) {
-        print <<END;
+# set options from environment
+foreach my $key(qw(Type Host Name User Password)) {
+    next unless exists $ENV{ 'RT_DB_'. uc $key };
+    print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n";
+    RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key });
+}
 
-About to drop $RT::DatabaseType database $RT::DatabaseName on $RT::DatabaseHost.
-WARNING: This will erase all data in $RT::DatabaseName.
+my $db_type = RT->Config->Get('DatabaseType') || '';
+my $db_host = RT->Config->Get('DatabaseHost') || '';
+my $db_name = RT->Config->Get('DatabaseName') || '';
+my $db_user = RT->Config->Get('DatabaseUser') || '';
+my $db_pass = RT->Config->Get('DatabasePassword') || '';
 
-END
-        exit unless _yesno();
+# load it here to get error immidiatly if DB type is not supported
+require RT::Handle;
 
-    }
+if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) {
+    $db_name = File::Spec->catfile($RT::VarPath, $db_name);
+    RT->Config->Set( DatabaseName => $db_name );
+}
 
-    print "Dropping $RT::DatabaseType database $RT::DatabaseName.\n";
+my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || '';
+my $dba_pass = $args{'dba-password'} || $ENV{'RT_DBA_PASSWORD'};
 
-    if ( $RT::DatabaseType eq 'SQLite' ) {
-        unlink $RT::DatabaseName or warn $!;
-        return;
-    }
-    $dbh->do("Drop DATABASE $RT::DatabaseName") or warn $DBI::errstr;
+if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) {
+    $dba_pass = get_dba_password();
+    chomp $dba_pass if defined($dba_pass);
 }
 
-# }}}
+print "Working with:\n"
+    ."Type:\t$db_type\nHost:\t$db_host\nName:\t$db_name\n"
+    ."User:\t$db_user\nDBA:\t$dba_user\n";
 
-# {{{ 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;
-    }
+foreach my $action ( @actions ) {
+    no strict 'refs';
+    my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
+    error($action, $msg) unless $status;
+    print $msg ."\n" if $msg;
+    print "Done.\n";
 }
 
-# }}}
+sub action_create {
+    my %args = @_;
+    my $dbh = get_system_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-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);
+    print "Now creating a $db_type database $db_name for RT.\n";
+    return RT::Handle->CreateDatabase( $dbh );
 }
 
-# {{{ sub _yesno
-sub _yesno {
-    print "Proceed [y/N]:";
-    my $x = scalar(<STDIN>);
-    $x =~ /^y/i;
-}
+sub action_drop {
+    my %args = @_;
 
-# }}}
+    print "Dropping $db_type database $db_name.\n";
+    unless ( $args{'force'} ) {
+        print <<END;
 
-# {{{ insert_acls
-sub insert_acl {
-    my $base_path = (shift || $RT::EtcPath);
+About to drop $db_type database $db_name on $db_host.
+WARNING: This will erase all data in $db_name.
 
-    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";
+END
+        exit(-2) unless _yesno();
     }
 
-    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";
+    my $dbh = get_system_dbh();
+    return RT::Handle->DropDatabase( $dbh );
 }
 
-# }}}
-
-=head2 get_system_dsn
-
-Returns a dsn suitable for database creates and drops
-and user creates and drops
-
-=cut
-
-sub get_system_dsn {
+sub action_schema {
+    my %args = @_;
+    my $dbh = get_admin_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-    my $dsn = $Handle->DSN;
+    print "Now populating database schema.\n";
+    return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
+}
 
-    #with mysql, you want to connect sans database to funge things
-    if ( $RT::DatabaseType eq 'mysql' ) {
-        $dsn =~ s/dbname=$RT::DatabaseName//;
+sub action_acl {
+    my %args = @_;
+    my $dbh = get_admin_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-        # 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;
+    print "Now inserting database ACLs\n";
+    return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
 }
 
-sub insert_initial_data {
-
+sub action_coredata {
+    my %args = @_;
+    $RT::Handle = new RT::Handle;
+    $RT::Handle->dbh( undef );
+    RT::ConnectToDatabase();
     RT::InitLogging();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-    #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';
+    print "Now inserting RT core system objects\n";
+    return $RT::Handle->InsertInitialData;
+}
 
+sub action_insert {
+    my %args = @_;
+    $RT::Handle = new RT::Handle;
+    RT::Init();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' );
+    return ($status, $msg) unless $status;
+
+    print "Now inserting data\n";
+    my $file = $args{'datafile'};
+    $file = $RT::EtcPath . "/initialdata" if $init && !$file;
+    $file ||= $args{'datadir'}."/content";
+    return $RT::Handle->InsertData( $file );
 }
 
-# load some sort of data into the database
+sub action_upgrade {
+    my %args = @_;
+    my $base_dir = $args{'datadir'} || "./etc/upgrade";
+    return (0, "Couldn't read dir '$base_dir' with upgrade data")
+        unless -d $base_dir || -r _;
+
+    my $upgrading_from = undef;
+    do {
+        if ( defined $upgrading_from ) {
+            print "Doesn't match #.#.#: ";
+        } else {
+            print "Enter RT version you're upgrading from: ";
+        }
+        $upgrading_from = scalar <STDIN>;
+        chomp $upgrading_from;
+        $upgrading_from =~ s/\s+//g;
+    } while $upgrading_from !~ /^\d+\.\d+\.\d+$/;
+
+    my $upgrading_to = $RT::VERSION;
+    return (0, "The current version $upgrading_to is lower than $upgrading_from")
+        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0;
 
-sub insert_data {
-    my $datafile = shift;
+    return (1, "The version $upgrading_to you're upgrading to is up to date")
+        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0;
 
-    #Connect to the database and get RT::SystemUser and RT::Nobody loaded
-    RT::Init;
+    my @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
 
-    my $CurrentUser = RT::CurrentUser->new();
-    $CurrentUser->LoadByName('RT_System');
+    return (1, "No DB changes between $upgrading_from and $upgrading_to")
+        unless @versions;
 
-    if ( $datafile eq $RT::EtcPath . "/initialdata" ) {
+    print "\nGoing to apply following upgrades:\n";
+    print map "* $_\n", @versions;
 
-        print "Creating Superuser  ACL...";
+    {
+        my $custom_upgrading_to = undef;
+        do {
+            if ( defined $custom_upgrading_to ) {
+                print "Doesn't match #.#.#: ";
+            } else {
+                print "\nEnter RT version if you want to stop upgrade at some point,\n";
+                print "  or leave it blank if you want apply above upgrades: ";
+            }
+            $custom_upgrading_to = scalar <STDIN>;
+            chomp $custom_upgrading_to;
+            $custom_upgrading_to =~ s/\s+//g;
+            last unless $custom_upgrading_to;
+        } while $custom_upgrading_to !~ /^\d+\.\d+\.\d+$/;
+
+        if ( $custom_upgrading_to ) {
+            return (
+                0, "The version you entered ($custom_upgrading_to) is lower than\n"
+                ."version you're upgrading from ($upgrading_from)"
+            ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0;
+
+            return (1, "The version you're upgrading to is up to date")
+                if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0;
+
+            if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) {
+                print "Version you entered is greater than installed ($RT::VERSION).\n";
+                _yesno() or exit(-2);
+            }
+            # ok, checked everything no let's refresh list
+            $upgrading_to = $custom_upgrading_to;
+            @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
 
-        my $superuser_ace = RT::ACE->new($CurrentUser);
-        $superuser_ace->_BootstrapCreate(
-                             PrincipalId => ACLEquivGroupId( $CurrentUser->Id ),
-                             PrincipalType => 'Group',
-                             RightName     => 'SuperUser',
-                             ObjectType    => 'RT::System',
-                             ObjectId      => '1' );
+            return (1, "No DB changes between $upgrading_from and $upgrading_to")
+                unless @versions;
 
-        print "done.\n";
+            print "\nGoing to apply following upgrades:\n";
+            print map "* $_\n", @versions;
+        }
     }
 
-    # 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" . $@;
+    print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
+    _yesno() or exit(-2) unless $args{'force'};
 
-    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. ".";
+    foreach my $v ( @versions ) {
+        print "Processing $v\n";
+        my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef);
+        if ( -e "$base_dir/$v/schema.$db_type" ) {
+            action_schema( %tmp );
         }
-        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. ".";
+        if ( -e "$base_dir/$v/acl.$db_type" ) {
+            action_acl( %tmp );
         }
-        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. ".";
+        if ( -e "$base_dir/$v/content" ) {
+            action_insert( %tmp );
         }
-        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'} );
-            }
+    return 1;
+}
 
-            # Grant it
-            my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
-                                                     Right => $item->{'Right'},
-                                                     Object => $object );
+sub get_versions_from_to {
+    my ($base_dir, $from, $to) = @_;
 
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print $msg . ".";
+    opendir my $dh, $base_dir or die "couldn't open dir: $!";
+    my @versions = grep -d "$base_dir/$_" && /\d+\.\d+\.\d+/, readdir $dh;
+    closedir $dh;
 
-            }
+    return
+        grep RT::Handle::cmp_version($_, $to) <= 0,
+        grep RT::Handle::cmp_version($_, $from) > 0,
+        sort RT::Handle::cmp_version @versions;
+}
 
-        }
-        print "done.\n";
-    }
-    if ( @CustomFields ) {
-        print "Creating custom fields...";
-        for $item (@CustomFields) {
-            my $new_entry = new RT::CustomField($CurrentUser);
-            my $values    = $item->{'Values'};
-            delete $item->{'Values'};
-            my ( $return, $msg ) = $new_entry->Create(%$item);
-            unless( $return ) {
-                print "(Error: $msg)\n";
-                next;
-            }
+sub error {
+    my ($action, $msg) = @_;
+    print STDERR "Couldn't finish '$action' step.\n\n";
+    print STDERR "ERROR: $msg\n\n";
+    exit(-1);
+}
 
-            foreach my $value ( @{$values} ) {
-                my ( $eval, $emsg ) = $new_entry->AddValue(%$value);
-                print "(Error: $emsg)\n" unless $eval;
-            }
+sub get_dba_password {
+    print "In order to create or update your RT database,"
+        . " this script needs to connect to your "
+        . " $db_type instance on $db_host as $dba_user\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);
+}
 
-            if ( $item->{LookupType} && !exists $item->{'Queue'} ) { # enable by default
-                my $ocf = RT::ObjectCustomField->new($CurrentUser);
-                $ocf->Create( CustomField => $new_entry->Id );
-            }
+=head2 get_system_dbh
 
-            print "(Error: $msg)\n" unless $return;
-            print $return. ".";
-        }
+Returns L<DBI> database handle connected to B<system> with DBA credentials.
 
-        print "done.\n";
-    }
+See also L<RT::Handle/SystemDSN>.
 
-    if ( @ScripActions ) {
-        print "Creating ScripActions...";
+=cut
 
-        for $item (@ScripActions) {
-            my $new_entry = RT::ScripAction->new($CurrentUser);
-            my ($return,$msg) = $new_entry->Create(%$item);
-            unless ($return) {
-                print "(Error: $msg)\n";
-                next;
-            }
-            print $return. ".";
-        }
+sub get_system_dbh {
+    return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass );
+}
 
-        print "done.\n";
-    }
+sub get_admin_dbh {
+    return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass );
+}
 
-    if ( @ScripConditions ) {
-        print "Creating ScripConditions...";
+=head2 get_rt_dbh [USER, PASSWORD]
 
-        for $item (@ScripConditions) {
-            my $new_entry = RT::ScripCondition->new($CurrentUser);
-            my ($return,$msg) = $new_entry->Create(%$item);
-            unless ($return) {
-                print "(Error: $msg)\n";
-                next;
-            }
-            print $return. ".";
-        }
+Returns L<DBI> database handle connected to RT database,
+you may specify credentials(USER and PASSWORD) to connect
+with. By default connects with credentials from RT config.
 
-        print "done.\n";
-    }
+=cut
 
-    if ( @Templates ) {
-        print "Creating templates...";
+sub get_rt_dbh {
+    return _get_dbh( RT::Handle->DSN, $db_user, $db_pass );
+}
 
-        for $item (@Templates) {
-            my $new_entry = new RT::Template($CurrentUser);
-            my $return    = $new_entry->Create(%$item);
-            print $return. ".";
-        }
-        print "done.\n";
-    }
-    if ( @Scrips ) {
-        print "Creating scrips...";
-
-        for $item (@Scrips) {
-            my $new_entry = new RT::Scrip($CurrentUser);
-            my ( $return, $msg ) = $new_entry->Create(%$item);
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print "(Error: $msg)\n";
-            }
-        }
-        print "done.\n";
-    }
-    if ( @Attributes ) {
-        print "Creating predefined searches...";
-        my $sys = RT::System->new($CurrentUser);
-
-        for $item (@Attributes) {
-            my $obj = delete $item->{Object}; # XXX: make this something loadable
-            $obj ||= $sys;
-            my ( $return, $msg ) = $obj->AddAttribute (%$item);
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print "(Error: $msg)\n";
-            }
+sub _get_dbh {
+    my ($dsn, $user, $pass) = @_;
+    my $dbh = DBI->connect(
+        $dsn, $user, $pass,
+        { RaiseError => 0, PrintError => 0 },
+    );
+    unless ( $dbh ) {
+        my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr;
+        if ( $args{'debug'} ) {
+            require Carp; Carp::confess( $msg );
+        } else {
+            print STDERR $msg; exit -1;
         }
-        print "done.\n";
     }
-    $RT::Handle->Disconnect() unless $RT::DatabaseType eq 'SQLite';
-    print "Done setting up database content.\n";
+    return $dbh;
 }
 
-=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 _yesno {
+    print "Proceed [y/N]:";
+    my $x = scalar(<STDIN>);
+    $x =~ /^y/i;
 }
 
 sub help {
@@ -674,25 +427,39 @@ sub help {
 
 $0: Set up RT's database
 
---action        init    Initialize the database
-                drop    Drop the database.
-                        This will ERASE ALL YOUR DATA
-                insert  Insert data into RT's database.
-                        By default, will use RT's installation data.
-                        To use a local or supplementary datafile, specify it
-                        using the '--datafile' option below.
+--action        init     Initialize the database. This is combination of
+                         multiple actions listed below. Create DB, schema,
+                         setup acl, insert core data and initial data.
+
+                upgrade  Apply all needed schema/acl/content updates (will ask
+                         for version to upgrade from)
+
+                create   Create the database.
+
+                drop     Drop the database.
+                         This will ERASE ALL YOUR DATA
+
+                schema   Initialize only the database schema
+                         To use a local or supplementary datafile, specify it
+                         using the '--datadir' option below.
+
+                acl      Initialize only the database ACLs
+                         To use a local or supplementary datafile, specify it
+                         using the '--datadir' option below.
+
+                coredata Insert data into RT's database. This data is required
+                         for normal functioning of any RT instance.
 
-                acl     Initialize only the database ACLs
-                        To use a local or supplementary datafile, specify it
-                        using the '--datadir' option below.
+                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.
 
-                schema  Initialize only the database schema
-                        To use a local or supplementary datafile, specify it
-                        using the '--datadir' option below.
+Several actions can be combined using comma separated list.
 
 --datafile /path/to/datafile
 --datadir /path/to/              Used to specify a path to find the local
-                                database schema and acls to be installed.
+                                 database schema and acls to be installed.
 
 
 --dba                           dba's username
diff --git a/rt/sbin/rt-setup-database.in b/rt/sbin/rt-setup-database.in
index f134f5b..a51076f 100644
--- a/rt/sbin/rt-setup-database.in
+++ b/rt/sbin/rt-setup-database.in
@@ -1,9 +1,9 @@
-#!@PERL@ -w
+#!@PERL@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -47,41 +47,56 @@
 # 
 # END BPS TAGGED BLOCK }}}
 use strict;
-use vars qw($PROMPT $VERSION $Handle $Nobody $SystemUser $item);
-use vars
-  qw(@Groups @Users @ACL @Queues @ScripActions @ScripConditions @Templates @CustomFields @Scrips @Attributes);
+use warnings;
+
+use vars qw($Nobody $SystemUser $item);
 
-use lib "@LOCAL_LIB_PATH@";
-use lib "@RT_LIB_PATH@";
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
 
 #This drags in  RT's config.pm
 # We do it in a begin block because RT::Handle needs to know the type to do its
 # inheritance
-use RT;
-use Carp;
-use RT::User;
-use RT::CurrentUser;
-use RT::Template;
-use RT::ScripAction;
-use RT::ACE;
-use RT::Group;
-use RT::User;
-use RT::Queue;
-use RT::ScripCondition;
-use RT::CustomField;
-use RT::Scrip;
-
-RT::LoadConfig();
+BEGIN {
+    use RT;
+    RT::LoadConfig();
+    RT::InitClasses();
+}
+
 use Term::ReadKey;
 use Getopt::Long;
 
-my %args;
+$| = 1; # unbuffer all output.
 
+my %args;
 GetOptions(
     \%args,
-    'prompt-for-dba-password', 'force', 'debug',
-    'action=s',                'dba=s', 'dba-password=s', 'datafile=s',
-    'datadir=s'
+    'action=s',
+    'force', 'debug',
+    'dba=s', 'dba-password=s', 'prompt-for-dba-password',
+    'datafile=s', 'datadir=s'
 );
 
 unless ( $args{'action'} ) {
@@ -89,583 +104,321 @@ unless ( $args{'action'} ) {
     exit(-1);
 }
 
-$| = 1;    #unbuffer that output.
-
-require RT::Handle;
-my $Handle = RT::Handle->new($RT::DatabaseType);
-$Handle->BuildDSN;
-my $dbh;
-
-if ( $args{'prompt-for-dba-password'} ) {
-    $args{'dba-password'} = get_dba_password();
-    chomp( $args{'dba-password'} );
-}
-
-if ( $args{'action'} eq 'init' ) {
-    $dbh = DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    print "Now creating a database for RT.\n";
-    if ( $RT::DatabaseType ne 'Oracle' || $args{'dba'} ne $RT::DatabaseUser ) {
-        create_db();
-    } else {
-        print "...skipped as ".$args{'dba'} ." is not " . $RT::DatabaseUser . " or we're working with Oracle.\n";
-    }
-
-    if ( $RT::DatabaseType eq "mysql" ) {
-        # Check which version we're running
-        my ($version) = $dbh->selectrow_hashref("show variables like 'version'")->{Value} =~ /^(\d\.\d+)/;
-        print "*** Warning: RT is unsupported on MySQL versions before 4.0.x\n" if $version < 4;
-
-        # MySQL must have InnoDB support
-        my $innodb = $dbh->selectrow_hashref("show variables like 'have_innodb'")->{Value};
-        if ( $innodb eq "NO" ) {
-            die "RT requires that MySQL be compiled with InnoDB table support.\n".
-              "See http://dev.mysql.com/doc/mysql/en/InnoDB.html\n";
-        } elsif ( $innodb eq "DISABLED" ) {
-            die "RT requires that MySQL InnoDB table support be enabled.\n".
-              ($version < 4
-               ? "Add 'innodb_data_file_path=ibdata1:10M:autoextend' to the [mysqld] section of my.cnf\n"
-               : "Remove the 'skip-innodb' line from your my.cnf file, restart MySQL, and try again.\n");
-        }
-    }
-
-    # SQLite can't deal with the disconnect/reconnect
-    unless ( $RT::DatabaseType eq 'SQLite' ) {
-
-        $dbh->disconnect;
-
-        if ( $RT::DatabaseType eq "Oracle" ) {
-            $RT::DatabasePassword = $RT::DatabasePassword; #Warning avidance
-            $dbh = DBI->connect( $Handle->DSN, ${RT::DatabaseUser}, ${RT::DatabasePassword} ) || die $DBI::errstr;
-        } else {	
-            $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} ) || die $DBI::errstr;
-        }
-    }
-    print "Now populating database schema.\n";
-    insert_schema();
-    print "Now inserting database ACLs\n";
-    insert_acl() unless $RT::DatabaseType eq 'Oracle';
-    print "Now inserting RT core system objects\n";
-    insert_initial_data();
-    print "Now inserting RT data\n";
-    insert_data( $RT::EtcPath . "/initialdata" );
-}
-elsif ( $args{'action'} eq 'drop' ) {
-    unless ( $dbh =
-        DBI->connect( get_system_dsn(), $args{'dba'}, $args{'dba-password'} ) )
-    {
-        warn $DBI::errstr;
-        warn "Database doesn't appear to exist. Aborting database drop.";
-        exit;
-    }
-    drop_db();
-}
-elsif ( $args{'action'} eq 'insert' ) {
-    insert_data( $args{'datafile'} || ($args{'datadir'}."/content") );
-}
-elsif ( $args{'action'} eq 'acl' ) {
-    $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    insert_acl($args{'datadir'});
-}
-elsif ( $args{'action'} eq 'schema' ) {
-    $dbh = DBI->connect( $Handle->DSN, $args{'dba'}, $args{'dba-password'} )
-      || die "Failed to connect to " . get_system_dsn() . " as $args{'dba'}: $DBI::errstr";
-    insert_schema($args{'datadir'});
-}
-else {
-    print STDERR "$0 called with an invalid --action parameter\n";
+# check and setup @actions
+my @actions = grep $_, split /,/, $args{'action'};
+if ( @actions > 1 && $args{'datafile'} ) {
+    print STDERR "You can not use --datafile option with multiple actions.\n";
     exit(-1);
 }
-
-# {{{ sub insert_schema
-sub insert_schema {
-    my $base_path = (shift || $RT::EtcPath);
-    my (@schema);
-    print "Creating database schema.\n";
-
-    my $schema_file = $base_path . "/schema." . $RT::DatabaseType;
-    if ( -f $schema_file ) {
-        open( SCHEMA, "<$schema_file"  ) or die "Can't open $schema_file: $!";
-	my @lines = <SCHEMA>;
-
-	my $local_schema_file = $RT::LocalEtcPath . "/schema." . $RT::DatabaseType;
-	if (-f $local_schema_file) {
-	    open( SCHEMA_LOCAL, "<$local_schema_file" )
-		or die "Can't open $local_schema_file: $!";
-	    push @lines, ';;', <SCHEMA_LOCAL>;
-	}
-
-        my $statement = "";
-        foreach my $line (@lines) {
-            $line =~ s/\#.*//g;
-            $line =~ s/--.*//g;
-            $statement .= $line;
-            if ( $line =~ /;(\s*)$/ ) {
-                $statement =~ s/;(\s*)$//g;
-                push @schema, $statement;
-                $statement = "";
-            }
-        }
-
-        local $SIG{__WARN__} = sub {};
-        my $is_local = 0; # local/etc/schema needs to be nonfatal.
-        $dbh->begin_work or die $dbh->errstr;
-        foreach my $statement (@schema) {
-            if ( $statement =~ /^\s*;$/ ) { $is_local = 1; next; }
-
-            print STDERR "SQL: $statement\n" if defined $args{'debug'};
-            my $sth = $dbh->prepare($statement) or die $dbh->errstr;
-            unless ( $sth->execute or $is_local ) {
-                die "Problem with statement:\n $statement\n" . $sth->errstr;
-            }
-        }
-        $dbh->commit or die $dbh->errstr;
+foreach ( @actions ) {
+    unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
+        print STDERR "$0 called with an invalid --action parameter.\n";
+        exit(-1);
     }
-    else {
-        die "Couldn't find schema file for " . $RT::DatabaseType . "\n";
+    if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) {
+        print STDERR "You can not mix init, drop or upgrade action with any action.\n";
+        exit(-1);
     }
-    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.
+# convert init to multiple actions
+my $init = 0;
+if ( $actions[0] eq 'init' ) {
+    @actions = qw(create schema acl coredata insert);
+    $init = 1;
+}
 
-END
-        return;
-    }
-    unless ( $args{'force'} ) {
-        print <<END;
+# set options from environment
+foreach my $key(qw(Type Host Name User Password)) {
+    next unless exists $ENV{ 'RT_DB_'. uc $key };
+    print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n";
+    RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key });
+}
 
-About to drop $RT::DatabaseType database $RT::DatabaseName on $RT::DatabaseHost.
-WARNING: This will erase all data in $RT::DatabaseName.
+my $db_type = RT->Config->Get('DatabaseType') || '';
+my $db_host = RT->Config->Get('DatabaseHost') || '';
+my $db_name = RT->Config->Get('DatabaseName') || '';
+my $db_user = RT->Config->Get('DatabaseUser') || '';
+my $db_pass = RT->Config->Get('DatabasePassword') || '';
 
-END
-        exit unless _yesno();
+# load it here to get error immidiatly if DB type is not supported
+require RT::Handle;
 
-    }
+if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) {
+    $db_name = File::Spec->catfile($RT::VarPath, $db_name);
+    RT->Config->Set( DatabaseName => $db_name );
+}
 
-    print "Dropping $RT::DatabaseType database $RT::DatabaseName.\n";
+my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || '';
+my $dba_pass = $args{'dba-password'} || $ENV{'RT_DBA_PASSWORD'};
 
-    if ( $RT::DatabaseType eq 'SQLite' ) {
-        unlink $RT::DatabaseName or warn $!;
-        return;
-    }
-    $dbh->do("Drop DATABASE $RT::DatabaseName") or warn $DBI::errstr;
+if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) {
+    $dba_pass = get_dba_password();
+    chomp $dba_pass if defined($dba_pass);
 }
 
-# }}}
+print "Working with:\n"
+    ."Type:\t$db_type\nHost:\t$db_host\nName:\t$db_name\n"
+    ."User:\t$db_user\nDBA:\t$dba_user\n";
 
-# {{{ 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;
-    }
+foreach my $action ( @actions ) {
+    no strict 'refs';
+    my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
+    error($action, $msg) unless $status;
+    print $msg ."\n" if $msg;
+    print "Done.\n";
 }
 
-# }}}
+sub action_create {
+    my %args = @_;
+    my $dbh = get_system_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-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);
+    print "Now creating a $db_type database $db_name for RT.\n";
+    return RT::Handle->CreateDatabase( $dbh );
 }
 
-# {{{ sub _yesno
-sub _yesno {
-    print "Proceed [y/N]:";
-    my $x = scalar(<STDIN>);
-    $x =~ /^y/i;
-}
+sub action_drop {
+    my %args = @_;
 
-# }}}
+    print "Dropping $db_type database $db_name.\n";
+    unless ( $args{'force'} ) {
+        print <<END;
 
-# {{{ insert_acls
-sub insert_acl {
-    my $base_path = (shift || $RT::EtcPath);
+About to drop $db_type database $db_name on $db_host.
+WARNING: This will erase all data in $db_name.
 
-    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";
+END
+        exit(-2) unless _yesno();
     }
 
-    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";
+    my $dbh = get_system_dbh();
+    return RT::Handle->DropDatabase( $dbh );
 }
 
-# }}}
-
-=head2 get_system_dsn
-
-Returns a dsn suitable for database creates and drops
-and user creates and drops
-
-=cut
-
-sub get_system_dsn {
+sub action_schema {
+    my %args = @_;
+    my $dbh = get_admin_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-    my $dsn = $Handle->DSN;
+    print "Now populating database schema.\n";
+    return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
+}
 
-    #with mysql, you want to connect sans database to funge things
-    if ( $RT::DatabaseType eq 'mysql' ) {
-        $dsn =~ s/dbname=$RT::DatabaseName//;
+sub action_acl {
+    my %args = @_;
+    my $dbh = get_admin_dbh();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-        # 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;
+    print "Now inserting database ACLs\n";
+    return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
 }
 
-sub insert_initial_data {
-
+sub action_coredata {
+    my %args = @_;
+    $RT::Handle = new RT::Handle;
+    $RT::Handle->dbh( undef );
+    RT::ConnectToDatabase();
     RT::InitLogging();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' );
+    return ($status, $msg) unless $status;
 
-    #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';
+    print "Now inserting RT core system objects\n";
+    return $RT::Handle->InsertInitialData;
+}
 
+sub action_insert {
+    my %args = @_;
+    $RT::Handle = new RT::Handle;
+    RT::Init();
+    my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' );
+    return ($status, $msg) unless $status;
+
+    print "Now inserting data\n";
+    my $file = $args{'datafile'};
+    $file = $RT::EtcPath . "/initialdata" if $init && !$file;
+    $file ||= $args{'datadir'}."/content";
+    return $RT::Handle->InsertData( $file );
 }
 
-# load some sort of data into the database
+sub action_upgrade {
+    my %args = @_;
+    my $base_dir = $args{'datadir'} || "./etc/upgrade";
+    return (0, "Couldn't read dir '$base_dir' with upgrade data")
+        unless -d $base_dir || -r _;
+
+    my $upgrading_from = undef;
+    do {
+        if ( defined $upgrading_from ) {
+            print "Doesn't match #.#.#: ";
+        } else {
+            print "Enter RT version you're upgrading from: ";
+        }
+        $upgrading_from = scalar <STDIN>;
+        chomp $upgrading_from;
+        $upgrading_from =~ s/\s+//g;
+    } while $upgrading_from !~ /^\d+\.\d+\.\d+$/;
+
+    my $upgrading_to = $RT::VERSION;
+    return (0, "The current version $upgrading_to is lower than $upgrading_from")
+        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0;
 
-sub insert_data {
-    my $datafile = shift;
+    return (1, "The version $upgrading_to you're upgrading to is up to date")
+        if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0;
 
-    #Connect to the database and get RT::SystemUser and RT::Nobody loaded
-    RT::Init;
+    my @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
 
-    my $CurrentUser = RT::CurrentUser->new();
-    $CurrentUser->LoadByName('RT_System');
+    return (1, "No DB changes between $upgrading_from and $upgrading_to")
+        unless @versions;
 
-    if ( $datafile eq $RT::EtcPath . "/initialdata" ) {
+    print "\nGoing to apply following upgrades:\n";
+    print map "* $_\n", @versions;
 
-        print "Creating Superuser  ACL...";
+    {
+        my $custom_upgrading_to = undef;
+        do {
+            if ( defined $custom_upgrading_to ) {
+                print "Doesn't match #.#.#: ";
+            } else {
+                print "\nEnter RT version if you want to stop upgrade at some point,\n";
+                print "  or leave it blank if you want apply above upgrades: ";
+            }
+            $custom_upgrading_to = scalar <STDIN>;
+            chomp $custom_upgrading_to;
+            $custom_upgrading_to =~ s/\s+//g;
+            last unless $custom_upgrading_to;
+        } while $custom_upgrading_to !~ /^\d+\.\d+\.\d+$/;
+
+        if ( $custom_upgrading_to ) {
+            return (
+                0, "The version you entered ($custom_upgrading_to) is lower than\n"
+                ."version you're upgrading from ($upgrading_from)"
+            ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0;
+
+            return (1, "The version you're upgrading to is up to date")
+                if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0;
+
+            if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) {
+                print "Version you entered is greater than installed ($RT::VERSION).\n";
+                _yesno() or exit(-2);
+            }
+            # ok, checked everything no let's refresh list
+            $upgrading_to = $custom_upgrading_to;
+            @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
 
-        my $superuser_ace = RT::ACE->new($CurrentUser);
-        $superuser_ace->_BootstrapCreate(
-                             PrincipalId => ACLEquivGroupId( $CurrentUser->Id ),
-                             PrincipalType => 'Group',
-                             RightName     => 'SuperUser',
-                             ObjectType    => 'RT::System',
-                             ObjectId      => '1' );
+            return (1, "No DB changes between $upgrading_from and $upgrading_to")
+                unless @versions;
 
-        print "done.\n";
+            print "\nGoing to apply following upgrades:\n";
+            print map "* $_\n", @versions;
+        }
     }
 
-    # 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" . $@;
+    print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
+    _yesno() or exit(-2) unless $args{'force'};
 
-    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. ".";
+    foreach my $v ( @versions ) {
+        print "Processing $v\n";
+        my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef);
+        if ( -e "$base_dir/$v/schema.$db_type" ) {
+            action_schema( %tmp );
         }
-        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. ".";
+        if ( -e "$base_dir/$v/acl.$db_type" ) {
+            action_acl( %tmp );
         }
-        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. ".";
+        if ( -e "$base_dir/$v/content" ) {
+            action_insert( %tmp );
         }
-        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'} );
-            }
+    return 1;
+}
 
-            # Grant it
-            my ( $return, $msg ) = $princ->PrincipalObj->GrantRight(
-                                                     Right => $item->{'Right'},
-                                                     Object => $object );
+sub get_versions_from_to {
+    my ($base_dir, $from, $to) = @_;
 
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print $msg . ".";
+    opendir my $dh, $base_dir or die "couldn't open dir: $!";
+    my @versions = grep -d "$base_dir/$_" && /\d+\.\d+\.\d+/, readdir $dh;
+    closedir $dh;
 
-            }
+    return
+        grep RT::Handle::cmp_version($_, $to) <= 0,
+        grep RT::Handle::cmp_version($_, $from) > 0,
+        sort RT::Handle::cmp_version @versions;
+}
 
-        }
-        print "done.\n";
-    }
-    if ( @CustomFields ) {
-        print "Creating custom fields...";
-        for $item (@CustomFields) {
-            my $new_entry = new RT::CustomField($CurrentUser);
-            my $values    = $item->{'Values'};
-            delete $item->{'Values'};
-            my ( $return, $msg ) = $new_entry->Create(%$item);
-            unless( $return ) {
-                print "(Error: $msg)\n";
-                next;
-            }
+sub error {
+    my ($action, $msg) = @_;
+    print STDERR "Couldn't finish '$action' step.\n\n";
+    print STDERR "ERROR: $msg\n\n";
+    exit(-1);
+}
 
-            foreach my $value ( @{$values} ) {
-                my ( $eval, $emsg ) = $new_entry->AddValue(%$value);
-                print "(Error: $emsg)\n" unless $eval;
-            }
+sub get_dba_password {
+    print "In order to create or update your RT database,"
+        . " this script needs to connect to your "
+        . " $db_type instance on $db_host as $dba_user\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);
+}
 
-            if ( $item->{LookupType} && !exists $item->{'Queue'} ) { # enable by default
-                my $ocf = RT::ObjectCustomField->new($CurrentUser);
-                $ocf->Create( CustomField => $new_entry->Id );
-            }
+=head2 get_system_dbh
 
-            print "(Error: $msg)\n" unless $return;
-            print $return. ".";
-        }
+Returns L<DBI> database handle connected to B<system> with DBA credentials.
 
-        print "done.\n";
-    }
+See also L<RT::Handle/SystemDSN>.
 
-    if ( @ScripActions ) {
-        print "Creating ScripActions...";
+=cut
 
-        for $item (@ScripActions) {
-            my $new_entry = RT::ScripAction->new($CurrentUser);
-            my ($return,$msg) = $new_entry->Create(%$item);
-            unless ($return) {
-                print "(Error: $msg)\n";
-                next;
-            }
-            print $return. ".";
-        }
+sub get_system_dbh {
+    return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass );
+}
 
-        print "done.\n";
-    }
+sub get_admin_dbh {
+    return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass );
+}
 
-    if ( @ScripConditions ) {
-        print "Creating ScripConditions...";
+=head2 get_rt_dbh [USER, PASSWORD]
 
-        for $item (@ScripConditions) {
-            my $new_entry = RT::ScripCondition->new($CurrentUser);
-            my ($return,$msg) = $new_entry->Create(%$item);
-            unless ($return) {
-                print "(Error: $msg)\n";
-                next;
-            }
-            print $return. ".";
-        }
+Returns L<DBI> database handle connected to RT database,
+you may specify credentials(USER and PASSWORD) to connect
+with. By default connects with credentials from RT config.
 
-        print "done.\n";
-    }
+=cut
 
-    if ( @Templates ) {
-        print "Creating templates...";
+sub get_rt_dbh {
+    return _get_dbh( RT::Handle->DSN, $db_user, $db_pass );
+}
 
-        for $item (@Templates) {
-            my $new_entry = new RT::Template($CurrentUser);
-            my $return    = $new_entry->Create(%$item);
-            print $return. ".";
-        }
-        print "done.\n";
-    }
-    if ( @Scrips ) {
-        print "Creating scrips...";
-
-        for $item (@Scrips) {
-            my $new_entry = new RT::Scrip($CurrentUser);
-            my ( $return, $msg ) = $new_entry->Create(%$item);
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print "(Error: $msg)\n";
-            }
-        }
-        print "done.\n";
-    }
-    if ( @Attributes ) {
-        print "Creating predefined searches...";
-        my $sys = RT::System->new($CurrentUser);
-
-        for $item (@Attributes) {
-            my $obj = delete $item->{Object}; # XXX: make this something loadable
-            $obj ||= $sys;
-            my ( $return, $msg ) = $obj->AddAttribute (%$item);
-            if ( $return ) {
-                print $return. ".";
-            }
-            else {
-                print "(Error: $msg)\n";
-            }
+sub _get_dbh {
+    my ($dsn, $user, $pass) = @_;
+    my $dbh = DBI->connect(
+        $dsn, $user, $pass,
+        { RaiseError => 0, PrintError => 0 },
+    );
+    unless ( $dbh ) {
+        my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr;
+        if ( $args{'debug'} ) {
+            require Carp; Carp::confess( $msg );
+        } else {
+            print STDERR $msg; exit -1;
         }
-        print "done.\n";
     }
-    $RT::Handle->Disconnect() unless $RT::DatabaseType eq 'SQLite';
-    print "Done setting up database content.\n";
+    return $dbh;
 }
 
-=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 _yesno {
+    print "Proceed [y/N]:";
+    my $x = scalar(<STDIN>);
+    $x =~ /^y/i;
 }
 
 sub help {
@@ -674,25 +427,39 @@ sub help {
 
 $0: Set up RT's database
 
---action        init    Initialize the database
-                drop    Drop the database.
-                        This will ERASE ALL YOUR DATA
-                insert  Insert data into RT's database.
-                        By default, will use RT's installation data.
-                        To use a local or supplementary datafile, specify it
-                        using the '--datafile' option below.
+--action        init     Initialize the database. This is combination of
+                         multiple actions listed below. Create DB, schema,
+                         setup acl, insert core data and initial data.
+
+                upgrade  Apply all needed schema/acl/content updates (will ask
+                         for version to upgrade from)
+
+                create   Create the database.
+
+                drop     Drop the database.
+                         This will ERASE ALL YOUR DATA
+
+                schema   Initialize only the database schema
+                         To use a local or supplementary datafile, specify it
+                         using the '--datadir' option below.
+
+                acl      Initialize only the database ACLs
+                         To use a local or supplementary datafile, specify it
+                         using the '--datadir' option below.
+
+                coredata Insert data into RT's database. This data is required
+                         for normal functioning of any RT instance.
 
-                acl     Initialize only the database ACLs
-                        To use a local or supplementary datafile, specify it
-                        using the '--datadir' option below.
+                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.
 
-                schema  Initialize only the database schema
-                        To use a local or supplementary datafile, specify it
-                        using the '--datadir' option below.
+Several actions can be combined using comma separated list.
 
 --datafile /path/to/datafile
 --datadir /path/to/              Used to specify a path to find the local
-                                database schema and acls to be installed.
+                                 database schema and acls to be installed.
 
 
 --dba                           dba's username
diff --git a/rt/sbin/rt-shredder b/rt/sbin/rt-shredder
new file mode 100755
index 0000000..5fa4909
--- /dev/null
+++ b/rt/sbin/rt-shredder
@@ -0,0 +1,323 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+=head1 NAME
+
+rt-shredder - Script which wipe out tickets from RT DB
+
+=head1 SYNOPSIS
+
+  rt-shredder --plugin list
+  rt-shredder --plugin help-Tickets
+  rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"'
+
+  rt-shredder --sqldump unshred.sql --plugin ...
+  rt-shredder --force --plugin ...
+
+=head1 DESCRIPTION
+
+rt-shredder - is script that allow you to wipe out objects
+from RT DB. This script uses API that L<RT::Shredder> module adds to RT.
+Script can be used as example of usage of the shredder API.
+
+=head1 USAGE
+
+You can use several options to control which objects script
+should wipeout.
+
+=head1 OPTIONS
+
+=head2 --sqldump <filename>
+
+Outputs INSERT queiries into file. This dump can be used to restore data
+after wiping out.
+
+By default creates files
+F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >>
+
+=head2 --object (DEPRECATED)
+
+Option has been deprecated, use plugin C<Objects> instead.
+
+=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]'
+
+You can use plugins to select RT objects with various conditions.
+See also --plugin list and --plugin help options.
+
+=head2 --plugin list
+
+Output list of the available plugins.
+
+=head2 --plugin help-<plugin name>
+
+Outputs help for specified plugin.
+
+=head2 --force
+
+Script doesn't ask any questions.
+
+=head1 SEE ALSO
+
+L<RT::Shredder>
+
+=cut
+
+use strict;
+use warnings FATAL => 'all';
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT::Shredder ();
+use Getopt::Long qw(GetOptions);
+use File::Spec ();
+
+use RT::Shredder::Plugin ();
+# prefetch list of plugins
+our %plugins = RT::Shredder::Plugin->List;
+
+our %opt;
+parse_args();
+
+RT::Shredder::Init( %opt );
+my $shredder = new RT::Shredder;
+
+{
+    my $plugin = eval { $shredder->AddDumpPlugin( Arguments => {
+        file_name    => $opt{'sqldump'},
+        from_storage => 0,
+    } ) };
+	if( $@ ) {
+        print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
+        exit 1 if $opt{'sqldump'};
+
+        print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n";
+        unless( $opt{'force'} ) {
+            exit 0 unless prompt_yN( "Do you want to proceed?" );
+        }
+	} else {
+        print "SQL dump file is '". $plugin->FileName ."'\n";
+    }
+}
+
+my @objs = process_plugins( $shredder );
+prompt_delete_objs( \@objs ) unless $opt{'force'};
+
+$shredder->PutObjects( Objects => $_ ) foreach @objs;
+eval { $shredder->WipeoutAll };
+if( $@ ) {
+    require RT::Shredder::Exceptions;
+    if( my $e = RT::Shredder::Exception::Info->caught ) {
+        print "\nERROR: $e\n\n";
+        exit 1;
+    }
+    die $@;
+}
+
+sub prompt_delete_objs
+{
+	my( $objs ) = @_;
+	unless( @$objs ) {
+		print "Objects list is empty, try refine search options\n";
+		exit 0;
+	}
+	my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n";
+	foreach my $o( @$objs ) {
+		$list .= "\t". $o->_AsString ." object\n";
+	}
+	print $list;
+	exit(0) unless prompt_yN( "Do you want to proceed?" );
+}
+
+sub prompt_yN
+{
+	my $text = shift;
+	print "$text [y/N] ";
+	unless( <STDIN> =~ /^(?:y|yes)$/i ) {
+		return 0;
+	}
+	return 1;
+}
+
+sub usage
+{
+	require RT::Shredder::POD;
+	RT::Shredder::POD::shredder_cli( $0, \*STDOUT );
+	exit 1;
+}
+
+sub parse_args
+{
+	my $tmp;
+	Getopt::Long::Configure( "pass_through" );
+	my @objs = ();
+	if( GetOptions( 'object=s' => \@objs ) && @objs ) {
+		print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n";
+        exit(1);
+	}
+
+	my @plugins = ();
+	if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) {
+		$opt{'plugin'} = \@plugins;
+		foreach my $str( @plugins ) {
+			if( $str =~ /^\s*list\s*$/ ) {
+				show_plugin_list();
+			} elsif( $str =~ /^\s*help-(\w+)\s*$/ ) {
+				show_plugin_help( $1 );
+			} elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) {
+				print "Couldn't find plugin '$1'\n";
+				show_plugin_list();
+			}
+		}
+	}
+
+	# other options make no sense without previouse
+	usage() unless keys %opt;
+
+	if( GetOptions( 'force' => \$tmp ) && $tmp ) {
+		$opt{'force'}++;
+	}
+	$tmp = undef;
+	if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) {
+		$opt{'sqldump'} = $tmp;
+	}
+	return;
+}
+
+sub process_plugins
+{
+	my $shredder = shift;
+
+	my @res;
+	foreach my $str( @{ $opt{'plugin'} } ) {
+		my $plugin = new RT::Shredder::Plugin;
+		my( $status, $msg ) = $plugin->LoadByString( $str );
+		unless( $status ) {
+			print STDERR "Couldn't load plugin\n";
+			print STDERR "Error: $msg\n";
+			exit(1);
+		}
+        if ( lc $plugin->Type eq 'search' ) {
+            push @res, _process_search_plugin( $shredder, $plugin );
+        }
+        elsif ( lc $plugin->Type eq 'dump' ) {
+            _process_dump_plugin( $shredder, $plugin );
+        }
+	}
+	return RT::Shredder->CastObjectsToRecords( Objects => \@res );
+}
+
+sub _process_search_plugin {
+    my ($shredder, $plugin) = @_;
+    my ($status, @objs) = $plugin->Run;
+    unless( $status ) {
+        print STDERR "Couldn't run plugin\n";
+        print STDERR "Error: $objs[1]\n";
+        exit(1);
+    }
+
+    my $msg;
+    ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
+    unless( $status ) {
+        print STDERR "Couldn't set conflicts resolver\n";
+        print STDERR "Error: $msg\n";
+        exit(1);
+    }
+    return @objs;
+}
+
+sub _process_dump_plugin {
+    my ($shredder, $plugin) = @_;
+    $shredder->AddDumpPlugin(
+        Object => $plugin,
+    );
+}
+
+sub show_plugin_list
+{
+	print "Plugins list:\n";
+	print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
+	exit(1);
+}
+
+sub show_plugin_help
+{
+	my( $name ) = @_;
+	require RT::Shredder::POD;
+	unless( $plugins{ $name } ) {
+		print "Couldn't find plugin '$name'\n";
+		show_plugin_list();
+	}
+	RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
+	RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
+	exit(1);
+}
+
+exit(0);
diff --git a/rt/sbin/rt-shredder.in b/rt/sbin/rt-shredder.in
new file mode 100755
index 0000000..bc91ef6
--- /dev/null
+++ b/rt/sbin/rt-shredder.in
@@ -0,0 +1,323 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+=head1 NAME
+
+rt-shredder - Script which wipe out tickets from RT DB
+
+=head1 SYNOPSIS
+
+  rt-shredder --plugin list
+  rt-shredder --plugin help-Tickets
+  rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"'
+
+  rt-shredder --sqldump unshred.sql --plugin ...
+  rt-shredder --force --plugin ...
+
+=head1 DESCRIPTION
+
+rt-shredder - is script that allow you to wipe out objects
+from RT DB. This script uses API that L<RT::Shredder> module adds to RT.
+Script can be used as example of usage of the shredder API.
+
+=head1 USAGE
+
+You can use several options to control which objects script
+should wipeout.
+
+=head1 OPTIONS
+
+=head2 --sqldump <filename>
+
+Outputs INSERT queiries into file. This dump can be used to restore data
+after wiping out.
+
+By default creates files
+F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >>
+
+=head2 --object (DEPRECATED)
+
+Option has been deprecated, use plugin C<Objects> instead.
+
+=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]'
+
+You can use plugins to select RT objects with various conditions.
+See also --plugin list and --plugin help options.
+
+=head2 --plugin list
+
+Output list of the available plugins.
+
+=head2 --plugin help-<plugin name>
+
+Outputs help for specified plugin.
+
+=head2 --force
+
+Script doesn't ask any questions.
+
+=head1 SEE ALSO
+
+L<RT::Shredder>
+
+=cut
+
+use strict;
+use warnings FATAL => 'all';
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use RT::Shredder ();
+use Getopt::Long qw(GetOptions);
+use File::Spec ();
+
+use RT::Shredder::Plugin ();
+# prefetch list of plugins
+our %plugins = RT::Shredder::Plugin->List;
+
+our %opt;
+parse_args();
+
+RT::Shredder::Init( %opt );
+my $shredder = new RT::Shredder;
+
+{
+    my $plugin = eval { $shredder->AddDumpPlugin( Arguments => {
+        file_name    => $opt{'sqldump'},
+        from_storage => 0,
+    } ) };
+	if( $@ ) {
+        print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
+        exit 1 if $opt{'sqldump'};
+
+        print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n";
+        unless( $opt{'force'} ) {
+            exit 0 unless prompt_yN( "Do you want to proceed?" );
+        }
+	} else {
+        print "SQL dump file is '". $plugin->FileName ."'\n";
+    }
+}
+
+my @objs = process_plugins( $shredder );
+prompt_delete_objs( \@objs ) unless $opt{'force'};
+
+$shredder->PutObjects( Objects => $_ ) foreach @objs;
+eval { $shredder->WipeoutAll };
+if( $@ ) {
+    require RT::Shredder::Exceptions;
+    if( my $e = RT::Shredder::Exception::Info->caught ) {
+        print "\nERROR: $e\n\n";
+        exit 1;
+    }
+    die $@;
+}
+
+sub prompt_delete_objs
+{
+	my( $objs ) = @_;
+	unless( @$objs ) {
+		print "Objects list is empty, try refine search options\n";
+		exit 0;
+	}
+	my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n";
+	foreach my $o( @$objs ) {
+		$list .= "\t". $o->_AsString ." object\n";
+	}
+	print $list;
+	exit(0) unless prompt_yN( "Do you want to proceed?" );
+}
+
+sub prompt_yN
+{
+	my $text = shift;
+	print "$text [y/N] ";
+	unless( <STDIN> =~ /^(?:y|yes)$/i ) {
+		return 0;
+	}
+	return 1;
+}
+
+sub usage
+{
+	require RT::Shredder::POD;
+	RT::Shredder::POD::shredder_cli( $0, \*STDOUT );
+	exit 1;
+}
+
+sub parse_args
+{
+	my $tmp;
+	Getopt::Long::Configure( "pass_through" );
+	my @objs = ();
+	if( GetOptions( 'object=s' => \@objs ) && @objs ) {
+		print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n";
+        exit(1);
+	}
+
+	my @plugins = ();
+	if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) {
+		$opt{'plugin'} = \@plugins;
+		foreach my $str( @plugins ) {
+			if( $str =~ /^\s*list\s*$/ ) {
+				show_plugin_list();
+			} elsif( $str =~ /^\s*help-(\w+)\s*$/ ) {
+				show_plugin_help( $1 );
+			} elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) {
+				print "Couldn't find plugin '$1'\n";
+				show_plugin_list();
+			}
+		}
+	}
+
+	# other options make no sense without previouse
+	usage() unless keys %opt;
+
+	if( GetOptions( 'force' => \$tmp ) && $tmp ) {
+		$opt{'force'}++;
+	}
+	$tmp = undef;
+	if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) {
+		$opt{'sqldump'} = $tmp;
+	}
+	return;
+}
+
+sub process_plugins
+{
+	my $shredder = shift;
+
+	my @res;
+	foreach my $str( @{ $opt{'plugin'} } ) {
+		my $plugin = new RT::Shredder::Plugin;
+		my( $status, $msg ) = $plugin->LoadByString( $str );
+		unless( $status ) {
+			print STDERR "Couldn't load plugin\n";
+			print STDERR "Error: $msg\n";
+			exit(1);
+		}
+        if ( lc $plugin->Type eq 'search' ) {
+            push @res, _process_search_plugin( $shredder, $plugin );
+        }
+        elsif ( lc $plugin->Type eq 'dump' ) {
+            _process_dump_plugin( $shredder, $plugin );
+        }
+	}
+	return RT::Shredder->CastObjectsToRecords( Objects => \@res );
+}
+
+sub _process_search_plugin {
+    my ($shredder, $plugin) = @_;
+    my ($status, @objs) = $plugin->Run;
+    unless( $status ) {
+        print STDERR "Couldn't run plugin\n";
+        print STDERR "Error: $objs[1]\n";
+        exit(1);
+    }
+
+    my $msg;
+    ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
+    unless( $status ) {
+        print STDERR "Couldn't set conflicts resolver\n";
+        print STDERR "Error: $msg\n";
+        exit(1);
+    }
+    return @objs;
+}
+
+sub _process_dump_plugin {
+    my ($shredder, $plugin) = @_;
+    $shredder->AddDumpPlugin(
+        Object => $plugin,
+    );
+}
+
+sub show_plugin_list
+{
+	print "Plugins list:\n";
+	print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
+	exit(1);
+}
+
+sub show_plugin_help
+{
+	my( $name ) = @_;
+	require RT::Shredder::POD;
+	unless( $plugins{ $name } ) {
+		print "Couldn't find plugin '$name'\n";
+		show_plugin_list();
+	}
+	RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
+	RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
+	exit(1);
+}
+
+exit(0);
diff --git a/rt/sbin/rt-test-dependencies b/rt/sbin/rt-test-dependencies
index fb14f84..a1fed19 100644
--- a/rt/sbin/rt-test-dependencies
+++ b/rt/sbin/rt-test-dependencies
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -64,14 +64,24 @@ GetOptions(
     'with-SPEEDYCGI',                     'with-MODPERL1',
     'with-MODPERL2',                      'with-DEV',
     'with-STANDALONE',
+
+    'with-GPG',
+    'with-ICAL',
+    'with-SMTP',
+    'with-GRAPHVIZ',
+    'with-GD',
+    'with-DASHBOARDS',
+
     'download=s',
-    'repository=s'
+    'repository=s',
+    'list-deps'
 );
 
 unless (keys %args) {
     help();
-    exit(0);
+    exit(1);
 }
+
 # Set up defaults
 my %default = (
     'with-MASON' => 1,
@@ -79,11 +89,16 @@ my %default = (
     'with-CLI' => 1,
     'with-MAILGATE' => 1, 
     'with-DEV' => 0, 
-    'with-STANDALONE' => 0,
+    'with-STANDALONE' => 1,
+    'with-GPG' => 1,
+    'with-ICAL' => 1,
+    'with-SMTP' => 1,
+    'with-GRAPHVIZ' => 0,
+    'with-GD' => 1,
+    'with-DASHBOARDS' => 1
 );
 $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
 
-
 {
   my $section;
   my %always_show_sections = (
@@ -94,35 +109,53 @@ $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
   sub section {
     my $s = shift;
     $section = $s;
-    print "$s:\n";
+    print "$s:\n" unless $args{'list-deps'};
   }
 
-  my $any_missing = 0;
-  sub found {
+  sub print_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";
+
+    unless ( $args{'list-deps'} ) {
+        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;
     }
-    
-    print "\t\t$extra\n" if defined $extra;
   }
+}
 
-  sub conclude {
-    if ($any_missing) {
-      print "\nSOMETHING WAS MISSING!\n";
-      exit 1;
-    } else {
-      print "\nEverything was found.\n";
+sub conclude {
+    my %missing_by_type = @_;
+
+    unless ( $args{'list-deps'} ) {
+        unless ( keys %missing_by_type ) {
+            print "\nAll dependencies have been found.\n";
+            return;
+        }
+
+        print "\nSOME DEPENDENCIES WERE MISSING.\n";
+
+        for my $type ( keys %missing_by_type ) {
+            my $missing = $missing_by_type{$type};
+
+            print "$type missing dependencies:\n";
+            for my $name ( keys %$missing ) {
+                my $module  = $missing->{$name};
+                my $version = $module->{version};
+                print_found( $name . ( $version ? " >= $version" : "" ),
+                    0, $module->{error} );
+            }
+        }
+        exit 1;
     }
-  }
 }
 
+
 sub help {
 
     print <<'.';
@@ -130,22 +163,22 @@ sub help {
 By default, testdeps determine whether you have 
 installed all the perl modules RT needs to run.
 
-	--install		Install missing modules
+    --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-mysql        Database interface for MySQL
+    --with-postgresql   Database interface for PostgreSQL 
+    --with-oracle       Database interface for Oracle
+    --with-sqlite       Database interface and driver for SQLite (unsupported)
 
-	--with-standalone	Libraries needed to support the standalone simple pure perl server
-	--with-fastcgi		Libraries needed to support the fastcgi handler
-	--with-speedycgi	Libraries needed to support the speedycgi handler
-	--with-modperl1		Libraries needed to support the modperl 1 handler
-	--with-modperl2		Libraries needed to support the modperl 2 handler
+    --with-standalone   Libraries needed to support the standalone simple pure perl server
+    --with-fastcgi      Libraries needed to support the fastcgi handler
+    --with-speedycgi    Libraries needed to support the speedycgi handler
+    --with-modperl1     Libraries needed to support the modperl 1 handler
+    --with-modperl2     Libraries needed to support the modperl 2 handler
 
-	--with-dev		Tools needed for RT development
+    --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.
@@ -175,54 +208,55 @@ Digest::base
 Digest::MD5 2.27
 DBI 1.37
 Class::ReturnValue 0.40
-Date::Format
-DBIx::SearchBuilder 1.53
-Text::Template
+DBIx::SearchBuilder 1.54
+Text::Template 1.44
+File::ShareDir
 File::Spec 0.8
 HTML::Entities 
 HTML::Scrubber 0.08
 Log::Dispatch 2.0
+Sys::Syslog 0.16
 Locale::Maketext 1.06
 Locale::Maketext::Lexicon 0.32
 Locale::Maketext::Fuzzy
-MIME::Entity 5.108
+MIME::Entity 5.425
 Mail::Mailer 1.57
-Net::SMTP
+Email::Address
 Text::Wrapper 
 Time::ParseDate
 Time::HiRes 
-File::Temp
-Text::Autoformat
+File::Temp 0.18
 Text::Quoted 2.02
 Tree::Simple 1.04
+UNIVERSAL::require
 Regexp::Common
 Scalar::Util
-Module::Versions::Report 1.03
+Module::Versions::Report 1.05
 Cache::Simple::TimedExpiry
-UNIVERSAL::require
 Calendar::Simple
+Encode 2.21
 CSS::Squish 0.06
+File::Glob
 Devel::StackTrace 1.19
 .
 
 $deps{'MASON'} = [ text_to_hash( << '.') ];
-HTML::Mason 1.23
+HTML::Mason 1.36
 Errno
 Digest::MD5 2.27
 CGI::Cookie 1.20
 Storable 2.08
 Apache::Session 1.53
 XML::RSS 1.05
-GD
-GD::Graph
-GD::Text
 Text::WikiFormat 0.76
 CSS::Squish 0.06
+Devel::StackTrace 1.19
 .
 
 $deps{'STANDALONE'} = [ text_to_hash( << '.') ];
-HTTP::Server::Simple 0.07
+HTTP::Server::Simple 0.34
 HTTP::Server::Simple::Mason 0.09
+Net::Server
 .
 
 $deps{'MAILGATE'} = [ text_to_hash( << '.') ];
@@ -243,48 +277,58 @@ Term::ReadKey
 .
 
 $deps{'DEV'} = [ text_to_hash( << '.') ];
-Test::Inline 
-Apache::Test
 HTML::Form
 HTML::TokeParser
 WWW::Mechanize
 Test::WWW::Mechanize 1.04
 Module::Refresh 0.03
-Test::Expect 0.30
+Test::Expect 0.31
 XML::Simple
 File::Find
+Test::Deep 0 # needed for shredder tests
+String::ShellQuote 0 # needed for gnupg-incoming.t
+Test::HTTP::Server::Simple 0.09
+Test::HTTP::Server::Simple::StashWarnings 0.02
+Log::Dispatch::Perl
+Test::Warn
+Test::Builder 0.77 # needed to fix TODO test
+IPC::Run3
+Test::MockTime
+HTTP::Server::Simple::Mason 0.13
 .
 
 $deps{'FASTCGI'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 FCGI
 CGI::Fast 
 .
 
 $deps{'SPEEDYCGI'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 CGI::SpeedyCGI
 .
 
 
 $deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 Apache::Request
 Apache::DBI 0.92
 .
 
 $deps{'MODPERL2'} = [ text_to_hash( << '.') ];
-CGI 3.10
+CGI 3.38
 Apache::DBI
-HTML::Mason 1.31
+HTML::Mason 1.36
 .
 
 $deps{'MYSQL'} = [ text_to_hash( << '.') ];
 DBD::mysql 2.1018
 .
+
 $deps{'ORACLE'} = [ text_to_hash( << '.') ];
 DBD::Oracle
 .
+
 $deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
 DBD::Pg 1.43
 .
@@ -293,6 +337,36 @@ $deps{'SQLITE'} = [ text_to_hash( << '.') ];
 DBD::SQLite 1.00
 .
 
+$deps{'GPG'} = [ text_to_hash( << '.') ];
+GnuPG::Interface
+PerlIO::eol
+.
+
+$deps{'ICAL'} = [ text_to_hash( << '.') ];
+Data::ICal
+.
+
+$deps{'SMTP'} = [ text_to_hash( << '.') ];
+Net::SMTP
+.
+
+$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
+HTML::RewriteAttributes 0.02
+MIME::Types
+.
+
+$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
+GraphViz
+IPC::Run
+IPC::Run::SafeHandles
+.
+
+$deps{'GD'} = [ text_to_hash( << '.') ];
+GD
+GD::Graph
+GD::Text
+.
+
 if ($args{'download'}) {
 
     download_mods();
@@ -303,7 +377,7 @@ check_perl_version();
 
 check_users();
 
-
+my %Missing_By_Type = ();
 foreach my $type (sort grep $args{$_}, keys %args) {
     next unless ($type =~ /^with-(.*?)$/);
 
@@ -312,39 +386,58 @@ foreach my $type (sort grep $args{$_}, keys %args) {
 
     my @missing;
     my @deps = @{ $deps{$type} };
-    while (@deps) {
-        my $module = shift @deps;
-        my $version = shift @deps;
-        my $ret = test_dep($module, $version);
 
-        push @missing, $module, $version unless $ret;
-    }
+    my %missing = test_deps(@deps);
+
     if ( $args{'install'} ) {
-        while( @missing ) {
-            resolve_dep(shift @missing, shift @missing);
+        for my $module (keys %missing) {
+            resolve_dep($module, $missing{$module}{version});
+            delete $missing{$module} if test_dep($module, $missing{$module}{version});
         }
     }
+
+    $Missing_By_Type{$type} = \%missing if keys %missing;
 }
 
-conclude();
+conclude(%Missing_By_Type);
+
+sub test_deps {
+    my @deps = @_;
+
+    my %missing;
+    while(@deps) {
+        my $module = shift @deps;
+        my $version = shift @deps;
+        my($test, $error) = test_dep($module, $version);
+        my $msg = $module . ($version ? " >= $version" : '');
+        print_found($msg, $test, $error);
+
+        $missing{$module} = { version => $version, error => $error } unless $test;
+    }
+
+    return %missing;
+}
 
 sub test_dep {
     my $module = shift;
     my $version = shift;
 
-    eval "use $module $version ()";
-    if ($@) {
-        my $error = $@;
-        $error =~ s/\n(.*)$//s;
-        undef $error unless $error =~ /this is only/;
-        found("$module $version", 0, $error);
-
-        return undef;
-    } else {
-        my $msg = "$module";
-        $msg .= " >=$version" if $version;
-        found($msg, 1);
-        return 1;
+    if ( $args{'list-deps'} ) {
+        print $module, ': ', $version || 0, "\n"; 
+    }
+    else {
+        eval "use $module $version ()";
+        if ($@) {
+            my $error = $@;
+            $error =~ s/\n(.*)$//s;
+            $error =~ s/at \(eval \d+\) line \d+\.$//;
+            undef $error unless $error =~ /this is only/;
+
+            return ( 0, $error );
+        }
+        else {
+            return 1;
+        }
     }
 }
 
@@ -366,8 +459,8 @@ sub resolve_dep {
         }
         unless ( $configured ) {
             print <<END;
-You didn't configure CPAN shell yet.
-Please run `/usr/bin/perl -MCPAN -e shell` tool and configure it.
+You haven't configured the CPAN shell yet.
+Please run `/usr/bin/perl -MCPAN -e shell` to configure it.
 END
             exit(1);
         }
@@ -459,21 +552,21 @@ 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.");
+    print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer.");
     exit(1);
   } else {
-    found( ">=5.8.3($])", 1);
+    print_found( sprintf(">=5.8.3(%vd)", $^V), 1 );
   }
 }
 
 sub check_users {
   section("users");
-  found("rt group (www)",      defined getgrnam("www"));
-  found("bin owner (root)",   defined getpwnam("root"));
-  found("libs owner (root)", defined getpwnam("root"));
-  found("libs group (bin)", defined getgrnam("bin"));
-  found("web owner (www)",    defined getpwnam("www"));
-  found("web group (www)",   defined getgrnam("www"));
+  print_found("rt group (www)",      defined getgrnam("www"));
+  print_found("bin owner (root)",   defined getpwnam("root"));
+  print_found("libs owner (root)", defined getpwnam("root"));
+  print_found("libs group (bin)", defined getgrnam("bin"));
+  print_found("web owner (www)",    defined getpwnam("www"));
+  print_found("web group (www)",   defined getgrnam("www"));
 }
 
 
diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in
index f978d7b..9819108 100644
--- a/rt/sbin/rt-test-dependencies.in
+++ b/rt/sbin/rt-test-dependencies.in
@@ -2,8 +2,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -64,14 +64,24 @@ GetOptions(
     'with-SPEEDYCGI',                     'with-MODPERL1',
     'with-MODPERL2',                      'with-DEV',
     'with-STANDALONE',
+
+    'with-GPG',
+    'with-ICAL',
+    'with-SMTP',
+    'with-GRAPHVIZ',
+    'with-GD',
+    'with-DASHBOARDS',
+
     'download=s',
-    'repository=s'
+    'repository=s',
+    'list-deps'
 );
 
 unless (keys %args) {
     help();
-    exit(0);
+    exit(1);
 }
+
 # Set up defaults
 my %default = (
     'with-MASON' => 1,
@@ -79,11 +89,16 @@ my %default = (
     'with-CLI' => 1,
     'with-MAILGATE' => 1, 
     'with-DEV' => @RT_DEVEL_MODE@, 
-    'with-STANDALONE' => @RT_STANDALONE@,
+    'with-STANDALONE' => 1,
+    'with-GPG' => @RT_GPG@,
+    'with-ICAL' => 1,
+    'with-SMTP' => 1,
+    'with-GRAPHVIZ' => @RT_GRAPHVIZ@,
+    'with-GD' => @RT_GD@,
+    'with-DASHBOARDS' => 1
 );
 $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
 
-
 {
   my $section;
   my %always_show_sections = (
@@ -94,35 +109,53 @@ $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
   sub section {
     my $s = shift;
     $section = $s;
-    print "$s:\n";
+    print "$s:\n" unless $args{'list-deps'};
   }
 
-  my $any_missing = 0;
-  sub found {
+  sub print_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";
+
+    unless ( $args{'list-deps'} ) {
+        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;
     }
-    
-    print "\t\t$extra\n" if defined $extra;
   }
+}
 
-  sub conclude {
-    if ($any_missing) {
-      print "\nSOMETHING WAS MISSING!\n";
-      exit 1;
-    } else {
-      print "\nEverything was found.\n";
+sub conclude {
+    my %missing_by_type = @_;
+
+    unless ( $args{'list-deps'} ) {
+        unless ( keys %missing_by_type ) {
+            print "\nAll dependencies have been found.\n";
+            return;
+        }
+
+        print "\nSOME DEPENDENCIES WERE MISSING.\n";
+
+        for my $type ( keys %missing_by_type ) {
+            my $missing = $missing_by_type{$type};
+
+            print "$type missing dependencies:\n";
+            for my $name ( keys %$missing ) {
+                my $module  = $missing->{$name};
+                my $version = $module->{version};
+                print_found( $name . ( $version ? " >= $version" : "" ),
+                    0, $module->{error} );
+            }
+        }
+        exit 1;
     }
-  }
 }
 
+
 sub help {
 
     print <<'.';
@@ -130,22 +163,22 @@ sub help {
 By default, testdeps determine whether you have 
 installed all the perl modules RT needs to run.
 
-	--install		Install missing modules
+    --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-mysql        Database interface for MySQL
+    --with-postgresql   Database interface for PostgreSQL 
+    --with-oracle       Database interface for Oracle
+    --with-sqlite       Database interface and driver for SQLite (unsupported)
 
-	--with-standalone	Libraries needed to support the standalone simple pure perl server
-	--with-fastcgi		Libraries needed to support the fastcgi handler
-	--with-speedycgi	Libraries needed to support the speedycgi handler
-	--with-modperl1		Libraries needed to support the modperl 1 handler
-	--with-modperl2		Libraries needed to support the modperl 2 handler
+    --with-standalone   Libraries needed to support the standalone simple pure perl server
+    --with-fastcgi      Libraries needed to support the fastcgi handler
+    --with-speedycgi    Libraries needed to support the speedycgi handler
+    --with-modperl1     Libraries needed to support the modperl 1 handler
+    --with-modperl2     Libraries needed to support the modperl 2 handler
 
-	--with-dev		Tools needed for RT development
+    --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.
@@ -175,54 +208,55 @@ Digest::base
 Digest::MD5 2.27
 DBI 1.37
 Class::ReturnValue 0.40
-Date::Format
-DBIx::SearchBuilder 1.53
-Text::Template
+DBIx::SearchBuilder 1.54
+Text::Template 1.44
+File::ShareDir
 File::Spec 0.8
 HTML::Entities 
 HTML::Scrubber 0.08
 Log::Dispatch 2.0
+Sys::Syslog 0.16
 Locale::Maketext 1.06
 Locale::Maketext::Lexicon 0.32
 Locale::Maketext::Fuzzy
-MIME::Entity 5.108
+MIME::Entity 5.425
 Mail::Mailer 1.57
-Net::SMTP
+Email::Address
 Text::Wrapper 
 Time::ParseDate
 Time::HiRes 
-File::Temp
-Text::Autoformat
+File::Temp 0.18
 Text::Quoted 2.02
 Tree::Simple 1.04
+UNIVERSAL::require
 Regexp::Common
 Scalar::Util
-Module::Versions::Report 1.03
+Module::Versions::Report 1.05
 Cache::Simple::TimedExpiry
-UNIVERSAL::require
 Calendar::Simple
+Encode 2.21
 CSS::Squish 0.06
+File::Glob
 Devel::StackTrace 1.19
 .
 
 $deps{'MASON'} = [ text_to_hash( << '.') ];
-HTML::Mason 1.23
+HTML::Mason 1.36
 Errno
 Digest::MD5 2.27
 CGI::Cookie 1.20
 Storable 2.08
 Apache::Session 1.53
 XML::RSS 1.05
-GD
-GD::Graph
-GD::Text
 Text::WikiFormat 0.76
 CSS::Squish 0.06
+Devel::StackTrace 1.19
 .
 
 $deps{'STANDALONE'} = [ text_to_hash( << '.') ];
-HTTP::Server::Simple 0.07
+HTTP::Server::Simple 0.34
 HTTP::Server::Simple::Mason 0.09
+Net::Server
 .
 
 $deps{'MAILGATE'} = [ text_to_hash( << '.') ];
@@ -243,48 +277,58 @@ Term::ReadKey
 .
 
 $deps{'DEV'} = [ text_to_hash( << '.') ];
-Test::Inline 
-Apache::Test
 HTML::Form
 HTML::TokeParser
 WWW::Mechanize
 Test::WWW::Mechanize 1.04
 Module::Refresh 0.03
-Test::Expect 0.30
+Test::Expect 0.31
 XML::Simple
 File::Find
+Test::Deep 0 # needed for shredder tests
+String::ShellQuote 0 # needed for gnupg-incoming.t
+Test::HTTP::Server::Simple 0.09
+Test::HTTP::Server::Simple::StashWarnings 0.02
+Log::Dispatch::Perl
+Test::Warn
+Test::Builder 0.77 # needed to fix TODO test
+IPC::Run3
+Test::MockTime
+HTTP::Server::Simple::Mason 0.13
 .
 
 $deps{'FASTCGI'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 FCGI
 CGI::Fast 
 .
 
 $deps{'SPEEDYCGI'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 CGI::SpeedyCGI
 .
 
 
 $deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-CGI 2.92
+CGI 3.38
 Apache::Request
 Apache::DBI 0.92
 .
 
 $deps{'MODPERL2'} = [ text_to_hash( << '.') ];
-CGI 3.10
+CGI 3.38
 Apache::DBI
-HTML::Mason 1.31
+HTML::Mason 1.36
 .
 
 $deps{'MYSQL'} = [ text_to_hash( << '.') ];
 DBD::mysql 2.1018
 .
+
 $deps{'ORACLE'} = [ text_to_hash( << '.') ];
 DBD::Oracle
 .
+
 $deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
 DBD::Pg 1.43
 .
@@ -293,6 +337,36 @@ $deps{'SQLITE'} = [ text_to_hash( << '.') ];
 DBD::SQLite 1.00
 .
 
+$deps{'GPG'} = [ text_to_hash( << '.') ];
+GnuPG::Interface
+PerlIO::eol
+.
+
+$deps{'ICAL'} = [ text_to_hash( << '.') ];
+Data::ICal
+.
+
+$deps{'SMTP'} = [ text_to_hash( << '.') ];
+Net::SMTP
+.
+
+$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
+HTML::RewriteAttributes 0.02
+MIME::Types
+.
+
+$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
+GraphViz
+IPC::Run
+IPC::Run::SafeHandles
+.
+
+$deps{'GD'} = [ text_to_hash( << '.') ];
+GD
+GD::Graph
+GD::Text
+.
+
 if ($args{'download'}) {
 
     download_mods();
@@ -303,7 +377,7 @@ check_perl_version();
 
 check_users();
 
-
+my %Missing_By_Type = ();
 foreach my $type (sort grep $args{$_}, keys %args) {
     next unless ($type =~ /^with-(.*?)$/);
 
@@ -312,39 +386,58 @@ foreach my $type (sort grep $args{$_}, keys %args) {
 
     my @missing;
     my @deps = @{ $deps{$type} };
-    while (@deps) {
-        my $module = shift @deps;
-        my $version = shift @deps;
-        my $ret = test_dep($module, $version);
 
-        push @missing, $module, $version unless $ret;
-    }
+    my %missing = test_deps(@deps);
+
     if ( $args{'install'} ) {
-        while( @missing ) {
-            resolve_dep(shift @missing, shift @missing);
+        for my $module (keys %missing) {
+            resolve_dep($module, $missing{$module}{version});
+            delete $missing{$module} if test_dep($module, $missing{$module}{version});
         }
     }
+
+    $Missing_By_Type{$type} = \%missing if keys %missing;
 }
 
-conclude();
+conclude(%Missing_By_Type);
+
+sub test_deps {
+    my @deps = @_;
+
+    my %missing;
+    while(@deps) {
+        my $module = shift @deps;
+        my $version = shift @deps;
+        my($test, $error) = test_dep($module, $version);
+        my $msg = $module . ($version ? " >= $version" : '');
+        print_found($msg, $test, $error);
+
+        $missing{$module} = { version => $version, error => $error } unless $test;
+    }
+
+    return %missing;
+}
 
 sub test_dep {
     my $module = shift;
     my $version = shift;
 
-    eval "use $module $version ()";
-    if ($@) {
-        my $error = $@;
-        $error =~ s/\n(.*)$//s;
-        undef $error unless $error =~ /this is only/;
-        found("$module $version", 0, $error);
-
-        return undef;
-    } else {
-        my $msg = "$module";
-        $msg .= " >=$version" if $version;
-        found($msg, 1);
-        return 1;
+    if ( $args{'list-deps'} ) {
+        print $module, ': ', $version || 0, "\n"; 
+    }
+    else {
+        eval "use $module $version ()";
+        if ($@) {
+            my $error = $@;
+            $error =~ s/\n(.*)$//s;
+            $error =~ s/at \(eval \d+\) line \d+\.$//;
+            undef $error unless $error =~ /this is only/;
+
+            return ( 0, $error );
+        }
+        else {
+            return 1;
+        }
     }
 }
 
@@ -366,8 +459,8 @@ sub resolve_dep {
         }
         unless ( $configured ) {
             print <<END;
-You didn't configure CPAN shell yet.
-Please run `@PERL@ -MCPAN -e shell` tool and configure it.
+You haven't configured the CPAN shell yet.
+Please run `@PERL@ -MCPAN -e shell` to configure it.
 END
             exit(1);
         }
@@ -459,21 +552,21 @@ 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.");
+    print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer.");
     exit(1);
   } else {
-    found( ">=5.8.3($])", 1);
+    print_found( sprintf(">=5.8.3(%vd)", $^V), 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@"));
+  print_found("rt group (@RTGROUP@)",      defined getgrnam("@RTGROUP@"));
+  print_found("bin owner (@BIN_OWNER@)",   defined getpwnam("@BIN_OWNER@"));
+  print_found("libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@"));
+  print_found("libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@"));
+  print_found("web owner (@WEB_USER@)",    defined getpwnam("@WEB_USER@"));
+  print_found("web group (@WEB_GROUP@)",   defined getgrnam("@WEB_GROUP@"));
 }
 
 
diff --git a/rt/sbin/rt-validator b/rt/sbin/rt-validator
new file mode 100755
index 0000000..2d6fc04
--- /dev/null
+++ b/rt/sbin/rt-validator
@@ -0,0 +1,1118 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("lib", "local/lib");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use Getopt::Long;
+my %opt = ();
+GetOptions(
+    \%opt,
+    'check|c',
+    'resolve',
+    'force',
+    'verbose|v',
+);
+
+usage() unless $opt{'check'};
+usage_warning() if $opt{'resolve'} && !$opt{'force'};
+
+sub usage {
+    print STDERR <<END;
+Usage: $0 options
+
+Options:
+
+    $0 --check
+    $0 --check --verbose
+    $0 --check --verbose --resolve
+    $0 --check --verbose --resolve --force
+
+--check   - is mandatory argument, you can use -c, as well.
+--verbose - print additional info to STDOUT
+--resolve - enable resolver that can delete or create some records
+--force   - resolve without asking questions
+
+Description:
+
+This script checks integrity of records in RT's DB. May delete some invalid
+records or ressurect accidentally deleted.
+
+END
+    exit 1;
+}
+
+sub usage_warning {
+    print <<END;
+This utility can fix some issues with DB by creating or updating. In some
+cases there is no enough data to resurect a missing record, but records which
+refers to a missing can be deleted. It's up to you to decide what to do.
+
+In any case it's highly recommended to have a backup before resolving anything.
+
+Press enter to continue.
+END
+    <>;
+}
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+my $dbh = $RT::Handle->dbh;
+my $db_type = RT->Config->Get('DatabaseType');
+
+my %TYPE = (
+    'Transactions.Field'    => 'text',
+    'Transactions.OldValue' => 'text',
+    'Transactions.NewValue' => 'text',
+);
+
+my @models = qw(
+    ACE
+    Attachment
+    Attribute
+    CachedGroupMember
+    CustomField
+    CustomFieldValue
+    GroupMember
+    Group
+    Link
+    ObjectCustomField
+    ObjectCustomFieldValue
+    Principal
+    Queue
+    ScripAction
+    ScripCondition
+    Scrip
+    Template
+    Ticket
+    Transaction
+    User
+);
+
+my %redo_on;
+$redo_on{'Delete'} = {
+    ACL => [],
+
+    Attributes => [],
+
+    Links => [],
+
+    CustomFields => [],
+    CustomFieldValues => [],
+    ObjectCustomFields => [],
+    ObjectCustomFieldValues => [],
+
+    Queues => [],
+
+    Scrips => [],
+    ScripActions => [],
+    ScripConditions => [],
+    Templates => [],
+
+    Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
+    Transactions => [ 'Attachments -> other' ],
+
+    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+    Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
+    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
+
+    GroupMembers => [ 'CGM vs. GM' ],
+    CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+$redo_on{'Create'} = {
+    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
+    GroupMembers => [ 'CGM vs. GM' ],
+    CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+
+my %describe_cb;
+%describe_cb = (
+    Attachments => sub {
+        my $row = shift;
+        my $txn_id = $row->{transactionid};
+        my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
+        return $res .', '. describe( 'Transactions', $txn_id );
+    },
+    Transactions => sub {
+        my $row = shift;
+        return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
+    },
+);
+
+{ my %cache = ();
+sub m2t($) {
+    my $model = shift;
+    return $cache{$model} if $cache{$model};
+    my $class = "RT::$model";
+    my $object = $class->new( $RT::SystemUser );
+    return $cache{$model} = $object->Table;
+} }
+
+my (@do_check, %redo_check);
+
+my @CHECKS;
+foreach my $table ( qw(Users Groups) ) {
+    push @CHECKS, "$table -> Principals" => sub {
+        my $msg = "A record in $table refers not existing record in Principals."
+            ." The script can either create missing record in Principals"
+            ." or delete record in $table.";
+        my ($type) = ($table =~ /^(.*)s$/);
+        check_integrity(
+            $table, 'id' => 'Principals', 'id',
+            join_condition => 't.PrincipalType = ?',
+            bind_values => [ $type ],
+            action => sub {
+                my $id = shift;
+                return unless my $a = prompt_action( ['Delete', 'create'], $msg );
+
+                if ( $a eq 'd' ) {
+                    delete_record( $table, $id );
+                }
+                elsif ( $a eq 'c' ) {
+                    my $principal_id = create_record( 'Principals',
+                        id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
+                    );
+                }
+                else {
+                    die "Unknown action '$a'";
+                }
+            },
+        );
+    };
+
+    push @CHECKS, "Principals -> $table" => sub {
+        my $msg = "A record in Principals refers not existing record in $table."
+            ." In some cases it's possible to resurrect manually such records,"
+            ." but this utility can only delete";
+
+        check_integrity(
+            'Principals', 'id' => $table, 'id',
+            condition   => 's.PrincipalType = ?',
+            bind_values => [ $table =~ /^(.*)s$/ ],
+            action => sub {
+                my $id = shift;
+                return unless prompt( 'Delete', $msg );
+
+                delete_record( 'Principals', $id );
+            },
+        );
+    };
+}
+
+push @CHECKS, 'User <-> ACL equivalence group' => sub {
+    # from user to group
+    check_integrity(
+        'Users', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ? AND t.Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create', "Found an user that has no ACL equivalence group."
+            );
+
+            my $gid = create_record( 'Groups',
+                Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
+            );
+        },
+    );
+    # from group to user
+    check_integrity(
+        'Groups', 'Instance' => 'Users', 'id',
+        condition   => 's.Domain = ? AND s.Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an user ACL equivalence group, but there is no user."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+    # one ACL equiv group for each user
+    check_uniqueness(
+        'Groups',
+        columns     => ['Instance'],
+        condition   => '.Domain = ? AND .Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+    );
+};
+
+# check integrity of Queue role groups
+push @CHECKS, 'Queues <-> Role Groups' => sub {
+    # XXX: we check only that there is at least one group for a queue
+    # from queue to group
+    check_integrity(
+        'Queues', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ?',
+        bind_values => [ 'RT::Queue-Role' ],
+    );
+    # from group to queue
+    check_integrity(
+        'Groups', 'Instance' => 'Queues', 'id',
+        condition   => 's.Domain = ?',
+        bind_values => [ 'RT::Queue-Role' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found role group of not existant queue."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+};
+
+# check integrity of Ticket role groups
+push @CHECKS, 'Tickets <-> Role Groups' => sub {
+    # XXX: we check only that there is at least one group for a queue
+    # from queue to group
+    check_integrity(
+        'Tickets', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ?',
+        bind_values => [ 'RT::Ticket-Role' ],
+    );
+    # from group to ticket
+    check_integrity(
+        'Groups', 'Instance' => 'Tickets', 'id',
+        condition   => 's.Domain = ?',
+        bind_values => [ 'RT::Ticket-Role' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a role group of not existant ticket."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+};
+
+# additional CHECKS on groups
+push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
+    # Check that Domain, Instance and Type are unique
+    check_uniqueness(
+        'Groups',
+        columns     => ['Domain', 'Instance', 'Type'],
+        condition   => '.Domain LIKE ?',
+        bind_values => [ '%-Role' ],
+    );
+};
+
+
+push @CHECKS, 'GMs -> Groups, Members' => sub {
+    my $msg = "A record in GroupMembers references an object that doesn't exist."
+        ." May be you deleted a group or principal directly from DB?"
+        ." Usually it's ok to delete such records.";
+    check_integrity(
+        'GroupMembers', 'GroupId' => 'Groups', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt( 'Delete', $msg );
+
+            delete_record( 'GroupMembers', $id );
+        },
+    );
+    check_integrity(
+        'GroupMembers', 'MemberId' => 'Principals', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt( 'Delete', $msg );
+
+            delete_record( 'GroupMembers', $id );
+        },
+    );
+};
+
+# CGM and GM
+push @CHECKS, 'CGM vs. GM' => sub {
+    # all GM record should be duplicated in CGM
+    check_integrity(
+        GroupMembers       => ['GroupId', 'MemberId'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create',
+                "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
+            );
+
+            my $gm = RT::GroupMember->new( $RT::SystemUser );
+            $gm->Load( $id );
+            die "Couldn't load GM record #$id" unless $gm->id;
+            my $cgm = create_record( 'CachedGroupMembers',
+                GroupId => $gm->GroupId, MemberId => $gm->MemberId,
+                ImmediateParentId => $gm->GroupId, Via => undef,
+                Disabled => 0, # XXX: we should check integrity of Disabled field
+            );
+            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+        },
+    );
+    # all first level CGM records should have a GM record
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        GroupMembers       => ['GroupId', 'MemberId'],
+        condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers for a (Group, Member) pair"
+                ." that doesn't exist in GroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+    # each group should have a CGM record where MemberId == GroupId
+    check_integrity(
+        Groups => ['id', 'id'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create',
+                "Found a record in Groups that has no direct"
+                ." duplicate in CachedGroupMembers table."
+            );
+
+            my $g = RT::Group->new( $RT::SystemUser );
+            $g->Load( $id );
+            die "Couldn't load group #$id" unless $g->id;
+            die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
+            my $cgm = create_record( 'CachedGroupMembers',
+                GroupId => $id, MemberId => $id,
+                ImmediateParentId => $id, Via => undef,
+                Disabled => $g->Disabled,
+            );
+            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+        },
+    );
+
+    # and back, each record in CGM with MemberId == GroupId without exceptions
+    # should reference a group
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        Groups => ['id', 'id'],
+        condition => "s.GroupId = s.MemberId",
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers for a group that doesn't exist."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+    # Via
+    check_integrity(
+        CachedGroupMembers => 'Via',
+        CachedGroupMembers => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers with Via referencing not existing record."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # for every CGM where ImmediateParentId != GroupId there should be
+    # matching parent record (first level) 
+    check_integrity(
+        CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition => 't.Via = t.id',
+        condition => 's.ImmediateParentId != s.GroupId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # for every CGM where ImmediateParentId != GroupId there should be
+    # matching "grand" parent record
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
+        CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
+        condition => 's.ImmediateParentId != s.GroupId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # CHECK recursive records:
+    # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
+    # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
+    {
+        my $query = <<END;
+SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
+    cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
+FROM
+    CachedGroupMembers cgm1
+    CROSS JOIN GroupMembers gm2
+    LEFT JOIN CachedGroupMembers cgm3 ON (
+            cgm3.GroupId           = cgm1.GroupId
+        AND cgm3.MemberId          = gm2.MemberId
+        AND cgm3.Via               = cgm1.id
+        AND cgm3.ImmediateParentId = cgm1.MemberId )
+WHERE cgm1.GroupId != cgm1.MemberId
+AND gm2.GroupId = cgm1.MemberId
+AND cgm3.id IS NULL
+END
+
+        my $action = sub {
+            my %props = @_;
+            return unless prompt(
+                'Create',
+                "Found records in CachedGroupMembers table without recursive duplicates."
+            );
+            my $cgm = create_record( 'CachedGroupMembers', %props );
+        };
+
+        my $sth = execute_query( $query );
+        while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
+            print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
+            print STDERR " but there is no cached GM record that $m is member of #$g.\n";
+            $action->(
+                GroupId => $g, MemberId => $m, Via => $via,
+                ImmediateParentId => $ip, Disabled => $dis,
+            );
+        }
+    }
+};
+
+# Tickets
+push @CHECKS, 'Tickets -> other' => sub {
+    check_integrity(
+        'Tickets', 'EffectiveId' => 'Tickets', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a ticket that's been merged into a ticket that don't exist anymore."
+            );
+
+            delete_record( 'Tickets', $id );
+        },
+    );
+    check_integrity(
+        'Tickets', 'Queue' => 'Queues', 'id',
+    );
+    check_integrity(
+        'Tickets', 'Owner' => 'Users', 'id',
+    );
+    # XXX: check that owner is only member of owner role group
+};
+
+
+push @CHECKS, 'Transactions -> other' => sub {
+    foreach my $model ( @models ) {
+        check_integrity(
+            'Transactions', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+            action => sub {
+                my $id = shift;
+                return unless prompt(
+                    'Delete', "Found a transaction without object."
+                );
+
+                delete_record( 'Transactions', $id );
+            },
+        );
+    }
+    # type = CustomField
+    check_integrity(
+        'Transactions', 'Field' => 'CustomFields', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'CustomField' ],
+    );
+    # type = Take, Untake, Force, Steal or Give
+    check_integrity(
+        'Transactions', 'OldValue' => 'Users', 'id',
+        condition   => 's.Type IN (?, ?, ?, ?, ?)',
+        bind_values => [ qw(Take Untake Force Steal Give) ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction regarding changes of Owner,"
+                ." but User with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    check_integrity(
+        'Transactions', 'NewValue' => 'Users', 'id',
+        condition   => 's.Type IN (?, ?, ?, ?, ?)',
+        bind_values => [ qw(Take Untake Force Steal Give) ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction regarding changes of Owner,"
+                ." but User with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # type = DelWatcher
+    check_integrity(
+        'Transactions', 'OldValue' => 'Principals', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'DelWatcher' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing watchers change,"
+                ." but User with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # type = AddWatcher
+    check_integrity(
+        'Transactions', 'NewValue' => 'Principals', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'AddWatcher' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing watchers change,"
+                ." but User with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+
+# XXX: Links need more love, uri is stored instead of id
+#    # type = DeleteLink
+#    check_integrity(
+#        'Transactions', 'OldValue' => 'Links', 'id',
+#        condition   => 's.Type = ?',
+#        bind_values => [ 'DeleteLink' ],
+#    );
+#    # type = AddLink
+#    check_integrity(
+#        'Transactions', 'NewValue' => 'Links', 'id',
+#        condition   => 's.Type = ?',
+#        bind_values => [ 'AddLink' ],
+#    );
+
+    # type = Set, Field = Queue
+    check_integrity(
+        'Transactions', 'NewValue' => 'Queues', 'id',
+        condition   => 's.Type = ? AND s.Field = ?',
+        bind_values => [ 'Set', 'Queue' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing queue change,"
+                ." but Queue with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    check_integrity(
+        'Transactions', 'OldValue' => 'Queues', 'id',
+        condition   => 's.Type = ? AND s.Field = ?',
+        bind_values => [ 'Set', 'Queue' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing queue change,"
+                ." but Queue with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # Reminders
+    check_integrity(
+        'Transactions', 'NewValue' => 'Tickets', 'id',
+        join_condition => 't.Type = ?',
+        condition      => 's.Type IN (?, ?, ?)',
+        bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
+    );
+};
+
+# Attachments
+push @CHECKS, 'Attachments -> other' => sub {
+    check_integrity(
+        Attachments  => 'TransactionId', Transactions => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an attachment without a transaction."
+            );
+            delete_record( 'Attachments', $id );
+        },
+    );
+    check_integrity(
+        Attachments => 'Parent', Attachments => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an sub-attachment without its parent attachment."
+            );
+            delete_record( 'Attachments', $id );
+        },
+    );
+    check_integrity(
+        Attachments => 'Parent',
+        Attachments => 'id',
+        join_condition => 's.TransactionId = t.TransactionId',
+    );
+};
+
+push @CHECKS, 'CustomFields and friends' => sub {
+    #XXX: ObjectCustomFields needs more love
+    check_integrity(
+        'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+    );
+    check_integrity(
+        'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+    );
+    foreach my $model ( @models ) {
+        check_integrity(
+            'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+        );
+    }
+};
+
+push @CHECKS, Templates => sub {
+    check_integrity(
+        'Templates', 'Queue' => 'Queues', 'id',
+    );
+};
+
+push @CHECKS, Scrips => sub {
+    check_integrity(
+        'Scrips', 'Queue' => 'Queues', 'id',
+    );
+    check_integrity(
+        'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
+    );
+    check_integrity(
+        'Scrips', 'ScripAction' => 'ScripActions', 'id',
+    );
+    check_integrity(
+        'Scrips', 'Template' => 'Templates', 'id',
+    );
+};
+
+push @CHECKS, Attributes => sub {
+    foreach my $model ( @models ) {
+        check_integrity(
+            'Attributes', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+        );
+    }
+};
+
+# Fix situations when Creator or LastUpdatedBy references ACL equivalence
+# group of a user instead of user
+push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
+    my %fix = ();
+    foreach my $model ( @models ) {
+        my $class = "RT::$model";
+        my $object = $class->new( $RT::SystemUser );
+        foreach my $column ( qw(LastUpdatedBy Creator) ) {
+            next unless $object->_Accessible( $column, 'auto' );
+
+            my $table = m2t($model);
+            my $query = <<END;
+SELECT m.id, g.id, g.Instance
+FROM
+    Groups g JOIN $table m ON g.id = m.$column
+WHERE
+    g.Domain = ?
+    AND g.Type = ?
+END
+            my $action = sub {
+                my ($gid, $uid) = @_;
+                return unless prompt(
+                    'Update',
+                    "Looks like there were a bug in old versions of RT back in 2006\n"
+                    ."that has been fixed. If other checks are ok then it's ok to update\n"
+                    ."these records to point them to users instead of groups"
+                );
+                $fix{ $table }{ $column }{ $gid } = $uid;
+            };
+
+            my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
+            while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
+                print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
+                print STDERR " when must reference user.\n";
+                $action->( $gid, $uid );
+                if ( keys( %fix ) > 1000 ) {
+                    $sth->finish;
+                    last;
+                }
+            }
+        }
+    }
+
+    if ( keys %fix ) {
+        foreach my $table ( keys %fix ) {
+            foreach my $column ( keys %{ $fix{ $table } } ) {
+                my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
+                while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
+                    update_records( $table, { $column => $gid }, { $column => $uid } );
+                }
+            }
+        }
+        $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
+    }
+};
+
+push @CHECKS, 'LastUpdatedBy and Creator' => sub {
+    foreach my $model ( @models ) {
+        my $class = "RT::$model";
+        my $object = $class->new( $RT::SystemUser );
+        my $table = $object->Table;
+        foreach my $column ( qw(LastUpdatedBy Creator) ) {
+            next unless $object->_Accessible( $column, 'auto' );
+            check_integrity(
+                $table, $column => 'Users', 'id',
+                action => sub {
+                    my ($id, %prop) = @_;
+                    return unless my $replace_with = prompt_integer(
+                        'Replace',
+                        "Column $column should point to a user, but there is record #$id in table $table\n"
+                        ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
+                        ."Note that id you enter is not checked. You can peak any user from your DB, but it's\n"
+                        ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
+                        ."or something like that.",
+                        "$table.$column -> user #$prop{$column}"
+                    );
+                    update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
+                },
+            );
+        }
+    }
+};
+my %CHECKS = @CHECKS;
+
+@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
+
+while ( my $check = shift @do_check ) {
+    $CHECKS{ $check }->();
+
+    foreach my $redo ( keys %redo_check ) {
+        die "check $redo doesn't exist" unless $CHECKS{ $redo };
+        delete $redo_check{ $redo };
+        next if grep $_ eq $redo, @do_check; # don't do twice
+        push @do_check, $redo;
+    }
+}
+
+sub check_integrity {
+    my ($stable, @scols) = (shift, shift);
+    my ($ttable, @tcols) = (shift, shift);
+    my %args = @_;
+
+    @scols = @{ $scols[0] } if ref $scols[0];
+    @tcols = @{ $tcols[0] } if ref $tcols[0];
+
+    print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
+        if $opt{'verbose'};
+
+    my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
+        ." FROM $stable s LEFT JOIN $ttable t"
+        ." ON (". join(
+            ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
+        ) .")"
+        . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
+        ." WHERE t.id IS NULL"
+        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
+
+    $query .= " AND ( $args{'condition'} )" if $args{'condition'};
+
+    my @binds = @{ $args{'bind_values'} || [] };
+    if ( $tcols[0] eq 'id' && @tcols == 1 ) {
+        my $type = $TYPE{"$stable.$scols[0]"} || 'number';
+        if ( $type eq 'number' ) {
+            $query .= " AND s.$scols[0] != ?"
+        }
+        elsif ( $type eq 'text' ) {
+            $query .= " AND s.$scols[0] NOT LIKE ?"
+        }
+        push @binds, 0;
+    }
+
+    my $sth = execute_query( $query, @binds );
+    while ( my ($sid, @set) = $sth->fetchrow_array ) {
+        print STDERR "Record #$sid in $stable references not existent record in $ttable\n";
+        for ( my $i = 0; $i < @scols; $i++ ) {
+            print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
+        }
+        print STDERR "\t". describe( $stable, $sid ) ."\n";
+        $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
+    }
+}
+
+sub describe {
+    my ($table, $id) = @_;
+    return '' unless my $cb = $describe_cb{ $table };
+
+    my $row = load_record( $table, $id );
+    unless ( $row->{id} ) {
+        $table =~ s/s$//;
+        return "$table doesn't exist";
+    }
+    return $cb->( $row );
+}
+
+sub columns_eq_cond {
+    my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
+    my $ltype = $TYPE{"$lt.$lc"} || 'number';
+    my $rtype = $TYPE{"$rt.$rc"} || 'number';
+    return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
+
+    if ( $rtype eq 'text' ) {
+        return "$ra.$rc LIKE CAST($la.$lc AS text)";
+    }
+    elsif ( $ltype eq 'text' ) {
+        return "$la.$lc LIKE CAST($ra.$rc AS text)";
+    }
+    else { die "don't know how to cast" }
+}
+
+sub check_uniqueness {
+    my $on = shift;
+    my %args = @_;
+
+    my @columns = @{ $args{'columns'} };
+
+    print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
+        if $opt{'versbose'};
+
+    my ($scond, $tcond);
+    if ( $scond = $tcond = $args{'condition'} ) {
+        $scond =~ s/(\s|^)\./$1s./g;
+        $tcond =~ s/(\s|^)\./$1t./g;
+    }
+
+    my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
+        ." FROM $on s LEFT JOIN $on t "
+        ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
+        . ($tcond? " AND ( $tcond )": "")
+        ." WHERE t.id IS NOT NULL "
+        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
+    $query .= " AND ( $scond )" if $scond;
+
+    my $sth = execute_query(
+        $query,
+        $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): ()
+    );
+    while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
+        print STDERR "Record #$tid in $on has the same set of values as $sid\n";
+        for ( my $i = 0; $i < @columns; $i++ ) {
+            print STDERR "\t$columns[$i] => '$set[$i]'\n";
+        }
+    }
+}
+
+sub load_record {
+    my ($table, $id) = @_;
+    my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
+    return $sth->fetchrow_hashref('NAME_lc');
+}
+
+sub delete_record {
+    my ($table, $id) = (@_);
+    print "Deleting record #$id in $table\n" if $opt{'verbose'};
+    my $query = "DELETE FROM $table WHERE id = ?";
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
+    return execute_query( $query, $id );
+}
+
+sub create_record {
+    print "Creating a record in $_[0]\n" if $opt{'verbose'};
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
+    return $RT::Handle->Insert( @_ );
+}
+
+sub update_records {
+    my $table = shift;
+    my $where = shift;
+    my $what = shift;
+
+    my (@where_cols, @where_binds);
+    while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
+
+    my (@what_cols, @what_binds);
+    while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
+
+    print "Updating record(s) in $table\n" if $opt{'verbose'};
+    my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
+        ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
+    return execute_query( $query, @what_binds, @where_binds );
+}
+
+sub execute_query {
+    my ($query, @binds) = @_;
+
+    print "Executing query: $query\n\n" if $opt{'verbose'};
+
+    my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
+    $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
+    return $sth;
+}
+
+{ my %cached_answer;
+sub prompt {
+    my $action = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return 0 unless $opt{'resolve'};
+    return 1 if $opt{'force'};
+
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print "$action ALL records with the same defect? [N]: ";
+    my $a = <STDIN>;
+    return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
+    return $cached_answer{ $token } = 0;
+} }
+
+{ my %cached_answer;
+sub prompt_action {
+    my $actions = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return '' unless $opt{'resolve'};
+    return '' if $opt{'force'};
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
+    my $a = <STDIN>;
+    chomp $a;
+    return $cached_answer{ $token } = '' unless $a;
+    foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
+        return $cached_answer{ $token } = lc substr $a, 0, 1;
+    }
+    return $cached_answer{ $token } = '';
+} }
+
+{ my %cached_answer;
+sub prompt_integer {
+    my $action = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return 0 unless $opt{'resolve'};
+    return 0 if $opt{'force'};
+
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print "$action ALL records with the same defect? [0]: ";
+    my $a = <STDIN>; chomp $a; $a = int($a);
+    return $cached_answer{ $token } = $a;
+} }
+
+1;
diff --git a/rt/sbin/rt-validator.in b/rt/sbin/rt-validator.in
new file mode 100644
index 0000000..ba2686e
--- /dev/null
+++ b/rt/sbin/rt-validator.in
@@ -0,0 +1,1118 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+    require File::Spec;
+    my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+    my $bin_path;
+
+    for my $lib (@libs) {
+        unless ( File::Spec->file_name_is_absolute($lib) ) {
+            unless ($bin_path) {
+                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+                }
+                else {
+                    require FindBin;
+                    no warnings "once";
+                    $bin_path = $FindBin::Bin;
+                }
+            }
+            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+        }
+        unshift @INC, $lib;
+    }
+
+}
+
+use Getopt::Long;
+my %opt = ();
+GetOptions(
+    \%opt,
+    'check|c',
+    'resolve',
+    'force',
+    'verbose|v',
+);
+
+usage() unless $opt{'check'};
+usage_warning() if $opt{'resolve'} && !$opt{'force'};
+
+sub usage {
+    print STDERR <<END;
+Usage: $0 options
+
+Options:
+
+    $0 --check
+    $0 --check --verbose
+    $0 --check --verbose --resolve
+    $0 --check --verbose --resolve --force
+
+--check   - is mandatory argument, you can use -c, as well.
+--verbose - print additional info to STDOUT
+--resolve - enable resolver that can delete or create some records
+--force   - resolve without asking questions
+
+Description:
+
+This script checks integrity of records in RT's DB. May delete some invalid
+records or ressurect accidentally deleted.
+
+END
+    exit 1;
+}
+
+sub usage_warning {
+    print <<END;
+This utility can fix some issues with DB by creating or updating. In some
+cases there is no enough data to resurect a missing record, but records which
+refers to a missing can be deleted. It's up to you to decide what to do.
+
+In any case it's highly recommended to have a backup before resolving anything.
+
+Press enter to continue.
+END
+    <>;
+}
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+my $dbh = $RT::Handle->dbh;
+my $db_type = RT->Config->Get('DatabaseType');
+
+my %TYPE = (
+    'Transactions.Field'    => 'text',
+    'Transactions.OldValue' => 'text',
+    'Transactions.NewValue' => 'text',
+);
+
+my @models = qw(
+    ACE
+    Attachment
+    Attribute
+    CachedGroupMember
+    CustomField
+    CustomFieldValue
+    GroupMember
+    Group
+    Link
+    ObjectCustomField
+    ObjectCustomFieldValue
+    Principal
+    Queue
+    ScripAction
+    ScripCondition
+    Scrip
+    Template
+    Ticket
+    Transaction
+    User
+);
+
+my %redo_on;
+$redo_on{'Delete'} = {
+    ACL => [],
+
+    Attributes => [],
+
+    Links => [],
+
+    CustomFields => [],
+    CustomFieldValues => [],
+    ObjectCustomFields => [],
+    ObjectCustomFieldValues => [],
+
+    Queues => [],
+
+    Scrips => [],
+    ScripActions => [],
+    ScripConditions => [],
+    Templates => [],
+
+    Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
+    Transactions => [ 'Attachments -> other' ],
+
+    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+    Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
+    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
+
+    GroupMembers => [ 'CGM vs. GM' ],
+    CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+$redo_on{'Create'} = {
+    Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+    Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
+    GroupMembers => [ 'CGM vs. GM' ],
+    CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+
+my %describe_cb;
+%describe_cb = (
+    Attachments => sub {
+        my $row = shift;
+        my $txn_id = $row->{transactionid};
+        my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
+        return $res .', '. describe( 'Transactions', $txn_id );
+    },
+    Transactions => sub {
+        my $row = shift;
+        return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
+    },
+);
+
+{ my %cache = ();
+sub m2t($) {
+    my $model = shift;
+    return $cache{$model} if $cache{$model};
+    my $class = "RT::$model";
+    my $object = $class->new( $RT::SystemUser );
+    return $cache{$model} = $object->Table;
+} }
+
+my (@do_check, %redo_check);
+
+my @CHECKS;
+foreach my $table ( qw(Users Groups) ) {
+    push @CHECKS, "$table -> Principals" => sub {
+        my $msg = "A record in $table refers not existing record in Principals."
+            ." The script can either create missing record in Principals"
+            ." or delete record in $table.";
+        my ($type) = ($table =~ /^(.*)s$/);
+        check_integrity(
+            $table, 'id' => 'Principals', 'id',
+            join_condition => 't.PrincipalType = ?',
+            bind_values => [ $type ],
+            action => sub {
+                my $id = shift;
+                return unless my $a = prompt_action( ['Delete', 'create'], $msg );
+
+                if ( $a eq 'd' ) {
+                    delete_record( $table, $id );
+                }
+                elsif ( $a eq 'c' ) {
+                    my $principal_id = create_record( 'Principals',
+                        id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
+                    );
+                }
+                else {
+                    die "Unknown action '$a'";
+                }
+            },
+        );
+    };
+
+    push @CHECKS, "Principals -> $table" => sub {
+        my $msg = "A record in Principals refers not existing record in $table."
+            ." In some cases it's possible to resurrect manually such records,"
+            ." but this utility can only delete";
+
+        check_integrity(
+            'Principals', 'id' => $table, 'id',
+            condition   => 's.PrincipalType = ?',
+            bind_values => [ $table =~ /^(.*)s$/ ],
+            action => sub {
+                my $id = shift;
+                return unless prompt( 'Delete', $msg );
+
+                delete_record( 'Principals', $id );
+            },
+        );
+    };
+}
+
+push @CHECKS, 'User <-> ACL equivalence group' => sub {
+    # from user to group
+    check_integrity(
+        'Users', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ? AND t.Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create', "Found an user that has no ACL equivalence group."
+            );
+
+            my $gid = create_record( 'Groups',
+                Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
+            );
+        },
+    );
+    # from group to user
+    check_integrity(
+        'Groups', 'Instance' => 'Users', 'id',
+        condition   => 's.Domain = ? AND s.Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an user ACL equivalence group, but there is no user."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+    # one ACL equiv group for each user
+    check_uniqueness(
+        'Groups',
+        columns     => ['Instance'],
+        condition   => '.Domain = ? AND .Type = ?',
+        bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
+    );
+};
+
+# check integrity of Queue role groups
+push @CHECKS, 'Queues <-> Role Groups' => sub {
+    # XXX: we check only that there is at least one group for a queue
+    # from queue to group
+    check_integrity(
+        'Queues', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ?',
+        bind_values => [ 'RT::Queue-Role' ],
+    );
+    # from group to queue
+    check_integrity(
+        'Groups', 'Instance' => 'Queues', 'id',
+        condition   => 's.Domain = ?',
+        bind_values => [ 'RT::Queue-Role' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found role group of not existant queue."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+};
+
+# check integrity of Ticket role groups
+push @CHECKS, 'Tickets <-> Role Groups' => sub {
+    # XXX: we check only that there is at least one group for a queue
+    # from queue to group
+    check_integrity(
+        'Tickets', 'id' => 'Groups', 'Instance',
+        join_condition   => 't.Domain = ?',
+        bind_values => [ 'RT::Ticket-Role' ],
+    );
+    # from group to ticket
+    check_integrity(
+        'Groups', 'Instance' => 'Tickets', 'id',
+        condition   => 's.Domain = ?',
+        bind_values => [ 'RT::Ticket-Role' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a role group of not existant ticket."
+            );
+
+            delete_record( 'Groups', $id );
+        },
+    );
+};
+
+# additional CHECKS on groups
+push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
+    # Check that Domain, Instance and Type are unique
+    check_uniqueness(
+        'Groups',
+        columns     => ['Domain', 'Instance', 'Type'],
+        condition   => '.Domain LIKE ?',
+        bind_values => [ '%-Role' ],
+    );
+};
+
+
+push @CHECKS, 'GMs -> Groups, Members' => sub {
+    my $msg = "A record in GroupMembers references an object that doesn't exist."
+        ." May be you deleted a group or principal directly from DB?"
+        ." Usually it's ok to delete such records.";
+    check_integrity(
+        'GroupMembers', 'GroupId' => 'Groups', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt( 'Delete', $msg );
+
+            delete_record( 'GroupMembers', $id );
+        },
+    );
+    check_integrity(
+        'GroupMembers', 'MemberId' => 'Principals', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt( 'Delete', $msg );
+
+            delete_record( 'GroupMembers', $id );
+        },
+    );
+};
+
+# CGM and GM
+push @CHECKS, 'CGM vs. GM' => sub {
+    # all GM record should be duplicated in CGM
+    check_integrity(
+        GroupMembers       => ['GroupId', 'MemberId'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create',
+                "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
+            );
+
+            my $gm = RT::GroupMember->new( $RT::SystemUser );
+            $gm->Load( $id );
+            die "Couldn't load GM record #$id" unless $gm->id;
+            my $cgm = create_record( 'CachedGroupMembers',
+                GroupId => $gm->GroupId, MemberId => $gm->MemberId,
+                ImmediateParentId => $gm->GroupId, Via => undef,
+                Disabled => 0, # XXX: we should check integrity of Disabled field
+            );
+            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+        },
+    );
+    # all first level CGM records should have a GM record
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        GroupMembers       => ['GroupId', 'MemberId'],
+        condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers for a (Group, Member) pair"
+                ." that doesn't exist in GroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+    # each group should have a CGM record where MemberId == GroupId
+    check_integrity(
+        Groups => ['id', 'id'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Create',
+                "Found a record in Groups that has no direct"
+                ." duplicate in CachedGroupMembers table."
+            );
+
+            my $g = RT::Group->new( $RT::SystemUser );
+            $g->Load( $id );
+            die "Couldn't load group #$id" unless $g->id;
+            die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
+            my $cgm = create_record( 'CachedGroupMembers',
+                GroupId => $id, MemberId => $id,
+                ImmediateParentId => $id, Via => undef,
+                Disabled => $g->Disabled,
+            );
+            update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+        },
+    );
+
+    # and back, each record in CGM with MemberId == GroupId without exceptions
+    # should reference a group
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        Groups => ['id', 'id'],
+        condition => "s.GroupId = s.MemberId",
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers for a group that doesn't exist."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+    # Via
+    check_integrity(
+        CachedGroupMembers => 'Via',
+        CachedGroupMembers => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers with Via referencing not existing record."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # for every CGM where ImmediateParentId != GroupId there should be
+    # matching parent record (first level) 
+    check_integrity(
+        CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
+        CachedGroupMembers => ['GroupId', 'MemberId'],
+        join_condition => 't.Via = t.id',
+        condition => 's.ImmediateParentId != s.GroupId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # for every CGM where ImmediateParentId != GroupId there should be
+    # matching "grand" parent record
+    check_integrity(
+        CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
+        CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
+        condition => 's.ImmediateParentId != s.GroupId',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+            );
+
+            delete_record( 'CachedGroupMembers', $id );
+        },
+    );
+
+    # CHECK recursive records:
+    # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
+    # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
+    {
+        my $query = <<END;
+SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
+    cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
+FROM
+    CachedGroupMembers cgm1
+    CROSS JOIN GroupMembers gm2
+    LEFT JOIN CachedGroupMembers cgm3 ON (
+            cgm3.GroupId           = cgm1.GroupId
+        AND cgm3.MemberId          = gm2.MemberId
+        AND cgm3.Via               = cgm1.id
+        AND cgm3.ImmediateParentId = cgm1.MemberId )
+WHERE cgm1.GroupId != cgm1.MemberId
+AND gm2.GroupId = cgm1.MemberId
+AND cgm3.id IS NULL
+END
+
+        my $action = sub {
+            my %props = @_;
+            return unless prompt(
+                'Create',
+                "Found records in CachedGroupMembers table without recursive duplicates."
+            );
+            my $cgm = create_record( 'CachedGroupMembers', %props );
+        };
+
+        my $sth = execute_query( $query );
+        while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
+            print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
+            print STDERR " but there is no cached GM record that $m is member of #$g.\n";
+            $action->(
+                GroupId => $g, MemberId => $m, Via => $via,
+                ImmediateParentId => $ip, Disabled => $dis,
+            );
+        }
+    }
+};
+
+# Tickets
+push @CHECKS, 'Tickets -> other' => sub {
+    check_integrity(
+        'Tickets', 'EffectiveId' => 'Tickets', 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete',
+                "Found a ticket that's been merged into a ticket that don't exist anymore."
+            );
+
+            delete_record( 'Tickets', $id );
+        },
+    );
+    check_integrity(
+        'Tickets', 'Queue' => 'Queues', 'id',
+    );
+    check_integrity(
+        'Tickets', 'Owner' => 'Users', 'id',
+    );
+    # XXX: check that owner is only member of owner role group
+};
+
+
+push @CHECKS, 'Transactions -> other' => sub {
+    foreach my $model ( @models ) {
+        check_integrity(
+            'Transactions', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+            action => sub {
+                my $id = shift;
+                return unless prompt(
+                    'Delete', "Found a transaction without object."
+                );
+
+                delete_record( 'Transactions', $id );
+            },
+        );
+    }
+    # type = CustomField
+    check_integrity(
+        'Transactions', 'Field' => 'CustomFields', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'CustomField' ],
+    );
+    # type = Take, Untake, Force, Steal or Give
+    check_integrity(
+        'Transactions', 'OldValue' => 'Users', 'id',
+        condition   => 's.Type IN (?, ?, ?, ?, ?)',
+        bind_values => [ qw(Take Untake Force Steal Give) ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction regarding changes of Owner,"
+                ." but User with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    check_integrity(
+        'Transactions', 'NewValue' => 'Users', 'id',
+        condition   => 's.Type IN (?, ?, ?, ?, ?)',
+        bind_values => [ qw(Take Untake Force Steal Give) ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction regarding changes of Owner,"
+                ." but User with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # type = DelWatcher
+    check_integrity(
+        'Transactions', 'OldValue' => 'Principals', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'DelWatcher' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing watchers change,"
+                ." but User with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # type = AddWatcher
+    check_integrity(
+        'Transactions', 'NewValue' => 'Principals', 'id',
+        condition   => 's.Type = ?',
+        bind_values => [ 'AddWatcher' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing watchers change,"
+                ." but User with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+
+# XXX: Links need more love, uri is stored instead of id
+#    # type = DeleteLink
+#    check_integrity(
+#        'Transactions', 'OldValue' => 'Links', 'id',
+#        condition   => 's.Type = ?',
+#        bind_values => [ 'DeleteLink' ],
+#    );
+#    # type = AddLink
+#    check_integrity(
+#        'Transactions', 'NewValue' => 'Links', 'id',
+#        condition   => 's.Type = ?',
+#        bind_values => [ 'AddLink' ],
+#    );
+
+    # type = Set, Field = Queue
+    check_integrity(
+        'Transactions', 'NewValue' => 'Queues', 'id',
+        condition   => 's.Type = ? AND s.Field = ?',
+        bind_values => [ 'Set', 'Queue' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing queue change,"
+                ." but Queue with id stored in NewValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    check_integrity(
+        'Transactions', 'OldValue' => 'Queues', 'id',
+        condition   => 's.Type = ? AND s.Field = ?',
+        bind_values => [ 'Set', 'Queue' ],
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found a transaction describing queue change,"
+                ." but Queue with id stored in OldValue column doesn't exist anymore."
+            );
+
+            delete_record( 'Transactions', $id );
+        },
+    );
+    # Reminders
+    check_integrity(
+        'Transactions', 'NewValue' => 'Tickets', 'id',
+        join_condition => 't.Type = ?',
+        condition      => 's.Type IN (?, ?, ?)',
+        bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
+    );
+};
+
+# Attachments
+push @CHECKS, 'Attachments -> other' => sub {
+    check_integrity(
+        Attachments  => 'TransactionId', Transactions => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an attachment without a transaction."
+            );
+            delete_record( 'Attachments', $id );
+        },
+    );
+    check_integrity(
+        Attachments => 'Parent', Attachments => 'id',
+        action => sub {
+            my $id = shift;
+            return unless prompt(
+                'Delete', "Found an sub-attachment without its parent attachment."
+            );
+            delete_record( 'Attachments', $id );
+        },
+    );
+    check_integrity(
+        Attachments => 'Parent',
+        Attachments => 'id',
+        join_condition => 's.TransactionId = t.TransactionId',
+    );
+};
+
+push @CHECKS, 'CustomFields and friends' => sub {
+    #XXX: ObjectCustomFields needs more love
+    check_integrity(
+        'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+    );
+    check_integrity(
+        'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+    );
+    foreach my $model ( @models ) {
+        check_integrity(
+            'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+        );
+    }
+};
+
+push @CHECKS, Templates => sub {
+    check_integrity(
+        'Templates', 'Queue' => 'Queues', 'id',
+    );
+};
+
+push @CHECKS, Scrips => sub {
+    check_integrity(
+        'Scrips', 'Queue' => 'Queues', 'id',
+    );
+    check_integrity(
+        'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
+    );
+    check_integrity(
+        'Scrips', 'ScripAction' => 'ScripActions', 'id',
+    );
+    check_integrity(
+        'Scrips', 'Template' => 'Templates', 'id',
+    );
+};
+
+push @CHECKS, Attributes => sub {
+    foreach my $model ( @models ) {
+        check_integrity(
+            'Attributes', 'ObjectId' => m2t($model), 'id',
+            condition   => 's.ObjectType = ?',
+            bind_values => [ "RT::$model" ],
+        );
+    }
+};
+
+# Fix situations when Creator or LastUpdatedBy references ACL equivalence
+# group of a user instead of user
+push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
+    my %fix = ();
+    foreach my $model ( @models ) {
+        my $class = "RT::$model";
+        my $object = $class->new( $RT::SystemUser );
+        foreach my $column ( qw(LastUpdatedBy Creator) ) {
+            next unless $object->_Accessible( $column, 'auto' );
+
+            my $table = m2t($model);
+            my $query = <<END;
+SELECT m.id, g.id, g.Instance
+FROM
+    Groups g JOIN $table m ON g.id = m.$column
+WHERE
+    g.Domain = ?
+    AND g.Type = ?
+END
+            my $action = sub {
+                my ($gid, $uid) = @_;
+                return unless prompt(
+                    'Update',
+                    "Looks like there were a bug in old versions of RT back in 2006\n"
+                    ."that has been fixed. If other checks are ok then it's ok to update\n"
+                    ."these records to point them to users instead of groups"
+                );
+                $fix{ $table }{ $column }{ $gid } = $uid;
+            };
+
+            my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
+            while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
+                print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
+                print STDERR " when must reference user.\n";
+                $action->( $gid, $uid );
+                if ( keys( %fix ) > 1000 ) {
+                    $sth->finish;
+                    last;
+                }
+            }
+        }
+    }
+
+    if ( keys %fix ) {
+        foreach my $table ( keys %fix ) {
+            foreach my $column ( keys %{ $fix{ $table } } ) {
+                my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
+                while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
+                    update_records( $table, { $column => $gid }, { $column => $uid } );
+                }
+            }
+        }
+        $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
+    }
+};
+
+push @CHECKS, 'LastUpdatedBy and Creator' => sub {
+    foreach my $model ( @models ) {
+        my $class = "RT::$model";
+        my $object = $class->new( $RT::SystemUser );
+        my $table = $object->Table;
+        foreach my $column ( qw(LastUpdatedBy Creator) ) {
+            next unless $object->_Accessible( $column, 'auto' );
+            check_integrity(
+                $table, $column => 'Users', 'id',
+                action => sub {
+                    my ($id, %prop) = @_;
+                    return unless my $replace_with = prompt_integer(
+                        'Replace',
+                        "Column $column should point to a user, but there is record #$id in table $table\n"
+                        ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
+                        ."Note that id you enter is not checked. You can peak any user from your DB, but it's\n"
+                        ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
+                        ."or something like that.",
+                        "$table.$column -> user #$prop{$column}"
+                    );
+                    update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
+                },
+            );
+        }
+    }
+};
+my %CHECKS = @CHECKS;
+
+@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
+
+while ( my $check = shift @do_check ) {
+    $CHECKS{ $check }->();
+
+    foreach my $redo ( keys %redo_check ) {
+        die "check $redo doesn't exist" unless $CHECKS{ $redo };
+        delete $redo_check{ $redo };
+        next if grep $_ eq $redo, @do_check; # don't do twice
+        push @do_check, $redo;
+    }
+}
+
+sub check_integrity {
+    my ($stable, @scols) = (shift, shift);
+    my ($ttable, @tcols) = (shift, shift);
+    my %args = @_;
+
+    @scols = @{ $scols[0] } if ref $scols[0];
+    @tcols = @{ $tcols[0] } if ref $tcols[0];
+
+    print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
+        if $opt{'verbose'};
+
+    my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
+        ." FROM $stable s LEFT JOIN $ttable t"
+        ." ON (". join(
+            ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
+        ) .")"
+        . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
+        ." WHERE t.id IS NULL"
+        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
+
+    $query .= " AND ( $args{'condition'} )" if $args{'condition'};
+
+    my @binds = @{ $args{'bind_values'} || [] };
+    if ( $tcols[0] eq 'id' && @tcols == 1 ) {
+        my $type = $TYPE{"$stable.$scols[0]"} || 'number';
+        if ( $type eq 'number' ) {
+            $query .= " AND s.$scols[0] != ?"
+        }
+        elsif ( $type eq 'text' ) {
+            $query .= " AND s.$scols[0] NOT LIKE ?"
+        }
+        push @binds, 0;
+    }
+
+    my $sth = execute_query( $query, @binds );
+    while ( my ($sid, @set) = $sth->fetchrow_array ) {
+        print STDERR "Record #$sid in $stable references not existent record in $ttable\n";
+        for ( my $i = 0; $i < @scols; $i++ ) {
+            print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
+        }
+        print STDERR "\t". describe( $stable, $sid ) ."\n";
+        $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
+    }
+}
+
+sub describe {
+    my ($table, $id) = @_;
+    return '' unless my $cb = $describe_cb{ $table };
+
+    my $row = load_record( $table, $id );
+    unless ( $row->{id} ) {
+        $table =~ s/s$//;
+        return "$table doesn't exist";
+    }
+    return $cb->( $row );
+}
+
+sub columns_eq_cond {
+    my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
+    my $ltype = $TYPE{"$lt.$lc"} || 'number';
+    my $rtype = $TYPE{"$rt.$rc"} || 'number';
+    return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
+
+    if ( $rtype eq 'text' ) {
+        return "$ra.$rc LIKE CAST($la.$lc AS text)";
+    }
+    elsif ( $ltype eq 'text' ) {
+        return "$la.$lc LIKE CAST($ra.$rc AS text)";
+    }
+    else { die "don't know how to cast" }
+}
+
+sub check_uniqueness {
+    my $on = shift;
+    my %args = @_;
+
+    my @columns = @{ $args{'columns'} };
+
+    print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
+        if $opt{'versbose'};
+
+    my ($scond, $tcond);
+    if ( $scond = $tcond = $args{'condition'} ) {
+        $scond =~ s/(\s|^)\./$1s./g;
+        $tcond =~ s/(\s|^)\./$1t./g;
+    }
+
+    my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
+        ." FROM $on s LEFT JOIN $on t "
+        ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
+        . ($tcond? " AND ( $tcond )": "")
+        ." WHERE t.id IS NOT NULL "
+        ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
+    $query .= " AND ( $scond )" if $scond;
+
+    my $sth = execute_query(
+        $query,
+        $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): ()
+    );
+    while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
+        print STDERR "Record #$tid in $on has the same set of values as $sid\n";
+        for ( my $i = 0; $i < @columns; $i++ ) {
+            print STDERR "\t$columns[$i] => '$set[$i]'\n";
+        }
+    }
+}
+
+sub load_record {
+    my ($table, $id) = @_;
+    my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
+    return $sth->fetchrow_hashref('NAME_lc');
+}
+
+sub delete_record {
+    my ($table, $id) = (@_);
+    print "Deleting record #$id in $table\n" if $opt{'verbose'};
+    my $query = "DELETE FROM $table WHERE id = ?";
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
+    return execute_query( $query, $id );
+}
+
+sub create_record {
+    print "Creating a record in $_[0]\n" if $opt{'verbose'};
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
+    return $RT::Handle->Insert( @_ );
+}
+
+sub update_records {
+    my $table = shift;
+    my $where = shift;
+    my $what = shift;
+
+    my (@where_cols, @where_binds);
+    while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
+
+    my (@what_cols, @what_binds);
+    while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
+
+    print "Updating record(s) in $table\n" if $opt{'verbose'};
+    my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
+        ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
+    $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
+    return execute_query( $query, @what_binds, @where_binds );
+}
+
+sub execute_query {
+    my ($query, @binds) = @_;
+
+    print "Executing query: $query\n\n" if $opt{'verbose'};
+
+    my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
+    $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
+    return $sth;
+}
+
+{ my %cached_answer;
+sub prompt {
+    my $action = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return 0 unless $opt{'resolve'};
+    return 1 if $opt{'force'};
+
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print "$action ALL records with the same defect? [N]: ";
+    my $a = <STDIN>;
+    return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
+    return $cached_answer{ $token } = 0;
+} }
+
+{ my %cached_answer;
+sub prompt_action {
+    my $actions = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return '' unless $opt{'resolve'};
+    return '' if $opt{'force'};
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
+    my $a = <STDIN>;
+    chomp $a;
+    return $cached_answer{ $token } = '' unless $a;
+    foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
+        return $cached_answer{ $token } = lc substr $a, 0, 1;
+    }
+    return $cached_answer{ $token } = '';
+} }
+
+{ my %cached_answer;
+sub prompt_integer {
+    my $action = shift;
+    my $msg = shift;
+    my $token = shift || join ':', caller;
+
+    return 0 unless $opt{'resolve'};
+    return 0 if $opt{'force'};
+
+    return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+    print $msg, "\n";
+    print "$action ALL records with the same defect? [0]: ";
+    my $a = <STDIN>; chomp $a; $a = int($a);
+    return $cached_answer{ $token } = $a;
+} }
+
+1;
diff --git a/rt/sbin/tweak-template-locstring b/rt/sbin/tweak-template-locstring
new file mode 100644
index 0000000..b63a5bd
--- /dev/null
+++ b/rt/sbin/tweak-template-locstring
@@ -0,0 +1,55 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+use strict;
+# run this script with:
+# perl -0pi sbin/tweak-template-locstring `ack -f share/html -G 'html$'`
+s!\<\&\|\/l([^&]*)\&\>[\n\s]+(.*?)[\n\s]*\<\/\&\>!;my ($arg, $x) = ($1, $2); $x =~ s/\s*\n\s*/ /g;"<&|/l$arg&>$x</&>"!smge;
+
+
+1;
-- 
cgit v1.1