[Rt-commit] r1995 - in rt/branches/3.3-TESTING: . lib/t
lib/t/regression
jesse at bestpractical.com
jesse at bestpractical.com
Thu Dec 16 14:48:46 EST 2004
Author: jesse
Date: Tue Dec 14 04:54:20 2004
New Revision: 1995
Added:
rt/branches/3.3-TESTING/lib/t/00smoke.t
rt/branches/3.3-TESTING/lib/t/regression/03basic_web.t
rt/branches/3.3-TESTING/lib/t/regression/04send_email.t
rt/branches/3.3-TESTING/lib/t/regression/05cronsupport.t
rt/branches/3.3-TESTING/lib/t/regression/06mailgateway.t
rt/branches/3.3-TESTING/lib/t/regression/07acl.t
rt/branches/3.3-TESTING/lib/t/regression/08web_cf_access.t
rt/branches/3.3-TESTING/lib/t/regression/09record_cf_api.t
rt/branches/3.3-TESTING/lib/t/setup_regression.t
Removed:
rt/branches/3.3-TESTING/lib/t/00smoke.t.in
rt/branches/3.3-TESTING/lib/t/01harness.t.in
rt/branches/3.3-TESTING/lib/t/02regression.t.in
rt/branches/3.3-TESTING/lib/t/03web.pl.in
rt/branches/3.3-TESTING/lib/t/04_send_email.pl.in
rt/branches/3.3-TESTING/lib/t/05cronsupport.pl.in
rt/branches/3.3-TESTING/lib/t/06mailgateway.pl.in
rt/branches/3.3-TESTING/lib/t/07acl.pl.in
rt/branches/3.3-TESTING/lib/t/08web_cf.pl.in
rt/branches/3.3-TESTING/lib/t/regression/00placeholder
Modified:
rt/branches/3.3-TESTING/ (props changed)
rt/branches/3.3-TESTING/Makefile.in
rt/branches/3.3-TESTING/configure.ac
Log:
r2434 at hualien: jesse | 2004-12-14T09:50:12.895761Z
Test suite refactored to use 'prove' rather than one big ball of tests.
This makes it much easier to run individual test scripts and gets us a nice pretty output.
Ruslan pushed me into this.
Modified: rt/branches/3.3-TESTING/Makefile.in
==============================================================================
--- rt/branches/3.3-TESTING/Makefile.in (original)
+++ rt/branches/3.3-TESTING/Makefile.in Tue Dec 14 04:54:20 2004
@@ -342,11 +342,14 @@
regression-install: config-install
$(PERL) -pi -e 's/Set\(\$$DatabaseName.*\);/Set\(\$$DatabaseName, "rt3regression"\);/' $(DESTDIR)/$(CONFIG_FILE)
-regression: regression-install dirs files-install libs-install sbin-install bin-install regression-instruct regression-reset-db testify-pods fixperms apachectl
- $(PERL) lib/t/02regression.t
+regression: regression-install dirs files-install libs-install sbin-install bin-install regression-instruct regression-reset-db testify-pods fixperms apachectl run-regression
+
+run-regression:
+ prove -Ilib lib/t/setup_regression.t lib/t/autogen/ lib/t/regression/
+
+
+regression-noapache: regression-install dirs files-install libs-install sbin-install bin-install regression-instruct regression-reset-db testify-pods fixperms start-httpd run-regression
-regression-noapache: regression-install dirs files-install libs-install sbin-install bin-install regression-instruct regression-reset-db testify-pods fixperms start-httpd
- $(PERL) lib/t/02regression.t
regression-quiet:
$(PERL) sbin/regression_harness
Modified: rt/branches/3.3-TESTING/configure.ac
==============================================================================
--- rt/branches/3.3-TESTING/configure.ac (original)
+++ rt/branches/3.3-TESTING/configure.ac Tue Dec 14 04:54:20 2004
@@ -7,7 +7,7 @@
dnl Setup autoconf
AC_PREREQ(2.53)
-AC_INIT(RT, [3.3.HEAD], [rt-3.1-bugs at fsck.com])
+AC_INIT(RT, [3.3.HEAD], [rt-bugs at fsck.com])
AC_CONFIG_SRCDIR([lib/RT.pm.in])
dnl Extract RT version number components
Added: rt/branches/3.3-TESTING/lib/t/00smoke.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/00smoke.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use Test::More qw(no_plan);
+
+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 '$_'"); }
+
+
Added: rt/branches/3.3-TESTING/lib/t/regression/03basic_web.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/03basic_web.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,171 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More qw/no_plan/;
+use WWW::Mechanize;
+use HTTP::Request::Common;
+use HTTP::Cookies;
+use LWP;
+use Encode;
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+
+# 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;
Added: rt/branches/3.3-TESTING/lib/t/regression/04send_email.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/04send_email.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,510 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init;
+use RT::EmailParser;
+use RT::Tickets;
+use RT::Action::SendEmail;
+
+my @_outgoing_messages;
+my @scrips_fired;
+
+#We're not testing acls here.
+my $everyone = RT::Group->new($RT::SystemUser);
+$everyone->LoadSystemInternalGroup('Everyone');
+$everyone->PrincipalObj->GrantRight(Right =>'SuperUser');
+
+
+is (__PACKAGE__, 'main', "We're operating in the main package");
+
+
+{
+no warnings qw/redefine/;
+sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ main::_fired_scrip($self->ScripObj);
+ main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
+}
+
+}
+
+# instrument SendEmail to pass us what it's about to send.
+# create a regular ticket
+
+my $parser = RT::EmailParser->new();
+
+
+# Let's test to make sure a multipart/report is processed correctly
+my $content = `cat /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 at localhost
+To: rt at example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!');
+
+
+use Data::Dumper;
+
+my $ticket = RT::Ticket->new($RT::SystemUser);
+my ($id, undef, $msg ) = $ticket->Create(Requestor => ['root at localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
+ok ($id,$msg);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+# make sure it sends a notification to adminccs
+
+
+# we need to swap out SendMessage to test the new things we care about;
+&utf8_redef_sendmessage;
+
+# create an iso 8859-1 ticket
+ at scrips_fired = ();
+
+$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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
+
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+
+
+# make sure it sends a notification to adminccs
+
+# If we correspond, does it do the right thing to the outbound messages?
+
+$parser->ParseMIMEEntityFromScalar($content);
+ ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+$parser->ParseMIMEEntityFromScalar($content);
+($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+
+
+
+
+# we need to swap out SendMessage to test the new things we care about;
+&iso8859_redef_sendmessage;
+$RT::EmailOutputEncoding = 'iso-8859-1';
+# create an iso 8859-1 ticket
+ at scrips_fired = ();
+
+ $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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
+
+
+# make sure it fires scrips.
+is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
+# make sure it sends an autoreply
+
+
+# make sure it sends a notification to adminccs
+
+
+# If we correspond, does it do the right thing to the outbound messages?
+
+$parser->ParseMIMEEntityFromScalar($content);
+ ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+$parser->ParseMIMEEntityFromScalar($content);
+($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
+ok ($id, $msg);
+
+
+sub _fired_scrip {
+ my $scrip = shift;
+ push @scrips_fired, $scrip;
+}
+
+sub utf8_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval '
+ sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ my $scrip = $self->ScripObj->id;
+ ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
+ main::_fired_scrip($self->ScripObj);
+ $MIME->make_singlepart;
+ main::ok( ref($MIME) eq \'MIME::Entity\',
+ "hey, look. it\'s a mime entity" );
+ main::ok( ref( $MIME->head ) eq \'MIME::Head\',
+ "its mime header is a mime header. yay" );
+ main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
+ "Its content type is utf-8" );
+ my $message_as_string = $MIME->bodyhandle->as_string();
+ use Encode;
+ $message_as_string = Encode::decode_utf8($message_as_string);
+ main::ok(
+ $message_as_string =~ /H\x{e5}vard/,
+"The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
+
+ }';
+}
+
+sub iso8859_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval '
+ sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+
+ my $scrip = $self->ScripObj->id;
+ ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
+ main::_fired_scrip($self->ScripObj);
+ $MIME->make_singlepart;
+ main::ok( ref($MIME) eq \'MIME::Entity\',
+ "hey, look. it\'s a mime entity" );
+ main::ok( ref( $MIME->head ) eq \'MIME::Head\',
+ "its mime header is a mime header. yay" );
+ main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
+ "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
+ my $message_as_string = $MIME->bodyhandle->as_string();
+ use Encode;
+ $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
+ main::ok(
+ $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
+
+ }';
+}
+
+# {{{ test a multipart alternative containing a text-html part with an umlaut
+
+ $content = `cat /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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain");
+is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
+
+sub umlauts_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+# }}}
+
+# {{{ test a text-html message with an umlaut
+
+ $content = `cat /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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'");
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
+
+sub text_html_umlauts_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ use Data::Dumper;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
+ is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
+ is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
+ is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
+ }';
+}
+
+# }}}
+
+# {{{ test a text-html message with russian characters
+
+ $content = `cat /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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
+
+sub text_html_russian_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ use Data::Dumper;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
+ is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
+ is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
+ is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
+ my $content_1251;
+ $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
+ ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
+"Content matches drugim in codepage 1251" );
+ }';
+}
+
+# }}}
+
+# {{{ test a message containing a russian subject and NO content type
+
+unshift (@RT::EmailInputEncodings, 'koi8-r');
+$RT::EmailOutputEncoding = 'koi8-r';
+$content = `cat /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;
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right");
+ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain");
+is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
+sub text_plain_russian_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
+ my $subject = $MIME->head->get("subject");
+ chomp($subject);
+ #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
+ };
+ ';
+}
+
+shift @RT::EmailInputEncodings;
+$RT::EmailOutputEncoding = 'utf-8';
+# }}}
+
+
+# {{{ test a message containing a nested RFC 822 message
+
+ $content = `cat /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;
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
+ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
+is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
+sub text_plain_nested_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage {
+ my $self = shift;
+ my $MIME = shift;
+ return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+ is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
+ my $subject = $MIME->head->get("subject");
+ $subject = MIME::Base64::decode_base64( $subject);
+ chomp($subject);
+ # TODO, why does this test fail
+ #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
+ 1;
+ }';
+}
+
+# }}}
+
+
+# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
+
+ $content = `cat /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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right");
+is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments");
+
+sub notes_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+# }}}
+
+# {{{ test a multipart that crashes the file-based mime-parser works
+
+ $content = `cat /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;
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
+is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
+
+sub crashes_redef_sendmessage {
+ no warnings qw/redefine/;
+ eval 'sub RT::Action::SendEmail::SendMessage { }';
+}
+
+
+
+# }}}
+
+# {{{ test a multi-line RT-Send-CC header
+
+ $content = `cat /opt/rt3/lib/t/data/rt-send-cc` || die "couldn't find new content";
+
+$parser->ParseMIMEEntityFromScalar($content);
+
+
+
+ %args = (message => $content, queue => 1, action => 'correspond');
+ RT::Interface::Email::Gateway(\%args);
+ $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick= $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+
+my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc');
+ok ($cc =~ /test1/, "Found test 1");
+ok ($cc =~ /test2/, "Found test 2");
+ok ($cc =~ /test3/, "Found test 3");
+ok ($cc =~ /test4/, "Found test 4");
+ok ($cc =~ /test5/, "Found test 5");
+
+# }}}
+
+# Don't taint the environment
+$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
+1;
Added: rt/branches/3.3-TESTING/lib/t/regression/05cronsupport.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/05cronsupport.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,91 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More qw/no_plan/;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+### Set up some testing data. Test the testing data because why not?
+
+# Create a user with rights, a queue, and some tickets.
+my $user_obj = RT::User->new($RT::SystemUser);
+my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('tara at 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 at example.com
+RT-Send-Bcc: jesse at 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 at 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 at localhost'],
+ Subject => 'hurdy gurdy'
+ );
+ok($id, 'record test ticket creation 2');
+
+
+### OK. Have data, will travel.
+
+# First test the search.
+
+ok(require RT::Search::FromSQL, "Search::FromSQL loaded");
+my $ticketsqlstr = "Requestor.EmailAddress = '" . $CurrentUser->EmailAddress .
+ "' AND Priority > '20'";
+my $search = RT::Search::FromSQL->new(Argument => $ticketsqlstr, TicketsObj => RT::Tickets->new($CurrentUser),
+ );
+is(ref($search), 'RT::Search::FromSQL', "search created");
+ok($search->Prepare(), "fromsql search run");
+my $counter = 0;
+while(my $t = $search->TicketsObj->Next() ) {
+ is($t->Id(), $ticket1->Id(), "fromsql search results 1");
+ $counter++;
+}
+is ($counter, 1, "fromsql search results 2");
+
+# Right. Now test the actions.
+
+ok(require RT::Action::RecordComment);
+ok(require RT::Action::RecordCorrespondence);
+
+my ($comment_act, $correspond_act);
+ok($comment_act = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordComment created");
+ok($correspond_act = RT::Action::RecordCorrespondence->new(TicketObj => $ticket2, TemplateObj => $template_obj, CurrentUser => $CurrentUser), "RecordCorrespondence created");
+ok($comment_act->Prepare(), "Comment prepared");
+ok($correspond_act->Prepare(), "Correspond prepared");
+ok($comment_act->Commit(), "Comment committed");
+ok($correspond_act->Commit(), "Correspondence committed");
+
+# Now test for loop suppression.
+my ($trans, $desc, $transaction) = $ticket2->Comment(MIMEObj => $template_obj->MIMEObj);
+my $bogus_action = RT::Action::RecordComment->new(TicketObj => $ticket1, TemplateObj => $template_obj, TransactionObj => $transaction, CurrentUser => $CurrentUser);
+ok(!$bogus_action->Prepare(), "Comment aborted to prevent loop");
+
+1;
Added: rt/branches/3.3-TESTING/lib/t/regression/06mailgateway.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/06mailgateway.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,423 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
+# <jesse.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+=head1 NAME
+
+rt-mailgate - Mail interface to RT3.
+
+=cut
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init();
+use RT::I18N;
+# Make sure that when we call the mailgate wrong, it tempfails
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Foob!
+EOF
+close (MAIL);
+
+# Check the return value
+is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay");
+
+
+# {{{ Test new ticket creation by root who is privileged and superuser
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --debug --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+use RT::Tickets;
+my $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket");
+
+# }}}
+
+
+# {{{This is a test of new ticket creation as an unknown user
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+my $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist at example.com');
+ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission");
+
+
+# }}}
+
+# {{{ now everybody can create tickets. can a random unkown user create tickets?
+
+my $g = RT::Group->new($RT::SystemUser);
+$g->LoadSystemInternalGroup('Everyone');
+ok( $g->Id, "Found 'everybody'");
+
+my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+ok ($val, "Granted everybody the right to create tickets - $msg");
+
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+ $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist at example.com');
+ok( $u->Id != 0, " user does not exist and was created by ticket submission");
+
+# }}}
+
+
+# {{{ can another random reply to a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2 at example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission");
+# }}}
+
+
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2 at example.com');
+ok( $u->Id != 0, " user exists and was created by ticket correspondence submission");
+
+# }}}
+
+# {{{ can another random comment on a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3 at example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
+
+# }}}
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3 at example.com');
+ok( $u->Id != 0, " user exists and was created by ticket comment submission");
+
+# }}}
+
+# {{{ Testing preservation of binary attachments
+
+# Get a binary blob (Best Practical logo)
+
+# Create a mime entity with an attachment
+
+use MIME::Entity;
+my $entity = MIME::Entity->build( From => 'root at localhost',
+ To => 'rt at localhost',
+ Subject => 'binary attachment test',
+ Data => ['This is a test of a binary attachment']);
+
+# currently in lib/t/autogen
+$entity->attach(Path => '/opt/rt3/share/html/NoAuth/images/bplogo.gif',
+ Type => 'image/gif',
+ Encoding => 'base64');
+
+# Create a ticket with a binary attachment
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+$entity->print(\*MAIL);
+
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id);
+
+my $file = `cat '/opt/rt3/share/html/NoAuth/images/bplogo.gif'`;
+ok ($file, "Read in the logo image");
+
+
+ use Digest::MD5;
+warn "for the raw file the content is ".Digest::MD5::md5_base64($file);
+
+
+
+# Verify that the binary attachment is valid in the database
+my $attachments = RT::Attachments->new($RT::SystemUser);
+$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif');
+ok ($attachments->Count == 1, 'Found only one gif in the database');
+my $attachment = $attachments->First;
+ok($attachment->Id);
+my $acontent = $attachment->Content;
+
+ warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent);
+
+is( $acontent, $file, 'The attachment isn\'t screwed up in the database.');
+# Log in as root
+use Getopt::Long;
+use LWP::UserAgent;
+
+
+# Grab the binary attachment via the web ui
+my $ua = LWP::UserAgent->new();
+
+my $full_url = "http://localhost".$RT::WebPath."/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/bplogo.gif?&user=root&pass=password";
+my $r = $ua->get( $full_url);
+
+
+# Verify that the downloaded attachment is the same as what we uploaded.
+is($file, $r->content, 'The attachment isn\'t screwed up in download');
+
+
+
+# }}}
+
+# {{{ Simple I18N testing
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+my $unitickets = RT::Tickets->new($RT::SystemUser);
+$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $unitick = $unitickets->First();
+ok (UNIVERSAL::isa($unitick,'RT::Ticket'));
+ok ($unitick->Id, "found ticket ".$unitick->Id);
+ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject);
+
+
+
+my $unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content);
+ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
+# supposedly I18N fails on the second message sent in.
+
+ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
+my $tickets2 = RT::Tickets->new($RT::SystemUser);
+$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick2 = $tickets2->First();
+ok (UNIVERSAL::isa($tick2,'RT::Ticket'));
+ok ($tick2->Id, "found ticket ".$tick2->Id);
+ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket");
+
+
+
+$unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+
+ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content);
+
+# }}}
+
+
+($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
+ok ($val, $msg);
+
+
+1;
+
+1;
+
Added: rt/branches/3.3-TESTING/lib/t/regression/07acl.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/07acl.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+
+use WWW::Mechanize;
+use HTTP::Cookies;
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+# Create a user with basically no rights, to start.
+my $user_obj = RT::User->new($RT::SystemUser);
+my ($ret, $msg) = $user_obj->LoadOrCreateByEmail('customer at example.com');
+ok($ret, 'ACL test user creation');
+$user_obj->SetName('customer');
+$user_obj->SetPrivileged(1);
+($ret, $msg) = $user_obj->SetPassword('customer');
+ok($ret, "ACL test password set. $msg");
+
+# Now test the web interface, making sure objects come and go as
+# required.
+
+my $cookie_jar = HTTP::Cookies->new;
+my $agent = WWW::Mechanize->new();
+
+# give the agent a place to stash the cookies
+
+$agent->cookie_jar($cookie_jar);
+
+
+# get the top page
+my $url = "http://localhost".$RT::WebPath."/";
+$agent->get($url);
+
+is ($agent->{'status'}, 200, "Loaded a page - http://localhost".$RT::WebPath);
+# {{{ test a login
+
+# follow the link marked "Login"
+
+ok($agent->{form}->find_input('user'));
+
+ok($agent->{form}->find_input('pass'));
+ok ($agent->{'content'} =~ /username:/i);
+$agent->field( 'user' => 'customer' );
+$agent->field( 'pass' => 'customer' );
+# the field isn't named, so we have to click link 0
+$agent->click(0);
+is($agent->{'status'}, 200, "Fetched the page ok");
+ok($agent->{'content'} =~ /Logout/i, "Found a logout link");
+
+# Test for absence of Configure and Preferences tabs.
+ok(!$agent->find_link( url => '/Admin/',
+ text => 'Configuration'), "No config tab" );
+ok(!$agent->find_link( url => '/User/Prefs.html',
+ text => 'Preferences'), "No prefs pane" );
+
+# Now test for their presence, one at a time. Sleep for a bit after
+# ACL changes, thanks to the 10s ACL cache.
+$user_obj->PrincipalObj->GrantRight(Right => 'ShowConfigTab');
+$agent->reload();
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => '/Admin/',
+ text => 'Configuration'), "Found config tab" );
+$user_obj->PrincipalObj->RevokeRight(Right => 'ShowConfigTab');
+$user_obj->PrincipalObj->GrantRight(Right => 'ModifySelf');
+$agent->reload();
+ok($agent->{'content'} =~ /Logout/i, "Reloaded page successfully");
+ok($agent->find_link( url => '/User/Prefs.html',
+ text => 'Preferences'), "Found prefs pane" );
+$user_obj->PrincipalObj->RevokeRight(Right => 'ModifySelf');
+
+# Good. Now load the search page and test Load/Save Search.
+$agent->follow_link( url => '/Search/Build.html',
+ text => 'Tickets');
+is($agent->{'status'}, 200, "Fetched search builder page");
+ok($agent->{'content'} !~ /Load saved search/i, "No search loading box");
+ok($agent->{'content'} !~ /Saved searches/i, "No saved searches box");
+
+$user_obj->PrincipalObj->GrantRight(Right => 'LoadSavedSearch');
+$agent->reload();
+ok($agent->{'content'} =~ /Load saved search/i, "Search loading box exists");
+ok($agent->{'content'} !~ /input\s+type=.submit.\s+name=.Save./i,
+ "Still no saved searches box");
+
+$user_obj->PrincipalObj->GrantRight(Right => 'CreateSavedSearch');
+$agent->reload();
+ok($agent->{'content'} =~ /Load saved search/i,
+ "Search loading box still exists");
+ok($agent->{'content'} =~ /input\s+type=.submit.\s+name=.Save./i,
+ "Saved searches box exists");
+
+# Create a group, and a queue, so we can test limited user visibility
+# via SelectOwner.
+
+my $queue_obj = RT::Queue->new($RT::SystemUser);
+($ret, $msg) = $queue_obj->Create(Name => 'CustomerQueue',
+ Description => 'queue for SelectOwner testing');
+ok($ret, "SelectOwner test queue creation. $msg");
+my $group_obj = RT::Group->new($RT::SystemUser);
+($ret, $msg) = $group_obj->CreateUserDefinedGroup(Name => 'CustomerGroup',
+ Description => 'group for SelectOwner testing');
+ok($ret, "SelectOwner test group creation. $msg");
+
+# Add our customer to the customer group, and give it queue rights.
+($ret, $msg) = $group_obj->AddMember($user_obj->PrincipalObj->Id());
+ok($ret, "Added customer to its group. $msg");
+$group_obj->PrincipalObj->GrantRight(Right => 'OwnTicket',
+ Object => $queue_obj);
+$group_obj->PrincipalObj->GrantRight(Right => 'SeeQueue',
+ Object => $queue_obj);
+
+# Now. When we look at the search page we should be able to see
+# ourself in the list of possible owners.
+
+$agent->reload();
+ok($agent->form_name('BuildQuery'), "Yep, form is still there");
+my $input = $agent->current_form->find_input('ValueOfActor');
+ok(grep(/customer/, $input->value_names()), "Found self in the actor listing");
+
+1;
Added: rt/branches/3.3-TESTING/lib/t/regression/08web_cf_access.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/08web_cf_access.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig;
+RT::Init;
+use Test::WWW::Mechanize;
+
+
+use constant BaseURL => "http://localhost".$RT::WebPath."/";
+use constant ImageFile => $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif';
+use constant ImageFileContent => do {
+ local $/;
+ open my $fh, '<', ImageFile or die $!;
+ binmode($fh);
+ scalar <$fh>;
+};
+
+my $m = Test::WWW::Mechanize->new;
+isa_ok($m, 'Test::WWW::Mechanize');
+
+$m->get( BaseURL."?user=root;pass=password" );
+$m->content_like(qr/Logout/, 'we did log in');
+$m->follow_link( text => 'Configuration' );
+$m->title_is(q/RT Administration/, 'admin screen');
+$m->follow_link( text => 'Custom Fields' );
+$m->title_is(q/Select a Custom Field/, 'admin-cf screen');
+$m->follow_link( text => 'New custom field' );
+$m->submit_form(
+ form_name => "ModifyCustomField",
+ fields => {
+ TypeComposite => 'Image-0',
+ LookupType => 'RT::Queue-RT::Ticket',
+ Name => 'img',
+ Description => 'img',
+ },
+);
+$m->title_is(q/Created CustomField img/, 'admin-cf created');
+$m->follow_link( text => 'Queues' );
+$m->title_is(q/Admin queues/, 'admin-queues screen');
+$m->follow_link( text => 'General' );
+$m->title_is(q/Editing Configuration for queue General/, 'admin-queue: general');
+$m->follow_link( text => 'Ticket Custom Fields' );
+
+$m->title_is(q/Edit Custom Fields for General/, 'admin-queue: general tcf');
+$m->form_name('EditCustomFields');
+
+# Sort by numeric IDs in names
+my @names = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map { /Object-1-CF-(\d+)/ ? [ $1 => $_ ] : () }
+ map $_->name, $m->current_form->inputs;
+my $tcf = pop(@names);
+$m->field( $tcf => 1 ); # Associate the new CF with this queue
+$m->field( $_ => undef ) for @names; # ...and not any other. ;-)
+$m->submit;
+
+$m->content_like( qr/Object created/, 'TCF added to the queue' );
+
+$m->submit_form(
+ form_name => "CreateTicketInQueue",
+ fields => { Queue => 'General' },
+);
+
+$m->content_like(qr/Upload multiple images/, 'has a upload image field');
+
+$tcf =~ /(\d+)$/ or die "Hey this is impossible dude";
+my $upload_field = "Object-RT::Ticket--CustomField-$1-Upload";
+
+$m->submit_form(
+ form_name => "TicketCreate",
+ fields => {
+ $upload_field => ImageFile,
+ Subject => 'testing img cf creation',
+ },
+);
+
+$m->content_like(qr/Ticket \d+ created/, "a ticket is created succesfully");
+
+my $id = $1 if $m->content =~ /Ticket (\d+) created/;
+
+$m->title_like(qr/testing img cf creation/, "its title is the Subject");
+
+$m->follow_link( text => 'bplogo.gif' );
+$m->content_is(ImageFileContent, "it links to the uploaded image");
+
+$m->get( BaseURL );
+
+$m->follow_link( text => 'Tickets' );
+$m->follow_link( text => 'New Query' );
+
+$m->title_is(q/Query Builder/, 'Query building');
+$m->submit_form(
+ form_name => "BuildQuery",
+ fields => {
+ idOp => '=',
+ ValueOfid => $id,
+ ValueOfQueue => 'General',
+ },
+ button => 'AddClause',
+);
+
+$m->form_name('BuildQuery');
+
+my $col = ($m->current_form->find_input('SelectDisplayColumns'))[-1];
+$col->value( ($col->possible_values)[-1] );
+
+$m->click('AddCol');
+
+$m->form_name('BuildQuery');
+$m->click('DoSearch');
+
+$m->follow_link( text_regex => qr/bplogo\.gif/ );
+$m->content_is(ImageFileContent, "it links to the uploaded image");
+
+__END__
+[FC] Bulk Update does not have custom fields.
Added: rt/branches/3.3-TESTING/lib/t/regression/09record_cf_api.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/regression/09record_cf_api.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,189 @@
+#!/usr/bin/perl
+
+use strict;
+#use warnings FATAL => 'all';
+use Test::More qw/no_plan/;
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+# Before we get going, let's ditch all object_cfs; this will remove
+# all custom fields systemwide;
+my $object_cfs = RT::ObjectCustomFields->new($RT::SystemUser);
+$object_cfs->UnLimit();
+while (my $ocf = $object_cfs->Next) {
+ $ocf->Delete();
+}
+
+
+my $queue = RT::Queue->new( $RT::SystemUser );
+$queue->Create( Name => 'RecordCustomFields' );
+
+my $ticket = RT::Ticket->new( $RT::SystemUser );
+$ticket->Create(
+ Queue => $queue->Id,
+ Requestor => 'root at localhost',
+ Subject => 'RecordCustomFields1',
+);
+
+my $cfs = $ticket->CustomFields;
+is( $cfs->Count, 0 );
+
+# Check that record has no any CF values yet {{{
+my $cfvs = $ticket->CustomFieldValues;
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue, undef );
+
+
+my $local_cf1 = RT::CustomField->new( $RT::SystemUser );
+$local_cf1->Create( Name => 'RecordCustomFields1', Type => 'SelectSingle', Queue => $queue->id );
+$local_cf1->AddValue( Name => 'RecordCustomFieldValues11' );
+$local_cf1->AddValue( Name => 'RecordCustomFieldValues12' );
+
+my $local_cf2 = RT::CustomField->new( $RT::SystemUser );
+$local_cf2->Create( Name => 'RecordCustomFields2', Type => 'SelectSingle', Queue => $queue->id );
+$local_cf2->AddValue( Name => 'RecordCustomFieldValues21' );
+$local_cf2->AddValue( Name => 'RecordCustomFieldValues22' );
+
+my $global_cf3 = RT::CustomField->new( $RT::SystemUser );
+$global_cf3->Create( Name => 'RecordCustomFields3', Type => 'SelectSingle', Queue => 0 );
+$global_cf3->AddValue( Name => 'RecordCustomFieldValues31' );
+$global_cf3->AddValue( Name => 'RecordCustomFieldValues32' );
+
+
+my @custom_fields = ($local_cf1, $local_cf2, $global_cf3);
+
+
+$cfs = $ticket->CustomFields;
+is( $cfs->Count, 3 );
+
+# Check that record has no any CF values yet {{{
+$cfvs = $ticket->CustomFieldValues;
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue, undef );
+
+# CF with ID -1 shouldnt exist at all
+$cfvs = $ticket->CustomFieldValues( -1 );
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue( -1 ), undef );
+
+$cfvs = $ticket->CustomFieldValues( 'SomeUnexpedCustomFieldName' );
+is( $cfvs->Count, 0 );
+is( $ticket->FirstCustomFieldValue( 'SomeUnexpedCustomFieldName' ), undef );
+
+for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 0 );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 0 );
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), undef );
+}
+# }}}
+
+# try to add field value with fields that doesn't exist {{{
+my ($status, $msg) = $ticket->AddCustomFieldValue( Field => -1 , Value => 'foo' );
+ok(!$status, "shouldn't add value" );
+($status, $msg) = $ticket->AddCustomFieldValue( Field => 'SomeUnexpedCustomFieldName' , Value => 'foo' );
+ok(!$status, "shouldn't add value" );
+# }}}
+
+# {{{
+SKIP: {
+
+ skip "TODO: We want fields that doesn't allow to set unexpected values", 10;
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->id , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_->Name , Value => 'SomeUnexpectedCFValue' );
+ ok( !$status, 'value doesn\'t exist');
+ }
+
+ # Let check that we didn't add value to be shure
+ # using only FirstCustomFieldValue sub because
+ # we checked other variants allready
+ for (@custom_fields) {
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef );
+ }
+
+}
+
+# Add some values to our custom fields
+for (@custom_fields) {
+ # this should be tested elsewhere
+ $_->AddValue( Name => 'Foo' );
+ $_->AddValue( Name => 'Bar' );
+}
+
+my $test_add_delete_cycle = sub {
+ my $cb = shift;
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $cb->($_) , Value => 'Foo' );
+ ok( $status, "message: $msg");
+ }
+
+ # does it exist?
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 3 );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 1 );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 1 );
+ is( $ticket->FirstCustomFieldValue( $_->id ), 'Foo' );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), 'Foo' );
+ }
+ # because our CFs are SingleValue then new value addition should override
+ for (@custom_fields) {
+ ($status, $msg) = $ticket->AddCustomFieldValue( Field => $_ , Value => 'Bar' );
+ ok( $status, "message: $msg");
+ }
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 3 );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 1 );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 1 );
+ is( $ticket->FirstCustomFieldValue( $_->id ), 'Bar' );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), 'Bar' );
+ }
+ # delete it
+ for (@custom_fields ) {
+ ($status, $msg) = $ticket->DeleteCustomFieldValue( Field => $_ , Value => 'Bar' );
+ ok( $status, "Deleted a custom field value 'Bar' for field ".$_->id.": $msg");
+ }
+ $cfvs = $ticket->CustomFieldValues;
+ is( $cfvs->Count, 0, "The ticket (".$ticket->id.") no longer has any custom field values" );
+ for (@custom_fields) {
+ $cfvs = $ticket->CustomFieldValues( $_->id );
+ is( $cfvs->Count, 0, $ticket->id." has no values for cf ".$_->id );
+
+ $cfvs = $ticket->CustomFieldValues( $_->Name );
+ is( $cfvs->Count, 0 , $ticket->id." has no values for cf '".$_->Name. "'" );
+ is( $ticket->FirstCustomFieldValue( $_->id ), undef , "There is no first custom field value when loading by id" );
+ is( $ticket->FirstCustomFieldValue( $_->Name ), undef, "There is no first custom field value when loading by Name" );
+ }
+};
+
+# lets test cycle via CF id
+$test_add_delete_cycle->( sub { return $_[0]->id } );
+# lets test cycle via CF object reference
+$test_add_delete_cycle->( sub { return $_[0] } );
+
+SKIP: {
+# skip "TODO: should we add CF values to objects via CF Name?", 48;
+# names are not unique
+ # lets test cycle via CF Name
+# $test_add_delete_cycle->( sub { return $_[0]->Name } );
+}
+
+
Added: rt/branches/3.3-TESTING/lib/t/setup_regression.t
==============================================================================
--- (empty file)
+++ rt/branches/3.3-TESTING/lib/t/setup_regression.t Tue Dec 14 04:54:20 2004
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use Test::More qw(no_plan);
+
+use RT;
+ok(RT::LoadConfig);
+ok(RT::Init, "Basic initialization and DB connectivity");
+
+# Create a new queue
+use_ok(RT::Queue);
+my $q = RT::Queue->new($RT::SystemUser);
+
+$q->Load('regression');
+if ($q->id != 0) {
+ die "Regression tests not starting with a clean DB. Bailing";
+}
+
+my ($id, $msg) = $q->Create( Name => 'Regression',
+ Description => 'A regression test queue',
+ CorrespondAddress => 'correspond at a',
+ CommentAddress => 'comment at 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 at a');
+is($q2->CommentAddress, 'comment at a');
+
+
More information about the Rt-commit
mailing list