summaryrefslogtreecommitdiff
path: root/rt/lib/t
diff options
context:
space:
mode:
authorivan <ivan>2005-10-15 09:11:20 +0000
committerivan <ivan>2005-10-15 09:11:20 +0000
commitd4d0590bef31071e8809ec046717444b95b3f30a (patch)
treeee1236da50578390d2642114f28eaed99a5efb18 /rt/lib/t
parentd39d52aac8f38ea9115628039f0df5aa3ac826de (diff)
import rt 3.4.4
Diffstat (limited to 'rt/lib/t')
-rw-r--r--rt/lib/t/00smoke.t3
-rw-r--r--rt/lib/t/create_data.pl136
-rw-r--r--rt/lib/t/regression/01ticket_link_searching.t155
-rw-r--r--rt/lib/t/regression/02basic_web.t150
-rw-r--r--rt/lib/t/regression/03web_compiliation_errors.t66
-rw-r--r--rt/lib/t/regression/04send_email.t511
-rw-r--r--rt/lib/t/regression/05cronsupport.t91
-rw-r--r--rt/lib/t/regression/06mailgateway.t504
-rw-r--r--rt/lib/t/regression/07acl.t120
-rw-r--r--rt/lib/t/regression/07rights.t110
-rw-r--r--rt/lib/t/regression/08web_cf_access.t118
-rw-r--r--rt/lib/t/regression/09record_cf_api.t188
-rw-r--r--rt/lib/t/regression/10merge.t72
-rw-r--r--rt/lib/t/regression/11-template-insert.t27
-rw-r--r--rt/lib/t/regression/12-search.t235
-rw-r--r--rt/lib/t/regression/13-attribute-tests.t67
-rw-r--r--rt/lib/t/regression/14merge.t31
-rw-r--r--rt/lib/t/regression/15cf_single_values_are_single.t39
-rw-r--r--rt/lib/t/regression/16-transaction_cf_tests.t61
-rw-r--r--rt/lib/t/regression/17multiple_deleg_revocation.t135
-rw-r--r--rt/lib/t/regression/18stale_delegations_cleanup.t458
-rw-r--r--rt/lib/t/regression/19-rtname.t38
-rw-r--r--rt/lib/t/regression/20savedsearch.t180
-rw-r--r--rt/lib/t/regression/21query-builder.t204
-rw-r--r--rt/lib/t/regression/22search_tix_by_txn.t32
-rw-r--r--rt/lib/t/setup_regression.t34
26 files changed, 3763 insertions, 2 deletions
diff --git a/rt/lib/t/00smoke.t b/rt/lib/t/00smoke.t
index 4f36bb3..9e9bf4a 100644
--- a/rt/lib/t/00smoke.t
+++ b/rt/lib/t/00smoke.t
@@ -2,13 +2,12 @@
use Test::More qw(no_plan);
-use lib "/opt/rt3/lib";
use RT;
ok(RT::LoadConfig);
ok(RT::Init, "Basic initialization and DB connectivity");
use File::Find;
-File::Find::find({wanted => \&wanted}, '.');
+File::Find::find({wanted => \&wanted}, 'lib/');
sub wanted { /^*\.pm\z/s && ok(require $_, "Requiring '$_'"); }
diff --git a/rt/lib/t/create_data.pl b/rt/lib/t/create_data.pl
new file mode 100644
index 0000000..35226ea
--- /dev/null
+++ b/rt/lib/t/create_data.pl
@@ -0,0 +1,136 @@
+#!@PERL@ -w
+use strict;
+
+use Test::More qw/no_plan/;
+use Text::Lorem;
+use RT;
+RT::LoadConfig;
+RT::Init;
+
+#### Generate some number of RT accounts. Come up with random
+#### usernames if requested, otherwise use provided ones. Take
+#### $subdomain argument so that we can generate customer accounts,
+#### etc. Group memberships should also be provided.
+
+=head2 create_users
+
+=over 4
+
+This subroutine creates a number of RT users, if they don't already
+exist, and places them in the specified group. It also creates the
+group if it needs to. Returns a ref to a list containing the user
+objects.
+
+If a list of names is specified, users with those names are created.
+Otherwise, it will make names up, checking to be sure that a user with
+the random name does not yet exist. Each user will have an email
+address in "example.com".
+
+Takes a hash of the following arguments:
+number => How many users to create. Default is 1.
+names => A ref to a list of usernames to use. Optional.
+subdomain => The subdomain of example.com which should be used for
+ email addresses.
+group => The name of the group these users should belong to. Creates
+ the group if it does not yet exist.
+privileged => Whether the users should be able to be granted rights.
+ Default is 1.
+attributes => a ref to a list of hashrefs containing the arguments for
+ any unsupported attribute we should add to the user (for example, a
+ user saved search.)
+
+=back
+
+=cut
+
+sub create_users {
+ my %ARGS = (number => 1,
+ subdomain => undef,
+ privileged => 1,
+ @_);
+ my $lorem = Text::Lorem->new();
+ my @users_returned;
+
+ my @usernames;
+ my $anon;
+ if ($ARGS{'users'}) {
+ @usernames = @{$ARGS{'users'}};
+ $anon = 0;
+ } else {
+ @usernames = split(/\s+/, $lorem->words($ARGS{'number'}));
+ $anon = 1;
+ }
+
+ my $domain = 'example.com';
+ $domain = $ARGS{'subdomain'} . ".$domain" if $ARGS{'subdomain'};
+
+ foreach my $user (@usernames) {
+ my $user_obj = RT::User->new($RT::SystemUser);
+ $user_obj->Load($user);
+ if ($user_obj->Id() && !$anon) {
+ # Use this user; assume we know what we're doing. Don't
+ # modify it, other than adding it to any group specified.
+ push(@users_returned, $user_obj);
+ } elsif ($user_obj->Id()) {
+ # Oops. Get a different username and stick it on the back
+ # of the list.
+ append(@users, $lorem->words(1));
+ } else {
+ $user_obj->Create(Name => $user,
+ Password => $user."pass",
+ EmailAddress => $user.'@'.$domain,
+ RealName => "$user ipsum",
+ Privileged => $ARGS{'privileged'},
+ );
+ push(@users_returned, $user_obj);
+ }
+ }
+
+ # Now we have our list of users. Did we have groups to add them
+ # to?
+
+ if ($ARGS{'groups'}) {
+ my @groups = @{$ARGS{'groups'}};
+ foreach my $group (@groups) {
+ my $group_obj = RT::Group->new();
+ $group_obj->LoadUserDefinedGroup($group);
+ unless ($group_obj->Id()) {
+ # Create it.
+ $group_obj->CreateUserDefinedGroup(
+ Name => $group,
+ Description => "lorem defined group $group",
+ );
+ }
+ foreach (@users_returned) {
+ $group_obj->AddMember($_->Id);
+ }
+ }
+ }
+
+ # Do we have attributes to apply to the users?
+ if ($ARGS{'attributes'}) {
+ foreach my $attrib (@{$ARGS{'attributes'}}) {
+ my %attr_args = %{$attrib};
+ foreach (@users_returned) {
+ $_->AddAttribute(%attr_args);
+ }
+ }
+ }
+
+ # Return our list of users.
+ return \@users_returned;
+}
+
+#### Generate any RT groups. These ought to be named, by function.
+#### The group names should be given either as part of user creation,
+#### or as a name with a number of subgroups which should be members.
+
+
+#### Generate some queues. Users/groups who have permissions on
+#### queues need to be specified on this point. Permissions can be
+#### specified by role, e.g. "client" or "staffmember" or "admin" for
+#### each queue. If the queue should have anything special like a
+#### custom field, say so here.
+
+
+#### Generate some tickets and transactions.
diff --git a/rt/lib/t/regression/01ticket_link_searching.t b/rt/lib/t/regression/01ticket_link_searching.t
new file mode 100644
index 0000000..6d10221
--- /dev/null
+++ b/rt/lib/t/regression/01ticket_link_searching.t
@@ -0,0 +1,155 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 25;
+use strict;
+use RT;
+
+# Load the config file
+RT::LoadConfig();
+
+#Connect to the database and get RT::SystemUser and RT::Nobody loaded
+RT::Init();
+
+#Get the current user all loaded
+my $CurrentUser = $RT::SystemUser;
+
+my $queue = new RT::Queue($CurrentUser);
+$queue->Load('General') || Abort(loc("Queue could not be loaded."));
+
+my $child_ticket = new RT::Ticket( $CurrentUser );
+
+my ( $childid ) = $child_ticket->Create
+ ( Subject => 'test child',
+ Queue => $queue->Id);
+
+ok($childid != 0);
+
+my $parent_ticket = new RT::Ticket( $CurrentUser );
+
+my ( $parentid ) = $parent_ticket->Create
+ ( Subject => 'test parent',
+ Children => [$childid],
+ Queue => $queue->Id);
+
+ok($parentid != 0, "We created a parent ticket");
+
+my $Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitMemberOf ($parentid);
+
+ok ($Collection->First);
+is ($Collection->First->id, $childid, "We found the collection of all children of $parentid with Limit");
+is($Collection->Count,1, "We found only one result");
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL( "MemberOf = $parentid");
+is ($Collection->First->id, $childid, "We found the collection of all children of $parentid with TicketSQL");
+is($Collection->Count,1, "We found only one result");
+
+
+
+
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitHasMember ($childid);
+
+ok ($Collection->First);
+is ($Collection->First->id, $parentid, "We found the collection of all parents of $childid with Limit");
+is($Collection->Count,1, "We found only one result");
+
+
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("HasMember = $childid");
+
+ok ($Collection->First);
+is ($Collection->First->id, $parentid, "We found the collection of all parents of $childid with TicketSQL");
+is($Collection->Count,1, "We found only one result");
+
+
+
+# Now we find a collection of all the tickets which have no members. they should have no children.
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitHasMember('');
+# must contain child; must not contain parent
+my %has;
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok ($has{$childid} , "The collection has our child - $childid");
+ok( !$has{$parentid}, "The collection doesn't have our parent - $parentid");
+
+
+
+
+# Now we find a collection of all the tickets which are not members of anything. they should have no parents.
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitMemberOf('');
+# must contain parent; must not contain child
+%has = ();
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok ($has{$parentid} , "The collection has our parent - $parentid");
+ok( !$has{$childid}, "The collection doesn't have our child - $childid");
+
+
+# Do it all over with TicketSQL
+#
+
+
+
+# Now we find a collection of all the tickets which have no members. they should have no children.
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL ("HasMember IS NULL");
+# must contain parent; must not contain child
+ %has = ();
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok (!$has{$parentid} , "The collection doesn't have our parent - $parentid");
+ok( $has{$childid}, "The collection has our child - $childid");
+
+
+# Now we find a collection of all the tickets which have no members. they should have no children.
+# Alternate syntax
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL ("HasMember = ''");
+# must contain parent; must not contain child
+ %has = ();
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok (!$has{$parentid} , "The collection doesn't have our parent - $parentid");
+ok( $has{$childid}, "The collection has our child - $childid");
+
+
+
+# Now we find a collection of all the tickets which are not members of anything. they should have no parents.
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("MemberOf IS NULL");
+# must not contain parent; must contain parent
+%has = ();
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok ($has{$parentid} , "The collection has our parent - $parentid");
+ok(!$has{$childid}, "The collection doesn't have our child - $childid");
+
+
+# Now we find a collection of all the tickets which are not members of anything. they should have no parents.
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("MemberOf = ''");
+# must not contain parent; must contain parent
+%has = ();
+while (my $t = $Collection->Next) {
+ ++$has{$t->id};
+}
+ok ($has{$parentid} , "The collection has our parent - $parentid");
+ok(!$has{$childid}, "The collection doesn't have our child - $childid");
+
+
+
+
+1;
+
+
diff --git a/rt/lib/t/regression/02basic_web.t b/rt/lib/t/regression/02basic_web.t
new file mode 100644
index 0000000..d3376d0
--- /dev/null
+++ b/rt/lib/t/regression/02basic_web.t
@@ -0,0 +1,150 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More tests => 17;
+use WWW::Mechanize;
+use HTTP::Request::Common;
+use HTTP::Cookies;
+use LWP;
+use Encode;
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+use RT;
+RT::LoadConfig;
+
+# get the top page
+my $url = $RT::WebURL;
+$agent->get($url);
+
+is ($agent->{'status'}, 200, "Loaded a page");
+
+
+# {{{ test a login
+
+# follow the link marked "Login"
+
+ok($agent->{form}->find_input('user'));
+
+ok($agent->{form}->find_input('pass'));
+ok ($agent->{'content'} =~ /username:/i);
+$agent->field( 'user' => 'root' );
+$agent->field( 'pass' => 'password' );
+# the field isn't named, so we have to click link 0
+$agent->click(0);
+is($agent->{'status'}, 200, "Fetched the page ok");
+ok( $agent->{'content'} =~ /Logout/i, "Found a logout link");
+
+
+
+$agent->get($url."Ticket/Create.html?Queue=1");
+is ($agent->{'status'}, 200, "Loaded Create.html");
+$agent->form(3);
+# Start with a string containing characters in latin1
+my $string = "I18N Web Testing æøå";
+Encode::from_to($string, 'iso-8859-1', 'utf8');
+$agent->field('Subject' => "Ticket with utf8 body");
+$agent->field('Content' => $string);
+ok($agent->submit(), "Created new ticket with $string as Content");
+ok( $agent->{'content'} =~ qr{$string} , "Found the content");
+$agent->get($url."Ticket/Create.html?Queue=1");
+is ($agent->{'status'}, 200, "Loaded Create.html");
+$agent->form(3);
+# Start with a string containing characters in latin1
+my $string = "I18N Web Testing æøå";
+Encode::from_to($string, 'iso-8859-1', 'utf8');
+$agent->field('Subject' => $string);
+$agent->field('Content' => "Ticket with utf8 subject");
+ok($agent->submit(), "Created new ticket with $string as Subject");
+
+ok( $agent->{'content'} =~ qr{$string} , "Found the content");
+
+
+
+# }}}
+
+# {{{ Query Builder tests
+
+my $response = $agent->get($url."Search/Build.html");
+ok( $response->is_success, "Fetched " . $url."Search/Build.html" );
+
+# Parsing TicketSQL
+#
+# Adding items
+
+# set the first value
+ok($agent->form_name('BuildQuery'));
+$agent->field("AttachmentField", "Subject");
+$agent->field("AttachmentOp", "LIKE");
+$agent->field("ValueOfAttachment", "aaa");
+$agent->submit();
+
+# set the next value
+ok($agent->form_name('BuildQuery'));
+$agent->field("AttachmentField", "Subject");
+$agent->field("AttachmentOp", "LIKE");
+$agent->field("ValueOfAttachment", "bbb");
+$agent->submit();
+
+ok($agent->form_name('BuildQuery'));
+
+# get the query
+my $query = $agent->current_form->find_input("Query")->value;
+# strip whitespace from ends
+$query =~ s/^\s*//g;
+$query =~ s/\s*$//g;
+
+# collapse other whitespace
+$query =~ s/\s+/ /g;
+
+is ($query, "Subject LIKE 'aaa' AND Subject LIKE 'bbb'");
+
+# - new items go one level down
+# - add items at currently selected level
+# - if nothing is selected, add at end, one level down
+#
+# move left
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move left if you're at the top level
+#
+# move right
+# - error if nothing selected
+# - same item should be selected after move
+# - can always move right (no max depth...should there be?)
+#
+# move up
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move up if you're first in the list
+#
+# move down
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move down if you're last in the list
+#
+# toggle
+# - error if nothing selected
+# - change all aggregators in the grouping
+# - don't change any others
+#
+# delete
+# - error if nothing selected
+# - delete currently selected item
+# - delete all children of a grouping
+# - if delete leaves a node with no children, delete that, too
+# - what should be selected?
+#
+# Clear
+# - clears entire query
+# - clears it from the session, too
+
+# }}}
+
+
+1;
diff --git a/rt/lib/t/regression/03web_compiliation_errors.t b/rt/lib/t/regression/03web_compiliation_errors.t
new file mode 100644
index 0000000..f2e62c9
--- /dev/null
+++ b/rt/lib/t/regression/03web_compiliation_errors.t
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More qw/no_plan/;
+use WWW::Mechanize;
+use HTTP::Request::Common;
+use HTTP::Cookies;
+use LWP;
+use Encode;
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+use RT;
+RT::LoadConfig;
+
+# get the top page
+my $url = $RT::WebURL;
+$agent->get($url);
+
+is ($agent->{'status'}, 200, "Loaded a page");
+
+
+# {{{ test a login
+
+# follow the link marked "Login"
+
+ok($agent->{form}->find_input('user'));
+
+ok($agent->{form}->find_input('pass'));
+ok ($agent->{'content'} =~ /username:/i);
+$agent->field( 'user' => 'root' );
+$agent->field( 'pass' => 'password' );
+# the field isn't named, so we have to click link 0
+$agent->click(0);
+is($agent->{'status'}, 200, "Fetched the page ok");
+ok( $agent->{'content'} =~ /Logout/i, "Found a logout link");
+
+
+use File::Find;
+find ( \&wanted , 'html/');
+
+sub wanted {
+ -f && /\.html$/ && $_ !~ /Logout.html$/ && test_get($File::Find::name);
+}
+
+sub test_get {
+ my $file = shift;
+
+
+ $file =~ s#^html/##;
+ ok ($agent->get("$url/$file", "GET $url/$file"));
+ is ($agent->{'status'}, 200, "Loaded $file");
+# ok( $agent->{'content'} =~ /Logout/i, "Found a logout link on $file ");
+ ok( $agent->{'content'} !~ /Not logged in/i, "Still logged in for $file");
+ ok( $agent->{'content'} !~ /System error/i, "Didn't get a Mason compilation error on $file");
+
+}
+
+# }}}
+
+1;
diff --git a/rt/lib/t/regression/04send_email.t b/rt/lib/t/regression/04send_email.t
new file mode 100644
index 0000000..09e6e6f
--- /dev/null
+++ b/rt/lib/t/regression/04send_email.t
@@ -0,0 +1,511 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 137;
+use RT;
+RT::LoadConfig();
+RT::Init;
+use RT::EmailParser;
+use RT::Tickets;
+use RT::Action::SendEmail;
+
+my @_outgoing_messages;
+my @scrips_fired;
+
+#We're not testing acls here.
+my $everyone = RT::Group->new($RT::SystemUser);
+$everyone->LoadSystemInternalGroup('Everyone');
+$everyone->PrincipalObj->GrantRight(Right =>'SuperUser');
+
+
+is (__PACKAGE__, 'main', "We're operating in the main package");
+
+
+{
+no warnings qw/redefine/;
+sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ main::_fired_scrip($self->ScripObj);
+ main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
+}
+
+}
+
+# instrument SendEmail to pass us what it's about to send.
+# create a regular ticket
+
+my $parser = RT::EmailParser->new();
+
+
+# Let's test to make sure a multipart/report is processed correctly
+my $content = `cat $RT::BasePath/lib/t/data/multipart-report` || die "couldn't find new content";
+# be as much like the mail gateway as possible.
+use RT::Interface::Email;
+
+my %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+my $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+my $tick= $tickets->First();
+isa_ok($tick, "RT::Ticket", "got a ticket object");
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce");
+
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+
+undef @scrips_fired;
+
+
+
+
+$parser->ParseMIMEEntityFromScalar('From: root@localhost
+To: rt@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!');
+
+
+use Data::Dumper;
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+my ($id, undef, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
+ok ($id,$msg);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+# make sure it sends a notification to adminccs
+
+
+# we need to swap out SendMessage to test the new things we care about;
+&utf8_redef_sendmessage;
+
+# create an iso 8859-1 ticket
+@scrips_fired = ();
+
+$content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
+
+
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+use RT::Interface::Email;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
+
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+
+
+# make sure it sends a notification to adminccs
+
+# If we correspond, does it do the right thing to the outbound messages?
+
+$parser->ParseMIMEEntityFromScalar($content);
+ ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+$parser->ParseMIMEEntityFromScalar($content);
+($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+
+
+
+
+# we need to swap out SendMessage to test the new things we care about;
+&iso8859_redef_sendmessage;
+$RT::EmailOutputEncoding = 'iso-8859-1';
+# create an iso 8859-1 ticket
+@scrips_fired = ();
+
+ $content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
+# be as much like the mail gateway as possible.
+use RT::Interface::Email;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
+
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+
+
+# make sure it sends a notification to adminccs
+
+
+# If we correspond, does it do the right thing to the outbound messages?
+
+$parser->ParseMIMEEntityFromScalar($content);
+ ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+$parser->ParseMIMEEntityFromScalar($content);
+($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+
+sub _fired_scrip {
+ my $scrip = shift;
+ push @scrips_fired, $scrip;
+}
+
+sub utf8_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval '
+ sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ my $scrip = $self->ScripObj->id;
+ ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
+ main::_fired_scrip($self->ScripObj);
+ $MIME->make_singlepart;
+ main::ok( ref($MIME) eq \'MIME::Entity\',
+ "hey, look. it\'s a mime entity" );
+ main::ok( ref( $MIME->head ) eq \'MIME::Head\',
+ "its mime header is a mime header. yay" );
+ main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
+ "Its content type is utf-8" );
+ my $message_as_string = $MIME->bodyhandle->as_string();
+ use Encode;
+ $message_as_string = Encode::decode_utf8($message_as_string);
+ main::ok(
+ $message_as_string =~ /H\x{e5}vard/,
+"The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
+
+ }';
+}
+
+sub iso8859_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval '
+ sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ my $scrip = $self->ScripObj->id;
+ ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
+ main::_fired_scrip($self->ScripObj);
+ $MIME->make_singlepart;
+ main::ok( ref($MIME) eq \'MIME::Entity\',
+ "hey, look. it\'s a mime entity" );
+ main::ok( ref( $MIME->head ) eq \'MIME::Head\',
+ "its mime header is a mime header. yay" );
+ main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
+ "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
+ my $message_as_string = $MIME->bodyhandle->as_string();
+ use Encode;
+ $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
+ main::ok(
+ $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
+
+ }';
+}
+
+# {{{ test a multipart alternative containing a text-html part with an umlaut
+
+ $content = `cat $RT::BasePath/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&umlauts_redef_sendmessage;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain");
+is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
+
+sub umlauts_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+# }}}
+
+# {{{ test a text-html message with an umlaut
+
+ $content = `cat $RT::BasePath/lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&text_html_umlauts_redef_sendmessage;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'");
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
+
+sub text_html_umlauts_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ use Data::Dumper;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
+ is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
+ is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
+ is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
+ }';
+}
+
+# }}}
+
+# {{{ test a text-html message with russian characters
+
+ $content = `cat $RT::BasePath/lib/t/data/text-html-in-russian` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&text_html_russian_redef_sendmessage;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
+
+sub text_html_russian_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ use Data::Dumper;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
+ is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
+ is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
+ is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
+ my $content_1251;
+ $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
+ ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
+"Content matches drugim in codepage 1251" );
+ }';
+}
+
+# }}}
+
+# {{{ test a message containing a russian subject and NO content type
+
+unshift (@RT::EmailInputEncodings, 'koi8-r');
+$RT::EmailOutputEncoding = 'koi8-r';
+$content = `cat $RT::BasePath/lib/t/data/russian-subject-no-content-type` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&text_plain_russian_redef_sendmessage;
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain");
+is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
+sub text_plain_russian_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
+ my $subject = $MIME->head->get("subject");
+ chomp($subject);
+ #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
+ };
+ ';
+}
+
+shift @RT::EmailInputEncodings;
+$RT::EmailOutputEncoding = 'utf-8';
+# }}}
+
+
+# {{{ test a message containing a nested RFC 822 message
+
+ $content = `cat $RT::BasePath/lib/t/data/nested-rfc-822` || die "couldn't find new content";
+ok ($content, "Loaded nested-rfc-822 to test");
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&text_plain_nested_redef_sendmessage;
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
+is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
+sub text_plain_nested_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
+ my $subject = $MIME->head->get("subject");
+ $subject = MIME::Base64::decode_base64( $subject);
+ chomp($subject);
+ # TODO, why does this test fail
+ #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
+ 1;
+ }';
+}
+
+# }}}
+
+
+# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
+
+ $content = `cat $RT::BasePath/lib/t/data/notes-uuencoded` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&notes_redef_sendmessage;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right");
+is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments");
+
+sub notes_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+# }}}
+
+# {{{ test a multipart that crashes the file-based mime-parser works
+
+ $content = `cat $RT::BasePath/lib/t/data/crashes-file-based-parser` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+# be as much like the mail gateway as possible.
+&crashes_redef_sendmessage;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
+is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
+
+sub crashes_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+
+
+# }}}
+
+# {{{ test a multi-line RT-Send-CC header
+
+ $content = `cat $RT::BasePath/lib/t/data/rt-send-cc` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc');
+ok ($cc =~ /test1/, "Found test 1");
+ok ($cc =~ /test2/, "Found test 2");
+ok ($cc =~ /test3/, "Found test 3");
+ok ($cc =~ /test4/, "Found test 4");
+ok ($cc =~ /test5/, "Found test 5");
+
+# }}}
+
+# Don't taint the environment
+$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
+1;
diff --git a/rt/lib/t/regression/05cronsupport.t b/rt/lib/t/regression/05cronsupport.t
new file mode 100644
index 0000000..8e5bd75
--- /dev/null
+++ b/rt/lib/t/regression/05cronsupport.t
@@ -0,0 +1,91 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More qw/no_plan/;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+### Set up some testing data. Test the testing data because why not?
+
+# Create a user with rights, a queue, and some tickets.
+my $user_obj = RT::User->new($RT::SystemUser);
+my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('tara@example.com');
+ok($ret, 'record test user creation');
+$user_obj->SetName('tara');
+$user_obj->PrincipalObj->GrantRight(Right => 'SuperUser');
+my $CurrentUser = RT::CurrentUser->new('tara');
+
+# Create our template, which will be used for tests of RT::Action::Record*.
+
+my $template_content = 'RT-Send-Cc: tla@example.com
+RT-Send-Bcc: jesse@example.com
+
+This is a content string with no content.';
+
+my $template_obj = RT::Template->new($CurrentUser);
+$template_obj->Create(Queue => '0',
+ Name => 'recordtest',
+ Description => 'testing Record actions',
+ Content => $template_content,
+ );
+
+# Create a queue and some tickets.
+
+my $queue_obj = RT::Queue->new($CurrentUser);
+($ret, $msg) = $queue_obj->Create(Name => 'recordtest', Description => 'queue for Action::Record testing');
+ok($ret, 'record test queue creation');
+
+my $ticket1 = RT::Ticket->new($CurrentUser);
+my ($id, $tobj, $msg2) = $ticket1->Create(Queue => $queue_obj,
+ Requestor => ['tara@example.com'],
+ Subject => 'bork bork bork',
+ Priority => 22,
+ );
+ok($id, 'record test ticket creation 1');
+my $ticket2 = RT::Ticket->new($CurrentUser);
+($id, $tobj, $msg2) = $ticket2->Create(Queue => $queue_obj,
+ Requestor => ['root@localhost'],
+ Subject => 'hurdy gurdy'
+ );
+ok($id, 'record test ticket creation 2');
+
+
+### OK. Have data, will travel.
+
+# First test the search.
+
+ok(require RT::Search::FromSQL, "Search::FromSQL loaded");
+my $ticketsqlstr = "Requestor.EmailAddress = '" . $CurrentUser->EmailAddress .
+ "' AND Priority > '20'";
+my $search = RT::Search::FromSQL->new(Argument => $ticketsqlstr, TicketsObj => RT::Tickets->new($CurrentUser),
+ );
+is(ref($search), 'RT::Search::FromSQL', "search created");
+ok($search->Prepare(), "fromsql search run");
+my $counter = 0;
+while(my $t = $search->TicketsObj->Next() ) {
+ is($t->Id(), $ticket1->Id(), "fromsql search results 1");
+ $counter++;
+}
+is ($counter, 1, "fromsql search results 2");
+
+# Right. Now test the actions.
+
+ok(require RT::Action::RecordComment);
+ok(require RT::Action::RecordCorrespondence);
+
+my ($comment_act, $correspond_act);
+ok($comment_act = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordComment created");
+ok($correspond_act = RT::Action::RecordCorrespondence->new(TicketObj => $ticket2, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordCorrespondence created");
+ok($comment_act->Prepare(), "Comment prepared");
+ok($correspond_act->Prepare(), "Correspond prepared");
+ok($comment_act->Commit(), "Comment committed");
+ok($correspond_act->Commit(), "Correspondence committed");
+
+# Now test for loop suppression.
+my ($trans, $desc, $transaction) = $ticket2->Comment(MIMEObj => $template_obj->MIMEObj);
+my $bogus_action = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, TransactionObj => $transaction, CurrentUser => $CurrentUser);
+ok(!$bogus_action->Prepare(), "Comment aborted to prevent loop");
+
+1;
diff --git a/rt/lib/t/regression/06mailgateway.t b/rt/lib/t/regression/06mailgateway.t
new file mode 100644
index 0000000..8486aea
--- /dev/null
+++ b/rt/lib/t/regression/06mailgateway.t
@@ -0,0 +1,504 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
+# <jesse.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+=head1 NAME
+
+rt-mailgate - Mail interface to RT3.
+
+=cut
+
+use strict;
+use Test::More tests => 57;
+use RT;
+RT::LoadConfig();
+RT::Init();
+use RT::I18N;
+# Make sure that when we call the mailgate wrong, it tempfails
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://this.test.for.non-connection.is.expected.to.generate.an.error"), "Opened the mailgate - The error below is expected - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Foob!
+EOF
+close (MAIL);
+
+# Check the return value
+is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay");
+
+
+# {{{ Test new ticket creation by root who is privileged and superuser
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+use RT::Tickets;
+my $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket");
+
+# }}}
+
+
+# {{{This is a test of new ticket creation as an unknown user
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+my $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission");
+
+
+# }}}
+
+# {{{ now everybody can create tickets. can a random unkown user create tickets?
+
+my $g = RT::Group->new($RT::SystemUser);
+$g->LoadSystemInternalGroup('Everyone');
+ok( $g->Id, "Found 'everybody'");
+
+my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+ok ($val, "Granted everybody the right to create tickets - $msg");
+
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+ $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist@example.com');
+ok( $u->Id != 0, " user does not exist and was created by ticket submission");
+
+# }}}
+
+
+# {{{ can another random reply to a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah! (Should not work.)
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission");
+# }}}
+
+
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2@example.com');
+ok( $u->Id != 0, " user exists and was created by ticket correspondence submission");
+
+# }}}
+
+# {{{ can another random comment on a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah! (Should not work.)
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
+
+# }}}
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3@example.com');
+ok( $u->Id != 0, " user exists and was created by ticket comment submission");
+
+# }}}
+
+# {{{ Testing preservation of binary attachments
+
+# Get a binary blob (Best Practical logo)
+
+# Create a mime entity with an attachment
+
+use MIME::Entity;
+my $entity = MIME::Entity->build( From => 'root@localhost',
+ To => 'rt@localhost',
+ Subject => 'binary attachment test',
+ Data => ['This is a test of a binary attachment']);
+
+# currently in lib/t/autogen
+
+my $LOGO_FILE = $RT::MasonComponentRoot.'/NoAuth/images/bplogo.gif';
+
+$entity->attach(Path => $LOGO_FILE,
+ Type => 'image/gif',
+ Encoding => 'base64');
+
+# Create a ticket with a binary attachment
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+
+$entity->print(\*MAIL);
+
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id);
+
+my $file = `cat $LOGO_FILE`;
+ok ($file, "Read in the logo image");
+
+
+ use Digest::MD5;
+warn "for the raw file the content is ".Digest::MD5::md5_base64($file);
+
+
+
+# Verify that the binary attachment is valid in the database
+my $attachments = RT::Attachments->new($RT::SystemUser);
+$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif');
+ok ($attachments->Count == 1, 'Found only one gif in the database');
+my $attachment = $attachments->First;
+ok($attachment->Id);
+my $acontent = $attachment->Content;
+
+ warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent);
+
+is( $acontent, $file, 'The attachment isn\'t screwed up in the database.');
+# Log in as root
+use Getopt::Long;
+use LWP::UserAgent;
+
+
+# Grab the binary attachment via the web ui
+my $ua = LWP::UserAgent->new();
+
+my $full_url = "$RT::WebURL/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/bplogo.gif?&user=root&pass=password";
+my $r = $ua->get( $full_url);
+
+
+# Verify that the downloaded attachment is the same as what we uploaded.
+is($file, $r->content, 'The attachment isn\'t screwed up in download');
+
+
+
+# }}}
+
+# {{{ Simple I18N testing
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+my $unitickets = RT::Tickets->new($RT::SystemUser);
+$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $unitick = $unitickets->First();
+ok (UNIVERSAL::isa($unitick,'RT::Ticket'));
+ok ($unitick->Id, "found ticket ".$unitick->Id);
+ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject);
+
+
+
+my $unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content);
+ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
+# supposedly I18N fails on the second message sent in.
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+my $tickets2 = RT::Tickets->new($RT::SystemUser);
+$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick2 = $tickets2->First();
+ok (UNIVERSAL::isa($tick2,'RT::Ticket'));
+ok ($tick2->Id, "found ticket ".$tick2->Id);
+ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket");
+
+
+
+$unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+
+ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content);
+
+# }}}
+
+
+($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
+ok ($val, $msg);
+
+=for later
+
+TODO: {
+
+# {{{ Check take and resolve actions
+
+# create ticket that is owned by nobody
+use RT::Ticket;
+$tick = RT::Ticket->new($RT::SystemUser);
+my ($id) = $tick->Create( Queue => 'general', Subject => 'test');
+ok( $id, 'new ticket created' );
+is( $tick->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' );
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action take"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [example.com \#$id] test
+
+EOF
+close (MAIL);
+is ($? >> 8, 0, "The mail gateway exited normally");
+
+$tick = RT::Ticket->new($RT::SystemUser);
+$tick->Load( $id );
+is( $tick->Id, $id, 'load correct ticket');
+is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email');
+
+# check that there is no text transactions writen
+is( $tick->Transactions->Count, 2, 'no superfluous transactions');
+
+my $status = '';
+($status, $msg) = $tick->SetOwner( $RT::Nobody->Id, 'Force' );
+ok( $status, 'successfuly changed owner: '. ($msg||'') );
+is( $tick->Owner, $RT::Nobody->Id, 'set owner back to nobody');
+
+
+
+ local $TODO = "Advanced mailgate actions require an unsafe configuration";
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action take-correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [example.com \#$id] correspondence
+
+test
+EOF
+close (MAIL);
+is ($? >> 8, 0, "The mail gateway exited normally");
+
+$tick = RT::Ticket->new($RT::SystemUser);
+$tick->Load( $id );
+is( $tick->Id, $id, 'load correct ticket');
+is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email');
+my $txns = $tick->Transactions;
+$txns->Limit( FIELD => 'Type', VALUE => 'Correspond');
+is( $txns->Last->Subject, "[example.com \#$id] correspondence", 'successfuly add correspond within take via email' );
+# +1 because of auto open
+is( $tick->Transactions->Count, 6, 'no superfluous transactions');
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue general --action resolve"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [example.com \#$id] test
+
+EOF
+close (MAIL);
+is ($? >> 8, 0, "The mail gateway exited normally");
+
+DBIx::SearchBuilder::Record::Cachable->FlushCache;
+
+$tick = RT::Ticket->new($RT::SystemUser);
+$tick->Load( $id );
+is( $tick->Id, $id, 'load correct ticket');
+is( $tick->Status, 'resolved', 'successfuly resolved ticket via email');
+is( $tick->Transactions->Count, 7, 'no superfluous transactions');
+
+};
+
+=cut
+
+# }}}
+
+1;
diff --git a/rt/lib/t/regression/07acl.t b/rt/lib/t/regression/07acl.t
new file mode 100644
index 0000000..bb1ccdc
--- /dev/null
+++ b/rt/lib/t/regression/07acl.t
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+
+use WWW::Mechanize;
+use HTTP::Cookies;
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+# Create a user with basically no rights, to start.
+my $user_obj = RT::User->new($RT::SystemUser);
+my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('customer-'.$$.'@example.com');
+ok($ret, 'ACL test user creation');
+$user_obj->SetName('customer-'.$$);
+$user_obj->SetPrivileged(1);
+($ret, $msg) = $user_obj->SetPassword('customer');
+ok($ret, "ACL test password set. $msg");
+
+# Now test the web interface, making sure objects come and go as
+# required.
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+
+# get the top page
+my $url = $RT::WebURL;
+$agent->get($url);
+
+is ($agent->{'status'}, 200, "Loaded a page - $RT::WebURL");
+# {{{ test a login
+
+# follow the link marked "Login"
+
+ok($agent->{form}->find_input('user'));
+
+ok($agent->{form}->find_input('pass'));
+ok ($agent->{'content'} =~ /username:/i);
+$agent->field( 'user' => 'customer-'.$$ );
+$agent->field( 'pass' => 'customer' );
+# the field isn't named, so we have to click link 0
+$agent->click(0);
+is($agent->{'status'}, 200, "Fetched the page ok");
+ok($agent->{'content'} =~ /Logout/i, "Found a logout link");
+
+# Test for absence of Configure and Preferences tabs.
+ok(!$agent->find_link( url => '/Admin/',
+ text => 'Configuration'), "No config tab" );
+ok(!$agent->find_link( url => '/User/Prefs.html',
+ text => 'Preferences'), "No prefs pane" );
+
+# Now test for their presence, one at a time. Sleep for a bit after
+# ACL changes, thanks to the 10s ACL cache.
+$user_obj->PrincipalObj->GrantRight(Right => 'ShowConfigTab');
+$agent->reload();
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => '/Admin/',
+ text => 'Configuration'), "Found config tab" );
+$user_obj->PrincipalObj->RevokeRight(Right => 'ShowConfigTab');
+$user_obj->PrincipalObj->GrantRight(Right => 'ModifySelf');
+$agent->reload();
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => '/User/Prefs.html',
+ text => 'Preferences'), "Found prefs pane" );
+$user_obj->PrincipalObj->RevokeRight(Right => 'ModifySelf');
+
+# Good. Now load the search page and test Load/Save Search.
+$agent->follow_link( url => '/Search/Build.html',
+ text => 'Tickets');
+is($agent->{'status'}, 200, "Fetched search builder page");
+ok($agent->{'content'} !~ /Load saved search/i, "No search loading box");
+ok($agent->{'content'} !~ /Saved searches/i, "No saved searches box");
+
+$user_obj->PrincipalObj->GrantRight(Right => 'LoadSavedSearch');
+$agent->reload();
+ok($agent->{'content'} =~ /Load saved search/i, "Search loading box exists");
+ok($agent->{'content'} !~ /input\s+type=.submit.\s+name=.Save./i,
+ "Still no saved searches box");
+
+$user_obj->PrincipalObj->GrantRight(Right => 'CreateSavedSearch');
+$agent->reload();
+ok($agent->{'content'} =~ /Load saved search/i,
+ "Search loading box still exists");
+ok($agent->{'content'} =~ /input\s+type=.submit.\s+name=.Save./i,
+ "Saved searches box exists");
+
+# Create a group, and a queue, so we can test limited user visibility
+# via SelectOwner.
+
+my $queue_obj = RT::Queue->new($RT::SystemUser);
+($ret, $msg) = $queue_obj->Create(Name => 'CustomerQueue',
+ Description => 'queue for SelectOwner testing');
+ok($ret, "SelectOwner test queue creation. $msg");
+my $group_obj = RT::Group->new($RT::SystemUser);
+($ret, $msg) = $group_obj->CreateUserDefinedGroup(Name => 'CustomerGroup',
+ Description => 'group for SelectOwner testing');
+ok($ret, "SelectOwner test group creation. $msg");
+
+# Add our customer to the customer group, and give it queue rights.
+($ret, $msg) = $group_obj->AddMember($user_obj->PrincipalObj->Id());
+ok($ret, "Added customer to its group. $msg");
+$group_obj->PrincipalObj->GrantRight(Right => 'OwnTicket',
+ Object => $queue_obj);
+$group_obj->PrincipalObj->GrantRight(Right => 'SeeQueue',
+ Object => $queue_obj);
+
+# Now. When we look at the search page we should be able to see
+# ourself in the list of possible owners.
+
+$agent->reload();
+ok($agent->form_name('BuildQuery'), "Yep, form is still there");
+my $input = $agent->current_form->find_input('ValueOfActor');
+ok(grep(/customer-$$/, $input->value_names()), "Found self in the actor listing");
+
+1;
diff --git a/rt/lib/t/regression/07rights.t b/rt/lib/t/regression/07rights.t
new file mode 100644
index 0000000..4764b49
--- /dev/null
+++ b/rt/lib/t/regression/07rights.t
@@ -0,0 +1,110 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+use Test::More tests => 14;
+use RT;
+RT::LoadConfig();
+RT::Init();
+use RT::I18N;
+use strict;
+no warnings 'once';
+
+use RT::Queue;
+use RT::ACE;
+use RT::User;
+use RT::Group;
+use RT::Ticket;
+
+
+# clear all global right
+my $acl = RT::ACL->new($RT::SystemUser);
+$acl->Limit( FIELD => 'RightName', OPERATOR => '!=', VALUE => 'SuperUser' );
+$acl->LimitToObject( $RT::System );
+while( my $ace = $acl->Next ) {
+ $ace->Delete;
+}
+
+# create new queue to be shure we don't mess with rights
+my $queue = RT::Queue->new($RT::SystemUser);
+my ($queue_id) = $queue->Create( Name => 'rights');
+ok( $queue_id, 'queue created for rights tests' );
+
+# new privileged user to check rights
+my $user = RT::User->new( $RT::SystemUser );
+my ($user_id) = $user->Create( Name => 'rights',
+ EmailAddress => 'rights@localhost',
+ Privileged => 1,
+ Password => 'qwe123',
+ );
+ok( !$user->HasRight( Right => 'OwnTicket', Object => $queue ), "user can't own ticket" );
+ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $queue ), "user can't reply to ticket" );
+
+my $group = RT::Group->new( $RT::SystemUser );
+ok( $group->LoadQueueRoleGroup( Queue => $queue_id, Type=> 'Owner' ), "load queue owners role group" );
+my $ace = RT::ACE->new( $RT::SystemUser );
+my ($ace_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ReplyToTicket', Object => $queue );
+ok( $ace_id, "Granted queue owners role group with ReplyToTicket right: $msg" );
+ok( $group->PrincipalObj->HasRight( Right => 'ReplyToTicket', Object => $queue ), "role group can reply to ticket" );
+ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $queue ), "user can't reply to ticket" );
+
+# new ticket
+my $ticket = RT::Ticket->new($RT::SystemUser);
+my ($ticket_id) = $ticket->Create( Queue => $queue_id, Subject => 'test');
+ok( $ticket_id, 'new ticket created' );
+is( $ticket->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' );
+
+my $status;
+($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'OwnTicket' );
+ok( $status, "successfuly granted right: $msg" );
+ok( $user->HasRight( Right => 'OwnTicket', Object => $queue ), "user can own ticket" );
+
+($status, $msg) = $ticket->SetOwner( $user_id );
+ok( $status, "successfuly set owner: $msg" );
+is( $ticket->Owner, $user_id, "set correct owner" );
+
+ok( $user->HasRight( Right => 'ReplyToTicket', Object => $ticket ), "user is owner and can reply to ticket" );
+
diff --git a/rt/lib/t/regression/08web_cf_access.t b/rt/lib/t/regression/08web_cf_access.t
new file mode 100644
index 0000000..012d733
--- /dev/null
+++ b/rt/lib/t/regression/08web_cf_access.t
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 15;
+use RT;
+RT::LoadConfig;
+RT::Init;
+use Test::WWW::Mechanize;
+
+$RT::WebURL ||= 0; # avoid stupid warning
+my $BaseURL = $RT::WebURL;
+use constant ImageFile => $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif';
+use constant ImageFileContent => do {
+ local $/;
+ open my $fh, '<', ImageFile or die $!;
+ binmode($fh);
+ scalar <$fh>;
+};
+
+my $m = Test::WWW::Mechanize->new;
+isa_ok($m, 'Test::WWW::Mechanize');
+
+$m->get( $BaseURL."?user=root;pass=password" );
+$m->content_like(qr/Logout/, 'we did log in');
+$m->follow_link( text => 'Configuration' );
+$m->title_is(q/RT Administration/, 'admin screen');
+$m->follow_link( text => 'Custom Fields' );
+$m->title_is(q/Select a Custom Field/, 'admin-cf screen');
+$m->follow_link( text => 'New custom field' );
+$m->submit_form(
+ form_name => "ModifyCustomField",
+ fields => {
+ TypeComposite => 'Image-0',
+ LookupType => 'RT::Queue-RT::Ticket',
+ Name => 'img',
+ Description => 'img',
+ },
+);
+$m->title_is(q/Created CustomField img/, 'admin-cf created');
+$m->follow_link( text => 'Queues' );
+$m->title_is(q/Admin queues/, 'admin-queues screen');
+$m->follow_link( text => 'General' );
+$m->title_is(q/Editing Configuration for queue General/, 'admin-queue: general');
+$m->follow_link( text => 'Ticket Custom Fields' );
+
+$m->title_is(q/Edit Custom Fields for General/, 'admin-queue: general tcf');
+$m->form_name('EditCustomFields');
+
+# Sort by numeric IDs in names
+my @names = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map { /Object-1-CF-(\d+)/ ? [ $1 => $_ ] : () }
+ map $_->name, $m->current_form->inputs;
+my $tcf = pop(@names);
+$m->field( $tcf => 1 ); # Associate the new CF with this queue
+$m->field( $_ => undef ) for @names; # ...and not any other. ;-)
+$m->submit;
+
+$m->content_like( qr/Object created/, 'TCF added to the queue' );
+
+$m->submit_form(
+ form_name => "CreateTicketInQueue",
+ fields => { Queue => 'General' },
+);
+
+$m->content_like(qr/Upload multiple images/, 'has a upload image field');
+
+$tcf =~ /(\d+)$/ or die "Hey this is impossible dude";
+my $upload_field = "Object-RT::Ticket--CustomField-$1-Upload";
+
+$m->submit_form(
+ form_name => "TicketCreate",
+ fields => {
+ $upload_field => ImageFile,
+ Subject => 'testing img cf creation',
+ },
+);
+
+$m->content_like(qr/Ticket \d+ created/, "a ticket is created succesfully");
+
+my $id = $1 if $m->content =~ /Ticket (\d+) created/;
+
+$m->title_like(qr/testing img cf creation/, "its title is the Subject");
+
+$m->follow_link( text => 'bplogo.gif' );
+$m->content_is(ImageFileContent, "it links to the uploaded image");
+
+$m->get( $BaseURL );
+
+$m->follow_link( text => 'Tickets' );
+$m->follow_link( text => 'New Query' );
+
+$m->title_is(q/Query Builder/, 'Query building');
+$m->submit_form(
+ form_name => "BuildQuery",
+ fields => {
+ idOp => '=',
+ ValueOfid => $id,
+ ValueOfQueue => 'General',
+ },
+ button => 'AddClause',
+);
+
+$m->form_name('BuildQuery');
+
+my $col = ($m->current_form->find_input('SelectDisplayColumns'))[-1];
+$col->value( ($col->possible_values)[-1] );
+
+$m->click('AddCol');
+
+$m->form_name('BuildQuery');
+$m->click('DoSearch');
+
+$m->follow_link( text_regex => qr/bplogo\.gif/ );
+$m->content_is(ImageFileContent, "it links to the uploaded image");
+
+__END__
+[FC] Bulk Update does not have custom fields.
diff --git a/rt/lib/t/regression/09record_cf_api.t b/rt/lib/t/regression/09record_cf_api.t
new file mode 100644
index 0000000..1428a28
--- /dev/null
+++ b/rt/lib/t/regression/09record_cf_api.t
@@ -0,0 +1,188 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 131;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+# Before we get going, ditch all object_cfs; this will remove
+# all custom fields systemwide;
+my $object_cfs = RT::ObjectCustomFields->new($RT::SystemUser);
+$object_cfs->UnLimit();
+while (my $ocf = $object_cfs->Next) {
+ $ocf->Delete();
+}
+
+
+my $queue = RT::Queue->new( $RT::SystemUser );
+$queue->Create( Name => 'RecordCustomFields-'.$$ );
+ok ($queue->id, "Created the queue");
+
+my $ticket = RT::Ticket->new( $RT::SystemUser );
+$ticket->Create(
+ Queue => $queue->Id,
+ Requestor => 'root@localhost',
+ Subject => 'RecordCustomFields1',
+);
+
+my $cfs = $ticket->CustomFields;
+is( $cfs->Count, 0 );
+
+# Check that record has no any CF values yet {{{
+my $cfvs = $ticket->CustomFieldValues;
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue, undef );
+
+my $local_cf1 = RT::CustomField->new( $RT::SystemUser );
+$local_cf1->Create( Name => 'RecordCustomFields1-'.$$, Type => 'SelectSingle', Queue => $queue->id );
+$local_cf1->AddValue( Name => 'RecordCustomFieldValues11' );
+$local_cf1->AddValue( Name => 'RecordCustomFieldValues12' );
+
+my $local_cf2 = RT::CustomField->new( $RT::SystemUser );
+$local_cf2->Create( Name => 'RecordCustomFields2-'.$$, Type => 'SelectSingle', Queue => $queue->id );
+$local_cf2->AddValue( Name => 'RecordCustomFieldValues21' );
+$local_cf2->AddValue( Name => 'RecordCustomFieldValues22' );
+
+my $global_cf3 = RT::CustomField->new( $RT::SystemUser );
+$global_cf3->Create( Name => 'RecordCustomFields3-'.$$, Type => 'SelectSingle', Queue => 0 );
+$global_cf3->AddValue( Name => 'RecordCustomFieldValues31' );
+$global_cf3->AddValue( Name => 'RecordCustomFieldValues32' );
+
+
+my @custom_fields = ($local_cf1, $local_cf2, $global_cf3);
+
+
+$cfs = $ticket->CustomFields;
+is( $cfs->Count, 3 );
+
+# Check that record has no any CF values yet {{{
+$cfvs = $ticket->CustomFieldValues;
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue, undef );
+
+# CF with ID -1 shouldnt exist at all
+$cfvs = $ticket->CustomFieldValues( -1 );
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue( -1 ), undef );
+
+$cfvs = $ticket->CustomFieldValues( 'SomeUnexpedCustomFieldName' );
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue( 'SomeUnexpedCustomFieldName' ), undef );
+
+for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 0 );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 0 );
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), undef );
+}
+# }}}
+
+# try to add field value with fields that do not exist {{{
+my ($status, $msg) = $ticket->AddCustomFieldValue( Field => -1 , Value => 'foo' );
+ok(!$status, "shouldn't add value" );
+($status, $msg) = $ticket->AddCustomFieldValue( Field => 'SomeUnexpedCustomFieldName' , Value => 'foo' );
+ok(!$status, "shouldn't add value" );
+# }}}
+
+# {{{
+SKIP: {
+
+ skip "TODO: We want fields that are not allowed to set unexpected values", 10;
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->id , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->Name , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+ }
+
+ # Let check that we did not add value to be sure
+ # using only FirstCustomFieldValue sub because
+ # we checked other variants allready
+ for (@custom_fields) {
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef );
+ }
+
+}
+# Add some values to our custom fields
+for (@custom_fields) {
+ # this should be tested elsewhere
+ $_->AddValue( Name => 'Foo' );
+ $_->AddValue( Name => 'Bar' );
+}
+
+my $test_add_delete_cycle = sub {
+ my $cb = shift;
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $cb->($_) , Value => 'Foo' );
+ ok( $status, "message: $msg");
+ }
+
+ # does it exist?
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 3, "We found all three custom fields on our ticket" );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 1 , "we found one custom field when searching by id");
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 1 , " We found one custom field when searching by name for " . $_->Name);
+ is( $ticket->FirstCustomFieldValue( $_->id ), 'Foo' , "first value by id is foo");
+ is( $ticket->FirstCustomFieldValue( $_->Name ), 'Foo' , "first value by name is foo");
+ }
+ # because our CFs are SingleValue then new value addition should override
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'Bar' );
+ ok( $status, "message: $msg");
+ }
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 3 );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 1 );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 1 );
+ is( $ticket->FirstCustomFieldValue( $_->id ), 'Bar' );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), 'Bar' );
+ }
+ # delete it
+ for (@custom_fields ) {
+ ($status, $msg) = $ticket->DeleteCustomFieldValue( Field => $_ , Value => 'Bar' );
+ ok( $status, "Deleted a custom field value 'Bar' for field ".$_->id.": $msg");
+ }
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 0, "The ticket (".$ticket->id.") no longer has any custom field values" );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 0, $ticket->id." has no values for cf ".$_->id );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 0 , $ticket->id." has no values for cf '".$_->Name. "'" );
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef , "There is no first custom field value when loading by id" );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), undef, "There is no first custom field value when loading by Name" );
+ }
+};
+
+# lets test cycle via CF id
+$test_add_delete_cycle->( sub { return $_[0]->id } );
+# lets test cycle via CF object reference
+$test_add_delete_cycle->( sub { return $_[0] } );
+
+#SKIP: {
+# skip "TODO: should we add CF values to objects via CF Name?", 48;
+# names are not unique
+ # lets test cycle via CF Name
+# $test_add_delete_cycle->( sub { return $_[0]->Name } );
+#}
+
+
diff --git a/rt/lib/t/regression/10merge.t b/rt/lib/t/regression/10merge.t
new file mode 100644
index 0000000..8bca952
--- /dev/null
+++ b/rt/lib/t/regression/10merge.t
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+
+#
+# This test script validates that when merging two tickets, the comments from both tickets
+# are integrated into the new ticket
+
+use Test::More tests => 13;
+use RT;
+RT::LoadConfig;
+RT::Init;
+
+use_ok('RT::Ticket');
+use_ok('RT::Queue');
+
+my $queue = RT::Queue->new($RT::SystemUser);
+my ($id,$msg) = $queue->Create(Name => 'MergeTest-'.rand(25));
+ok ($id,$msg);
+
+my $t1 = RT::Ticket->new($RT::SystemUser);
+my ($tid,$transid, $t1msg) =$t1->Create ( Queue => $queue->Name, Subject => 'Merge test. orig');
+ok ($tid, $t1msg);
+($id, $msg) = $t1->Comment(Content => 'This is a Comment on the original');
+ok($id,$msg);
+
+my $txns = $t1->Transactions;
+my $Comments = 0;
+while (my $txn = $txns->Next) {
+$Comments++ if ($txn->Type eq 'Comment');
+}
+is($Comments,1, "our first ticket has only one Comment");
+
+my $t2 = RT::Ticket->new($RT::SystemUser);
+my ($t2id,$t2transid, $t2msg) =$t2->Create ( Queue => $queue->Name, Subject => 'Merge test. duplicate');
+ok ($t2id, $t2msg);
+
+
+
+($id, $msg) = $t2->Comment(Content => 'This is a commet on the duplicate');
+ok($id,$msg);
+
+
+$txns = $t2->Transactions;
+ $Comments = 0;
+while (my $txn = $txns->Next) {
+ $Comments++ if ($txn->Type eq 'Comment');
+}
+is($Comments,1, "our second ticket has only one Comment");
+
+($id, $msg) = $t1->Comment(Content => 'This is a second Comment on the original');
+ok($id,$msg);
+
+$txns = $t1->Transactions;
+$Comments = 0;
+while (my $txn = $txns->Next) {
+ $Comments++ if ($txn->Type eq 'Comment');
+}
+is($Comments,2, "our first ticket now has two Comments");
+
+($id,$msg) = $t2->MergeInto($t1->id);
+
+ok($id,$msg);
+$txns = $t1->Transactions;
+$Comments = 0;
+while (my $txn = $txns->Next) {
+ $Comments++ if ($txn->Type eq 'Comment');
+}
+is($Comments,3, "our first ticket now has three Comments - we merged safely");
+
diff --git a/rt/lib/t/regression/11-template-insert.t b/rt/lib/t/regression/11-template-insert.t
new file mode 100644
index 0000000..8681ce6
--- /dev/null
+++ b/rt/lib/t/regression/11-template-insert.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More tests => 7;
+
+use RT;
+RT::LoadConfig();
+RT::Init;
+
+
+# This tiny little test script triggers an interaction bug between DBD::Oracle 1.16, SB 1.15 and RT 3.4
+
+use_ok('RT::Template');
+my $template = RT::Template->new($RT::SystemUser);
+
+isa_ok($template, 'RT::Template');
+my ($val,$msg) = $template->Create(Queue => 1,
+ Name => 'InsertTest',
+ Content => 'This is template content');
+ok($val,$msg);
+is($template->Name, 'InsertTest');
+is($template->Content, 'This is template content', "We created the object right");
+($val, $msg) = $template->SetContent( 'This is new template content');
+ok($val,$msg);
+is($template->Content, 'This is new template content', "We managed to _Set_ the content");
diff --git a/rt/lib/t/regression/12-search.t b/rt/lib/t/regression/12-search.t
new file mode 100644
index 0000000..9cc4aa4
--- /dev/null
+++ b/rt/lib/t/regression/12-search.t
@@ -0,0 +1,235 @@
+#!/opt/perl/bin/perl -w
+
+# tests relating to searching. Especially around custom fields, and
+# corner cases.
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+use_ok('RT');
+RT::LoadConfig();
+RT::Init();
+
+# setup the queue
+
+my $q = RT::Queue->new($RT::SystemUser);
+my $queue = 'SearchTests-'.$$;
+$q->Create(Name => $queue);
+ok ($q->id, "Created the queue");
+
+
+# and setup the CFs
+# we believe the Type shouldn't matter.
+
+my $cf = RT::CustomField->new($RT::SystemUser);
+$cf->Create(Name => 'SearchTest', Type => 'Freeform', MaxValues => 0, Queue => $q->id);
+ok($cf->id, "Created the SearchTest CF");
+my $cflabel = "CustomField-".$cf->id;
+
+my $cf2 = RT::CustomField->new($RT::SystemUser);
+$cf2->Create(Name => 'SearchTest2', Type => 'Freeform', MaxValues => 0, Queue => $q->id);
+ok($cf2->id, "Created the SearchTest2 CF");
+my $cflabel2 = "CustomField-".$cf2->id;
+
+my $cf3 = RT::CustomField->new($RT::SystemUser);
+$cf3->Create(Name => 'SearchTest3', Type => 'Freeform', MaxValues => 0, Queue => $q->id);
+ok($cf3->id, "Created the SearchTest3 CF");
+my $cflabel3 = "CustomField-".$cf3->id;
+
+
+# setup some tickets
+# we'll need a small pile of them, to test various combinations and nulls.
+# there's probably a way to think harder and do this with fewer
+
+
+my $t1 = RT::Ticket->new($RT::SystemUser);
+my ( $id, undef $msg ) = $t1->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest1',
+ Requestor => ['search1@example.com'],
+ $cflabel => 'foo1',
+ $cflabel2 => 'bar1',
+ $cflabel3 => 'qux1',
+);
+ok( $id, $msg );
+
+
+my $t2 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t2->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest2',
+ Requestor => ['search2@example.com'],
+# $cflabel => 'foo2',
+ $cflabel2 => 'bar2',
+ $cflabel3 => 'qux2',
+);
+ok( $id, $msg );
+
+my $t3 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t3->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest3',
+ Requestor => ['search3@example.com'],
+ $cflabel => 'foo3',
+# $cflabel2 => 'bar3',
+ $cflabel3 => 'qux3',
+);
+ok( $id, $msg );
+
+my $t4 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t4->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest4',
+ Requestor => ['search4@example.com'],
+ $cflabel => 'foo4',
+ $cflabel2 => 'bar4',
+# $cflabel3 => 'qux4',
+);
+ok( $id, $msg );
+
+my $t5 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t5->Create(
+ Queue => $q->id,
+# Subject => 'SearchTest5',
+ Requestor => ['search5@example.com'],
+ $cflabel => 'foo5',
+ $cflabel2 => 'bar5',
+ $cflabel3 => 'qux5',
+);
+ok( $id, $msg );
+
+my $t6 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t6->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest6',
+# Requestor => ['search6@example.com'],
+ $cflabel => 'foo6',
+ $cflabel2 => 'bar6',
+ $cflabel3 => 'qux6',
+);
+ok( $id, $msg );
+
+my $t7 = RT::Ticket->new($RT::SystemUser);
+( $id, undef, $msg ) = $t7->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest7',
+ Requestor => ['search7@example.com'],
+# $cflabel => 'foo7',
+# $cflabel2 => 'bar7',
+ $cflabel3 => 'qux7',
+);
+ok( $id, $msg );
+
+# we have tickets. start searching
+my $tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue'");
+is($tix->Count, 7, "found all the tickets");
+
+
+# very simple searches. both CF and normal
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest = 'foo1'");
+is($tix->Count, 1, "matched identical subject");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest LIKE 'foo1'");
+is($tix->Count, 1, "matched LIKE subject");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest = 'foo'");
+is($tix->Count, 0, "IS a regexp match");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest LIKE 'foo'");
+is($tix->Count, 5, "matched LIKE subject");
+
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest IS NULL");
+
+ is($tix->Count, 2, "IS null CF");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Requestors LIKE 'search1'");
+is($tix->Count, 1, "LIKE requestor");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Requestors = 'search1\@example.com'");
+is($tix->Count, 1, "IS requestor");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Requestors LIKE 'search'");
+is($tix->Count, 6, "LIKE requestor");
+
+TODO: {
+
+ local $TODO = "Can't search for 'no requestor";
+ $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Requestors IS NULL");
+ is($tix->Count, 1, "Search for no requestor");
+
+};
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Subject = 'SearchTest1'");
+is($tix->Count, 1, "IS subject");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'SearchTest1'");
+is($tix->Count, 1, "LIKE subject");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Subject = ''");
+is($tix->Count, 1, "found one ticket");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'SearchTest'");
+is($tix->Count, 6, "found two ticket");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND Subject LIKE 'qwerty'");
+is($tix->Count, 0, "found zero ticket");
+
+
+
+
+# various combinations
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar1'");
+is($tix->Count, 1, "LIKE cf and LIKE cf");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest = 'foo1' AND CF.SearchTest2 = 'bar1'");
+is($tix->Count, 1, "is cf and is cf");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest = 'foo' AND CF.SearchTest2 LIKE 'bar1'");
+is($tix->Count, 0, "is cf and like cf");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar' AND CF.SearchTest3 LIKE 'qux'");
+is($tix->Count, 3, "like cf and like cf and like cf");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest LIKE 'foo' AND CF.SearchTest2 LIKE 'bar' AND CF.SearchTest3 LIKE 'qux6'");
+is($tix->Count, 1, "like cf and like cf and is cf");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest LIKE 'foo' AND Subject LIKE 'SearchTest'");
+is($tix->Count, 4, "like cf and like subject");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest IS NULL AND CF.SearchTest2 = 'bar2'");
+
+ is($tix->Count, 1, "null cf and is cf");
+
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("Queue = '$queue' AND CF.SearchTest IS NULL AND CF.SearchTest2 IS NULL");
+
+ is($tix->Count, 1, "null cf and null cf");
+
+
diff --git a/rt/lib/t/regression/13-attribute-tests.t b/rt/lib/t/regression/13-attribute-tests.t
new file mode 100644
index 0000000..945bbcf
--- /dev/null
+++ b/rt/lib/t/regression/13-attribute-tests.t
@@ -0,0 +1,67 @@
+
+use Test::More tests => 24;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+
+my $runid = rand(200);
+
+my $attribute = "squelch-$runid";
+
+ok(require RT::Attributes);
+
+my $user = RT::User->new($RT::SystemUser);
+ok (UNIVERSAL::isa($user, 'RT::User'));
+my ($id,$msg) = $user->Create(Name => 'attrtest-'.$runid);
+ok ($id, $msg);
+ok($user->id, "Created a test user");
+
+ok(1, $user->Attributes->BuildSelectQuery);
+my $attr = $user->Attributes;
+
+ok(1, $attr->BuildSelectQuery);
+
+
+ok (UNIVERSAL::isa($attr,'RT::Attributes'), 'got the attributes object');
+
+($id, $msg) = $user->AddAttribute(Name => 'TestAttr', Content => 'The attribute has content');
+ok ($id, $msg);
+is ($attr->Count,1, " One attr after adidng a first one");
+($id, $msg) = $attr->DeleteEntry(Name => $runid);
+ok(!$id, "Deleted non-existant entry - $msg");
+is ($attr->Count,1, "1 attr after deleting an empty attr");
+
+my @names = $attr->Names;
+is ("@names", "TestAttr");
+
+
+($id, $msg) = $user->AddAttribute(Name => $runid, Content => "First");
+
+is ($attr->Count,2, " Two attrs after adding an attribute named $runid");
+($id, $msg) = $user->AddAttribute(Name => $runid, Content => "Second");
+ok($id, $msg);
+
+is ($attr->Count,3, " Three attrs after adding a secondvalue to $runid");
+($id, $msg) = $attr->DeleteEntry(Name => $runid, Content => "First");
+ok($id, $msg);
+is ($attr->Count,2);
+
+#$attr->_DoSearch();
+($id, $msg) = $attr->DeleteEntry(Name => $runid, Content => "Second");
+ok($id, $msg);
+is ($attr->Count,1);
+
+#$attr->_DoSearch();
+ok(1, $attr->BuildSelectQuery);
+($id, $msg) = $attr->DeleteEntry(Name => "moose");
+ok(!$id, "Deleted non-existant entry - $msg");
+is ($attr->Count,1);
+
+ok(1, $attr->BuildSelectQuery);
+@names = $attr->Names;
+is("@names", "TestAttr");
+
+
+
+1;
diff --git a/rt/lib/t/regression/14merge.t b/rt/lib/t/regression/14merge.t
new file mode 100644
index 0000000..c916251
--- /dev/null
+++ b/rt/lib/t/regression/14merge.t
@@ -0,0 +1,31 @@
+
+use Test::More tests => '6';
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+# when you try to merge duplicate links on postgres, eveyrything goes to hell due to referential integrity constraints.
+
+
+my $t = RT::Ticket->new($RT::SystemUser);
+$t->Create(Subject => 'Main', Queue => 'general');
+
+ok ($t->id);
+my $t2 = RT::Ticket->new($RT::SystemUser);
+$t2->Create(Subject => 'Second', Queue => 'general');
+ok ($t2->id);
+
+my $t3 = RT::Ticket->new($RT::SystemUser);
+$t3->Create(Subject => 'Third', Queue => 'general');
+
+ok ($t3->id);
+
+my ($id,$val);
+($id,$val) = $t->AddLink(Type => 'DependsOn', Target => $t3->id);
+ok($id,$val);
+($id,$val) = $t2->AddLink(Type => 'DependsOn', Target => $t3->id);
+ok($id,$val);
+
+
+($id,$val) = $t->MergeInto($t2->id);
+ok($id,$val);
diff --git a/rt/lib/t/regression/15cf_single_values_are_single.t b/rt/lib/t/regression/15cf_single_values_are_single.t
new file mode 100644
index 0000000..dcfa2e5
--- /dev/null
+++ b/rt/lib/t/regression/15cf_single_values_are_single.t
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More tests => 8;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+
+my $q = RT::Queue->new($RT::SystemUser);
+my ($id,$msg) =$q->Create(Name => "CF-Single-".$$);
+ok($id,$msg);
+
+my $cf = RT::CustomField->new($RT::SystemUser);
+($id,$msg) = $cf->Create(Name => 'Single-'.$$, Type => 'Select', MaxValues => '1', Queue => $q->id);
+ok($id,$msg);
+
+
+($id,$msg) =$cf->AddValue(Name => 'First');
+ok($id,$msg);
+
+($id,$msg) =$cf->AddValue(Name => 'Second');
+ok($id,$msg);
+
+
+my $t = RT::Ticket->new($RT::SystemUser);
+($id,undef,$msg) = $t->Create(Queue => $q->id,
+ Subject => 'CF Test');
+
+ok($id,$msg);
+is($t->CustomFieldValues($cf->id)->Count, 0, "No values yet");
+$t->AddCustomFieldValue(Field => $cf->id, Value => 'First');
+is($t->CustomFieldValues($cf->id)->Count, 1, "One now");
+
+$t->AddCustomFieldValue(Field => $cf->id, Value => 'Second');
+is($t->CustomFieldValues($cf->id)->Count, 1, "Still one");
+
+1;
diff --git a/rt/lib/t/regression/16-transaction_cf_tests.t b/rt/lib/t/regression/16-transaction_cf_tests.t
new file mode 100644
index 0000000..9e1e86c
--- /dev/null
+++ b/rt/lib/t/regression/16-transaction_cf_tests.t
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Data::Dumper;
+use Test::More qw/no_plan/;
+
+use_ok('RT');
+use_ok('RT::Transactions');
+RT::LoadConfig();
+RT::Init();
+
+my $q = RT::Queue->new($RT::SystemUser);
+my ($id,$msg) = $q->Create( Name => 'TxnCFTest'.$$);
+ok($id,$msg);
+
+my $cf = RT::CustomField->new($RT::SystemUser);
+($id,$msg) = $cf->Create(Name => 'Txnfreeform-'.$$, Type => 'Freeform', MaxValues => '0', LookupType => RT::Transaction->CustomFieldLookupType );
+
+ok($id,$msg);
+
+($id,$msg) = $cf->AddToObject($q);
+
+ok($id,$msg);
+
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+
+my $transid;
+($id,$transid, $msg) = $ticket->Create(Queue => $q->id,
+ Subject => 'TxnCF test',
+ );
+ok($id,$msg);
+
+my $trans = RT::Transaction->new($RT::SystemUser);
+$trans->Load($transid);
+
+is($trans->ObjectId,$id);
+is ($trans->ObjectType, 'RT::Ticket');
+is ($trans->Type, 'Create');
+my $txncfs = $trans->CustomFields;
+is ($txncfs->Count, 1, "We have one custom field");
+my $txn_cf = $txncfs->First;
+is ($txn_cf->id, $cf->id, "It's the right custom field");
+my $values = $trans->CustomFieldValues($txn_cf->id);
+is ($values->Count, 0, "It has no values");
+
+# Old API
+my %cf_updates = ( 'CustomField-'.$cf->id => 'Testing');
+$trans->UpdateCustomFields( ARGSRef => \%cf_updates);
+
+ $values = $trans->CustomFieldValues($txn_cf->id);
+is ($values->Count, 1, "It has one value");
+
+# New API
+
+$trans->UpdateCustomFields( 'CustomField-'.$cf->id => 'Test two');
+ $values = $trans->CustomFieldValues($txn_cf->id);
+is ($values->Count, 2, "it has two values");
+
+# TODO ok(0, "Should updating custom field values remove old values?");
diff --git a/rt/lib/t/regression/17multiple_deleg_revocation.t b/rt/lib/t/regression/17multiple_deleg_revocation.t
new file mode 100644
index 0000000..1ed0404
--- /dev/null
+++ b/rt/lib/t/regression/17multiple_deleg_revocation.t
@@ -0,0 +1,135 @@
+#!/usr/bin/perl -w
+
+use Test::More qw(no_plan);
+
+use RT;
+
+ok( RT::LoadConfig, "Locating config files" );
+ok( RT::Init, "Basic initialization and DB connectivity" );
+
+my ($u1, $g1, $pg1, $pg2, $ace, @groups, @users, @principals);
+@groups = (\$g1, \$pg1, \$pg2);
+@users = (\$u1);
+@principals = (@groups, @users);
+
+my($ret, $msg);
+
+$u1 = RT::User->new($RT::SystemUser);
+( $ret, $msg ) = $u1->LoadOrCreateByEmail('delegtest1@example.com');
+ok( $ret, "Load / Create test user 1: $msg" );
+$u1->SetPrivileged(1);
+
+$g1 = RT::Group->new($RT::SystemUser);
+( $ret, $msg) = $g1->LoadUserDefinedGroup('dg1');
+unless ($ret) {
+ ( $ret, $msg ) = $g1->CreateUserDefinedGroup( Name => 'dg1' );
+}
+$pg1 = RT::Group->new($RT::SystemUser);
+( $ret, $msg ) = $pg1->LoadPersonalGroup( Name => 'dpg1',
+ User => $u1->PrincipalId );
+unless ($ret) {
+ ( $ret, $msg ) = $pg1->CreatePersonalGroup( Name => 'dpg1',
+ PrincipalId => $u1->PrincipalId );
+}
+ok( $ret, "Load / Create test personal group 1: $msg" );
+$pg2 = RT::Group->new($RT::SystemUser);
+( $ret, $msg ) = $pg2->LoadPersonalGroup( Name => 'dpg2',
+ User => $u1->PrincipalId );
+unless ($ret) {
+ ( $ret, $msg ) = $pg2->CreatePersonalGroup( Name => 'dpg2',
+ PrincipalId => $u1->PrincipalId );
+}
+ok( $ret, "Load / Create test personal group 2: $msg" );
+
+clear_acls_and_groups();
+
+( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights' );
+ok( $ret, "Grant DelegateRights to u1: $msg" );
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'ShowConfigTab' );
+ok( $ret, "Grant ShowConfigTab to g1: $msg" );
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'ShowConfigTab',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g1->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg2: $msg" );
+
+ok(( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System ) and
+ $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal groups have ShowConfigTab right after delegation" );
+
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete test user 1 from g1: $msg" );
+
+ok( not( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal group 1 lacks ShowConfigTab after user removed from g1" );
+ok( not( $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal group 2 lacks ShowConfigTab after user removed from g1" );
+
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg2: $msg" );
+
+ok(( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System ) and
+ $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal groups have ShowConfigTab right after delegation" );
+
+( $ret, $msg ) = $g1->PrincipalObj->RevokeRight( Right => 'ShowConfigTab' );
+ok( $ret, "Revoke ShowConfigTab from g1: $msg" );
+
+ok( not( $pg1->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal group 1 lacks ShowConfigTab after user removed from g1" );
+ok( not( $pg2->PrincipalObj->HasRight( Right => 'ShowConfigTab',
+ Object => $RT::System )),
+ "Test personal group 2 lacks ShowConfigTab after user removed from g1" );
+
+
+
+#######
+
+sub clear_acls_and_groups {
+ # Revoke all rights granted to our cast
+ my $acl = RT::ACL->new($RT::SystemUser);
+ foreach (@principals) {
+ $acl->LimitToPrincipal(Type => $$_->PrincipalObj->PrincipalType,
+ Id => $$_->PrincipalObj->Id);
+ }
+ while (my $ace = $acl->Next()) {
+ $ace->Delete();
+ }
+
+ # Remove all group memberships
+ my $members = RT::GroupMembers->new($RT::SystemUser);
+ foreach (@groups) {
+ $members->LimitToMembersOfGroup( $$_->PrincipalId );
+ }
+ while (my $member = $members->Next()) {
+ $member->Delete();
+ }
+
+ $acl->RedoSearch();
+ ok( $acl->Count() == 0,
+ "All principals have no rights after clearing ACLs" );
+ $members->RedoSearch();
+ ok( $members->Count() == 0,
+ "All groups have no members after clearing groups" );
+}
diff --git a/rt/lib/t/regression/18stale_delegations_cleanup.t b/rt/lib/t/regression/18stale_delegations_cleanup.t
new file mode 100644
index 0000000..84e666e
--- /dev/null
+++ b/rt/lib/t/regression/18stale_delegations_cleanup.t
@@ -0,0 +1,458 @@
+#!/usr/bin/perl -w
+
+# Regression test suite for http://rt3.fsck.com/Ticket/Display.html?id=6184
+# and related corner cases related to cleanup of delegated ACEs when
+# the delegator loses the right to delegate. This causes complexities
+# due to the fact that multiple ACEs can grant different delegation
+# rights to a principal, and because DelegateRights and SuperUser can
+# themselves be delegated.
+
+# The case where the "parent" delegated ACE is removed is handled in
+# the embedded regression tests in lib/RT/ACE_Overlay.pm .
+
+use Test::More qw(no_plan);
+
+use RT;
+
+ok( RT::LoadConfig, "Locating config files" );
+ok( RT::Init, "Basic initialization and DB connectivity" );
+
+my ($u1, $u2, $g1, $g2, $g3, $pg1, $pg2, $ace, @groups, @users, @principals);
+@groups = (\$g1, \$g2, \$g3, \$pg1, \$pg2);
+@users = (\$u1, \$u2);
+@principals = (@groups, @users);
+
+my($ret, $msg);
+
+$u1 = RT::User->new($RT::SystemUser);
+( $ret, $msg ) = $u1->LoadOrCreateByEmail('delegtest1@example.com');
+ok( $ret, "Load / Create test user 1: $msg" );
+$u1->SetPrivileged(1);
+$u2 = RT::User->new($RT::SystemUser);
+( $ret, $msg ) = $u2->LoadOrCreateByEmail('delegtest2@example.com');
+ok( $ret, "Load / Create test user 2: $msg" );
+$u2->SetPrivileged(1);
+$g1 = RT::Group->new($RT::SystemUser);
+( $ret, $msg) = $g1->LoadUserDefinedGroup('dg1');
+unless ($ret) {
+ ( $ret, $msg ) = $g1->CreateUserDefinedGroup( Name => 'dg1' );
+}
+ok( $ret, "Load / Create test group 1: $msg" );
+$g2 = RT::Group->new($RT::SystemUser);
+( $ret, $msg) = $g2->LoadUserDefinedGroup('dg2');
+unless ($ret) {
+ ( $ret, $msg ) = $g2->CreateUserDefinedGroup( Name => 'dg2' );
+}
+ok( $ret, "Load / Create test group 2: $msg" );
+$g3 = RT::Group->new($RT::SystemUser);
+( $ret, $msg) = $g3->LoadUserDefinedGroup('dg3');
+unless ($ret) {
+ ( $ret, $msg ) = $g3->CreateUserDefinedGroup( Name => 'dg3' );
+}
+ok( $ret, "Load / Create test group 3: $msg" );
+$pg1 = RT::Group->new($RT::SystemUser);
+( $ret, $msg ) = $pg1->LoadPersonalGroup( Name => 'dpg1',
+ User => $u1->PrincipalId );
+unless ($ret) {
+ ( $ret, $msg ) = $pg1->CreatePersonalGroup( Name => 'dpg1',
+ PrincipalId => $u1->PrincipalId );
+}
+ok( $ret, "Load / Create test personal group 1: $msg" );
+$pg2 = RT::Group->new($RT::SystemUser);
+( $ret, $msg ) = $pg2->LoadPersonalGroup( Name => 'dpg2',
+ User => $u2->PrincipalId );
+unless ($ret) {
+ ( $ret, $msg ) = $pg2->CreatePersonalGroup( Name => 'dpg2',
+ PrincipalId => $u2->PrincipalId );
+}
+ok( $ret, "Load / Create test personal group 2: $msg" );
+
+
+
+# Basic case: u has global DelegateRights through g1 and ShowConfigTab
+# through g2; then u is removed from g1.
+
+clear_acls_and_groups();
+
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' );
+ok( $ret, "Grant DelegateRights to g1: $msg" );
+( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' );
+ok( $ret, "Grant ShowConfigTab to g2: $msg" );
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+ok(
+ $u1->PrincipalObj->HasRight(
+ Right => 'DelegateRights',
+ Object => $RT::System
+ ),
+ "test user 1 has DelegateRights after joining g1"
+);
+( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g2: $msg" );
+ok(
+ $u1->PrincipalObj->HasRight(
+ Right => 'ShowConfigTab',
+ Object => $RT::System
+ ),
+ "test user 1 has ShowConfigTab after joining g2"
+);
+
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'ShowConfigTab',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+ok(
+ $pg1->PrincipalObj->HasRight(
+ Right => 'ShowConfigTab',
+ Object => $RT::System
+ ),
+ "Test personal group 1 has ShowConfigTab right after delegation"
+);
+
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete test user 1 from g1: $msg" );
+ok(
+ not(
+ $pg1->PrincipalObj->HasRight(
+ Right => 'ShowConfigTab',
+ Object => $RT::System
+ )
+ ),
+ "Test personal group 1 lacks ShowConfigTab right after user removed from g1"
+);
+
+# Basic case: u has global DelegateRights through g1 and ShowConfigTab
+# through g2; then DelegateRights revoked from g1.
+
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+( $ret, $msg ) = $g1->PrincipalObj->RevokeRight( Right => 'DelegateRights' );
+ok( $ret, "Revoke DelegateRights from g1: $msg" );
+ok(
+ not(
+ $pg1->PrincipalObj->HasRight(
+ Right => 'ShowConfigTab',
+ Object => $RT::System
+ )
+ ),
+ "Test personal group 1 lacks ShowConfigTab right after DelegateRights revoked from g1"
+);
+
+
+
+# Corner case - restricted delegation: u has DelegateRights on pg1
+# through g1 and AdminGroup on pg1 through g2; then DelegateRights
+# revoked from g1.
+
+clear_acls_and_groups();
+
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $pg1);
+ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" );
+( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'AdminGroup',
+ Object => $pg1);
+ok( $ret, "Grant AdminGroup on pg1 to g2: $msg" );
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g2: $msg" );
+ok( $u1->PrincipalObj->HasRight(
+ Right => 'DelegateRights',
+ Object => $pg1 ),
+ "test user 1 has DelegateRights on pg1 after joining g1" );
+ok( not( $u1->PrincipalObj->HasRight(
+ Right => 'DelegateRights',
+ Object => $RT::System )),
+ "Test personal group 1 lacks global DelegateRights after joining g1" );
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'AdminGroup',
+ Object => $pg1,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" );
+ok( $pg1->PrincipalObj->HasRight(
+ Right => 'AdminGroup',
+ Object => $pg1 ),
+ "Test personal group 1 has AdminGroup right on pg1 after delegation" );
+( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights',
+ Object => $pg1 );
+ok( $ret, "Revoke DelegateRights on pg1 from g1: $msg" );
+ok( not( $pg1->PrincipalObj->HasRight(
+ Right => 'AdminGroup',
+ Object => $pg1 )),
+ "Test personal group 1 lacks AdminGroup right on pg1 after DelegateRights revoked from g1" );
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $pg1);
+
+# Corner case - restricted delegation: u has DelegateRights on pg1
+# through g1 and AdminGroup on pg1 through g2; then u removed from g1.
+
+ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" );
+ok( $pg1->PrincipalObj->HasRight(
+ Right => 'AdminGroup',
+ Object => $pg1 ),
+ "Test personal group 1 has AdminGroup right on pg1 after delegation" );
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete test user 1 from g1: $msg" );
+ok( not( $pg1->PrincipalObj->HasRight(
+ Right => 'AdminGroup',
+ Object => $pg1 )),
+ "Test personal group 1 lacks AdminGroup right on pg1 after user removed from g1" );
+
+clear_acls_and_groups();
+
+
+
+# Corner case - multiple delegation rights: u has global
+# DelegateRights directly and DelegateRights on pg1 through g1, and
+# AdminGroup on pg1 through g2; then u removed from g1 (delegation
+# should remain); then DelegateRights revoked from u (delegation
+# should not remain).
+
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $pg1);
+ok( $ret, "Grant DelegateRights on pg1 to g1: $msg" );
+( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'AdminGroup',
+ Object => $pg1);
+ok( $ret, "Grant AdminGroup on pg1 to g2: $msg" );
+( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $RT::System);
+ok( $ret, "Grant DelegateRights to user: $msg" );
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g2: $msg" );
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'AdminGroup',
+ Object => $pg1,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" );
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete test user 1 from g1: $msg" );
+ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup',
+ Object => $pg1),
+ "Test personal group 1 retains AdminGroup right on pg1 after user removed from g1" );
+( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights',
+ Object => $RT::System );
+ok( not ($pg1->PrincipalObj->HasRight(Right => 'AdminGroup',
+ Object => $pg1)),
+ "Test personal group 1 lacks AdminGroup right on pg1 after DelegateRights revoked");
+
+# Corner case - multiple delegation rights and selectivity: u has
+# DelegateRights globally and on g2 directly and DelegateRights on pg1
+# through g1, and AdminGroup on pg1 through g2; then global
+# DelegateRights revoked from u (delegation should remain),
+# DelegateRights on g2 revoked from u (delegation should remain), and
+# u removed from g1 (delegation should not remain).
+
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $RT::System);
+ok( $ret, "Grant DelegateRights to user: $msg" );
+( $ret, $msg ) = $u1->PrincipalObj->GrantRight( Right => 'DelegateRights',
+ Object => $g2);
+ok( $ret, "Grant DelegateRights on g2 to user: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate AdminGroup on pg1 to pg1: $msg" );
+( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights',
+ Object => $RT::System );
+ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup',
+ Object => $pg1),
+ "Test personal group 1 retains AdminGroup right on pg1 after global DelegateRights revoked" );
+( $ret, $msg ) = $u1->PrincipalObj->RevokeRight( Right => 'DelegateRights',
+ Object => $g2 );
+ok( $pg1->PrincipalObj->HasRight(Right => 'AdminGroup',
+ Object => $pg1),
+ "Test personal group 1 retains AdminGroup right on pg1 after DelegateRights on g2 revoked" );
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete test user 1 from g1: $msg" );
+ok( not ($pg1->PrincipalObj->HasRight(Right => 'AdminGroup',
+ Object => $pg1)),
+ "Test personal group 1 lacks AdminGroup right on pg1 after user removed from g1");
+
+
+
+# Corner case - indirect delegation rights: u has DelegateRights
+# through g1 via g3, and ShowConfigTab via g2; then g3 removed from
+# g1.
+
+clear_acls_and_groups();
+
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' );
+ok( $ret, "Grant DelegateRights to g1: $msg" );
+( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' );
+ok( $ret, "Grant ShowConfigTab to g2: $msg" );
+( $ret, $msg ) = $g1->AddMember( $g3->PrincipalId );
+ok( $ret, "Add g3 to g1: $msg" );
+( $ret, $msg ) = $g3->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g3: $msg" );
+( $ret, $msg ) = $g2->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g2: $msg" );
+
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'ShowConfigTab',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+
+( $ret, $msg ) = $g1->DeleteMember( $g3->PrincipalId );
+ok( $ret, "Delete g3 from g1: $msg" );
+ok( not ($pg1->PrincipalObj->HasRight(Right => 'ShowConfigTab',
+ Object => $RT::System)),
+ "Test personal group 1 lacks ShowConfigTab right after g3 removed from g1");
+
+# Corner case - indirect delegation rights: u has DelegateRights
+# through g1 via g3, and ShowConfigTab via g2; then DelegateRights
+# revoked from g1.
+
+( $ret, $msg ) = $g1->AddMember( $g3->PrincipalId );
+ok( $ret, "Add g3 to g1: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg1: $msg" );
+( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights' );
+ok( $ret, "Revoke DelegateRights from g1: $msg" );
+
+ok( not ($pg1->PrincipalObj->HasRight(Right => 'ShowConfigTab',
+ Object => $RT::System)),
+ "Test personal group 1 lacks ShowConfigTab right after DelegateRights revoked from g1");
+
+
+
+# Corner case - delegation of DelegateRights: u1 has DelegateRights
+# via g1 and delegates DelegateRights to pg1; u2 has DelegateRights
+# via pg1 and ShowConfigTab via g2; then u1 removed from g1.
+
+clear_acls_and_groups();
+
+( $ret, $msg ) = $g1->PrincipalObj->GrantRight( Right => 'DelegateRights' );
+ok( $ret, "Grant DelegateRights to g1: $msg" );
+( $ret, $msg ) = $g2->PrincipalObj->GrantRight( Right => 'ShowConfigTab' );
+ok( $ret, "Grant ShowConfigTab to g2: $msg" );
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add test user 1 to g1: $msg" );
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'DelegateRights',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g1->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate DelegateRights to pg1: $msg" );
+
+( $ret, $msg ) = $pg1->AddMember( $u2->PrincipalId );
+ok( $ret, "Add test user 2 to pg1: $msg" );
+( $ret, $msg ) = $g2->AddMember( $u2->PrincipalId );
+ok( $ret, "Add test user 2 to g2: $msg" );
+$ace = RT::ACE->new($u2);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'ShowConfigTab',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg2: $msg" );
+
+ok( $pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab',
+ Object => $RT::System),
+ "Test personal group 2 has ShowConfigTab right after delegation");
+( $ret, $msg ) = $g1->DeleteMember( $u1->PrincipalId );
+ok( $ret, "Delete u1 from g1: $msg" );
+ok( not ($pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab',
+ Object => $RT::System)),
+ "Test personal group 2 lacks ShowConfigTab right after u1 removed from g1");
+
+# Corner case - delegation of DelegateRights: u1 has DelegateRights
+# via g1 and delegates DelegateRights to pg1; u2 has DelegateRights
+# via pg1 and ShowConfigTab via g2; then DelegateRights revoked from
+# g1.
+
+( $ret, $msg ) = $g1->AddMember( $u1->PrincipalId );
+ok( $ret, "Add u1 to g1: $msg" );
+$ace = RT::ACE->new($u1);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'DelegateRights',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g1->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg1->PrincipalId );
+ok( $ret, "Delegate DelegateRights to pg1: $msg" );
+$ace = RT::ACE->new($u2);
+( $ret, $msg ) = $ace->LoadByValues(
+ RightName => 'ShowConfigTab',
+ Object => $RT::System,
+ PrincipalType => 'Group',
+ PrincipalId => $g2->PrincipalId
+);
+ok( $ret, "Look up ACE to be delegated: $msg" );
+( $ret, $msg ) = $ace->Delegate( PrincipalId => $pg2->PrincipalId );
+ok( $ret, "Delegate ShowConfigTab to pg2: $msg" );
+
+( $ret, $msg ) = $g1->PrincipalObj->RevokeRight ( Right => 'DelegateRights' );
+ok( $ret, "Revoke DelegateRights from g1: $msg" );
+ok( not ($pg2->PrincipalObj->HasRight(Right => 'ShowConfigTab',
+ Object => $RT::System)),
+ "Test personal group 2 lacks ShowConfigTab right after DelegateRights revoked from g1");
+
+
+
+
+#######
+
+sub clear_acls_and_groups {
+ # Revoke all rights granted to our cast
+ my $acl = RT::ACL->new($RT::SystemUser);
+ foreach (@principals) {
+ $acl->LimitToPrincipal(Type => $$_->PrincipalObj->PrincipalType,
+ Id => $$_->PrincipalObj->Id);
+ }
+ while (my $ace = $acl->Next()) {
+ $ace->Delete();
+ }
+
+ # Remove all group memberships
+ my $members = RT::GroupMembers->new($RT::SystemUser);
+ foreach (@groups) {
+ $members->LimitToMembersOfGroup( $$_->PrincipalId );
+ }
+ while (my $member = $members->Next()) {
+ $member->Delete();
+ }
+
+ $acl->RedoSearch();
+ ok( $acl->Count() == 0,
+ "All principals have no rights after clearing ACLs" );
+ $members->RedoSearch();
+ ok( $members->Count() == 0,
+ "All groups have no members after clearing groups" );
+}
diff --git a/rt/lib/t/regression/19-rtname.t b/rt/lib/t/regression/19-rtname.t
new file mode 100644
index 0000000..b654df2
--- /dev/null
+++ b/rt/lib/t/regression/19-rtname.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More qw/no_plan/;
+
+use_ok("RT");
+
+RT::LoadConfig();
+RT::Init();
+
+use RT::Interface::Email;
+
+# normal use case, regexp set to rtname
+$RT::rtname = "site";
+$RT::EmailSubjectTagRegex = qr/$RT::rtname/ ;
+$RT::rtname = undef;
+is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123);
+is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef);
+
+# oops usecase, where the regexp is scragged
+$RT::rtname = "site";
+$RT::EmailSubjectTagRegex = undef;
+is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123);
+is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef);
+
+# set to a simple regexp. NOTE: we no longer match "site"
+$RT::rtname = "site";
+$RT::EmailSubjectTagRegex = qr/newsite/;
+is(RT::Interface::Email::ParseTicketId("[site #123] test"), undef);
+is(RT::Interface::Email::ParseTicketId("[newsite #123] test"), 123);
+
+# set to a more complex regexp
+$RT::rtname = "site";
+$RT::EmailSubjectTagRegex = qr/newsite||site/;
+is(RT::Interface::Email::ParseTicketId("[site #123] test"), 123);
+is(RT::Interface::Email::ParseTicketId("[newsite #123] test"), 123);
+is(RT::Interface::Email::ParseTicketId("[othersite #123] test"), undef);
+
diff --git a/rt/lib/t/regression/20savedsearch.t b/rt/lib/t/regression/20savedsearch.t
new file mode 100644
index 0000000..f4439f9
--- /dev/null
+++ b/rt/lib/t/regression/20savedsearch.t
@@ -0,0 +1,180 @@
+use RT;
+use Test::More tests => 26;
+use RT::User;
+use RT::Group;
+use RT::Ticket;
+use RT::Queue;
+
+use_ok(RT::SavedSearch);
+use_ok(RT::SavedSearches);
+
+RT::LoadConfig();
+RT::Init();
+
+# Set up some infrastructure. These calls are tested elsewhere.
+
+my $searchuser = RT::User->new($RT::SystemUser);
+my ($ret, $msg) = $searchuser->Create(Name => 'searchuser'.$$,
+ Privileged => 1,
+ EmailAddress => "searchuser\@p$$.example.com",
+ RealName => 'Search user');
+ok($ret, "created searchuser: $msg");
+$searchuser->PrincipalObj->GrantRight(Right => 'LoadSavedSearch');
+$searchuser->PrincipalObj->GrantRight(Right => 'CreateSavedSearch');
+$searchuser->PrincipalObj->GrantRight(Right => 'ModifySelf');
+
+# This is the group whose searches searchuser should be able to see.
+my $ingroup = RT::Group->new($RT::SystemUser);
+$ingroup->CreateUserDefinedGroup(Name => 'searchgroup1'.$$);
+$ingroup->AddMember($searchuser->Id);
+$searchuser->PrincipalObj->GrantRight(Right => 'EditSavedSearches',
+ Object => $ingroup);
+$searchuser->PrincipalObj->GrantRight(Right => 'ShowSavedSearches',
+ Object => $ingroup);
+
+# This is the group whose searches searchuser should not be able to see.
+my $outgroup = RT::Group->new($RT::SystemUser);
+$outgroup->CreateUserDefinedGroup(Name => 'searchgroup2'.$$);
+$outgroup->AddMember($RT::SystemUser->Id);
+
+my $queue = RT::Queue->new($RT::SystemUser);
+$queue->Create(Name => 'SearchQueue'.$$);
+$searchuser->PrincipalObj->GrantRight(Right => 'SeeQueue', Object => $queue);
+$searchuser->PrincipalObj->GrantRight(Right => 'ShowTicket', Object => $queue);
+$searchuser->PrincipalObj->GrantRight(Right => 'OwnTicket', Object => $queue);
+
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+$ticket->Create(Queue => $queue->Id,
+ Requestor => [ $searchuser->Name ],
+ Owner => $searchuser,
+ Subject => 'saved search test');
+
+
+# Now start the search madness.
+my $curruser = RT::CurrentUser->new($searchuser);
+my $format = '\' <b><a href="/Ticket/Display.html?id=__id__">__id__</a></b>/TITLE:#\',
+\'<b><a href="/Ticket/Display.html?id=__id__">__Subject__</a></b>/TITLE:Subject\',
+\'__Status__\',
+\'__QueueName__\',
+\'__OwnerName__\',
+\'__Priority__\',
+\'__NEWLINE__\',
+\'\',
+\'<small>__Requestors__</small>\',
+\'<small>__CreatedRelative__</small>\',
+\'<small>__ToldRelative__</small>\',
+\'<small>__LastUpdatedRelative__</small>\',
+\'<small>__TimeLeft__</small>\'';
+
+my ($ret, $msg);
+my $mysearch = RT::SavedSearch->new($curruser);
+($ret, $msg) = $mysearch->Save(Privacy => 'RT::User-' . $searchuser->Id,
+ Type => 'Ticket',
+ Name => 'owned by me',
+ SearchParams => {'Format' => $format,
+ 'Query' => "Owner = '"
+ . $searchuser->Name
+ . "'"});
+ok($ret, "mysearch was created");
+
+
+my $groupsearch = RT::SavedSearch->new($curruser);
+($ret, $msg) = $groupsearch->Save(Privacy => 'RT::Group-' . $ingroup->Id,
+ Type => 'Ticket',
+ Name => 'search queue',
+ SearchParams => {'Format' => $format,
+ 'Query' => "Queue = '"
+ . $queue->Name . "'"});
+ok($ret, "groupsearch was created");
+
+my $othersearch = RT::SavedSearch->new($curruser);
+($ret, $msg) = $othersearch->Save(Privacy => 'RT::Group-' . $outgroup->Id,
+ Type => 'Ticket',
+ Name => 'searchuser requested',
+ SearchParams => {'Format' => $format,
+ 'Query' =>
+ "Requestor.Name LIKE 'search'"});
+ok(!$ret, "othersearch NOT created");
+like($msg, qr/Failed to load object for/, "...for the right reason");
+
+$othersearch = RT::SavedSearch->new($RT::SystemUser);
+($ret, $msg) = $othersearch->Save(Privacy => 'RT::Group-' . $outgroup->Id,
+ Type => 'Ticket',
+ Name => 'searchuser requested',
+ SearchParams => {'Format' => $format,
+ 'Query' =>
+ "Requestor.Name LIKE 'search'"});
+ok($ret, "othersearch created by systemuser");
+
+# Now try to load some searches.
+
+# This should work.
+my $loadedsearch1 = RT::SavedSearch->new($curruser);
+$loadedsearch1->Load('RT::User-'.$curruser->Id, $mysearch->Id);
+is($loadedsearch1->Id, $mysearch->Id, "Loaded mysearch");
+like($loadedsearch1->GetParameter('Query'), qr/Owner/,
+ "Retrieved query of mysearch");
+# Check through the other accessor methods.
+is($loadedsearch1->Privacy, 'RT::User-' . $curruser->Id,
+ "Privacy of mysearch correct");
+is($loadedsearch1->Name, 'owned by me', "Name of mysearch correct");
+is($loadedsearch1->Type, 'Ticket', "Type of mysearch correct");
+
+# See if it can be used to search for tickets.
+my $tickets = RT::Tickets->new($curruser);
+$tickets->FromSQL($loadedsearch1->GetParameter('Query'));
+is($tickets->Count, 1, "Found a ticket");
+
+# This should fail -- wrong object.
+# my $loadedsearch2 = RT::SavedSearch->new($curruser);
+# $loadedsearch2->Load('RT::User-'.$curruser->Id, $groupsearch->Id);
+# isnt($loadedsearch2->Id, $othersearch->Id, "Didn't load groupsearch as mine");
+# ...but this should succeed.
+my $loadedsearch3 = RT::SavedSearch->new($curruser);
+$loadedsearch3->Load('RT::Group-'.$ingroup->Id, $groupsearch->Id);
+is($loadedsearch3->Id, $groupsearch->Id, "Loaded groupsearch");
+like($loadedsearch3->GetParameter('Query'), qr/Queue/,
+ "Retrieved query of groupsearch");
+# Can it get tickets?
+$tickets = RT::Tickets->new($curruser);
+$tickets->FromSQL($loadedsearch3->GetParameter('Query'));
+is($tickets->Count, 1, "Found a ticket");
+
+# This should fail -- no permission.
+my $loadedsearch4 = RT::SavedSearch->new($curruser);
+$loadedsearch4->Load($othersearch->Privacy, $othersearch->Id);
+isnt($loadedsearch4->Id, $othersearch->Id, "Did not load othersearch");
+
+# Try to update an existing search.
+$loadedsearch1->Update( SearchParams => {'Format' => $format,
+ 'Query' => "Queue = '" . $queue->Name . "'" } );
+like($loadedsearch1->GetParameter('Query'), qr/Queue/,
+ "Updated mysearch parameter");
+is($loadedsearch1->Type, 'Ticket', "mysearch is still for tickets");
+is($loadedsearch1->Privacy, 'RT::User-'.$curruser->Id,
+ "mysearch still belongs to searchuser");
+like($mysearch->GetParameter('Query'), qr/Queue/, "other mysearch object updated");
+
+
+## Right ho. Test the pseudo-collection object.
+
+my $genericsearch = RT::SavedSearch->new($curruser);
+$genericsearch->Save(Name => 'generic search',
+ Type => 'all',
+ SearchParams => {'Query' => "Queue = 'General'"});
+
+my $ticketsearches = RT::SavedSearches->new($curruser);
+$ticketsearches->LimitToPrivacy('RT::User-'.$curruser->Id, 'Ticket');
+is($ticketsearches->Count, 1, "Found searchuser's ticket searches");
+
+my $allsearches = RT::SavedSearches->new($curruser);
+$allsearches->LimitToPrivacy('RT::User-'.$curruser->Id);
+is($allsearches->Count, 2, "Found all searchuser's searches");
+
+# Delete a search.
+($ret, $msg) = $genericsearch->Delete;
+ok($ret, "Deleted genericsearch");
+$allsearches->LimitToPrivacy('RT::User-'.$curruser->Id);
+is($allsearches->Count, 1, "Found all searchuser's searches after deletion");
+
diff --git a/rt/lib/t/regression/21query-builder.t b/rt/lib/t/regression/21query-builder.t
new file mode 100644
index 0000000..be04599
--- /dev/null
+++ b/rt/lib/t/regression/21query-builder.t
@@ -0,0 +1,204 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More tests => 31;
+use Test::WWW::Mechanize;
+use HTTP::Request::Common;
+use HTTP::Cookies;
+use LWP;
+use Encode;
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = Test::WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+use RT;
+RT::LoadConfig;
+
+# get the top page
+my $url = $RT::WebURL;
+$agent->get($url);
+
+is ($agent->{'status'}, 200, "Loaded a page");
+
+
+# {{{ test a login
+
+# follow the link marked "Login"
+
+ok($agent->{form}->find_input('user'));
+
+ok($agent->{form}->find_input('pass'));
+ok ($agent->{'content'} =~ /username:/i);
+$agent->field( 'user' => 'root' );
+$agent->field( 'pass' => 'password' );
+# the field isn't named, so we have to click link 0
+$agent->click(0);
+is($agent->{'status'}, 200, "Fetched the page ok");
+ok( $agent->{'content'} =~ /Logout/i, "Found a logout link");
+
+# }}}
+
+# {{{ Query Builder tests
+
+my $response = $agent->get($url."Search/Build.html");
+ok( $response->is_success, "Fetched " . $url."Search/Build.html" );
+
+# Adding items
+
+# set the first value
+ok($agent->form_name('BuildQuery'), "found the form once");
+$agent->field("ActorField", "Owner");
+$agent->field("ActorOp", "=");
+$agent->field("ValueOfActor", "Nobody");
+$agent->submit();
+
+# set the next value
+ok($agent->form_name('BuildQuery'), "found the form again");
+$agent->field("QueueOp", "!=");
+$agent->field("ValueOfQueue", "Regression");
+$agent->submit();
+
+ok($agent->form_name('BuildQuery'), "found the form a third time");
+
+sub getQueryFromForm {
+ # This pulls out the "hidden input" query from the page
+ my $q = $agent->current_form->find_input("Query")->value;
+ $q =~ s/^\s+//g;
+ $q =~ s/\s+$//g;
+ $q =~ s/\s+/ /g;
+ return $q;
+}
+
+is (getQueryFromForm, "Owner = 'Nobody' AND Queue != 'Regression'");
+
+# We're going to delete the owner
+
+$agent->select("clauses", ["0"] );
+
+$agent->click("DeleteClause");
+
+ok($agent->form_name('BuildQuery'), "found the form a fourth time");
+
+is (getQueryFromForm, "Queue != 'Regression'");
+
+$agent->field("AndOr", "OR");
+
+$agent->select("idOp", ">");
+
+$agent->field("ValueOfid" => "1234");
+
+$agent->click("AddClause");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+TODO: {
+ local $TODO = "query builder incorrectly quotes numbers";
+ is(getQueryFromForm, "Queue != 'Regression' OR id > 1234", "added something as OR, and number not quoted");
+}
+
+sub selectedClauses {
+ my @clauses = grep { defined } map { $_->value } $agent->current_form->find_input("clauses");
+ return [ @clauses ];
+}
+
+
+is_deeply(selectedClauses, ["1"], 'the id that we just entered is still selected');
+
+# Move the second one up a level
+$agent->click("Up");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+is(getQueryFromForm, "id > 1234 OR Queue != 'Regression'", "moved up one");
+
+is_deeply(selectedClauses, ["0"], 'the one we moved up is selected');
+
+$agent->click("Right");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+is(getQueryFromForm, "Queue != 'Regression' OR ( id > 1234 )", "moved over to the right (and down)");
+is_deeply(selectedClauses, ["2"], 'the one we moved right is selected');
+
+$agent->select("clauses", ["1"]);
+
+$agent->click("Up");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+TODO: {
+ local $TODO = "query builder incorrectly changes OR to AND";
+ is(getQueryFromForm, "( id > 1234 ) OR Queue != 'Regression'", "moved up");
+}
+
+$agent->select("clauses", ["0"]); # this is a null clause
+
+$agent->click("Up");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+
+$agent->content_like(qr/error: can\S+t move up/, "i shouldn't have been able to hit up");
+
+$agent->click("Left");
+
+ok($agent->form_name('BuildQuery'), "found the form again");
+
+$agent->content_like(qr/error: can\S+t move left/, "i shouldn't have been able to hit left");
+
+$agent->select("clauses", ["1"]);
+$agent->select("ValueOfStatus" => "stalled");
+
+$agent->submit;
+ok($agent->form_name('BuildQuery'), "found the form again");
+is_deeply(selectedClauses, ["2"], 'the one we added is selected');
+TODO: {
+ local $TODO = "query builder incorrectly changes OR to AND";
+ is(getQueryFromForm, "( id > 1234 AND Status = 'stalled' ) OR Queue != 'Regression'", "added new one");
+}
+
+
+
+# - new items go one level down
+# - add items at currently selected level
+# - if nothing is selected, add at end, one level down
+#
+# move left
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move left if you're at the top level
+#
+# move right
+# - error if nothing selected
+# - same item should be selected after move
+# - can always move right (no max depth...should there be?)
+#
+# move up
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move up if you're first in the list
+#
+# move down
+# - error if nothing selected
+# - same item should be selected after move
+# - can't move down if you're last in the list
+#
+# toggle
+# - error if nothing selected
+# - change all aggregators in the grouping
+# - don't change any others
+#
+# delete
+# - error if nothing selected
+# - delete currently selected item
+# - delete all children of a grouping
+# - if delete leaves a node with no children, delete that, too
+# - what should be selected?
+#
+# Clear
+# - clears entire query
+# - clears it from the session, too
+
+# }}}
+
+
+1;
diff --git a/rt/lib/t/regression/22search_tix_by_txn.t b/rt/lib/t/regression/22search_tix_by_txn.t
new file mode 100644
index 0000000..54dad98
--- /dev/null
+++ b/rt/lib/t/regression/22search_tix_by_txn.t
@@ -0,0 +1,32 @@
+#use Test::More tests => 26;
+use Test::More qw/no_plan/;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+my $SUBJECT = "Search test - ".$$;
+
+use_ok('RT::Tickets');
+my $tix = RT::Tickets->new($RT::SystemUser);
+can_ok($tix, 'FromSQL');
+$tix->FromSQL('Updated = "2005-08-05" AND Subject = "$SUBJECT"');
+
+ok(! $tix->Count, "Searching for tickets updated on a random date finds nothing" . $tix->Count);
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+$ticket->Create(Queue => 'General', Subject => $SUBJECT);
+ok ($ticket->id, "We created a ticket");
+my ($id, $txnid, $txnobj) = $ticket->Comment( Content => 'A comment that happend on 2004-01-01');
+
+isa_ok($txnobj, 'RT::Transaction');
+
+ok($txnobj->CreatedObj->ISO);
+my ( $sid,$smsg) = $txnobj->__Set(Field => 'Created', Value => '2005-08-05 20:00:56');
+ok($sid,$smsg);
+is($txnobj->Created,'2005-08-05 20:00:56');
+is($txnobj->CreatedObj->ISO,'2005-08-05 20:00:56');
+
+$tix->FromSQL(qq{Updated = "2005-08-05" AND Subject = "$SUBJECT"});
+is( $tix->Count, 1);
+1;
diff --git a/rt/lib/t/setup_regression.t b/rt/lib/t/setup_regression.t
new file mode 100644
index 0000000..36f809b
--- /dev/null
+++ b/rt/lib/t/setup_regression.t
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use Test::More qw(no_plan);
+
+use RT;
+ok(RT::LoadConfig);
+ok(RT::Init, "Basic initialization and DB connectivity");
+
+# Create a new queue
+use_ok(RT::Queue);
+my $q = RT::Queue->new($RT::SystemUser);
+
+$q->Load('regression');
+if ($q->id != 0) {
+ die "Regression tests not starting with a clean DB. Bailing";
+}
+
+my ($id, $msg) = $q->Create( Name => 'Regression',
+ Description => 'A regression test queue',
+ CorrespondAddress => 'correspond@a',
+ CommentAddress => 'comment@a');
+
+isnt($id, 0, "Queue was created sucessfully - $msg");
+
+my $q2 = RT::Queue->new($RT::SystemUser);
+
+ok($q2->Load($id));
+is($q2->id, $id, "Sucessfully loaded the queue again");
+is($q2->Name, 'Regression');
+is($q2->Description, 'A regression test queue');
+is($q2->CorrespondAddress, 'correspond@a');
+is($q2->CommentAddress, 'comment@a');
+
+