diff options
Diffstat (limited to 'rt/lib/t')
27 files changed, 0 insertions, 2757 deletions
diff --git a/rt/lib/t/00smoke.t.in b/rt/lib/t/00smoke.t.in deleted file mode 100644 index 288dd4a..0000000 --- a/rt/lib/t/00smoke.t.in +++ /dev/null @@ -1,14 +0,0 @@ -#!@PERL@ - -use Test::More qw(no_plan); - -use lib "@RT_LIB_PATH@"; -use RT; -ok(RT::LoadConfig); -ok(RT::Init, "Basic initialization and DB connectivity"); - -use File::Find; -File::Find::find({wanted => \&wanted}, 'lib/'); -sub wanted { /^*\.pm\z/s && ok(require $_, "Requiring '$_'"); } - - diff --git a/rt/lib/t/01harness.t b/rt/lib/t/01harness.t deleted file mode 100644 index 98c28d2..0000000 --- a/rt/lib/t/01harness.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl - -use Test::More qw(no_plan); - -use lib "/opt/rt3/lib"; -use RT; -ok(RT::LoadConfig); -ok(RT::Init, "Basic initialization and DB connectivity"); - -my $test = shift @ARGV; -require $test; - diff --git a/rt/lib/t/01harness.t.in b/rt/lib/t/01harness.t.in deleted file mode 100644 index d132330..0000000 --- a/rt/lib/t/01harness.t.in +++ /dev/null @@ -1,12 +0,0 @@ -#!@PERL@ - -use Test::More qw(no_plan); - -use lib "@RT_LIB_PATH@"; -use RT; -ok(RT::LoadConfig); -ok(RT::Init, "Basic initialization and DB connectivity"); - -my $test = shift @ARGV; -require $test; - diff --git a/rt/lib/t/02regression.t b/rt/lib/t/02regression.t deleted file mode 100644 index 4504cc7..0000000 --- a/rt/lib/t/02regression.t +++ /dev/null @@ -1,44 +0,0 @@ -#!/usr/bin/perl - -use Test::More qw(no_plan); - -use lib "/opt/rt3/lib"; -use RT; -ok(RT::LoadConfig); -ok(RT::Init, "Basic initialization and DB connectivity"); - -# Create a new queue -use_ok(RT::Queue); -my $q = RT::Queue->new($RT::SystemUser); - -$q->Load('regression'); -if ($q->id != 0) { - die "Regression tests not starting with a clean DB. Bailing"; -} - -my ($id, $msg) = $q->Create( Name => 'Regression', - Description => 'A regression test queue', - CorrespondAddress => 'correspond@a', - CommentAddress => 'comment@a'); - -isnt($id, 0, "Queue was created sucessfully - $msg"); - -my $q2 = RT::Queue->new($RT::SystemUser); - -ok($q2->Load($id)); -is($q2->id, $id, "Sucessfully loaded the queue again"); -is($q2->Name, 'Regression'); -is($q2->Description, 'A regression test queue'); -is($q2->CorrespondAddress, 'correspond@a'); -is($q2->CommentAddress, 'comment@a'); - - -use File::Find; -File::Find::find({wanted => \&wanted_autogen}, 'lib/t/autogen'); -sub wanted_autogen { /^autogen.*\.t\z/s && require $_; } - -File::Find::find({wanted => \&wanted_regression}, 'lib/t/regression'); -sub wanted_regression { /^*\.t\z/s && require $_; } - -require "/opt/rt3/lib/t/03web.pl"; -require "/opt/rt3/lib/t/04_send_email.pl"; diff --git a/rt/lib/t/02regression.t.in b/rt/lib/t/02regression.t.in deleted file mode 100644 index c2e3277..0000000 --- a/rt/lib/t/02regression.t.in +++ /dev/null @@ -1,47 +0,0 @@ -#!@PERL@ - -use Test::More qw(no_plan); - -use lib "@RT_LIB_PATH@"; -use RT; -ok(RT::LoadConfig); -ok(RT::Init, "Basic initialization and DB connectivity"); - -# Create a new queue -use_ok(RT::Queue); -my $q = RT::Queue->new($RT::SystemUser); - -$q->Load('regression'); -if ($q->id != 0) { - die "Regression tests not starting with a clean DB. Bailing"; -} - -my ($id, $msg) = $q->Create( Name => 'Regression', - Description => 'A regression test queue', - CorrespondAddress => 'correspond@a', - CommentAddress => 'comment@a'); - -isnt($id, 0, "Queue was created sucessfully - $msg"); - -my $q2 = RT::Queue->new($RT::SystemUser); - -ok($q2->Load($id)); -is($q2->id, $id, "Sucessfully loaded the queue again"); -is($q2->Name, 'Regression'); -is($q2->Description, 'A regression test queue'); -is($q2->CorrespondAddress, 'correspond@a'); -is($q2->CommentAddress, 'comment@a'); - - -use File::Find; -File::Find::find({wanted => \&wanted_autogen, - preprocess => sub {return sort @_}}, 'lib/t/autogen'); -sub wanted_autogen { /^autogen.*\.t\z/s && require $_; } - -File::Find::find({wanted => \&wanted_regression, - preprocess => sub {return sort @_}}, 'lib/t/regression'); -sub wanted_regression { /^*\.t\z/s && require $_; } - -require "@RT_LIB_PATH@/t/03web.pl"; -require "@RT_LIB_PATH@/t/04_send_email.pl"; -require "@RT_LIB_PATH@/t/05cronsupport.pl"; diff --git a/rt/lib/t/03web.pl b/rt/lib/t/03web.pl deleted file mode 100644 index 94ad3e9..0000000 --- a/rt/lib/t/03web.pl +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/perl - -use strict; -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); - - -# get the top page -my $url = "http://localhost".$RT::WebPath."/"; -$agent->get($url); - -is ($agent->{'status'}, 200, "Loaded a page"); - - -# {{{ test a login - -# follow the link marked "Login" - -ok($agent->{form}->find_input('user')); - -ok($agent->{form}->find_input('pass')); -ok ($agent->{'content'} =~ /username:/i); -$agent->field( 'user' => 'root' ); -$agent->field( 'pass' => 'password' ); -# the field isn't named, so we have to click link 0 -$agent->click(0); -is($agent->{'status'}, 200, "Fetched the page ok"); -ok( $agent->{'content'} =~ /Logout/i, "Found a logout link"); - - - -$agent->get($url."Ticket/Create.html?Queue=1"); -is ($agent->{'status'}, 200, "Loaded Create.html"); -$agent->form(3); -# Start with a string containing characters in latin1 -my $string = "I18N Web Testing æøå"; -Encode::from_to($string, 'iso-8859-1', 'utf8'); -$agent->field('Subject' => "Foo"); -$agent->field('Content' => $string); -ok($agent->submit(), "Created new ticket with $string"); - -ok( $agent->{'content'} =~ qr{$string} , "Found the content"); - -$agent->get($url."Ticket/Create.html?Queue=1"); -is ($agent->{'status'}, 200, "Loaded Create.html"); -$agent->form(3); -# Start with a string containing characters in latin1 -my $string = "I18N Web Testing æøå"; -Encode::from_to($string, 'iso-8859-1', 'utf8'); -$agent->field('Subject' => $string); -$agent->field('Content' => "BAR"); -ok($agent->submit(), "Created new ticket with $string"); - -ok( $agent->{'content'} =~ qr{$string} , "Found the content"); - - - -# }}} - - - -use File::Find; -find ( \&wanted , 'html/'); - -sub wanted { - -f && /\.html$/ && $_ !~ /Logout.html$/ && test_get($File::Find::name); -} - -sub test_get { - my $file = shift; - - - $file =~ s#^html/##; - ok ($agent->get("$url/$file", "GET $url/$file")); - is ($agent->{'status'}, 200, "Loaded $file"); - ok( $agent->{'content'} =~ /Logout/i, "Found a logout link on $file "); - ok( $agent->{'content'} !~ /Not logged in/i, "Still logged in for $file"); - ok( $agent->{'content'} !~ /System error/i, "Didn't get a Mason compilation error on $file"); - -} - -# }}} - -1; diff --git a/rt/lib/t/03web.pl.in b/rt/lib/t/03web.pl.in deleted file mode 100644 index 25c26e7..0000000 --- a/rt/lib/t/03web.pl.in +++ /dev/null @@ -1,170 +0,0 @@ -#!@PERL@ - -use strict; -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); - - -# get the top page -my $url = "http://localhost".$RT::WebPath."/"; -$agent->get($url); - -is ($agent->{'status'}, 200, "Loaded a page"); - - -# {{{ test a login - -# follow the link marked "Login" - -ok($agent->{form}->find_input('user')); - -ok($agent->{form}->find_input('pass')); -ok ($agent->{'content'} =~ /username:/i); -$agent->field( 'user' => 'root' ); -$agent->field( 'pass' => 'password' ); -# the field isn't named, so we have to click link 0 -$agent->click(0); -is($agent->{'status'}, 200, "Fetched the page ok"); -ok( $agent->{'content'} =~ /Logout/i, "Found a logout link"); - - - -$agent->get($url."Ticket/Create.html?Queue=1"); -is ($agent->{'status'}, 200, "Loaded Create.html"); -$agent->form(3); -# Start with a string containing characters in latin1 -my $string = "I18N Web Testing æøå"; -Encode::from_to($string, 'iso-8859-1', 'utf8'); -$agent->field('Subject' => "Foo"); -$agent->field('Content' => $string); -ok($agent->submit(), "Created new ticket with $string"); - -ok( $agent->{'content'} =~ qr{$string} , "Found the content"); - -$agent->get($url."Ticket/Create.html?Queue=1"); -is ($agent->{'status'}, 200, "Loaded Create.html"); -$agent->form(3); -# Start with a string containing characters in latin1 -my $string = "I18N Web Testing æøå"; -Encode::from_to($string, 'iso-8859-1', 'utf8'); -$agent->field('Subject' => $string); -$agent->field('Content' => "BAR"); -ok($agent->submit(), "Created new ticket with $string"); - -ok( $agent->{'content'} =~ qr{$string} , "Found the content"); - - - -# }}} - -# {{{ Query Builder tests - -my $response = $agent->get($url."Search/Build.html"); -ok( $response->is_success, "Fetched " . $url."Search/Build.html" ); - -# Parsing TicketSQL -# -# Adding items - -# set the first value -ok($agent->form_name('BuildQuery')); -$agent->field("AttachmentField", "Subject"); -$agent->field("AttachmentOp", "LIKE"); -$agent->field("ValueOfAttachment", "aaa"); -$agent->submit(); - -# set the next value -ok($agent->form_name('BuildQuery')); -$agent->field("AttachmentField", "Subject"); -$agent->field("AttachmentOp", "LIKE"); -$agent->field("ValueOfAttachment", "bbb"); -$agent->submit(); - -ok($agent->form_name('BuildQuery')); - -# get the query -my $query = $agent->current_form->find_input("Query")->value; -# strip whitespace from ends -$query =~ s/^\s*//g; -$query =~ s/\s*$//g; - -# collapse other whitespace -$query =~ s/\s+/ /g; - -is ($query, "Subject LIKE 'aaa' AND Subject LIKE 'bbb'"); - -# - new items go one level down -# - add items at currently selected level -# - if nothing is selected, add at end, one level down -# -# move left -# - error if nothing selected -# - same item should be selected after move -# - can't move left if you're at the top level -# -# move right -# - error if nothing selected -# - same item should be selected after move -# - can always move right (no max depth...should there be?) -# -# move up -# - error if nothing selected -# - same item should be selected after move -# - can't move up if you're first in the list -# -# move down -# - error if nothing selected -# - same item should be selected after move -# - can't move down if you're last in the list -# -# toggle -# - error if nothing selected -# - change all aggregators in the grouping -# - don't change any others -# -# delete -# - error if nothing selected -# - delete currently selected item -# - delete all children of a grouping -# - if delete leaves a node with no children, delete that, too -# - what should be selected? -# -# Clear -# - clears entire query -# - clears it from the session, too - -# }}} - -use File::Find; -find ( \&wanted , 'html/'); - -sub wanted { - -f && /\.html$/ && $_ !~ /Logout.html$/ && test_get($File::Find::name); -} - -sub test_get { - my $file = shift; - - - $file =~ s#^html/##; - ok ($agent->get("$url/$file", "GET $url/$file")); - is ($agent->{'status'}, 200, "Loaded $file"); -# ok( $agent->{'content'} =~ /Logout/i, "Found a logout link on $file "); - ok( $agent->{'content'} !~ /Not logged in/i, "Still logged in for $file"); - ok( $agent->{'content'} !~ /System error/i, "Didn't get a Mason compilation error on $file"); - -} - -# }}} - -1; diff --git a/rt/lib/t/04_send_email.pl b/rt/lib/t/04_send_email.pl deleted file mode 100644 index c384eed..0000000 --- a/rt/lib/t/04_send_email.pl +++ /dev/null @@ -1,481 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use RT::EmailParser; -use RT::Tickets; -use RT::Action::SendEmail; - -my @_outgoing_messages; -my @scrips_fired; - -#We're not testing acls here. -my $everyone = RT::Group->new($RT::SystemUser); -$everyone->LoadSystemInternalGroup('Everyone'); -$everyone->PrincipalObj->GrantRight(Right =>'SuperUser'); - - -is (__PACKAGE__, 'main', "We're operating in the main package"); - - -{ -no warnings qw/redefine/; -sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - - main::_fired_scrip($self->ScripObj); - main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity"); -} - -} - -# instrument SendEmail to pass us what it's about to send. -# create a regular ticket - -my $parser = RT::EmailParser->new(); - - -# Let's test to make sure a multipart/report is processed correctly -my $content = `cat /opt/rt3/lib/t/data/multipart-report` || die "couldn't find new content"; -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -my %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); -my $tickets = RT::Tickets->new($RT::SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -my $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); - -undef @scrips_fired; - - - - -$parser->ParseMIMEEntityFromScalar('From: root@localhost -To: rt@example.com -Subject: This is a test of new ticket creation as an unknown user - -Blah! -Foob!'); - - -use Data::Dumper; - -my $ticket = RT::Ticket->new($RT::SystemUser); -my ($id, $tid, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity); -ok ($id,$msg); -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 ($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 = (); - -my $content = `cat /opt/rt3/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; - - - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); -my ($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 = (); - -my $content = `cat /opt/rt3/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); -my ($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 - -my $content = `cat /opt/rt3/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -¨auts_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain"); -is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); - -sub umlauts_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - -# }}} - -# {{{ test a text-html message with an umlaut - -my $content = `cat /opt/rt3/lib/t/data/text-html-with-umlaut` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_html_umlauts_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'"); -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); - -sub text_html_umlauts_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - use Data::Dumper; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); - is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); - is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); - is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); - }'; -} - -# }}} - -# {{{ test a text-html message with russian characters - -my $content = `cat /opt/rt3/lib/t/data/text-html-in-russian` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_html_russian_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); - -sub text_html_russian_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - use Data::Dumper; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); - is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); - is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); - is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); - my $content_1251; - $content_1251 = $MIME->parts(1)->bodyhandle->as_string(); - ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:}, -"Content matches drugim in codepage 1251" ); - }'; -} - -# }}} - -# {{{ test a message containing a russian subject and NO content type - -unshift (@RT::EmailInputEncodings, 'koi8-r'); -$RT::EmailOutputEncoding = 'koi8-r'; -my $content = `cat /opt/rt3/lib/t/data/russian-subject-no-content-type` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_russian_redef_sendmessage; -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain"); -is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right"); -sub text_plain_russian_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); - my $subject = $MIME->head->get("subject"); - chomp($subject); - #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); - }; - '; -} - -shift @RT::EmailInputEncodings; -$RT::EmailOutputEncoding = 'utf-8'; -# }}} - - -# {{{ test a message containing a nested RFC 822 message - -my $content = `cat /opt/rt3/lib/t/data/nested-rfc-822` || die "couldn't find new content"; -ok ($content, "Loaded nested-rfc-822 to test"); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_nested_redef_sendmessage; -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(); -ok ($tick->Id, "found ticket ".$tick->Id); -is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right"); -is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain"); -sub text_plain_nested_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); - my $subject = $MIME->head->get("subject"); - $subject = MIME::Base64::decode_base64( $subject); - chomp($subject); - # TODO, why does this test fail - #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject"); - 1; - }'; -} - -# }}} - - -# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes - -my $content = `cat /opt/rt3/lib/t/data/notes-uuencoded` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -¬es_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right"); -is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments"); - -sub notes_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - -# }}} - -# {{{ test a multipart that crashes the file-based mime-parser works - -my $content = `cat /opt/rt3/lib/t/data/crashes-file-based-parser` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&crashes_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right"); -is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments"); - -sub crashes_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - - - -# }}} - -# Don't taint the environment -$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); -1; diff --git a/rt/lib/t/04_send_email.pl.in b/rt/lib/t/04_send_email.pl.in deleted file mode 100644 index 39ab0d2..0000000 --- a/rt/lib/t/04_send_email.pl.in +++ /dev/null @@ -1,506 +0,0 @@ -#!@PERL@ -w - -use strict; -use RT::EmailParser; -use RT::Tickets; -use RT::Action::SendEmail; - -my @_outgoing_messages; -my @scrips_fired; - -#We're not testing acls here. -my $everyone = RT::Group->new($RT::SystemUser); -$everyone->LoadSystemInternalGroup('Everyone'); -$everyone->PrincipalObj->GrantRight(Right =>'SuperUser'); - - -is (__PACKAGE__, 'main', "We're operating in the main package"); - - -{ -no warnings qw/redefine/; -sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - - main::_fired_scrip($self->ScripObj); - main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity"); -} - -} - -# instrument SendEmail to pass us what it's about to send. -# create a regular ticket - -my $parser = RT::EmailParser->new(); - - -# Let's test to make sure a multipart/report is processed correctly -my $content = `cat @RT_LIB_PATH@/t/data/multipart-report` || die "couldn't find new content"; -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -my %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); -my $tickets = RT::Tickets->new($RT::SystemUser); -$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); -$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); -my $tick = $tickets->First(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); - -undef @scrips_fired; - - - - -$parser->ParseMIMEEntityFromScalar('From: root@localhost -To: rt@example.com -Subject: This is a test of new ticket creation as an unknown user - -Blah! -Foob!'); - - -use Data::Dumper; - -my $ticket = RT::Ticket->new($RT::SystemUser); -my ($id, $tid, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity); -ok ($id,$msg); -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 ($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 = (); - -my $content = `cat @RT_LIB_PATH@/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; - - - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); -my ($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 = (); - -my $content = `cat @RT_LIB_PATH@/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content"; -# be as much like the mail gateway as possible. -use RT::Interface::Email; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay"); - - -# make sure it fires scrips. -is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); -# make sure it sends an autoreply - - -# make sure it sends a notification to adminccs - - -# If we correspond, does it do the right thing to the outbound messages? - -$parser->ParseMIMEEntityFromScalar($content); -my ($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 - -my $content = `cat @RT_LIB_PATH@/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -¨auts_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain"); -is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); - -sub umlauts_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - -# }}} - -# {{{ test a text-html message with an umlaut - -my $content = `cat @RT_LIB_PATH@/t/data/text-html-with-umlaut` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_html_umlauts_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'"); -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); - -sub text_html_umlauts_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - use Data::Dumper; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); - is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); - is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); - is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); - }'; -} - -# }}} - -# {{{ test a text-html message with russian characters - -my $content = `cat @RT_LIB_PATH@/t/data/text-html-in-russian` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_html_russian_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative"); - -sub text_html_russian_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - use Data::Dumper; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts"); - is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type); - is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain"); - is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html "); - my $content_1251; - $content_1251 = $MIME->parts(1)->bodyhandle->as_string(); - ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:}, -"Content matches drugim in codepage 1251" ); - }'; -} - -# }}} - -# {{{ test a message containing a russian subject and NO content type - -unshift (@RT::EmailInputEncodings, 'koi8-r'); -$RT::EmailOutputEncoding = 'koi8-r'; -my $content = `cat @RT_LIB_PATH@/t/data/russian-subject-no-content-type` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_russian_redef_sendmessage; -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right"); -ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain"); -is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right"); -sub text_plain_russian_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); - my $subject = $MIME->head->get("subject"); - chomp($subject); - #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); - }; - '; -} - -shift @RT::EmailInputEncodings; -$RT::EmailOutputEncoding = 'utf-8'; -# }}} - - -# {{{ test a message containing a nested RFC 822 message - -my $content = `cat @RT_LIB_PATH@/t/data/nested-rfc-822` || die "couldn't find new content"; -ok ($content, "Loaded nested-rfc-822 to test"); - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&text_plain_nested_redef_sendmessage; -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(); -ok ($tick->Id, "found ticket ".$tick->Id); -is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); -ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right"); -is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain"); -sub text_plain_nested_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); - my $subject = $MIME->head->get("subject"); - $subject = MIME::Base64::decode_base64( $subject); - chomp($subject); - # TODO, why does this test fail - #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject"); - 1; - }'; -} - -# }}} - - -# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes - -my $content = `cat @RT_LIB_PATH@/t/data/notes-uuencoded` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -¬es_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right"); -is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments"); - -sub notes_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - -# }}} - -# {{{ test a multipart that crashes the file-based mime-parser works - -my $content = `cat @RT_LIB_PATH@/t/data/crashes-file-based-parser` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - -# be as much like the mail gateway as possible. -&crashes_redef_sendmessage; - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right"); -is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments"); - -sub crashes_redef_sendmessage { - no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { }'; -} - - - -# }}} - -# {{{ test a multi-line RT-Send-CC header - -my $content = `cat @RT_LIB_PATH@/t/data/rt-send-cc` || die "couldn't find new content"; - -$parser->ParseMIMEEntityFromScalar($content); - - - -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(); -ok ($tick->Id, "found ticket ".$tick->Id); - -my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc'); -ok ($cc =~ /test1/, "Found test 1"); -ok ($cc =~ /test2/, "Found test 2"); -ok ($cc =~ /test3/, "Found test 3"); -ok ($cc =~ /test4/, "Found test 4"); -ok ($cc =~ /test5/, "Found test 5"); - -# }}} - -# Don't taint the environment -$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); -1; diff --git a/rt/lib/t/05cronsupport.pl.in b/rt/lib/t/05cronsupport.pl.in deleted file mode 100644 index a6b3d74..0000000 --- a/rt/lib/t/05cronsupport.pl.in +++ /dev/null @@ -1,84 +0,0 @@ -#!@PERL@ -w - -use strict; - -### 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"); diff --git a/rt/lib/t/data/lorem-ipsum b/rt/lib/t/data/lorem-ipsum deleted file mode 100644 index 1aceb14..0000000 --- a/rt/lib/t/data/lorem-ipsum +++ /dev/null @@ -1,5 +0,0 @@ -Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut -labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris -nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit -esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in -culpa qui officia deserunt mollit anim id est laborum. diff --git a/rt/lib/t/data/subject-with-folding-ws b/rt/lib/t/data/subject-with-folding-ws deleted file mode 100644 index c082632..0000000 --- a/rt/lib/t/data/subject-with-folding-ws +++ /dev/null @@ -1,10 +0,0 @@ -Subject: =?ISO-8859-1?Q?te?= - =?ISO-8859-1?Q?st?= -Date: Mon, 02 Jun 2003 20:58:30 +0200 -To: rt@example.com -From: foo@example.com -Mime-Version: 1.0 -Content-Type: text/plain; charset="iso-8859-1" -Content-Transfer-Encoding: 8bit - -test diff --git a/rt/lib/t/data/very-long-subject b/rt/lib/t/data/very-long-subject deleted file mode 100644 index ad420d0..0000000 --- a/rt/lib/t/data/very-long-subject +++ /dev/null @@ -1,12 +0,0 @@ -Subject: 012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 -Date: Mon, 02 Jun 2003 20:58:30 +0200 -To: rt@example.com -From: foo@example.com -Mime-Version: 1.0 -Content-Type: text/plain; charset="utf-8" -Content-Transfer-Encoding: 8bit - -This email has a very long subject. Our DB allows you to use subject -no longer than 200 chars, but we creat ticket, don't generate an -error and trancate long line. - diff --git a/rt/lib/t/regression/00-mason-syntax.t b/rt/lib/t/regression/00-mason-syntax.t deleted file mode 100644 index 96674ca..0000000 --- a/rt/lib/t/regression/00-mason-syntax.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/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::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' ); - return 1; -} - diff --git a/rt/lib/t/regression/00placeholder b/rt/lib/t/regression/00placeholder deleted file mode 100644 index 0afc604..0000000 --- a/rt/lib/t/regression/00placeholder +++ /dev/null @@ -1 +0,0 @@ -1; diff --git a/rt/lib/t/regression/15cf_combo_cascade.t b/rt/lib/t/regression/15cf_combo_cascade.t deleted file mode 100644 index df663a1..0000000 --- a/rt/lib/t/regression/15cf_combo_cascade.t +++ /dev/null @@ -1,49 +0,0 @@ -#!/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 deleted file mode 100644 index ea2b5b8..0000000 --- a/rt/lib/t/regression/15cf_pattern.t +++ /dev/null @@ -1,54 +0,0 @@ -#!/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/17custom_search.t b/rt/lib/t/regression/17custom_search.t deleted file mode 100644 index 8e53f44..0000000 --- a/rt/lib/t/regression/17custom_search.t +++ /dev/null @@ -1,88 +0,0 @@ -#!/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/18custom_frontpage.t b/rt/lib/t/regression/18custom_frontpage.t deleted file mode 100644 index cf77e35..0000000 --- a/rt/lib/t/regression/18custom_frontpage.t +++ /dev/null @@ -1,75 +0,0 @@ -#!/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/19quicksearch.t b/rt/lib/t/regression/19quicksearch.t deleted file mode 100644 index 7744787..0000000 --- a/rt/lib/t/regression/19quicksearch.t +++ /dev/null @@ -1,39 +0,0 @@ - -#!/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 deleted file mode 100644 index e6903b4..0000000 --- a/rt/lib/t/regression/20-sort-by-requestor.t +++ /dev/null @@ -1,143 +0,0 @@ -#!/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/23-batch-upload-csv.t b/rt/lib/t/regression/23-batch-upload-csv.t deleted file mode 100644 index fc9436a..0000000 --- a/rt/lib/t/regression/23-batch-upload-csv.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/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/23cfsort.t b/rt/lib/t/regression/23cfsort.t deleted file mode 100644 index e90fa36..0000000 --- a/rt/lib/t/regression/23cfsort.t +++ /dev/null @@ -1,143 +0,0 @@ -#!/usr/bin/perl - -use Test::More tests => 15; -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); - is( $results, $order , "Ordered correctly: $order"); -} - -# 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 => 'DES' ); -is($tx->Count,2); -check_order( $tx, 1, 2); - -# 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); -check_order( $tx, 3, 2, 1); - -# 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); -check_order( $tx, 2, 3, 1); diff --git a/rt/lib/t/regression/24pawsort.t b/rt/lib/t/regression/24pawsort.t deleted file mode 100644 index 665c325..0000000 --- a/rt/lib/t/regression/24pawsort.t +++ /dev/null @@ -1,104 +0,0 @@ -#!/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 deleted file mode 100644 index 0e11989..0000000 --- a/rt/lib/t/regression/25scrip_order.t +++ /dev/null @@ -1,57 +0,0 @@ -#!/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 deleted file mode 100644 index 841e2d1..0000000 --- a/rt/lib/t/regression/26command_line.t +++ /dev/null @@ -1,415 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::Expect; -#use Test::More qw/no_plan/; -use Test::More tests => 202; - -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'); -} - -# }}} - -# 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'); -# ... -# 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 deleted file mode 100644 index 856681b..0000000 --- a/rt/lib/t/regression/27verp.t +++ /dev/null @@ -1,9 +0,0 @@ -#!/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"); -} |