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