summaryrefslogtreecommitdiff
path: root/rt/lib/t/regression
diff options
context:
space:
mode:
Diffstat (limited to 'rt/lib/t/regression')
-rw-r--r--rt/lib/t/regression/00-mason-syntax.t47
-rw-r--r--rt/lib/t/regression/01ticket_link_searching.t159
-rw-r--r--rt/lib/t/regression/02basic_web.t159
-rw-r--r--rt/lib/t/regression/03web_compiliation_errors.t64
-rw-r--r--rt/lib/t/regression/04send_email.t549
-rw-r--r--rt/lib/t/regression/05cronsupport.t91
-rw-r--r--rt/lib/t/regression/06-mime_decoding.t64
-rw-r--r--rt/lib/t/regression/06mailgateway.t663
-rw-r--r--rt/lib/t/regression/07acl.t138
-rw-r--r--rt/lib/t/regression/07rights.t140
-rw-r--r--rt/lib/t/regression/08web_cf_access.t119
-rw-r--r--rt/lib/t/regression/09record_cf_api.t204
-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.t266
-rw-r--r--rt/lib/t/regression/13-attribute-tests.t87
-rw-r--r--rt/lib/t/regression/14linking.t243
-rw-r--r--rt/lib/t/regression/14merge.t31
-rw-r--r--rt/lib/t/regression/15cf_combo_cascade.t49
-rw-r--r--rt/lib/t/regression/15cf_pattern.t54
-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/17custom_search.t88
-rw-r--r--rt/lib/t/regression/17multiple_deleg_revocation.t135
-rw-r--r--rt/lib/t/regression/18custom_frontpage.t75
-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/19quicksearch.t39
-rw-r--r--rt/lib/t/regression/20-sort-by-requestor.t143
-rw-r--r--rt/lib/t/regression/20savedsearch.t180
-rw-r--r--rt/lib/t/regression/21query-builder.t247
-rw-r--r--rt/lib/t/regression/22search_tix_by_txn.t38
-rw-r--r--rt/lib/t/regression/22search_tix_by_watcher.t228
-rw-r--r--rt/lib/t/regression/23-batch-upload-csv.t47
-rw-r--r--rt/lib/t/regression/23-web_attachments.t60
-rw-r--r--rt/lib/t/regression/23cfsort.t192
-rw-r--r--rt/lib/t/regression/24pawsort.t104
-rw-r--r--rt/lib/t/regression/25scrip_order.t57
-rw-r--r--rt/lib/t/regression/26command_line.t445
-rw-r--r--rt/lib/t/regression/27verp.t9
-rw-r--r--rt/lib/t/regression/mime_tests19
41 files changed, 5928 insertions, 0 deletions
diff --git a/rt/lib/t/regression/00-mason-syntax.t b/rt/lib/t/regression/00-mason-syntax.t
new file mode 100644
index 000000000..a94c7efc1
--- /dev/null
+++ b/rt/lib/t/regression/00-mason-syntax.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+my $ok = 1;
+
+use File::Find;
+find( {
+ no_chdir => 1,
+ wanted => sub {
+ return if /\.(?:jpe?g|png|gif|rej|\~)$/i;
+ if (m!/\.svn$!) {
+ $File::Find::prune = 1;
+ return;
+ }
+ return unless -f $_;
+ diag "testing $_" if $ENV{'TEST_VERBOSE'};
+ eval { compile_file($_) } and return;
+ $ok = 0;
+ diag "error in ${File::Find::name}:\n$@";
+ },
+}, 'html');
+ok($ok, "mason syntax is ok");
+
+use HTML::Mason;
+use HTML::Mason::Compiler;
+use HTML::Mason::Compiler::ToObject;
+
+sub compile_file {
+ my $file = shift;
+
+ open my $fh, '<:utf8', $file or die "couldn't open '$file': $!";
+ my $text = do { local $/; <$fh> };
+ close $fh or die "couldn't close '$file': $!";
+
+ my $compiler = new HTML::Mason::Compiler::ToObject;
+ $compiler->compile(
+ comp_source => $text,
+ name => 'my',
+ $HTML::Mason::VERSION >= 1.36? (comp_path => 'my'): (),
+ );
+ return 1;
+}
+
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 000000000..a402c7376
--- /dev/null
+++ b/rt/lib/t/regression/01ticket_link_searching.t
@@ -0,0 +1,159 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 30;
+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, "We created a child ticket");
+
+my $parent_ticket = new RT::Ticket( $CurrentUser );
+my ($parentid) = $parent_ticket->Create(
+ Subject => 'test parent',
+ Children => [ $childid ],
+ Queue => $queue->Id,
+);
+ok($parentid, "We created a parent ticket");
+
+
+my $Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitMemberOf( $parentid );
+is($Collection->Count,1, "We found only one result");
+ok($Collection->First);
+is($Collection->First->id, $childid, "We found the collection of all children of $parentid with Limit");
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("MemberOf = $parentid");
+is($Collection->Count, 1, "We found only one result");
+ok($Collection->First);
+is($Collection->First->id, $childid, "We found the collection of all children of $parentid with TicketSQL");
+
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitHasMember ($childid);
+is($Collection->Count,1, "We found only one result");
+ok($Collection->First);
+is($Collection->First->id, $parentid, "We found the collection of all parents of $childid with Limit");
+
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("HasMember = $childid");
+is($Collection->Count,1, "We found only one result");
+ok($Collection->First);
+is($Collection->First->id, $parentid, "We found the collection of all parents of $childid 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->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");
+
+
+# Now we find a collection of all the tickets which are not members of the parent ticket
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->FromSQL("MemberOf != $parentid");
+%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");
+
+$Collection = RT::Tickets->new($CurrentUser);
+$Collection->LimitMemberOf($parentid, OPERATOR => '!=');
+%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 000000000..3b8619b66
--- /dev/null
+++ b/rt/lib/t/regression/02basic_web.t
@@ -0,0 +1,159 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More tests => 19;
+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;
+diag $url;
+$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_number(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");
+like( $agent->{'content'}, qr{$string} , "Found the content");
+ok($agent->{redirected_uri}, "Did redirection");
+
+
+$agent->get($url."Ticket/Create.html?Queue=1");
+is ($agent->{'status'}, 200, "Loaded Create.html");
+$agent->form_number(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");
+
+like( $agent->{'content'}, qr{$string} , "Found the content");
+
+# Update time worked in hours
+$agent->follow_link( text_regex => qr/Basics/ );
+$agent->submit_form( form_number => 3,
+ fields => { TimeWorked => 5, 'TimeWorked-TimeUnits' => "hours" }
+);
+
+like ($agent->{'content'}, qr/to &#39;300&#39;/, "5 hours is 300 minutes");
+
+# }}}
+
+# {{{ 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("AddClause");
+
+# set the next value
+ok($agent->form_name('BuildQuery'));
+$agent->field("AttachmentField", "Subject");
+$agent->field("AttachmentOp", "LIKE");
+$agent->field("ValueOfAttachment", "bbb");
+$agent->submit("AddClause");
+
+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 000000000..29e56d67b
--- /dev/null
+++ b/rt/lib/t/regression/03web_compiliation_errors.t
@@ -0,0 +1,64 @@
+#!/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;
+diag "Base URL is '$url'" if $ENV{TEST_VERBOSE};
+$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/##;
+ diag( "testing $url/$file" ) if $ENV{TEST_VERBOSE};
+ 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'} !~ /raw 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 000000000..a175ffaee
--- /dev/null
+++ b/rt/lib/t/regression/04send_email.t
@@ -0,0 +1,549 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 142;
+
+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");
+ }
+}
+
+# some utils
+sub first_txn { return $_[0]->Transactions->First }
+sub first_attach { return first_txn($_[0])->Attachments->First }
+
+sub count_txns { return $_[0]->Transactions->Count }
+sub count_attachs { return first_txn($_[0])->Attachments->Count }
+
+sub file_content
+{
+ open my $fh, "<:raw", $_[0] or die "couldn't open file '$_[0]': $!";
+ local $/;
+ return scalar <$fh>;
+}
+
+# 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 = file_content("$RT::BasePath/lib/t/data/multipart-report");
+# 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 (first_txn($tick)->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 = file_content("$RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1");
+
+
+
+$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 (first_txn($tick)->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 = file_content("$RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1");
+# 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 (first_txn($tick)->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 = file_content("$RT::BasePath/lib/t/data/multipart-alternative-with-umlaut");
+
+$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 (first_txn($tick)->Content =~ /causes Error/, "We recorded the content right as text-plain");
+is (count_attachs($tick) , 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 = file_content("$RT::BasePath/lib/t/data/text-html-with-umlaut");
+
+$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 (first_attach($tick)->Content =~ /causes Error/, "We recorded the content as containing 'causes error'") or diag( first_attach($tick)->Content );
+ok (first_attach($tick)->ContentType =~ /text\/html/, "We recorded the content as text/html");
+is (count_attachs($tick), 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;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ 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 = file_content("$RT::BasePath/lib/t/data/text-html-in-russian");
+
+$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 (first_attach($tick)->ContentType =~ /text\/html/, "We recorded the content right as text-html");
+ok (count_attachs($tick) ==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 = file_content("$RT::BasePath/lib/t/data/russian-subject-no-content-type");
+
+$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 (first_attach($tick)->ContentType =~ /text\/plain/, "We recorded the content type right");
+ok (count_attachs($tick) ==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 = file_content("$RT::BasePath/lib/t/data/nested-rfc-822");
+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 (first_attach($tick)->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
+is (count_attachs($tick) , 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 = file_content("$RT::BasePath/lib/t/data/notes-uuencoded");
+
+$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 (first_txn($tick)->Content =~ /from Lotus Notes/, "We recorded the content right");
+is (count_attachs($tick) , 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 = file_content("$RT::BasePath/lib/t/data/crashes-file-based-parser");
+
+$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 (first_txn($tick)->Content =~ /FYI/, "We recorded the content right");
+is (count_attachs($tick) , 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 = file_content("$RT::BasePath/lib/t/data/rt-send-cc");
+
+$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 = first_attach($tick)->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");
+
+# }}}
+
+diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
+{
+ my $content = file_content("$RT::BasePath/lib/t/data/subject-with-folding-ws");
+ my ($status, $msg, $ticket) = RT::Interface::Email::Gateway(
+ { message => $content, queue => 1, action => 'correspond' }
+ );
+ ok ($status, 'created ticket') or diag "error: $msg";
+ ok ($ticket->id, "found ticket ". $ticket->id);
+ is ($ticket->Subject, 'test', 'correct subject');
+}
+
+diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
+{
+ my $content = file_content("$RT::BasePath/lib/t/data/very-long-subject");
+ my ($status, $msg, $ticket) = RT::Interface::Email::Gateway(
+ { message => $content, queue => 1, action => 'correspond' }
+ );
+ ok ($status, 'created ticket') or diag "error: $msg";
+ ok ($ticket->id, "found ticket ". $ticket->id);
+ is ($ticket->Subject, '0123456789'x20, 'correct subject');
+}
+
+
+
+# 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 000000000..8e5bd7516
--- /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/06-mime_decoding.t b/rt/lib/t/regression/06-mime_decoding.t
new file mode 100644
index 000000000..2dca4f191
--- /dev/null
+++ b/rt/lib/t/regression/06-mime_decoding.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+use_ok("RT");
+
+RT::LoadConfig();
+RT::Init();
+
+use_ok('RT::I18N');
+
+diag q{'=' char in a leading part before an encoded part} if $ENV{TEST_VERBOSE};
+{
+ my $str = 'key="plain"; key="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="';
+ is(
+ RT::I18N::DecodeMIMEWordsToUTF8($str),
+ 'key="plain"; key="мой_файл.bin"',
+ "right decoding"
+ );
+}
+
+diag q{not compliant with standards, but MUAs send such field when attachment has non-ascii in name}
+ if $ENV{TEST_VERBOSE};
+{
+ my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="';
+ is(
+ RT::I18N::DecodeMIMEWordsToUTF8($str),
+ 'attachment; filename="мой_файл.bin"',
+ "right decoding"
+ );
+}
+
+diag q{'=' char in a trailing part after an encoded part} if $ENV{TEST_VERBOSE};
+{
+ my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="; some_prop="value"';
+ is(
+ RT::I18N::DecodeMIMEWordsToUTF8($str),
+ 'attachment; filename="мой_файл.bin"; some_prop="value"',
+ "right decoding"
+ );
+}
+
+diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
+{
+ my $str = qq{Subject: =?ISO-8859-1?Q?Re=3A_=5BXXXXXX=23269=5D_=5BComment=5D_Frag?=}
+ . qq{\n =?ISO-8859-1?Q?e_zu_XXXXXX--xxxxxx_/_Xxxxx=FCxxxxxxxxxx?=};
+ is(
+ RT::I18N::DecodeMIMEWordsToUTF8($str),
+ qq{Subject: Re: [XXXXXX#269] [Comment] Frage zu XXXXXX--xxxxxx / Xxxxxüxxxxxxxxxx},
+ "right decoding"
+ );
+}
+
+diag q{newline and encoded file name} if $ENV{TEST_VERBOSE};
+{
+ my $str = qq{application/vnd.ms-powerpoint;\n\tname="=?ISO-8859-1?Q?Main_presentation.ppt?="};
+ is(
+ RT::I18N::DecodeMIMEWordsToUTF8($str),
+ qq{application/vnd.ms-powerpoint;\tname="Main presentation.ppt"},
+ "right decoding"
+ );
+}
+
diff --git a/rt/lib/t/regression/06mailgateway.t b/rt/lib/t/regression/06mailgateway.t
new file mode 100644
index 000000000..5fc502926
--- /dev/null
+++ b/rt/lib/t/regression/06mailgateway.t
@@ -0,0 +1,663 @@
+#!/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 => 109;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+use RT::I18N;
+use Digest::MD5 qw(md5_base64);
+
+no warnings 'once';
+my $url = join( ':', grep $_, "http://localhost", $RT::WebPort ) . $RT::WebPath ."/";
+
+# Make sure that when we call the mailgate wrong, it tempfails
+
+$! = 0;
+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\@$RT::rtname
+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
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --debug --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@$RT::rtname
+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");
+
+# }}}
+
+# {{{ Test new ticket creation without --action argument
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --debug --url $url --queue general"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@$RT::rtname
+Subject: using mailgate without --action arg
+
+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;
+isa_ok ($tick,'RT::Ticket');
+ok ($tick->Id, "found ticket ".$tick->Id);
+is ($tick->Subject, 'using mailgate without --action arg', "using mailgate without --action arg");
+
+# }}}
+
+# {{{This is a test of new ticket creation as an unknown user
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist\@$RT::rtname
+To: rt\@$RT::rtname
+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\@$RT::rtname");
+ok( !$u->Id, " 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");
+
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist\@$RT::rtname
+To: rt\@$RT::rtname
+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\@$RT::rtname");
+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");
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist-2\@$RT::rtname
+To: rt\@$RT::rtname
+Subject: [$RT::rtname #@{[$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@$RT::rtname');
+ok( !$u->Id, " 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");
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist-2\@$RT::rtname
+To: rt\@$RT::rtname
+Subject: [$RT::rtname #@{[$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\@$RT::rtname");
+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");
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action comment"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist-3\@$RT::rtname
+To: rt\@$RT::rtname
+Subject: [$RT::rtname #@{[$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\@$RT::rtname");
+ok( !$u->Id, " 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");
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action comment"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: doesnotexist-3\@$RT::rtname
+To: rt\@$RT::rtname
+Subject: [$RT::rtname #@{[$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\@$RT::rtname");
+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
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --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");
+
+
+diag( "for the raw file the content is ". 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;
+
+diag( "coming from the database, the content is ". 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 = "$url/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
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@$RT::rtname
+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.
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue general --action correspond"), "Opened the mailgate - $!");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@$RT::rtname
+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
+
+SKIP: {
+skip "Advanced mailgate actions require an unsafe configuration", 47 unless $RT::UnsafeEmailCommands;
+
+#create new queue to be shure we don't mess with rights
+use RT::Queue;
+my $queue = RT::Queue->new($RT::SystemUser);
+my ($qid) = $queue->Create( Name => 'ext-mailgate');
+ok( $qid, 'queue created for ext-mailgate tests' );
+
+# {{{ 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 => 'ext-mailgate', Subject => 'test');
+ok( $id, 'new ticket created' );
+is( $tick->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [$RT::rtname \#$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');
+
+
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $RT::WebURL --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [$RT::rtname \#$id] correspondence
+
+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 #$id");
+is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email');
+my $txns = $tick->Transactions;
+$txns->Limit( FIELD => 'Type', VALUE => 'Correspond');
+$txns->OrderBy( FIELD => 'id', ORDER => 'DESC' );
+# +1 because of auto open
+is( $tick->Transactions->Count, 6, 'no superfluous transactions');
+is( $txns->First->Subject, "[$RT::rtname \#$id] correspondence", 'successfuly add correspond within take via email' );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action resolve --debug"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: root\@localhost
+Subject: [$RT::rtname \#$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');
+
+use RT::User;
+my $user = RT::User->new( $RT::SystemUser );
+my ($uid) = $user->Create( Name => 'ext-mailgate',
+ EmailAddress => 'ext-mailgate@localhost',
+ Privileged => 1,
+ Password => 'qwe123',
+ );
+ok( $uid, 'user created for ext-mailgate tests' );
+ok( !$user->HasRight( Right => 'OwnTicket', Object => $queue ), "User can't own ticket" );
+
+$tick = RT::Ticket->new($RT::SystemUser);
+($id) = $tick->Create( Queue => $qid, Subject => 'test' );
+ok( $id, 'create new ticket' );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: ext-mailgate\@localhost
+Subject: [example.com \#$id] test
+
+EOF
+close (MAIL);
+is ( $? >> 8, 0, "mailgate exited normally" );
+DBIx::SearchBuilder::Record::Cachable->FlushCache;
+
+cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" );
+
+($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'ReplyToTicket' );
+ok( $status, "successfuly granted right: $msg" );
+my $ace_id = $status;
+ok( $user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can reply to ticket" );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action correspond-take"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: ext-mailgate\@localhost
+Subject: [example.com \#$id] test
+
+correspond-take
+EOF
+close (MAIL);
+is ( $? >> 8, 0, "mailgate exited normally" );
+DBIx::SearchBuilder::Record::Cachable->FlushCache;
+
+cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" );
+is( $tick->Transactions->Count, 3, "one transactions added" );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: ext-mailgate\@localhost
+Subject: [example.com \#$id] test
+
+correspond-take
+EOF
+close (MAIL);
+is ( $? >> 8, 0, "mailgate exited normally" );
+DBIx::SearchBuilder::Record::Cachable->FlushCache;
+
+cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" );
+is( $tick->Transactions->Count, 3, "no transactions added, user can't take ticket first" );
+
+# revoke ReplyToTicket right
+use RT::ACE;
+my $ace = RT::ACE->new($RT::SystemUser);
+$ace->Load( $ace_id );
+$ace->Delete;
+my $acl = RT::ACL->new($RT::SystemUser);
+$acl->Limit( FIELD => 'RightName', VALUE => 'ReplyToTicket' );
+$acl->LimitToObject( $RT::System );
+while( my $ace = $acl->Next ) {
+ $ace->Delete;
+}
+
+ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can't reply to ticket any more" );
+
+
+my $group = RT::Group->new( $RT::SystemUser );
+ok( $group->LoadQueueRoleGroup( Queue => $qid, Type=> 'Owner' ), "load queue owners role group" );
+$ace = RT::ACE->new( $RT::SystemUser );
+($ace_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ReplyToTicket', Object => $queue );
+ok( $ace_id, "Granted queue owners role group with ReplyToTicket right" );
+
+($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'OwnTicket' );
+ok( $status, "successfuly granted right: $msg" );
+($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'TakeTicket' );
+ok( $status, "successfuly granted right: $msg" );
+
+$! = 0;
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $!");
+print MAIL <<EOF;
+From: ext-mailgate\@localhost
+Subject: [example.com \#$id] test
+
+take-correspond with reply right granted to owner role
+EOF
+close (MAIL);
+is ( $? >> 8, 0, "mailgate exited normally" );
+DBIx::SearchBuilder::Record::Cachable->FlushCache;
+
+$tick->Load( $id );
+is( $tick->Owner, $user->id, "we changed owner" );
+ok( $user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "owner can reply to ticket" );
+is( $tick->Transactions->Count, 5, "transactions added" );
+
+
+# }}}
+};
+
+
+1;
+
diff --git a/rt/lib/t/regression/07acl.t b/rt/lib/t/regression/07acl.t
new file mode 100644
index 000000000..efd87016d
--- /dev/null
+++ b/rt/lib/t/regression/07acl.t
@@ -0,0 +1,138 @@
+#!/usr/bin/perl -w
+use strict;
+use WWW::Mechanize;
+use HTTP::Cookies;
+
+use Test::More tests => 34;
+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);
+
+no warnings 'once';
+# get the top page
+login($agent, $user_obj);
+
+# Test for absence of Configure and Preferences tabs.
+ok(!$agent->find_link( url => $RT::WebPath . "/Admin/",
+ text => 'Configuration'), "No config tab" );
+ok(!$agent->find_link( url => $RT::WebPath . "/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.
+my ($grantid,$grantmsg) =$user_obj->PrincipalObj->GrantRight(Right => 'ShowConfigTab', Object => $RT::System);
+
+ok($grantid,$grantmsg);
+
+$agent->reload;
+
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => $RT::WebPath . "/Admin/",
+ text => 'Configuration'), "Found config tab" );
+my ($revokeid,$revokemsg) =$user_obj->PrincipalObj->RevokeRight(Right => 'ShowConfigTab');
+ok ($revokeid,$revokemsg);
+($grantid,$grantmsg) =$user_obj->PrincipalObj->GrantRight(Right => 'ModifySelf');
+ok ($grantid,$grantmsg);
+$agent->reload();
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => $RT::WebPath . "/User/Prefs.html",
+ text => 'Preferences'), "Found prefs pane" );
+($revokeid,$revokemsg) = $user_obj->PrincipalObj->RevokeRight(Right => 'ModifySelf');
+ok ($revokeid,$revokemsg);
+# Good. Now load the search page and test Load/Save Search.
+$agent->follow_link( url => $RT::WebPath . "/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");
+
+($grantid,$grantmsg) = $user_obj->PrincipalObj->GrantRight(Right => 'LoadSavedSearch');
+ok($grantid,$grantmsg);
+$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");
+
+($grantid,$grantmsg) =$user_obj->PrincipalObj->GrantRight(Right => 'CreateSavedSearch');
+ok ($grantid,$grantmsg);
+$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");
+($grantid,$grantmsg) =$group_obj->PrincipalObj->GrantRight(Right => 'OwnTicket',
+ Object => $queue_obj);
+
+ok($grantid,$grantmsg);
+($grantid,$grantmsg) =$group_obj->PrincipalObj->GrantRight(Right => 'SeeQueue',
+ Object => $queue_obj);
+ok ($grantid,$grantmsg);
+# 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");
+
+sub login {
+ my $agent = shift;
+
+ my $url = $RT::WebURL;
+ $agent->get($url);
+ is( $agent->{'status'}, 200,
+ "Loaded a page - $url" );
+
+ # {{{ 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' => $user_obj->Name );
+ $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" );
+}
+1;
diff --git a/rt/lib/t/regression/07rights.t b/rt/lib/t/regression/07rights.t
new file mode 100644
index 000000000..6c35a0717
--- /dev/null
+++ b/rt/lib/t/regression/07rights.t
@@ -0,0 +1,140 @@
+#!/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 => 26;
+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" );
+
+# Testing of EquivObjects
+$group = RT::Group->new( $RT::SystemUser );
+ok( $group->LoadQueueRoleGroup( Queue => $queue_id, Type=> 'AdminCc' ), "load queue AdminCc role group" );
+$ace = RT::ACE->new( $RT::SystemUser );
+($ace_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ModifyTicket', Object => $queue );
+ok( $ace_id, "Granted queue AdminCc role group with ModifyTicket right: $msg" );
+ok( $group->PrincipalObj->HasRight( Right => 'ModifyTicket', Object => $queue ), "role group can modify ticket" );
+ok( !$user->HasRight( Right => 'ModifyTicket', Object => $ticket ), "user is not AdminCc and can't modify ticket" );
+($status, $msg) = $ticket->AddWatcher(Type => 'AdminCc', PrincipalId => $user->PrincipalId);
+ok( $status, "successfuly added user as AdminCc");
+ok( $user->HasRight( Right => 'ModifyTicket', Object => $ticket ), "user is AdminCc and can modify ticket" );
+
+my $ticket2 = RT::Ticket->new($RT::SystemUser);
+my ($ticket2_id) = $ticket2->Create( Queue => $queue_id, Subject => 'test2');
+ok( $ticket2_id, 'new ticket created' );
+ok( !$user->HasRight( Right => 'ModifyTicket', Object => $ticket2 ), "user is not AdminCc and can't modify ticket2" );
+
+# now we can finally test EquivObjects
+my $equiv = [ $ticket ];
+ok( $user->HasRight( Right => 'ModifyTicket', Object => $ticket2, EquivObjects => $equiv ),
+ "user is not AdminCc but can modify ticket2 because of EquivObjects" );
+
+# the first a third test below are the same, so they should both pass
+my $equiv2 = [];
+ok( !$user->HasRight( Right => 'ModifyTicket', Object => $ticket2, EquivObjects => $equiv2 ),
+ "user is not AdminCc and can't modify ticket2" );
+ok( $user->HasRight( Right => 'ModifyTicket', Object => $ticket, EquivObjects => $equiv2 ),
+ "user is AdminCc and can modify ticket" );
+ok( !$user->HasRight( Right => 'ModifyTicket', Object => $ticket2, EquivObjects => $equiv2 ),
+ "user is not AdminCc and can't modify ticket2 (same question different answer)" );
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 000000000..c352bbcf8
--- /dev/null
+++ b/rt/lib/t/regression/08web_cf_access.t
@@ -0,0 +1,119 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 15;
+BEGIN {
+ use RT;
+ RT::LoadConfig;
+ RT::Init;
+}
+use Test::WWW::Mechanize;
+
+use constant 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 000000000..78f111bd8
--- /dev/null
+++ b/rt/lib/t/regression/09record_cf_api.t
@@ -0,0 +1,204 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 133;
+
+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 $queue2 = RT::Queue->new( $RT::SystemUser );
+$queue2->Create( Name => 'RecordCustomFields2' );
+
+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 $local_cf4 = RT::CustomField->new( $RT::SystemUser );
+$local_cf4->Create( Name => 'RecordCustomFields4', Type => 'SelectSingle', Queue => $queue2->id );
+$local_cf4->AddValue( Name => 'RecordCustomFieldValues41' );
+$local_cf4->AddValue( Name => 'RecordCustomFieldValues42' );
+
+
+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] } );
+
+$ticket->AddCustomFieldValue( Field => $local_cf2->id , Value => 'Baz' );
+$ticket->AddCustomFieldValue( Field => $global_cf3->id , Value => 'Baz' );
+# now if we ask for cf values on RecordCustomFields4 we should not get any
+$cfvs = $ticket->CustomFieldValues( 'RecordCustomFields4' );
+is( $cfvs->Count, 0, "No custom field values for non-Queue cf" );
+is( $ticket->FirstCustomFieldValue( 'RecordCustomFields4' ), undef, "No first custom field value for non-Queue cf" );
+
+
+#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 000000000..8bca9526a
--- /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 000000000..8681ce67d
--- /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 000000000..210d4fe33
--- /dev/null
+++ b/rt/lib/t/regression/12-search.t
@@ -0,0 +1,266 @@
+#!/opt/perl/bin/perl -w
+
+# tests relating to searching. Especially around custom fields, and
+# corner cases.
+
+use strict;
+use warnings;
+
+use Test::More tests => 44;
+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;
+
+
+# There was a bug involving a missing join to ObjectCustomFields that
+# caused spurious results on negative searches if another custom field
+# with the same name existed on a different queue. Hence, we make
+# duplicate CFs on a different queue here
+my $dup = RT::Queue->new($RT::SystemUser);
+$dup->Create(Name => $queue . "-Copy");
+ok ($dup->id, "Created the duplicate queue");
+my $dupcf = RT::CustomField->new($RT::SystemUser);
+$dupcf->Create(Name => 'SearchTest', Type => 'Freeform', MaxValues => 0, Queue => $dup->id);
+ok($dupcf->id, "Created the duplicate SearchTest CF");
+$dupcf = RT::CustomField->new($RT::SystemUser);
+$dupcf->Create(Name => 'SearchTest2', Type => 'Freeform', MaxValues => 0, Queue => $dup->id);
+ok($dupcf->id, "Created the SearchTest2 CF");
+$dupcf = RT::CustomField->new($RT::SystemUser);
+$dupcf->Create(Name => 'SearchTest3', Type => 'Freeform', MaxValues => 0, Queue => $dup->id);
+ok($dupcf->id, "Created the SearchTest3 CF");
+
+
+# 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");
+
+$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");
+
+# tests with the same CF listed twice
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.{SearchTest} = 'foo1'");
+is($tix->Count, 1, "is cf.{name} format");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest = 'foo1' OR CF.SearchTest = 'foo3'");
+is($tix->Count, 2, "is cf1 or is cf1");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest = 'foo1' OR CF.SearchTest IS NULL");
+is($tix->Count, 3, "is cf1 or null cf1");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("(CF.SearchTest = 'foo1' OR CF.SearchTest = 'foo3') AND (CF.SearchTest2 = 'bar1' OR CF.SearchTest2 = 'bar2')");
+is($tix->Count, 1, "(is cf1 or is cf1) and (is cf2 or is cf2)");
+
+$tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL("CF.SearchTest = 'foo1' OR CF.SearchTest = 'foo3' OR CF.SearchTest2 = 'bar1' OR CF.SearchTest2 = 'bar2'");
+is($tix->Count, 3, "is cf1 or is cf1 or is cf2 or is cf2");
+
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 000000000..fdac94e63
--- /dev/null
+++ b/rt/lib/t/regression/13-attribute-tests.t
@@ -0,0 +1,87 @@
+use strict;
+use warnings;
+use Test::More tests => 34;
+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;
+# XXX: Order by id as some tests depend on it
+$attr->OrderByCols({ FIELD => 'id' });
+
+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");
+
+my $first_attr = $user->FirstAttribute('TestAttr');
+ok($first_attr, "got some sort of attribute");
+isa_ok($first_attr, 'RT::Attribute');
+is($first_attr->Content, 'The attribute has content', "got the right content back");
+
+($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");
+ok($id, $msg);
+
+my $runid_attr = $user->FirstAttribute($runid);
+ok($runid_attr, "got some sort of attribute");
+isa_ok($runid_attr, 'RT::Attribute');
+is($runid_attr->Content, 'First', "got the right content back");
+
+is ($attr->Count,2, " Two attrs after adding an attribute named $runid");
+($id, $msg) = $user->AddAttribute(Name => $runid, Content => "Second");
+ok($id, $msg);
+
+$runid_attr = $user->FirstAttribute($runid);
+ok($runid_attr, "got some sort of attribute");
+isa_ok($runid_attr, 'RT::Attribute');
+is($runid_attr->Content, 'First', "got the first content back still");
+
+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/14linking.t b/rt/lib/t/regression/14linking.t
new file mode 100644
index 000000000..c8e57eadd
--- /dev/null
+++ b/rt/lib/t/regression/14linking.t
@@ -0,0 +1,243 @@
+use Test::More tests => '70';
+use_ok('RT');
+use_ok('RT::Ticket');
+use_ok('RT::ScripConditions');
+use_ok('RT::ScripActions');
+use_ok('RT::Template');
+use_ok('RT::Scrips');
+use_ok('RT::Scrip');
+RT::LoadConfig();
+RT::Init();
+
+use File::Temp qw/tempfile/;
+my ($fh, $filename) = tempfile( UNLINK => 1, SUFFIX => '.rt');
+my $link_scrips_orig = $RT::LinkTransactionsRun1Scrip;
+my $link_acl_chacks_orig = $RT::StrictLinkACL;
+$RT::LinkTransactionsRun1Scrip = 1;
+$RT::StrictLinkACL = 1;
+
+my $condition = RT::ScripCondition->new( $RT::SystemUser );
+$condition->Load('User Defined');
+ok($condition->id);
+my $action = RT::ScripAction->new( $RT::SystemUser );
+$action->Load('User Defined');
+ok($action->id);
+my $template = RT::Template->new( $RT::SystemUser );
+$template->Load('Blank');
+ok($template->id);
+
+my $q1 = RT::Queue->new($RT::SystemUser);
+my ($id,$msg) = $q1->Create(Name => "LinkTest1.$$");
+ok ($id,$msg);
+my $q2 = RT::Queue->new($RT::SystemUser);
+($id,$msg) = $q2->Create(Name => "LinkTest2.$$");
+ok ($id,$msg);
+
+my $commit_code = <<END;
+open(FILE, "<$filename");
+my \$data = <FILE>;
+chomp \$data;
+close FILE;
+open(FILE, ">$filename");
+if (\$self->TransactionObj->Type eq 'AddLink') {
+ print FILE \$data+1, "\n";
+}
+else {
+ print FILE \$data-1, "\n";
+}
+close FILE;
+1;
+END
+
+my $Scrips = RT::Scrips->new( $RT::SystemUser );
+$Scrips->UnLimit;
+while ( my $Scrip = $Scrips->Next ) {
+ $Scrip->Delete if $Scrip->Description =~ /Add or Delete Link \d+/;
+}
+
+
+my $scrip = RT::Scrip->new($RT::SystemUser);
+($id,$msg) = $scrip->Create( Description => "Add or Delete Link $$",
+ ScripCondition => $condition->id,
+ ScripAction => $action->id,
+ Template => $template->id,
+ Stage => 'TransactionCreate',
+ Queue => 0,
+ CustomIsApplicableCode => '$self->TransactionObj->Type =~ /(Add|Delete)Link/;',
+ CustomPrepareCode => '1;',
+ CustomCommitCode => $commit_code,
+ );
+ok($id, "Scrip created");
+
+my $u1 = RT::User->new($RT::SystemUser);
+($id,$msg) = $u1->Create(Name => "LinkTestUser.$$");
+ok ($id,$msg);
+
+my $creator = RT::CurrentUser->new($u1->id);
+
+($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q1, Right => 'CreateTicket');
+ok ($id,$msg);
+
+diag('Create tickets without rights to link') if $ENV{'TEST_VERBOSE'};
+{
+ # on q2 we have no rights, yet
+ my $parent = RT::Ticket->new( $RT::SystemUser );
+ ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
+ ok($id,$msg);
+ my $child = RT::Ticket->new( $creator );
+ ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id, MemberOf => $parent->id );
+ ok($id,$msg);
+ $child->CurrentUser( $RT::SystemUser );
+ is($child->_Links('Base')->Count, 0, 'link was not created, no permissions');
+ is($child->_Links('Target')->Count, 0, 'link was not create, no permissions');
+}
+
+diag('Create tickets with rights checks on one end of a link') if $ENV{'TEST_VERBOSE'};
+{
+ # on q2 we have no rights, but use checking one only on thing
+ local $RT::StrictLinkACL = 0;
+ my $parent = RT::Ticket->new( $RT::SystemUser );
+ ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
+ ok($id,$msg);
+ my $child = RT::Ticket->new( $creator );
+ ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id, MemberOf => $parent->id );
+ ok($id,$msg);
+ $child->CurrentUser( $RT::SystemUser );
+ is($child->_Links('Base')->Count, 1, 'link was created');
+ is($child->_Links('Target')->Count, 0, 'link was created only one');
+ # no scrip run on second ticket accroding to config option
+ is(link_count($filename), 0, "scrips ok");
+}
+
+($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q1, Right => 'ModifyTicket');
+ok ($id,$msg);
+
+diag('try to add link without rights') if $ENV{'TEST_VERBOSE'};
+{
+ # on q2 we have no rights, yet
+ my $parent = RT::Ticket->new( $RT::SystemUser );
+ ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
+ ok($id,$msg);
+ my $child = RT::Ticket->new( $creator );
+ ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id );
+ ok($id,$msg);
+ my ($id, $msg) = $child->AddLink(Type => 'MemberOf', Target => $parent->id);
+ ok(!$id, $msg);
+ is(link_count($filename), 0, "scrips ok");
+ $child->CurrentUser( $RT::SystemUser );
+ is($child->_Links('Base')->Count, 0, 'link was not created, no permissions');
+ is($child->_Links('Target')->Count, 0, 'link was not create, no permissions');
+}
+
+diag('add link with rights only on base') if $ENV{'TEST_VERBOSE'};
+{
+ # on q2 we have no rights, but use checking one only on thing
+ local $RT::StrictLinkACL = 0;
+ my $parent = RT::Ticket->new( $RT::SystemUser );
+ ($id,$tid,$msg) = $parent->Create( Subject => 'Link test 1', Queue => $q2->id );
+ ok($id,$msg);
+ my $child = RT::Ticket->new( $creator );
+ ($id,$tid,$msg) = $child->Create( Subject => 'Link test 1', Queue => $q1->id );
+ ok($id,$msg);
+ my ($id, $msg) = $child->AddLink(Type => 'MemberOf', Target => $parent->id);
+ ok($id, $msg);
+ is(link_count($filename), 1, "scrips ok");
+ $child->CurrentUser( $RT::SystemUser );
+ is($child->_Links('Base')->Count, 1, 'link was created');
+ is($child->_Links('Target')->Count, 0, 'link was created only one');
+ $child->CurrentUser( $creator );
+
+ # turn off feature and try to delete link, we should fail
+ $RT::StrictLinkACL = 1;
+ my ($id, $msg) = $child->AddLink(Type => 'MemberOf', Target => $parent->id);
+ ok(!$id, $msg);
+ is(link_count($filename), 1, "scrips ok");
+ $child->CurrentUser( $RT::SystemUser );
+ $child->_Links('Base')->_DoCount;
+ is($child->_Links('Base')->Count, 1, 'link was not deleted');
+ $child->CurrentUser( $creator );
+
+ # try to delete link, we should success as feature is active
+ $RT::StrictLinkACL = 0;
+ my ($id, $msg) = $child->DeleteLink(Type => 'MemberOf', Target => $parent->id);
+ ok($id, $msg);
+ is(link_count($filename), 0, "scrips ok");
+ $child->CurrentUser( $RT::SystemUser );
+ $child->_Links('Base')->_DoCount;
+ is($child->_Links('Base')->Count, 0, 'link was deleted');
+}
+
+my $tid;
+my $ticket = RT::Ticket->new( $creator);
+ok($ticket->isa('RT::Ticket'));
+($id,$tid, $msg) = $ticket->Create(Subject => 'Link test 1', Queue => $q1->id);
+ok ($id,$msg);
+
+diag('try link to itself') if $ENV{'TEST_VERBOSE'};
+{
+ my ($id, $msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket->id);
+ ok(!$id, $msg);
+ is(link_count($filename), 0, "scrips ok");
+}
+
+my $ticket2 = RT::Ticket->new($RT::SystemUser);
+($id, $tid, $msg) = $ticket2->Create(Subject => 'Link test 2', Queue => $q2->id);
+ok ($id, $msg);
+($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
+ok(!$id,$msg);
+ok(link_count($filename) == 0, "scrips ok");
+
+($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q2, Right => 'CreateTicket');
+ok ($id,$msg);
+($id,$msg) = $u1->PrincipalObj->GrantRight ( Object => $q2, Right => 'ModifyTicket');
+ok ($id,$msg);
+($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
+ok($id,$msg);
+ok(link_count($filename) == 1, "scrips ok");
+($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => -1);
+ok(!$id,$msg);
+ok(link_count($filename) == 1, "scrips ok");
+($id,$msg) = $ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
+ok($id,$msg);
+is(link_count($filename), 1, "scrips ok");
+
+my $transactions = $ticket2->Transactions;
+$transactions->Limit( FIELD => 'Type', VALUE => 'AddLink' );
+ok( $transactions->Count == 1, "Transaction found in other ticket" );
+ok( $transactions->First->Field eq 'ReferredToBy');
+ok( $transactions->First->NewValue eq $ticket->URI );
+
+($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id);
+ok($id,$msg);
+ok(link_count($filename) == 0, "scrips ok");
+$transactions = $ticket2->Transactions;
+$transactions->Limit( FIELD => 'Type', VALUE => 'DeleteLink' );
+ok( $transactions->Count == 1, "Transaction found in other ticket" );
+ok( $transactions->First->Field eq 'ReferredToBy');
+ok( $transactions->First->OldValue eq $ticket->URI );
+
+$RT::LinkTransactionsRun1Scrip = 0;
+
+($id,$msg) =$ticket->AddLink(Type => 'RefersTo', Target => $ticket2->id);
+ok($id,$msg);
+ok(link_count($filename) == 2, "scrips ok");
+($id,$msg) =$ticket->DeleteLink(Type => 'RefersTo', Target => $ticket2->id);
+ok($id,$msg);
+ok(link_count($filename) == 0, "scrips ok");
+
+# restore
+$RT::LinkTransactionsRun1Scrip = $link_scrips_orig;
+$RT::StrictLinkACL = $link_acl_checks_orig;
+
+exit(0);
+
+sub link_count {
+
+ my $file = shift;
+ open(FILE, "<$file");
+ my $data = <FILE>;
+ chomp $data;
+ return $data + 0;
+ close FILE;
+
+}
diff --git a/rt/lib/t/regression/14merge.t b/rt/lib/t/regression/14merge.t
new file mode 100644
index 000000000..c9162510b
--- /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_combo_cascade.t b/rt/lib/t/regression/15cf_combo_cascade.t
new file mode 100644
index 000000000..df663a1bd
--- /dev/null
+++ b/rt/lib/t/regression/15cf_combo_cascade.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More tests => 11;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+sub fails { ok(!$_[0], "This should fail: $_[1]") }
+sub works { ok($_[0], $_[1] || 'This works') }
+
+sub new (*) {
+ my $class = shift;
+ return $class->new($RT::SystemUser);
+}
+
+my $q = new(RT::Queue);
+works($q->Create(Name => "CF-Pattern-".$$));
+
+my $cf = new(RT::CustomField);
+my @cf_args = (Name => $q->Name, Type => 'Combobox', Queue => $q->id);
+
+works($cf->Create(@cf_args));
+
+# Set some CFVs with Category markers
+
+my $t = new(RT::Ticket);
+my ($id,undef,$msg) = $t->Create(Queue => $q->id, Subject => 'CF Test');
+works($id,$msg);
+
+sub add_works {
+ works(
+ $cf->AddValue(Name => $_[0], Description => $_[0], Category => $_[1])
+ );
+};
+
+add_works('value1', '1. Category A');
+add_works('value2');
+add_works('value3', '1.1. A-sub one');
+add_works('value4', '1.2. A-sub two');
+add_works('value5', '');
+
+my $cfv = $cf->Values->First;
+is($cfv->Category, '1. Category A');
+works($cfv->SetCategory('1. Category AAA'));
+is($cfv->Category, '1. Category AAA');
+
+1;
diff --git a/rt/lib/t/regression/15cf_pattern.t b/rt/lib/t/regression/15cf_pattern.t
new file mode 100644
index 000000000..ea2b5b858
--- /dev/null
+++ b/rt/lib/t/regression/15cf_pattern.t
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More tests => 17;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+sub fails { ok(!$_[0], "This should fail: $_[1]") }
+sub works { ok($_[0], $_[1] || 'This works') }
+
+sub new (*) {
+ my $class = shift;
+ return $class->new($RT::SystemUser);
+}
+
+my $q = new(RT::Queue);
+works($q->Create(Name => "CF-Pattern-".$$));
+
+my $cf = new(RT::CustomField);
+my @cf_args = (Name => $q->Name, Type => 'Freeform', Queue => $q->id, MaxValues => 1);
+
+fails($cf->Create(@cf_args, Pattern => ')))bad!regex((('));
+works($cf->Create(@cf_args, Pattern => 'good regex'));
+
+my $t = new(RT::Ticket);
+my ($id,undef,$msg) = $t->Create(Queue => $q->id, Subject => 'CF Test');
+works($id,$msg);
+
+# OK, I'm thoroughly brain washed by HOP at this point now...
+sub cnt { $t->CustomFieldValues($cf->id)->Count };
+sub add { $t->AddCustomFieldValue(Field => $cf->id, Value => $_[0]) };
+sub del { $t->DeleteCustomFieldValue(Field => $cf->id, Value => $_[0]) };
+
+is(cnt(), 0, "No values yet");
+fails(add('not going to match'));
+is(cnt(), 0, "No values yet");
+works(add('here is a good regex'));
+is(cnt(), 1, "Value filled");
+fails(del('here is a good regex'));
+is(cnt(), 1, "Single CF - Value _not_ deleted");
+
+$cf->SetMaxValues(0); # Unlimited MaxValues
+
+works(del('here is a good regex'));
+is(cnt(), 0, "Multiple CF - Value deleted");
+
+fails($cf->SetPattern('(?{ "insert evil code here" })'));
+works($cf->SetPattern('(?!)')); # reject everything
+fails(add(''));
+fails(add('...'));
+
+1;
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 000000000..dcfa2e5b3
--- /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 000000000..9e1e86ca4
--- /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/17custom_search.t b/rt/lib/t/regression/17custom_search.t
new file mode 100644
index 000000000..8e53f4486
--- /dev/null
+++ b/rt/lib/t/regression/17custom_search.t
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 10;
+BEGIN {
+ use RT;
+ RT::LoadConfig;
+ RT::Init;
+}
+use Test::WWW::Mechanize;
+
+use constant BaseURL => $RT::WebURL;
+
+# reset preferences for easier test?
+
+my $t = RT::Ticket->new($RT::SystemUser);
+$t->Create(Subject => 'for custom search', Queue => 'general',
+ Owner => 'root', Requestor => 'customsearch@localhost');
+ok(my $id = $t->id, 'created ticket for custom search');
+
+my $m = Test::WWW::Mechanize->new ( autocheck => 1 );
+isa_ok($m, 'Test::WWW::Mechanize');
+
+$m->get( BaseURL."?user=root;pass=password" );
+$m->content_like(qr/Logout/, 'we did log in');
+
+my $t_link = $m->find_link( text => "for custom search" );
+like ($t_link->url, qr/$id/, 'link to the ticket we created');
+
+$m->content_lacks ('customsearch@localhost', 'requestor not displayed ');
+$m->get ( BaseURL.'Prefs/MyRT.html' );
+my $cus_hp = $m->find_link( text => "My Tickets" );
+my $cus_qs = $m->find_link( text => "Quick search" );
+$m->get ($cus_hp);
+$m->content_like (qr'highest priority tickets');
+
+# add Requestor to the fields
+$m->form_name ('BuildQuery');
+# can't use submit form for mutli-valued select as it uses set_fields
+$m->field (SelectDisplayColumns => ['Requestors']);
+$m->click_button (name => 'AddCol') ;
+
+$m->form_name ('BuildQuery');
+$m->click_button (name => 'Save');
+
+$m->get( BaseURL );
+$m->content_contains ('customsearch@localhost', 'requestor now displayed ');
+
+
+# now remove Requestor from the fields
+$m->get ($cus_hp);
+
+$m->form_name ('BuildQuery');
+$m->field (CurrentDisplayColumns => 'Requestors');
+$m->click_button (name => 'RemoveCol') ;
+
+$m->form_name ('BuildQuery');
+$m->click_button (name => 'Save');
+
+$m->get( BaseURL );
+$m->content_lacks ('customsearch@localhost', 'requestor not displayed ');
+
+
+# try to disable General from quick search
+
+# Note that there's a small problem in the current implementation,
+# since ticked quese are wanted, we do the invesrsion. So any
+# queue added during the quicksearch setting will be unticked.
+my $nlinks = $#{$m->find_all_links( text => "General" )};
+warn $nlinks;
+$m->get ($cus_qs);
+$m->form_name ('Preferences');
+$m->untick('Want-General', '1');
+$m->click_button (name => 'Save');
+
+$m->get( BaseURL );
+is ($#{$m->find_all_links( text => "General" )}, $nlinks - 1,
+ 'General gone from quicksearch list');
+
+# get it back
+$m->get ($cus_qs);
+$m->form_name ('Preferences');
+$m->tick('Want-General', '1');
+$m->click_button (name => 'Save');
+
+$m->get( BaseURL );
+is ($#{$m->find_all_links( text => "General" )}, $nlinks,
+ 'General back in quicksearch list');
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 000000000..1ed040406
--- /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/18custom_frontpage.t b/rt/lib/t/regression/18custom_frontpage.t
new file mode 100644
index 000000000..cf77e35cc
--- /dev/null
+++ b/rt/lib/t/regression/18custom_frontpage.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 7;
+BEGIN {
+ use RT;
+ RT::LoadConfig;
+ RT::Init;
+}
+use Test::WWW::Mechanize;
+
+use constant BaseURL => $RT::WebURL;
+
+
+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');
+$user_obj->PrincipalObj->GrantRight(Right => 'LoadSavedSearch');
+$user_obj->PrincipalObj->GrantRight(Right => 'EditSavedSearch');
+$user_obj->PrincipalObj->GrantRight(Right => 'CreateSavedSearch');
+$user_obj->PrincipalObj->GrantRight(Right => 'ModifySelf');
+
+my $m = Test::WWW::Mechanize->new ( autocheck => 1 );
+isa_ok($m, 'Test::WWW::Mechanize');
+
+$m->get( BaseURL."?user=customer;pass=customer" );
+
+$m->content_like(qr/Logout/, 'we did log in');
+
+$m->get ( BaseURL."Search/Build.html");
+
+#create a saved search
+$m->form_name ('BuildQuery');
+
+$m->field ( "ValueOfAttachment" => 'stupid');
+$m->field ( "Description" => 'stupid tickets');
+$m->click_button (name => 'Save');
+
+$m->get ( BaseURL.'Prefs/MyRT.html' );
+$m->content_like (qr/stupid tickets/, 'saved search listed in rt at a glance items');
+
+$m->follow_link (text => 'Logout');
+
+$m->get( BaseURL."?user=root;pass=password" );
+$m->content_like(qr/Logout/, 'we did log in');
+
+$m->get ( BaseURL.'Prefs/MyRT.html' );
+$m->form_name ('SelectionBox-body');
+# can't use submit form for mutli-valued select as it uses set_fields
+$m->field ('body-Selected' => ['component-QuickCreate', 'system-Unowned Tickets', 'system-My Tickets']);
+$m->click_button (name => 'remove');
+$m->form_name ('SelectionBox-body');
+#$m->click_button (name => 'body-Save');
+$m->get ( BaseURL );
+$m->content_lacks ('highest priority tickets', 'remove everything from body pane');
+
+$m->get ( BaseURL.'Prefs/MyRT.html' );
+$m->form_name ('SelectionBox-body');
+$m->field ('body-Available' => ['component-QuickCreate', 'system-Unowned Tickets', 'system-My Tickets']);
+$m->click_button (name => 'add');
+
+$m->form_name ('SelectionBox-body');
+$m->field ('body-Selected' => ['component-QuickCreate']);
+$m->click_button (name => 'movedown');
+
+$m->form_name ('SelectionBox-body');
+$m->click_button (name => 'movedown');
+
+$m->form_name ('SelectionBox-body');
+#$m->click_button (name => 'body-Save');
+$m->get ( BaseURL );
+$m->content_like (qr'highest priority tickets', 'adds them back');
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 000000000..84e666eee
--- /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 000000000..b654df2bd
--- /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/19quicksearch.t b/rt/lib/t/regression/19quicksearch.t
new file mode 100644
index 000000000..7744787c0
--- /dev/null
+++ b/rt/lib/t/regression/19quicksearch.t
@@ -0,0 +1,39 @@
+
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More qw/no_plan/;
+use_ok('RT');
+RT::LoadConfig();
+RT::Init();
+
+my $q = RT::Queue->new($RT::SystemUser);
+my $queue = 'SearchTests-'.$$;
+$q->Create(Name => $queue);
+ok ($q->id, "Created the queue");
+
+my $t1 = RT::Ticket->new($RT::SystemUser);
+my ( $id, undef, $msg ) = $t1->Create(
+ Queue => $q->id,
+ Subject => 'SearchTest1',
+ Requestor => ['search2@example.com'],
+);
+ok( $id, $msg );
+
+use_ok("RT::Search::Googleish");
+my $tickets = RT::Tickets->new($RT::SystemUser);
+my $quick = RT::Search::Googleish->new(Argument => "",
+ TicketsObj => $tickets);
+my @tests = (
+ "General new open root" => "( Owner = 'root' ) AND ( Queue = 'General' ) AND ( Status = 'new' OR Status = 'open' )",
+ "fulltext:jesse" => "( Content LIKE 'jesse' )",
+ $queue => "( Queue = '$queue' )",
+ "root $queue" => "( Owner = 'root' ) AND ( Queue = '$queue' )",
+ "notauser $queue" => "( Queue = '$queue' ) AND ( Subject LIKE 'notauser' )",
+ "notauser $queue root" => "( Owner = 'root' ) AND ( Queue = '$queue' ) AND ( Subject LIKE 'notauser' )");
+
+while (my ($from, $to) = splice @tests, 0, 2) {
+ is($quick->QueryToSQL($from), $to, "<$from> -> <$to>");
+}
diff --git a/rt/lib/t/regression/20-sort-by-requestor.t b/rt/lib/t/regression/20-sort-by-requestor.t
new file mode 100644
index 000000000..e6903b433
--- /dev/null
+++ b/rt/lib/t/regression/20-sort-by-requestor.t
@@ -0,0 +1,143 @@
+#!/usr/bin/perl -w
+use strict; use warnings;
+
+use Test::More qw/no_plan/;
+use_ok('RT');
+RT::LoadConfig();
+RT::Init();
+use RT::Ticket;
+
+my $q = RT::Queue->new($RT::SystemUser);
+my $queue = 'SearchTests-'.rand(200);
+$q->Create(Name => $queue);
+
+my @requestors = ( ('bravo@example.com') x 6, ('alpha@example.com') x 6,
+ ('delta@example.com') x 6, ('charlie@example.com') x 6,
+ (undef) x 6);
+my @subjects = ("first test", "second test", "third test", "fourth test", "fifth test") x 6;
+while (@requestors) {
+ my $t = RT::Ticket->new($RT::SystemUser);
+ my ( $id, undef $msg ) = $t->Create(
+ Queue => $q->id,
+ Subject => shift @subjects,
+ Requestor => [ shift @requestors ]
+ );
+ ok( $id, $msg );
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue'");
+ is($tix->Count, 30, "found thirty tickets");
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND requestor = 'alpha\@example.com'");
+ $tix->OrderByCols({ FIELD => "Subject" });
+ my @subjects;
+ while (my $t = $tix->Next) { push @subjects, $t->Subject; }
+ is(@subjects, 6, "found six tickets");
+ is_deeply( \@subjects, [ sort @subjects ], "Subjects are sorted");
+}
+
+sub check_emails_order
+{
+ my ($tix,$count,$order) = (@_);
+ my @mails;
+ while (my $t = $tix->Next) { push @mails, $t->RequestorAddresses; }
+ is(@mails, $count, "found $count tickets for ". $tix->Query);
+ my @required_order;
+ if( $order =~ /asc/i ) {
+ @required_order = sort { $a? ($b? ($a cmp $b) : -1) : 1} @mails;
+ } else {
+ @required_order = sort { $a? ($b? ($b cmp $a) : -1) : 1} @mails;
+ }
+ foreach( reverse splice @mails ) {
+ if( $_ ) { unshift @mails, $_ }
+ else { push @mails, $_ }
+ }
+ is_deeply( \@mails, \@required_order, "Addresses are sorted");
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND subject = 'first test' AND Requestor.EmailAddress LIKE 'example.com'");
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ check_emails_order($tix, 5, 'ASC');
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress", ORDER => 'DESC' });
+ check_emails_order($tix, 5, 'DESC');
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Subject = 'first test'");
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ check_emails_order($tix, 6, 'ASC');
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress", ORDER => 'DESC' });
+ check_emails_order($tix, 6, 'DESC');
+}
+
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Subject = 'first test'");
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ check_emails_order($tix, 6, 'ASC');
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress", ORDER => 'DESC' });
+ check_emails_order($tix, 6, 'DESC');
+}
+
+{
+ # create ticket with group as member of the requestors group
+ my $t = RT::Ticket->new($RT::SystemUser);
+ my ( $id, $msg ) = $t->Create(
+ Queue => $q->id,
+ Subject => "first test",
+ Requestor => 'badaboom@example.com',
+ );
+ ok( $id, "ticket created" ) or diag( "error: $msg" );
+
+ my $g = RT::Group->new($RT::SystemUser);
+
+ my ($gid);
+ ($gid, $msg) = $g->CreateUserDefinedGroup(Name => '20-sort-by-requestor.t-'.rand(200));
+ ok($gid, "created group") or diag("error: $msg");
+
+ ($id, $msg) = $t->Requestors->AddMember( $gid );
+ ok($id, "added group to requestors group") or diag("error: $msg");
+}
+
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Subject = 'first test'");
+TODO: {
+ local $TODO = "if group has non users members we get wrong order";
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ check_emails_order($tix, 7, 'ASC');
+}
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress", ORDER => 'DESC' });
+ check_emails_order($tix, 7, 'DESC');
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue'");
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ $tix->RowsPerPage(30);
+ my @mails;
+ while (my $t = $tix->Next) { push @mails, $t->RequestorAddresses; }
+ is(@mails, 30, "found thirty tickets");
+ is_deeply( [grep {$_} @mails], [ sort grep {$_} @mails ], "Paging works (exclude nulls, which are db-dependant)");
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue'");
+ $tix->OrderByCols({ FIELD => "Requestor.EmailAddress" });
+ $tix->RowsPerPage(30);
+ my @mails;
+ while (my $t = $tix->Next) { push @mails, $t->RequestorAddresses; }
+ is(@mails, 30, "found thirty tickets");
+ is_deeply( [grep {$_} @mails], [ sort grep {$_} @mails ], "Paging works (exclude nulls, which are db-dependant)");
+}
+
+# vim:ft=perl:
diff --git a/rt/lib/t/regression/20savedsearch.t b/rt/lib/t/regression/20savedsearch.t
new file mode 100644
index 000000000..f4439f94e
--- /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 000000000..a0cecb2f3
--- /dev/null
+++ b/rt/lib/t/regression/21query-builder.t
@@ -0,0 +1,247 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 39;
+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();
+RT::Init();
+
+# create a regression queue if it doesn't exist
+{
+ my $queue = RT::Queue->new( $RT::SystemUser );
+ $queue->Load( 'Regression' );
+ if ( $queue->id ) {
+ ok(1, "queue 'Regression' exists - #". $queue->id );
+ } else {
+ $queue->Create( Name => 'Regression' );
+ ok($queue->id, "created queue 'Regression'");
+ }
+}
+
+# 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 {
+ $agent->form_name('BuildQuery');
+ # 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");
+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');
+is( getQueryFromForm, "( id > 1234 AND Status = 'stalled' ) OR Queue != 'Regression'", "added new one" );
+
+# click advanced, enter "C1 OR ( C2 AND C3 )", apply, aggregators should stay the same.
+{
+ my $response = $agent->get($url."Search/Edit.html");
+ ok( $response->is_success, "Fetched /Search/Edit.html" );
+ ok($agent->form_number(3), "found the form");
+ $agent->field("Query", "Status = 'new' OR ( Status = 'open' AND Subject LIKE 'office' )");
+ $agent->submit;
+ is( getQueryFromForm,
+ "Status = 'new' OR ( Status = 'open' AND Subject LIKE 'office' )",
+ "no aggregators change"
+ );
+}
+
+# - 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
+
+# }}}
+
+# create a custom field with nonascii name and try to add a condition
+{
+ my $cf = RT::CustomField->new( $RT::SystemUser );
+ $cf->LoadByName( Name => "\x{442}", Queue => 0 );
+ if ( $cf->id ) {
+ is($cf->Type, 'Freeform', 'loaded and type is correct');
+ } else {
+ my ($return, $msg) = $cf->Create(
+ Name => "\x{442}",
+ Queue => 0,
+ Type => 'Freeform',
+ );
+ ok($return, 'created CF') or diag "error: $msg";
+ }
+
+ my $response = $agent->get($url."Search/Build.html?NewQuery=1");
+ ok( $response->is_success, "Fetched " . $url."Search/Build.html" );
+
+ ok($agent->form_name('BuildQuery'), "found the form once");
+ $agent->field("ValueOf'CF.{\321\202}'", "\321\201");
+ $agent->submit();
+ is( getQueryFromForm,
+ "'CF.{\321\202}' LIKE '\321\201'",
+ "no changes, no duplicate condition with badly encoded text"
+ );
+
+ $cf->delete();
+}
+
+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 000000000..bec61b5ad
--- /dev/null
+++ b/rt/lib/t/regression/22search_tix_by_txn.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Test::More tests => 10;
+
+BEGIN{ $ENV{'TZ'} = 'GMT'};
+
+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);
+
diff --git a/rt/lib/t/regression/22search_tix_by_watcher.t b/rt/lib/t/regression/22search_tix_by_watcher.t
new file mode 100644
index 000000000..4dd11af1e
--- /dev/null
+++ b/rt/lib/t/regression/22search_tix_by_watcher.t
@@ -0,0 +1,228 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More tests => 79;
+use_ok('RT');
+RT::LoadConfig();
+RT::Init();
+use RT::Ticket;
+
+my $q = RT::Queue->new( $RT::SystemUser );
+my $queue = 'SearchTests-'. rand(200);
+$q->Create( Name => $queue );
+
+my ($total, @data, @tickets, %test) = (0, ());
+
+sub add_tix_from_data {
+ my @res = ();
+ while (@data) {
+ my $t = RT::Ticket->new($RT::SystemUser);
+ my ( $id, undef $msg ) = $t->Create(
+ Queue => $q->id,
+ %{ shift(@data) },
+ );
+ ok( $id, "ticket created" ) or diag("error: $msg");
+ push @res, $t;
+ $total++;
+ }
+ return @res;
+}
+
+sub run_tests {
+ my $query_prefix = join ' OR ', map 'id = '. $_->id, @tickets;
+ foreach my $key ( sort keys %test ) {
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL( "( $query_prefix ) AND ( $key )" );
+
+ my $error = 0;
+
+ my $count = 0;
+ $count++ foreach grep $_, values %{ $test{$key} };
+ is($tix->Count, $count, "found correct number of ticket(s) by '$key'") or $error = 1;
+
+ my $good_tickets = 1;
+ while ( my $ticket = $tix->Next ) {
+ next if $test{$key}->{ $ticket->Subject };
+ diag $ticket->Subject ." ticket has been found when it's not expected";
+ $good_tickets = 0;
+ }
+ ok( $good_tickets, "all tickets are good with '$key'" ) or $error = 1;
+
+ diag "Wrong SQL query for '$key':". $tix->BuildSelectQuery if $error;
+ }
+}
+
+@data = (
+ { Subject => 'xy', Requestor => ['x@example.com', 'y@example.com'] },
+ { Subject => 'x', Requestor => 'x@example.com' },
+ { Subject => 'y', Requestor => 'y@example.com' },
+ { Subject => '-', },
+ { Subject => 'z', Requestor => 'z@example.com' },
+);
+%test = (
+ 'Requestor = "x@example.com"' => { xy => 1, x => 1, y => 0, '-' => 0, z => 0 },
+ 'Requestor != "x@example.com"' => { xy => 0, x => 0, y => 1, '-' => 1, z => 1 },
+
+ 'Requestor = "y@example.com"' => { xy => 1, x => 0, y => 1, '-' => 0, z => 0 },
+ 'Requestor != "y@example.com"' => { xy => 0, x => 1, y => 0, '-' => 1, z => 1 },
+
+ 'Requestor LIKE "@example.com"' => { xy => 1, x => 1, y => 1, '-' => 0, z => 1 },
+ 'Requestor NOT LIKE "@example.com"' => { xy => 0, x => 0, y => 0, '-' => 1, z => 0 },
+
+ 'Requestor IS NULL' => { xy => 0, x => 0, y => 0, '-' => 1, z => 0 },
+ 'Requestor IS NOT NULL' => { xy => 1, x => 1, y => 1, '-' => 0, z => 1 },
+
+# this test is a todo, we run it later
+# 'Requestor = "x@example.com" AND Requestor = "y@example.com"' => { xy => 1, x => 0, y => 0, '-' => 0, z => 0 },
+ 'Requestor = "x@example.com" OR Requestor = "y@example.com"' => { xy => 1, x => 1, y => 1, '-' => 0, z => 0 },
+
+ 'Requestor != "x@example.com" AND Requestor != "y@example.com"' => { xy => 0, x => 0, y => 0, '-' => 1, z => 1 },
+ 'Requestor != "x@example.com" OR Requestor != "y@example.com"' => { xy => 0, x => 1, y => 1, '-' => 1, z => 1 },
+
+ 'Requestor = "x@example.com" AND Requestor != "y@example.com"' => { xy => 0, x => 1, y => 0, '-' => 0, z => 0 },
+ 'Requestor = "x@example.com" OR Requestor != "y@example.com"' => { xy => 1, x => 1, y => 0, '-' => 1, z => 1 },
+
+ 'Requestor != "x@example.com" AND Requestor = "y@example.com"' => { xy => 0, x => 0, y => 1, '-' => 0, z => 0 },
+ 'Requestor != "x@example.com" OR Requestor = "y@example.com"' => { xy => 1, x => 0, y => 1, '-' => 1, z => 1 },
+);
+@tickets = add_tix_from_data();
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue'");
+ is($tix->Count, $total, "found $total tickets");
+}
+run_tests();
+
+TODO: {
+ local $TODO = "we can't generate this query yet";
+ %test = (
+ 'Requestor = "x@example.com" AND Requestor = "y@example.com"'
+ => { xy => 1, x => 0, y => 0, '-' => 0, z => 0 },
+ );
+ run_tests();
+}
+
+@data = (
+ { Subject => 'xy', Cc => ['x@example.com'], Requestor => [ 'y@example.com' ] },
+ { Subject => 'x-', Cc => ['x@example.com'], Requestor => [] },
+ { Subject => '-y', Cc => [], Requestor => [ 'y@example.com' ] },
+ { Subject => '-', },
+ { Subject => 'zz', Cc => ['z@example.com'], Requestor => [ 'z@example.com' ] },
+ { Subject => 'z-', Cc => ['z@example.com'], Requestor => [] },
+ { Subject => '-z', Cc => [], Requestor => [ 'z@example.com' ] },
+);
+%test = (
+ 'Cc = "x@example.com" AND Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 0, '-y' => 0, '-' => 0, zz => 0, 'z-' => 0, '-z' => 0 },
+ 'Cc = "x@example.com" OR Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 1, '-y' => 1, '-' => 0, zz => 0, 'z-' => 0, '-z' => 0 },
+
+ 'Cc != "x@example.com" AND Requestor = "y@example.com"' =>
+ { xy => 0, 'x-' => 0, '-y' => 1, '-' => 0, zz => 0, 'z-' => 0, '-z' => 0 },
+ 'Cc != "x@example.com" OR Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 0, '-y' => 1, '-' => 1, zz => 1, 'z-' => 1, '-z' => 1 },
+
+ 'Cc IS NULL AND Requestor = "y@example.com"' =>
+ { xy => 0, 'x-' => 0, '-y' => 1, '-' => 0, zz => 0, 'z-' => 0, '-z' => 0 },
+ 'Cc IS NULL OR Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 0, '-y' => 1, '-' => 1, zz => 0, 'z-' => 0, '-z' => 1 },
+
+ 'Cc IS NOT NULL AND Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 0, '-y' => 0, '-' => 0, zz => 0, 'z-' => 0, '-z' => 0 },
+ 'Cc IS NOT NULL OR Requestor = "y@example.com"' =>
+ { xy => 1, 'x-' => 1, '-y' => 1, '-' => 0, zz => 1, 'z-' => 1, '-z' => 0 },
+);
+@tickets = add_tix_from_data();
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue'");
+ is($tix->Count, $total, "found $total tickets");
+}
+run_tests();
+
+# owner is special watcher because reference is duplicated in two places,
+# owner was an ENUM field now it's WATCHERFIELD, but should support old
+# style ENUM searches for backward compatibility
+my $nobody = RT::Nobody();
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner = '". $nobody->id ."'");
+ ok($tix->Count, "found ticket(s)");
+}
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner = '". $nobody->Name ."'");
+ ok($tix->Count, "found ticket(s)");
+}
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner != '". $nobody->id ."'");
+ is($tix->Count, 0, "found ticket(s)");
+}
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner != '". $nobody->Name ."'");
+ is($tix->Count, 0, "found ticket(s)");
+}
+
+{
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner.Name LIKE 'nob'");
+ ok($tix->Count, "found ticket(s)");
+}
+
+{
+ # create ticket and force type to not a 'ticket' value
+ # bug #6898@rt3.fsck.com
+ # and http://marc.theaimsgroup.com/?l=rt-devel&m=112662934627236&w=2
+ @data = ( { Subject => 'not a ticket' } );
+ my($t) = add_tix_from_data();
+ $t->_Set( Field => 'Type',
+ Value => 'not a ticket',
+ CheckACL => 0,
+ RecordTransaction => 0,
+ );
+ $total--;
+
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND Owner = 'Nobody'");
+ is($tix->Count, $total, "found ticket(s)");
+}
+
+{
+ my $everyone = RT::Group->new( $RT::SystemUser );
+ $everyone->LoadSystemInternalGroup('Everyone');
+ ok($everyone->id, "loaded 'everyone' group");
+ my($id, $msg) = $everyone->PrincipalObj->GrantRight( Right => 'OwnTicket',
+ Object => $q
+ );
+ ok($id, "granted OwnTicket right to Everyone on '$queue'") or diag("error: $msg");
+
+ my $u = RT::User->new( $RT::SystemUser );
+ $u->LoadOrCreateByEmail('alpha@example.com');
+ ok($u->id, "loaded user");
+ @data = ( { Subject => '4', Owner => $u->id } );
+ my($t) = add_tix_from_data();
+ is( $t->Owner, $u->id, "created ticket with custom owner" );
+ my $u_alpha_id = $u->id;
+
+ $u = RT::User->new( $RT::SystemUser );
+ $u->LoadOrCreateByEmail('bravo@example.com');
+ ok($u->id, "loaded user");
+ @data = ( { Subject => '5', Owner => $u->id } );
+ ($t) = add_tix_from_data();
+ is( $t->Owner, $u->id, "created ticket with custom owner" );
+ my $u_bravo_id = $u->id;
+
+ my $tix = RT::Tickets->new($RT::SystemUser);
+ $tix->FromSQL("Queue = '$queue' AND
+ ( Owner = '$u_alpha_id' OR
+ Owner = '$u_bravo_id' )"
+ );
+ is($tix->Count, 2, "found ticket(s)");
+}
+
+
+exit(0)
diff --git a/rt/lib/t/regression/23-batch-upload-csv.t b/rt/lib/t/regression/23-batch-upload-csv.t
new file mode 100644
index 000000000..fc9436a20
--- /dev/null
+++ b/rt/lib/t/regression/23-batch-upload-csv.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+use strict; use warnings;
+
+use Test::More qw/no_plan/;
+use_ok('RT');
+RT::LoadConfig();
+RT::Init();
+use_ok('RT::Action::CreateTickets');
+
+my $QUEUE = 'uploadtest-'.$$;
+
+my $queue_obj = RT::Queue->new($RT::SystemUser);
+$queue_obj->Create(Name => $QUEUE);
+
+my $cf = RT::CustomField->new($RT::SystemUser);
+my ($val,$msg) = $cf->Create(Name => 'Work Package-'.$$, Type => 'Freeform', LookupType => RT::Ticket->CustomFieldLookupType, MaxValues => 1);
+ok($cf->id);
+ok($val,$msg);
+($val, $msg) = $cf->AddToObject($queue_obj);
+ok($val,$msg);
+ok($queue_obj->TicketCustomFields()->Count, "We have a custom field, at least");
+
+
+my $data = <<EOF;
+id,Queue,Subject,Status,Requestor,@{[$cf->Name]}
+create-1,$QUEUE,hi,new,root,2.0
+create-2,$QUEUE,hello,new,root,3.0
+EOF
+
+my $action = RT::Action::CreateTickets->new(CurrentUser => RT::CurrentUser->new('root'));
+ok ($action->CurrentUser->id , "WE have a current user");
+
+$action->Parse(Content => $data);
+my @results = $action->CreateByTemplate();
+
+my $tix = RT::Tickets->new($RT::SystemUser);
+$tix->FromSQL ("Queue = '". $QUEUE."'");
+$tix->OrderBy( FIELD => 'id', ORDER => 'ASC' );
+ok($tix->Count);
+my $first = $tix->First();
+is($first->Subject(), 'hi');
+is($first->FirstCustomFieldValue($cf->id), '2.0');
+
+my $second = $tix->Next;
+is($second->Subject(), 'hello');
+is($second->FirstCustomFieldValue($cf->id), '3.0');
+1;
diff --git a/rt/lib/t/regression/23-web_attachments.t b/rt/lib/t/regression/23-web_attachments.t
new file mode 100644
index 000000000..adc38adb5
--- /dev/null
+++ b/rt/lib/t/regression/23-web_attachments.t
@@ -0,0 +1,60 @@
+#!/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 LogoFile => $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif';
+use constant FaviconFile => $RT::MasonComponentRoot .'/NoAuth/images/favicon.png';
+
+my $queue_name = 'General';
+
+my $m = Test::WWW::Mechanize->new;
+isa_ok($m, 'Test::WWW::Mechanize');
+
+$m->get_ok( $BaseURL."?user=root;pass=password" );
+$m->content_like(qr/Logout/, 'we did log in');
+
+my $qid;
+{
+ $m->content =~ /<SELECT\s+NAME\s*="Queue"\s*>.*?<OPTION\s+VALUE="(\d+)".*?>\s*\Q$queue_name\E\s*<\/OPTION>/msig;
+ ok( $qid = $1, "found id of the '$queue_name' queue");
+}
+
+$m->form_name('CreateTicketInQueue');
+$m->field('Queue', $qid);
+$m->submit;
+is($m->status, 200, "request successful");
+$m->content_like(qr/Create a new ticket/, 'ticket create page');
+
+$m->form_name('TicketCreate');
+$m->field('Subject', 'Attachments test');
+$m->field('Attach', LogoFile);
+$m->field('Content', 'Some content');
+$m->submit;
+is($m->status, 200, "request successful");
+
+$m->content_like(qr/Attachments test/, 'we have subject on the page');
+$m->content_like(qr/Some content/, 'and content');
+$m->content_like(qr/Download bplogo\.gif/, 'page has file name');
+
+$m->follow_link_ok({text => 'Reply'}, "reply to the ticket");
+$m->form_name('TicketUpdate');
+$m->field('Attach', LogoFile);
+$m->click('AddMoreAttach');
+is($m->status, 200, "request successful");
+
+$m->form_name('TicketUpdate');
+$m->field('Attach', FaviconFile);
+$m->field('UpdateContent', 'Message');
+$m->click('SubmitTicket');
+is($m->status, 200, "request successful");
+
+$m->content_like(qr/Download bplogo\.gif/, 'page has file name');
+$m->content_like(qr/Download favicon\.png/, 'page has file name');
+
diff --git a/rt/lib/t/regression/23cfsort.t b/rt/lib/t/regression/23cfsort.t
new file mode 100644
index 000000000..85decc707
--- /dev/null
+++ b/rt/lib/t/regression/23cfsort.t
@@ -0,0 +1,192 @@
+#!/usr/bin/perl
+
+use Test::More tests => 21;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+use strict;
+use warnings;
+
+use RT::Tickets;
+use RT::Queue;
+use RT::CustomField;
+
+my($ret,$msg);
+
+
+# Test Sorting by custom fields.
+
+# ---- Create a queue to test with.
+my $queue = "CFSortQueue-$$";
+my $queue_obj = RT::Queue->new( $RT::SystemUser );
+($ret, $msg) = $queue_obj->Create(
+ Name => $queue,
+ Description => 'queue for custom field sort testing'
+);
+ok($ret, "$queue test queue creation. $msg");
+
+# ---- Create some custom fields. We're not currently using all of
+# them to test with, but the more the merrier.
+my $cfO = RT::CustomField->new($RT::SystemUser);
+my $cfA = RT::CustomField->new($RT::SystemUser);
+my $cfB = RT::CustomField->new($RT::SystemUser);
+my $cfC = RT::CustomField->new($RT::SystemUser);
+
+($ret, $msg) = $cfO->Create( Name => 'Order',
+ Queue => 0,
+ SortOrder => 1,
+ Description => q{Something to compare results for, since we can't guarantee ticket ID},
+ Type=> 'FreeformSingle');
+ok($ret, "Custom Field Order created");
+
+($ret, $msg) = $cfA->Create( Name => 'Alpha',
+ Queue => $queue_obj->id,
+ SortOrder => 1,
+ Description => 'A Testing custom field',
+ Type=> 'FreeformSingle');
+ok($ret, "Custom Field Alpha created");
+
+($ret, $msg) = $cfB->Create( Name => 'Beta',
+ Queue => $queue_obj->id,
+ Description => 'A Testing custom field',
+ Type=> 'FreeformSingle');
+ok($ret, "Custom Field Beta created");
+
+($ret, $msg) = $cfC->Create( Name => 'Charlie',
+ Queue => $queue_obj->id,
+ Description => 'A Testing custom field',
+ Type=> 'FreeformSingle');
+ok($ret, "Custom Field Charlie created");
+
+# ----- Create some tickets to test with. Assign them some values to
+# make it easy to sort with.
+my $t1 = RT::Ticket->new($RT::SystemUser);
+$t1->Create( Queue => $queue_obj->Id,
+ Subject => 'One',
+ );
+$t1->AddCustomFieldValue(Field => $cfO->Id, Value => '1');
+$t1->AddCustomFieldValue(Field => $cfA->Id, Value => '2');
+$t1->AddCustomFieldValue(Field => $cfB->Id, Value => '1');
+$t1->AddCustomFieldValue(Field => $cfC->Id, Value => 'BBB');
+
+my $t2 = RT::Ticket->new($RT::SystemUser);
+$t2->Create( Queue => $queue_obj->Id,
+ Subject => 'Two',
+ );
+$t2->AddCustomFieldValue(Field => $cfO->Id, Value => '2');
+$t2->AddCustomFieldValue(Field => $cfA->Id, Value => '1');
+$t2->AddCustomFieldValue(Field => $cfB->Id, Value => '2');
+$t2->AddCustomFieldValue(Field => $cfC->Id, Value => 'AAA');
+
+# helper
+sub check_order {
+ my ($tx, @order) = @_;
+ my @results;
+ while (my $t = $tx->Next) {
+ push @results, $t->CustomFieldValues($cfO->Id)->First->Content;
+ }
+ my $results = join (" ",@results);
+ my $order = join(" ",@order);
+ @_ = ($results, $order , "Ordered correctly: $order");
+ goto \&is;
+}
+
+# The real tests start here
+my $tx = new RT::Tickets( $RT::SystemUser );
+
+
+# Make sure we can sort in both directions on a queue specific field.
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderBy( FIELD => "CF.${queue}.{Charlie}", ORDER => 'DES' );
+is($tx->Count,2 ,"We found 2 tickets when lookign for cf charlie");
+check_order( $tx, 1, 2);
+
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderBy( FIELD => "CF.${queue}.{Charlie}", ORDER => 'ASC' );
+is($tx->Count,2, "We found two tickets when sorting by cf charlie without limiting to it" );
+check_order( $tx, 2, 1);
+
+# When ordering by _global_ CustomFields, if more than one queue has a
+# CF named Charlie, things will go bad. So, these results are uniqued
+# in Tickets_Overlay.
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderBy( FIELD => "CF.{Charlie}", ORDER => 'DESC' );
+diag $tx->BuildSelectQuery;
+is($tx->Count,2);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 1, 2);
+}
+
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderBy( FIELD => "CF.{Charlie}", ORDER => 'ASC' );
+diag $tx->BuildSelectQuery;
+is($tx->Count,2);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 2, 1);
+}
+
+# Add a new ticket, to test sorting on multiple columns.
+my $t3 = RT::Ticket->new($RT::SystemUser);
+$t3->Create( Queue => $queue_obj->Id,
+ Subject => 'Three',
+ );
+$t3->AddCustomFieldValue(Field => $cfO->Id, Value => '3');
+$t3->AddCustomFieldValue(Field => $cfA->Id, Value => '3');
+$t3->AddCustomFieldValue(Field => $cfB->Id, Value => '2');
+$t3->AddCustomFieldValue(Field => $cfC->Id, Value => 'AAA');
+
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderByCols(
+ { FIELD => "CF.${queue}.{Charlie}", ORDER => 'ASC' },
+ { FIELD => "CF.${queue}.{Alpha}", ORDER => 'DES' },
+);
+is($tx->Count,3);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 3, 2, 1);
+}
+
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderByCols(
+ { FIELD => "CF.${queue}.{Charlie}", ORDER => 'DES' },
+ { FIELD => "CF.${queue}.{Alpha}", ORDER => 'ASC' },
+);
+is($tx->Count,3);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 1, 2, 3);
+}
+
+# Reverse the order of the secondary column, which changes the order
+# of the first two tickets.
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderByCols(
+ { FIELD => "CF.${queue}.{Charlie}", ORDER => 'ASC' },
+ { FIELD => "CF.${queue}.{Alpha}", ORDER => 'ASC' },
+);
+is($tx->Count,3);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 2, 3, 1);
+}
+
+$tx = new RT::Tickets( $RT::SystemUser );
+$tx->FromSQL(qq[queue="$queue"] );
+$tx->OrderByCols(
+ { FIELD => "CF.${queue}.{Charlie}", ORDER => 'DES' },
+ { FIELD => "CF.${queue}.{Alpha}", ORDER => 'DES' },
+);
+is($tx->Count,3);
+TODO: {
+ local $TODO = 'order by CF fail';
+check_order( $tx, 1, 3, 2);
+}
diff --git a/rt/lib/t/regression/24pawsort.t b/rt/lib/t/regression/24pawsort.t
new file mode 100644
index 000000000..665c325a6
--- /dev/null
+++ b/rt/lib/t/regression/24pawsort.t
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+use strict;
+use warnings;
+
+use RT::Tickets;
+use RT::Queue;
+use RT::CustomField;
+
+my($ret,$msg);
+
+# Test Paw Sort
+
+
+
+# ---- Create a queue to test with.
+my $queue = "PAWSortQueue-$$";
+my $queue_obj = RT::Queue->new($RT::SystemUser);
+($ret, $msg) = $queue_obj->Create(Name => $queue,
+ Description => 'queue for custom field sort testing');
+ok($ret, "$queue test queue creation. $msg");
+
+
+# ---- Create some users
+
+my $me = RT::User->new($RT::SystemUser);
+($ret, $msg) = $me->Create(Name => "Me$$", EmailAddress => $$.'create-me-1@example.com');
+($ret, $msg) = $me->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'OwnTicket');
+($ret, $msg) = $me->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'SeeQueue');
+($ret, $msg) = $me->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'ShowTicket');
+my $you = RT::User->new($RT::SystemUser);
+($ret, $msg) = $you->Create(Name => "You$$", EmailAddress => $$.'create-you-1@example.com');
+($ret, $msg) = $you->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'OwnTicket');
+($ret, $msg) = $you->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'SeeQueue');
+($ret, $msg) = $you->PrincipalObj->GrantRight(Object =>$queue_obj, Right => 'ShowTicket');
+
+my $nobody = RT::User->new($RT::SystemUser);
+$nobody->Load('nobody');
+
+
+# ----- Create some tickets to test with. Assign them some values to
+# make it easy to sort with.
+
+my @tickets = (
+ [qw[1 10], $me],
+ [qw[2 20], $me],
+ [qw[3 20], $you],
+ [qw[4 30], $you],
+ [qw[5 5], $nobody],
+ [qw[6 55], $nobody],
+ );
+for (@tickets) {
+ my $t = RT::Ticket->new($RT::SystemUser);
+ $t->Create( Queue => $queue_obj->Id,
+ Subject => $_->[0],
+ Owner => $_->[2]->Id,
+ Priority => $_->[1],
+ );
+}
+
+sub check_order {
+ my ($tx, @order) = @_;
+ my @results;
+ while (my $t = $tx->Next) {
+ push @results, $t->Subject;
+ }
+ my $results = join (" ",@results);
+ my $order = join(" ",@order);
+ is( $results, $order );
+}
+
+
+# The real tests start here
+
+my $cme = new RT::CurrentUser( $me );
+my $metx = new RT::Tickets( $cme );
+# Make sure we can sort in both directions on a queue specific field.
+$metx->FromSQL(qq[queue="$queue"] );
+$metx->OrderBy( FIELD => "Custom.Ownership", ORDER => 'ASC' );
+is($metx->Count,6);
+check_order( $metx, qw[2 1 6 5 4 3]);
+
+$metx->OrderBy( FIELD => "Custom.Ownership", ORDER => 'DESC' );
+is($metx->Count,6);
+check_order( $metx, reverse qw[2 1 6 5 4 3]);
+
+
+
+my $cyou = new RT::CurrentUser( $you );
+my $youtx = new RT::Tickets( $cyou );
+# Make sure we can sort in both directions on a queue specific field.
+$youtx->FromSQL(qq[queue="$queue"] );
+$youtx->OrderBy( FIELD => "Custom.Ownership", ORDER => 'ASC' );
+is($youtx->Count,6);
+check_order( $youtx, qw[4 3 6 5 2 1]);
+
+__END__
+
+
diff --git a/rt/lib/t/regression/25scrip_order.t b/rt/lib/t/regression/25scrip_order.t
new file mode 100644
index 000000000..0e11989e6
--- /dev/null
+++ b/rt/lib/t/regression/25scrip_order.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 7;
+
+use RT;
+RT::LoadConfig();
+RT::Init;
+
+# {{{ test scrip ordering based on description
+
+my $scrip_queue = RT::Queue->new($RT::SystemUser);
+my ($queue_id, $msg) = $scrip_queue->Create( Name => "ScripOrdering-$$",
+ Description => 'Test scrip ordering by description' );
+ok($queue_id, "Created scrip-ordering test queue? ".$msg);
+
+my $priority_ten_scrip = RT::Scrip->new($RT::SystemUser);
+(my $id, $msg) = $priority_ten_scrip->Create(
+ Description => "10 set priority $$",
+ Queue => $queue_id,
+ ScripCondition => 'On Create',
+ ScripAction => 'User Defined',
+ CustomPrepareCode => '$RT::Logger->debug("Setting priority to 10..."); return 1;',
+ CustomCommitCode => '$self->TicketObj->SetPriority(10);',
+ Template => 'Blank',
+ Stage => 'TransactionCreate',
+);
+ok($id, "Created priority-10 scrip? ".$msg);
+
+my $priority_five_scrip = RT::Scrip->new($RT::SystemUser);
+($id, $msg) = $priority_ten_scrip->Create(
+ Description => "05 set priority $$",
+ Queue => $queue_id,
+ ScripCondition => 'On Create',
+ ScripAction => 'User Defined',
+ CustomPrepareCode => '$RT::Logger->debug("Setting priority to 5..."); return 1;',
+ CustomCommitCode => '$self->TicketObj->SetPriority(5);',
+ Template => 'Blank',
+ Stage => 'TransactionCreate',
+);
+ok($id, "Created priority-5 scrip? ".$msg);
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+($id, $msg) = $ticket->Create(
+ Queue => $queue_id,
+ Requestor => 'order@example.com',
+ Subject => "Scrip order test $$",
+);
+ok($ticket->id, "Created ticket? id=$id");
+
+ok($ticket->Priority != 0, "Ticket shouldn't be priority 0");
+ok($ticket->Priority != 5, "Ticket shouldn't be priority 5");
+ok($ticket->Priority == 10, "Ticket should be priority 10");
+
+# }}}
+
+1;
diff --git a/rt/lib/t/regression/26command_line.t b/rt/lib/t/regression/26command_line.t
new file mode 100644
index 000000000..457c63aa5
--- /dev/null
+++ b/rt/lib/t/regression/26command_line.t
@@ -0,0 +1,445 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::Expect;
+#use Test::More qw/no_plan/;
+use Test::More tests => 218;
+
+use RT;
+RT::LoadConfig();
+RT::Init;
+
+use RT::User;
+use RT::Queue;
+
+my $rt_tool_path = "$RT::BinPath/rt";
+
+# {{{ test configuration options
+
+# config directives:
+# (in $CWD/.rtrc)
+# - server <URL> URL to RT server.
+# - user <username> RT username.
+# - passwd <passwd> RT user's password.
+# - query <RT Query> Default RT Query for list action
+# - orderby <order> Default RT order for list action
+#
+# Blank and #-commented lines are ignored.
+
+# environment variables
+# The following environment variables override any corresponding
+# values defined in configuration files:
+#
+# - RTUSER
+$ENV{'RTUSER'} = 'root';
+# - RTPASSWD
+$ENV{'RTPASSWD'} = 'password';
+# - RTSERVER
+$RT::Logger->debug("Connecting to server at $RT::WebBaseURL...");
+$ENV{'RTSERVER'} = $RT::WebBaseURL;
+# - RTDEBUG Numeric debug level. (Set to 3 for full logs.)
+$ENV{'RTDEBUG'} = '1';
+# - RTCONFIG Specifies a name other than ".rtrc" for the
+# configuration file.
+#
+# - RTQUERY Default RT Query for rt list
+# - RTORDERBY Default order for rt list
+
+
+# }}}
+
+# {{{ test ticket manipulation
+
+# create a ticket
+expect_run(
+ command => "$rt_tool_path shell",
+ prompt => 'rt> ',
+ quit => 'quit',
+);
+expect_send(q{create -t ticket set subject='new ticket' add cc=foo@example.com}, "Creating a ticket...");
+expect_like(qr/Ticket \d+ created/, "Created the ticket");
+expect_handle->before() =~ /Ticket (\d+) created/;
+my $ticket_id = $1;
+ok($ticket_id, "Got ticket id=$ticket_id");
+expect_send(q{create -t ticket set subject='new ticket'}, "Creating a ticket as just a subject...");
+expect_like(qr/Ticket \d+ created/, "Created the ticket");
+
+# make sure we can request things as 'rt foo'
+expect_send(q{rt create -t ticket set subject='rt ticket'}, "Creating a ticket with 'rt create'...");
+expect_like(qr/Ticket \d+ created/, "Created the ticket");
+
+# {{{ test queue manipulation
+
+# creating queues
+expect_send("create -t queue set Name='NewQueue$$'", 'Creating a queue...');
+expect_like(qr/Queue \d+ created/, 'Created the queue');
+expect_handle->before() =~ /Queue (\d+) created/;
+my $queue_id = $1;
+ok($queue_id, "Got queue id=$queue_id");
+# updating users
+expect_send("edit queue/$queue_id set Name='EditedQueue$$'", 'Editing the queue');
+expect_like(qr/Queue $queue_id updated/, 'Edited the queue');
+expect_send("show queue/$queue_id", 'Showing the queue...');
+expect_like(qr/id: queue\/$queue_id/, 'Saw the queue');
+expect_like(qr/Name: EditedQueue$$/, 'Saw the modification');
+TODO: {
+ todo_skip "Listing non-ticket items doesn't work", 2;
+ expect_send("list -t queue 'id > 0'", 'Listing the queues...');
+ expect_like(qr/$queue_id: EditedQueue$$/, 'Found the queue');
+}
+
+# }}}
+
+
+# Set up a custom field for editing tests
+my $cf = RT::CustomField->new($RT::SystemUser);
+my ($val,$msg) = $cf->Create(Name => 'MyCF'.$$, Type => 'FreeformSingle', Queue => $queue_id);
+ok($val,$msg);
+
+my $othercf = RT::CustomField->new($RT::SystemUser);
+($val,$msg) = $othercf->Create(Name => 'My CF'.$$, Type => 'FreeformSingle', Queue => $queue_id);
+ok($val,$msg);
+
+
+
+# add a comment to ticket
+ expect_send("comment -m 'comment-$$' $ticket_id", "Adding a comment...");
+ expect_like(qr/Message recorded/, "Added the comment");
+ ### should test to make sure it actually got added
+ # add correspondance to ticket (?)
+ expect_send("correspond -m 'correspond-$$' $ticket_id", "Adding correspondence...");
+ expect_like(qr/Message recorded/, "Added the correspondence");
+ ### should test to make sure it actually got added
+
+ # add attachments to a ticket
+ # text attachment
+ check_attachment("$RT::BasePath/lib/t/data/lorem-ipsum");
+ # binary attachment
+ check_attachment($RT::MasonComponentRoot.'/NoAuth/images/bplogo.gif');
+
+# change a ticket's Owner
+expect_send("edit ticket/$ticket_id set owner=root", 'Changing owner...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed owner');
+expect_send("show ticket/$ticket_id -f owner", 'Verifying change...');
+expect_like(qr/Owner: root/, 'Verified change');
+# change a ticket's Requestor
+expect_send("edit ticket/$ticket_id set requestors=foo\@example.com", 'Changing Requestor...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed Requestor');
+expect_send("show ticket/$ticket_id -f requestors", 'Verifying change...');
+expect_like(qr/Requestors: foo\@example.com/, 'Verified change');
+# change a ticket's Cc
+expect_send("edit ticket/$ticket_id set cc=bar\@example.com", 'Changing Cc...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed Cc');
+expect_send("show ticket/$ticket_id -f cc", 'Verifying change...');
+expect_like(qr/Cc: bar\@example.com/, 'Verified change');
+# change a ticket's priority
+expect_send("edit ticket/$ticket_id set priority=10", 'Changing priority...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed priority');
+expect_send("show ticket/$ticket_id -f priority", 'Verifying change...');
+expect_like(qr/Priority: 10/, 'Verified change');
+# move a ticket to a different queue
+expect_send("edit ticket/$ticket_id set queue=EditedQueue$$", 'Changing queue...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed queue');
+expect_send("show ticket/$ticket_id -f queue", 'Verifying change...');
+expect_like(qr/Queue: EditedQueue$$/, 'Verified change');
+# cannot move ticket to a nonexistent queue
+expect_send("edit ticket/$ticket_id set queue=nonexistent-$$", 'Changing to nonexistent queue...');
+expect_like(qr/queue does not exist/i, 'Errored out');
+expect_send("show ticket/$ticket_id -f queue", 'Verifying lack of change...');
+expect_like(qr/Queue: EditedQueue$$/, 'Verified lack of change');
+
+# Test reading and setting custom fields without spaces
+expect_send("show ticket/$ticket_id -f CF-myCF$$", 'Checking initial value');
+expect_like(qr/CF-myCF$$:/i, 'Verified initial empty value');
+expect_send("edit ticket/$ticket_id set 'CF-myCF$$=VALUE' ", 'Changing CF...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed cf');
+expect_send("show ticket/$ticket_id -f CF-myCF$$", 'Checking new value');
+expect_like(qr/CF-myCF$$: VALUE/i, 'Verified change');
+# Test reading and setting custom fields with spaces
+expect_send("show ticket/$ticket_id -f 'CF-my CF$$'", 'Checking initial value');
+expect_like(qr/my CF$$:/i, 'Verified change');
+expect_send("edit ticket/$ticket_id set 'CF-my CF$$=VALUE' ", 'Changing CF...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed cf');
+expect_send("show ticket/$ticket_id -f 'CF-my CF$$'", 'Checking new value');
+expect_like(qr/my CF$$: VALUE/i, 'Verified change');
+expect_send("ls 'id = $ticket_id' -f 'CF-my CF$$'", 'Checking new value');
+expect_like(qr/my CF$$: VALUE/i, 'Verified change');
+
+# ...
+# change a ticket's ...[other properties]...
+# ...
+# stall a ticket
+expect_send("edit ticket/$ticket_id set status=stalled", 'Changing status to "stalled"...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed status');
+expect_send("show ticket/$ticket_id -f status", 'Verifying change...');
+expect_like(qr/Status: stalled/, 'Verified change');
+# resolve a ticket
+expect_send("edit ticket/$ticket_id set status=resolved", 'Changing status to "resolved"...');
+expect_like(qr/Ticket $ticket_id updated/, 'Changed status');
+expect_send("show ticket/$ticket_id -f status", 'Verifying change...');
+expect_like(qr/Status: resolved/, 'Verified change');
+# try to set status to an illegal value
+expect_send("edit ticket/$ticket_id set status=quux", 'Changing status to an illegal value...');
+expect_like(qr/illegal value/i, 'Errored out');
+expect_send("show ticket/$ticket_id -f status", 'Verifying lack of change...');
+expect_like(qr/Status: resolved/, 'Verified change');
+
+# }}}
+
+# {{{ display
+
+# show ticket list
+expect_send("ls -s -t ticket -o +id \"Status='resolved'\"", 'Listing resolved tickets...');
+expect_like(qr/$ticket_id: new ticket/, 'Found our ticket');
+# show ticket list verbosely
+expect_send("ls -l -t ticket -o +id \"Status='resolved'\"", 'Listing resolved tickets verbosely...');
+expect_like(qr/id: ticket\/$ticket_id/, 'Found our ticket');
+# show ticket
+expect_send("show -t ticket $ticket_id", 'Showing our ticket...');
+expect_like(qr/id: ticket\/$ticket_id/, 'Got our ticket');
+# show ticket history
+expect_send("show ticket/$ticket_id/history", 'Showing our ticket\'s history...');
+expect_like(qr/Ticket created by root/, 'Got our history');
+TODO: {
+ local $TODO = "Cannot show verbose ticket history right now";
+ # show ticket history verbosely
+ expect_send("show -v ticket/$ticket_id/history", 'Showing our ticket\'s history verbosely...');
+ expect_like(qr/Ticket created by root/, 'Got our history');
+}
+# get attachments from a ticket
+expect_send("show ticket/$ticket_id/attachments", 'Showing ticket attachments...');
+expect_like(qr/id: ticket\/$ticket_id\/attachments/, 'Got our ticket\'s attachments');
+expect_like(qr/Attachments: \d+:\s*\(\S+ \/ \d+\w+\)/, 'Our ticket has an attachment');
+expect_handle->before() =~ /Attachments: (\d+):\s*\((\S+)/;
+my $attachment_id = $1;
+my $attachment_type = $2;
+ok($attachment_id, "Got attachment id=$attachment_id $attachment_type");
+expect_send("show ticket/$ticket_id/attachments/$attachment_id", "Showing attachment $attachment_id...");
+expect_like(qr/ContentType: $attachment_type/, 'Got the attachment');
+
+# }}}
+
+# {{{ test user manipulation
+
+# creating users
+expect_send("create -t user set Name='NewUser$$' EmailAddress='fbar$$\@example.com'", 'Creating a user...');
+expect_like(qr/User \d+ created/, 'Created the user');
+expect_handle->before() =~ /User (\d+) created/;
+my $user_id = $1;
+ok($user_id, "Got user id=$user_id");
+# updating users
+expect_send("edit user/$user_id set Name='EditedUser$$'", 'Editing the user');
+expect_like(qr/User $user_id updated/, 'Edited the user');
+expect_send("show user/$user_id", 'Showing the user...');
+expect_like(qr/id: user\/$user_id/, 'Saw the user');
+expect_like(qr/Name: EditedUser$$/, 'Saw the modification');
+TODO: {
+ todo_skip "Listing non-ticket items doesn't work", 2;
+ expect_send("list -t user 'id > 0'", 'Listing the users...');
+ expect_like(qr/$user_id: EditedUser$$/, 'Found the user');
+}
+
+# }}}
+
+# {{{ test group manipulation
+
+TODO: {
+todo_skip "Group manipulation doesn't work right now", 8;
+# creating groups
+expect_send("create -t group set Name='NewGroup$$'", 'Creating a group...');
+expect_like(qr/Group \d+ created/, 'Created the group');
+expect_handle->before() =~ /Group (\d+) created/;
+my $group_id = $1;
+ok($group_id, "Got group id=$group_id");
+# updating groups
+expect_send("edit group/$group_id set Name='EditedGroup$$'", 'Editing the group');
+expect_like(qr/Group $group_id updated/, 'Edited the group');
+expect_send("show group/$group_id", 'Showing the group...');
+expect_like(qr/id: group\/$group_id/, 'Saw the group');
+expect_like(qr/Name: EditedGroup$$/, 'Saw the modification');
+TODO: {
+ local $TODO = "Listing non-ticket items doesn't work";
+ expect_send("list -t group 'id > 0'", 'Listing the groups...');
+ expect_like(qr/$group_id: EditedGroup$$/, 'Found the group');
+}
+}
+
+# }}}
+
+TODO: {
+todo_skip "Custom field manipulation not yet implemented", 8;
+# {{{ test custom field manipulation
+
+# creating custom fields
+expect_send("create -t custom_field set Name='NewCF$$'", 'Creating a custom field...');
+expect_like(qr/Custom Field \d+ created/, 'Created the custom field');
+expect_handle->before() =~ /Custom Field (\d+) created/;
+my $cf_id = $1;
+ok($cf_id, "Got custom field id=$cf_id");
+# updating custom fields
+expect_send("edit cf/$cf_id set Name='EditedCF$$'", 'Editing the custom field');
+expect_like(qr/Custom field $cf_id updated/, 'Edited the custom field');
+expect_send("show cf/$cf_id", 'Showing the queue...');
+expect_like(qr/id: custom_field\/$cf_id/, 'Saw the custom field');
+expect_like(qr/Name: EditedCF$$/, 'Saw the modification');
+TODO: {
+ todo_skip "Listing non-ticket items doesn't work", 2;
+ expect_send("list -t custom_field 'id > 0'", 'Listing the CFs...');
+ expect_like(qr/$cf_id: EditedCF$$/, 'Found the custom field');
+}
+}
+
+# }}}
+
+# {{{ test merging tickets
+expect_send("create -t ticket set subject='CLIMergeTest1-$$'", 'Creating first ticket to merge...');
+expect_like(qr/Ticket \d+ created/, 'Created first ticket');
+expect_handle->before() =~ /Ticket (\d+) created/;
+my $merge_ticket_A = $1;
+ok($merge_ticket_A, "Got first ticket to merge id=$merge_ticket_A");
+expect_send("create -t ticket set subject='CLIMergeTest2-$$'", 'Creating second ticket to merge...');
+expect_like(qr/Ticket \d+ created/, 'Created second ticket');
+expect_handle->before() =~ /Ticket (\d+) created/;
+my $merge_ticket_B = $1;
+ok($merge_ticket_B, "Got second ticket to merge id=$merge_ticket_B");
+expect_send("merge $merge_ticket_B $merge_ticket_A", 'Merging the tickets...');
+expect_like(qr/Merge completed/, 'Merged the tickets');
+expect_send("show ticket/$merge_ticket_A/history", 'Checking merge on first ticket');
+expect_like(qr/Merged into ticket #$merge_ticket_A by root/, 'Merge recorded in first ticket');
+expect_send("show ticket/$merge_ticket_B/history", 'Checking merge on second ticket');
+expect_like(qr/Merged into ticket #$merge_ticket_A by root/, 'Merge recorded in second ticket');
+# }}}
+
+# {{{ test taking/stealing tickets
+{
+ # create a user; give them privileges to take and steal
+ ### TODO: implement 'grant' in the CLI tool; use that here instead.
+ ### this breaks the abstraction barrier, like, a lot.
+ my $steal_user = RT::User->new($RT::SystemUser);
+ my ($steal_user_id, $msg) = $steal_user->Create( Name => "fooser$$",
+ EmailAddress => "fooser$$\@localhost",
+ Privileged => 1,
+ Password => 'foobar',
+ );
+ ok($steal_user_id, "Created the user? $msg");
+ my $steal_queue = RT::Queue->new($RT::SystemUser);
+ my $steal_queue_id;
+ ($steal_queue_id, $msg) = $steal_queue->Create( Name => "Steal$$" );
+ ok($steal_queue_id, "Got the queue? $msg");
+ ok($steal_queue->id, "queue obj has id");
+ my $status;
+ ($status, $msg) = $steal_user->PrincipalObj->GrantRight( Right => 'ShowTicket', Object => $steal_queue );
+ ok($status, "Gave 'SeeTicket' to our user? $msg");
+ ($status, $msg) = $steal_user->PrincipalObj->GrantRight( Right => 'OwnTicket', Object => $steal_queue );
+ ok($status, "Gave 'OwnTicket' to our user? $msg");
+ ($status, $msg) = $steal_user->PrincipalObj->GrantRight( Right => 'StealTicket', Object => $steal_queue );
+ ok($status, "Gave 'StealTicket' to our user? $msg");
+ ($status, $msg) = $steal_user->PrincipalObj->GrantRight( Right => 'TakeTicket', Object => $steal_queue );
+ ok($status, "Gave 'TakeTicket' to our user? $msg");
+
+ # create a ticket to take/steal
+ expect_send("create -t ticket set queue=$steal_queue_id subject='CLIStealTest-$$'", 'Creating ticket to steal...');
+ expect_like(qr/Ticket \d+ created/, 'Created ticket');
+ expect_handle->before() =~ /Ticket (\d+) created/;
+ my $steal_ticket_id = $1;
+ ok($steal_ticket_id, "Got ticket to steal id=$steal_ticket_id");
+
+ # root takes the ticket
+ expect_send("take $steal_ticket_id", 'root takes the ticket...');
+ expect_like(qr/Owner changed from Nobody to root/, 'root took the ticket');
+
+ # log in as the non-root user
+ #expect_quit(); # this is apparently unnecessary, but I'll leave it in
+ # until I'm sure
+ $ENV{'RTUSER'} = "fooser$$";
+ $ENV{'RTPASSWD'} = 'foobar';
+ expect_run( command => "$rt_tool_path shell", prompt => 'rt> ', quit => 'quit',);
+
+ # user tries to take the ticket, fails
+ # shouldn't be able to 'take' a ticket which someone else has taken out from
+ # under you; that should produce an error. should have to explicitly
+ # 'steal' it back from them. 'steal' can automatically 'take' a ticket,
+ # though.
+ expect_send("take $steal_ticket_id", 'user tries to take the ticket...');
+ expect_like(qr/You can only take tickets that are unowned/, '...and fails.');
+ expect_send("show ticket/$steal_ticket_id -f owner", 'Double-checking...');
+ expect_like(qr/Owner: root/, '...no change.');
+
+ # user steals the ticket
+ expect_send("steal $steal_ticket_id", 'user tries to *steal* the ticket...');
+ expect_like(qr/Owner changed from root to fooser$$/, '...and succeeds!');
+ expect_send("show ticket/$steal_ticket_id -f owner", 'Double-checking...');
+ expect_like(qr/Owner: fooser$$/, '...yup, it worked.');
+
+ # log back in as root
+ #expect_quit(); # ditto
+ $ENV{'RTUSER'} = 'root';
+ $ENV{'RTPASSWD'} = 'password';
+ expect_run( command => "$rt_tool_path shell", prompt => 'rt> ', quit => 'quit',);
+
+ # root steals the ticket back
+ expect_send("steal $steal_ticket_id", 'root steals the ticket back...');
+ expect_like(qr/Owner changed from fooser$$ to root/, '...and succeeds.');
+}
+# }}}
+
+# {{{ test ticket linking
+ my @link_relns = ( 'DependsOn', 'DependedOnBy', 'RefersTo', 'ReferredToBy',
+ 'MemberOf', 'HasMember', );
+ my %display_relns = map { $_ => $_ } @link_relns;
+ $display_relns{HasMember} = 'Members';
+
+ my $link1_id = ok_create_ticket( "LinkTicket1-$$" );
+ my $link2_id = ok_create_ticket( "LinkTicket2-$$" );
+
+ foreach my $reln (@link_relns) {
+ # create link
+ expect_send("link $link1_id $reln $link2_id", "Link by $reln...");
+ expect_like(qr/Created link $link1_id $reln $link2_id/, 'Linked');
+ expect_send("show ticket/$link1_id/links", "Checking creation of $reln...");
+ expect_like(qr/$display_relns{reln}: [\w\d\.\-]+:\/\/[\w\d\.]+\/ticket\/$link2_id/, "Created link $reln");
+
+ # delete link
+ expect_send("link -d $link1_id $reln $link2_id", "Delete $reln...");
+ expect_like(qr/Deleted link $link1_id $reln $link2_id/, 'Deleted');
+ expect_send("show ticket/$link1_id/links", "Checking removal of $reln...");
+ ok( expect_handle->before() !~ /\Q$display_relns{$reln}: \E[\w\d\.\-]+:\/\/[w\d\.]+\/ticket\/$link2_id/, "Removed link $reln" );
+ #expect_unlike(qr/\Q$reln: \E[\w\d\.]+\Q://\E[w\d\.]+\/ticket\/$link2_id/, "Removed link $reln");
+
+ }
+# }}}
+
+
+# helper function
+sub ok_create_ticket {
+ my $subject = shift;
+
+ expect_send("create -t ticket set subject='$subject'", 'Creating ticket...');
+ expect_like(qr/Ticket \d+ created/, "Created ticket '$subject'");
+ expect_handle->before() =~ /Ticket (\d+) created/;
+ my $id = $1;
+ ok($id, "Got ticket id=$id");
+
+ return $id;
+}
+
+# wrap up all the file handling stuff for attachment testing
+sub check_attachment {
+ my $attachment_path = shift;
+ (my $filename = $attachment_path) =~ s/.*\/(.*?)$/$1/;
+ expect_send("comment -m 'attach file' -a $attachment_path $ticket_id", "Adding an attachment ($filename)");
+ expect_like(qr/Message recorded/, "Added the attachment");
+ expect_send("show ticket/$ticket_id/attachments","Finding Attachment");
+ my $attachment_regex = qr/(\d+):\s+$filename/;
+ expect_like($attachment_regex,"Attachment Uploaded");
+ expect_handle->before() =~ $attachment_regex;
+ my $attachment_id = $1;
+ expect_send("show ticket/$ticket_id/attachments/$attachment_id/content","Fetching Attachment");
+ open (my $fh, $attachment_path) or die "Can't open $attachment_path: $!";
+ my $attachment_content = do { local($/); <$fh> };
+ close $fh;
+ chomp $attachment_content;
+ expect_is($attachment_content,"Attachment contains original text");
+}
+
+1;
diff --git a/rt/lib/t/regression/27verp.t b/rt/lib/t/regression/27verp.t
new file mode 100644
index 000000000..856681be1
--- /dev/null
+++ b/rt/lib/t/regression/27verp.t
@@ -0,0 +1,9 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 1;
+
+TODO: {
+ todo_skip "No tests written for VERP yet", 1;
+ ok(1,"a test to skip");
+}
diff --git a/rt/lib/t/regression/mime_tests b/rt/lib/t/regression/mime_tests
new file mode 100644
index 000000000..26e4dbf84
--- /dev/null
+++ b/rt/lib/t/regression/mime_tests
@@ -0,0 +1,19 @@
+use RT::Ticket;
+use RT::Queue;
+
+use MIME::Parser;
+use File::Temp;
+use RT::EmailParser;
+
+open (HANDLE, "data/nested-mime-sample");
+my $parser = RT::EmailParser->new()
+ $parser->ParseMIMEEntityFromFileHandle(\*HANDLE);
+my $entity = $parser->Entity;
+
+my $q = RT::Queue->new($RT::SystemUser);
+$q->Load('general');
+ok ($q->Id, "Queue is loaded");
+my $Ticket = RT::Ticket->new($RT::SystemUser);
+my ($tid, $ttid, $msg) =$Ticket->Create( Queue => $q->Id, Subject => "Nested mime test", MIMEObj => $entity);
+ok ($tid, $msg);
+ok($Ticket->Id);