diff options
author | Ivan Kohler <ivan@freeside.biz> | 2014-09-15 20:54:03 -0700 |
---|---|---|
committer | Ivan Kohler <ivan@freeside.biz> | 2014-09-15 20:54:03 -0700 |
commit | bdc63b4ee68fb08d3ef281212bdffac2bc038717 (patch) | |
tree | 5f1c28e48cd03dced7204891ed108d6b85d9f47a /rt/lib/RT | |
parent | ed1f84b4e8f626245995ecda5afcf83092c153b2 (diff) |
RT 4.0.22 - remove inadvertantly commited files
Diffstat (limited to 'rt/lib/RT')
-rw-r--r-- | rt/lib/RT/.Handle.pm.swp | bin | 61440 -> 0 bytes | |||
-rw-r--r-- | rt/lib/RT/.Ticket.pm.swp | bin | 16384 -> 0 bytes | |||
-rw-r--r-- | rt/lib/RT/Config.pm.orig | 1382 | ||||
-rw-r--r-- | rt/lib/RT/CustomField.pm.orig | 2170 | ||||
-rw-r--r-- | rt/lib/RT/EmailParser.pm.orig | 692 | ||||
-rwxr-xr-x | rt/lib/RT/Record.pm.orig | 2102 | ||||
-rwxr-xr-x | rt/lib/RT/Ticket.pm.orig | 4379 | ||||
-rwxr-xr-x | rt/lib/RT/Tickets.pm.orig | 3892 |
8 files changed, 0 insertions, 14617 deletions
diff --git a/rt/lib/RT/.Handle.pm.swp b/rt/lib/RT/.Handle.pm.swp Binary files differdeleted file mode 100644 index 5ae85734d..000000000 --- a/rt/lib/RT/.Handle.pm.swp +++ /dev/null diff --git a/rt/lib/RT/.Ticket.pm.swp b/rt/lib/RT/.Ticket.pm.swp Binary files differdeleted file mode 100644 index 7088d1bcf..000000000 --- a/rt/lib/RT/.Ticket.pm.swp +++ /dev/null diff --git a/rt/lib/RT/Config.pm.orig b/rt/lib/RT/Config.pm.orig deleted file mode 100644 index 62aae1c35..000000000 --- a/rt/lib/RT/Config.pm.orig +++ /dev/null @@ -1,1382 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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 }}} - -package RT::Config; - -use strict; -use warnings; - - -use File::Spec (); - -=head1 NAME - - RT::Config - RT's config - -=head1 SYNOPSYS - - # get config object - use RT::Config; - my $config = RT::Config->new; - $config->LoadConfigs; - - # get or set option - my $rt_web_path = $config->Get('WebPath'); - $config->Set(EmailOutputEncoding => 'latin1'); - - # get config object from RT package - use RT; - RT->LoadConfig; - my $config = RT->Config; - -=head1 DESCRIPTION - -C<RT::Config> class provide access to RT's and RT extensions' config files. - -RT uses two files for site configuring: - -First file is F<RT_Config.pm> - core config file. This file is shipped -with RT distribution and contains default values for all available options. -B<You should never edit this file.> - -Second file is F<RT_SiteConfig.pm> - site config file. You can use it -to customize your RT instance. In this file you can override any option -listed in core config file. - -RT extensions could also provide thier config files. Extensions should -use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for -config files, where <NAME> is extension name. - -B<NOTE>: All options from RT's config and extensions' configs are saved -in one place and thus extension could override RT's options, but it is not -recommended. - -=cut - -=head2 %META - -Hash of Config options that may be user overridable -or may require more logic than should live in RT_*Config.pm - -Keyed by config name, there are several properties that -can be set for each config optin: - - Section - What header this option should be grouped - under on the user Settings page - Overridable - Can users change this option - SortOrder - Within a Section, how should the options be sorted - for display to the user - Widget - Mason component path to widget that should be used - to display this config option - WidgetArguments - An argument hash passed to the WIdget - Description - Friendly description to show the user - Values - Arrayref of options (for select Widget) - ValuesLabel - Hashref, key is the Value from the Values - list, value is a user friendly description - of the value - Callback - subref that receives no arguments. It returns - a hashref of items that are added to the rest - of the WidgetArguments - PostLoadCheck - subref passed the RT::Config object and the current - setting of the config option. Can make further checks - (such as seeing if a library is installed) and then change - the setting of this or other options in the Config using - the RT::Config option. - Obfuscate - subref passed the RT::Config object, current setting of the config option - and a user object, can return obfuscated value. it's called in - RT->Config->GetObfuscated() - -=cut - -our %META = ( - # General user overridable options - DefaultQueue => { - Section => 'General', - Overridable => 1, - SortOrder => 1, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Default queue', #loc - Callback => sub { - my $ret = { Values => [], ValuesLabel => {}}; - my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'}); - $q->UnLimit; - while (my $queue = $q->Next) { - next unless $queue->CurrentUserHasRight("CreateTicket"); - push @{$ret->{Values}}, $queue->Id; - $ret->{ValuesLabel}{$queue->Id} = $queue->Name; - } - return $ret; - }, - } - }, - RememberDefaultQueue => { - Section => 'General', - Overridable => 1, - SortOrder => 2, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Remember default queue' # loc - } - }, - UsernameFormat => { - Section => 'General', - Overridable => 1, - SortOrder => 3, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Username format', # loc - Values => [qw(concise verbose)], - ValuesLabel => { - concise => 'Short usernames', # loc - verbose => 'Name and email address', # loc - }, - }, - }, - AutocompleteOwners => { - Section => 'General', - Overridable => 1, - SortOrder => 3.1, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Use autocomplete to find owners?', # loc - Hints => 'Replaces the owner dropdowns with textboxes' #loc - } - }, - WebDefaultStylesheet => { - Section => 'General', #loc - Overridable => 1, - SortOrder => 4, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Theme', #loc - # XXX: we need support for 'get values callback' - Values => [qw(web2 freeside2.1 freeside3 aileron ballard)], - }, - PostLoadCheck => sub { - my $self = shift; - my $value = $self->Get('WebDefaultStylesheet'); - - my @comp_roots = RT::Interface::Web->ComponentRoots; - for my $comp_root (@comp_roots) { - return if -d $comp_root.'/NoAuth/css/'.$value; - } - - $RT::Logger->warning( - "The default stylesheet ($value) does not exist in this instance of RT. " - . "Defaulting to freeside3." - ); - - #$self->Set('WebDefaultStylesheet', 'aileron'); - $self->Set('WebDefaultStylesheet', 'freeside3'); - }, - }, - UseSideBySideLayout => { - Section => 'Ticket composition', - Overridable => 1, - SortOrder => 5, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Use a two column layout for create and update forms?' # loc - } - }, - MessageBoxRichText => { - Section => 'Ticket composition', - Overridable => 1, - SortOrder => 5.1, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'WYSIWYG message composer' # loc - } - }, - MessageBoxRichTextHeight => { - Section => 'Ticket composition', - Overridable => 1, - SortOrder => 6, - Widget => '/Widgets/Form/Integer', - WidgetArguments => { - Description => 'WYSIWYG composer height', # loc - } - }, - MessageBoxWidth => { - Section => 'Ticket composition', - Overridable => 1, - SortOrder => 7, - Widget => '/Widgets/Form/Integer', - WidgetArguments => { - Description => 'Message box width', #loc - }, - }, - MessageBoxHeight => { - Section => 'Ticket composition', - Overridable => 1, - SortOrder => 8, - Widget => '/Widgets/Form/Integer', - WidgetArguments => { - Description => 'Message box height', #loc - }, - }, - MessageBoxWrap => { - Section => 'Ticket composition', #loc - Overridable => 1, - SortOrder => 8.1, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Message box wrapping', #loc - Values => [qw(SOFT HARD)], - Hints => "When the WYSIWYG editor is not enabled, this setting determines whether automatic line wraps in the ticket message box are sent to RT or not.", # loc - }, - }, - DefaultTimeUnitsToHours => { - Section => 'Ticket composition', #loc - Overridable => 1, - SortOrder => 9, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Enter time in hours by default', #loc - Hints => 'Only for entry, not display', #loc - }, - }, - SearchResultsRefreshInterval => { - Section => 'General', #loc - Overridable => 1, - SortOrder => 9, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Search results refresh interval', #loc - Values => [qw(0 120 300 600 1200 3600 7200)], - ValuesLabel => { - 0 => "Don't refresh search results.", #loc - 120 => "Refresh search results every 2 minutes.", #loc - 300 => "Refresh search results every 5 minutes.", #loc - 600 => "Refresh search results every 10 minutes.", #loc - 1200 => "Refresh search results every 20 minutes.", #loc - 3600 => "Refresh search results every 60 minutes.", #loc - 7200 => "Refresh search results every 120 minutes.", #loc - }, - }, - }, - - # User overridable options for RT at a glance - HomePageRefreshInterval => { - Section => 'RT at a glance', #loc - Overridable => 1, - SortOrder => 2, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Home page refresh interval', #loc - Values => [qw(0 120 300 600 1200 3600 7200)], - ValuesLabel => { - 0 => "Don't refresh home page.", #loc - 120 => "Refresh home page every 2 minutes.", #loc - 300 => "Refresh home page every 5 minutes.", #loc - 600 => "Refresh home page every 10 minutes.", #loc - 1200 => "Refresh home page every 20 minutes.", #loc - 3600 => "Refresh home page every 60 minutes.", #loc - 7200 => "Refresh home page every 120 minutes.", #loc - }, - }, - }, - - # User overridable options for Ticket displays - MaxInlineBody => { - Section => 'Ticket display', #loc - Overridable => 1, - SortOrder => 1, - Widget => '/Widgets/Form/Integer', - WidgetArguments => { - Description => 'Maximum inline message length', #loc - Hints => - "Length in characters; Use '0' to show all messages inline, regardless of length" #loc - }, - }, - OldestTransactionsFirst => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 2, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Show oldest history first', #loc - }, - }, - DeferTransactionLoading => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 3, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Hide ticket history by default', #loc - }, - }, - ShowUnreadMessageNotifications => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 4, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Notify me of unread messages', #loc - }, - - }, - PlainTextPre => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 5, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'add <pre> tag around plain text attachments', #loc - Hints => "Use this to protect the format of plain text" #loc - }, - }, - PlainTextMono => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 5, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'display wrapped and formatted plain text attachments', #loc - Hints => 'Use css rules to display text monospaced and with formatting preserved, but wrap as needed. This does not work well with IE6 and you should use the previous option', #loc - }, - }, - DisplayAfterQuickCreate => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 6, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'On Quick Create, redirect to ticket display', #loc - #Hints => '', #loc - }, - }, - MoreAboutRequestorTicketList => { - Section => 'Ticket display', #loc - Overridable => 1, - SortOrder => 6, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => q|What tickets to display in the 'More about requestor' box|, #loc - Values => [qw(Active Inactive All None)], - ValuesLabel => { - Active => "Show the Requestor's 10 highest priority active tickets", #loc - Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc - All => "Show the Requestor's 10 highest priority tickets", #loc - None => "Show no tickets for the Requestor", #loc - }, - }, - }, - SimplifiedRecipients => { - Section => 'Ticket display', #loc - Overridable => 1, - SortOrder => 7, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => q|Show simplified recipient list on ticket update|, #loc - }, - }, - DisplayTicketAfterQuickCreate => { - Section => 'Ticket display', - Overridable => 1, - SortOrder => 8, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => q{Display ticket after "Quick Create"}, #loc - }, - }, - - # User overridable locale options - DateTimeFormat => { - Section => 'Locale', #loc - Overridable => 1, - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Date format', #loc - Callback => sub { my $ret = { Values => [], ValuesLabel => {}}; - my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'}); - $date->SetToNow; - foreach my $value ($date->Formatters) { - push @{$ret->{Values}}, $value; - $ret->{ValuesLabel}{$value} = $date->Get( - Format => $value, - Timezone => 'user', - ); - } - return $ret; - }, - }, - }, - - RTAddressRegexp => { - Type => 'SCALAR', - PostLoadCheck => sub { - my $self = shift; - my $value = $self->Get('RTAddressRegexp'); - if (not $value) { - $RT::Logger->debug( - 'The RTAddressRegexp option is not set in the config.' - .' Not setting this option results in additional SQL queries to' - .' check whether each address belongs to RT or not.' - .' It is especially important to set this option if RT recieves' - .' emails on addresses that are not in the database or config.' - ); - } elsif (ref $value and ref $value eq "Regexp") { - # Ensure that the regex is case-insensitive; while the - # local part of email addresses is _technically_ - # case-sensitive, most MTAs don't treat it as such. - $RT::Logger->warning( - 'RTAddressRegexp is set to a case-sensitive regular expression.' - .' This may lead to mail loops with MTAs which treat the' - .' local part as case-insensitive -- which is most of them.' - ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/; - } - }, - }, - # User overridable mail options - EmailFrequency => { - Section => 'Mail', #loc - Overridable => 1, - Default => 'Individual messages', - Widget => '/Widgets/Form/Select', - WidgetArguments => { - Description => 'Email delivery', #loc - Values => [ - 'Individual messages', #loc - 'Daily digest', #loc - 'Weekly digest', #loc - 'Suspended' #loc - ] - } - }, - NotifyActor => { - Section => 'Mail', #loc - Overridable => 1, - SortOrder => 2, - Widget => '/Widgets/Form/Boolean', - WidgetArguments => { - Description => 'Outgoing mail', #loc - Hints => 'Should RT send you mail for ticket updates you make?', #loc - } - }, - - # this tends to break extensions that stash links in ticket update pages - Organization => { - Type => 'SCALAR', - PostLoadCheck => sub { - my ($self,$value) = @_; - $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.") - if $value =~ /\s/;; - }, - }, - - # Internal config options - FullTextSearch => { - Type => 'HASH', - PostLoadCheck => sub { - my $self = shift; - my $v = $self->Get('FullTextSearch'); - return unless $v->{Enable} and $v->{Indexed}; - my $dbtype = $self->Get('DatabaseType'); - if ($dbtype eq 'Oracle') { - if (not $v->{IndexName}) { - $RT::Logger->error("No IndexName set for full-text index; disabling"); - $v->{Enable} = $v->{Indexed} = 0; - } - } elsif ($dbtype eq 'Pg') { - my $bad = 0; - if (not $v->{'Column'}) { - $RT::Logger->error("No Column set for full-text index; disabling"); - $v->{Enable} = $v->{Indexed} = 0; - } elsif ($v->{'Column'} eq "Content" - and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) { - $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling"); - $v->{Enable} = $v->{Indexed} = 0; - } - } elsif ($dbtype eq 'mysql') { - if (not $v->{'Table'}) { - $RT::Logger->error("No Table set for full-text index; disabling"); - $v->{Enable} = $v->{Indexed} = 0; - } elsif ($v->{'Table'} eq "Attachments") { - $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling"); - $v->{Enable} = $v->{Indexed} = 0; - } elsif (not $v->{'MaxMatches'}) { - $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000"); - $v->{MaxMatches} = 10_000; - } - } else { - $RT::Logger->error("Indexed full-text-search not supported for $dbtype"); - $v->{Indexed} = 0; - } - }, - }, - DisableGraphViz => { - Type => 'SCALAR', - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - return if $value; - return if $INC{'GraphViz.pm'}; - local $@; - return if eval {require GraphViz; 1}; - $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@"); - $self->Set( DisableGraphViz => 1 ); - }, - }, - DisableGD => { - Type => 'SCALAR', - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - return if $value; - return if $INC{'GD.pm'}; - local $@; - return if eval {require GD; 1}; - $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@"); - $self->Set( DisableGD => 1 ); - }, - }, - MailPlugins => { Type => 'ARRAY' }, - Plugins => { - Type => 'ARRAY', - PostLoadCheck => sub { - my $self = shift; - my $value = $self->Get('Plugins'); - # XXX Remove in RT 4.2 - return unless $value and grep {$_ eq "RT::FM"} @{$value}; - warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins'; - }, - }, - GnuPG => { Type => 'HASH' }, - GnuPGOptions => { Type => 'HASH', - PostLoadCheck => sub { - my $self = shift; - my $gpg = $self->Get('GnuPG'); - return unless $gpg->{'Enable'}; - my $gpgopts = $self->Get('GnuPGOptions'); - unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg - $RT::Logger->debug( - "RT's GnuPG libraries couldn't successfully read your". - " configured GnuPG home directory (".$gpgopts->{homedir} - ."). PGP support has been disabled"); - $gpg->{'Enable'} = 0; - return; - } - - - require RT::Crypt::GnuPG; - unless (RT::Crypt::GnuPG->Probe()) { - $RT::Logger->debug( - "RT's GnuPG libraries couldn't successfully execute gpg.". - " PGP support has been disabled"); - $gpg->{'Enable'} = 0; - } - } - }, - ReferrerWhitelist => { Type => 'ARRAY' }, - ResolveDefaultUpdateType => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - return unless $value; - $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated. '. - 'You can change the site default in your %Lifecycles config.'); - } - }, - WebPath => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - - # "In most cases, you should leave $WebPath set to '' (an empty value)." - return unless $value; - - # try to catch someone who assumes that you shouldn't leave this empty - if ($value eq '/') { - $RT::Logger->error("For the WebPath config option, use the empty string instead of /"); - return; - } - - # $WebPath requires a leading / but no trailing /, or it can be blank. - return if $value =~ m{^/.+[^/]$}; - - if ($value =~ m{/$}) { - $RT::Logger->error("The WebPath config option requires no trailing slash"); - } - - if ($value !~ m{^/}) { - $RT::Logger->error("The WebPath config option requires a leading slash"); - } - }, - }, - WebDomain => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - - if (!$value) { - $RT::Logger->error("You must set the WebDomain config option"); - return; - } - - if ($value =~ m{^(\w+://)}) { - $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)"); - return; - } - - if ($value =~ m{(/.*)}) { - $RT::Logger->error("The WebDomain config option must not contain a path ($1)"); - return; - } - - if ($value =~ m{:(\d*)}) { - $RT::Logger->error("The WebDomain config option must not contain a port ($1)"); - return; - } - }, - }, - WebPort => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - - if (!$value) { - $RT::Logger->error("You must set the WebPort config option"); - return; - } - - if ($value !~ m{^\d+$}) { - $RT::Logger->error("The WebPort config option must be an integer"); - } - }, - }, - WebBaseURL => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - - if (!$value) { - $RT::Logger->error("You must set the WebBaseURL config option"); - return; - } - - if ($value !~ m{^https?://}i) { - $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)"); - } - - if ($value =~ m{/$}) { - $RT::Logger->error("The WebBaseURL config option requires no trailing slash"); - } - - if ($value =~ m{^https?://.+?(/[^/].*)}i) { - $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)"); - } - }, - }, - WebURL => { - PostLoadCheck => sub { - my $self = shift; - my $value = shift; - - if (!$value) { - $RT::Logger->error("You must set the WebURL config option"); - return; - } - - if ($value !~ m{^https?://}i) { - $RT::Logger->error("The WebURL config option must contain a scheme (http or https)"); - } - - if ($value !~ m{/$}) { - $RT::Logger->error("The WebURL config option requires a trailing slash"); - } - }, - }, - EmailInputEncodings => { - Type => 'ARRAY', - PostLoadCheck => sub { - my $self = shift; - my $value = $self->Get('EmailInputEncodings'); - return unless $value && @$value; - - my %seen; - foreach my $encoding ( grep defined && length, splice @$value ) { - next if $seen{ $encoding }; - if ( $encoding eq '*' ) { - unshift @$value, '*'; - next; - } - - my $canonic = Encode::resolve_alias( $encoding ); - unless ( $canonic ) { - warn "Unknown encoding '$encoding' in \@EmailInputEncodings option"; - } - elsif ( $seen{ $canonic }++ ) { - next; - } - else { - push @$value, $canonic; - } - } - }, - }, - - ActiveStatus => { - Type => 'ARRAY', - PostLoadCheck => sub { - my $self = shift; - return unless shift; - # XXX Remove in RT 4.2 - warn <<EOT; -The ActiveStatus configuration has been replaced by the new Lifecycles -functionality. You should set the 'active' property of the 'default' -lifecycle and add transition rules; see RT_Config.pm for documentation. -EOT - }, - }, - InactiveStatus => { - Type => 'ARRAY', - PostLoadCheck => sub { - my $self = shift; - return unless shift; - # XXX Remove in RT 4.2 - warn <<EOT; -The InactiveStatus configuration has been replaced by the new Lifecycles -functionality. You should set the 'inactive' property of the 'default' -lifecycle and add transition rules; see RT_Config.pm for documentation. -EOT - }, - }, -); -my %OPTIONS = (); - -=head1 METHODS - -=head2 new - -Object constructor returns new object. Takes no arguments. - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) ? ref($proto) : $proto; - my $self = bless {}, $class; - $self->_Init(@_); - return $self; -} - -sub _Init { - return; -} - -=head2 InitConfig - -Do nothin right now. - -=cut - -sub InitConfig { - my $self = shift; - my %args = ( File => '', @_ ); - $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/; - return 1; -} - -=head2 LoadConfigs - -Load all configs. First of all load RT's config then load -extensions' config files in alphabetical order. -Takes no arguments. - -=cut - -sub LoadConfigs { - my $self = shift; - - $self->InitConfig( File => 'RT_Config.pm' ); - $self->LoadConfig( File => 'RT_Config.pm' ); - - my @configs = $self->Configs; - $self->InitConfig( File => $_ ) foreach @configs; - $self->LoadConfig( File => $_ ) foreach @configs; - return; -} - -=head1 LoadConfig - -Takes param hash with C<File> field. -First, the site configuration file is loaded, in order to establish -overall site settings like hostname and name of RT instance. -Then, the core configuration file is loaded to set fallback values -for all settings; it bases some values on settings from the site -configuration file. - -B<Note> that core config file don't change options if site config -has set them so to add value to some option instead of -overriding you have to copy original value from core config file. - -=cut - -sub LoadConfig { - my $self = shift; - my %args = ( File => '', @_ ); - $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/; - if ( $args{'File'} eq 'RT_SiteConfig.pm' - and my $site_config = $ENV{RT_SITE_CONFIG} ) - { - $self->_LoadConfig( %args, File => $site_config ); - } else { - $self->_LoadConfig(%args); - } - $args{'File'} =~ s/Site(?=Config\.pm$)//; - $self->_LoadConfig(%args); - return 1; -} - -sub _LoadConfig { - my $self = shift; - my %args = ( File => '', @_ ); - - my ($is_ext, $is_site); - if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) { - ($is_ext, $is_site) = ('', 1); - } else { - $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : ''; - $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0; - } - - eval { - package RT; - local *Set = sub(\[$@%]@) { - my ( $opt_ref, @args ) = @_; - my ( $pack, $file, $line ) = caller; - return $self->SetFromConfig( - Option => $opt_ref, - Value => [@args], - Package => $pack, - File => $file, - Line => $line, - SiteConfig => $is_site, - Extension => $is_ext, - ); - }; - my @etc_dirs = ($RT::LocalEtcPath); - push @etc_dirs, RT->PluginDirs('etc') if $is_ext; - push @etc_dirs, $RT::EtcPath, @INC; - local @INC = @etc_dirs; - require $args{'File'}; - }; - if ($@) { - return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/; - if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) { - die qq{Couldn't load RT config file $args{'File'}:\n\n$@}; - } - - my $username = getpwuid($>); - my $group = getgrgid($(); - - my ( $file_path, $fileuid, $filegid ); - foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) { - my $tmp = File::Spec->catfile( $_, $args{File} ); - ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ]; - if ( defined $fileuid ) { - $file_path = $tmp; - last; - } - } - unless ($file_path) { - die - qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n} - . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@}; - } - - my $message = <<EOF; - -RT couldn't load RT config file %s as: - user: $username - group: $group - -The file is owned by user %s and group %s. - -This usually means that the user/group your webserver is running -as cannot read the file. Be careful not to make the permissions -on this file too liberal, because it contains database passwords. -You may need to put the webserver user in the appropriate group -(%s) or change permissions be able to run succesfully. -EOF - - my $fileusername = getpwuid($fileuid); - my $filegroup = getgrgid($filegid); - my $errormessage = sprintf( $message, - $file_path, $fileusername, $filegroup, $filegroup ); - die "$errormessage\n$@"; - } - return 1; -} - -sub PostLoadCheck { - my $self = shift; - foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) { - $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) ); - } -} - -=head2 Configs - -Returns list of config files found in local etc, plugins' etc -and main etc directories. - -=cut - -sub Configs { - my $self = shift; - - my @configs = (); - foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) { - my $mask = File::Spec->catfile( $path, "*_Config.pm" ); - my @files = glob $mask; - @files = grep !/^RT_Config\.pm$/, - grep $_ && /^\w+_Config\.pm$/, - map { s/^.*[\\\/]//; $_ } @files; - push @configs, sort @files; - } - - my %seen; - @configs = grep !$seen{$_}++, @configs; - return @configs; -} - -=head2 Get - -Takes name of the option as argument and returns its current value. - -In the case of a user-overridable option, first checks the user's -preferences before looking for site-wide configuration. - -Returns values from RT_SiteConfig, RT_Config and then the %META hash -of configuration variables's "Default" for this config variable, -in that order. - -Returns different things in scalar and array contexts. For scalar -options it's not that important, however for arrays and hash it's. -In scalar context returns references to arrays and hashes. - -Use C<scalar> perl's op to force context, especially when you use -C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)> -as perl's '=>' op doesn't change context of the right hand argument to -scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>. - -It's also important for options that have no default value(no default -in F<etc/RT_Config.pm>). If you don't force scalar context then you'll -get empty list and all your named args will be messed up. For example -C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)> -will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably -unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)> -will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>. - -=cut - -sub Get { - my ( $self, $name, $user ) = @_; - - my $res; - if ( $user && $user->id && $META{$name}->{'Overridable'} ) { - $user = $user->UserObj if $user->isa('RT::CurrentUser'); - my $prefs = $user->Preferences($RT::System); - $res = $prefs->{$name} if $prefs; - } - $res = $OPTIONS{$name} unless defined $res; - $res = $META{$name}->{'Default'} unless defined $res; - return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); -} - -=head2 GetObfuscated - -the same as Get, except it returns Obfuscated value via Obfuscate sub - -=cut - -sub GetObfuscated { - my $self = shift; - my ( $name, $user ) = @_; - my $obfuscate = $META{$name}->{Obfuscate}; - - # we use two Get here is to simplify the logic of the return value - # configs need obfuscation are supposed to be less, so won't be too heavy - - return $self->Get(@_) unless $obfuscate; - - my $res = $self->Get(@_); - $res = $obfuscate->( $self, $res, $user ); - return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); -} - -=head2 Set - -Set option's value to new value. Takes name of the option and new value. -Returns old value. - -The new value should be scalar, array or hash depending on type of the option. -If the option is not defined in meta or the default RT config then it is of -scalar type. - -=cut - -sub Set { - my ( $self, $name ) = ( shift, shift ); - - my $old = $OPTIONS{$name}; - my $type = $META{$name}->{'Type'} || 'SCALAR'; - if ( $type eq 'ARRAY' ) { - $OPTIONS{$name} = [@_]; - { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); } - } elsif ( $type eq 'HASH' ) { - $OPTIONS{$name} = {@_}; - { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); } - } else { - $OPTIONS{$name} = shift; - {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; } - } - $META{$name}->{'Type'} = $type; - return $self->_ReturnValue( $old, $type ); -} - -sub _ReturnValue { - my ( $self, $res, $type ) = @_; - return $res unless wantarray; - - if ( $type eq 'ARRAY' ) { - return @{ $res || [] }; - } elsif ( $type eq 'HASH' ) { - return %{ $res || {} }; - } - return $res; -} - -sub SetFromConfig { - my $self = shift; - my %args = ( - Option => undef, - Value => [], - Package => 'RT', - File => '', - Line => 0, - SiteConfig => 1, - Extension => 0, - @_ - ); - - unless ( $args{'File'} ) { - ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1); - } - - my $opt = $args{'Option'}; - - my $type; - my $name = $self->__GetNameByRef($opt); - if ($name) { - $type = ref $opt; - $name =~ s/.*:://; - } else { - $name = $$opt; - $type = $META{$name}->{'Type'} || 'SCALAR'; - } - - # if option is already set we have to check where - # it comes from and may be ignore it - if ( exists $OPTIONS{$name} ) { - if ( $type eq 'HASH' ) { - $args{'Value'} = [ - @{ $args{'Value'} }, - @{ $args{'Value'} }%2? (undef) : (), - $self->Get( $name ), - ]; - } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) { - # if it's site config of an extension then it can only - # override options that came from its main config - if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) { - my %source = %{ $META{$name}->{'Source'} }; - warn - "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." - ." This option earlier has been set in $source{'File'} line $source{'Line'}." - ." To overide this option use ". ($source{'Extension'}||'RT') - ." site config." - ; - return 1; - } - } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) { - # if it's core config then we can override any option that came from another - # core config, but not site config - - my %source = %{ $META{$name}->{'Source'} }; - if ( $source{'Extension'} ne $args{'Extension'} ) { - # as a site config is loaded earlier then its base config - # then we warn only on different extensions, for example - # RTIR's options is set in main site config - warn - "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." - ." It may be ok, but we want you to be aware." - ." This option has been set earlier in $source{'File'} line $source{'Line'}." - ; - } - - return 1; - } - } - - $META{$name}->{'Type'} = $type; - foreach (qw(Package File Line SiteConfig Extension)) { - $META{$name}->{'Source'}->{$_} = $args{$_}; - } - $self->Set( $name, @{ $args{'Value'} } ); - - return 1; -} - - our %REF_SYMBOLS = ( - SCALAR => '$', - ARRAY => '@', - HASH => '%', - CODE => '&', - ); - -{ - my $last_pack = ''; - - sub __GetNameByRef { - my $self = shift; - my $ref = shift; - my $pack = shift; - if ( !$pack && $last_pack ) { - my $tmp = $self->__GetNameByRef( $ref, $last_pack ); - return $tmp if $tmp; - } - $pack ||= 'main::'; - $pack .= '::' unless substr( $pack, -2 ) eq '::'; - - no strict 'refs'; - my $name = undef; - - # scan $pack's nametable(hash) - foreach my $k ( keys %{$pack} ) { - - # The hash for main:: has a reference to itself - next if $k eq 'main::'; - - # if the entry has a trailing '::' then - # it is a link to another name space - if ( substr( $k, -2 ) eq '::') { - $name = $self->__GetNameByRef( $ref, $pack eq 'main::'? $k : $pack.$k ); - return $name if $name; - } - - # entry of the table with references to - # SCALAR, ARRAY... and other types with - # the same name - my $entry = ${$pack}{$k}; - next unless $entry; - - # Inlined constants are simplified in the symbol table -- - # namely, when possible, you only get a reference back in - # $entry, rather than a full GLOB. In 5.10, scalar - # constants began being inlined this way; starting in 5.20, - # list constants are also inlined. Notably, ref(GLOB) is - # undef, but inlined constants are currently either REF, - # SCALAR, or ARRAY. - next if ref($entry); - - my $ref_type = ref($ref); - - # regex/arrayref/hashref/coderef are stored in SCALAR glob - $ref_type = 'SCALAR' if $ref_type eq 'REF'; - - my $entry_ref = *{$entry}{ $ref_type }; - next if ref $entry_ref && ref $entry_ref ne ref $ref; - next unless $entry_ref; - - # if references are equal then we've found - if ( $entry_ref == $ref ) { - $last_pack = $pack; - return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k; - } - } - return ''; - } -} - -=head2 Metadata - - -=head2 Meta - -=cut - -sub Meta { - return $META{ $_[1] }; -} - -sub Sections { - my $self = shift; - my %seen; - my @sections = sort - grep !$seen{$_}++, - map $_->{'Section'} || 'General', - values %META; - return @sections; -} - -sub Options { - my $self = shift; - my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ ); - my @res = keys %META; - - @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'}, - @res - ) if defined $args{'Section'}; - - if ( defined $args{'Overridable'} ) { - @res - = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'}, - @res ); - } - - if ( $args{'Sorted'} ) { - @res = sort { - ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999) - || $a cmp $b - } @res; - } else { - @res = sort { $a cmp $b } @res; - } - return @res; -} - -=head2 AddOption( Name => '', Section => '', ... ) - -=cut - -sub AddOption { - my $self = shift; - my %args = ( - Name => undef, - Section => undef, - Overridable => 0, - SortOrder => undef, - Widget => '/Widgets/Form/String', - WidgetArguments => {}, - @_ - ); - - unless ( $args{Name} ) { - $RT::Logger->error("Need Name to add a new config"); - return; - } - - unless ( $args{Section} ) { - $RT::Logger->error("Need Section to add a new config option"); - return; - } - - $META{ delete $args{Name} } = \%args; -} - -=head2 DeleteOption( Name => '' ) - -=cut - -sub DeleteOption { - my $self = shift; - my %args = ( - Name => undef, - @_ - ); - if ( $args{Name} ) { - delete $META{$args{Name}}; - } - else { - $RT::Logger->error("Need Name to remove a config option"); - return; - } -} - -=head2 UpdateOption( Name => '' ), Section => '', ... ) - -=cut - -sub UpdateOption { - my $self = shift; - my %args = ( - Name => undef, - Section => undef, - Overridable => undef, - SortOrder => undef, - Widget => undef, - WidgetArguments => undef, - @_ - ); - - my $name = delete $args{Name}; - - unless ( $name ) { - $RT::Logger->error("Need Name to update a new config"); - return; - } - - unless ( exists $META{$name} ) { - $RT::Logger->error("Config $name doesn't exist"); - return; - } - - for my $type ( keys %args ) { - next unless defined $args{$type}; - $META{$name}{$type} = $args{$type}; - } - return 1; -} - -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/CustomField.pm.orig b/rt/lib/RT/CustomField.pm.orig deleted file mode 100644 index e71bbf78a..000000000 --- a/rt/lib/RT/CustomField.pm.orig +++ /dev/null @@ -1,2170 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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 }}} - -package RT::CustomField; - -use strict; -use warnings; - -use Scalar::Util 'blessed'; - -use base 'RT::Record'; - -sub Table {'CustomFields'} - - -use RT::CustomFieldValues; -use RT::ObjectCustomFields; -use RT::ObjectCustomFieldValues; - -our %FieldTypes = ( - Select => { - sort_order => 10, - selection_type => 1, - - labels => [ 'Select multiple values', # loc - 'Select one value', # loc - 'Select up to [_1] values', # loc - ], - - render_types => { - multiple => [ - - # Default is the first one - 'Select box', # loc - 'List', # loc - ], - single => [ 'Select box', # loc - 'Dropdown', # loc - 'List', # loc - ] - }, - - }, - Freeform => { - sort_order => 20, - selection_type => 0, - - labels => [ 'Enter multiple values', # loc - 'Enter one value', # loc - 'Enter up to [_1] values', # loc - ] - }, - Text => { - sort_order => 30, - selection_type => 0, - labels => [ - 'Fill in multiple text areas', # loc - 'Fill in one text area', # loc - 'Fill in up to [_1] text areas', # loc - ] - }, - Wikitext => { - sort_order => 40, - selection_type => 0, - labels => [ - 'Fill in multiple wikitext areas', # loc - 'Fill in one wikitext area', # loc - 'Fill in up to [_1] wikitext areas', # loc - ] - }, - - Image => { - sort_order => 50, - selection_type => 0, - labels => [ - 'Upload multiple images', # loc - 'Upload one image', # loc - 'Upload up to [_1] images', # loc - ] - }, - Binary => { - sort_order => 60, - selection_type => 0, - labels => [ - 'Upload multiple files', # loc - 'Upload one file', # loc - 'Upload up to [_1] files', # loc - ] - }, - - Combobox => { - sort_order => 70, - selection_type => 1, - labels => [ - 'Combobox: Select or enter multiple values', # loc - 'Combobox: Select or enter one value', # loc - 'Combobox: Select or enter up to [_1] values', # loc - ] - }, - Autocomplete => { - sort_order => 80, - selection_type => 1, - labels => [ - 'Enter multiple values with autocompletion', # loc - 'Enter one value with autocompletion', # loc - 'Enter up to [_1] values with autocompletion', # loc - ] - }, - - Date => { - sort_order => 90, - selection_type => 0, - labels => [ - 'Select multiple dates', # loc - 'Select date', # loc - 'Select up to [_1] dates', # loc - ] - }, - DateTime => { - sort_order => 100, - selection_type => 0, - labels => [ - 'Select multiple datetimes', # loc - 'Select datetime', # loc - 'Select up to [_1] datetimes', # loc - ] - }, - TimeValue => { - sort_order => 105, - selection_type => 0, - labels => [ - 'Enter multiple time values (UNSUPPORTED)', - 'Enter a time value', - 'Enter [_1] time values (UNSUPPORTED)', - ] - }, - - IPAddress => { - sort_order => 110, - selection_type => 0, - - labels => [ 'Enter multiple IP addresses', # loc - 'Enter one IP address', # loc - 'Enter up to [_1] IP addresses', # loc - ] - }, - IPAddressRange => { - sort_order => 120, - selection_type => 0, - - labels => [ 'Enter multiple IP address ranges', # loc - 'Enter one IP address range', # loc - 'Enter up to [_1] IP address ranges', # loc - ] - }, -); - - -our %FRIENDLY_OBJECT_TYPES = (); - -RT::CustomField->_ForObjectType( 'RT::Queue-RT::Ticket' => "Tickets", ); #loc -RT::CustomField->_ForObjectType( - 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", ); #loc -RT::CustomField->_ForObjectType( 'RT::User' => "Users", ); #loc -RT::CustomField->_ForObjectType( 'RT::Queue' => "Queues", ); #loc -RT::CustomField->_ForObjectType( 'RT::Group' => "Groups", ); #loc - -our $RIGHTS = { - SeeCustomField => 'View custom fields', # loc_pair - AdminCustomField => 'Create, modify and delete custom fields', # loc_pair - AdminCustomFieldValues => 'Create, modify and delete custom fields values', # loc_pair - ModifyCustomField => 'Add, modify and delete custom field values for objects' # loc_pair -}; - -our $RIGHT_CATEGORIES = { - SeeCustomField => 'General', - AdminCustomField => 'Admin', - AdminCustomFieldValues => 'Admin', - ModifyCustomField => 'Staff', -}; - -# Tell RT::ACE that this sort of object can get acls granted -$RT::ACE::OBJECT_TYPES{'RT::CustomField'} = 1; - -__PACKAGE__->AddRights(%$RIGHTS); -__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES); - -=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...] - -Adds the given rights to the list of possible rights. This method -should be called during server startup, not at runtime. - -=cut - -sub AddRights { - my $self = shift; - my %new = @_; - $RIGHTS = { %$RIGHTS, %new }; - %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES, - map { lc($_) => $_ } keys %new); -} - -sub AvailableRights { - my $self = shift; - return $RIGHTS; -} - -=head2 RightCategories - -Returns a hashref where the keys are rights for this type of object and the -values are the category (General, Staff, Admin) the right falls into. - -=cut - -sub RightCategories { - return $RIGHT_CATEGORIES; -} - -=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...] - -Adds the given right and category pairs to the list of right categories. This -method should be called during server startup, not at runtime. - -=cut - -sub AddRightCategories { - my $self = shift if ref $_[0] or $_[0] eq __PACKAGE__; - my %new = @_; - $RIGHT_CATEGORIES = { %$RIGHT_CATEGORIES, %new }; -} - -=head1 NAME - - RT::CustomField_Overlay - overlay for RT::CustomField - -=head1 DESCRIPTION - -=head1 'CORE' METHODS - -=head2 Create PARAMHASH - -Create takes a hash of values and creates a row in the database: - - varchar(200) 'Name'. - varchar(200) 'Type'. - int(11) 'MaxValues'. - varchar(255) 'Pattern'. - smallint(6) 'Repeated'. - varchar(255) 'Description'. - int(11) 'SortOrder'. - varchar(255) 'LookupType'. - smallint(6) 'Disabled'. - -C<LookupType> is generally the result of either -C<RT::Ticket->CustomFieldLookupType> or C<RT::Transaction->CustomFieldLookupType>. - -=cut - -sub Create { - my $self = shift; - my %args = ( - Name => '', - Type => '', - MaxValues => 0, - Pattern => '', - Description => '', - Disabled => 0, - LookupType => '', - Repeated => 0, - LinkValueTo => '', - IncludeContentForValue => '', - @_, - ); - - unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) { - return (0, $self->loc('Permission Denied')); - } - - if ( $args{TypeComposite} ) { - @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2); - } - elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) { - # old style Type string - $args{'MaxValues'} = $1 ? 1 : 0; - } - $args{'MaxValues'} = int $args{'MaxValues'}; - - if ( !exists $args{'Queue'}) { - # do nothing -- things below are strictly backward compat - } - elsif ( ! $args{'Queue'} ) { - unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) { - return ( 0, $self->loc('Permission Denied') ); - } - $args{'LookupType'} = 'RT::Queue-RT::Ticket'; - } - else { - my $queue = RT::Queue->new($self->CurrentUser); - $queue->Load($args{'Queue'}); - unless ($queue->Id) { - return (0, $self->loc("Queue not found")); - } - unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) { - return ( 0, $self->loc('Permission Denied') ); - } - $args{'LookupType'} = 'RT::Queue-RT::Ticket'; - $args{'Queue'} = $queue->Id; - } - - my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} ); - return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok; - - if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) { - $RT::Logger->debug("Support for 'multiple' Texts or Comboboxes is not implemented"); - $args{'MaxValues'} = 1; - } - - if ( $args{'RenderType'} ||= undef ) { - my $composite = join '-', @args{'Type', 'MaxValues'}; - return (0, $self->loc("This custom field has no Render Types")) - unless $self->HasRenderTypes( $composite ); - - if ( $args{'RenderType'} eq $self->DefaultRenderType( $composite ) ) { - $args{'RenderType'} = undef; - } else { - return (0, $self->loc("Invalid Render Type") ) - unless grep $_ eq $args{'RenderType'}, $self->RenderTypes( $composite ); - } - } - - $args{'ValuesClass'} = undef if ($args{'ValuesClass'} || '') eq 'RT::CustomFieldValues'; - if ( $args{'ValuesClass'} ||= undef ) { - return (0, $self->loc("This Custom Field can not have list of values")) - unless $self->IsSelectionType( $args{'Type'} ); - - unless ( $self->ValidateValuesClass( $args{'ValuesClass'} ) ) { - return (0, $self->loc("Invalid Custom Field values source")); - } - } - - (my $rv, $msg) = $self->SUPER::Create( - Name => $args{'Name'}, - Type => $args{'Type'}, - RenderType => $args{'RenderType'}, - MaxValues => $args{'MaxValues'}, - Pattern => $args{'Pattern'}, - BasedOn => $args{'BasedOn'}, - ValuesClass => $args{'ValuesClass'}, - Description => $args{'Description'}, - Disabled => $args{'Disabled'}, - LookupType => $args{'LookupType'}, - Repeated => $args{'Repeated'}, - ); - - if ($rv) { - if ( exists $args{'LinkValueTo'}) { - $self->SetLinkValueTo($args{'LinkValueTo'}); - } - - if ( exists $args{'IncludeContentForValue'}) { - $self->SetIncludeContentForValue($args{'IncludeContentForValue'}); - } - - if ( exists $args{'UILocation'} ) { - $self->SetUILocation( $args{'UILocation'} ); - } - - if ( exists $args{'NoClone'} ) { - $self->SetNoClone( $args{'NoClone'} ); - } - - return ($rv, $msg) unless exists $args{'Queue'}; - - # Compat code -- create a new ObjectCustomField mapping - my $OCF = RT::ObjectCustomField->new( $self->CurrentUser ); - $OCF->Create( - CustomField => $self->Id, - ObjectId => $args{'Queue'}, - ); - } - - return ($rv, $msg); -} - -=head2 Load ID/NAME - -Load a custom field. If the value handed in is an integer, load by custom field ID. Otherwise, Load by name. - -=cut - -sub Load { - my $self = shift; - my $id = shift || ''; - - if ( $id =~ /^\d+$/ ) { - return $self->SUPER::Load( $id ); - } else { - return $self->LoadByName( Name => $id ); - } -} - - - -=head2 LoadByName (Queue => QUEUEID, Name => NAME) - -Loads the Custom field named NAME. - -Will load a Disabled Custom Field even if there is a non-disabled Custom Field -with the same Name. - -If a Queue parameter is specified, only look for ticket custom fields tied to that Queue. - -If the Queue parameter is '0', look for global ticket custom fields. - -If no queue parameter is specified, look for any and all custom fields with this name. - -BUG/TODO, this won't let you specify that you only want user or group CFs. - -=cut - -# Compatibility for API change after 3.0 beta 1 -*LoadNameAndQueue = \&LoadByName; -# Change after 3.4 beta. -*LoadByNameAndQueue = \&LoadByName; - -sub LoadByName { - my $self = shift; - my %args = ( - Queue => undef, - Name => undef, - @_, - ); - - unless ( defined $args{'Name'} && length $args{'Name'} ) { - $RT::Logger->error("Couldn't load Custom Field without Name"); - return wantarray ? (0, $self->loc("No name provided")) : 0; - } - - # if we're looking for a queue by name, make it a number - if ( defined $args{'Queue'} && ($args{'Queue'} =~ /\D/ || !$self->ContextObject) ) { - my $QueueObj = RT::Queue->new( $self->CurrentUser ); - $QueueObj->Load( $args{'Queue'} ); - $args{'Queue'} = $QueueObj->Id; - $self->SetContextObject( $QueueObj ) - unless $self->ContextObject; - } - - # XXX - really naive implementation. Slow. - not really. still just one query - - my $CFs = RT::CustomFields->new( $self->CurrentUser ); - $CFs->SetContextObject( $self->ContextObject ); - my $field = $args{'Name'} =~ /\D/? 'Name' : 'id'; - $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0); - # Don't limit to queue if queue is 0. Trying to do so breaks - # RT::Group type CFs. - if ( defined $args{'Queue'} ) { - $CFs->LimitToQueue( $args{'Queue'} ); - } - - # When loading by name, we _can_ load disabled fields, but prefer - # non-disabled fields. - $CFs->FindAllRows; - $CFs->OrderByCols( - { FIELD => "Disabled", ORDER => 'ASC' }, - ); - - # We only want one entry. - $CFs->RowsPerPage(1); - - # version before 3.8 just returns 0, so we need to test if wantarray to be - # backward compatible. - return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First; - - return $self->LoadById( $first->id ); -} - - - - -=head2 Custom field values - -=head3 Values FIELD - -Return a object (collection) of all acceptable values for this Custom Field. -Class of the object can vary and depends on the return value -of the C<ValuesClass> method. - -=cut - -*ValuesObj = \&Values; - -sub Values { - my $self = shift; - - my $class = $self->ValuesClass; - if ( $class ne 'RT::CustomFieldValues') { - eval "require $class" or die "$@"; - } - my $cf_values = $class->new( $self->CurrentUser ); - # if the user has no rights, return an empty object - if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) { - $cf_values->LimitToCustomField( $self->Id ); - } else { - $cf_values->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' ); - } - return ($cf_values); -} - - -=head3 AddValue HASH - -Create a new value for this CustomField. Takes a paramhash containing the elements Name, Description and SortOrder - -=cut - -sub AddValue { - my $self = shift; - my %args = @_; - - unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) { - return (0, $self->loc('Permission Denied')); - } - - # allow zero value - if ( !defined $args{'Name'} || $args{'Name'} eq '' ) { - return (0, $self->loc("Can't add a custom field value without a name")); - } - - my $newval = RT::CustomFieldValue->new( $self->CurrentUser ); - return $newval->Create( %args, CustomField => $self->Id ); -} - - - - -=head3 DeleteValue ID - -Deletes a value from this custom field by id. - -Does not remove this value for any article which has had it selected - -=cut - -sub DeleteValue { - my $self = shift; - my $id = shift; - unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) { - return (0, $self->loc('Permission Denied')); - } - - my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser ); - $val_to_del->Load( $id ); - unless ( $val_to_del->Id ) { - return (0, $self->loc("Couldn't find that value")); - } - unless ( $val_to_del->CustomField == $self->Id ) { - return (0, $self->loc("That is not a value for this custom field")); - } - - my $retval = $val_to_del->Delete; - unless ( $retval ) { - return (0, $self->loc("Custom field value could not be deleted")); - } - return ($retval, $self->loc("Custom field value deleted")); -} - - -=head2 ValidateQueue Queue - -Make sure that the name specified is valid - -=cut - -sub ValidateName { - my $self = shift; - my $value = shift; - - return 0 unless length $value; - - return $self->SUPER::ValidateName($value); -} - -=head2 ValidateQueue Queue - -Make sure that the queue specified is a valid queue name - -=cut - -sub ValidateQueue { - my $self = shift; - my $id = shift; - - return undef unless defined $id; - # 0 means "Global" null would _not_ be ok. - return 1 if $id eq '0'; - - my $q = RT::Queue->new( RT->SystemUser ); - $q->Load( $id ); - return undef unless $q->id; - return 1; -} - - - -=head2 Types - -Retuns an array of the types of CustomField that are supported - -=cut - -sub Types { - return (sort {(($FieldTypes{$a}{sort_order}||999) <=> ($FieldTypes{$b}{sort_order}||999)) or ($a cmp $b)} keys %FieldTypes); -} - - -=head2 IsSelectionType - -Retuns a boolean value indicating whether the C<Values> method makes sense -to this Custom Field. - -=cut - -sub IsSelectionType { - my $self = shift; - my $type = @_? shift : $self->Type; - return undef unless $type; - return $FieldTypes{$type}->{selection_type}; -} - - - -=head2 IsExternalValues - -=cut - -sub IsExternalValues { - my $self = shift; - return 0 unless $self->IsSelectionType( @_ ); - return $self->ValuesClass eq 'RT::CustomFieldValues'? 0 : 1; -} - -sub ValuesClass { - my $self = shift; - return $self->_Value( ValuesClass => @_ ) || 'RT::CustomFieldValues'; -} - -sub SetValuesClass { - my $self = shift; - my $class = shift || 'RT::CustomFieldValues'; - - if ( $class eq 'RT::CustomFieldValues' ) { - return $self->_Set( Field => 'ValuesClass', Value => undef, @_ ); - } - - return (0, $self->loc("This Custom Field can not have list of values")) - unless $self->IsSelectionType; - - unless ( $self->ValidateValuesClass( $class ) ) { - return (0, $self->loc("Invalid Custom Field values source")); - } - return $self->_Set( Field => 'ValuesClass', Value => $class, @_ ); -} - -sub ValidateValuesClass { - my $self = shift; - my $class = shift; - - return 1 if !$class || $class eq 'RT::CustomFieldValues'; - return 1 if grep $class eq $_, RT->Config->Get('CustomFieldValuesSources'); - return undef; -} - - -=head2 FriendlyType [TYPE, MAX_VALUES] - -Returns a localized human-readable version of the custom field type. -If a custom field type is specified as the parameter, the friendly type for that type will be returned - -=cut - -sub FriendlyType { - my $self = shift; - - my $type = @_ ? shift : $self->Type; - my $max = @_ ? shift : $self->MaxValues; - $max = 0 unless $max; - - if (my $friendly_type = $FieldTypes{$type}->{labels}->[$max>2 ? 2 : $max]) { - return ( $self->loc( $friendly_type, $max ) ); - } - else { - return ( $self->loc( $type ) ); - } -} - -sub FriendlyTypeComposite { - my $self = shift; - my $composite = shift || $self->TypeComposite; - return $self->FriendlyType(split(/-/, $composite, 2)); -} - - -=head2 ValidateType TYPE - -Takes a single string. returns true if that string is a value -type of custom field - - -=cut - -sub ValidateType { - my $self = shift; - my $type = shift; - - if ( $type =~ s/(?:Single|Multiple)$// ) { - $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")"); - } - - if ( $FieldTypes{$type} ) { - return 1; - } - else { - return undef; - } -} - - -sub SetType { - my $self = shift; - my $type = shift; - if ($type =~ s/(?:(Single)|Multiple)$//) { - $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")"); - $self->SetMaxValues($1 ? 1 : 0); - } - $self->_Set(Field => 'Type', Value =>$type); -} - -=head2 SetPattern STRING - -Takes a single string representing a regular expression. Performs basic -validation on that regex, and sets the C<Pattern> field for the CF if it -is valid. - -=cut - -sub SetPattern { - my $self = shift; - my $regex = shift; - - my ($ok, $msg) = $self->_IsValidRegex($regex); - if ($ok) { - return $self->_Set(Field => 'Pattern', Value => $regex); - } - else { - return (0, $self->loc("Invalid pattern: [_1]", $msg)); - } -} - -=head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg) - -Tests if the string contains an invalid regex. - -=cut - -sub _IsValidRegex { - my $self = shift; - my $regex = shift or return (1, 'valid'); - - local $^W; local $@; - local $SIG{__DIE__} = sub { 1 }; - local $SIG{__WARN__} = sub { 1 }; - - if (eval { qr/$regex/; 1 }) { - return (1, 'valid'); - } - - my $err = $@; - $err =~ s{[,;].*}{}; # strip debug info from error - chomp $err; - return (0, $err); -} - - -=head2 SingleValue - -Returns true if this CustomField only accepts a single value. -Returns false if it accepts multiple values - -=cut - -sub SingleValue { - my $self = shift; - if (($self->MaxValues||0) == 1) { - return 1; - } - else { - return undef; - } -} - -sub UnlimitedValues { - my $self = shift; - if (($self->MaxValues||0) == 0) { - return 1; - } - else { - return undef; - } -} - - -=head2 CurrentUserHasRight RIGHT - -Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args. - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return $self->CurrentUser->HasRight( - Object => $self, - Right => $right, - ); -} - -=head2 ACLEquivalenceObjects - -Returns list of objects via which users can get rights on this custom field. For custom fields -these objects can be set using L<ContextObject|/"ContextObject and SetContextObject">. - -=cut - -sub ACLEquivalenceObjects { - my $self = shift; - - my $ctx = $self->ContextObject - or return; - return ($ctx, $ctx->ACLEquivalenceObjects); -} - -=head2 ContextObject and SetContextObject - -Set or get a context for this object. It can be ticket, queue or another object -this CF applies to. Used for ACL control, for example SeeCustomField can be granted on -queue level to allow people to see all fields applied to the queue. - -=cut - -sub SetContextObject { - my $self = shift; - return $self->{'context_object'} = shift; -} - -sub ContextObject { - my $self = shift; - return $self->{'context_object'}; -} - -sub ValidContextType { - my $self = shift; - my $class = shift; - - my %valid; - $valid{$_}++ for split '-', $self->LookupType; - delete $valid{'RT::Transaction'}; - - return $valid{$class}; -} - -=head2 LoadContextObject - -Takes an Id for a Context Object and loads the right kind of RT::Object -for this particular Custom Field (based on the LookupType) and returns it. -This is a good way to ensure you don't try to use a Queue as a Context -Object on a User Custom Field. - -=cut - -sub LoadContextObject { - my $self = shift; - my $type = shift; - my $contextid = shift; - - unless ( $self->ValidContextType($type) ) { - RT->Logger->debug("Invalid ContextType $type for Custom Field ".$self->Id); - return; - } - - my $context_object = $type->new( $self->CurrentUser ); - my ($id, $msg) = $context_object->LoadById( $contextid ); - unless ( $id ) { - RT->Logger->debug("Invalid ContextObject id: $msg"); - return; - } - return $context_object; -} - -=head2 ValidateContextObject - -Ensure that a given ContextObject applies to this Custom Field. -For custom fields that are assigned to Queues or to Classes, this checks that the Custom -Field is actually applied to that objects. For Global Custom Fields, it returns true -as long as the Object is of the right type, because you may be using -your permissions on a given Queue of Class to see a Global CF. -For CFs that are only applied Globally, you don't need a ContextObject. - -=cut - -sub ValidateContextObject { - my $self = shift; - my $object = shift; - - return 1 if $self->IsApplied(0); - - # global only custom fields don't have objects - # that should be used as context objects. - return if $self->ApplyGlobally; - - # Otherwise, make sure we weren't passed a user object that we're - # supposed to treat as a queue. - return unless $self->ValidContextType(ref $object); - - # Check that it is applied correctly - my ($applied_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects); - return unless $applied_to; - return $self->IsApplied($applied_to->id); -} - - -sub _Set { - my $self = shift; - - unless ( $self->CurrentUserHasRight('AdminCustomField') ) { - return ( 0, $self->loc('Permission Denied') ); - } - return $self->SUPER::_Set( @_ ); - -} - - - -=head2 _Value - -Takes the name of a table column. -Returns its value as a string, if the user passes an ACL check - -=cut - -sub _Value { - my $self = shift; - return undef unless $self->id; - - # we need to do the rights check - unless ( $self->CurrentUserHasRight('SeeCustomField') ) { - $RT::Logger->debug( - "Permission denied. User #". $self->CurrentUser->id - ." has no SeeCustomField right on CF #". $self->id - ); - return (undef); - } - return $self->__Value( @_ ); -} - - -=head2 SetDisabled - -Takes a boolean. -1 will cause this custom field to no longer be avaialble for objects. -0 will re-enable this field. - -=cut - - -=head2 SetTypeComposite - -Set this custom field's type and maximum values as a composite value - -=cut - -sub SetTypeComposite { - my $self = shift; - my $composite = shift; - - my $old = $self->TypeComposite; - - my ($type, $max_values) = split(/-/, $composite, 2); - if ( $type ne $self->Type ) { - my ($status, $msg) = $self->SetType( $type ); - return ($status, $msg) unless $status; - } - if ( ($max_values || 0) != ($self->MaxValues || 0) ) { - my ($status, $msg) = $self->SetMaxValues( $max_values ); - return ($status, $msg) unless $status; - } - my $render = $self->RenderType; - if ( $render and not grep { $_ eq $render } $self->RenderTypes ) { - # We switched types and our render type is no longer valid, so unset it - # and use the default - $self->SetRenderType( undef ); - } - return 1, $self->loc( - "Type changed from '[_1]' to '[_2]'", - $self->FriendlyTypeComposite( $old ), - $self->FriendlyTypeComposite( $composite ), - ); -} - -=head2 TypeComposite - -Returns a composite value composed of this object's type and maximum values - -=cut - - -sub TypeComposite { - my $self = shift; - return join '-', ($self->Type || ''), ($self->MaxValues || 0); -} - -=head2 TypeComposites - -Returns an array of all possible composite values for custom fields. - -=cut - -sub TypeComposites { - my $self = shift; - return grep !/(?:[Tt]ext|Combobox|Date|DateTime|TimeValue)-0/, map { ("$_-1", "$_-0") } $self->Types; -} - -=head2 RenderType - -Returns the type of form widget to render for this custom field. Currently -this only affects fields which return true for L</HasRenderTypes>. - -=cut - -sub RenderType { - my $self = shift; - return '' unless $self->HasRenderTypes; - - return $self->_Value( 'RenderType', @_ ) - || $self->DefaultRenderType; -} - -=head2 SetRenderType TYPE - -Sets this custom field's render type. - -=cut - -sub SetRenderType { - my $self = shift; - my $type = shift; - return (0, $self->loc("This custom field has no Render Types")) - unless $self->HasRenderTypes; - - if ( !$type || $type eq $self->DefaultRenderType ) { - return $self->_Set( Field => 'RenderType', Value => undef, @_ ); - } - - if ( not grep { $_ eq $type } $self->RenderTypes ) { - return (0, $self->loc("Invalid Render Type for custom field of type [_1]", - $self->FriendlyType)); - } - - return $self->_Set( Field => 'RenderType', Value => $type, @_ ); -} - -=head2 DefaultRenderType [TYPE COMPOSITE] - -Returns the default render type for this custom field's type or the TYPE -COMPOSITE specified as an argument. - -=cut - -sub DefaultRenderType { - my $self = shift; - my $composite = @_ ? shift : $self->TypeComposite; - my ($type, $max) = split /-/, $composite, 2; - return unless $type and $self->HasRenderTypes($composite); - return $FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }[0]; -} - -=head2 HasRenderTypes [TYPE_COMPOSITE] - -Returns a boolean value indicating whether the L</RenderTypes> and -L</RenderType> methods make sense for this custom field. - -Currently true only for type C<Select>. - -=cut - -sub HasRenderTypes { - my $self = shift; - my ($type, $max) = split /-/, (@_ ? shift : $self->TypeComposite), 2; - return undef unless $type; - return defined $FieldTypes{$type}->{render_types} - ->{ $max == 1 ? 'single' : 'multiple' }; -} - -=head2 RenderTypes [TYPE COMPOSITE] - -Returns the valid render types for this custom field's type or the TYPE -COMPOSITE specified as an argument. - -=cut - -sub RenderTypes { - my $self = shift; - my $composite = @_ ? shift : $self->TypeComposite; - my ($type, $max) = split /-/, $composite, 2; - return unless $type and $self->HasRenderTypes($composite); - return @{$FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }}; -} - -=head2 SetLookupType - -Autrijus: care to doc how LookupTypes work? - -=cut - -sub SetLookupType { - my $self = shift; - my $lookup = shift; - if ( $lookup ne $self->LookupType ) { - # Okay... We need to invalidate our existing relationships - my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser); - $ObjectCustomFields->LimitToCustomField($self->Id); - $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef}; - } - return $self->_Set(Field => 'LookupType', Value =>$lookup); -} - -=head2 LookupTypes - -Returns an array of LookupTypes available - -=cut - - -sub LookupTypes { - my $self = shift; - return sort keys %FRIENDLY_OBJECT_TYPES; -} - -my @FriendlyObjectTypes = ( - "[_1] objects", # loc - "[_1]'s [_2] objects", # loc - "[_1]'s [_2]'s [_3] objects", # loc -); - -=head2 FriendlyLookupType - -Returns a localized description of the type of this custom field - -=cut - -sub FriendlyLookupType { - my $self = shift; - my $lookup = shift || $self->LookupType; - - return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} )) - if (defined $FRIENDLY_OBJECT_TYPES{$lookup} ); - - my @types = map { s/^RT::// ? $self->loc($_) : $_ } - grep { defined and length } - split( /-/, $lookup ) - or return; - return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) ); -} - -=head1 RecordClassFromLookupType - -Returns the type of Object referred to by ObjectCustomFields' ObjectId column - -Optionally takes a LookupType to use instead of using the value on the loaded -record. In this case, the method may be called on the class instead of an -object. - -=cut - -sub RecordClassFromLookupType { - my $self = shift; - my $type = shift || $self->LookupType; - my ($class) = ($type =~ /^([^-]+)/); - unless ( $class ) { - if (blessed($self) and $self->LookupType eq $type) { - $RT::Logger->error( - "Custom Field #". $self->id - ." has incorrect LookupType '$type'" - ); - } else { - RT->Logger->error("Invalid LookupType passed as argument: $type"); - } - return undef; - } - return $class; -} - -=head1 ObjectTypeFromLookupType - -Returns the ObjectType used in ObjectCustomFieldValues rows for this CF - -Optionally takes a LookupType to use instead of using the value on the loaded -record. In this case, the method may be called on the class instead of an -object. - -=cut - -sub ObjectTypeFromLookupType { - my $self = shift; - my $type = shift || $self->LookupType; - my ($class) = ($type =~ /([^-]+)$/); - unless ( $class ) { - if (blessed($self) and $self->LookupType eq $type) { - $RT::Logger->error( - "Custom Field #". $self->id - ." has incorrect LookupType '$type'" - ); - } else { - RT->Logger->error("Invalid LookupType passed as argument: $type"); - } - return undef; - } - return $class; -} - -sub CollectionClassFromLookupType { - my $self = shift; - - my $record_class = $self->RecordClassFromLookupType; - return undef unless $record_class; - - my $collection_class; - if ( UNIVERSAL::can($record_class.'Collection', 'new') ) { - $collection_class = $record_class.'Collection'; - } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) { - $collection_class = $record_class.'es'; - } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) { - $collection_class = $record_class.'s'; - } else { - $RT::Logger->error("Can not find a collection class for record class '$record_class'"); - return undef; - } - return $collection_class; -} - -=head1 ApplyGlobally - -Certain custom fields (users, groups) should only be applied globally -but rather than regexing in code for LookupType =~ RT::Queue, we'll codify -the rules here. - -=cut - -sub ApplyGlobally { - my $self = shift; - - return ($self->LookupType =~ /^RT::(?:Group|User)/io); - -} - -=head1 AppliedTo - -Returns collection with objects this custom field is applied to. -Class of the collection depends on L</LookupType>. -See all L</NotAppliedTo> . - -Doesn't takes into account if object is applied globally. - -=cut - -sub AppliedTo { - my $self = shift; - - my ($res, $ocfs_alias) = $self->_AppliedTo; - return $res unless $res; - - $res->Limit( - ALIAS => $ocfs_alias, - FIELD => 'id', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - ); - - return $res; -} - -=head1 NotAppliedTo - -Returns collection with objects this custom field is not applied to. -Class of the collection depends on L</LookupType>. -See all L</AppliedTo> . - -Doesn't takes into account if object is applied globally. - -=cut - -sub NotAppliedTo { - my $self = shift; - - my ($res, $ocfs_alias) = $self->_AppliedTo; - return $res unless $res; - - $res->Limit( - ALIAS => $ocfs_alias, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - - return $res; -} - -sub _AppliedTo { - my $self = shift; - - my ($class) = $self->CollectionClassFromLookupType; - return undef unless $class; - - my $res = $class->new( $self->CurrentUser ); - - # If CF is a Group CF, only display user-defined groups - if ( $class eq 'RT::Groups' ) { - $res->LimitToUserDefinedGroups; - } - - $res->OrderBy( FIELD => 'Name' ); - my $ocfs_alias = $res->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFields', - FIELD2 => 'ObjectId', - ); - $res->Limit( - LEFTJOIN => $ocfs_alias, - ALIAS => $ocfs_alias, - FIELD => 'CustomField', - VALUE => $self->id, - ); - return ($res, $ocfs_alias); -} - -=head2 IsApplied - -Takes object id and returns corresponding L<RT::ObjectCustomField> -record if this custom field is applied to the object. Use 0 to check -if custom field is applied globally. - -=cut - -sub IsApplied { - my $self = shift; - my $id = shift; - my $ocf = RT::ObjectCustomField->new( $self->CurrentUser ); - $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 ); - return undef unless $ocf->id; - return $ocf; -} - -=head2 AddToObject OBJECT - -Add this custom field as a custom field for a single object, such as a queue or group. - -Takes an object - -=cut - - -sub AddToObject { - my $self = shift; - my $object = shift; - my $id = $object->Id || 0; - - unless (index($self->LookupType, ref($object)) == 0) { - return ( 0, $self->loc('Lookup type mismatch') ); - } - - unless ( $object->CurrentUserHasRight('AssignCustomFields') ) { - return ( 0, $self->loc('Permission Denied') ); - } - - if ( $self->IsApplied( $id ) ) { - return ( 0, $self->loc("Custom field is already applied to the object") ); - } - - if ( $id ) { - # applying locally - return (0, $self->loc("Couldn't apply custom field to an object as it's global already") ) - if $self->IsApplied( 0 ); - } - else { - my $applied = RT::ObjectCustomFields->new( $self->CurrentUser ); - $applied->LimitToCustomField( $self->id ); - while ( my $record = $applied->Next ) { - $record->Delete; - } - } - - my $ocf = RT::ObjectCustomField->new( $self->CurrentUser ); - my ( $oid, $msg ) = $ocf->Create( - ObjectId => $id, CustomField => $self->id, - ); - return ( $oid, $msg ); -} - - -=head2 RemoveFromObject OBJECT - -Remove this custom field for a single object, such as a queue or group. - -Takes an object - -=cut - -sub RemoveFromObject { - my $self = shift; - my $object = shift; - my $id = $object->Id || 0; - - unless (index($self->LookupType, ref($object)) == 0) { - return ( 0, $self->loc('Object type mismatch') ); - } - - unless ( $object->CurrentUserHasRight('AssignCustomFields') ) { - return ( 0, $self->loc('Permission Denied') ); - } - - my $ocf = $self->IsApplied( $id ); - unless ( $ocf ) { - return ( 0, $self->loc("This custom field does not apply to that object") ); - } - - # XXX: Delete doesn't return anything - my ( $oid, $msg ) = $ocf->Delete; - return ( $oid, $msg ); -} - - -=head2 AddValueForObject HASH - -Adds a custom field value for a record object of some kind. -Takes a param hash of - -Required: - - Object - Content - -Optional: - - LargeContent - ContentType - -=cut - -sub AddValueForObject { - my $self = shift; - my %args = ( - Object => undef, - Content => undef, - LargeContent => undef, - ContentType => undef, - @_ - ); - my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') ); - - unless ( $self->CurrentUserHasRight('ModifyCustomField') ) { - return ( 0, $self->loc('Permission Denied') ); - } - - unless ( $self->MatchPattern($args{'Content'}) ) { - return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) ); - } - - $RT::Handle->BeginTransaction; - - if ( $self->MaxValues ) { - my $current_values = $self->ValuesForObject($obj); - my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues; - - # (The +1 is for the new value we're adding) - - # If we have a set of current values and we've gone over the maximum - # allowed number of values, we'll need to delete some to make room. - # which former values are blown away is not guaranteed - - while ($extra_values) { - my $extra_item = $current_values->Next; - unless ( $extra_item->id ) { - $RT::Logger->crit( "We were just asked to delete " - ."a custom field value that doesn't exist!" ); - $RT::Handle->Rollback(); - return (undef); - } - $extra_item->Delete; - $extra_values--; - } - } - - if (my $canonicalizer = $self->can('_CanonicalizeValue'.$self->Type)) { - $canonicalizer->($self, \%args); - } - - - - my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); - my ($val, $msg) = $newval->Create( - ObjectType => ref($obj), - ObjectId => $obj->Id, - Content => $args{'Content'}, - LargeContent => $args{'LargeContent'}, - ContentType => $args{'ContentType'}, - CustomField => $self->Id - ); - - unless ($val) { - $RT::Handle->Rollback(); - return ($val, $self->loc("Couldn't create record: [_1]", $msg)); - } - - $RT::Handle->Commit(); - return ($val); - -} - - - -sub _CanonicalizeValueDateTime { - my $self = shift; - my $args = shift; - my $DateObj = RT::Date->new( $self->CurrentUser ); - $DateObj->Set( Format => 'unknown', - Value => $args->{'Content'} ); - $args->{'Content'} = $DateObj->ISO; -} - -# For date, we need to store Content as ISO date -sub _CanonicalizeValueDate { - my $self = shift; - my $args = shift; - - # in case user input date with time, let's omit it by setting timezone - # to utc so "hour" won't affect "day" - my $DateObj = RT::Date->new( $self->CurrentUser ); - $DateObj->Set( Format => 'unknown', - Value => $args->{'Content'}, - ); - $args->{'Content'} = $DateObj->Date( Timezone => 'user' ); -} - -=head2 MatchPattern STRING - -Tests the incoming string against the Pattern of this custom field object -and returns a boolean; returns true if the Pattern is empty. - -=cut - -sub MatchPattern { - my $self = shift; - my $regex = $self->Pattern or return 1; - - return (( defined $_[0] ? $_[0] : '') =~ $regex); -} - - - - -=head2 FriendlyPattern - -Prettify the pattern of this custom field, by taking the text in C<(?#text)> -and localizing it. - -=cut - -sub FriendlyPattern { - my $self = shift; - my $regex = $self->Pattern; - - return '' unless length $regex; - if ( $regex =~ /\(\?#([^)]*)\)/ ) { - return '[' . $self->loc($1) . ']'; - } - else { - return $regex; - } -} - - - - -=head2 DeleteValueForObject HASH - -Deletes a custom field value for a ticket. Takes a param hash of Object and Content - -Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false - -=cut - -sub DeleteValueForObject { - my $self = shift; - my %args = ( Object => undef, - Content => undef, - Id => undef, - @_ ); - - - unless ($self->CurrentUserHasRight('ModifyCustomField')) { - return (0, $self->loc('Permission Denied')); - } - - my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser); - - if (my $id = $args{'Id'}) { - $oldval->Load($id); - } - unless ($oldval->id) { - $oldval->LoadByObjectContentAndCustomField( - Object => $args{'Object'}, - Content => $args{'Content'}, - CustomField => $self->Id, - ); - } - - - # check to make sure we found it - unless ($oldval->Id) { - return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name)); - } - - # for single-value fields, we need to validate that empty string is a valid value for it - if ( $self->SingleValue and not $self->MatchPattern( '' ) ) { - return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) ); - } - - # delete it - - my $ret = $oldval->Delete(); - unless ($ret) { - return(0, $self->loc("Custom field value could not be found")); - } - return($oldval->Id, $self->loc("Custom field value deleted")); -} - - -=head2 ValuesForObject OBJECT - -Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT - -=cut - -sub ValuesForObject { - my $self = shift; - my $object = shift; - - my $values = RT::ObjectCustomFieldValues->new($self->CurrentUser); - unless ($self->id and $self->CurrentUserHasRight('SeeCustomField')) { - # Return an empty object if they have no rights to see - $values->Limit( FIELD => "id", VALUE => 0, SUBCLAUSE => "ACL" ); - return ($values); - } - - $values->LimitToCustomField($self->Id); - $values->LimitToObject($object); - - return ($values); -} - - -=head2 _ForObjectType PATH FRIENDLYNAME - -Tell RT that a certain object accepts custom fields - -Examples: - - 'RT::Queue-RT::Ticket' => "Tickets", # loc - 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", # loc - 'RT::User' => "Users", # loc - 'RT::Group' => "Groups", # loc - 'RT::Queue' => "Queues", # loc - -This is a class method. - -=cut - -sub _ForObjectType { - my $self = shift; - my $path = shift; - my $friendly_name = shift; - - $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name; - -} - - -=head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue) - -Gets or sets the C<IncludeContentForValue> for this custom field. RT -uses this field to automatically include content into the user's browser -as they display records with custom fields in RT. - -=cut - -sub SetIncludeContentForValue { - shift->IncludeContentForValue(@_); -} -sub IncludeContentForValue{ - my $self = shift; - $self->_URLTemplate('IncludeContentForValue', @_); -} - - - -=head2 LinkValueTo [VALUE] (and SetLinkValueTo) - -Gets or sets the C<LinkValueTo> for this custom field. RT -uses this field to make custom field values into hyperlinks in the user's -browser as they display records with custom fields in RT. - -=cut - - -sub SetLinkValueTo { - shift->LinkValueTo(@_); -} - -sub LinkValueTo { - my $self = shift; - $self->_URLTemplate('LinkValueTo', @_); - -} - - -=head2 _URLTemplate NAME [VALUE] - -With one argument, returns the _URLTemplate named C<NAME>, but only if -the current user has the right to see this custom field. - -With two arguments, attemptes to set the relevant template value. - -=cut - -sub _URLTemplate { - my $self = shift; - my $template_name = shift; - if (@_) { - - my $value = shift; - unless ( $self->CurrentUserHasRight('AdminCustomField') ) { - return ( 0, $self->loc('Permission Denied') ); - } - $self->SetAttribute( Name => $template_name, Content => $value ); - return ( 1, $self->loc('Updated') ); - } else { - unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) { - return (undef); - } - - my @attr = $self->Attributes->Named($template_name); - my $attr = shift @attr; - - if ($attr) { return $attr->Content } - - } -} - -sub SetBasedOn { - my $self = shift; - my $value = shift; - - return $self->_Set( Field => 'BasedOn', Value => $value, @_ ) - unless defined $value and length $value; - - my $cf = RT::CustomField->new( $self->CurrentUser ); - $cf->SetContextObject( $self->ContextObject ); - $cf->Load( ref $value ? $value->id : $value ); - - return (0, "Permission denied") - unless $cf->id && $cf->CurrentUserHasRight('SeeCustomField'); - - # XXX: Remove this restriction once we support lists and cascaded selects - if ( $self->RenderType =~ /List/ ) { - return (0, $self->loc("We can't currently render as a List when basing categories on another custom field. Please use another render type.")); - } - - return $self->_Set( Field => 'BasedOn', Value => $value, @_ ) -} - -sub BasedOnObj { - my $self = shift; - - my $obj = RT::CustomField->new( $self->CurrentUser ); - $obj->SetContextObject( $self->ContextObject ); - if ( $self->BasedOn ) { - $obj->Load( $self->BasedOn ); - } - return $obj; -} - -sub UILocation { - my $self = shift; - my $tag = $self->FirstAttribute( 'UILocation' ); - return $tag ? $tag->Content : ''; -} - -sub SetUILocation { - my $self = shift; - my $tag = shift; - if ( $tag ) { - return $self->SetAttribute( Name => 'UILocation', Content => $tag ); - } - else { - return $self->DeleteAttribute('UILocation'); - } -} - -sub NoClone { - my $self = shift; - $self->FirstAttribute('NoClone') ? 1 : ''; -} - -sub SetNoClone { - my $self = shift; - my $value = shift; - if ( $value ) { - return $self->SetAttribute( Name => 'NoClone', Content => 1 ); - } else { - return $self->DeleteAttribute('NoClone'); - } -} - - -=head2 id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=head2 Name - -Returns the current value of Name. -(In the database, Name is stored as varchar(200).) - - - -=head2 SetName VALUE - - -Set Name to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Name will be stored as a varchar(200).) - - -=cut - - -=head2 Type - -Returns the current value of Type. -(In the database, Type is stored as varchar(200).) - - - -=head2 SetType VALUE - - -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(200).) - - -=cut - - -=head2 RenderType - -Returns the current value of RenderType. -(In the database, RenderType is stored as varchar(64).) - - - -=head2 SetRenderType VALUE - - -Set RenderType to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, RenderType will be stored as a varchar(64).) - - -=cut - - -=head2 MaxValues - -Returns the current value of MaxValues. -(In the database, MaxValues is stored as int(11).) - - - -=head2 SetMaxValues VALUE - - -Set MaxValues to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, MaxValues will be stored as a int(11).) - - -=cut - - -=head2 Pattern - -Returns the current value of Pattern. -(In the database, Pattern is stored as text.) - - - -=head2 SetPattern VALUE - - -Set Pattern to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Pattern will be stored as a text.) - - -=cut - - -=head2 Repeated - -Returns the current value of Repeated. -(In the database, Repeated is stored as smallint(6).) - - - -=head2 SetRepeated VALUE - - -Set Repeated to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Repeated will be stored as a smallint(6).) - - -=cut - - -=head2 BasedOn - -Returns the current value of BasedOn. -(In the database, BasedOn is stored as int(11).) - - - -=head2 SetBasedOn VALUE - - -Set BasedOn to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, BasedOn will be stored as a int(11).) - - -=cut - - -=head2 Description - -Returns the current value of Description. -(In the database, Description is stored as varchar(255).) - - - -=head2 SetDescription VALUE - - -Set Description to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Description will be stored as a varchar(255).) - - -=cut - - -=head2 SortOrder - -Returns the current value of SortOrder. -(In the database, SortOrder is stored as int(11).) - - - -=head2 SetSortOrder VALUE - - -Set SortOrder to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, SortOrder will be stored as a int(11).) - - -=cut - - -=head2 LookupType - -Returns the current value of LookupType. -(In the database, LookupType is stored as varchar(255).) - - - -=head2 SetLookupType VALUE - - -Set LookupType to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, LookupType will be stored as a varchar(255).) - - -=cut - - -=head2 Creator - -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) - - -=cut - - -=head2 Created - -Returns the current value of Created. -(In the database, Created is stored as datetime.) - - -=cut - - -=head2 LastUpdatedBy - -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) - - -=cut - - -=head2 LastUpdated - -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) - - -=cut - - -=head2 Disabled - -Returns the current value of Disabled. -(In the database, Disabled is stored as smallint(6).) - - - -=head2 SetDisabled VALUE - - -Set Disabled to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Disabled will be stored as a smallint(6).) - - -=cut - - - -sub _CoreAccessible { - { - - id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, - Name => - {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, - Type => - {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''}, - RenderType => - {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, - MaxValues => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, - Pattern => - {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''}, - Repeated => - {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, - ValuesClass => - {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, - BasedOn => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, - Description => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, - SortOrder => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - LookupType => - {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, - Creator => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Disabled => - {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, - - } -}; - - -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/EmailParser.pm.orig b/rt/lib/RT/EmailParser.pm.orig deleted file mode 100644 index 89f7ea4f9..000000000 --- a/rt/lib/RT/EmailParser.pm.orig +++ /dev/null @@ -1,692 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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 }}} - -package RT::EmailParser; - - -use base qw/RT::Base/; - -use strict; -use warnings; - - -use Email::Address; -use MIME::Entity; -use MIME::Head; -use MIME::Parser; -use File::Temp qw/tempdir/; - -=head1 NAME - - RT::EmailParser - helper functions for parsing parts from incoming - email messages - -=head1 SYNOPSIS - - -=head1 DESCRIPTION - - - - -=head1 METHODS - -=head2 new - -Returns a new RT::EmailParser object - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - return $self; -} - - -=head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] } - -Parse a message stored in a scalar from scalar_ref. - -=cut - -sub SmartParseMIMEEntityFromScalar { - my $self = shift; - my %args = ( Message => undef, Decode => 1, Exact => 0, @_ ); - - eval { - my ( $fh, $temp_file ); - for ( 1 .. 10 ) { - - # on NFS and NTFS, it is possible that tempfile() conflicts - # with other processes, causing a race condition. we try to - # accommodate this by pausing and retrying. - last - if ( $fh, $temp_file ) = - eval { File::Temp::tempfile( UNLINK => 0 ) }; - sleep 1; - } - if ($fh) { - - #thank you, windows - binmode $fh; - $fh->autoflush(1); - print $fh $args{'Message'}; - close($fh); - if ( -f $temp_file ) { - - # We have to trust the temp file's name -- untaint it - $temp_file =~ /(.*)/; - my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} ); - unlink($1); - return $entity; - } - } - }; - - #If for some reason we weren't able to parse the message using a temp file - # try it with a scalar - if ( $@ || !$self->Entity ) { - return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} ); - } - -} - - -=head2 ParseMIMEEntityFromSTDIN - -Parse a message from standard input - -=cut - -sub ParseMIMEEntityFromSTDIN { - my $self = shift; - return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_); -} - -=head2 ParseMIMEEntityFromScalar $message - -Takes either a scalar or a reference to a scalar which contains a stringified MIME message. -Parses it. - -Returns true if it wins. -Returns false if it loses. - -=cut - -sub ParseMIMEEntityFromScalar { - my $self = shift; - return $self->_ParseMIMEEntity( shift, 'parse_data', @_ ); -} - -=head2 ParseMIMEEntityFromFilehandle *FH - -Parses a mime entity from a filehandle passed in as an argument - -=cut - -sub ParseMIMEEntityFromFileHandle { - my $self = shift; - return $self->_ParseMIMEEntity( shift, 'parse', @_ ); -} - -=head2 ParseMIMEEntityFromFile - -Parses a mime entity from a filename passed in as an argument - -=cut - -sub ParseMIMEEntityFromFile { - my $self = shift; - return $self->_ParseMIMEEntity( shift, 'parse_open', @_ ); -} - - -sub _ParseMIMEEntity { - my $self = shift; - my $message = shift; - my $method = shift; - my $postprocess = (@_ ? shift : 1); - my $exact = shift; - - # Create a new parser object: - my $parser = MIME::Parser->new(); - $self->_SetupMIMEParser($parser); - $parser->decode_bodies(0) if $exact; - - # TODO: XXX 3.0 we really need to wrap this in an eval { } - unless ( $self->{'entity'} = $parser->$method($message) ) { - $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages"); - # Try again, this time without extracting nested messages - $parser->extract_nested_messages(0); - unless ( $self->{'entity'} = $parser->$method($message) ) { - $RT::Logger->crit("couldn't parse MIME stream"); - return ( undef); - } - } - - $self->_PostProcessNewEntity if $postprocess; - - return $self->{'entity'}; -} - -sub _DecodeBodies { - my $self = shift; - return unless $self->{'entity'}; - - my @parts = $self->{'entity'}->parts_DFS; - $self->_DecodeBody($_) foreach @parts; -} - -sub _DecodeBody { - my $self = shift; - my $entity = shift; - - my $old = $entity->bodyhandle or return; - return unless $old->is_encoded; - - require MIME::Decoder; - my $encoding = $entity->head->mime_encoding; - my $decoder = MIME::Decoder->new($encoding); - unless ( $decoder ) { - $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary"); - $old->is_encoded(0); - return; - } - - require MIME::Body; - # XXX: use InCore for now, but later must switch to files - my $new = MIME::Body::InCore->new(); - $new->binmode(1); - $new->is_encoded(0); - - my $source = $old->open('r') or die "couldn't open body: $!"; - my $destination = $new->open('w') or die "couldn't open body: $!"; - { - local $@; - eval { $decoder->decode($source, $destination) }; - $RT::Logger->error($@) if $@; - } - $source->close or die "can't close: $!"; - $destination->close or die "can't close: $!"; - - $entity->bodyhandle( $new ); -} - -=head2 _PostProcessNewEntity - -cleans up and postprocesses a newly parsed MIME Entity - -=cut - -sub _PostProcessNewEntity { - my $self = shift; - - #Now we've got a parsed mime object. - - # Unfold headers that are have embedded newlines - # Better do this before conversion or it will break - # with multiline encoded Subject (RFC2047) (fsck.com #5594) - $self->Head->unfold; - - # try to convert text parts into utf-8 charset - RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8'); -} - -=head2 ParseCcAddressesFromHead HASHREF - -Takes a hashref object containing QueueObj, Head and CurrentUser objects. -Returns a list of all email addresses in the To and Cc -headers b<except> the current Queue's email addresses, the CurrentUser's -email address and anything that the RT->Config->Get('RTAddressRegexp') matches. - -=cut - -sub ParseCcAddressesFromHead { - my $self = shift; - my %args = ( - QueueObj => undef, - CurrentUser => undef, - @_ - ); - - my (@Addresses); - - my @ToObjs = Email::Address->parse( $self->Head->get('To') ); - my @CcObjs = Email::Address->parse( $self->Head->get('Cc') ); - - foreach my $AddrObj ( @ToObjs, @CcObjs ) { - my $Address = $AddrObj->address; - my $user = RT::User->new(RT->SystemUser); - $Address = $user->CanonicalizeEmailAddress($Address); - next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address; - next if $self->IsRTAddress($Address); - - push ( @Addresses, $Address ); - } - return (@Addresses); -} - - -=head2 IsRTaddress ADDRESS - -Takes a single parameter, an email address. -Returns true if that address matches the C<RTAddressRegexp> config option. -Returns false, otherwise. - - -=cut - -sub IsRTAddress { - my $self = shift; - my $address = shift; - - if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) { - return $address =~ /$address_re/i ? 1 : undef; - } - - # we don't warn here, but do in config check - if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) { - return 1 if lc $correspond_address eq lc $address; - } - if ( my $comment_address = RT->Config->Get('CommentAddress') ) { - return 1 if lc $comment_address eq lc $address; - } - - my $queue = RT::Queue->new( RT->SystemUser ); - $queue->LoadByCols( CorrespondAddress => $address ); - return 1 if $queue->id; - - $queue->LoadByCols( CommentAddress => $address ); - return 1 if $queue->id; - - return undef; -} - - -=head2 CullRTAddresses ARRAY - -Takes a single argument, an array of email addresses. -Returns the same array with any IsRTAddress()es weeded out. - - -=cut - -sub CullRTAddresses { - my $self = shift; - my @addresses = (@_); - - return grep { !$self->IsRTAddress($_) } @addresses; -} - - - - - -# LookupExternalUserInfo is a site-definable method for synchronizing -# incoming users with an external data source. -# -# This routine takes a tuple of EmailAddress and FriendlyName -# EmailAddress is the user's email address, ususally taken from -# an email message's From: header. -# FriendlyName is a freeform string, ususally taken from the "comment" -# portion of an email message's From: header. -# -# If you define an AutoRejectRequest template, RT will use this -# template for the rejection message. - - -=head2 LookupExternalUserInfo - - LookupExternalUserInfo is a site-definable method for synchronizing - incoming users with an external data source. - - This routine takes a tuple of EmailAddress and FriendlyName - EmailAddress is the user's email address, ususally taken from - an email message's From: header. - FriendlyName is a freeform string, ususally taken from the "comment" - portion of an email message's From: header. - - It returns (FoundInExternalDatabase, ParamHash); - - FoundInExternalDatabase must be set to 1 before return if the user - was found in the external database. - - ParamHash is a Perl parameter hash which can contain at least the - following fields. These fields are used to populate RT's users - database when the user is created. - - EmailAddress is the email address that RT should use for this user. - Name is the 'Name' attribute RT should use for this user. - 'Name' is used for things like access control and user lookups. - RealName is what RT should display as the user's name when displaying - 'friendly' names - -=cut - -sub LookupExternalUserInfo { - my $self = shift; - my $EmailAddress = shift; - my $RealName = shift; - - my $FoundInExternalDatabase = 1; - my %params; - - #Name is the RT username you want to use for this user. - $params{'Name'} = $EmailAddress; - $params{'EmailAddress'} = $EmailAddress; - $params{'RealName'} = $RealName; - - return ($FoundInExternalDatabase, %params); -} - -=head2 Head - -Return the parsed head from this message - -=cut - -sub Head { - my $self = shift; - return $self->Entity->head; -} - -=head2 Entity - -Return the parsed Entity from this message - -=cut - -sub Entity { - my $self = shift; - return $self->{'entity'}; -} - - - -=head2 _SetupMIMEParser $parser - -A private instance method which sets up a mime parser to do its job - -=cut - - - ## TODO: Does it make sense storing to disk at all? After all, we - ## need to put each msg as an in-core scalar before saving it to - ## the database, don't we? - - ## At the same time, we should make sure that we nuke attachments - ## Over max size and return them - -sub _SetupMIMEParser { - my $self = shift; - my $parser = shift; - - # Set up output directory for files; we use $RT::VarPath instead - # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always - # writable. - my $tmpdir; - if ( -w $RT::VarPath ) { - $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 ); - } elsif (-w File::Spec->tmpdir) { - $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 ); - } else { - $RT::Logger->crit("Neither the RT var directory ($RT::VarPath) nor the system tmpdir (@{[File::Spec->tmpdir]}) are writable; falling back to in-memory parsing!"); - } - - #If someone includes a message, extract it - $parser->extract_nested_messages(1); - $parser->extract_uuencode(1); ### default is false - - if ($tmpdir) { - # If we got a writable tmpdir, write to disk - push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir ); - $parser->output_dir($tmpdir); - $parser->filer->ignore_filename(1); - - # Set up the prefix for files with auto-generated names: - $parser->output_prefix("part"); - - # From the MIME::Parser docs: - # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope" - # Turns out that the default is to recycle tempfiles - # Temp files should never be recycled, especially when running under perl taint checking - - $parser->tmp_recycling(0) if $parser->can('tmp_recycling'); - } else { - # Otherwise, fall back to storing it in memory - $parser->output_to_core(1); - $parser->tmp_to_core(1); - $parser->use_inner_files(1); - } - -} - -=head2 ParseEmailAddress string - -Returns a list of Email::Address objects -Works around the bug that Email::Address 1.889 and earlier -doesn't handle local-only email addresses (when users pass -in just usernames on the RT system in fields that expect -Email Addresses) - -We don't handle the case of -bob, fred@bestpractical.com -because we don't want to fail parsing -bob, "Falcone, Fred" <fred@bestpractical.com> -The next release of Email::Address will have a new method -we can use that removes the bandaid - -=cut - -sub ParseEmailAddress { - my $self = shift; - my $address_string = shift; - - $address_string =~ s/^\s+|\s+$//g; - - my @addresses; - # if it looks like a username / local only email - if ($address_string !~ /@/ && $address_string =~ /^\w+$/) { - my $user = RT::User->new( RT->SystemUser ); - my ($id, $msg) = $user->Load($address_string); - if ($id) { - push @addresses, Email::Address->new($user->Name,$user->EmailAddress); - } else { - $RT::Logger->error("Unable to parse an email address from $address_string: $msg"); - } - } else { - @addresses = Email::Address->parse($address_string); - } - - $self->CleanupAddresses(@addresses); - - return @addresses; - -} - -=head2 CleanupAddresses ARRAY - -Massages an array of L<Email::Address> objects to make their email addresses -more palatable. - -Currently this strips off surrounding single quotes around C<< ->address >> and -B<< modifies the L<Email::Address> objects in-place >>. - -Returns the list of objects for convienence in C<map>/C<grep> chains. - -=cut - -sub CleanupAddresses { - my $self = shift; - - for my $addr (@_) { - next unless defined $addr; - # Outlook sometimes sends addresses surrounded by single quotes; - # clean them all up - if ((my $email = $addr->address) =~ s/^'(.+)'$/$1/) { - $addr->address($email); - } - } - return @_; -} - -=head2 RescueOutlook - -Outlook 2007/2010 have a bug when you write an email with the html format. -it will send a 'multipart/alternative' with both 'text/plain' and 'text/html' -in it. it's cool to have a 'text/plain' part, but the problem is the part is -not so right: all the "\n" in your main message will become "\n\n" :/ - -this method will fix this bug, i.e. replaces "\n\n" to "\n". -return 1 if it does find the problem in the entity and get it fixed. - -=cut - - -sub RescueOutlook { - my $self = shift; - my $mime = $self->Entity(); - return unless $mime && $self->LooksLikeMSEmail($mime); - - my $text_part; - if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) { - my $first = $mime->parts(0); - if ( $first && $first->head->get('Content-Type') =~ m{multipart/alternative} ) - { - my $inner_first = $first->parts(0); - if ( $inner_first && $inner_first->head->get('Content-Type') =~ m{text/plain} ) - { - $text_part = $inner_first; - } - } - } - elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) { - my $first = $mime->parts(0); - if ( $first && $first->head->get('Content-Type') =~ m{text/plain} ) { - $text_part = $first; - } - } - - # Add base64 since we've seen examples of double newlines with - # this type too. Need an example of a multi-part base64 to - # handle that permutation if it exists. - elsif ( $mime->head->get('Content-Transfer-Encoding') =~ m{base64} ) { - $text_part = $mime; # Assuming single part, already decoded. - } - - if ($text_part) { - - # use the unencoded string - my $content = $text_part->bodyhandle->as_string; - if ( $content =~ s/\n\n/\n/g ) { - - # Outlook puts a space on extra newlines, remove it - $content =~ s/\ +$//mg; - - # only write only if we did change the content - if ( my $io = $text_part->open("w") ) { - $io->print($content); - $io->close; - $RT::Logger->debug( - "Removed extra newlines from MS Outlook message."); - return 1; - } - else { - $RT::Logger->error("Can't write to body to fix newlines"); - } - } - } - - return; -} - -=head1 LooksLikeMSEmail - -Try to determine if the current email may have -come from MS Outlook or gone through Exchange, and therefore -may have extra newlines added. - -=cut - -sub LooksLikeMSEmail { - my $self = shift; - my $mime = shift; - - my $mailer = $mime->head->get('X-Mailer'); - - # 12.0 is outlook 2007, 14.0 is 2010 - return 1 if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ ); - - if ( RT->Config->Get('CheckMoreMSMailHeaders') ) { - - # Check for additional headers that might - # indicate this came from Outlook or through Exchange. - # A sample we received had the headers X-MS-Has-Attach: and - # X-MS-Tnef-Correlator: and both had no value. - - my @tags = $mime->head->tags(); - return 1 if grep { /^X-MS-/ } @tags; - } - - return 0; # Doesn't look like MS email. -} - -sub DESTROY { - my $self = shift; - File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1) - if $self->{'AttachmentDirs'}; -} - - - -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/Record.pm.orig b/rt/lib/RT/Record.pm.orig deleted file mode 100755 index 7adfc2678..000000000 --- a/rt/lib/RT/Record.pm.orig +++ /dev/null @@ -1,2102 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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::Record - Base class for RT record objects - -=head1 SYNOPSIS - - -=head1 DESCRIPTION - - - -=head1 METHODS - -=cut - -package RT::Record; - -use strict; -use warnings; - - -use RT::Date; -use RT::I18N; -use RT::User; -use RT::Attributes; -use Encode qw(); - -our $_TABLE_ATTR = { }; -use base RT->Config->Get('RecordBaseClass'); -use base 'RT::Base'; - - -sub _Init { - my $self = shift; - $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)}); - $self->CurrentUser(@_); -} - - - -=head2 _PrimaryKeys - -The primary keys for RT classes is 'id' - -=cut - -sub _PrimaryKeys { return ['id'] } -# short circuit many, many thousands of calls from searchbuilder -sub _PrimaryKey { 'id' } - -=head2 Id - -Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do -on a very common codepath - -C<id> is an alias to C<Id> and is the preferred way to call this method. - -=cut - -sub Id { - return shift->{'values'}->{id}; -} - -*id = \&Id; - -=head2 Delete - -Delete this record object from the database. - -=cut - -sub Delete { - my $self = shift; - my ($rv) = $self->SUPER::Delete; - if ($rv) { - return ($rv, $self->loc("Object deleted")); - } else { - - return(0, $self->loc("Object could not be deleted")) - } -} - -=head2 ObjectTypeStr - -Returns a string which is this object's type. The type is the class, -without the "RT::" prefix. - - -=cut - -sub ObjectTypeStr { - my $self = shift; - if (ref($self) =~ /^.*::(\w+)$/) { - return $self->loc($1); - } else { - return $self->loc(ref($self)); - } -} - -=head2 Attributes - -Return this object's attributes as an RT::Attributes object - -=cut - -sub Attributes { - my $self = shift; - unless ($self->{'attributes'}) { - $self->{'attributes'} = RT::Attributes->new($self->CurrentUser); - $self->{'attributes'}->LimitToObject($self); - $self->{'attributes'}->OrderByCols({FIELD => 'id'}); - } - return ($self->{'attributes'}); -} - - -=head2 AddAttribute { Name, Description, Content } - -Adds a new attribute for this object. - -=cut - -sub AddAttribute { - my $self = shift; - my %args = ( Name => undef, - Description => undef, - Content => undef, - @_ ); - - my $attr = RT::Attribute->new( $self->CurrentUser ); - my ( $id, $msg ) = $attr->Create( - Object => $self, - Name => $args{'Name'}, - Description => $args{'Description'}, - Content => $args{'Content'} ); - - - # XXX TODO: Why won't RedoSearch work here? - $self->Attributes->_DoSearch; - - return ($id, $msg); -} - - -=head2 SetAttribute { Name, Description, Content } - -Like AddAttribute, but replaces all existing attributes with the same Name. - -=cut - -sub SetAttribute { - my $self = shift; - my %args = ( Name => undef, - Description => undef, - Content => undef, - @_ ); - - my @AttributeObjs = $self->Attributes->Named( $args{'Name'} ) - or return $self->AddAttribute( %args ); - - my $AttributeObj = pop( @AttributeObjs ); - $_->Delete foreach @AttributeObjs; - - $AttributeObj->SetDescription( $args{'Description'} ); - $AttributeObj->SetContent( $args{'Content'} ); - - $self->Attributes->RedoSearch; - return 1; -} - -=head2 DeleteAttribute NAME - -Deletes all attributes with the matching name for this object. - -=cut - -sub DeleteAttribute { - my $self = shift; - my $name = shift; - my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name ); - $self->ClearAttributes; - return ($val,$msg); -} - -=head2 FirstAttribute NAME - -Returns the first attribute with the matching name for this object (as an -L<RT::Attribute> object), or C<undef> if no such attributes exist. -If there is more than one attribute with the matching name on the -object, the first value that was set is returned. - -=cut - -sub FirstAttribute { - my $self = shift; - my $name = shift; - return ($self->Attributes->Named( $name ))[0]; -} - - -sub ClearAttributes { - my $self = shift; - delete $self->{'attributes'}; - -} - -sub _Handle { return $RT::Handle } - - - -=head2 Create PARAMHASH - -Takes a PARAMHASH of Column -> Value pairs. -If any Column has a Validate$PARAMNAME subroutine defined and the -value provided doesn't pass validation, this routine returns -an error. - -If this object's table has any of the following atetributes defined as -'Auto', this routine will automatically fill in their values. - -=over - -=item Created - -=item Creator - -=item LastUpdated - -=item LastUpdatedBy - -=back - -=cut - -sub Create { - my $self = shift; - my %attribs = (@_); - foreach my $key ( keys %attribs ) { - if (my $method = $self->can("Validate$key")) { - if (! $method->( $self, $attribs{$key} ) ) { - if (wantarray) { - return ( 0, $self->loc('Invalid value for [_1]', $key) ); - } - else { - return (0); - } - } - } - } - - - - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime(); - - my $now_iso = - sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec); - - $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'}); - - if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) { - $attribs{'Creator'} = $self->CurrentUser->id || '0'; - } - $attribs{'LastUpdated'} = $now_iso - if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'}); - - $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0' - if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'}); - - my $id = $self->SUPER::Create(%attribs); - if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) { - if ( $id->errno ) { - if (wantarray) { - return ( 0, - $self->loc( "Internal Error: [_1]", $id->{error_message} ) ); - } - else { - return (0); - } - } - } - # If the object was created in the database, - # load it up now, so we're sure we get what the database - # has. Arguably, this should not be necessary, but there - # isn't much we can do about it. - - unless ($id) { - if (wantarray) { - return ( $id, $self->loc('Object could not be created') ); - } - else { - return ($id); - } - - } - - if (UNIVERSAL::isa('errno',$id)) { - return(undef); - } - - $self->Load($id) if ($id); - - - - if (wantarray) { - return ( $id, $self->loc('Object created') ); - } - else { - return ($id); - } - -} - - - -=head2 LoadByCols - -Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the -DB is case sensitive - -=cut - -sub LoadByCols { - my $self = shift; - - # We don't want to hang onto this - $self->ClearAttributes; - - return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive; - - # If this database is case sensitive we need to uncase objects for - # explicit loading - my %hash = (@_); - foreach my $key ( keys %hash ) { - - # If we've been passed an empty value, we can't do the lookup. - # We don't need to explicitly downcase integers or an id. - if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) { - my ($op, $val, $func); - ($key, $op, $val, $func) = - $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } ); - $hash{$key}->{operator} = $op; - $hash{$key}->{value} = $val; - $hash{$key}->{function} = $func; - } - } - return $self->SUPER::LoadByCols( %hash ); -} - - - -# There is room for optimizations in most of those subs: - - -sub LastUpdatedObj { - my $self = shift; - my $obj = RT::Date->new( $self->CurrentUser ); - - $obj->Set( Format => 'sql', Value => $self->LastUpdated ); - return $obj; -} - - - -sub CreatedObj { - my $self = shift; - my $obj = RT::Date->new( $self->CurrentUser ); - - $obj->Set( Format => 'sql', Value => $self->Created ); - - return $obj; -} - - -# -# TODO: This should be deprecated -# -sub AgeAsString { - my $self = shift; - return ( $self->CreatedObj->AgeAsString() ); -} - - - -# TODO this should be deprecated - -sub LastUpdatedAsString { - my $self = shift; - if ( $self->LastUpdated ) { - return ( $self->LastUpdatedObj->AsString() ); - - } - else { - return "never"; - } -} - - -# -# TODO This should be deprecated -# -sub CreatedAsString { - my $self = shift; - return ( $self->CreatedObj->AsString() ); -} - - -# -# TODO This should be deprecated -# -sub LongSinceUpdateAsString { - my $self = shift; - if ( $self->LastUpdated ) { - - return ( $self->LastUpdatedObj->AgeAsString() ); - - } - else { - return "never"; - } -} - - - -# -sub _Set { - my $self = shift; - - my %args = ( - Field => undef, - Value => undef, - IsSQL => undef, - @_ - ); - - #if the user is trying to modify the record - # TODO: document _why_ this code is here - - if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) { - $args{'Value'} = 0; - } - - my $old_val = $self->__Value($args{'Field'}); - $self->_SetLastUpdated(); - my $ret = $self->SUPER::_Set( - Field => $args{'Field'}, - Value => $args{'Value'}, - IsSQL => $args{'IsSQL'} - ); - my ($status, $msg) = $ret->as_array(); - - # @values has two values, a status code and a message. - - # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool - # we want to change the standard "success" message - if ($status) { - if ($self->SQLType( $args{'Field'}) =~ /text/) { - $msg = $self->loc( - "[_1] updated", - $self->loc( $args{'Field'} ), - ); - } else { - $msg = $self->loc( - "[_1] changed from [_2] to [_3]", - $self->loc( $args{'Field'} ), - ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ), - '"' . $self->__Value( $args{'Field'}) . '"', - ); - } - } else { - $msg = $self->CurrentUser->loc_fuzzy($msg); - } - - return wantarray ? ($status, $msg) : $ret; -} - - - -=head2 _SetLastUpdated - -This routine updates the LastUpdated and LastUpdatedBy columns of the row in question -It takes no options. Arguably, this is a bug - -=cut - -sub _SetLastUpdated { - my $self = shift; - use RT::Date; - my $now = RT::Date->new( $self->CurrentUser ); - $now->SetToNow(); - - if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) { - my ( $msg, $val ) = $self->__Set( - Field => 'LastUpdated', - Value => $now->ISO - ); - } - if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) { - my ( $msg, $val ) = $self->__Set( - Field => 'LastUpdatedBy', - Value => $self->CurrentUser->id - ); - } -} - - - -=head2 CreatorObj - -Returns an RT::User object with the RT account of the creator of this row - -=cut - -sub CreatorObj { - my $self = shift; - unless ( exists $self->{'CreatorObj'} ) { - - $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser ); - $self->{'CreatorObj'}->Load( $self->Creator ); - } - return ( $self->{'CreatorObj'} ); -} - - - -=head2 LastUpdatedByObj - - Returns an RT::User object of the last user to touch this object - -=cut - -sub LastUpdatedByObj { - my $self = shift; - unless ( exists $self->{LastUpdatedByObj} ) { - $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser ); - $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy ); - } - return $self->{'LastUpdatedByObj'}; -} - - - -=head2 URI - -Returns this record's URI - -=cut - -sub URI { - my $self = shift; - my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser); - return($uri->URIForObject($self)); -} - - -=head2 ValidateName NAME - -Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name - -=cut - -sub ValidateName { - my $self = shift; - my $value = shift; - if (defined $value && $value=~ /^\d+$/) { - return(0); - } else { - return(1); - } -} - - - -=head2 SQLType attribute - -return the SQL type for the attribute 'attribute' as stored in _ClassAccessible - -=cut - -sub SQLType { - my $self = shift; - my $field = shift; - - return ($self->_Accessible($field, 'type')); - - -} - -sub __Value { - my $self = shift; - my $field = shift; - my %args = ( decode_utf8 => 1, @_ ); - - unless ($field) { - $RT::Logger->error("__Value called with undef field"); - } - - my $value = $self->SUPER::__Value($field); - - return undef if (!defined $value); - - if ( $args{'decode_utf8'} ) { - if ( !utf8::is_utf8($value) ) { - utf8::decode($value); - } - } - else { - if ( utf8::is_utf8($value) ) { - utf8::encode($value); - } - } - - return $value; - -} - -# Set up defaults for DBIx::SearchBuilder::Record::Cachable - -sub _CacheConfig { - { - 'cache_p' => 1, - 'cache_for_sec' => 30, - } -} - - - -sub _BuildTableAttributes { - my $self = shift; - my $class = ref($self) || $self; - - my $attributes; - if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) { - $attributes = $self->_CoreAccessible(); - } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) { - $attributes = $self->_ClassAccessible(); - - } - - foreach my $column (keys %$attributes) { - foreach my $attr ( keys %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; - } - } - foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) { - next unless UNIVERSAL::can( $self, $method ); - $attributes = $self->$method(); - - foreach my $column ( keys %$attributes ) { - foreach my $attr ( keys %{ $attributes->{$column} } ) { - $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr}; - } - } - } -} - - -=head2 _ClassAccessible - -Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in -DBIx::SearchBuilder::Record - -=cut - -sub _ClassAccessible { - my $self = shift; - return $_TABLE_ATTR->{ref($self) || $self}; -} - -=head2 _Accessible COLUMN ATTRIBUTE - -returns the value of ATTRIBUTE for COLUMN - - -=cut - -sub _Accessible { - my $self = shift; - my $column = shift; - my $attribute = lc(shift); - return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column}); - return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0; - -} - -=head2 _EncodeLOB BODY MIME_TYPE FILENAME - -Takes a potentially large attachment. Returns (ContentEncoding, -EncodedBody, MimeType, Filename) based on system configuration and -selected database. Returns a custom (short) text/plain message if -DropLongAttachments causes an attachment to not be stored. - -Encodes your data as base64 or Quoted-Printable as needed based on your -Databases's restrictions and the UTF-8ness of the data being passed in. Since -we are storing in columns marked UTF8, we must ensure that binary data is -encoded on databases which are strict. - -This function expects to receive an octet string in order to properly -evaluate and encode it. It will return an octet string. - -=cut - -sub _EncodeLOB { - my $self = shift; - my $Body = shift; - my $MIMEType = shift || ''; - my $Filename = shift; - - my $ContentEncoding = 'none'; - - #get the max attachment length from RT - my $MaxSize = RT->Config->Get('MaxAttachmentSize'); - - #if the current attachment contains nulls and the - #database doesn't support embedded nulls - - if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) { - - # set a flag telling us to mimencode the attachment - $ContentEncoding = 'base64'; - - #cut the max attchment size by 25% (for mime-encoding overhead. - $RT::Logger->debug("Max size is $MaxSize"); - $MaxSize = $MaxSize * 3 / 4; - # Some databases (postgres) can't handle non-utf8 data - } elsif ( !$RT::Handle->BinarySafeBLOBs - && $Body =~ /\P{ASCII}/ - && !Encode::is_utf8( $Body, 1 ) ) { - $ContentEncoding = 'quoted-printable'; - } - - #if the attachment is larger than the maximum size - if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) { - - # if we're supposed to truncate large attachments - if (RT->Config->Get('TruncateLongAttachments')) { - - # truncate the attachment to that length. - $Body = substr( $Body, 0, $MaxSize ); - - } - - # elsif we're supposed to drop large attachments on the floor, - elsif (RT->Config->Get('DropLongAttachments')) { - - # drop the attachment on the floor - $RT::Logger->info( "$self: Dropped an attachment of size " - . length($Body)); - $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) ); - $Filename .= ".txt" if $Filename; - return ("none", "Large attachment dropped", "text/plain", $Filename ); - } - } - - # if we need to mimencode the attachment - if ( $ContentEncoding eq 'base64' ) { - - # base64 encode the attachment - Encode::_utf8_off($Body); - $Body = MIME::Base64::encode_base64($Body); - - } elsif ($ContentEncoding eq 'quoted-printable') { - Encode::_utf8_off($Body); - $Body = MIME::QuotedPrint::encode($Body); - } - - - return ($ContentEncoding, $Body, $MIMEType, $Filename ); - -} - -=head2 _DecodeLOB - -Unpacks data stored in the database, which may be base64 or QP encoded -because of our need to store binary and badly encoded data in columns -marked as UTF-8. Databases such as PostgreSQL and Oracle care that you -are feeding them invalid UTF-8 and will refuse the content. This -function handles unpacking the encoded data. - -It returns textual data as a UTF-8 string which has been processed by Encode's -PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see -the invalid byte but won't run into problems treating the data as UTF-8 later. - -This is similar to how we filter all data coming in via the web UI in -RT::Interface::Web::DecodeARGS. This filter should only end up being -applied to old data from less UTF-8-safe versions of RT. - -Important Note - This function expects an octet string and returns a -character string for non-binary data. - -=cut - -sub _DecodeLOB { - my $self = shift; - my $ContentType = shift || ''; - my $ContentEncoding = shift || 'none'; - my $Content = shift; - - if ( $ContentEncoding eq 'base64' ) { - $Content = MIME::Base64::decode_base64($Content); - } - elsif ( $ContentEncoding eq 'quoted-printable' ) { - $Content = MIME::QuotedPrint::decode($Content); - } - elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) { - return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) ); - } - if ( RT::I18N::IsTextualContentType($ContentType) ) { - $Content = Encode::decode('UTF-8',$Content,Encode::FB_PERLQQ) unless Encode::is_utf8($Content); - } - return ($Content); -} - -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -use vars '%LINKDIRMAP'; - -%LINKDIRMAP = ( - MemberOf => { Base => 'MemberOf', - Target => 'HasMember', }, - RefersTo => { Base => 'RefersTo', - Target => 'ReferredToBy', }, - DependsOn => { Base => 'DependsOn', - Target => 'DependedOnBy', }, - MergedInto => { Base => 'MergedInto', - Target => 'MergedInto', }, - -); - -=head2 Update ARGSHASH - -Updates fields on an object for you using the proper Set methods, -skipping unchanged values. - - ARGSRef => a hashref of attributes => value for the update - AttributesRef => an arrayref of keys in ARGSRef that should be updated - AttributePrefix => a prefix that should be added to the attributes in AttributesRef - when looking up values in ARGSRef - Bare attributes are tried before prefixed attributes - -Returns a list of localized results of the update - -=cut - -sub Update { - my $self = shift; - - my %args = ( - ARGSRef => undef, - AttributesRef => undef, - AttributePrefix => undef, - @_ - ); - - my $attributes = $args{'AttributesRef'}; - my $ARGSRef = $args{'ARGSRef'}; - my %new_values; - - # gather all new values - foreach my $attribute (@$attributes) { - my $value; - if ( defined $ARGSRef->{$attribute} ) { - $value = $ARGSRef->{$attribute}; - } - elsif ( - defined( $args{'AttributePrefix'} ) - && defined( - $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute } - ) - ) { - $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }; - - } - else { - next; - } - - $value =~ s/\r\n/\n/gs; - - my $truncated_value = $self->TruncateValue($attribute, $value); - - # If Queue is 'General', we want to resolve the queue name for - # the object. - - # This is in an eval block because $object might not exist. - # and might not have a Name method. But "can" won't find autoloaded - # items. If it fails, we don't care - do { - no warnings "uninitialized"; - local $@; - eval { - my $object = $attribute . "Obj"; - my $name = $self->$object->Name; - next if $name eq $value || $name eq ($value || 0); - }; - - my $current = $self->$attribute(); - # RT::Queue->Lifecycle returns a Lifecycle object instead of name - $current = eval { $current->Name } if ref $current; - next if $truncated_value eq $current; - next if ( $truncated_value || 0 ) eq $current; - }; - - $new_values{$attribute} = $value; - } - - return $self->_UpdateAttributes( - Attributes => $attributes, - NewValues => \%new_values, - ); -} - -sub _UpdateAttributes { - my $self = shift; - my %args = ( - Attributes => [], - NewValues => {}, - @_, - ); - - my @results; - - foreach my $attribute (@{ $args{Attributes} }) { - next if !exists($args{NewValues}{$attribute}); - - my $value = $args{NewValues}{$attribute}; - my $method = "Set$attribute"; - my ( $code, $msg ) = $self->$method($value); - my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/; - - # Default to $id, but use name if we can get it. - my $label = $self->id; - $label = $self->Name if (UNIVERSAL::can($self,'Name')); - # this requires model names to be loc'ed. - -=for loc - - "Ticket" # loc - "User" # loc - "Group" # loc - "Queue" # loc - -=cut - - push @results, $self->loc( $prefix ) . " $label: ". $msg; - -=for loc - - "[_1] could not be set to [_2].", # loc - "That is already the current value", # loc - "No value sent to _Set!", # loc - "Illegal value for [_1]", # loc - "The new value has been set.", # loc - "No column specified", # loc - "Immutable field", # loc - "Nonexistant field?", # loc - "Invalid data", # loc - "Couldn't find row", # loc - "Missing a primary key?: [_1]", # loc - "Found Object", # loc - -=cut - - } - - return @results; -} - - - - -=head2 Members - - This returns an RT::Links object which references all the tickets -which are 'MembersOf' this ticket - -=cut - -sub Members { - my $self = shift; - return ( $self->_Links( 'Target', 'MemberOf' ) ); -} - - - -=head2 MemberOf - - This returns an RT::Links object which references all the tickets that this -ticket is a 'MemberOf' - -=cut - -sub MemberOf { - my $self = shift; - return ( $self->_Links( 'Base', 'MemberOf' ) ); -} - - - -=head2 RefersTo - - This returns an RT::Links object which shows all references for which this ticket is a base - -=cut - -sub RefersTo { - my $self = shift; - return ( $self->_Links( 'Base', 'RefersTo' ) ); -} - - - -=head2 ReferredToBy - -This returns an L<RT::Links> object which shows all references for which this ticket is a target - -=cut - -sub ReferredToBy { - my $self = shift; - return ( $self->_Links( 'Target', 'RefersTo' ) ); -} - - - -=head2 DependedOnBy - - This returns an RT::Links object which references all the tickets that depend on this one - -=cut - -sub DependedOnBy { - my $self = shift; - return ( $self->_Links( 'Target', 'DependsOn' ) ); -} - - - - -=head2 HasUnresolvedDependencies - -Takes a paramhash of Type (default to '__any'). Returns the number of -unresolved dependencies, if $self->UnresolvedDependencies returns an -object with one or more members of that type. Returns false -otherwise. - -=cut - -sub HasUnresolvedDependencies { - my $self = shift; - my %args = ( - Type => undef, - @_ - ); - - my $deps = $self->UnresolvedDependencies; - - if ($args{Type}) { - $deps->Limit( FIELD => 'Type', - OPERATOR => '=', - VALUE => $args{Type}); - } - else { - $deps->IgnoreType; - } - - if ($deps->Count > 0) { - return $deps->Count; - } - else { - return (undef); - } -} - - - -=head2 UnresolvedDependencies - -Returns an RT::Tickets object of tickets which this ticket depends on -and which have a status of new, open or stalled. (That list comes from -RT::Queue->ActiveStatusArray - -=cut - - -sub UnresolvedDependencies { - my $self = shift; - my $deps = RT::Tickets->new($self->CurrentUser); - - my @live_statuses = RT::Queue->ActiveStatusArray(); - foreach my $status (@live_statuses) { - $deps->LimitStatus(VALUE => $status); - } - $deps->LimitDependedOnBy($self->Id); - - return($deps); - -} - - - -=head2 AllDependedOnBy - -Returns an array of RT::Ticket objects which (directly or indirectly) -depends on this ticket; takes an optional 'Type' argument in the param -hash, which will limit returned tickets to that type, as well as cause -tickets with that type to serve as 'leaf' nodes that stops the recursive -dependency search. - -=cut - -sub AllDependedOnBy { - my $self = shift; - return $self->_AllLinkedTickets( LinkType => 'DependsOn', - Direction => 'Target', @_ ); -} - -=head2 AllDependsOn - -Returns an array of RT::Ticket objects which this ticket (directly or -indirectly) depends on; takes an optional 'Type' argument in the param -hash, which will limit returned tickets to that type, as well as cause -tickets with that type to serve as 'leaf' nodes that stops the -recursive dependency search. - -=cut - -sub AllDependsOn { - my $self = shift; - return $self->_AllLinkedTickets( LinkType => 'DependsOn', - Direction => 'Base', @_ ); -} - -sub _AllLinkedTickets { - my $self = shift; - - my %args = ( - LinkType => undef, - Direction => undef, - Type => undef, - _found => {}, - _top => 1, - @_ - ); - - my $dep = $self->_Links( $args{Direction}, $args{LinkType}); - while (my $link = $dep->Next()) { - my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI; - next unless ($uri->IsLocal()); - my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj; - next if $args{_found}{$obj->Id}; - - if (!$args{Type}) { - $args{_found}{$obj->Id} = $obj; - $obj->_AllLinkedTickets( %args, _top => 0 ); - } - elsif ($obj->Type and $obj->Type eq $args{Type}) { - $args{_found}{$obj->Id} = $obj; - } - else { - $obj->_AllLinkedTickets( %args, _top => 0 ); - } - } - - if ($args{_top}) { - return map { $args{_found}{$_} } sort keys %{$args{_found}}; - } - else { - return 1; - } -} - - - -=head2 DependsOn - - This returns an RT::Links object which references all the tickets that this ticket depends on - -=cut - -sub DependsOn { - my $self = shift; - return ( $self->_Links( 'Base', 'DependsOn' ) ); -} - -# }}} - -# {{{ Customers - -=head2 Customers - - This returns an RT::Links object which references all the customers that - this object is a member of. This includes both explicitly linked customers - and links implied by services. - -=cut - -sub Customers { - my( $self, %opt ) = @_; - my $Debug = $opt{'Debug'}; - - unless ( $self->{'Customers'} ) { - - $self->{'Customers'} = $self->MemberOf->Clone; - - for my $fstable (qw(cust_main cust_svc)) { - - $self->{'Customers'}->Limit( - FIELD => 'Target', - OPERATOR => 'STARTSWITH', - VALUE => "freeside://freeside/$fstable", - ENTRYAGGREGATOR => 'OR', - SUBCLAUSE => 'customers', - ); - } - } - - warn "->Customers method called on $self; returning ". - ref($self->{'Customers'}). ' object' - if $Debug; - - return $self->{'Customers'}; -} - -# }}} - -# {{{ Services - -=head2 Services - - This returns an RT::Links object which references all the services this - object is a member of. - -=cut - -sub Services { - my( $self, %opt ) = @_; - - unless ( $self->{'Services'} ) { - - $self->{'Services'} = $self->MemberOf->Clone; - - $self->{'Services'}->Limit( - FIELD => 'Target', - OPERATOR => 'STARTSWITH', - VALUE => "freeside://freeside/cust_svc", - ); - } - - return $self->{'Services'}; -} - - - - - - -=head2 Links DIRECTION [TYPE] - -Return links (L<RT::Links>) to/from this object. - -DIRECTION is either 'Base' or 'Target'. - -TYPE is a type of links to return, it can be omitted to get -links of any type. - -=cut - -sub Links { shift->_Links(@_) } - -sub _Links { - my $self = shift; - - #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- - #tobias meant by $f - my $field = shift; - my $type = shift || ""; - - unless ( $self->{"$field$type"} ) { - $self->{"$field$type"} = RT::Links->new( $self->CurrentUser ); - # at least to myself - $self->{"$field$type"}->Limit( FIELD => $field, - VALUE => $self->URI, - ENTRYAGGREGATOR => 'OR' ); - $self->{"$field$type"}->Limit( FIELD => 'Type', - VALUE => $type ) - if ($type); - } - return ( $self->{"$field$type"} ); -} - - - - -=head2 FormatType - -Takes a Type and returns a string that is more human readable. - -=cut - -sub FormatType{ - my $self = shift; - my %args = ( Type => '', - @_ - ); - $args{Type} =~ s/([A-Z])/" " . lc $1/ge; - $args{Type} =~ s/^\s+//; - return $args{Type}; -} - - - - -=head2 FormatLink - -Takes either a Target or a Base and returns a string of human friendly text. - -=cut - -sub FormatLink { - my $self = shift; - my %args = ( Object => undef, - FallBack => '', - @_ - ); - my $text = "URI " . $args{FallBack}; - if ($args{Object} && $args{Object}->isa("RT::Ticket")) { - $text = "Ticket " . $args{Object}->id; - } - return $text; -} - - - -=head2 _AddLink - -Takes a paramhash of Type and one of Base or Target. Adds that link to this object. - -Returns C<link id>, C<message> and C<exist> flag. - - -=cut - -sub _AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - @_ ); - - - # Remote_link is the URI of the object that is not this ticket - my $remote_link; - my $direction; - - if ( $args{'Base'} and $args{'Target'} ) { - $RT::Logger->debug( "$self tried to create a link. both base and target were specified" ); - return ( 0, $self->loc("Can't specify both base and target") ); - } - elsif ( $args{'Base'} ) { - $args{'Target'} = $self->URI(); - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - elsif ( $args{'Target'} ) { - $args{'Base'} = $self->URI(); - $remote_link = $args{'Target'}; - $direction = 'Base'; - } - else { - return ( 0, $self->loc('Either base or target must be specified') ); - } - - # Check if the link already exists - we don't want duplicates - use RT::Link; - my $old_link = RT::Link->new( $self->CurrentUser ); - $old_link->LoadByParams( Base => $args{'Base'}, - Type => $args{'Type'}, - Target => $args{'Target'} ); - if ( $old_link->Id ) { - $RT::Logger->debug("$self Somebody tried to duplicate a link"); - return ( $old_link->id, $self->loc("Link already exists"), 1 ); - } - - # }}} - - - # Storing the link in the DB. - my $link = RT::Link->new( $self->CurrentUser ); - my ($linkid, $linkmsg) = $link->Create( Target => $args{Target}, - Base => $args{Base}, - Type => $args{Type} ); - - unless ($linkid) { - $RT::Logger->error("Link could not be created: ".$linkmsg); - return ( 0, $self->loc("Link could not be created") ); - } - - my $basetext = $self->FormatLink(Object => $link->BaseObj, - FallBack => $args{Base}); - my $targettext = $self->FormatLink(Object => $link->TargetObj, - FallBack => $args{Target}); - my $typetext = $self->FormatType(Type => $args{Type}); - my $TransString = - "$basetext $typetext $targettext."; - return ( $linkid, $TransString ) ; -} - - - -=head2 _DeleteLink - -Delete a link. takes a paramhash of Base, Target and Type. -Either Base or Target must be null. The null value will -be replaced with this ticket's id - -=cut - -sub _DeleteLink { - my $self = shift; - my %args = ( - Base => undef, - Target => undef, - Type => undef, - @_ - ); - - #we want one of base and target. we don't care which - #but we only want _one_ - - my $direction; - my $remote_link; - - if ( $args{'Base'} and $args{'Target'} ) { - $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target"); - return ( 0, $self->loc("Can't specify both base and target") ); - } - elsif ( $args{'Base'} ) { - $args{'Target'} = $self->URI(); - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - elsif ( $args{'Target'} ) { - $args{'Base'} = $self->URI(); - $remote_link = $args{'Target'}; - $direction='Base'; - } - else { - $RT::Logger->error("Base or Target must be specified"); - return ( 0, $self->loc('Either base or target must be specified') ); - } - - my $link = RT::Link->new( $self->CurrentUser ); - $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} ); - - - $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} ); - #it's a real link. - - if ( $link->id ) { - my $basetext = $self->FormatLink(Object => $link->BaseObj, - FallBack => $args{Base}); - my $targettext = $self->FormatLink(Object => $link->TargetObj, - FallBack => $args{Target}); - my $typetext = $self->FormatType(Type => $args{Type}); - my $linkid = $link->id; - $link->Delete(); - my $TransString = "$basetext no longer $typetext $targettext."; - return ( 1, $TransString); - } - - #if it's not a link we can find - else { - $RT::Logger->debug("Couldn't find that link"); - return ( 0, $self->loc("Link not found") ); - } -} - - -=head1 LockForUpdate - -In a database transaction, gains an exclusive lock on the row, to -prevent race conditions. On SQLite, this is a "RESERVED" lock on the -entire database. - -=cut - -sub LockForUpdate { - my $self = shift; - - my $pk = $self->_PrimaryKey; - my $id = @_ ? $_[0] : $self->$pk; - $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable"); - if (RT->Config->Get('DatabaseType') eq "SQLite") { - # SQLite does DB-level locking, upgrading the transaction to - # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op - # UPDATE to force the upgade. - return RT->DatabaseHandle->dbh->do( - "UPDATE " .$self->Table. - " SET $pk = $pk WHERE 1 = 0"); - } else { - return $self->_LoadFromSQL( - "SELECT * FROM ".$self->Table - ." WHERE $pk = ? FOR UPDATE", - $id, - ); - } -} - -=head2 _NewTransaction PARAMHASH - -Private function to create a new RT::Transaction object for this ticket update - -=cut - -sub _NewTransaction { - my $self = shift; - my %args = ( - TimeTaken => undef, - Type => undef, - OldValue => undef, - NewValue => undef, - OldReference => undef, - NewReference => undef, - ReferenceType => undef, - Data => undef, - Field => undef, - MIMEObj => undef, - ActivateScrips => 1, - CommitScrips => 1, - SquelchMailTo => undef, - CustomFields => {}, - @_ - ); - - my $in_txn = RT->DatabaseHandle->TransactionDepth; - RT->DatabaseHandle->BeginTransaction unless $in_txn; - - $self->LockForUpdate; - - my $old_ref = $args{'OldReference'}; - my $new_ref = $args{'NewReference'}; - my $ref_type = $args{'ReferenceType'}; - if ($old_ref or $new_ref) { - $ref_type ||= ref($old_ref) || ref($new_ref); - if (!$ref_type) { - $RT::Logger->error("Reference type not specified for transaction"); - return; - } - $old_ref = $old_ref->Id if ref($old_ref); - $new_ref = $new_ref->Id if ref($new_ref); - } - - require RT::Transaction; - my $trans = RT::Transaction->new( $self->CurrentUser ); - my ( $transaction, $msg ) = $trans->Create( - ObjectId => $self->Id, - ObjectType => ref($self), - TimeTaken => $args{'TimeTaken'}, - Type => $args{'Type'}, - Data => $args{'Data'}, - Field => $args{'Field'}, - NewValue => $args{'NewValue'}, - OldValue => $args{'OldValue'}, - NewReference => $new_ref, - OldReference => $old_ref, - ReferenceType => $ref_type, - MIMEObj => $args{'MIMEObj'}, - ActivateScrips => $args{'ActivateScrips'}, - CommitScrips => $args{'CommitScrips'}, - SquelchMailTo => $args{'SquelchMailTo'}, - CustomFields => $args{'CustomFields'}, - ); - - # Rationalize the object since we may have done things to it during the caching. - $self->Load($self->Id); - - $RT::Logger->warning($msg) unless $transaction; - - $self->_SetLastUpdated; - - if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) { - $self->_UpdateTimeTaken( $args{'TimeTaken'} ); - } - if ( RT->Config->Get('UseTransactionBatch') and $transaction ) { - push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'}; - } - - RT->DatabaseHandle->Commit unless $in_txn; - - return ( $transaction, $msg, $trans ); -} - - - -=head2 Transactions - - Returns an RT::Transactions object of all transactions on this record object - -=cut - -sub Transactions { - my $self = shift; - - use RT::Transactions; - my $transactions = RT::Transactions->new( $self->CurrentUser ); - - #If the user has no rights, return an empty object - $transactions->Limit( - FIELD => 'ObjectId', - VALUE => $self->id, - ); - $transactions->Limit( - FIELD => 'ObjectType', - VALUE => ref($self), - ); - - return ($transactions); -} - -# - -sub CustomFields { - my $self = shift; - my $cfs = RT::CustomFields->new( $self->CurrentUser ); - - $cfs->SetContextObject( $self ); - # XXX handle multiple types properly - $cfs->LimitToLookupType( $self->CustomFieldLookupType ); - $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId ); - $cfs->ApplySortOrder; - - return $cfs; -} - -# TODO: This _only_ works for RT::Foo classes. it doesn't work, for -# example, for RT::IR::Foo classes. - -sub CustomFieldLookupId { - my $self = shift; - my $lookup = shift || $self->CustomFieldLookupType; - my @classes = ($lookup =~ /RT::(\w+)-/g); - - # Work on "RT::Queue", for instance - return $self->Id unless @classes; - - my $object = $self; - # Save a ->Load call by not calling ->FooObj->Id, just ->Foo - my $final = shift @classes; - foreach my $class (reverse @classes) { - my $method = "${class}Obj"; - $object = $object->$method; - } - - my $id = $object->$final; - unless (defined $id) { - my $method = "${final}Obj"; - $id = $object->$method->Id; - } - return $id; -} - - -=head2 CustomFieldLookupType - -Returns the path RT uses to figure out which custom fields apply to this object. - -=cut - -sub CustomFieldLookupType { - my $self = shift; - return ref($self) || $self; -} - - -=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE } - -VALUE should be a string. FIELD can be any identifier of a CustomField -supported by L</LoadCustomFieldByIdentifier> method. - -Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field, -deletes the old value. -If VALUE is not a valid value for the custom field, returns -(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where -$id is ID of created L<ObjectCustomFieldValue> object. - -=cut - -sub AddCustomFieldValue { - my $self = shift; - $self->_AddCustomFieldValue(@_); -} - -sub _AddCustomFieldValue { - my $self = shift; - my %args = ( - Field => undef, - Value => undef, - LargeContent => undef, - ContentType => undef, - RecordTransaction => 1, - @_ - ); - - my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); - unless ( $cf->Id ) { - return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); - } - - my $OCFs = $self->CustomFields; - $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id ); - unless ( $OCFs->Count ) { - return ( - 0, - $self->loc( - "Custom field [_1] does not apply to this object", - ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'} - ) - ); - } - - # empty string is not correct value of any CF, so undef it - foreach ( qw(Value LargeContent) ) { - $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ }; - } - - unless ( $cf->ValidateValue( $args{'Value'} ) ) { - return ( 0, $self->loc("Invalid value for custom field") ); - } - - # If the custom field only accepts a certain # of values, delete the existing - # value and record a "changed from foo to bar" transaction - unless ( $cf->UnlimitedValues ) { - - # Load up a ObjectCustomFieldValues object for this custom field and this ticket - my $values = $cf->ValuesForObject($self); - - # We need to whack any old values here. In most cases, the custom field should - # only have one value to delete. In the pathalogical case, this custom field - # used to be a multiple and we have many values to whack.... - my $cf_values = $values->Count; - - if ( $cf_values > $cf->MaxValues ) { - my $i = 0; #We want to delete all but the max we can currently have , so we can then - # execute the same code to "change" the value from old to new - while ( my $value = $values->Next ) { - $i++; - if ( $i < $cf_values ) { - my ( $val, $msg ) = $cf->DeleteValueForObject( - Object => $self, - Id => $value->id, - ); - unless ($val) { - return ( 0, $msg ); - } - my ( $TransactionId, $Msg, $TransactionObj ) = - $self->_NewTransaction( - Type => 'CustomField', - Field => $cf->Id, - OldReference => $value, - ); - } - } - $values->RedoSearch if $i; # redo search if have deleted at least one value - } - - if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { - return $entry->id; - } - - my $old_value = $values->First; - my $old_content; - $old_content = $old_value->Content if $old_value; - - my ( $new_value_id, $value_msg ) = $cf->AddValueForObject( - Object => $self, - Content => $args{'Value'}, - LargeContent => $args{'LargeContent'}, - ContentType => $args{'ContentType'}, - ); - - unless ( $new_value_id ) { - return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) ); - } - - my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser ); - $new_value->Load( $new_value_id ); - - # now that adding the new value was successful, delete the old one - if ( $old_value ) { - my ( $val, $msg ) = $old_value->Delete(); - return ( 0, $msg ) unless $val; - } - - if ( $args{'RecordTransaction'} ) { - my ( $TransactionId, $Msg, $TransactionObj ) = - $self->_NewTransaction( - Type => 'CustomField', - Field => $cf->Id, - OldReference => $old_value, - NewReference => $new_value, - ); - } - - my $new_content = $new_value->Content; - - # For datetime, we need to display them in "human" format in result message - #XXX TODO how about date without time? - if ($cf->Type eq 'DateTime') { - my $DateObj = RT::Date->new( $self->CurrentUser ); - $DateObj->Set( - Format => 'ISO', - Value => $new_content, - ); - $new_content = $DateObj->AsString; - - if ( defined $old_content && length $old_content ) { - $DateObj->Set( - Format => 'ISO', - Value => $old_content, - ); - $old_content = $DateObj->AsString; - } - } - - unless ( defined $old_content && length $old_content ) { - return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content )); - } - elsif ( !defined $new_content || !length $new_content ) { - return ( $new_value_id, - $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) ); - } - else { - return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content)); - } - - } - - # otherwise, just add a new value and record "new value added" - else { - if ( !$cf->Repeated ) { - my $values = $cf->ValuesForObject($self); - if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) { - return $entry->id; - } - } - - my ($new_value_id, $msg) = $cf->AddValueForObject( - Object => $self, - Content => $args{'Value'}, - LargeContent => $args{'LargeContent'}, - ContentType => $args{'ContentType'}, - ); - - unless ( $new_value_id ) { - return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) ); - } - if ( $args{'RecordTransaction'} ) { - my ( $tid, $msg ) = $self->_NewTransaction( - Type => 'CustomField', - Field => $cf->Id, - NewReference => $new_value_id, - ReferenceType => 'RT::ObjectCustomFieldValue', - ); - unless ( $tid ) { - return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) ); - } - } - return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) ); - } -} - - - -=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE } - -Deletes VALUE as a value of CustomField FIELD. - -VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue. - -If VALUE is not a valid value for the custom field, returns -(0, 'Error message' ) otherwise, returns (1, 'Success Message') - -=cut - -sub DeleteCustomFieldValue { - my $self = shift; - my %args = ( - Field => undef, - Value => undef, - ValueId => undef, - @_ - ); - - my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'}); - unless ( $cf->Id ) { - return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) ); - } - - my ( $val, $msg ) = $cf->DeleteValueForObject( - Object => $self, - Id => $args{'ValueId'}, - Content => $args{'Value'}, - ); - unless ($val) { - return ( 0, $msg ); - } - - my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction( - Type => 'CustomField', - Field => $cf->Id, - OldReference => $val, - ReferenceType => 'RT::ObjectCustomFieldValue', - ); - unless ($TransactionId) { - return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) ); - } - - my $old_value = $TransactionObj->OldValue; - # For datetime, we need to display them in "human" format in result message - if ( $cf->Type eq 'DateTime' ) { - my $DateObj = RT::Date->new( $self->CurrentUser ); - $DateObj->Set( - Format => 'ISO', - Value => $old_value, - ); - $old_value = $DateObj->AsString; - } - return ( - $TransactionId, - $self->loc( - "[_1] is no longer a value for custom field [_2]", - $old_value, $cf->Name - ) - ); -} - - - -=head2 FirstCustomFieldValue FIELD - -Return the content of the first value of CustomField FIELD for this ticket -Takes a field id or name - -=cut - -sub FirstCustomFieldValue { - my $self = shift; - my $field = shift; - - my $values = $self->CustomFieldValues( $field ); - return undef unless my $first = $values->First; - return $first->Content; -} - -=head2 CustomFieldValuesAsString FIELD - -Return the content of the CustomField FIELD for this ticket. -If this is a multi-value custom field, values will be joined with newlines. - -Takes a field id or name as the first argument - -Takes an optional Separator => "," second and third argument -if you want to join the values using something other than a newline - -=cut - -sub CustomFieldValuesAsString { - my $self = shift; - my $field = shift; - my %args = @_; - my $separator = $args{Separator} || "\n"; - - my $values = $self->CustomFieldValues( $field ); - return join ($separator, grep { defined $_ } - map { $_->Content } @{$values->ItemsArrayRef}); -} - - - -=head2 CustomFieldValues FIELD - -Return a ObjectCustomFieldValues object of all values of the CustomField whose -id or Name is FIELD for this record. - -Returns an RT::ObjectCustomFieldValues object - -=cut - -sub CustomFieldValues { - my $self = shift; - my $field = shift; - - if ( $field ) { - my $cf = $self->LoadCustomFieldByIdentifier( $field ); - - # we were asked to search on a custom field we couldn't find - unless ( $cf->id ) { - $RT::Logger->warning("Couldn't load custom field by '$field' identifier"); - return RT::ObjectCustomFieldValues->new( $self->CurrentUser ); - } - return ( $cf->ValuesForObject($self) ); - } - - # we're not limiting to a specific custom field; - my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser ); - $ocfs->LimitToObject( $self ); - return $ocfs; -} - -=head2 LoadCustomFieldByIdentifier IDENTIFER - -Find the custom field has id or name IDENTIFIER for this object. - -If no valid field is found, returns an empty RT::CustomField object. - -=cut - -sub LoadCustomFieldByIdentifier { - my $self = shift; - my $field = shift; - - my $cf; - if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) { - $cf = RT::CustomField->new($self->CurrentUser); - $cf->SetContextObject( $self ); - $cf->LoadById( $field->id ); - } - elsif ($field =~ /^\d+$/) { - $cf = RT::CustomField->new($self->CurrentUser); - $cf->SetContextObject( $self ); - $cf->LoadById($field); - } else { - - my $cfs = $self->CustomFields($self->CurrentUser); - $cfs->SetContextObject( $self ); - $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0); - $cf = $cfs->First || RT::CustomField->new($self->CurrentUser); - } - return $cf; -} - -sub ACLEquivalenceObjects { } - -sub BasicColumns { } - -sub WikiBase { - return RT->Config->Get('WebPath'). "/index.html?q="; -} - -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/Ticket.pm.orig b/rt/lib/RT/Ticket.pm.orig deleted file mode 100755 index c3d4c2773..000000000 --- a/rt/lib/RT/Ticket.pm.orig +++ /dev/null @@ -1,4379 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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 SYNOPSIS - - use RT::Ticket; - my $ticket = RT::Ticket->new($CurrentUser); - $ticket->Load($ticket_id); - -=head1 DESCRIPTION - -This module lets you manipulate RT's ticket object. - - -=head1 METHODS - - -=cut - - -package RT::Ticket; - -use strict; -use warnings; - - -use RT::Queue; -use RT::User; -use RT::Record; -use RT::Links; -use RT::Date; -use RT::CustomFields; -use RT::Tickets; -use RT::Transactions; -use RT::Reminders; -use RT::URI::fsck_com_rt; -use RT::URI; -use RT::URI::freeside; -use MIME::Entity; -use Devel::GlobalDestruction; - - -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -our %LINKTYPEMAP = ( - MemberOf => { Type => 'MemberOf', - Mode => 'Target', }, - Parents => { Type => 'MemberOf', - Mode => 'Target', }, - Members => { Type => 'MemberOf', - Mode => 'Base', }, - Children => { Type => 'MemberOf', - Mode => 'Base', }, - HasMember => { Type => 'MemberOf', - Mode => 'Base', }, - RefersTo => { Type => 'RefersTo', - Mode => 'Target', }, - ReferredToBy => { Type => 'RefersTo', - Mode => 'Base', }, - DependsOn => { Type => 'DependsOn', - Mode => 'Target', }, - DependedOnBy => { Type => 'DependsOn', - Mode => 'Base', }, - MergedInto => { Type => 'MergedInto', - Mode => 'Target', }, - -); - - -# A helper table for links mapping to make it easier -# to build and parse links between tickets - -our %LINKDIRMAP = ( - MemberOf => { Base => 'MemberOf', - Target => 'HasMember', }, - RefersTo => { Base => 'RefersTo', - Target => 'ReferredToBy', }, - DependsOn => { Base => 'DependsOn', - Target => 'DependedOnBy', }, - MergedInto => { Base => 'MergedInto', - Target => 'MergedInto', }, - -); - - -sub LINKTYPEMAP { return \%LINKTYPEMAP } -sub LINKDIRMAP { return \%LINKDIRMAP } - -our %MERGE_CACHE = ( - effective => {}, - merged => {}, -); - - -=head2 Load - -Takes a single argument. This can be a ticket id, ticket alias or -local ticket uri. If the ticket can't be loaded, returns undef. -Otherwise, returns the ticket id. - -=cut - -sub Load { - my $self = shift; - my $id = shift; - $id = '' unless defined $id; - - # TODO: modify this routine to look at EffectiveId and - # do the recursive load thing. be careful to cache all - # the interim tickets we try so we don't loop forever. - - unless ( $id =~ /^\d+$/ ) { - $RT::Logger->debug("Tried to load a bogus ticket id: '$id'"); - return (undef); - } - - $id = $MERGE_CACHE{'effective'}{ $id } - if $MERGE_CACHE{'effective'}{ $id }; - - my ($ticketid, $msg) = $self->LoadById( $id ); - unless ( $self->Id ) { - $RT::Logger->debug("$self tried to load a bogus ticket: $id"); - return (undef); - } - - #If we're merged, resolve the merge. - if ( $self->EffectiveId && $self->EffectiveId != $self->Id ) { - $RT::Logger->debug( - "We found a merged ticket. " - . $self->id ."/". $self->EffectiveId - ); - my $real_id = $self->Load( $self->EffectiveId ); - $MERGE_CACHE{'effective'}{ $id } = $real_id; - return $real_id; - } - - #Ok. we're loaded. lets get outa here. - return $self->Id; -} - - - -=head2 Create (ARGS) - -Arguments: ARGS is a hash of named parameters. Valid parameters are: - - id - Queue - Either a Queue object or a Queue Name - Requestor - A reference to a list of email addresses or RT user Names - Cc - A reference to a list of email addresses or Names - AdminCc - A reference to a list of email addresses or Names - SquelchMailTo - A reference to a list of email addresses - - who should this ticket not mail - Type -- The ticket's type. ignore this for now - Owner -- This ticket's owner. either an RT::User object or this user's id - Subject -- A string describing the subject of the ticket - Priority -- an integer from 0 to 99 - InitialPriority -- an integer from 0 to 99 - FinalPriority -- an integer from 0 to 99 - Status -- any valid status for Queue's Lifecycle, otherwises uses on_create from Lifecycle default - TimeEstimated -- an integer. estimated time for this task in minutes - TimeWorked -- an integer. time worked so far in minutes - TimeLeft -- an integer. time remaining in minutes - Starts -- an ISO date describing the ticket's start date and time in GMT - Due -- an ISO date describing the ticket's due date and time in GMT - MIMEObj -- a MIME::Entity object with the content of the initial ticket request. - CustomField-<n> -- a scalar or array of values for the customfield with the id <n> - -Ticket links can be set up during create by passing the link type as a hask key and -the ticket id to be linked to as a value (or a URI when linking to other objects). -Multiple links of the same type can be created by passing an array ref. For example: - - Parents => 45, - DependsOn => [ 15, 22 ], - RefersTo => 'http://www.bestpractical.com', - -Supported link types are C<MemberOf>, C<HasMember>, C<RefersTo>, C<ReferredToBy>, -C<DependsOn> and C<DependedOnBy>. Also, C<Parents> is alias for C<MemberOf> and -C<Members> and C<Children> are aliases for C<HasMember>. - -Returns: TICKETID, Transaction Object, Error Message - - -=cut - -sub Create { - my $self = shift; - - my %args = ( - id => undef, - EffectiveId => undef, - Queue => undef, - Requestor => undef, - Cc => undef, - AdminCc => undef, - SquelchMailTo => undef, - TransSquelchMailTo => undef, - Type => 'ticket', - Owner => undef, - Subject => '', - InitialPriority => undef, - FinalPriority => undef, - Priority => undef, - Status => undef, - TimeWorked => "0", - TimeLeft => 0, - TimeEstimated => 0, - Due => undef, - Starts => undef, - Started => undef, - Resolved => undef, - WillResolve => undef, - MIMEObj => undef, - _RecordTransaction => 1, - DryRun => 0, - @_ - ); - - my ($ErrStr, @non_fatal_errors); - - my $QueueObj = RT::Queue->new( RT->SystemUser ); - if ( ref $args{'Queue'} eq 'RT::Queue' ) { - $QueueObj->Load( $args{'Queue'}->Id ); - } - elsif ( $args{'Queue'} ) { - $QueueObj->Load( $args{'Queue'} ); - } - else { - $RT::Logger->debug("'". ( $args{'Queue'} ||''). "' not a recognised queue object." ); - } - - #Can't create a ticket without a queue. - unless ( $QueueObj->Id ) { - $RT::Logger->debug("$self No queue given for ticket creation."); - return ( 0, 0, $self->loc('Could not create ticket. Queue not set') ); - } - - - #Now that we have a queue, Check the ACLS - unless ( - $self->CurrentUser->HasRight( - Right => 'CreateTicket', - Object => $QueueObj - ) - ) - { - return ( - 0, 0, - $self->loc( "No permission to create tickets in the queue '[_1]'", $QueueObj->Name)); - } - - my $cycle = $QueueObj->Lifecycle; - unless ( defined $args{'Status'} && length $args{'Status'} ) { - $args{'Status'} = $cycle->DefaultOnCreate; - } - - $args{'Status'} = lc $args{'Status'}; - unless ( $cycle->IsValid( $args{'Status'} ) ) { - return ( 0, 0, - $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", - $self->loc($args{'Status'})) - ); - } - - unless ( $cycle->IsTransition( '' => $args{'Status'} ) ) { - return ( 0, 0, - $self->loc("New tickets can not have status '[_1]' in this queue.", - $self->loc($args{'Status'})) - ); - } - - - - #Since we have a queue, we can set queue defaults - - #Initial Priority - # If there's no queue default initial priority and it's not set, set it to 0 - $args{'InitialPriority'} = $QueueObj->InitialPriority || 0 - unless defined $args{'InitialPriority'}; - - #Final priority - # If there's no queue default final priority and it's not set, set it to 0 - $args{'FinalPriority'} = $QueueObj->FinalPriority || 0 - unless defined $args{'FinalPriority'}; - - # Priority may have changed from InitialPriority, for the case - # where we're importing tickets (eg, from an older RT version.) - $args{'Priority'} = $args{'InitialPriority'} - unless defined $args{'Priority'}; - - # Dates - #TODO we should see what sort of due date we're getting, rather + - # than assuming it's in ISO format. - - #Set the due date. if we didn't get fed one, use the queue default due in - my $Due = RT::Date->new( $self->CurrentUser ); - if ( defined $args{'Due'} ) { - $Due->Set( Format => 'ISO', Value => $args{'Due'} ); - } - elsif ( my $due_in = $QueueObj->DefaultDueIn ) { - $Due->SetToNow; - $Due->AddDays( $due_in ); - } - - my $Starts = RT::Date->new( $self->CurrentUser ); - if ( defined $args{'Starts'} ) { - $Starts->Set( Format => 'ISO', Value => $args{'Starts'} ); - } - - my $Started = RT::Date->new( $self->CurrentUser ); - if ( defined $args{'Started'} ) { - $Started->Set( Format => 'ISO', Value => $args{'Started'} ); - } - - my $WillResolve = RT::Date->new($self->CurrentUser ); - if ( defined $args{'WillResolve'} ) { - $WillResolve->Set( Format => 'ISO', Value => $args{'WillResolve'} ); - } - - # If the status is not an initial status, set the started date - elsif ( !$cycle->IsInitial($args{'Status'}) ) { - $Started->SetToNow; - } - - my $Resolved = RT::Date->new( $self->CurrentUser ); - if ( defined $args{'Resolved'} ) { - $Resolved->Set( Format => 'ISO', Value => $args{'Resolved'} ); - } - - #If the status is an inactive status, set the resolved date - elsif ( $cycle->IsInactive( $args{'Status'} ) ) - { - $RT::Logger->debug( "Got a ". $args{'Status'} - ."(inactive) ticket with undefined resolved date. Setting to now." - ); - $Resolved->SetToNow; - } - - # }}} - - # Dealing with time fields - - $args{'TimeEstimated'} = 0 unless defined $args{'TimeEstimated'}; - $args{'TimeWorked'} = 0 unless defined $args{'TimeWorked'}; - $args{'TimeLeft'} = 0 unless defined $args{'TimeLeft'}; - - # }}} - - # Deal with setting the owner - - my $Owner; - if ( ref( $args{'Owner'} ) eq 'RT::User' ) { - if ( $args{'Owner'}->id ) { - $Owner = $args{'Owner'}; - } else { - $RT::Logger->error('Passed an empty RT::User for owner'); - push @non_fatal_errors, - $self->loc("Owner could not be set.") . " ". - $self->loc("Invalid value for [_1]",loc('owner')); - $Owner = undef; - } - } - - #If we've been handed something else, try to load the user. - elsif ( $args{'Owner'} ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( $args{'Owner'} ); - if (!$Owner->id) { - $Owner->LoadByEmail( $args{'Owner'} ) - } - unless ( $Owner->Id ) { - push @non_fatal_errors, - $self->loc("Owner could not be set.") . " " - . $self->loc( "User '[_1]' could not be found.", $args{'Owner'} ); - $Owner = undef; - } - } - - #If we have a proposed owner and they don't have the right - #to own a ticket, scream about it and make them not the owner - - my $DeferOwner; - if ( $Owner && $Owner->Id != RT->Nobody->Id - && !$Owner->HasRight( Object => $QueueObj, Right => 'OwnTicket' ) ) - { - $DeferOwner = $Owner; - $Owner = undef; - $RT::Logger->debug('going to deffer setting owner'); - - } - - #If we haven't been handed a valid owner, make it nobody. - unless ( defined($Owner) && $Owner->Id ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( RT->Nobody->Id ); - } - - # }}} - -# We attempt to load or create each of the people who might have a role for this ticket -# _outside_ the transaction, so we don't get into ticket creation races - foreach my $type ( "Cc", "AdminCc", "Requestor" ) { - $args{ $type } = [ $args{ $type } ] unless ref $args{ $type }; - foreach my $watcher ( splice @{ $args{$type} } ) { - next unless $watcher; - if ( $watcher =~ /^\d+$/ ) { - push @{ $args{$type} }, $watcher; - } else { - my @addresses = RT::EmailParser->ParseEmailAddress( $watcher ); - foreach my $address( @addresses ) { - my $user = RT::User->new( RT->SystemUser ); - my ($uid, $msg) = $user->LoadOrCreateByEmail( $address ); - unless ( $uid ) { - push @non_fatal_errors, - $self->loc("Couldn't load or create user: [_1]", $msg); - } else { - push @{ $args{$type} }, $user->id; - } - } - } - } - } - - $args{'Type'} = lc $args{'Type'} - if $args{'Type'} =~ /^(ticket|approval|reminder)$/i; - - $args{'Subject'} =~ s/\n//g; - - $RT::Handle->BeginTransaction(); - - my %params = ( - Queue => $QueueObj->Id, - Owner => $Owner->Id, - Subject => $args{'Subject'}, - InitialPriority => $args{'InitialPriority'}, - FinalPriority => $args{'FinalPriority'}, - Priority => $args{'Priority'}, - Status => $args{'Status'}, - TimeWorked => $args{'TimeWorked'}, - TimeEstimated => $args{'TimeEstimated'}, - TimeLeft => $args{'TimeLeft'}, - Type => $args{'Type'}, - Starts => $Starts->ISO, - Started => $Started->ISO, - Resolved => $Resolved->ISO, - WillResolve => $WillResolve->ISO, - Due => $Due->ISO - ); - -# Parameters passed in during an import that we probably don't want to touch, otherwise - foreach my $attr (qw(id Creator Created LastUpdated LastUpdatedBy)) { - $params{$attr} = $args{$attr} if $args{$attr}; - } - - # Delete null integer parameters - foreach my $attr - (qw(TimeWorked TimeLeft TimeEstimated InitialPriority FinalPriority)) - { - delete $params{$attr} - unless ( exists $params{$attr} && $params{$attr} ); - } - - # Delete the time worked if we're counting it in the transaction - delete $params{'TimeWorked'} if $args{'_RecordTransaction'}; - - my ($id,$ticket_message) = $self->SUPER::Create( %params ); - unless ($id) { - $RT::Logger->crit( "Couldn't create a ticket: " . $ticket_message ); - $RT::Handle->Rollback(); - return ( 0, 0, - $self->loc("Ticket could not be created due to an internal error") - ); - } - - #Set the ticket's effective ID now that we've created it. - my ( $val, $msg ) = $self->__Set( - Field => 'EffectiveId', - Value => ( $args{'EffectiveId'} || $id ) - ); - unless ( $val ) { - $RT::Logger->crit("Couldn't set EffectiveId: $msg"); - $RT::Handle->Rollback; - return ( 0, 0, - $self->loc("Ticket could not be created due to an internal error") - ); - } - - my $create_groups_ret = $self->_CreateTicketGroups(); - unless ($create_groups_ret) { - $RT::Logger->crit( "Couldn't create ticket groups for ticket " - . $self->Id - . ". aborting Ticket creation." ); - $RT::Handle->Rollback(); - return ( 0, 0, - $self->loc("Ticket could not be created due to an internal error") - ); - } - - # Set the owner in the Groups table - # We denormalize it into the Ticket table too because doing otherwise would - # kill performance, bigtime. It gets kept in lockstep thanks to the magic of transactionalization - $self->OwnerGroup->_AddMember( - PrincipalId => $Owner->PrincipalId, - InsideTransaction => 1 - ) unless $DeferOwner; - - - - # Deal with setting up watchers - - foreach my $type ( "Cc", "AdminCc", "Requestor" ) { - # we know it's an array ref - foreach my $watcher ( @{ $args{$type} } ) { - - # Note that we're using AddWatcher, rather than _AddWatcher, as we - # actually _want_ that ACL check. Otherwise, random ticket creators - # could make themselves adminccs and maybe get ticket rights. that would - # be poor - my $method = $type eq 'AdminCc'? 'AddWatcher': '_AddWatcher'; - - my ($val, $msg) = $self->$method( - Type => $type, - PrincipalId => $watcher, - Silent => 1, - ); - push @non_fatal_errors, $self->loc("Couldn't set [_1] watcher: [_2]", $type, $msg) - unless $val; - } - } - - if ($args{'SquelchMailTo'}) { - my @squelch = ref( $args{'SquelchMailTo'} ) ? @{ $args{'SquelchMailTo'} } - : $args{'SquelchMailTo'}; - $self->_SquelchMailTo( @squelch ); - } - - - # }}} - - # Add all the custom fields - - foreach my $arg ( keys %args ) { - next unless $arg =~ /^CustomField-(\d+)$/i; - my $cfid = $1; - - foreach my $value ( - UNIVERSAL::isa( $args{$arg} => 'ARRAY' ) ? @{ $args{$arg} } : ( $args{$arg} ) ) - { - next unless defined $value && length $value; - - # Allow passing in uploaded LargeContent etc by hash reference - my ($status, $msg) = $self->_AddCustomFieldValue( - (UNIVERSAL::isa( $value => 'HASH' ) - ? %$value - : (Value => $value) - ), - Field => $cfid, - RecordTransaction => 0, - ); - push @non_fatal_errors, $msg unless $status; - } - } - - # }}} - - # Deal with setting up links - - # TODO: Adding link may fire scrips on other end and those scrips - # could create transactions on this ticket before 'Create' transaction. - # - # We should implement different lifecycle: record 'Create' transaction, - # create links and only then fire create transaction's scrips. - # - # Ideal variant: add all links without firing scrips, record create - # transaction and only then fire scrips on the other ends of links. - # - # //RUZ - - foreach my $type ( keys %LINKTYPEMAP ) { - next unless ( defined $args{$type} ); - foreach my $link ( - ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) ) - { - my ( $val, $msg, $obj ) = $self->__GetTicketFromURI( URI => $link ); - unless ($val) { - push @non_fatal_errors, $msg; - next; - } - - # Check rights on the other end of the link if we must - # then run _AddLink that doesn't check for ACLs - if ( RT->Config->Get( 'StrictLinkACL' ) ) { - if ( $obj && !$obj->CurrentUserHasRight('ModifyTicket') ) { - push @non_fatal_errors, $self->loc('Linking. Permission denied'); - next; - } - } - - if ( $obj && lc $obj->Status eq 'deleted' ) { - push @non_fatal_errors, - $self->loc("Linking. Can't link to a deleted ticket"); - next; - } - - my ( $wval, $wmsg ) = $self->_AddLink( - Type => $LINKTYPEMAP{$type}->{'Type'}, - $LINKTYPEMAP{$type}->{'Mode'} => $link, - Silent => !$args{'_RecordTransaction'} || $self->Type eq 'reminder', - 'Silent'. ( $LINKTYPEMAP{$type}->{'Mode'} eq 'Base'? 'Target': 'Base' ) - => 1, - ); - - push @non_fatal_errors, $wmsg unless ($wval); - } - } - - # }}} - - # {{{ Deal with auto-customer association - - #unless we already have (a) customer(s)... - unless ( $self->Customers->Count ) { - - #first find any requestors with emails but *without* customer targets - my @NoCust_Requestors = - grep { $_->EmailAddress && ! $_->Customers->Count } - @{ $self->_Requestors->UserMembersObj->ItemsArrayRef }; - - for my $Requestor (@NoCust_Requestors) { - - #perhaps the stuff in here should be in a User method?? - my @Customers = - &RT::URI::freeside::email_search( email=>$Requestor->EmailAddress ); - - foreach my $custnum ( map $_->{'custnum'}, @Customers ) { - - ## false laziness w/RT/Interface/Web_Vendor.pm - my @link = ( 'Type' => 'MemberOf', - 'Target' => "freeside://freeside/cust_main/$custnum", - ); - - my( $val, $msg ) = $Requestor->_AddLink(@link); - #XXX should do something with $msg# push @non_fatal_errors, $msg; - - } - - } - - #find any requestors with customer targets - - my %cust_target = (); - - my @Requestors = - grep { $_->Customers->Count } - @{ $self->_Requestors->UserMembersObj->ItemsArrayRef }; - - foreach my $Requestor ( @Requestors ) { - foreach my $cust_link ( @{ $Requestor->Customers->ItemsArrayRef } ) { - $cust_target{ $cust_link->Target } = 1; - } - } - - #and then auto-associate this ticket with those customers - - foreach my $cust_target ( keys %cust_target ) { - - my @link = ( 'Type' => 'MemberOf', - #'Target' => "freeside://freeside/cust_main/$custnum", - 'Target' => $cust_target, - ); - - my( $val, $msg ) = $self->_AddLink(@link); - push @non_fatal_errors, $msg; - - } - - } - - # }}} - - # Now that we've created the ticket and set up its metadata, we can actually go and check OwnTicket on the ticket itself. - # This might be different than before in cases where extensions like RTIR are doing clever things with RT's ACL system - if ( $DeferOwner ) { - if (!$DeferOwner->HasRight( Object => $self, Right => 'OwnTicket')) { - - $RT::Logger->warning( "User " . $DeferOwner->Name . "(" . $DeferOwner->id - . ") was proposed as a ticket owner but has no rights to own " - . "tickets in " . $QueueObj->Name ); - push @non_fatal_errors, $self->loc( - "Owner '[_1]' does not have rights to own this ticket.", - $DeferOwner->Name - ); - } else { - $Owner = $DeferOwner; - $self->__Set(Field => 'Owner', Value => $Owner->id); - - } - $self->OwnerGroup->_AddMember( - PrincipalId => $Owner->PrincipalId, - InsideTransaction => 1 - ); - } - - #don't make a transaction or fire off any scrips for reminders either - if ( $args{'_RecordTransaction'} && $self->Type ne 'reminder' ) { - - # Add a transaction for the create - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => "Create", - TimeTaken => $args{'TimeWorked'}, - MIMEObj => $args{'MIMEObj'}, - CommitScrips => !$args{'DryRun'}, - SquelchMailTo => $args{'TransSquelchMailTo'}, - ); - - if ( $self->Id && $Trans ) { - - #$TransObj->UpdateCustomFields(ARGSRef => \%args); - $TransObj->UpdateCustomFields(%args); - - $RT::Logger->info( "Ticket " . $self->Id . " created in queue '" . $QueueObj->Name . "' by " . $self->CurrentUser->Name ); - $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name ); - $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); - } - else { - $RT::Handle->Rollback(); - - $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); - $RT::Logger->error("Ticket couldn't be created: $ErrStr"); - return ( 0, 0, $self->loc( "Ticket could not be created due to an internal error")); - } - - if ( $args{'DryRun'} ) { - $RT::Handle->Rollback(); - return ($self->id, $TransObj, $ErrStr); - } - $RT::Handle->Commit(); - return ( $self->Id, $TransObj->Id, $ErrStr ); - - # }}} - } - else { - - # Not going to record a transaction - $RT::Handle->Commit(); - $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name ); - $ErrStr = join( "\n", $ErrStr, @non_fatal_errors ); - return ( $self->Id, 0, $ErrStr ); - - } -} - -sub SetType { - my $self = shift; - my $value = shift; - - # Force lowercase on internal RT types - $value = lc $value - if $value =~ /^(ticket|approval|reminder)$/i; - return $self->_Set(Field => 'Type', Value => $value, @_); -} - - - -=head2 _Parse822HeadersForAttributes Content - -Takes an RFC822 style message and parses its attributes into a hash. - -=cut - -sub _Parse822HeadersForAttributes { - my $self = shift; - my $content = shift; - my %args; - - my @lines = ( split ( /\n/, $content ) ); - while ( defined( my $line = shift @lines ) ) { - if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) { - my $value = $2; - my $tag = lc($1); - - $tag =~ s/-//g; - if ( defined( $args{$tag} ) ) - { #if we're about to get a second value, make it an array - $args{$tag} = [ $args{$tag} ]; - } - if ( ref( $args{$tag} ) ) - { #If it's an array, we want to push the value - push @{ $args{$tag} }, $value; - } - else { #if there's nothing there, just set the value - $args{$tag} = $value; - } - } elsif ($line =~ /^$/) { - - #TODO: this won't work, since "" isn't of the form "foo:value" - - while ( defined( my $l = shift @lines ) ) { - push @{ $args{'content'} }, $l; - } - } - - } - - foreach my $date (qw(due starts started resolved)) { - my $dateobj = RT::Date->new(RT->SystemUser); - if ( defined ($args{$date}) and $args{$date} =~ /^\d+$/ ) { - $dateobj->Set( Format => 'unix', Value => $args{$date} ); - } - else { - $dateobj->Set( Format => 'unknown', Value => $args{$date} ); - } - $args{$date} = $dateobj->ISO; - } - $args{'mimeobj'} = MIME::Entity->new(); - $args{'mimeobj'}->build( - Type => ( $args{'contenttype'} || 'text/plain' ), - Data => ($args{'content'} || '') - ); - - return (%args); -} - - - -=head2 Import PARAMHASH - -Import a ticket. -Doesn't create a transaction. -Doesn't supply queue defaults, etc. - -Returns: TICKETID - -=cut - -sub Import { - my $self = shift; - my ( $ErrStr, $QueueObj, $Owner ); - - my %args = ( - id => undef, - EffectiveId => undef, - Queue => undef, - Requestor => undef, - Type => 'ticket', - Owner => RT->Nobody->Id, - Subject => '[no subject]', - InitialPriority => undef, - FinalPriority => undef, - Status => 'new', - TimeWorked => "0", - Due => undef, - Created => undef, - Updated => undef, - Resolved => undef, - Told => undef, - @_ - ); - - if ( ( defined( $args{'Queue'} ) ) && ( !ref( $args{'Queue'} ) ) ) { - $QueueObj = RT::Queue->new(RT->SystemUser); - $QueueObj->Load( $args{'Queue'} ); - - #TODO error check this and return 0 if it's not loading properly +++ - } - elsif ( ref( $args{'Queue'} ) eq 'RT::Queue' ) { - $QueueObj = RT::Queue->new(RT->SystemUser); - $QueueObj->Load( $args{'Queue'}->Id ); - } - else { - $RT::Logger->debug( - "$self " . $args{'Queue'} . " not a recognised queue object." ); - } - - #Can't create a ticket without a queue. - unless ( defined($QueueObj) and $QueueObj->Id ) { - $RT::Logger->debug("$self No queue given for ticket creation."); - return ( 0, $self->loc('Could not create ticket. Queue not set') ); - } - - #Now that we have a queue, Check the ACLS - unless ( - $self->CurrentUser->HasRight( - Right => 'CreateTicket', - Object => $QueueObj - ) - ) - { - return ( 0, - $self->loc("No permission to create tickets in the queue '[_1]'" - , $QueueObj->Name)); - } - - # Deal with setting the owner - - # Attempt to take user object, user name or user id. - # Assign to nobody if lookup fails. - if ( defined( $args{'Owner'} ) ) { - if ( ref( $args{'Owner'} ) ) { - $Owner = $args{'Owner'}; - } - else { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( $args{'Owner'} ); - if ( !defined( $Owner->id ) ) { - $Owner->Load( RT->Nobody->id ); - } - } - } - - #If we have a proposed owner and they don't have the right - #to own a ticket, scream about it and make them not the owner - if ( - ( defined($Owner) ) - and ( $Owner->Id != RT->Nobody->Id ) - and ( - !$Owner->HasRight( - Object => $QueueObj, - Right => 'OwnTicket' - ) - ) - ) - { - - $RT::Logger->warning( "$self user " - . $Owner->Name . "(" - . $Owner->id - . ") was proposed " - . "as a ticket owner but has no rights to own " - . "tickets in '" - . $QueueObj->Name . "'" ); - - $Owner = undef; - } - - #If we haven't been handed a valid owner, make it nobody. - unless ( defined($Owner) ) { - $Owner = RT::User->new( $self->CurrentUser ); - $Owner->Load( RT->Nobody->UserObj->Id ); - } - - # }}} - - unless ( $self->ValidateStatus( $args{'Status'} ) ) { - return ( 0, $self->loc("'[_1]' is an invalid value for status", $args{'Status'}) ); - } - - $self->{'_AccessibleCache'}{Created} = { 'read' => 1, 'write' => 1 }; - $self->{'_AccessibleCache'}{Creator} = { 'read' => 1, 'auto' => 1 }; - $self->{'_AccessibleCache'}{LastUpdated} = { 'read' => 1, 'write' => 1 }; - $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read' => 1, 'auto' => 1 }; - - # If we're coming in with an id, set that now. - my $EffectiveId = undef; - if ( $args{'id'} ) { - $EffectiveId = $args{'id'}; - - } - - my $id = $self->SUPER::Create( - id => $args{'id'}, - EffectiveId => $EffectiveId, - Queue => $QueueObj->Id, - Owner => $Owner->Id, - Subject => $args{'Subject'}, # loc - InitialPriority => $args{'InitialPriority'}, # loc - FinalPriority => $args{'FinalPriority'}, # loc - Priority => $args{'InitialPriority'}, # loc - Status => $args{'Status'}, # loc - TimeWorked => $args{'TimeWorked'}, # loc - Type => $args{'Type'}, # loc - Created => $args{'Created'}, # loc - Told => $args{'Told'}, # loc - LastUpdated => $args{'Updated'}, # loc - Resolved => $args{'Resolved'}, # loc - Due => $args{'Due'}, # loc - ); - - # If the ticket didn't have an id - # Set the ticket's effective ID now that we've created it. - if ( $args{'id'} ) { - $self->Load( $args{'id'} ); - } - else { - my ( $val, $msg ) = - $self->__Set( Field => 'EffectiveId', Value => $id ); - - unless ($val) { - $RT::Logger->err( - $self . "->Import couldn't set EffectiveId: $msg" ); - } - } - - my $create_groups_ret = $self->_CreateTicketGroups(); - unless ($create_groups_ret) { - $RT::Logger->crit( - "Couldn't create ticket groups for ticket " . $self->Id ); - } - - $self->OwnerGroup->_AddMember( PrincipalId => $Owner->PrincipalId ); - - foreach my $watcher ( @{ $args{'Cc'} } ) { - $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 ); - } - foreach my $watcher ( @{ $args{'AdminCc'} } ) { - $self->_AddWatcher( Type => 'AdminCc', Email => $watcher, - Silent => 1 ); - } - foreach my $watcher ( @{ $args{'Requestor'} } ) { - $self->_AddWatcher( Type => 'Requestor', Email => $watcher, - Silent => 1 ); - } - - return ( $self->Id, $ErrStr ); -} - - - - -=head2 _CreateTicketGroups - -Create the ticket groups and links for this ticket. -This routine expects to be called from Ticket->Create _inside of a transaction_ - -It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner. - -It will return true on success and undef on failure. - - -=cut - - -sub _CreateTicketGroups { - my $self = shift; - - my @types = (qw(Requestor Owner Cc AdminCc)); - - foreach my $type (@types) { - my $type_obj = RT::Group->new($self->CurrentUser); - my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role', - Instance => $self->Id, - Type => $type); - unless ($id) { - $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ". - $self->Id.": ".$msg); - return(undef); - } - } - return(1); - -} - - - -=head2 OwnerGroup - -A constructor which returns an RT::Group object containing the owner of this ticket. - -=cut - -sub OwnerGroup { - my $self = shift; - my $owner_obj = RT::Group->new($self->CurrentUser); - $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id, Type => 'Owner'); - return ($owner_obj); -} - - - - -=head2 AddWatcher - -AddWatcher takes a parameter hash. The keys are as follows: - -Type One of Requestor, Cc, AdminCc - -PrincipalId The RT::Principal id of the user or group that's being added as a watcher - -Email The email address of the new watcher. If a user with this - email address can't be found, a new nonprivileged user will be created. - -If the watcher you're trying to set has an RT account, set the PrincipalId paremeter to their User Id. Otherwise, set the Email parameter to their Email address. - -=cut - -sub AddWatcher { - my $self = shift; - my %args = ( - Type => undef, - PrincipalId => undef, - Email => undef, - @_ - ); - - # ModifyTicket works in any case - return $self->_AddWatcher( %args ) - if $self->CurrentUserHasRight('ModifyTicket'); - if ( $args{'Email'} ) { - my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} ); - return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} )) - unless $addr; - - if ( lc $self->CurrentUser->EmailAddress - eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) ) - { - $args{'PrincipalId'} = $self->CurrentUser->id; - delete $args{'Email'}; - } - } - - # If the watcher isn't the current user then the current user has no right - # bail - unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail - if ( $args{'Type'} eq 'AdminCc' ) { - unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - - # If it's a Requestor or Cc and they don't have 'Watch', bail - elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) { - unless ( $self->CurrentUserHasRight('Watch') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - else { - $RT::Logger->warning( "AddWatcher got passed a bogus type"); - return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') ); - } - - return $self->_AddWatcher( %args ); -} - -#This contains the meat of AddWatcher. but can be called from a routine like -# Create, which doesn't need the additional acl check -sub _AddWatcher { - my $self = shift; - my %args = ( - Type => undef, - Silent => undef, - PrincipalId => undef, - Email => undef, - @_ - ); - - - my $principal = RT::Principal->new($self->CurrentUser); - if ($args{'Email'}) { - if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'}))); - } - my $user = RT::User->new(RT->SystemUser); - my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} ); - $args{'PrincipalId'} = $pid if $pid; - } - if ($args{'PrincipalId'}) { - $principal->Load($args{'PrincipalId'}); - if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) { - return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'}))) - if RT::EmailParser->IsRTAddress( $email ); - - } - } - - - # If we can't find this watcher, we need to bail. - unless ($principal->Id) { - $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id); - return(0, $self->loc("Could not find or create that user")); - } - - - my $group = RT::Group->new($self->CurrentUser); - $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id); - unless ($group->id) { - return(0,$self->loc("Group not found")); - } - - if ( $group->HasMember( $principal)) { - - return ( 0, $self->loc('[_1] is already a [_2] for this ticket', - $principal->Object->Name, $self->loc($args{'Type'})) ); - } - - - my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id, - InsideTransaction => 1 ); - unless ($m_id) { - $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg); - - return ( 0, $self->loc('Could not make [_1] a [_2] for this ticket', - $principal->Object->Name, $self->loc($args{'Type'})) ); - } - - unless ( $args{'Silent'} ) { - $self->_NewTransaction( - Type => 'AddWatcher', - NewValue => $principal->Id, - Field => $args{'Type'} - ); - } - - return ( 1, $self->loc('Added [_1] as a [_2] for this ticket', - $principal->Object->Name, $self->loc($args{'Type'})) ); -} - - - - -=head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS } - - -Deletes a Ticket watcher. Takes two arguments: - -Type (one of Requestor,Cc,AdminCc) - -and one of - -PrincipalId (an RT::Principal Id of the watcher you want to remove) - OR -Email (the email address of an existing wathcer) - - -=cut - - -sub DeleteWatcher { - my $self = shift; - - my %args = ( Type => undef, - PrincipalId => undef, - Email => undef, - @_ ); - - unless ( $args{'PrincipalId'} || $args{'Email'} ) { - return ( 0, $self->loc("No principal specified") ); - } - my $principal = RT::Principal->new( $self->CurrentUser ); - if ( $args{'PrincipalId'} ) { - - $principal->Load( $args{'PrincipalId'} ); - } - else { - my $user = RT::User->new( $self->CurrentUser ); - $user->LoadByEmail( $args{'Email'} ); - $principal->Load( $user->Id ); - } - - # If we can't find this watcher, we need to bail. - unless ( $principal->Id ) { - return ( 0, $self->loc("Could not find that principal") ); - } - - my $group = RT::Group->new( $self->CurrentUser ); - $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id ); - unless ( $group->id ) { - return ( 0, $self->loc("Group not found") ); - } - - # Check ACLS - #If the watcher we're trying to add is for the current user - if ( $self->CurrentUser->PrincipalId == $principal->id ) { - - # If it's an AdminCc and they don't have - # 'WatchAsAdminCc' or 'ModifyTicket', bail - if ( $args{'Type'} eq 'AdminCc' ) { - unless ( $self->CurrentUserHasRight('ModifyTicket') - or $self->CurrentUserHasRight('WatchAsAdminCc') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - - # If it's a Requestor or Cc and they don't have - # 'Watch' or 'ModifyTicket', bail - elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) ) - { - unless ( $self->CurrentUserHasRight('ModifyTicket') - or $self->CurrentUserHasRight('Watch') ) { - return ( 0, $self->loc('Permission Denied') ); - } - } - else { - $RT::Logger->warning("$self -> DeleteWatcher got passed a bogus type"); - return ( 0, - $self->loc('Error in parameters to Ticket->DeleteWatcher') ); - } - } - - # If the watcher isn't the current user - # and the current user doesn't have 'ModifyTicket' bail - else { - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - } - - # }}} - - # see if this user is already a watcher. - - unless ( $group->HasMember($principal) ) { - return ( 0, - $self->loc( '[_1] is not a [_2] for this ticket', - $principal->Object->Name, $args{'Type'} ) ); - } - - my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id ); - unless ($m_id) { - $RT::Logger->error( "Failed to delete " - . $principal->Id - . " as a member of group " - . $group->Id . ": " - . $m_msg ); - - return (0, - $self->loc( - 'Could not remove [_1] as a [_2] for this ticket', - $principal->Object->Name, $args{'Type'} ) ); - } - - unless ( $args{'Silent'} ) { - $self->_NewTransaction( Type => 'DelWatcher', - OldValue => $principal->Id, - Field => $args{'Type'} ); - } - - return ( 1, - $self->loc( "[_1] is no longer a [_2] for this ticket.", - $principal->Object->Name, - $args{'Type'} ) ); -} - - - - - -=head2 SquelchMailTo [EMAIL] - -Takes an optional email address to never email about updates to this ticket. - - -Returns an array of the RT::Attribute objects for this ticket's 'SquelchMailTo' attributes. - - -=cut - -sub SquelchMailTo { - my $self = shift; - if (@_) { - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return (); - } - } else { - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - return (); - } - - } - return $self->_SquelchMailTo(@_); -} - -sub _SquelchMailTo { - my $self = shift; - if (@_) { - my $attr = shift; - $self->AddAttribute( Name => 'SquelchMailTo', Content => $attr ) - unless grep { $_->Content eq $attr } - $self->Attributes->Named('SquelchMailTo'); - } - my @attributes = $self->Attributes->Named('SquelchMailTo'); - return (@attributes); -} - - -=head2 UnsquelchMailTo ADDRESS - -Takes an address and removes it from this ticket's "SquelchMailTo" list. If an address appears multiple times, each instance is removed. - -Returns a tuple of (status, message) - -=cut - -sub UnsquelchMailTo { - my $self = shift; - - my $address = shift; - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - my ($val, $msg) = $self->Attributes->DeleteEntry ( Name => 'SquelchMailTo', Content => $address); - return ($val, $msg); -} - - - -=head2 RequestorAddresses - -B<Returns> String: All Ticket Requestor email addresses as a string. - -=cut - -sub RequestorAddresses { - my $self = shift; - - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - return undef; - } - - return ( $self->Requestors->MemberEmailAddressesAsString ); -} - - -=head2 AdminCcAddresses - -returns String: All Ticket AdminCc email addresses as a string - -=cut - -sub AdminCcAddresses { - my $self = shift; - - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - return undef; - } - - return ( $self->AdminCc->MemberEmailAddressesAsString ) - -} - -=head2 CcAddresses - -returns String: All Ticket Ccs as a string of email addresses - -=cut - -sub CcAddresses { - my $self = shift; - - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - return undef; - } - return ( $self->Cc->MemberEmailAddressesAsString); - -} - - - - -=head2 Requestors - -Takes nothing. -Returns this ticket's Requestors as an RT::Group object - -=cut - -sub Requestors { - my $self = shift; - - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id); - } - return ($group); - -} - -=head2 _Requestors - -Private non-ACLed variant of Reqeustors so that we can look them up for the -purposes of customer auto-association during create. - -=cut - -sub _Requestors { - my $self = shift; - - my $group = RT::Group->new($RT::SystemUser); - $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id); - return ($group); -} - -=head2 Cc - -Takes nothing. -Returns an RT::Group object which contains this ticket's Ccs. -If the user doesn't have "ShowTicket" permission, returns an empty group - -=cut - -sub Cc { - my $self = shift; - - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id); - } - return ($group); - -} - - - -=head2 AdminCc - -Takes nothing. -Returns an RT::Group object which contains this ticket's AdminCcs. -If the user doesn't have "ShowTicket" permission, returns an empty group - -=cut - -sub AdminCc { - my $self = shift; - - my $group = RT::Group->new($self->CurrentUser); - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id); - } - return ($group); - -} - - - - -# a generic routine to be called by IsRequestor, IsCc and IsAdminCc - -=head2 IsWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL } - -Takes a param hash with the attributes Type and either PrincipalId or Email - -Type is one of Requestor, Cc, AdminCc and Owner - -PrincipalId is an RT::Principal id, and Email is an email address. - -Returns true if the specified principal (or the one corresponding to the -specified address) is a member of the group Type for this ticket. - -XX TODO: This should be Memoized. - -=cut - -sub IsWatcher { - my $self = shift; - - my %args = ( Type => 'Requestor', - PrincipalId => undef, - Email => undef, - @_ - ); - - # Load the relevant group. - my $group = RT::Group->new($self->CurrentUser); - $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id); - - # Find the relevant principal. - if (!$args{PrincipalId} && $args{Email}) { - # Look up the specified user. - my $user = RT::User->new($self->CurrentUser); - $user->LoadByEmail($args{Email}); - if ($user->Id) { - $args{PrincipalId} = $user->PrincipalId; - } - else { - # A non-existent user can't be a group member. - return 0; - } - } - - # Ask if it has the member in question - return $group->HasMember( $args{'PrincipalId'} ); -} - - - -=head2 IsRequestor PRINCIPAL_ID - -Takes an L<RT::Principal> id. - -Returns true if the principal is a requestor of the current ticket. - -=cut - -sub IsRequestor { - my $self = shift; - my $person = shift; - - return ( $self->IsWatcher( Type => 'Requestor', PrincipalId => $person ) ); - -}; - - - -=head2 IsCc PRINCIPAL_ID - - Takes an RT::Principal id. - Returns true if the principal is a Cc of the current ticket. - - -=cut - -sub IsCc { - my $self = shift; - my $cc = shift; - - return ( $self->IsWatcher( Type => 'Cc', PrincipalId => $cc ) ); - -} - - - -=head2 IsAdminCc PRINCIPAL_ID - - Takes an RT::Principal id. - Returns true if the principal is an AdminCc of the current ticket. - -=cut - -sub IsAdminCc { - my $self = shift; - my $person = shift; - - return ( $self->IsWatcher( Type => 'AdminCc', PrincipalId => $person ) ); - -} - - - -=head2 IsOwner - - Takes an RT::User object. Returns true if that user is this ticket's owner. -returns undef otherwise - -=cut - -sub IsOwner { - my $self = shift; - my $person = shift; - - # no ACL check since this is used in acl decisions - # unless ($self->CurrentUserHasRight('ShowTicket')) { - # return(undef); - # } - - #Tickets won't yet have owners when they're being created. - unless ( $self->OwnerObj->id ) { - return (undef); - } - - if ( $person->id == $self->OwnerObj->id ) { - return (1); - } - else { - return (undef); - } -} - - - - - -=head2 TransactionAddresses - -Returns a composite hashref of the results of L<RT::Transaction/Addresses> for -all this ticket's Create, Comment or Correspond transactions. The keys are -stringified email addresses. Each value is an L<Email::Address> object. - -NOTE: For performance reasons, this method might want to skip transactions and go straight for attachments. But to make that work right, we're going to need to go and walk around the access control in Attachment.pm's sub _Value. - -=cut - - -sub TransactionAddresses { - my $self = shift; - my $txns = $self->Transactions; - - my %addresses = (); - - my $attachments = RT::Attachments->new( $self->CurrentUser ); - $attachments->LimitByTicket( $self->id ); - $attachments->Columns( qw( id Headers TransactionId)); - - - foreach my $type (qw(Create Comment Correspond)) { - $attachments->Limit( ALIAS => $attachments->TransactionAlias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => $type, - ENTRYAGGREGATOR => 'OR', - CASESENSITIVE => 1 - ); - } - - while ( my $att = $attachments->Next ) { - foreach my $addrlist ( values %{$att->Addresses } ) { - foreach my $addr (@$addrlist) { - -# Skip addresses without a phrase (things that are just raw addresses) if we have a phrase - next - if ( $addresses{ $addr->address } - && $addresses{ $addr->address }->phrase - && not $addr->phrase ); - - # skips "comment-only" addresses - next unless ( $addr->address ); - $addresses{ $addr->address } = $addr; - } - } - } - - return \%addresses; - -} - - - - - - -sub ValidateQueue { - my $self = shift; - my $Value = shift; - - if ( !$Value ) { - $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok."); - return (1); - } - - my $QueueObj = RT::Queue->new( $self->CurrentUser ); - my $id = $QueueObj->Load($Value); - - if ($id) { - return (1); - } - else { - return (undef); - } -} - - - -sub SetQueue { - my $self = shift; - my $NewQueue = shift; - - #Redundant. ACL gets checked in _Set; - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - my $NewQueueObj = RT::Queue->new( $self->CurrentUser ); - $NewQueueObj->Load($NewQueue); - - unless ( $NewQueueObj->Id() ) { - return ( 0, $self->loc("That queue does not exist") ); - } - - if ( $NewQueueObj->Id == $self->QueueObj->Id ) { - return ( 0, $self->loc('That is the same value') ); - } - unless ( $self->CurrentUser->HasRight( Right => 'CreateTicket', Object => $NewQueueObj)) { - return ( 0, $self->loc("You may not create requests in that queue.") ); - } - - my $new_status; - my $old_lifecycle = $self->QueueObj->Lifecycle; - my $new_lifecycle = $NewQueueObj->Lifecycle; - if ( $old_lifecycle->Name ne $new_lifecycle->Name ) { - unless ( $old_lifecycle->HasMoveMap( $new_lifecycle ) ) { - return ( 0, $self->loc("There is no mapping for statuses between these queues. Contact your system administrator.") ); - } - $new_status = $old_lifecycle->MoveMap( $new_lifecycle )->{ lc $self->Status }; - return ( 0, $self->loc("Mapping between queues' lifecycles is incomplete. Contact your system administrator.") ) - unless $new_status; - } - - if ( $new_status ) { - my $clone = RT::Ticket->new( RT->SystemUser ); - $clone->Load( $self->Id ); - unless ( $clone->Id ) { - return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) ); - } - - my $now = RT::Date->new( $self->CurrentUser ); - $now->SetToNow; - - my $old_status = $clone->Status; - - #If we're changing the status from initial in old to not intial in new, - # record that we've started - if ( $old_lifecycle->IsInitial($old_status) && !$new_lifecycle->IsInitial($new_status) && $clone->StartedObj->Unix == 0 ) { - #Set the Started time to "now" - $clone->_Set( - Field => 'Started', - Value => $now->ISO, - RecordTransaction => 0 - ); - } - - #When we close a ticket, set the 'Resolved' attribute to now. - # It's misnamed, but that's just historical. - if ( $new_lifecycle->IsInactive($new_status) ) { - $clone->_Set( - Field => 'Resolved', - Value => $now->ISO, - RecordTransaction => 0, - ); - } - - #Actually update the status - my ($val, $msg)= $clone->_Set( - Field => 'Status', - Value => $new_status, - RecordTransaction => 0, - ); - $RT::Logger->error( 'Status change failed on queue change: '. $msg ) - unless $val; - } - - my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() ); - - if ( $status ) { - # Clear the queue object cache; - $self->{_queue_obj} = undef; - - # Untake the ticket if we have no permissions in the new queue - unless ( $self->OwnerObj->HasRight( Right => 'OwnTicket', Object => $NewQueueObj ) ) { - my $clone = RT::Ticket->new( RT->SystemUser ); - $clone->Load( $self->Id ); - unless ( $clone->Id ) { - return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) ); - } - my ($status, $msg) = $clone->SetOwner( RT->Nobody->Id, 'Force' ); - $RT::Logger->error("Couldn't set owner on queue change: $msg") unless $status; - } - - # On queue change, change queue for reminders too - my $reminder_collection = $self->Reminders->Collection; - while ( my $reminder = $reminder_collection->Next ) { - my ($status, $msg) = $reminder->SetQueue($NewQueue); - $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status; - } - } - - return ($status, $msg); -} - - - -=head2 QueueObj - -Takes nothing. returns this ticket's queue object - -=cut - -sub QueueObj { - my $self = shift; - - if(!$self->{_queue_obj} || ! $self->{_queue_obj}->id) { - - $self->{_queue_obj} = RT::Queue->new( $self->CurrentUser ); - - #We call __Value so that we can avoid the ACL decision and some deep recursion - my ($result) = $self->{_queue_obj}->Load( $self->__Value('Queue') ); - } - return ($self->{_queue_obj}); -} - -sub SetSubject { - my $self = shift; - my $value = shift; - $value =~ s/\n//g; - return $self->_Set( Field => 'Subject', Value => $value ); -} - -=head2 SubjectTag - -Takes nothing. Returns SubjectTag for this ticket. Includes -queue's subject tag or rtname if that is not set, ticket -id and braces, for example: - - [support.example.com #123456] - -=cut - -sub SubjectTag { - my $self = shift; - return - '[' - . ($self->QueueObj->SubjectTag || RT->Config->Get('rtname')) - .' #'. $self->id - .']' - ; -} - - -=head2 DueObj - - Returns an RT::Date object containing this ticket's due date - -=cut - -sub DueObj { - my $self = shift; - - my $time = RT::Date->new( $self->CurrentUser ); - - # -1 is RT::Date slang for never - if ( my $due = $self->Due ) { - $time->Set( Format => 'sql', Value => $due ); - } - else { - $time->Set( Format => 'unix', Value => -1 ); - } - - return $time; -} - - - -=head2 DueAsString - -Returns this ticket's due date as a human readable string - -=cut - -sub DueAsString { - my $self = shift; - return $self->DueObj->AsString(); -} - - - -=head2 ResolvedObj - - Returns an RT::Date object of this ticket's 'resolved' time. - -=cut - -sub ResolvedObj { - my $self = shift; - - my $time = RT::Date->new( $self->CurrentUser ); - $time->Set( Format => 'sql', Value => $self->Resolved ); - return $time; -} - - -=head2 FirstActiveStatus - -Returns the first active status that the ticket could transition to, -according to its current Queue's lifecycle. May return undef if there -is no such possible status to transition to, or we are already in it. -This is used in L<RT::Action::AutoOpen>, for instance. - -=cut - -sub FirstActiveStatus { - my $self = shift; - - my $lifecycle = $self->QueueObj->Lifecycle; - my $status = $self->Status; - my @active = $lifecycle->Active; - # no change if no active statuses in the lifecycle - return undef unless @active; - - # no change if the ticket is already has first status from the list of active - return undef if lc $status eq lc $active[0]; - - my ($next) = grep $lifecycle->IsActive($_), $lifecycle->Transitions($status); - return $next; -} - -=head2 FirstInactiveStatus - -Returns the first inactive status that the ticket could transition to, -according to its current Queue's lifecycle. May return undef if there -is no such possible status to transition to, or we are already in it. -This is used in resolve action in UnsafeEmailCommands, for instance. - -=cut - -sub FirstInactiveStatus { - my $self = shift; - - my $lifecycle = $self->QueueObj->Lifecycle; - my $status = $self->Status; - my @inactive = $lifecycle->Inactive; - # no change if no inactive statuses in the lifecycle - return undef unless @inactive; - - # no change if the ticket is already has first status from the list of inactive - return undef if lc $status eq lc $inactive[0]; - - my ($next) = grep $lifecycle->IsInactive($_), $lifecycle->Transitions($status); - return $next; -} - -=head2 SetStarted - -Takes a date in ISO format or undef -Returns a transaction id and a message -The client calls "Start" to note that the project was started on the date in $date. -A null date means "now" - -=cut - -sub SetStarted { - my $self = shift; - my $time = shift || 0; - - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - #We create a date object to catch date weirdness - my $time_obj = RT::Date->new( $self->CurrentUser() ); - if ( $time ) { - $time_obj->Set( Format => 'ISO', Value => $time ); - } - else { - $time_obj->SetToNow(); - } - - # We need $TicketAsSystem, in case the current user doesn't have - # ShowTicket - my $TicketAsSystem = RT::Ticket->new(RT->SystemUser); - $TicketAsSystem->Load( $self->Id ); - # Now that we're starting, open this ticket - # TODO: do we really want to force this as policy? it should be a scrip - my $next = $TicketAsSystem->FirstActiveStatus; - - $self->SetStatus( $next ) if defined $next; - - return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) ); - -} - - - -=head2 StartedObj - - Returns an RT::Date object which contains this ticket's -'Started' time. - -=cut - -sub StartedObj { - my $self = shift; - - my $time = RT::Date->new( $self->CurrentUser ); - $time->Set( Format => 'sql', Value => $self->Started ); - return $time; -} - - - -=head2 StartsObj - - Returns an RT::Date object which contains this ticket's -'Starts' time. - -=cut - -sub StartsObj { - my $self = shift; - - my $time = RT::Date->new( $self->CurrentUser ); - $time->Set( Format => 'sql', Value => $self->Starts ); - return $time; -} - - - -=head2 ToldObj - - Returns an RT::Date object which contains this ticket's -'Told' time. - -=cut - -sub ToldObj { - my $self = shift; - - my $time = RT::Date->new( $self->CurrentUser ); - $time->Set( Format => 'sql', Value => $self->Told ); - return $time; -} - - - -=head2 ToldAsString - -A convenience method that returns ToldObj->AsString - -TODO: This should be deprecated - -=cut - -sub ToldAsString { - my $self = shift; - if ( $self->Told ) { - return $self->ToldObj->AsString(); - } - else { - return ("Never"); - } -} - - - -=head2 TimeWorkedAsString - -Returns the amount of time worked on this ticket as a Text String - -=cut - -sub TimeWorkedAsString { - my $self = shift; - my $value = $self->TimeWorked; - - # return the # of minutes worked turned into seconds and written as - # a simple text string, this is not really a date object, but if we - # diff a number of seconds vs the epoch, we'll get a nice description - # of time worked. - return "" unless $value; - return RT::Date->new( $self->CurrentUser ) - ->DurationAsString( $value * 60 ); -} - - - -=head2 TimeLeftAsString - -Returns the amount of time left on this ticket as a Text String - -=cut - -sub TimeLeftAsString { - my $self = shift; - my $value = $self->TimeLeft; - return "" unless $value; - return RT::Date->new( $self->CurrentUser ) - ->DurationAsString( $value * 60 ); -} - - - - -=head2 Comment - -Comment on this ticket. -Takes a hash with the following attributes: -If MIMEObj is undefined, Content will be used to build a MIME::Entity for this -comment. - -MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun - -If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed. -They will, however, be prepared and you'll be able to access them through the TransactionObj - -Returns: Transaction id, Error Message, Transaction Object -(note the different order from Create()!) - -=cut - -sub Comment { - my $self = shift; - - my %args = ( CcMessageTo => undef, - BccMessageTo => undef, - MIMEObj => undef, - Content => undef, - TimeTaken => 0, - DryRun => 0, - @_ ); - - unless ( ( $self->CurrentUserHasRight('CommentOnTicket') ) - or ( $self->CurrentUserHasRight('ModifyTicket') ) ) { - return ( 0, $self->loc("Permission Denied"), undef ); - } - $args{'NoteType'} = 'Comment'; - - $RT::Handle->BeginTransaction(); - if ($args{'DryRun'}) { - $args{'CommitScrips'} = 0; - } - - my @results = $self->_RecordNote(%args); - if ($args{'DryRun'}) { - $RT::Handle->Rollback(); - } else { - $RT::Handle->Commit(); - } - - return(@results); -} - - -=head2 Correspond - -Correspond on this ticket. -Takes a hashref with the following attributes: - - -MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun - -if there's no MIMEObj, Content is used to build a MIME::Entity object - -If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed. -They will, however, be prepared and you'll be able to access them through the TransactionObj - -Returns: Transaction id, Error Message, Transaction Object -(note the different order from Create()!) - - -=cut - -sub Correspond { - my $self = shift; - my %args = ( CcMessageTo => undef, - BccMessageTo => undef, - MIMEObj => undef, - Content => undef, - TimeTaken => 0, - @_ ); - - unless ( ( $self->CurrentUserHasRight('ReplyToTicket') ) - or ( $self->CurrentUserHasRight('ModifyTicket') ) ) { - return ( 0, $self->loc("Permission Denied"), undef ); - } - $args{'NoteType'} = 'Correspond'; - - $RT::Handle->BeginTransaction(); - if ($args{'DryRun'}) { - $args{'CommitScrips'} = 0; - } - - my @results = $self->_RecordNote(%args); - - unless ( $results[0] ) { - $RT::Handle->Rollback(); - return @results; - } - - #Set the last told date to now if this isn't mail from the requestor. - #TODO: Note that this will wrongly ack mail from any non-requestor as a "told" - unless ( $self->IsRequestor($self->CurrentUser->id) ) { - my %squelch; - $squelch{$_}++ for map {$_->Content} $self->SquelchMailTo, $results[2]->SquelchMailTo; - $self->_SetTold - if grep {not $squelch{$_}} $self->Requestors->MemberEmailAddresses; - } - - if ($args{'DryRun'}) { - $RT::Handle->Rollback(); - } else { - $RT::Handle->Commit(); - } - - return (@results); - -} - - - -=head2 _RecordNote - -the meat of both comment and correspond. - -Performs no access control checks. hence, dangerous. - -=cut - -sub _RecordNote { - my $self = shift; - my %args = ( - CcMessageTo => undef, - BccMessageTo => undef, - Encrypt => undef, - Sign => undef, - MIMEObj => undef, - Content => undef, - NoteType => 'Correspond', - TimeTaken => 0, - CommitScrips => 1, - SquelchMailTo => undef, - CustomFields => {}, - @_ - ); - - unless ( $args{'MIMEObj'} || $args{'Content'} ) { - return ( 0, $self->loc("No message attached"), undef ); - } - - unless ( $args{'MIMEObj'} ) { - $args{'MIMEObj'} = MIME::Entity->build( - Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] ) - ); - } - - $args{'MIMEObj'}->head->replace('X-RT-Interface' => 'API') - unless $args{'MIMEObj'}->head->get('X-RT-Interface'); - - # convert text parts into utf-8 - RT::I18N::SetMIMEEntityToUTF8( $args{'MIMEObj'} ); - - # If we've been passed in CcMessageTo and BccMessageTo fields, - # add them to the mime object for passing on to the transaction handler - # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and - # RT-Send-Bcc: headers - - - foreach my $type (qw/Cc Bcc/) { - if ( defined $args{ $type . 'MessageTo' } ) { - - my $addresses = join ', ', ( - map { RT::User->CanonicalizeEmailAddress( $_->address ) } - Email::Address->parse( $args{ $type . 'MessageTo' } ) ); - $args{'MIMEObj'}->head->replace( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) ); - } - } - - foreach my $argument (qw(Encrypt Sign)) { - $args{'MIMEObj'}->head->replace( - "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } ) - ) if defined $args{ $argument }; - } - - # If this is from an external source, we need to come up with its - # internal Message-ID now, so all emails sent because of this - # message have a common Message-ID - my $org = RT->Config->Get('Organization'); - my $msgid = $args{'MIMEObj'}->head->get('Message-ID'); - unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) { - $args{'MIMEObj'}->head->set( - 'RT-Message-ID' => Encode::encode_utf8( - RT::Interface::Email::GenMessageId( Ticket => $self ) - ) - ); - } - - #Record the correspondence (write the transaction) - my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction( - Type => $args{'NoteType'}, - Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ), - TimeTaken => $args{'TimeTaken'}, - MIMEObj => $args{'MIMEObj'}, - CommitScrips => $args{'CommitScrips'}, - SquelchMailTo => $args{'SquelchMailTo'}, - CustomFields => $args{'CustomFields'}, - ); - - unless ($Trans) { - $RT::Logger->err("$self couldn't init a transaction $msg"); - return ( $Trans, $self->loc("Message could not be recorded"), undef ); - } - - return ( $Trans, $self->loc("Message recorded"), $TransObj ); -} - - -=head2 DryRun - -Builds a MIME object from the given C<UpdateSubject> and -C<UpdateContent>, then calls L</Comment> or L</Correspond> with -C<< DryRun => 1 >>, and returns the transaction so produced. - -=cut - -sub DryRun { - my $self = shift; - my %args = @_; - my $action; - if (($args{'UpdateType'} || $args{Action}) =~ /^respon(d|se)$/i ) { - $action = 'Correspond'; - } else { - $action = 'Comment'; - } - - my $Message = MIME::Entity->build( - Type => 'text/plain', - Subject => defined $args{UpdateSubject} ? Encode::encode_utf8( $args{UpdateSubject} ) : "", - Charset => 'UTF-8', - Data => $args{'UpdateContent'} || "", - ); - - my ( $Transaction, $Description, $Object ) = $self->$action( - CcMessageTo => $args{'UpdateCc'}, - BccMessageTo => $args{'UpdateBcc'}, - MIMEObj => $Message, - TimeTaken => $args{'UpdateTimeWorked'}, - DryRun => 1, - ); - unless ( $Transaction ) { - $RT::Logger->error("Couldn't fire '$action' action: $Description"); - } - - return $Object; -} - -=head2 DryRunCreate - -Prepares a MIME mesage with the given C<Subject>, C<Cc>, and -C<Content>, then calls L</Create> with C<< DryRun => 1 >> and returns -the resulting L<RT::Transaction>. - -=cut - -sub DryRunCreate { - my $self = shift; - my %args = @_; - my $Message = MIME::Entity->build( - Type => 'text/plain', - Subject => defined $args{Subject} ? Encode::encode_utf8( $args{'Subject'} ) : "", - (defined $args{'Cc'} ? - ( Cc => Encode::encode_utf8( $args{'Cc'} ) ) : ()), - Charset => 'UTF-8', - Data => $args{'Content'} || "", - ); - - my ( $Transaction, $Object, $Description ) = $self->Create( - Type => $args{'Type'} || 'ticket', - Queue => $args{'Queue'}, - Owner => $args{'Owner'}, - Requestor => $args{'Requestors'}, - Cc => $args{'Cc'}, - AdminCc => $args{'AdminCc'}, - InitialPriority => $args{'InitialPriority'}, - FinalPriority => $args{'FinalPriority'}, - TimeLeft => $args{'TimeLeft'}, - TimeEstimated => $args{'TimeEstimated'}, - TimeWorked => $args{'TimeWorked'}, - Subject => $args{'Subject'}, - Status => $args{'Status'}, - MIMEObj => $Message, - DryRun => 1, - ); - unless ( $Transaction ) { - $RT::Logger->error("Couldn't fire Create action: $Description"); - } - - return $Object; -} - - - -sub _Links { - my $self = shift; - - #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic --- - #tobias meant by $f - my $field = shift; - my $type = shift || ""; - - my $cache_key = "$field$type"; - return $self->{ $cache_key } if $self->{ $cache_key }; - - my $links = $self->{ $cache_key } - = RT::Links->new( $self->CurrentUser ); - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - $links->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' ); - return $links; - } - - # Maybe this ticket is a merge ticket - #my $limit_on = 'Local'. $field; - # at least to myself - $links->Limit( - FIELD => $field, #$limit_on, - OPERATOR => 'MATCHES', - VALUE => 'fsck.com-rt://%/ticket/'. $self->id, - ENTRYAGGREGATOR => 'OR', - ); - $links->Limit( - FIELD => $field, #$limit_on, - OPERATOR => 'MATCHES', - VALUE => 'fsck.com-rt://%/ticket/'. $_, - ENTRYAGGREGATOR => 'OR', - ) foreach $self->Merged; - $links->Limit( - FIELD => 'Type', - VALUE => $type, - ) if $type; - - return $links; -} - - - -=head2 DeleteLink - -Delete a link. takes a paramhash of Base, Target, Type, Silent, -SilentBase and SilentTarget. Either Base or Target must be null. -The null value will be replaced with this ticket's id. - -If Silent is true then no transaction would be recorded, in other -case you can control creation of transactions on both base and -target with SilentBase and SilentTarget respectively. By default -both transactions are created. - -=cut - -sub DeleteLink { - my $self = shift; - my %args = ( - Base => undef, - Target => undef, - Type => undef, - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ - ); - - unless ( $args{'Target'} || $args{'Base'} ) { - $RT::Logger->error("Base or Target must be specified"); - return ( 0, $self->loc('Either base or target must be specified') ); - } - - #check acls - my $right = 0; - $right++ if $self->CurrentUserHasRight('ModifyTicket'); - if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); - return (0, $msg) unless $status; - if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { - $right++; - } - if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || - ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) - { - return ( 0, $self->loc("Permission Denied") ); - } - - my ($val, $Msg) = $self->SUPER::_DeleteLink(%args); - return ( 0, $Msg ) unless $val; - - return ( $val, $Msg ) if $args{'Silent'}; - - my ($direction, $remote_link); - - if ( $args{'Base'} ) { - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - elsif ( $args{'Target'} ) { - $remote_link = $args{'Target'}; - $direction = 'Base'; - } - - my $remote_uri = RT::URI->new( $self->CurrentUser ); - $remote_uri->FromURI( $remote_link ); - - unless ( $args{ 'Silent'. $direction } ) { - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => 'DeleteLink', - Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, - OldValue => $remote_uri->URI || $remote_link, - TimeTaken => 0 - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; - } - - if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { - my $OtherObj = $remote_uri->Object; - my ( $val, $Msg ) = $OtherObj->_NewTransaction( - Type => 'DeleteLink', - Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} - : $LINKDIRMAP{$args{'Type'}}->{Target}, - OldValue => $self->URI, - ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), - TimeTaken => 0, - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $val; - } - - return ( $val, $Msg ); -} - - - -=head2 AddLink - -Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket. - -If Silent is true then no transaction would be recorded, in other -case you can control creation of transactions on both base and -target with SilentBase and SilentTarget respectively. By default -both transactions are created. - -=cut - -sub AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ ); - - unless ( $args{'Target'} || $args{'Base'} ) { - $RT::Logger->error("Base or Target must be specified"); - return ( 0, $self->loc('Either base or target must be specified') ); - } - - my $right = 0; - $right++ if $self->CurrentUserHasRight('ModifyTicket'); - if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} ); - return (0, $msg) unless $status; - if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) { - $right++; - } - if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) || - ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) ) - { - return ( 0, $self->loc("Permission Denied") ); - } - - return ( 0, "Can't link to a deleted ticket" ) - if $other_ticket && lc $other_ticket->Status eq 'deleted'; - - return $self->_AddLink(%args); -} - -sub __GetTicketFromURI { - my $self = shift; - my %args = ( URI => '', @_ ); - - # If the other URI is an RT::Ticket, we want to make sure the user - # can modify it too... - my $uri_obj = RT::URI->new( $self->CurrentUser ); - unless ($uri_obj->FromURI( $args{'URI'} )) { - my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} ); - $RT::Logger->warning( $msg ); - return( 0, $msg ); - } - my $obj = $uri_obj->Resolver->Object; - unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) { - return (1, 'Found not a ticket', undef); - } - return (1, 'Found ticket', $obj); -} - -=head2 _AddLink - -Private non-acled variant of AddLink so that links can be added during create. - -=cut - -sub _AddLink { - my $self = shift; - my %args = ( Target => '', - Base => '', - Type => '', - Silent => undef, - SilentBase => undef, - SilentTarget => undef, - @_ ); - - my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args); - return ($val, $msg) if !$val || $exist; - return ($val, $msg) if $args{'Silent'}; - - my ($direction, $remote_link); - if ( $args{'Target'} ) { - $remote_link = $args{'Target'}; - $direction = 'Base'; - } elsif ( $args{'Base'} ) { - $remote_link = $args{'Base'}; - $direction = 'Target'; - } - - my $remote_uri = RT::URI->new( $self->CurrentUser ); - $remote_uri->FromURI( $remote_link ); - - unless ( $args{ 'Silent'. $direction } ) { - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => 'AddLink', - Field => $LINKDIRMAP{$args{'Type'}}->{$direction}, - NewValue => $remote_uri->URI || $remote_link, - TimeTaken => 0 - ); - $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans; - } - - if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) { - my $OtherObj = $remote_uri->Object; - my ( $val, $msg ) = $OtherObj->_NewTransaction( - Type => 'AddLink', - Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} - : $LINKDIRMAP{$args{'Type'}}->{Target}, - NewValue => $self->URI, - ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'), - TimeTaken => 0, - ); - $RT::Logger->error("Couldn't create transaction: $msg") unless $val; - } - - return ( $val, $msg ); -} - - - - -=head2 MergeInto - -MergeInto take the id of the ticket to merge this ticket into. - -=cut - -sub MergeInto { - my $self = shift; - my $ticket_id = shift; - - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - # Load up the new ticket. - my $MergeInto = RT::Ticket->new($self->CurrentUser); - $MergeInto->Load($ticket_id); - - # make sure it exists. - unless ( $MergeInto->Id ) { - return ( 0, $self->loc("New ticket doesn't exist") ); - } - - # Make sure the current user can modify the new ticket. - unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - delete $MERGE_CACHE{'effective'}{ $self->id }; - delete @{ $MERGE_CACHE{'merged'} }{ - $ticket_id, $MergeInto->id, $self->id - }; - - $RT::Handle->BeginTransaction(); - - $self->_MergeInto( $MergeInto ); - - $RT::Handle->Commit(); - - return ( 1, $self->loc("Merge Successful") ); -} - -sub _MergeInto { - my $self = shift; - my $MergeInto = shift; - - - # We use EffectiveId here even though it duplicates information from - # the links table becasue of the massive performance hit we'd take - # by trying to do a separate database query for merge info everytime - # loaded a ticket. - - #update this ticket's effective id to the new ticket's id. - my ( $id_val, $id_msg ) = $self->__Set( - Field => 'EffectiveId', - Value => $MergeInto->Id() - ); - - unless ($id_val) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") ); - } - - - my $force_status = $self->QueueObj->Lifecycle->DefaultOnMerge; - if ( $force_status && $force_status ne $self->__Value('Status') ) { - my ( $status_val, $status_msg ) - = $self->__Set( Field => 'Status', Value => $force_status ); - - unless ($status_val) { - $RT::Handle->Rollback(); - $RT::Logger->error( - "Couldn't set status to $force_status. RT's Database may be inconsistent." - ); - return ( 0, $self->loc("Merge failed. Couldn't set Status") ); - } - } - - # update all the links that point to that old ticket - my $old_links_to = RT::Links->new($self->CurrentUser); - $old_links_to->Limit(FIELD => 'Target', VALUE => $self->URI); - - my %old_seen; - while (my $link = $old_links_to->Next) { - if (exists $old_seen{$link->Base."-".$link->Type}) { - $link->Delete; - } - elsif ($link->Base eq $MergeInto->URI) { - $link->Delete; - } else { - # First, make sure the link doesn't already exist. then move it over. - my $tmp = RT::Link->new(RT->SystemUser); - $tmp->LoadByCols(Base => $link->Base, Type => $link->Type, LocalTarget => $MergeInto->id); - if ($tmp->id) { - $link->Delete; - } else { - $link->SetTarget($MergeInto->URI); - $link->SetLocalTarget($MergeInto->id); - } - $old_seen{$link->Base."-".$link->Type} =1; - } - - } - - my $old_links_from = RT::Links->new($self->CurrentUser); - $old_links_from->Limit(FIELD => 'Base', VALUE => $self->URI); - - while (my $link = $old_links_from->Next) { - if (exists $old_seen{$link->Type."-".$link->Target}) { - $link->Delete; - } - if ($link->Target eq $MergeInto->URI) { - $link->Delete; - } else { - # First, make sure the link doesn't already exist. then move it over. - my $tmp = RT::Link->new(RT->SystemUser); - $tmp->LoadByCols(Target => $link->Target, Type => $link->Type, LocalBase => $MergeInto->id); - if ($tmp->id) { - $link->Delete; - } else { - $link->SetBase($MergeInto->URI); - $link->SetLocalBase($MergeInto->id); - $old_seen{$link->Type."-".$link->Target} =1; - } - } - - } - - # Update time fields - foreach my $type (qw(TimeEstimated TimeWorked TimeLeft)) { - - my $mutator = "Set$type"; - $MergeInto->$mutator( - ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) ); - - } -#add all of this ticket's watchers to that ticket. - foreach my $watcher_type (qw(Requestors Cc AdminCc)) { - - my $people = $self->$watcher_type->MembersObj; - my $addwatcher_type = $watcher_type; - $addwatcher_type =~ s/s$//; - - while ( my $watcher = $people->Next ) { - - my ($val, $msg) = $MergeInto->_AddWatcher( - Type => $addwatcher_type, - Silent => 1, - PrincipalId => $watcher->MemberId - ); - unless ($val) { - $RT::Logger->debug($msg); - } - } - - } - - #find all of the tickets that were merged into this ticket. - my $old_mergees = RT::Tickets->new( $self->CurrentUser ); - $old_mergees->Limit( - FIELD => 'EffectiveId', - OPERATOR => '=', - VALUE => $self->Id - ); - - # update their EffectiveId fields to the new ticket's id - while ( my $ticket = $old_mergees->Next() ) { - my ( $val, $msg ) = $ticket->__Set( - Field => 'EffectiveId', - Value => $MergeInto->Id() - ); - } - - #make a new link: this ticket is merged into that other ticket. - $self->AddLink( Type => 'MergedInto', Target => $MergeInto->Id()); - - $MergeInto->_SetLastUpdated; -} - -=head2 Merged - -Returns list of tickets' ids that's been merged into this ticket. - -=cut - -sub Merged { - my $self = shift; - - my $id = $self->id; - return @{ $MERGE_CACHE{'merged'}{ $id } } - if $MERGE_CACHE{'merged'}{ $id }; - - my $mergees = RT::Tickets->new( $self->CurrentUser ); - $mergees->Limit( - FIELD => 'EffectiveId', - VALUE => $id, - ); - $mergees->Limit( - FIELD => 'id', - OPERATOR => '!=', - VALUE => $id, - ); - return @{ $MERGE_CACHE{'merged'}{ $id } ||= [] } - = map $_->id, @{ $mergees->ItemsArrayRef || [] }; -} - - - - - -=head2 OwnerObj - -Takes nothing and returns an RT::User object of -this ticket's owner - -=cut - -sub OwnerObj { - my $self = shift; - - #If this gets ACLed, we lose on a rights check in User.pm and - #get deep recursion. if we need ACLs here, we need - #an equiv without ACLs - - my $owner = RT::User->new( $self->CurrentUser ); - $owner->Load( $self->__Value('Owner') ); - - #Return the owner object - return ($owner); -} - - - -=head2 OwnerAsString - -Returns the owner's email address - -=cut - -sub OwnerAsString { - my $self = shift; - return ( $self->OwnerObj->EmailAddress ); - -} - - - -=head2 SetOwner - -Takes two arguments: - the Id or Name of the owner -and (optionally) the type of the SetOwner Transaction. It defaults -to 'Set'. 'Steal' is also a valid option. - - -=cut - -sub SetOwner { - my $self = shift; - my $NewOwner = shift; - my $Type = shift || "Set"; - - $RT::Handle->BeginTransaction(); - - $self->_SetLastUpdated(); # lock the ticket - $self->Load( $self->id ); # in case $self changed while waiting for lock - - my $OldOwnerObj = $self->OwnerObj; - - my $NewOwnerObj = RT::User->new( $self->CurrentUser ); - $NewOwnerObj->Load( $NewOwner ); - unless ( $NewOwnerObj->Id ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("That user does not exist") ); - } - - - # must have ModifyTicket rights - # or TakeTicket/StealTicket and $NewOwner is self - # see if it's a take - if ( $OldOwnerObj->Id == RT->Nobody->Id ) { - unless ( $self->CurrentUserHasRight('ModifyTicket') - || $self->CurrentUserHasRight('TakeTicket') ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Permission Denied") ); - } - } - - # see if it's a steal - elsif ( $OldOwnerObj->Id != RT->Nobody->Id - && $OldOwnerObj->Id != $self->CurrentUser->id ) { - - unless ( $self->CurrentUserHasRight('ModifyTicket') - || $self->CurrentUserHasRight('StealTicket') ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Permission Denied") ); - } - } - else { - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Permission Denied") ); - } - } - - # If we're not stealing and the ticket has an owner and it's not - # the current user - if ( $Type ne 'Steal' and $Type ne 'Force' - and $OldOwnerObj->Id != RT->Nobody->Id - and $OldOwnerObj->Id != $self->CurrentUser->Id ) - { - $RT::Handle->Rollback(); - return ( 0, $self->loc("You can only take tickets that are unowned") ) - if $NewOwnerObj->id == $self->CurrentUser->id; - return ( - 0, - $self->loc("You can only reassign tickets that you own or that are unowned" ) - ); - } - - #If we've specified a new owner and that user can't modify the ticket - elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("That user may not own tickets in that queue") ); - } - - # If the ticket has an owner and it's the new owner, we don't need - # To do anything - elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("That user already owns that ticket") ); - } - - # Delete the owner in the owner group, then add a new one - # TODO: is this safe? it's not how we really want the API to work - # for most things, but it's fast. - my ( $del_id, $del_msg ); - for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) { - ($del_id, $del_msg) = $owner->Delete(); - last unless ($del_id); - } - - unless ($del_id) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) ); - } - - my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember( - PrincipalId => $NewOwnerObj->PrincipalId, - InsideTransaction => 1 ); - unless ($add_id) { - $RT::Handle->Rollback(); - return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) ); - } - - # We call set twice with slightly different arguments, so - # as to not have an SQL transaction span two RT transactions - - my ( $val, $msg ) = $self->_Set( - Field => 'Owner', - RecordTransaction => 0, - Value => $NewOwnerObj->Id, - TimeTaken => 0, - TransactionType => 'Set', - CheckACL => 0, # don't check acl - ); - - unless ($val) { - $RT::Handle->Rollback; - return ( 0, $self->loc("Could not change owner: [_1]", $msg) ); - } - - ($val, $msg) = $self->_NewTransaction( - Type => 'Set', - Field => 'Owner', - NewValue => $NewOwnerObj->Id, - OldValue => $OldOwnerObj->Id, - TimeTaken => 0, - ); - - if ( $val ) { - $msg = $self->loc( "Owner changed from [_1] to [_2]", - $OldOwnerObj->Name, $NewOwnerObj->Name ); - } - else { - $RT::Handle->Rollback(); - return ( 0, $msg ); - } - - $RT::Handle->Commit(); - - return ( $val, $msg ); -} - - - -=head2 Take - -A convenince method to set the ticket's owner to the current user - -=cut - -sub Take { - my $self = shift; - return ( $self->SetOwner( $self->CurrentUser->Id, 'Take' ) ); -} - - - -=head2 Untake - -Convenience method to set the owner to 'nobody' if the current user is the owner. - -=cut - -sub Untake { - my $self = shift; - return ( $self->SetOwner( RT->Nobody->UserObj->Id, 'Untake' ) ); -} - - - -=head2 Steal - -A convenience method to change the owner of the current ticket to the -current user. Even if it's owned by another user. - -=cut - -sub Steal { - my $self = shift; - - if ( $self->IsOwner( $self->CurrentUser ) ) { - return ( 0, $self->loc("You already own this ticket") ); - } - else { - return ( $self->SetOwner( $self->CurrentUser->Id, 'Steal' ) ); - - } - -} - - - - - -=head2 ValidateStatus STATUS - -Takes a string. Returns true if that status is a valid status for this ticket. -Returns false otherwise. - -=cut - -sub ValidateStatus { - my $self = shift; - my $status = shift; - - #Make sure the status passed in is valid - return 1 if $self->QueueObj->IsValidStatus($status); - - my $i = 0; - while ( my $caller = (caller($i++))[3] ) { - return 1 if $caller eq 'RT::Ticket::SetQueue'; - } - - return 0; -} - -sub Status { - my $self = shift; - my $value = $self->_Value( 'Status' ); - return $value unless $self->QueueObj; - return $self->QueueObj->Lifecycle->CanonicalCase( $value ); -} - -=head2 SetStatus STATUS - -Set this ticket's status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted. - -Alternatively, you can pass in a list of named parameters (Status => STATUS, Force => FORCE, SetStarted => SETSTARTED ). -If FORCE is true, ignore unresolved dependencies and force a status change. -if SETSTARTED is true( it's the default value), set Started to current datetime if Started -is not set and the status is changed from initial to not initial. - -=cut - -sub SetStatus { - my $self = shift; - my %args; - if (@_ == 1) { - $args{Status} = shift; - } - else { - %args = (@_); - } - - # this only allows us to SetStarted, not we must SetStarted. - # this option was added for rtir initially - $args{SetStarted} = 1 unless exists $args{SetStarted}; - - - my $lifecycle = $self->QueueObj->Lifecycle; - - my $new = lc $args{'Status'}; - unless ( $lifecycle->IsValid( $new ) ) { - return (0, $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", $self->loc($new))); - } - - my $old = $self->__Value('Status'); - unless ( $lifecycle->IsTransition( $old => $new ) ) { - return (0, $self->loc("You can't change status from '[_1]' to '[_2]'.", $self->loc($old), $self->loc($new))); - } - - my $check_right = $lifecycle->CheckRight( $old => $new ); - unless ( $self->CurrentUserHasRight( $check_right ) ) { - return ( 0, $self->loc('Permission Denied') ); - } - - if ( !$args{Force} && $lifecycle->IsInactive( $new ) && $self->HasUnresolvedDependencies) { - return (0, $self->loc('That ticket has unresolved dependencies')); - } - - my $now = RT::Date->new( $self->CurrentUser ); - $now->SetToNow(); - - my $raw_started = RT::Date->new(RT->SystemUser); - $raw_started->Set(Format => 'ISO', Value => $self->__Value('Started')); - - #If we're changing the status from new, record that we've started - if ( $args{SetStarted} && $lifecycle->IsInitial($old) && !$lifecycle->IsInitial($new) && !$raw_started->Unix) { - #Set the Started time to "now" - $self->_Set( - Field => 'Started', - Value => $now->ISO, - RecordTransaction => 0 - ); - } - - #When we close a ticket, set the 'Resolved' attribute to now. - # It's misnamed, but that's just historical. - if ( $lifecycle->IsInactive($new) ) { - $self->_Set( - Field => 'Resolved', - Value => $now->ISO, - RecordTransaction => 0, - ); - } - - #Actually update the status - my ($val, $msg)= $self->_Set( - Field => 'Status', - Value => $new, - TimeTaken => 0, - CheckACL => 0, - TransactionType => 'Status', - ); - return ($val, $msg); -} - - - -=head2 Delete - -Takes no arguments. Marks this ticket for garbage collection - -=cut - -sub Delete { - my $self = shift; - unless ( $self->QueueObj->Lifecycle->IsValid('deleted') ) { - return (0, $self->loc('Delete operation is disabled by lifecycle configuration') ); #loc - } - return ( $self->SetStatus('deleted') ); -} - - -=head2 SetTold ISO [TIMETAKEN] - -Updates the told and records a transaction - -=cut - -sub SetTold { - my $self = shift; - my $told; - $told = shift if (@_); - my $timetaken = shift || 0; - - unless ( $self->CurrentUserHasRight('ModifyTicket') ) { - return ( 0, $self->loc("Permission Denied") ); - } - - my $datetold = RT::Date->new( $self->CurrentUser ); - if ($told) { - $datetold->Set( Format => 'iso', - Value => $told ); - } - else { - $datetold->SetToNow(); - } - - return ( $self->_Set( Field => 'Told', - Value => $datetold->ISO, - TimeTaken => $timetaken, - TransactionType => 'Told' ) ); -} - -=head2 _SetTold - -Updates the told without a transaction or acl check. Useful when we're sending replies. - -=cut - -sub _SetTold { - my $self = shift; - - my $now = RT::Date->new( $self->CurrentUser ); - $now->SetToNow(); - - #use __Set to get no ACLs ;) - return ( $self->__Set( Field => 'Told', - Value => $now->ISO ) ); -} - -=head2 SeenUpTo - - -=cut - -sub SeenUpTo { - my $self = shift; - my $uid = $self->CurrentUser->id; - my $attr = $self->FirstAttribute( "User-". $uid ."-SeenUpTo" ); - return if $attr && $attr->Content gt $self->LastUpdated; - - my $txns = $self->Transactions; - $txns->Limit( FIELD => 'Type', VALUE => 'Comment' ); - $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' ); - $txns->Limit( FIELD => 'Creator', OPERATOR => '!=', VALUE => $uid ); - $txns->Limit( - FIELD => 'Created', - OPERATOR => '>', - VALUE => $attr->Content - ) if $attr; - $txns->RowsPerPage(1); - return $txns->First; -} - -=head2 RanTransactionBatch - -Acts as a guard around running TransactionBatch scrips. - -Should be false until you enter the code that runs TransactionBatch scrips - -Accepts an optional argument to indicate that TransactionBatch Scrips should no longer be run on this object. - -=cut - -sub RanTransactionBatch { - my $self = shift; - my $val = shift; - - if ( defined $val ) { - return $self->{_RanTransactionBatch} = $val; - } else { - return $self->{_RanTransactionBatch}; - } - -} - - -=head2 TransactionBatch - -Returns an array reference of all transactions created on this ticket during -this ticket object's lifetime or since last application of a batch, or undef -if there were none. - -Only works when the C<UseTransactionBatch> config option is set to true. - -=cut - -sub TransactionBatch { - my $self = shift; - return $self->{_TransactionBatch}; -} - -=head2 ApplyTransactionBatch - -Applies scrips on the current batch of transactions and shinks it. Usually -batch is applied when object is destroyed, but in some cases it's too late. - -=cut - -sub ApplyTransactionBatch { - my $self = shift; - - my $batch = $self->TransactionBatch; - return unless $batch && @$batch; - - $self->_ApplyTransactionBatch; - - $self->{_TransactionBatch} = []; -} - -sub _ApplyTransactionBatch { - my $self = shift; - - return if $self->RanTransactionBatch; - $self->RanTransactionBatch(1); - - my $still_exists = RT::Ticket->new( RT->SystemUser ); - $still_exists->Load( $self->Id ); - if (not $still_exists->Id) { - # The ticket has been removed from the database, but we still - # have pending TransactionBatch txns for it. Unfortunately, - # because it isn't in the DB anymore, attempting to run scrips - # on it may produce unpredictable results; simply drop the - # batched transactions. - $RT::Logger->warning("TransactionBatch was fired on a ticket that no longer exists; unable to run scrips! Call ->ApplyTransactionBatch before shredding the ticket, for consistent results."); - return; - } - - my $batch = $self->TransactionBatch; - - my %seen; - my $types = join ',', grep !$seen{$_}++, grep defined, map $_->__Value('Type'), grep defined, @{$batch}; - - require RT::Scrips; - RT::Scrips->new(RT->SystemUser)->Apply( - Stage => 'TransactionBatch', - TicketObj => $self, - TransactionObj => $batch->[0], - Type => $types, - ); - - # Entry point of the rule system - my $rules = RT::Ruleset->FindAllRules( - Stage => 'TransactionBatch', - TicketObj => $self, - TransactionObj => $batch->[0], - Type => $types, - ); - RT::Ruleset->CommitRules($rules); -} - -sub DESTROY { - my $self = shift; - - # DESTROY methods need to localize $@, or it may unset it. This - # causes $m->abort to not bubble all of the way up. See perlbug - # http://rt.perl.org/rt3/Ticket/Display.html?id=17650 - local $@; - - # The following line eliminates reentrancy. - # It protects against the fact that perl doesn't deal gracefully - # when an object's refcount is changed in its destructor. - return if $self->{_Destroyed}++; - - if (in_global_destruction()) { - unless ($ENV{'HARNESS_ACTIVE'}) { - warn "Too late to safely run transaction-batch scrips!" - ." This is typically caused by using ticket objects" - ." at the top-level of a script which uses the RT API." - ." Be sure to explicitly undef such ticket objects," - ." or put them inside of a lexical scope."; - } - return; - } - - return $self->ApplyTransactionBatch; -} - - - - -sub _OverlayAccessible { - { - EffectiveId => { 'read' => 1, 'write' => 1, 'public' => 1 }, - Queue => { 'read' => 1, 'write' => 1 }, - Requestors => { 'read' => 1, 'write' => 1 }, - Owner => { 'read' => 1, 'write' => 1 }, - Subject => { 'read' => 1, 'write' => 1 }, - InitialPriority => { 'read' => 1, 'write' => 1 }, - FinalPriority => { 'read' => 1, 'write' => 1 }, - Priority => { 'read' => 1, 'write' => 1 }, - Status => { 'read' => 1, 'write' => 1 }, - TimeEstimated => { 'read' => 1, 'write' => 1 }, - TimeWorked => { 'read' => 1, 'write' => 1 }, - TimeLeft => { 'read' => 1, 'write' => 1 }, - Told => { 'read' => 1, 'write' => 1 }, - Resolved => { 'read' => 1 }, - Type => { 'read' => 1 }, - Starts => { 'read' => 1, 'write' => 1 }, - Started => { 'read' => 1, 'write' => 1 }, - Due => { 'read' => 1, 'write' => 1 }, - Creator => { 'read' => 1, 'auto' => 1 }, - Created => { 'read' => 1, 'auto' => 1 }, - LastUpdatedBy => { 'read' => 1, 'auto' => 1 }, - LastUpdated => { 'read' => 1, 'auto' => 1 } - }; - -} - - - -sub _Set { - my $self = shift; - - my %args = ( Field => undef, - Value => undef, - TimeTaken => 0, - RecordTransaction => 1, - UpdateTicket => 1, - CheckACL => 1, - TransactionType => 'Set', - @_ ); - - if ($args{'CheckACL'}) { - unless ( $self->CurrentUserHasRight('ModifyTicket')) { - return ( 0, $self->loc("Permission Denied")); - } - } - - unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) { - $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket"); - return(0, $self->loc("Internal Error")); - } - - #if the user is trying to modify the record - - #Take care of the old value we really don't want to get in an ACL loop. - # so ask the super::_Value - my $Old = $self->SUPER::_Value("$args{'Field'}"); - - my ($ret, $msg); - if ( $args{'UpdateTicket'} ) { - - #Set the new value - ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'}, - Value => $args{'Value'} ); - - #If we can't actually set the field to the value, don't record - # a transaction. instead, get out of here. - return ( 0, $msg ) unless $ret; - } - - if ( $args{'RecordTransaction'} == 1 ) { - - my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction( - Type => $args{'TransactionType'}, - Field => $args{'Field'}, - NewValue => $args{'Value'}, - OldValue => $Old, - TimeTaken => $args{'TimeTaken'}, - ); - # Ensure that we can read the transaction, even if the change - # just made the ticket unreadable to us - $TransObj->{ _object_is_readable } = 1; - return ( $Trans, scalar $TransObj->BriefDescription ); - } - else { - return ( $ret, $msg ); - } -} - - - -=head2 _Value - -Takes the name of a table column. -Returns its value as a string, if the user passes an ACL check - -=cut - -sub _Value { - - my $self = shift; - my $field = shift; - - #if the field is public, return it. - if ( $self->_Accessible( $field, 'public' ) ) { - - #$RT::Logger->debug("Skipping ACL check for $field"); - return ( $self->SUPER::_Value($field) ); - - } - - #If the current user doesn't have ACLs, don't let em at it. - - unless ( $self->CurrentUserHasRight('ShowTicket') ) { - return (undef); - } - return ( $self->SUPER::_Value($field) ); - -} - - - -=head2 _UpdateTimeTaken - -This routine will increment the timeworked counter. it should -only be called from _NewTransaction - -=cut - -sub _UpdateTimeTaken { - my $self = shift; - my $Minutes = shift; - my ($Total); - - $Total = $self->SUPER::_Value("TimeWorked"); - $Total = ( $Total || 0 ) + ( $Minutes || 0 ); - $self->SUPER::_Set( - Field => "TimeWorked", - Value => $Total - ); - - return ($Total); -} - - - - - -=head2 CurrentUserHasRight - - Takes the textual name of a Ticket scoped right (from RT::ACE) and returns -1 if the user has that right. It returns 0 if the user doesn't have that right. - -=cut - -sub CurrentUserHasRight { - my $self = shift; - my $right = shift; - - return $self->CurrentUser->PrincipalObj->HasRight( - Object => $self, - Right => $right, - ) -} - - -=head2 CurrentUserCanSee - -Returns true if the current user can see the ticket, using ShowTicket - -=cut - -sub CurrentUserCanSee { - my $self = shift; - return $self->CurrentUserHasRight('ShowTicket'); -} - -=head2 HasRight - - Takes a paramhash with the attributes 'Right' and 'Principal' - 'Right' is a ticket-scoped textual right from RT::ACE - 'Principal' is an RT::User object - - Returns 1 if the principal has the right. Returns undef if not. - -=cut - -sub HasRight { - my $self = shift; - my %args = ( - Right => undef, - Principal => undef, - @_ - ); - - unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) ) - { - Carp::cluck("Principal attrib undefined for Ticket::HasRight"); - $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight"); - return(undef); - } - - return ( - $args{'Principal'}->HasRight( - Object => $self, - Right => $args{'Right'} - ) - ); -} - - - -=head2 Reminders - -Return the Reminders object for this ticket. (It's an RT::Reminders object.) -It isn't acutally a searchbuilder collection itself. - -=cut - -sub Reminders { - my $self = shift; - - unless ($self->{'__reminders'}) { - $self->{'__reminders'} = RT::Reminders->new($self->CurrentUser); - $self->{'__reminders'}->Ticket($self->id); - } - return $self->{'__reminders'}; - -} - - - - -=head2 Transactions - - Returns an RT::Transactions object of all transactions on this ticket - -=cut - -sub Transactions { - my $self = shift; - - my $transactions = RT::Transactions->new( $self->CurrentUser ); - - #If the user has no rights, return an empty object - if ( $self->CurrentUserHasRight('ShowTicket') ) { - $transactions->LimitToTicket($self->id); - - # if the user may not see comments do not return them - unless ( $self->CurrentUserHasRight('ShowTicketComments') ) { - $transactions->Limit( - SUBCLAUSE => 'acl', - FIELD => 'Type', - OPERATOR => '!=', - VALUE => "Comment" - ); - $transactions->Limit( - SUBCLAUSE => 'acl', - FIELD => 'Type', - OPERATOR => '!=', - VALUE => "CommentEmailRecord", - ENTRYAGGREGATOR => 'AND' - ); - - } - } else { - $transactions->Limit( - SUBCLAUSE => 'acl', - FIELD => 'id', - VALUE => 0, - ENTRYAGGREGATOR => 'AND' - ); - } - - return ($transactions); -} - - - - -=head2 TransactionCustomFields - - Returns the custom fields that transactions on tickets will have. - -=cut - -sub TransactionCustomFields { - my $self = shift; - my $cfs = $self->QueueObj->TicketTransactionCustomFields; - $cfs->SetContextObject( $self ); - return $cfs; -} - - -=head2 LoadCustomFieldByIdentifier - -Finds and returns the custom field of the given name for the ticket, -overriding L<RT::Record/LoadCustomFieldByIdentifier> to look for -queue-specific CFs before global ones. - -=cut - -sub LoadCustomFieldByIdentifier { - my $self = shift; - my $field = shift; - - return $self->SUPER::LoadCustomFieldByIdentifier($field) - if ref $field or $field =~ /^\d+$/; - - my $cf = RT::CustomField->new( $self->CurrentUser ); - $cf->SetContextObject( $self ); - $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue ); - $cf->LoadByNameAndQueue( Name => $field, Queue => 0 ) unless $cf->id; - return $cf; -} - - -=head2 CustomFieldLookupType - -Returns the RT::Ticket lookup type, which can be passed to -RT::CustomField->Create() via the 'LookupType' hash key. - -=cut - - -sub CustomFieldLookupType { - "RT::Queue-RT::Ticket"; -} - -=head2 ACLEquivalenceObjects - -This method returns a list of objects for which a user's rights also apply -to this ticket. Generally, this is only the ticket's queue, but some RT -extensions may make other objects available too. - -This method is called from L<RT::Principal/HasRight>. - -=cut - -sub ACLEquivalenceObjects { - my $self = shift; - return $self->QueueObj; - -} - - -1; - -=head1 AUTHOR - -Jesse Vincent, jesse@bestpractical.com - -=head1 SEE ALSO - -RT - -=cut - - -use RT::Queue; -use base 'RT::Record'; - -sub Table {'Tickets'} - - - - - - -=head2 id - -Returns the current value of id. -(In the database, id is stored as int(11).) - - -=cut - - -=head2 EffectiveId - -Returns the current value of EffectiveId. -(In the database, EffectiveId is stored as int(11).) - - - -=head2 SetEffectiveId VALUE - - -Set EffectiveId to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, EffectiveId will be stored as a int(11).) - - -=cut - - -=head2 Queue - -Returns the current value of Queue. -(In the database, Queue is stored as int(11).) - - - -=head2 SetQueue VALUE - - -Set Queue to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Queue will be stored as a int(11).) - - -=cut - - -=head2 Type - -Returns the current value of Type. -(In the database, Type is stored as varchar(16).) - - - -=head2 SetType VALUE - - -Set Type to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Type will be stored as a varchar(16).) - - -=cut - - -=head2 IssueStatement - -Returns the current value of IssueStatement. -(In the database, IssueStatement is stored as int(11).) - - - -=head2 SetIssueStatement VALUE - - -Set IssueStatement to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, IssueStatement will be stored as a int(11).) - - -=cut - - -=head2 Resolution - -Returns the current value of Resolution. -(In the database, Resolution is stored as int(11).) - - - -=head2 SetResolution VALUE - - -Set Resolution to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Resolution will be stored as a int(11).) - - -=cut - - -=head2 Owner - -Returns the current value of Owner. -(In the database, Owner is stored as int(11).) - - - -=head2 SetOwner VALUE - - -Set Owner to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Owner will be stored as a int(11).) - - -=cut - - -=head2 Subject - -Returns the current value of Subject. -(In the database, Subject is stored as varchar(200).) - - - -=head2 SetSubject VALUE - - -Set Subject to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Subject will be stored as a varchar(200).) - - -=cut - - -=head2 InitialPriority - -Returns the current value of InitialPriority. -(In the database, InitialPriority is stored as int(11).) - - - -=head2 SetInitialPriority VALUE - - -Set InitialPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, InitialPriority will be stored as a int(11).) - - -=cut - - -=head2 FinalPriority - -Returns the current value of FinalPriority. -(In the database, FinalPriority is stored as int(11).) - - - -=head2 SetFinalPriority VALUE - - -Set FinalPriority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, FinalPriority will be stored as a int(11).) - - -=cut - - -=head2 Priority - -Returns the current value of Priority. -(In the database, Priority is stored as int(11).) - - - -=head2 SetPriority VALUE - - -Set Priority to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Priority will be stored as a int(11).) - - -=cut - - -=head2 TimeEstimated - -Returns the current value of TimeEstimated. -(In the database, TimeEstimated is stored as int(11).) - - - -=head2 SetTimeEstimated VALUE - - -Set TimeEstimated to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeEstimated will be stored as a int(11).) - - -=cut - - -=head2 TimeWorked - -Returns the current value of TimeWorked. -(In the database, TimeWorked is stored as int(11).) - - - -=head2 SetTimeWorked VALUE - - -Set TimeWorked to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeWorked will be stored as a int(11).) - - -=cut - - -=head2 Status - -Returns the current value of Status. -(In the database, Status is stored as varchar(64).) - - - -=head2 SetStatus VALUE - - -Set Status to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Status will be stored as a varchar(64).) - - -=cut - - -=head2 TimeLeft - -Returns the current value of TimeLeft. -(In the database, TimeLeft is stored as int(11).) - - - -=head2 SetTimeLeft VALUE - - -Set TimeLeft to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, TimeLeft will be stored as a int(11).) - - -=cut - - -=head2 Told - -Returns the current value of Told. -(In the database, Told is stored as datetime.) - - - -=head2 SetTold VALUE - - -Set Told to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Told will be stored as a datetime.) - - -=cut - - -=head2 Starts - -Returns the current value of Starts. -(In the database, Starts is stored as datetime.) - - - -=head2 SetStarts VALUE - - -Set Starts to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Starts will be stored as a datetime.) - - -=cut - - -=head2 Started - -Returns the current value of Started. -(In the database, Started is stored as datetime.) - - - -=head2 SetStarted VALUE - - -Set Started to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Started will be stored as a datetime.) - - -=cut - - -=head2 Due - -Returns the current value of Due. -(In the database, Due is stored as datetime.) - - - -=head2 SetDue VALUE - - -Set Due to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Due will be stored as a datetime.) - - -=cut - - -=head2 Resolved - -Returns the current value of Resolved. -(In the database, Resolved is stored as datetime.) - - - -=head2 SetResolved VALUE - - -Set Resolved to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Resolved will be stored as a datetime.) - - -=cut - - -=head2 LastUpdatedBy - -Returns the current value of LastUpdatedBy. -(In the database, LastUpdatedBy is stored as int(11).) - - -=cut - - -=head2 LastUpdated - -Returns the current value of LastUpdated. -(In the database, LastUpdated is stored as datetime.) - - -=cut - - -=head2 Creator - -Returns the current value of Creator. -(In the database, Creator is stored as int(11).) - - -=cut - - -=head2 Created - -Returns the current value of Created. -(In the database, Created is stored as datetime.) - - -=cut - - -=head2 Disabled - -Returns the current value of Disabled. -(In the database, Disabled is stored as smallint(6).) - - - -=head2 SetDisabled VALUE - - -Set Disabled to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, Disabled will be stored as a smallint(6).) - - -=cut - - - -sub _CoreAccessible { - { - - id => - {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, - EffectiveId => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Queue => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Type => - {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''}, - IssueStatement => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Resolution => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Owner => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Subject => - {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => '[no subject]'}, - InitialPriority => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - FinalPriority => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Priority => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - TimeEstimated => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - TimeWorked => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Status => - {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''}, - TimeLeft => - {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Told => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Starts => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Started => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Due => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Resolved => - {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - LastUpdatedBy => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - LastUpdated => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Creator => - {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, - Created => - {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, - Disabled => - {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'}, - - } -}; - -RT::Base->_ImportOverlays(); - -1; diff --git a/rt/lib/RT/Tickets.pm.orig b/rt/lib/RT/Tickets.pm.orig deleted file mode 100755 index cd5649dd9..000000000 --- a/rt/lib/RT/Tickets.pm.orig +++ /dev/null @@ -1,3892 +0,0 @@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC -# <sales@bestpractical.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., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# 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 }}} - -# Major Changes: - -# - Decimated ProcessRestrictions and broke it into multiple -# functions joined by a LUT -# - Semi-Generic SQL stuff moved to another file - -# Known Issues: FIXME! - -# - ClearRestrictions and Reinitialization is messy and unclear. The -# only good way to do it is to create a new RT::Tickets object. - -=head1 NAME - - RT::Tickets - A collection of Ticket objects - - -=head1 SYNOPSIS - - use RT::Tickets; - my $tickets = RT::Tickets->new($CurrentUser); - -=head1 DESCRIPTION - - A collection of RT::Tickets. - -=head1 METHODS - - -=cut - -package RT::Tickets; - -use strict; -use warnings; - - -use RT::Ticket; - -use base 'RT::SearchBuilder'; - -sub Table { 'Tickets'} - -use RT::CustomFields; -use DBIx::SearchBuilder::Unique; - -# Configuration Tables: - -# FIELD_METADATA is a mapping of searchable Field name, to Type, and other -# metadata. - -our %FIELD_METADATA = ( - Status => [ 'ENUM', ], #loc_left_pair - Queue => [ 'ENUM' => 'Queue', ], #loc_left_pair - Type => [ 'ENUM', ], #loc_left_pair - Creator => [ 'ENUM' => 'User', ], #loc_left_pair - LastUpdatedBy => [ 'ENUM' => 'User', ], #loc_left_pair - Owner => [ 'WATCHERFIELD' => 'Owner', ], #loc_left_pair - EffectiveId => [ 'INT', ], #loc_left_pair - id => [ 'ID', ], #loc_left_pair - InitialPriority => [ 'INT', ], #loc_left_pair - FinalPriority => [ 'INT', ], #loc_left_pair - Priority => [ 'INT', ], #loc_left_pair - TimeLeft => [ 'INT', ], #loc_left_pair - TimeWorked => [ 'INT', ], #loc_left_pair - TimeEstimated => [ 'INT', ], #loc_left_pair - - Linked => [ 'LINK' ], #loc_left_pair - LinkedTo => [ 'LINK' => 'To' ], #loc_left_pair - LinkedFrom => [ 'LINK' => 'From' ], #loc_left_pair - MemberOf => [ 'LINK' => To => 'MemberOf', ], #loc_left_pair - DependsOn => [ 'LINK' => To => 'DependsOn', ], #loc_left_pair - RefersTo => [ 'LINK' => To => 'RefersTo', ], #loc_left_pair - HasMember => [ 'LINK' => From => 'MemberOf', ], #loc_left_pair - DependentOn => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair - DependedOnBy => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair - ReferredToBy => [ 'LINK' => From => 'RefersTo', ], #loc_left_pair - Told => [ 'DATE' => 'Told', ], #loc_left_pair - Starts => [ 'DATE' => 'Starts', ], #loc_left_pair - Started => [ 'DATE' => 'Started', ], #loc_left_pair - Due => [ 'DATE' => 'Due', ], #loc_left_pair - Resolved => [ 'DATE' => 'Resolved', ], #loc_left_pair - LastUpdated => [ 'DATE' => 'LastUpdated', ], #loc_left_pair - Created => [ 'DATE' => 'Created', ], #loc_left_pair - Subject => [ 'STRING', ], #loc_left_pair - Content => [ 'TRANSCONTENT', ], #loc_left_pair - ContentType => [ 'TRANSFIELD', ], #loc_left_pair - Filename => [ 'TRANSFIELD', ], #loc_left_pair - TransactionDate => [ 'TRANSDATE', ], #loc_left_pair - Requestor => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair - Requestors => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair - Cc => [ 'WATCHERFIELD' => 'Cc', ], #loc_left_pair - AdminCc => [ 'WATCHERFIELD' => 'AdminCc', ], #loc_left_pair - Watcher => [ 'WATCHERFIELD', ], #loc_left_pair - QueueCc => [ 'WATCHERFIELD' => 'Cc' => 'Queue', ], #loc_left_pair - QueueAdminCc => [ 'WATCHERFIELD' => 'AdminCc' => 'Queue', ], #loc_left_pair - QueueWatcher => [ 'WATCHERFIELD' => undef => 'Queue', ], #loc_left_pair - CustomFieldValue => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair - CustomField => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair - CF => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair - Updated => [ 'TRANSDATE', ], #loc_left_pair - RequestorGroup => [ 'MEMBERSHIPFIELD' => 'Requestor', ], #loc_left_pair - CCGroup => [ 'MEMBERSHIPFIELD' => 'Cc', ], #loc_left_pair - AdminCCGroup => [ 'MEMBERSHIPFIELD' => 'AdminCc', ], #loc_left_pair - WatcherGroup => [ 'MEMBERSHIPFIELD', ], #loc_left_pair - HasAttribute => [ 'HASATTRIBUTE', 1 ], - HasNoAttribute => [ 'HASATTRIBUTE', 0 ], - #freeside - Customer => [ 'FREESIDEFIELD' => 'Customer' ], - Service => [ 'FREESIDEFIELD' => 'Service' ], - WillResolve => [ 'DATE' => 'WillResolve', ], #loc_left_pair -); - -# Lower Case version of FIELDS, for case insensitivity -our %LOWER_CASE_FIELDS = map { ( lc($_) => $_ ) } (keys %FIELD_METADATA); - -our %SEARCHABLE_SUBFIELDS = ( - User => [qw( - EmailAddress Name RealName Nickname Organization Address1 Address2 - WorkPhone HomePhone MobilePhone PagerPhone id - )], -); - -# Mapping of Field Type to Function -our %dispatch = ( - ENUM => \&_EnumLimit, - INT => \&_IntLimit, - ID => \&_IdLimit, - LINK => \&_LinkLimit, - DATE => \&_DateLimit, - STRING => \&_StringLimit, - TRANSFIELD => \&_TransLimit, - TRANSCONTENT => \&_TransContentLimit, - TRANSDATE => \&_TransDateLimit, - WATCHERFIELD => \&_WatcherLimit, - MEMBERSHIPFIELD => \&_WatcherMembershipLimit, - CUSTOMFIELD => \&_CustomFieldLimit, - HASATTRIBUTE => \&_HasAttributeLimit, - FREESIDEFIELD => \&_FreesideFieldLimit, -); -our %can_bundle = ();# WATCHERFIELD => "yes", ); - -# Default EntryAggregator per type -# if you specify OP, you must specify all valid OPs -my %DefaultEA = ( - INT => 'AND', - ENUM => { - '=' => 'OR', - '!=' => 'AND' - }, - DATE => { - '=' => 'OR', - '>=' => 'AND', - '<=' => 'AND', - '>' => 'AND', - '<' => 'AND' - }, - STRING => { - '=' => 'OR', - '!=' => 'AND', - 'LIKE' => 'AND', - 'NOT LIKE' => 'AND' - }, - TRANSFIELD => 'AND', - TRANSDATE => 'AND', - LINK => 'OR', - LINKFIELD => 'AND', - TARGET => 'AND', - BASE => 'AND', - WATCHERFIELD => { - '=' => 'OR', - '!=' => 'AND', - 'LIKE' => 'OR', - 'NOT LIKE' => 'AND' - }, - - HASATTRIBUTE => { - '=' => 'AND', - '!=' => 'AND', - }, - - CUSTOMFIELD => 'OR', -); - -# Helper functions for passing the above lexically scoped tables above -# into Tickets_SQL. -sub FIELDS { return \%FIELD_METADATA } -sub dispatch { return \%dispatch } -sub can_bundle { return \%can_bundle } - -# Bring in the clowns. -require RT::Tickets_SQL; - - -our @SORTFIELDS = qw(id Status - Queue Subject - Owner Created Due Starts Started - Told - Resolved LastUpdated Priority TimeWorked TimeLeft); - -=head2 SortFields - -Returns the list of fields that lists of tickets can easily be sorted by - -=cut - -sub SortFields { - my $self = shift; - return (@SORTFIELDS); -} - - -# BEGIN SQL STUFF ********************************* - - -sub CleanSlate { - my $self = shift; - $self->SUPER::CleanSlate( @_ ); - delete $self->{$_} foreach qw( - _sql_cf_alias - _sql_group_members_aliases - _sql_object_cfv_alias - _sql_role_group_aliases - _sql_trattachalias - _sql_u_watchers_alias_for_sort - _sql_u_watchers_aliases - _sql_current_user_can_see_applied - ); -} - -=head1 Limit Helper Routines - -These routines are the targets of a dispatch table depending on the -type of field. They all share the same signature: - - my ($self,$field,$op,$value,@rest) = @_; - -The values in @rest should be suitable for passing directly to -DBIx::SearchBuilder::Limit. - -Essentially they are an expanded/broken out (and much simplified) -version of what ProcessRestrictions used to do. They're also much -more clearly delineated by the TYPE of field being processed. - -=head2 _IdLimit - -Handle ID field. - -=cut - -sub _IdLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - if ( $value eq '__Bookmarked__' ) { - return $sb->_BookmarkLimit( $field, $op, $value, @rest ); - } else { - return $sb->_IntLimit( $field, $op, $value, @rest ); - } -} - -sub _BookmarkLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - die "Invalid operator $op for __Bookmarked__ search on $field" - unless $op =~ /^(=|!=)$/; - - my @bookmarks = do { - my $tmp = $sb->CurrentUser->UserObj->FirstAttribute('Bookmarks'); - $tmp = $tmp->Content if $tmp; - $tmp ||= {}; - grep $_, keys %$tmp; - }; - - return $sb->_SQLLimit( - FIELD => $field, - OPERATOR => $op, - VALUE => 0, - @rest, - ) unless @bookmarks; - - # as bookmarked tickets can be merged we have to use a join - # but it should be pretty lightweight - my $tickets_alias = $sb->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Tickets', - FIELD2 => 'EffectiveId', - ); - $sb->_OpenParen; - my $first = 1; - my $ea = $op eq '='? 'OR': 'AND'; - foreach my $id ( sort @bookmarks ) { - $sb->_SQLLimit( - ALIAS => $tickets_alias, - FIELD => 'id', - OPERATOR => $op, - VALUE => $id, - $first? (@rest): ( ENTRYAGGREGATOR => $ea ) - ); - $first = 0 if $first; - } - $sb->_CloseParen; -} - -=head2 _EnumLimit - -Handle Fields which are limited to certain values, and potentially -need to be looked up from another class. - -This subroutine actually handles two different kinds of fields. For -some the user is responsible for limiting the values. (i.e. Status, -Type). - -For others, the value specified by the user will be looked by via -specified class. - -Meta Data: - name of class to lookup in (Optional) - -=cut - -sub _EnumLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - # SQL::Statement changes != to <>. (Can we remove this now?) - $op = "!=" if $op eq "<>"; - - die "Invalid Operation: $op for $field" - unless $op eq "=" - or $op eq "!="; - - my $meta = $FIELD_METADATA{$field}; - if ( defined $meta->[1] && defined $value && $value !~ /^\d+$/ ) { - my $class = "RT::" . $meta->[1]; - my $o = $class->new( $sb->CurrentUser ); - $o->Load($value); - $value = $o->Id || 0; - } elsif ( $field eq "Type" ) { - $value = lc $value if $value =~ /^(ticket|approval|reminder)$/i; - } elsif ($field eq "Status") { - $value = lc $value; - } - $sb->_SQLLimit( - FIELD => $field, - VALUE => $value, - OPERATOR => $op, - @rest, - ); -} - -=head2 _IntLimit - -Handle fields where the values are limited to integers. (For example, -Priority, TimeWorked.) - -Meta Data: - None - -=cut - -sub _IntLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - die "Invalid Operator $op for $field" - unless $op =~ /^(=|!=|>|<|>=|<=)$/; - - $sb->_SQLLimit( - FIELD => $field, - VALUE => $value, - OPERATOR => $op, - @rest, - ); -} - -=head2 _LinkLimit - -Handle fields which deal with links between tickets. (MemberOf, DependsOn) - -Meta Data: - 1: Direction (From, To) - 2: Link Type (MemberOf, DependsOn, RefersTo) - -=cut - -sub _LinkLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - my $meta = $FIELD_METADATA{$field}; - die "Invalid Operator $op for $field" unless $op =~ /^(=|!=|IS|IS NOT)$/io; - - my $is_negative = 0; - if ( $op eq '!=' || $op =~ /\bNOT\b/i ) { - $is_negative = 1; - } - my $is_null = 0; - $is_null = 1 if !$value || $value =~ /^null$/io; - - my $direction = $meta->[1] || ''; - my ($matchfield, $linkfield) = ('', ''); - if ( $direction eq 'To' ) { - ($matchfield, $linkfield) = ("Target", "Base"); - } - elsif ( $direction eq 'From' ) { - ($matchfield, $linkfield) = ("Base", "Target"); - } - elsif ( $direction ) { - die "Invalid link direction '$direction' for $field\n"; - } else { - $sb->_OpenParen; - $sb->_LinkLimit( 'LinkedTo', $op, $value, @rest ); - $sb->_LinkLimit( - 'LinkedFrom', $op, $value, @rest, - ENTRYAGGREGATOR => (($is_negative && $is_null) || (!$is_null && !$is_negative))? 'OR': 'AND', - ); - $sb->_CloseParen; - return; - } - - my $is_local = 1; - if ( $is_null ) { - $op = ($op =~ /^(=|IS)$/i)? 'IS': 'IS NOT'; - } - elsif ( $value =~ /\D/ ) { - $value = RT::URI->new( $sb->CurrentUser )->CanonicalizeURI( $value ); - $is_local = 0; - } - $matchfield = "Local$matchfield" if $is_local; - -#For doing a left join to find "unlinked tickets" we want to generate a query that looks like this -# SELECT main.* FROM Tickets main -# LEFT JOIN Links Links_1 ON ( (Links_1.Type = 'MemberOf') -# AND(main.id = Links_1.LocalTarget)) -# WHERE Links_1.LocalBase IS NULL; - - if ( $is_null ) { - my $linkalias = $sb->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Links', - FIELD2 => 'Local' . $linkfield - ); - $sb->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => $meta->[2], - ) if $meta->[2]; - $sb->_SQLLimit( - @rest, - ALIAS => $linkalias, - FIELD => $matchfield, - OPERATOR => $op, - VALUE => 'NULL', - QUOTEVALUE => 0, - ); - } - else { - my $linkalias = $sb->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Links', - FIELD2 => 'Local' . $linkfield - ); - $sb->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => $meta->[2], - ) if $meta->[2]; - $sb->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => $matchfield, - OPERATOR => '=', - VALUE => $value, - ); - $sb->_SQLLimit( - @rest, - ALIAS => $linkalias, - FIELD => $matchfield, - OPERATOR => $is_negative? 'IS': 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ); - } -} - -=head2 _DateLimit - -Handle date fields. (Created, LastTold..) - -Meta Data: - 1: type of link. (Probably not necessary.) - -=cut - -sub _DateLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - die "Invalid Date Op: $op" - unless $op =~ /^(=|>|<|>=|<=)$/; - - my $meta = $FIELD_METADATA{$field}; - die "Incorrect Meta Data for $field" - unless ( defined $meta->[1] ); - - $sb->_DateFieldLimit( $meta->[1], $op, $value, @rest ); -} - -# Factor this out for use by custom fields - -sub _DateFieldLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - my $date = RT::Date->new( $sb->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - - if ( $op eq "=" ) { - - # if we're specifying =, that means we want everything on a - # particular single day. in the database, we need to check for > - # and < the edges of that day. - # - # Except if the value is 'this month' or 'last month', check - # > and < the edges of the month. - - my ($daystart, $dayend); - if ( lc($value) eq 'this month' ) { - $date->SetToNow; - $date->SetToStart('month', Timezone => 'server'); - $daystart = $date->ISO; - $date->AddMonth(Timezone => 'server'); - $dayend = $date->ISO; - } - elsif ( lc($value) eq 'last month' ) { - $date->SetToNow; - $date->SetToStart('month', Timezone => 'server'); - $dayend = $date->ISO; - $date->AddDays(-1); - $date->SetToStart('month', Timezone => 'server'); - $daystart = $date->ISO; - } - else { - $date->SetToMidnight( Timezone => 'server' ); - $daystart = $date->ISO; - $date->AddDay; - $dayend = $date->ISO; - } - - $sb->_OpenParen; - - $sb->_SQLLimit( - FIELD => $field, - OPERATOR => ">=", - VALUE => $daystart, - @rest, - ); - - $sb->_SQLLimit( - FIELD => $field, - OPERATOR => "<", - VALUE => $dayend, - @rest, - ENTRYAGGREGATOR => 'AND', - ); - - $sb->_CloseParen; - - } - else { - $sb->_SQLLimit( - FIELD => $field, - OPERATOR => $op, - VALUE => $date->ISO, - @rest, - ); - } -} - -=head2 _StringLimit - -Handle simple fields which are just strings. (Subject,Type) - -Meta Data: - None - -=cut - -sub _StringLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - # FIXME: - # Valid Operators: - # =, !=, LIKE, NOT LIKE - if ( RT->Config->Get('DatabaseType') eq 'Oracle' - && (!defined $value || !length $value) - && lc($op) ne 'is' && lc($op) ne 'is not' - ) { - if ($op eq '!=' || $op =~ /^NOT\s/i) { - $op = 'IS NOT'; - } else { - $op = 'IS'; - } - $value = 'NULL'; - } - - $sb->_SQLLimit( - FIELD => $field, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - @rest, - ); -} - -=head2 _TransDateLimit - -Handle fields limiting based on Transaction Date. - -The inpupt value must be in a format parseable by Time::ParseDate - -Meta Data: - None - -=cut - -# This routine should really be factored into translimit. -sub _TransDateLimit { - my ( $sb, $field, $op, $value, @rest ) = @_; - - # See the comments for TransLimit, they apply here too - - my $txn_alias = $sb->JoinTransactions; - - my $date = RT::Date->new( $sb->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - - $sb->_OpenParen; - if ( $op eq "=" ) { - - # if we're specifying =, that means we want everything on a - # particular single day. in the database, we need to check for > - # and < the edges of that day. - - $date->SetToMidnight( Timezone => 'server' ); - my $daystart = $date->ISO; - $date->AddDay; - my $dayend = $date->ISO; - - $sb->_SQLLimit( - ALIAS => $txn_alias, - FIELD => 'Created', - OPERATOR => ">=", - VALUE => $daystart, - @rest - ); - $sb->_SQLLimit( - ALIAS => $txn_alias, - FIELD => 'Created', - OPERATOR => "<=", - VALUE => $dayend, - @rest, - ENTRYAGGREGATOR => 'AND', - ); - - } - - # not searching for a single day - else { - - #Search for the right field - $sb->_SQLLimit( - ALIAS => $txn_alias, - FIELD => 'Created', - OPERATOR => $op, - VALUE => $date->ISO, - @rest - ); - } - - $sb->_CloseParen; -} - -=head2 _TransLimit - -Limit based on the ContentType or the Filename of a transaction. - -=cut - -sub _TransLimit { - my ( $self, $field, $op, $value, %rest ) = @_; - - my $txn_alias = $self->JoinTransactions; - unless ( defined $self->{_sql_trattachalias} ) { - $self->{_sql_trattachalias} = $self->_SQLJoin( - TYPE => 'LEFT', # not all txns have an attachment - ALIAS1 => $txn_alias, - FIELD1 => 'id', - TABLE2 => 'Attachments', - FIELD2 => 'TransactionId', - ); - } - - $self->_SQLLimit( - %rest, - ALIAS => $self->{_sql_trattachalias}, - FIELD => $field, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); -} - -=head2 _TransContentLimit - -Limit based on the Content of a transaction. - -=cut - -sub _TransContentLimit { - - # Content search - - # If only this was this simple. We've got to do something - # complicated here: - - #Basically, we want to make sure that the limits apply to - #the same attachment, rather than just another attachment - #for the same ticket, no matter how many clauses we lump - #on. We put them in TicketAliases so that they get nuked - #when we redo the join. - - # In the SQL, we might have - # (( Content = foo ) or ( Content = bar AND Content = baz )) - # The AND group should share the same Alias. - - # Actually, maybe it doesn't matter. We use the same alias and it - # works itself out? (er.. different.) - - # Steal more from _ProcessRestrictions - - # FIXME: Maybe look at the previous FooLimit call, and if it was a - # TransLimit and EntryAggregator == AND, reuse the Aliases? - - # Or better - store the aliases on a per subclause basis - since - # those are going to be the things we want to relate to each other, - # anyway. - - # maybe we should not allow certain kinds of aggregation of these - # clauses and do a psuedo regex instead? - the problem is getting - # them all into the same subclause when you have (A op B op C) - the - # way they get parsed in the tree they're in different subclauses. - - my ( $self, $field, $op, $value, %rest ) = @_; - $field = 'Content' if $field =~ /\W/; - - my $config = RT->Config->Get('FullTextSearch') || {}; - unless ( $config->{'Enable'} ) { - $self->_SQLLimit( %rest, FIELD => 'id', VALUE => 0 ); - return; - } - - my $txn_alias = $self->JoinTransactions; - unless ( defined $self->{_sql_trattachalias} ) { - $self->{_sql_trattachalias} = $self->_SQLJoin( - TYPE => 'LEFT', # not all txns have an attachment - ALIAS1 => $txn_alias, - FIELD1 => 'id', - TABLE2 => 'Attachments', - FIELD2 => 'TransactionId', - ); - } - - $self->_OpenParen; - if ( $config->{'Indexed'} ) { - my $db_type = RT->Config->Get('DatabaseType'); - - my $alias; - if ( $config->{'Table'} and $config->{'Table'} ne "Attachments") { - $alias = $self->{'_sql_aliases'}{'full_text'} ||= $self->_SQLJoin( - TYPE => 'LEFT', - ALIAS1 => $self->{'_sql_trattachalias'}, - FIELD1 => 'id', - TABLE2 => $config->{'Table'}, - FIELD2 => 'id', - ); - } else { - $alias = $self->{'_sql_trattachalias'}; - } - - #XXX: handle negative searches - my $index = $config->{'Column'}; - if ( $db_type eq 'Oracle' ) { - my $dbh = $RT::Handle->dbh; - my $alias = $self->{_sql_trattachalias}; - $self->_SQLLimit( - %rest, - FUNCTION => "CONTAINS( $alias.$field, ".$dbh->quote($value) .")", - OPERATOR => '>', - VALUE => 0, - QUOTEVALUE => 0, - CASESENSITIVE => 1, - ); - # this is required to trick DBIx::SB's LEFT JOINS optimizer - # into deciding that join is redundant as it is - $self->_SQLLimit( - ENTRYAGGREGATOR => 'AND', - ALIAS => $self->{_sql_trattachalias}, - FIELD => 'Content', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - ); - } - elsif ( $db_type eq 'Pg' ) { - my $dbh = $RT::Handle->dbh; - $self->_SQLLimit( - %rest, - ALIAS => $alias, - FIELD => $index, - OPERATOR => '@@', - VALUE => 'plainto_tsquery('. $dbh->quote($value) .')', - QUOTEVALUE => 0, - ); - } - elsif ( $db_type eq 'mysql' ) { - # XXX: We could theoretically skip the join to Attachments, - # and have Sphinx simply index and group by the TicketId, - # and join Ticket.id to that attribute, which would be much - # more efficient -- however, this is only a possibility if - # there are no other transaction limits. - - # This is a special character. Note that \ does not escape - # itself (in Sphinx 2.1.0, at least), so 'foo\;bar' becoming - # 'foo\\;bar' is not a vulnerability, and is still parsed as - # "foo, \, ;, then bar". Happily, the default mode is - # "all", meaning that boolean operators are not special. - $value =~ s/;/\\;/g; - - my $max = $config->{'MaxMatches'}; - $self->_SQLLimit( - %rest, - ALIAS => $alias, - FIELD => 'query', - OPERATOR => '=', - VALUE => "$value;limit=$max;maxmatches=$max", - ); - } - } else { - $self->_SQLLimit( - %rest, - ALIAS => $self->{_sql_trattachalias}, - FIELD => $field, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); - } - if ( RT->Config->Get('DontSearchFileAttachments') ) { - $self->_SQLLimit( - ENTRYAGGREGATOR => 'AND', - ALIAS => $self->{_sql_trattachalias}, - FIELD => 'Filename', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - } - $self->_CloseParen; -} - -=head2 _WatcherLimit - -Handle watcher limits. (Requestor, CC, etc..) - -Meta Data: - 1: Field to query on - - - -=cut - -sub _WatcherLimit { - my $self = shift; - my $field = shift; - my $op = shift; - my $value = shift; - my %rest = (@_); - - my $meta = $FIELD_METADATA{ $field }; - my $type = $meta->[1] || ''; - my $class = $meta->[2] || 'Ticket'; - - # Bail if the subfield is not allowed - if ( $rest{SUBKEY} - and not grep { $_ eq $rest{SUBKEY} } @{$SEARCHABLE_SUBFIELDS{'User'}}) - { - die "Invalid watcher subfield: '$rest{SUBKEY}'"; - } - - # if it's equality op and search by Email or Name then we can preload user - # we do it to help some DBs better estimate number of rows and get better plans - if ( $op =~ /^!?=$/ && (!$rest{'SUBKEY'} || $rest{'SUBKEY'} eq 'Name' || $rest{'SUBKEY'} eq 'EmailAddress') ) { - my $o = RT::User->new( $self->CurrentUser ); - my $method = - !$rest{'SUBKEY'} - ? $field eq 'Owner'? 'Load' : 'LoadByEmail' - : $rest{'SUBKEY'} eq 'EmailAddress' ? 'LoadByEmail': 'Load'; - $o->$method( $value ); - $rest{'SUBKEY'} = 'id'; - $value = $o->id || 0; - } - - # Owner was ENUM field, so "Owner = 'xxx'" allowed user to - # search by id and Name at the same time, this is workaround - # to preserve backward compatibility - if ( $field eq 'Owner' ) { - if ( ($rest{'SUBKEY'}||'') eq 'id' ) { - $self->_SQLLimit( - FIELD => 'Owner', - OPERATOR => $op, - VALUE => $value, - %rest, - ); - return; - } - } - $rest{SUBKEY} ||= 'EmailAddress'; - - my ($groups, $group_members, $users); - if ( $rest{'BUNDLE'} ) { - ($groups, $group_members, $users) = @{ $rest{'BUNDLE'} }; - } else { - $groups = $self->_RoleGroupsJoin( Type => $type, Class => $class, New => !$type ); - } - - $self->_OpenParen; - if ( $op =~ /^IS(?: NOT)?$/i ) { - # is [not] empty case - - $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); - # to avoid joining the table Users into the query, we just join GM - # and make sure we don't match records where group is member of itself - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - $self->_SQLLimit( - ALIAS => $group_members, - FIELD => 'GroupId', - OPERATOR => $op, - VALUE => $value, - %rest, - ); - } - elsif ( $op =~ /^!=$|^NOT\s+/i ) { - # negative condition case - - # reverse op - $op =~ s/!|NOT\s+//i; - - # XXX: we have no way to build correct "Watcher.X != 'Y'" when condition - # "X = 'Y'" matches more then one user so we try to fetch two records and - # do the right thing when there is only one exist and semi-working solution - # otherwise. - my $users_obj = RT::Users->new( $self->CurrentUser ); - $users_obj->Limit( - FIELD => $rest{SUBKEY}, - OPERATOR => $op, - VALUE => $value, - ); - $users_obj->OrderBy; - $users_obj->RowsPerPage(2); - my @users = @{ $users_obj->ItemsArrayRef }; - - $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups ); - if ( @users <= 1 ) { - my $uid = 0; - $uid = $users[0]->id if @users; - $self->SUPER::Limit( - LEFTJOIN => $group_members, - ALIAS => $group_members, - FIELD => 'MemberId', - VALUE => $uid, - ); - $self->_SQLLimit( - %rest, - ALIAS => $group_members, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - } else { - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - $users ||= $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', - ); - $self->SUPER::Limit( - LEFTJOIN => $users, - ALIAS => $users, - FIELD => $rest{SUBKEY}, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); - $self->_SQLLimit( - %rest, - ALIAS => $users, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - ); - } - } else { - # positive condition case - - $group_members ||= $self->_GroupMembersJoin( - GroupsAlias => $groups, New => 1, Left => 0 - ); - $users ||= $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', - ); - $self->_SQLLimit( - %rest, - ALIAS => $users, - FIELD => $rest{'SUBKEY'}, - VALUE => $value, - OPERATOR => $op, - CASESENSITIVE => 0, - ); - } - $self->_CloseParen; - return ($groups, $group_members, $users); -} - -sub _RoleGroupsJoin { - my $self = shift; - my %args = (New => 0, Class => 'Ticket', Type => '', @_); - return $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } - if $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } - && !$args{'New'}; - - # we always have watcher groups for ticket, so we use INNER join - my $groups = $self->Join( - ALIAS1 => 'main', - FIELD1 => $args{'Class'} eq 'Queue'? 'Queue': 'id', - TABLE2 => 'Groups', - FIELD2 => 'Instance', - ENTRYAGGREGATOR => 'AND', - ); - $self->SUPER::Limit( - LEFTJOIN => $groups, - ALIAS => $groups, - FIELD => 'Domain', - VALUE => 'RT::'. $args{'Class'} .'-Role', - ); - $self->SUPER::Limit( - LEFTJOIN => $groups, - ALIAS => $groups, - FIELD => 'Type', - VALUE => $args{'Type'}, - ) if $args{'Type'}; - - $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } = $groups - unless $args{'New'}; - - return $groups; -} - -sub _GroupMembersJoin { - my $self = shift; - my %args = (New => 1, GroupsAlias => undef, Left => 1, @_); - - return $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } - if $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } - && !$args{'New'}; - - my $alias = $self->Join( - $args{'Left'} ? (TYPE => 'LEFT') : (), - ALIAS1 => $args{'GroupsAlias'}, - FIELD1 => 'id', - TABLE2 => 'CachedGroupMembers', - FIELD2 => 'GroupId', - ENTRYAGGREGATOR => 'AND', - ); - $self->SUPER::Limit( - $args{'Left'} ? (LEFTJOIN => $alias) : (), - ALIAS => $alias, - FIELD => 'Disabled', - VALUE => 0, - ); - - $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } = $alias - unless $args{'New'}; - - return $alias; -} - -=head2 _WatcherJoin - -Helper function which provides joins to a watchers table both for limits -and for ordering. - -=cut - -sub _WatcherJoin { - my $self = shift; - my $type = shift || ''; - - - my $groups = $self->_RoleGroupsJoin( Type => $type ); - my $group_members = $self->_GroupMembersJoin( GroupsAlias => $groups ); - # XXX: work around, we must hide groups that - # are members of the role group we search in, - # otherwise them result in wrong NULLs in Users - # table and break ordering. Now, we know that - # RT doesn't allow to add groups as members of the - # ticket roles, so we just hide entries in CGM table - # with MemberId == GroupId from results - $self->SUPER::Limit( - LEFTJOIN => $group_members, - FIELD => 'GroupId', - OPERATOR => '!=', - VALUE => "$group_members.MemberId", - QUOTEVALUE => 0, - ); - my $users = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $group_members, - FIELD1 => 'MemberId', - TABLE2 => 'Users', - FIELD2 => 'id', - ); - return ($groups, $group_members, $users); -} - -=head2 _WatcherMembershipLimit - -Handle watcher membership limits, i.e. whether the watcher belongs to a -specific group or not. - -Meta Data: - 1: Field to query on - -SELECT DISTINCT main.* -FROM - Tickets main, - Groups Groups_1, - CachedGroupMembers CachedGroupMembers_2, - Users Users_3 -WHERE ( - (main.EffectiveId = main.id) -) AND ( - (main.Status != 'deleted') -) AND ( - (main.Type = 'ticket') -) AND ( - ( - (Users_3.EmailAddress = '22') - AND - (Groups_1.Domain = 'RT::Ticket-Role') - AND - (Groups_1.Type = 'RequestorGroup') - ) -) AND - Groups_1.Instance = main.id -AND - Groups_1.id = CachedGroupMembers_2.GroupId -AND - CachedGroupMembers_2.MemberId = Users_3.id -ORDER BY main.id ASC -LIMIT 25 - -=cut - -sub _WatcherMembershipLimit { - my ( $self, $field, $op, $value, @rest ) = @_; - my %rest = @rest; - - $self->_OpenParen; - - my $groups = $self->NewAlias('Groups'); - my $groupmembers = $self->NewAlias('CachedGroupMembers'); - my $users = $self->NewAlias('Users'); - my $memberships = $self->NewAlias('CachedGroupMembers'); - - if ( ref $field ) { # gross hack - my @bundle = @$field; - $self->_OpenParen; - for my $chunk (@bundle) { - ( $field, $op, $value, @rest ) = @$chunk; - $self->_SQLLimit( - ALIAS => $memberships, - FIELD => 'GroupId', - VALUE => $value, - OPERATOR => $op, - @rest, - ); - } - $self->_CloseParen; - } - else { - $self->_SQLLimit( - ALIAS => $memberships, - FIELD => 'GroupId', - VALUE => $value, - OPERATOR => $op, - @rest, - ); - } - - # Tie to groups for tickets we care about - $self->_SQLLimit( - ALIAS => $groups, - FIELD => 'Domain', - VALUE => 'RT::Ticket-Role', - ENTRYAGGREGATOR => 'AND' - ); - - $self->Join( - ALIAS1 => $groups, - FIELD1 => 'Instance', - ALIAS2 => 'main', - FIELD2 => 'id' - ); - - # }}} - - # If we care about which sort of watcher - my $meta = $FIELD_METADATA{$field}; - my $type = ( defined $meta->[1] ? $meta->[1] : undef ); - - if ($type) { - $self->_SQLLimit( - ALIAS => $groups, - FIELD => 'Type', - VALUE => $type, - ENTRYAGGREGATOR => 'AND' - ); - } - - $self->Join( - ALIAS1 => $groups, - FIELD1 => 'id', - ALIAS2 => $groupmembers, - FIELD2 => 'GroupId' - ); - - $self->Join( - ALIAS1 => $groupmembers, - FIELD1 => 'MemberId', - ALIAS2 => $users, - FIELD2 => 'id' - ); - - $self->Limit( - ALIAS => $groupmembers, - FIELD => 'Disabled', - VALUE => 0, - ); - - $self->Join( - ALIAS1 => $memberships, - FIELD1 => 'MemberId', - ALIAS2 => $users, - FIELD2 => 'id' - ); - - $self->Limit( - ALIAS => $memberships, - FIELD => 'Disabled', - VALUE => 0, - ); - - - $self->_CloseParen; - -} - -=head2 _CustomFieldDecipher - -Try and turn a CF descriptor into (cfid, cfname) object pair. - -Takes an optional second parameter of the CF LookupType, defaults to Ticket CFs. - -=cut - -sub _CustomFieldDecipher { - my ($self, $string, $lookuptype) = @_; - $lookuptype ||= $self->_SingularClass->CustomFieldLookupType; - - my ($object, $field, $column) = ($string =~ /^(?:(.+?)\.)?\{(.+)\}(?:\.(Content|LargeContent))?$/); - $field ||= ($string =~ /^{(.*?)}$/)[0] || $string; - - my ($cf, $applied_to); - - if ( $object ) { - my $record_class = RT::CustomField->RecordClassFromLookupType($lookuptype); - $applied_to = $record_class->new( $self->CurrentUser ); - $applied_to->Load( $object ); - - if ( $applied_to->id ) { - RT->Logger->debug("Limiting to CFs identified by '$field' applied to $record_class #@{[$applied_to->id]} (loaded via '$object')"); - } - else { - RT->Logger->warning("$record_class '$object' doesn't exist, parsed from '$string'"); - $object = 0; - undef $applied_to; - } - } - - if ( $field =~ /\D/ ) { - $object ||= ''; - my $cfs = RT::CustomFields->new( $self->CurrentUser ); - $cfs->Limit( FIELD => 'Name', VALUE => $field, ($applied_to ? (CASESENSITIVE => 0) : ()) ); - $cfs->LimitToLookupType($lookuptype); - - if ($applied_to) { - $cfs->SetContextObject($applied_to); - $cfs->LimitToObjectId($applied_to->id); - } - - # if there is more then one field the current user can - # see with the same name then we shouldn't return cf object - # as we don't know which one to use - $cf = $cfs->First; - if ( $cf ) { - $cf = undef if $cfs->Next; - } - } - else { - $cf = RT::CustomField->new( $self->CurrentUser ); - $cf->Load( $field ); - $cf->SetContextObject($applied_to) - if $cf->id and $applied_to; - } - - return ($object, $field, $cf, $column); -} - -=head2 _CustomFieldJoin - -Factor out the Join of custom fields so we can use it for sorting too - -=cut - -our %JOIN_ALIAS_FOR_LOOKUP_TYPE = ( - RT::Ticket->CustomFieldLookupType => sub { "main" }, -); - -sub _CustomFieldJoin { - my ($self, $cfkey, $cfid, $field, $type) = @_; - $type ||= RT::Ticket->CustomFieldLookupType; - - # Perform one Join per CustomField - if ( $self->{_sql_object_cfv_alias}{$cfkey} || - $self->{_sql_cf_alias}{$cfkey} ) - { - return ( $self->{_sql_object_cfv_alias}{$cfkey}, - $self->{_sql_cf_alias}{$cfkey} ); - } - - my $ObjectAlias = $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type} - ? $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type}->($self) - : die "We don't know how to join on $type"; - - my ($ObjectCFs, $CFs); - if ( $cfid ) { - $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ObjectAlias, - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFieldValues', - FIELD2 => 'ObjectId', - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'CustomField', - VALUE => $cfid, - ENTRYAGGREGATOR => 'AND' - ); - } - else { - my $ocfalias = $self->Join( - TYPE => 'LEFT', - FIELD1 => 'Queue', - TABLE2 => 'ObjectCustomFields', - FIELD2 => 'ObjectId', - ); - - $self->SUPER::Limit( - LEFTJOIN => $ocfalias, - ENTRYAGGREGATOR => 'OR', - FIELD => 'ObjectId', - VALUE => '0', - ); - - $CFs = $self->{_sql_cf_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ocfalias, - FIELD1 => 'CustomField', - TABLE2 => 'CustomFields', - FIELD2 => 'id', - ); - $self->SUPER::Limit( - LEFTJOIN => $CFs, - ENTRYAGGREGATOR => 'AND', - FIELD => 'LookupType', - VALUE => $type, - ); - $self->SUPER::Limit( - LEFTJOIN => $CFs, - ENTRYAGGREGATOR => 'AND', - FIELD => 'Name', - VALUE => $field, - ); - - $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $CFs, - FIELD1 => 'id', - TABLE2 => 'ObjectCustomFieldValues', - FIELD2 => 'CustomField', - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'ObjectId', - VALUE => "$ObjectAlias.id", - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ); - } - - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'ObjectType', - VALUE => RT::CustomField->ObjectTypeFromLookupType($type), - ENTRYAGGREGATOR => 'AND' - ); - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - FIELD => 'Disabled', - OPERATOR => '=', - VALUE => '0', - ENTRYAGGREGATOR => 'AND' - ); - - return ($ObjectCFs, $CFs); -} - -=head2 _CustomFieldLimit - -Limit based on CustomFields - -Meta Data: - none - -=cut - -use Regexp::Common qw(RE_net_IPv4); -use Regexp::Common::net::CIDR; - - -sub _CustomFieldLimit { - my ( $self, $_field, $op, $value, %rest ) = @_; - - my $meta = $FIELD_METADATA{ $_field }; - my $class = $meta->[1] || 'Ticket'; - my $type = "RT::$class"->CustomFieldLookupType; - - my $field = $rest{'SUBKEY'} || die "No field specified"; - - # For our sanity, we can only limit on one queue at a time - - my ($object, $cfid, $cf, $column); - ($object, $field, $cf, $column) = $self->_CustomFieldDecipher( $field, $type ); - $cfid = $cf ? $cf->id : 0 ; - -# If we're trying to find custom fields that don't match something, we -# want tickets where the custom field has no value at all. Note that -# we explicitly don't include the "IS NULL" case, since we would -# otherwise end up with a redundant clause. - - my ($negative_op, $null_op, $inv_op, $range_op) - = $self->ClassifySQLOperation( $op ); - - my $fix_op = sub { - return @_ unless RT->Config->Get('DatabaseType') eq 'Oracle'; - - my %args = @_; - return %args unless $args{'FIELD'} eq 'LargeContent'; - - my $op = $args{'OPERATOR'}; - if ( $op eq '=' ) { - $args{'OPERATOR'} = 'MATCHES'; - } - elsif ( $op eq '!=' ) { - $args{'OPERATOR'} = 'NOT MATCHES'; - } - elsif ( $op =~ /^[<>]=?$/ ) { - $args{'FUNCTION'} = "TO_CHAR( $args{'ALIAS'}.LargeContent )"; - } - return %args; - }; - - if ( $cf && $cf->Type eq 'IPAddress' ) { - my $parsed = RT::ObjectCustomFieldValue->ParseIP($value); - if ($parsed) { - $value = $parsed; - } - else { - $RT::Logger->warn("$value is not a valid IPAddress"); - } - } - - if ( $cf && $cf->Type eq 'IPAddressRange' ) { - my ( $start_ip, $end_ip ) = - RT::ObjectCustomFieldValue->ParseIPRange($value); - if ( $start_ip && $end_ip ) { - if ( $op =~ /^([<>])=?$/ ) { - my $is_less = $1 eq '<' ? 1 : 0; - if ( $is_less ) { - $value = $start_ip; - } - else { - $value = $end_ip; - } - } - else { - $value = join '-', $start_ip, $end_ip; - } - } - else { - $RT::Logger->warn("$value is not a valid IPAddressRange"); - } - } - - if ( $cf && $cf->Type =~ /^Date(?:Time)?$/ ) { - my $date = RT::Date->new( $self->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - if ( $date->Unix ) { - - if ( - $cf->Type eq 'Date' - || $value =~ /^\s*(?:today|tomorrow|yesterday)\s*$/i - || ( $value !~ /midnight|\d+:\d+:\d+/i - && $date->Time( Timezone => 'user' ) eq '00:00:00' ) - ) - { - $value = $date->Date( Timezone => 'user' ); - } - else { - $value = $date->DateTime; - } - } - else { - $RT::Logger->warn("$value is not a valid date string"); - } - } - - my $single_value = !$cf || !$cfid || $cf->SingleValue; - - my $cfkey = $cfid ? $cfid : "$type-$object.$field"; - - if ( $null_op && !$column ) { - # IS[ NOT] NULL without column is the same as has[ no] any CF value, - # we can reuse our default joins for this operation - # with column specified we have different situation - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'id', - OPERATOR => $op, - VALUE => $value, - %rest - ); - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - $self->_CloseParen; - } - elsif ( $op !~ /^[<>]=?$/ && ( $cf && $cf->Type eq 'IPAddressRange')) { - - my ($start_ip, $end_ip) = split /-/, $value; - - $self->_OpenParen; - if ( $op !~ /NOT|!=|<>/i ) { # positive equation - $self->_CustomFieldLimit( - $_field, '<=', $end_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.Content', - ); - $self->_CustomFieldLimit( - $_field, '>=', $start_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.LargeContent', - ENTRYAGGREGATOR => 'AND', - ); - # as well limit borders so DB optimizers can use better - # estimations and scan less rows -# have to disable this tweak because of ipv6 -# $self->_CustomFieldLimit( -# $_field, '>=', '000.000.000.000', %rest, -# SUBKEY => $rest{'SUBKEY'}. '.Content', -# ENTRYAGGREGATOR => 'AND', -# ); -# $self->_CustomFieldLimit( -# $_field, '<=', '255.255.255.255', %rest, -# SUBKEY => $rest{'SUBKEY'}. '.LargeContent', -# ENTRYAGGREGATOR => 'AND', -# ); - } - else { # negative equation - $self->_CustomFieldLimit($_field, '>', $end_ip, %rest); - $self->_CustomFieldLimit( - $_field, '<', $start_ip, %rest, - SUBKEY => $rest{'SUBKEY'}. '.LargeContent', - ENTRYAGGREGATOR => 'OR', - ); - # TODO: as well limit borders so DB optimizers can use better - # estimations and scan less rows, but it's harder to do - # as we have OR aggregator - } - $self->_CloseParen; - } - elsif ( !$negative_op || $single_value ) { - $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++ if !$single_value && !$range_op; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - - $self->_OpenParen; - - $self->_OpenParen; - - $self->_OpenParen; - # if column is defined then deal only with it - # otherwise search in Content and in LargeContent - if ( $column ) { - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => $column, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ) ); - $self->_CloseParen; - $self->_CloseParen; - $self->_CloseParen; - } - else { - # need special treatment for Date - if ( $cf and $cf->Type eq 'DateTime' and $op eq '=' && $value !~ /:/ ) { - # no time specified, that means we want everything on a - # particular day. in the database, we need to check for > - # and < the edges of that day. - my $date = RT::Date->new( $self->CurrentUser ); - $date->Set( Format => 'unknown', Value => $value ); - my $daystart = $date->ISO; - $date->AddDay; - my $dayend = $date->ISO; - - $self->_OpenParen; - - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => ">=", - VALUE => $daystart, - %rest, - ); - - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => "<", - VALUE => $dayend, - %rest, - ENTRYAGGREGATOR => 'AND', - ); - - $self->_CloseParen; - } - elsif ( $op eq '=' || $op eq '!=' || $op eq '<>' ) { - if ( length( Encode::encode_utf8($value) ) < 256 ) { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ); - } - else { - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => '=', - VALUE => '', - ENTRYAGGREGATOR => 'OR' - ); - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - ENTRYAGGREGATOR => 'OR' - ); - $self->_CloseParen; - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => 'LargeContent', - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND', - CASESENSITIVE => 0, - ) ); - } - } - else { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - %rest - ); - - $self->_OpenParen; - $self->_OpenParen; - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => '=', - VALUE => '', - ENTRYAGGREGATOR => 'OR' - ); - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - ENTRYAGGREGATOR => 'OR' - ); - $self->_CloseParen; - $self->_SQLLimit( $fix_op->( - ALIAS => $ObjectCFs, - FIELD => 'LargeContent', - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND', - CASESENSITIVE => 0, - ) ); - $self->_CloseParen; - } - $self->_CloseParen; - - # XXX: if we join via CustomFields table then - # because of order of left joins we get NULLs in - # CF table and then get nulls for those records - # in OCFVs table what result in wrong results - # as decifer method now tries to load a CF then - # we fall into this situation only when there - # are more than one CF with the name in the DB. - # the same thing applies to order by call. - # TODO: reorder joins T <- OCFVs <- CFs <- OCFs if - # we want treat IS NULL as (not applies or has - # no value) - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - $self->_CloseParen; - - if ($negative_op) { - $self->_SQLLimit( - ALIAS => $ObjectCFs, - FIELD => $column || 'Content', - OPERATOR => 'IS', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => 'OR', - ); - } - - $self->_CloseParen; - } - } - else { - $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type ); - - # reverse operation - $op =~ s/!|NOT\s+//i; - - # if column is defined then deal only with it - # otherwise search in Content and in LargeContent - if ( $column ) { - $self->SUPER::Limit( $fix_op->( - LEFTJOIN => $ObjectCFs, - ALIAS => $ObjectCFs, - FIELD => $column, - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ) ); - } - else { - $self->SUPER::Limit( - LEFTJOIN => $ObjectCFs, - ALIAS => $ObjectCFs, - FIELD => 'Content', - OPERATOR => $op, - VALUE => $value, - CASESENSITIVE => 0, - ); - } - $self->_SQLLimit( - %rest, - ALIAS => $ObjectCFs, - FIELD => 'id', - OPERATOR => 'IS', - VALUE => 'NULL', - QUOTEVALUE => 0, - ); - } -} - -sub _HasAttributeLimit { - my ( $self, $field, $op, $value, %rest ) = @_; - - my $alias = $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Attributes', - FIELD2 => 'ObjectId', - ); - $self->SUPER::Limit( - LEFTJOIN => $alias, - FIELD => 'ObjectType', - VALUE => 'RT::Ticket', - ENTRYAGGREGATOR => 'AND' - ); - $self->SUPER::Limit( - LEFTJOIN => $alias, - FIELD => 'Name', - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND' - ); - $self->_SQLLimit( - %rest, - ALIAS => $alias, - FIELD => 'id', - OPERATOR => $FIELD_METADATA{$field}->[1]? 'IS NOT': 'IS', - VALUE => 'NULL', - QUOTEVALUE => 0, - ); -} - -# End Helper Functions - -# End of SQL Stuff ------------------------------------------------- - - -=head2 OrderByCols ARRAY - -A modified version of the OrderBy method which automatically joins where -C<ALIAS> is set to the name of a watcher type. - -=cut - -sub OrderByCols { - my $self = shift; - my @args = @_; - my $clause; - my @res = (); - my $order = 0; - - foreach my $row (@args) { - if ( $row->{ALIAS} ) { - push @res, $row; - next; - } - if ( $row->{FIELD} !~ /\./ ) { - my $meta = $self->FIELDS->{ $row->{FIELD} }; - unless ( $meta ) { - push @res, $row; - next; - } - - if ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'Queue' ) { - my $alias = $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => $row->{'FIELD'}, - TABLE2 => 'Queues', - FIELD2 => 'id', - ); - push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; - } elsif ( ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'User' ) - || ( $meta->[0] eq 'WATCHERFIELD' && ($meta->[1]||'') eq 'Owner' ) - ) { - my $alias = $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => $row->{'FIELD'}, - TABLE2 => 'Users', - FIELD2 => 'id', - ); - push @res, { %$row, ALIAS => $alias, FIELD => "Name" }; - } else { - push @res, $row; - } - next; - } - - my ( $field, $subkey ) = split /\./, $row->{FIELD}, 2; - my $meta = $self->FIELDS->{$field}; - if ( defined $meta->[0] && $meta->[0] eq 'WATCHERFIELD' ) { - # cache alias as we want to use one alias per watcher type for sorting - my $users = $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] }; - unless ( $users ) { - $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] } - = $users = ( $self->_WatcherJoin( $meta->[1] ) )[2]; - } - push @res, { %$row, ALIAS => $users, FIELD => $subkey }; - } elsif ( defined $meta->[0] && $meta->[0] eq 'CUSTOMFIELD' ) { - my ($object, $field, $cf_obj, $column) = $self->_CustomFieldDecipher( $subkey ); - my $cfkey = $cf_obj ? $cf_obj->id : "$object.$field"; - $cfkey .= ".ordering" if !$cf_obj || ($cf_obj->MaxValues||0) != 1; - my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, ($cf_obj ?$cf_obj->id :0) , $field ); - # this is described in _CustomFieldLimit - $self->_SQLLimit( - ALIAS => $CFs, - FIELD => 'Name', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 1, - ENTRYAGGREGATOR => 'AND', - ) if $CFs; - unless ($cf_obj) { - # For those cases where we are doing a join against the - # CF name, and don't have a CFid, use Unique to make sure - # we don't show duplicate tickets. NOTE: I'm pretty sure - # this will stay mixed in for the life of the - # class/package, and not just for the life of the object. - # Potential performance issue. - require DBIx::SearchBuilder::Unique; - DBIx::SearchBuilder::Unique->import; - } - my $CFvs = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $ObjectCFs, - FIELD1 => 'CustomField', - TABLE2 => 'CustomFieldValues', - FIELD2 => 'CustomField', - ); - $self->SUPER::Limit( - LEFTJOIN => $CFvs, - FIELD => 'Name', - QUOTEVALUE => 0, - VALUE => $ObjectCFs . ".Content", - ENTRYAGGREGATOR => 'AND' - ); - - push @res, { %$row, ALIAS => $CFvs, FIELD => 'SortOrder' }; - push @res, { %$row, ALIAS => $ObjectCFs, FIELD => 'Content' }; - } elsif ( $field eq "Custom" && $subkey eq "Ownership") { - # PAW logic is "reversed" - my $order = "ASC"; - if (exists $row->{ORDER} ) { - my $o = $row->{ORDER}; - delete $row->{ORDER}; - $order = "DESC" if $o =~ /asc/i; - } - - # Ticket.Owner 1 0 X - # Unowned Tickets 0 1 X - # Else 0 0 X - - foreach my $uid ( $self->CurrentUser->Id, RT->Nobody->Id ) { - if ( RT->Config->Get('DatabaseType') eq 'Oracle' ) { - my $f = ($row->{'ALIAS'} || 'main') .'.Owner'; - push @res, { - %$row, - FIELD => undef, - ALIAS => '', - FUNCTION => "CASE WHEN $f=$uid THEN 1 ELSE 0 END", - ORDER => $order - }; - } else { - push @res, { - %$row, - FIELD => undef, - FUNCTION => "Owner=$uid", - ORDER => $order - }; - } - } - - push @res, { %$row, FIELD => "Priority", ORDER => $order } ; - - } elsif ( $field eq 'Customer' ) { #Freeside - # OrderBy(FIELD => expression) doesn't work, it has to be - # an actual field, so we have to do the join even if sorting - # by custnum - my $custalias = $self->JoinToCustomer; - my $cust_field = lc($subkey); - if ( !$cust_field or $cust_field eq 'number' ) { - $cust_field = 'custnum'; - } - elsif ( $cust_field eq 'name' ) { - $cust_field = "COALESCE( $custalias.company, - $custalias.last || ', ' || $custalias.first - )"; - } - else { # order by cust_main fields directly: 'Customer.agentnum' - $cust_field = $subkey; - } - push @res, { %$row, ALIAS => $custalias, FIELD => $cust_field }; - - } elsif ( $field eq 'Service' ) { - - my $svcalias = $self->JoinToService; - my $svc_field = lc($subkey); - if ( !$svc_field or $svc_field eq 'number' ) { - $svc_field = 'svcnum'; - } - push @res, { %$row, ALIAS => $svcalias, FIELD => $svc_field }; - - } #Freeside - - else { - push @res, $row; - } - } - return $self->SUPER::OrderByCols(@res); -} - -#Freeside - -sub JoinToCustLinks { - # Set up join to links (id = localbase), - # limit link type to 'MemberOf', - # and target value to any Freeside custnum URI. - # Return the linkalias for further join/limit action, - # and an sql expression to retrieve the custnum. - my $self = shift; - # only join once for each RT::Tickets object - my $linkalias = $self->{cust_main_linkalias}; - if (!$linkalias) { - $linkalias = $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Links', - FIELD2 => 'LocalBase', - ); - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Base', - OPERATOR => 'LIKE', - VALUE => 'fsck.com-rt://%/ticket/%', - ); - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => 'MemberOf', - ); - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Target', - OPERATOR => 'STARTSWITH', - VALUE => 'freeside://freeside/cust_main/', - ); - $self->{cust_main_linkalias} = $linkalias; - } - my $custnum_sql = "CAST(SUBSTR($linkalias.Target,31) AS "; - if ( RT->Config->Get('DatabaseType') eq 'mysql' ) { - $custnum_sql .= 'SIGNED INTEGER)'; - } - else { - $custnum_sql .= 'INTEGER)'; - } - return ($linkalias, $custnum_sql); -} - -sub JoinToCustomer { - my $self = shift; - my ($linkalias, $custnum_sql) = $self->JoinToCustLinks; - # don't reuse this join, though--negative queries need - # independent joins - my $custalias = $self->Join( - TYPE => 'LEFT', - EXPRESSION => $custnum_sql, - TABLE2 => 'cust_main', - FIELD2 => 'custnum', - ); - return $custalias; -} - -sub JoinToSvcLinks { - my $self = shift; - my $linkalias = $self->{cust_svc_linkalias}; - if (!$linkalias) { - $linkalias = $self->Join( - TYPE => 'LEFT', - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Links', - FIELD2 => 'LocalBase', - ); - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Base', - OPERATOR => 'LIKE', - VALUE => 'fsck.com-rt://%/ticket/%', - ); - - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Type', - OPERATOR => '=', - VALUE => 'MemberOf', - ); - $self->SUPER::Limit( - LEFTJOIN => $linkalias, - FIELD => 'Target', - OPERATOR => 'STARTSWITH', - VALUE => 'freeside://freeside/cust_svc/', - ); - $self->{cust_svc_linkalias} = $linkalias; - } - my $svcnum_sql = "CAST(SUBSTR($linkalias.Target,30) AS "; - if ( RT->Config->Get('DatabaseType') eq 'mysql' ) { - $svcnum_sql .= 'SIGNED INTEGER)'; - } - else { - $svcnum_sql .= 'INTEGER)'; - } - return ($linkalias, $svcnum_sql); -} - -sub JoinToService { - my $self = shift; - my ($linkalias, $svcnum_sql) = $self->JoinToSvcLinks; - $self->Join( - TYPE => 'LEFT', - EXPRESSION => $svcnum_sql, - TABLE2 => 'cust_svc', - FIELD2 => 'svcnum', - ); -} - -# This creates an alternate left join path to cust_main via cust_svc. -# _FreesideFieldLimit needs to add this as a separate, independent join -# and include all tickets that have a matching cust_main record via -# either path. -sub JoinToCustomerViaService { - my $self = shift; - my $svcalias = $self->JoinToService; - my $cust_pkg = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $svcalias, - FIELD1 => 'pkgnum', - TABLE2 => 'cust_pkg', - FIELD2 => 'pkgnum', - ); - my $cust_main = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $cust_pkg, - FIELD1 => 'custnum', - TABLE2 => 'cust_main', - FIELD2 => 'custnum', - ); - $cust_main; -} - -sub _FreesideFieldLimit { - my ( $self, $field, $op, $value, %rest ) = @_; - my $is_negative = 0; - if ( $op eq '!=' || $op =~ /\bNOT\b/i ) { - # if the op is negative, do the join as though - # the op were positive, then accept only records - # where the right-side join key is null. - $is_negative = 1; - $op = '=' if $op eq '!='; - $op =~ s/\bNOT\b//; - } - - my (@alias, $table2, $subfield, $pkey); - if ( $field eq 'Customer' ) { - push @alias, $self->JoinToCustomer; - push @alias, $self->JoinToCustomerViaService; - $pkey = 'custnum'; - } - elsif ( $field eq 'Service' ) { - push @alias, $self->JoinToService; - $pkey = 'svcnum'; - } - else { - die "malformed Freeside query: $field"; - } - - $subfield = $rest{SUBKEY} || $pkey; - # compound subkey: separate into table name and field in that table - # (must be linked by custnum) - $subfield = lc($subfield); - ($table2, $subfield) = ($1, $2) if $subfield =~ /^(\w+)?\.(\w+)$/; - $subfield = $pkey if $subfield eq 'number'; - - # if it's compound, create a join from cust_main or cust_svc to that - # table, using custnum or svcnum, and Limit on that table instead. - my @_SQLLimit = (); - foreach my $a (@alias) { - if ( $table2 ) { - $a = $self->Join( - TYPE => 'LEFT', - ALIAS1 => $a, - FIELD1 => $pkey, - TABLE2 => $table2, - FIELD2 => $pkey, - ); - } - - # do the actual Limit - $self->SUPER::Limit( - LEFTJOIN => $a, - FIELD => $subfield, - OPERATOR => $op, - VALUE => $value, - ENTRYAGGREGATOR => 'AND', - # no SUBCLAUSE needed, limits on different aliases across left joins - # are inherently independent - ); - - # then, since it's a left join, exclude tickets for which there is now - # no matching record in the table we just limited on. (Or where there - # is a matching record, if $is_negative.) - # For a cust_main query (where there are two different aliases), this - # will produce a subclause: "cust_main_1.custnum IS NOT NULL OR - # cust_main_2.custnum IS NOT NULL" (or "IS NULL AND..." for a negative - # query). - #$self->_SQLLimit( - push @_SQLLimit, { - %rest, - ALIAS => $a, - FIELD => $pkey, - OPERATOR => $is_negative ? 'IS' : 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => $is_negative ? 'AND' : 'OR', - SUBCLAUSE => 'fs_limit', - }; - } - - $self->_OpenParen; - foreach my $_SQLLimit (@_SQLLimit) { - $self->_SQLLimit( %$_SQLLimit); - } - $self->_CloseParen; - -} - -#Freeside - -=head2 Limit - -Takes a paramhash with the fields FIELD, OPERATOR, VALUE and DESCRIPTION -Generally best called from LimitFoo methods - -=cut - -sub Limit { - my $self = shift; - my %args = ( - FIELD => undef, - OPERATOR => '=', - VALUE => undef, - DESCRIPTION => undef, - @_ - ); - $args{'DESCRIPTION'} = $self->loc( - "[_1] [_2] [_3]", $args{'FIELD'}, - $args{'OPERATOR'}, $args{'VALUE'} - ) - if ( !defined $args{'DESCRIPTION'} ); - - my $index = $self->_NextIndex; - -# make the TicketRestrictions hash the equivalent of whatever we just passed in; - - %{ $self->{'TicketRestrictions'}{$index} } = %args; - - $self->{'RecalcTicketLimits'} = 1; - -# If we're looking at the effective id, we don't want to append the other clause -# which limits us to tickets where id = effective id - if ( $args{'FIELD'} eq 'EffectiveId' - && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) - { - $self->{'looking_at_effective_id'} = 1; - } - - if ( $args{'FIELD'} eq 'Type' - && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) - { - $self->{'looking_at_type'} = 1; - } - - return ($index); -} - - - - -=head2 LimitQueue - -LimitQueue takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of = or !=. (It defaults to =). -VALUE is a queue id or Name. - - -=cut - -sub LimitQueue { - my $self = shift; - my %args = ( - VALUE => undef, - OPERATOR => '=', - @_ - ); - - #TODO VALUE should also take queue objects - if ( defined $args{'VALUE'} && $args{'VALUE'} !~ /^\d+$/ ) { - my $queue = RT::Queue->new( $self->CurrentUser ); - $queue->Load( $args{'VALUE'} ); - $args{'VALUE'} = $queue->Id; - } - - # What if they pass in an Id? Check for isNum() and convert to - # string. - - #TODO check for a valid queue here - - $self->Limit( - FIELD => 'Queue', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( - ' ', $self->loc('Queue'), $args{'OPERATOR'}, $args{'VALUE'}, - ), - ); - -} - - - -=head2 LimitStatus - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of = or !=. -VALUE is a status. - -RT adds Status != 'deleted' until object has -allow_deleted_search internal property set. -$tickets->{'allow_deleted_search'} = 1; -$tickets->LimitStatus( VALUE => 'deleted' ); - -=cut - -sub LimitStatus { - my $self = shift; - my %args = ( - OPERATOR => '=', - @_ - ); - $self->Limit( - FIELD => 'Status', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Status'), $args{'OPERATOR'}, - $self->loc( $args{'VALUE'} ) ), - ); -} - - - -=head2 IgnoreType - -If called, this search will not automatically limit the set of results found -to tickets of type "Ticket". Tickets of other types, such as "project" and -"approval" will be found. - -=cut - -sub IgnoreType { - my $self = shift; - - # Instead of faking a Limit that later gets ignored, fake up the - # fact that we're already looking at type, so that the check in - # Tickets_SQL/FromSQL goes down the right branch - - # $self->LimitType(VALUE => '__any'); - $self->{looking_at_type} = 1; -} - - - -=head2 LimitType - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of = or !=, it defaults to "=". -VALUE is a string to search for in the type of the ticket. - - - -=cut - -sub LimitType { - my $self = shift; - my %args = ( - OPERATOR => '=', - VALUE => undef, - @_ - ); - $self->Limit( - FIELD => 'Type', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Type'), $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - - - -=head2 LimitSubject - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of = or !=. -VALUE is a string to search for in the subject of the ticket. - -=cut - -sub LimitSubject { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'Subject', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Subject'), $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - -# Things that can be > < = != - - -=head2 LimitId - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a ticket Id to search for - -=cut - -sub LimitId { - my $self = shift; - my %args = ( - OPERATOR => '=', - @_ - ); - - $self->Limit( - FIELD => 'id', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => - join( ' ', $self->loc('Id'), $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - -=head2 LimitPriority - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a value to match the ticket's priority against - -=cut - -sub LimitPriority { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'Priority', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Priority'), - $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - -=head2 LimitInitialPriority - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a value to match the ticket's initial priority against - - -=cut - -sub LimitInitialPriority { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'InitialPriority', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Initial Priority'), $args{'OPERATOR'}, - $args{'VALUE'}, ), - ); -} - - - -=head2 LimitFinalPriority - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a value to match the ticket's final priority against - -=cut - -sub LimitFinalPriority { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'FinalPriority', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Final Priority'), $args{'OPERATOR'}, - $args{'VALUE'}, ), - ); -} - - - -=head2 LimitTimeWorked - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a value to match the ticket's TimeWorked attribute - -=cut - -sub LimitTimeWorked { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'TimeWorked', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Time Worked'), - $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - -=head2 LimitTimeLeft - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, >, < or !=. -VALUE is a value to match the ticket's TimeLeft attribute - -=cut - -sub LimitTimeLeft { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'TimeLeft', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Time Left'), - $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - - - -=head2 LimitContent - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, LIKE, NOT LIKE or !=. -VALUE is a string to search for in the body of the ticket - -=cut - -sub LimitContent { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'Content', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Ticket content'), $args{'OPERATOR'}, - $args{'VALUE'}, ), - ); -} - - - -=head2 LimitFilename - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, LIKE, NOT LIKE or !=. -VALUE is a string to search for in the body of the ticket - -=cut - -sub LimitFilename { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'Filename', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Attachment filename'), $args{'OPERATOR'}, - $args{'VALUE'}, ), - ); -} - - -=head2 LimitContentType - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of =, LIKE, NOT LIKE or !=. -VALUE is a content type to search ticket attachments for - -=cut - -sub LimitContentType { - my $self = shift; - my %args = (@_); - $self->Limit( - FIELD => 'ContentType', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Ticket content type'), $args{'OPERATOR'}, - $args{'VALUE'}, ), - ); -} - - - - - -=head2 LimitOwner - -Takes a paramhash with the fields OPERATOR and VALUE. -OPERATOR is one of = or !=. -VALUE is a user id. - -=cut - -sub LimitOwner { - my $self = shift; - my %args = ( - OPERATOR => '=', - @_ - ); - - my $owner = RT::User->new( $self->CurrentUser ); - $owner->Load( $args{'VALUE'} ); - - # FIXME: check for a valid $owner - $self->Limit( - FIELD => 'Owner', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - DESCRIPTION => join( ' ', - $self->loc('Owner'), $args{'OPERATOR'}, $owner->Name(), ), - ); - -} - - - - -=head2 LimitWatcher - - Takes a paramhash with the fields OPERATOR, TYPE and VALUE. - OPERATOR is one of =, LIKE, NOT LIKE or !=. - VALUE is a value to match the ticket's watcher email addresses against - TYPE is the sort of watchers you want to match against. Leave it undef if you want to search all of them - - -=cut - -sub LimitWatcher { - my $self = shift; - my %args = ( - OPERATOR => '=', - VALUE => undef, - TYPE => undef, - @_ - ); - - #build us up a description - my ( $watcher_type, $desc ); - if ( $args{'TYPE'} ) { - $watcher_type = $args{'TYPE'}; - } - else { - $watcher_type = "Watcher"; - } - - $self->Limit( - FIELD => $watcher_type, - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - TYPE => $args{'TYPE'}, - DESCRIPTION => join( ' ', - $self->loc($watcher_type), - $args{'OPERATOR'}, $args{'VALUE'}, ), - ); -} - - - - - - -=head2 LimitLinkedTo - -LimitLinkedTo takes a paramhash with two fields: TYPE and TARGET -TYPE limits the sort of link we want to search on - -TYPE = { RefersTo, MemberOf, DependsOn } - -TARGET is the id or URI of the TARGET of the link - -=cut - -sub LimitLinkedTo { - my $self = shift; - my %args = ( - TARGET => undef, - TYPE => undef, - OPERATOR => '=', - @_ - ); - - $self->Limit( - FIELD => 'LinkedTo', - BASE => undef, - TARGET => $args{'TARGET'}, - TYPE => $args{'TYPE'}, - DESCRIPTION => $self->loc( - "Tickets [_1] by [_2]", - $self->loc( $args{'TYPE'} ), - $args{'TARGET'} - ), - OPERATOR => $args{'OPERATOR'}, - ); -} - - - -=head2 LimitLinkedFrom - -LimitLinkedFrom takes a paramhash with two fields: TYPE and BASE -TYPE limits the sort of link we want to search on - - -BASE is the id or URI of the BASE of the link - -=cut - -sub LimitLinkedFrom { - my $self = shift; - my %args = ( - BASE => undef, - TYPE => undef, - OPERATOR => '=', - @_ - ); - - # translate RT2 From/To naming to RT3 TicketSQL naming - my %fromToMap = qw(DependsOn DependentOn - MemberOf HasMember - RefersTo ReferredToBy); - - my $type = $args{'TYPE'}; - $type = $fromToMap{$type} if exists( $fromToMap{$type} ); - - $self->Limit( - FIELD => 'LinkedTo', - TARGET => undef, - BASE => $args{'BASE'}, - TYPE => $type, - DESCRIPTION => $self->loc( - "Tickets [_1] [_2]", - $self->loc( $args{'TYPE'} ), - $args{'BASE'}, - ), - OPERATOR => $args{'OPERATOR'}, - ); -} - - -sub LimitMemberOf { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedTo( - @_, - TARGET => $ticket_id, - TYPE => 'MemberOf', - ); -} - - -sub LimitHasMember { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedFrom( - @_, - BASE => "$ticket_id", - TYPE => 'HasMember', - ); - -} - - - -sub LimitDependsOn { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedTo( - @_, - TARGET => $ticket_id, - TYPE => 'DependsOn', - ); - -} - - - -sub LimitDependedOnBy { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedFrom( - @_, - BASE => $ticket_id, - TYPE => 'DependentOn', - ); - -} - - - -sub LimitRefersTo { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedTo( - @_, - TARGET => $ticket_id, - TYPE => 'RefersTo', - ); - -} - - - -sub LimitReferredToBy { - my $self = shift; - my $ticket_id = shift; - return $self->LimitLinkedFrom( - @_, - BASE => $ticket_id, - TYPE => 'ReferredToBy', - ); -} - - - - - -=head2 LimitDate (FIELD => 'DateField', OPERATOR => $oper, VALUE => $ISODate) - -Takes a paramhash with the fields FIELD OPERATOR and VALUE. - -OPERATOR is one of > or < -VALUE is a date and time in ISO format in GMT -FIELD is one of Starts, Started, Told, Created, Resolved, LastUpdated - -There are also helper functions of the form LimitFIELD that eliminate -the need to pass in a FIELD argument. - -=cut - -sub LimitDate { - my $self = shift; - my %args = ( - FIELD => undef, - VALUE => undef, - OPERATOR => undef, - - @_ - ); - - #Set the description if we didn't get handed it above - unless ( $args{'DESCRIPTION'} ) { - $args{'DESCRIPTION'} = $args{'FIELD'} . " " - . $args{'OPERATOR'} . " " - . $args{'VALUE'} . " GMT"; - } - - $self->Limit(%args); - -} - - -sub LimitCreated { - my $self = shift; - $self->LimitDate( FIELD => 'Created', @_ ); -} - -sub LimitDue { - my $self = shift; - $self->LimitDate( FIELD => 'Due', @_ ); - -} - -sub LimitStarts { - my $self = shift; - $self->LimitDate( FIELD => 'Starts', @_ ); - -} - -sub LimitStarted { - my $self = shift; - $self->LimitDate( FIELD => 'Started', @_ ); -} - -sub LimitResolved { - my $self = shift; - $self->LimitDate( FIELD => 'Resolved', @_ ); -} - -sub LimitTold { - my $self = shift; - $self->LimitDate( FIELD => 'Told', @_ ); -} - -sub LimitLastUpdated { - my $self = shift; - $self->LimitDate( FIELD => 'LastUpdated', @_ ); -} - -# - -=head2 LimitTransactionDate (OPERATOR => $oper, VALUE => $ISODate) - -Takes a paramhash with the fields FIELD OPERATOR and VALUE. - -OPERATOR is one of > or < -VALUE is a date and time in ISO format in GMT - - -=cut - -sub LimitTransactionDate { - my $self = shift; - my %args = ( - FIELD => 'TransactionDate', - VALUE => undef, - OPERATOR => undef, - - @_ - ); - - # <20021217042756.GK28744@pallas.fsck.com> - # "Kill It" - Jesse. - - #Set the description if we didn't get handed it above - unless ( $args{'DESCRIPTION'} ) { - $args{'DESCRIPTION'} = $args{'FIELD'} . " " - . $args{'OPERATOR'} . " " - . $args{'VALUE'} . " GMT"; - } - - $self->Limit(%args); - -} - - - - -=head2 LimitCustomField - -Takes a paramhash of key/value pairs with the following keys: - -=over 4 - -=item CUSTOMFIELD - CustomField name or id. If a name is passed, an additional parameter QUEUE may also be passed to distinguish the custom field. - -=item OPERATOR - The usual Limit operators - -=item VALUE - The value to compare against - -=back - -=cut - -sub LimitCustomField { - my $self = shift; - my %args = ( - VALUE => undef, - CUSTOMFIELD => undef, - OPERATOR => '=', - DESCRIPTION => undef, - FIELD => 'CustomFieldValue', - QUOTEVALUE => 1, - @_ - ); - - my $CF = RT::CustomField->new( $self->CurrentUser ); - if ( $args{CUSTOMFIELD} =~ /^\d+$/ ) { - $CF->Load( $args{CUSTOMFIELD} ); - } - else { - $CF->LoadByNameAndQueue( - Name => $args{CUSTOMFIELD}, - Queue => $args{QUEUE} - ); - $args{CUSTOMFIELD} = $CF->Id; - } - - #If we are looking to compare with a null value. - if ( $args{'OPERATOR'} =~ /^is$/i ) { - $args{'DESCRIPTION'} - ||= $self->loc( "Custom field [_1] has no value.", $CF->Name ); - } - elsif ( $args{'OPERATOR'} =~ /^is not$/i ) { - $args{'DESCRIPTION'} - ||= $self->loc( "Custom field [_1] has a value.", $CF->Name ); - } - - # if we're not looking to compare with a null value - else { - $args{'DESCRIPTION'} ||= $self->loc( "Custom field [_1] [_2] [_3]", - $CF->Name, $args{OPERATOR}, $args{VALUE} ); - } - - if ( defined $args{'QUEUE'} && $args{'QUEUE'} =~ /\D/ ) { - my $QueueObj = RT::Queue->new( $self->CurrentUser ); - $QueueObj->Load( $args{'QUEUE'} ); - $args{'QUEUE'} = $QueueObj->Id; - } - delete $args{'QUEUE'} unless defined $args{'QUEUE'} && length $args{'QUEUE'}; - - my @rest; - @rest = ( ENTRYAGGREGATOR => 'AND' ) - if ( $CF->Type eq 'SelectMultiple' ); - - $self->Limit( - VALUE => $args{VALUE}, - FIELD => "CF" - .(defined $args{'QUEUE'}? ".$args{'QUEUE'}" : '' ) - .".{" . $CF->Name . "}", - OPERATOR => $args{OPERATOR}, - CUSTOMFIELD => 1, - @rest, - ); - - $self->{'RecalcTicketLimits'} = 1; -} - - - -=head2 _NextIndex - -Keep track of the counter for the array of restrictions - -=cut - -sub _NextIndex { - my $self = shift; - return ( $self->{'restriction_index'}++ ); -} - - - - -sub _Init { - my $self = shift; - $self->{'table'} = "Tickets"; - $self->{'RecalcTicketLimits'} = 1; - $self->{'looking_at_effective_id'} = 0; - $self->{'looking_at_type'} = 0; - $self->{'restriction_index'} = 1; - $self->{'primary_key'} = "id"; - delete $self->{'items_array'}; - delete $self->{'item_map'}; - delete $self->{'columns_to_display'}; - $self->SUPER::_Init(@_); - - $self->_InitSQL; - -} - - -sub Count { - my $self = shift; - $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); - return ( $self->SUPER::Count() ); -} - - -sub CountAll { - my $self = shift; - $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); - return ( $self->SUPER::CountAll() ); -} - - - -=head2 ItemsArrayRef - -Returns a reference to the set of all items found in this search - -=cut - -sub ItemsArrayRef { - my $self = shift; - - return $self->{'items_array'} if $self->{'items_array'}; - - my $placeholder = $self->_ItemsCounter; - $self->GotoFirstItem(); - while ( my $item = $self->Next ) { - push( @{ $self->{'items_array'} }, $item ); - } - $self->GotoItem($placeholder); - $self->{'items_array'} - = $self->ItemsOrderBy( $self->{'items_array'} ); - - return $self->{'items_array'}; -} - -sub ItemsArrayRefWindow { - my $self = shift; - my $window = shift; - - my @old = ($self->_ItemsCounter, $self->RowsPerPage, $self->FirstRow+1); - - $self->RowsPerPage( $window ); - $self->FirstRow(1); - $self->GotoFirstItem; - - my @res; - while ( my $item = $self->Next ) { - push @res, $item; - } - - $self->RowsPerPage( $old[1] ); - $self->FirstRow( $old[2] ); - $self->GotoItem( $old[0] ); - - return \@res; -} - - -sub Next { - my $self = shift; - - $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 ); - - my $Ticket = $self->SUPER::Next; - return $Ticket unless $Ticket; - - if ( $Ticket->__Value('Status') eq 'deleted' - && !$self->{'allow_deleted_search'} ) - { - return $self->Next; - } - elsif ( RT->Config->Get('UseSQLForACLChecks') ) { - # if we found a ticket with this option enabled then - # all tickets we found are ACLed, cache this fact - my $key = join ";:;", $self->CurrentUser->id, 'ShowTicket', 'RT::Ticket-'. $Ticket->id; - $RT::Principal::_ACL_CACHE->set( $key => 1 ); - return $Ticket; - } - elsif ( $Ticket->CurrentUserHasRight('ShowTicket') ) { - # has rights - return $Ticket; - } - else { - # If the user doesn't have the right to show this ticket - return $self->Next; - } -} - -sub _DoSearch { - my $self = shift; - $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); - return $self->SUPER::_DoSearch( @_ ); -} - -sub _DoCount { - my $self = shift; - $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); - return $self->SUPER::_DoCount( @_ ); -} - -sub _RolesCanSee { - my $self = shift; - - my $cache_key = 'RolesHasRight;:;ShowTicket'; - - if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { - return %$cached; - } - - my $ACL = RT::ACL->new( RT->SystemUser ); - $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' ); - $ACL->Limit( FIELD => 'PrincipalType', OPERATOR => '!=', VALUE => 'Group' ); - my $principal_alias = $ACL->Join( - ALIAS1 => 'main', - FIELD1 => 'PrincipalId', - TABLE2 => 'Principals', - FIELD2 => 'id', - ); - $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); - - my %res = (); - foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) { - my $role = $ACE->__Value('PrincipalType'); - my $type = $ACE->__Value('ObjectType'); - if ( $type eq 'RT::System' ) { - $res{ $role } = 1; - } - elsif ( $type eq 'RT::Queue' ) { - next if $res{ $role } && !ref $res{ $role }; - push @{ $res{ $role } ||= [] }, $ACE->__Value('ObjectId'); - } - else { - $RT::Logger->error('ShowTicket right is granted on unsupported object'); - } - } - $RT::Principal::_ACL_CACHE->set( $cache_key => \%res ); - return %res; -} - -sub _DirectlyCanSeeIn { - my $self = shift; - my $id = $self->CurrentUser->id; - - my $cache_key = 'User-'. $id .';:;ShowTicket;:;DirectlyCanSeeIn'; - if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) { - return @$cached; - } - - my $ACL = RT::ACL->new( RT->SystemUser ); - $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' ); - my $principal_alias = $ACL->Join( - ALIAS1 => 'main', - FIELD1 => 'PrincipalId', - TABLE2 => 'Principals', - FIELD2 => 'id', - ); - $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); - my $cgm_alias = $ACL->Join( - ALIAS1 => 'main', - FIELD1 => 'PrincipalId', - TABLE2 => 'CachedGroupMembers', - FIELD2 => 'GroupId', - ); - $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id ); - $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 ); - - my @res = (); - foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) { - my $type = $ACE->__Value('ObjectType'); - if ( $type eq 'RT::System' ) { - # If user is direct member of a group that has the right - # on the system then he can see any ticket - $RT::Principal::_ACL_CACHE->set( $cache_key => [-1] ); - return (-1); - } - elsif ( $type eq 'RT::Queue' ) { - push @res, $ACE->__Value('ObjectId'); - } - else { - $RT::Logger->error('ShowTicket right is granted on unsupported object'); - } - } - $RT::Principal::_ACL_CACHE->set( $cache_key => \@res ); - return @res; -} - -sub CurrentUserCanSee { - my $self = shift; - return if $self->{'_sql_current_user_can_see_applied'}; - - return $self->{'_sql_current_user_can_see_applied'} = 1 - if $self->CurrentUser->UserObj->HasRight( - Right => 'SuperUser', Object => $RT::System - ); - - my $id = $self->CurrentUser->id; - - # directly can see in all queues then we have nothing to do - my @direct_queues = $self->_DirectlyCanSeeIn; - return $self->{'_sql_current_user_can_see_applied'} = 1 - if @direct_queues && $direct_queues[0] == -1; - - my %roles = $self->_RolesCanSee; - { - my %skip = map { $_ => 1 } @direct_queues; - foreach my $role ( keys %roles ) { - next unless ref $roles{ $role }; - - my @queues = grep !$skip{$_}, @{ $roles{ $role } }; - if ( @queues ) { - $roles{ $role } = \@queues; - } else { - delete $roles{ $role }; - } - } - } - -# there is no global watchers, only queues and tickes, if at -# some point we will add global roles then it's gonna blow -# the idea here is that if the right is set globaly for a role -# and user plays this role for a queue directly not a ticket -# then we have to check in advance - if ( my @tmp = grep $_ ne 'Owner' && !ref $roles{ $_ }, keys %roles ) { - - my $groups = RT::Groups->new( RT->SystemUser ); - $groups->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role' ); - foreach ( @tmp ) { - $groups->Limit( FIELD => 'Type', VALUE => $_ ); - } - my $principal_alias = $groups->Join( - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'Principals', - FIELD2 => 'id', - ); - $groups->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 ); - my $cgm_alias = $groups->Join( - ALIAS1 => 'main', - FIELD1 => 'id', - TABLE2 => 'CachedGroupMembers', - FIELD2 => 'GroupId', - ); - $groups->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id ); - $groups->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 ); - while ( my $group = $groups->Next ) { - push @direct_queues, $group->Instance; - } - } - - unless ( @direct_queues || keys %roles ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => 'main', - FIELD => 'id', - VALUE => 0, - ENTRYAGGREGATOR => 'AND', - ); - return $self->{'_sql_current_user_can_see_applied'} = 1; - } - - { - my $join_roles = keys %roles; - $join_roles = 0 if $join_roles == 1 && $roles{'Owner'}; - my ($role_group_alias, $cgm_alias); - if ( $join_roles ) { - $role_group_alias = $self->_RoleGroupsJoin( New => 1 ); - $cgm_alias = $self->_GroupMembersJoin( GroupsAlias => $role_group_alias ); - $self->SUPER::Limit( - LEFTJOIN => $cgm_alias, - FIELD => 'MemberId', - OPERATOR => '=', - VALUE => $id, - ); - } - my $limit_queues = sub { - my $ea = shift; - my @queues = @_; - - return unless @queues; - if ( @queues == 1 ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => 'main', - FIELD => 'Queue', - VALUE => $_[0], - ENTRYAGGREGATOR => $ea, - ); - } else { - $self->SUPER::_OpenParen('ACL'); - foreach my $q ( @queues ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => 'main', - FIELD => 'Queue', - VALUE => $q, - ENTRYAGGREGATOR => $ea, - ); - $ea = 'OR'; - } - $self->SUPER::_CloseParen('ACL'); - } - return 1; - }; - - $self->SUPER::_OpenParen('ACL'); - my $ea = 'AND'; - $ea = 'OR' if $limit_queues->( $ea, @direct_queues ); - while ( my ($role, $queues) = each %roles ) { - $self->SUPER::_OpenParen('ACL'); - if ( $role eq 'Owner' ) { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - FIELD => 'Owner', - VALUE => $id, - ENTRYAGGREGATOR => $ea, - ); - } - else { - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => $cgm_alias, - FIELD => 'MemberId', - OPERATOR => 'IS NOT', - VALUE => 'NULL', - QUOTEVALUE => 0, - ENTRYAGGREGATOR => $ea, - ); - $self->SUPER::Limit( - SUBCLAUSE => 'ACL', - ALIAS => $role_group_alias, - FIELD => 'Type', - VALUE => $role, - ENTRYAGGREGATOR => 'AND', - ); - } - $limit_queues->( 'AND', @$queues ) if ref $queues; - $ea = 'OR' if $ea eq 'AND'; - $self->SUPER::_CloseParen('ACL'); - } - $self->SUPER::_CloseParen('ACL'); - } - return $self->{'_sql_current_user_can_see_applied'} = 1; -} - - - - - -=head2 LoadRestrictions - -LoadRestrictions takes a string which can fully populate the TicketRestrictons hash. -TODO It is not yet implemented - -=cut - - - -=head2 DescribeRestrictions - -takes nothing. -Returns a hash keyed by restriction id. -Each element of the hash is currently a one element hash that contains DESCRIPTION which -is a description of the purpose of that TicketRestriction - -=cut - -sub DescribeRestrictions { - my $self = shift; - - my %listing; - - foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) { - $listing{$row} = $self->{'TicketRestrictions'}{$row}{'DESCRIPTION'}; - } - return (%listing); -} - - - -=head2 RestrictionValues FIELD - -Takes a restriction field and returns a list of values this field is restricted -to. - -=cut - -sub RestrictionValues { - my $self = shift; - my $field = shift; - map $self->{'TicketRestrictions'}{$_}{'VALUE'}, grep { - $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field - && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "=" - } - keys %{ $self->{'TicketRestrictions'} }; -} - - - -=head2 ClearRestrictions - -Removes all restrictions irretrievably - -=cut - -sub ClearRestrictions { - my $self = shift; - delete $self->{'TicketRestrictions'}; - $self->{'looking_at_effective_id'} = 0; - $self->{'looking_at_type'} = 0; - $self->{'RecalcTicketLimits'} = 1; -} - - - -=head2 DeleteRestriction - -Takes the row Id of a restriction (From DescribeRestrictions' output, for example. -Removes that restriction from the session's limits. - -=cut - -sub DeleteRestriction { - my $self = shift; - my $row = shift; - delete $self->{'TicketRestrictions'}{$row}; - - $self->{'RecalcTicketLimits'} = 1; - - #make the underlying easysearch object forget all its preconceptions -} - - - -# Convert a set of oldstyle SB Restrictions to Clauses for RQL - -sub _RestrictionsToClauses { - my $self = shift; - - my %clause; - foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) { - my $restriction = $self->{'TicketRestrictions'}{$row}; - - # We need to reimplement the subclause aggregation that SearchBuilder does. - # Default Subclause is ALIAS.FIELD, and default ALIAS is 'main', - # Then SB AND's the different Subclauses together. - - # So, we want to group things into Subclauses, convert them to - # SQL, and then join them with the appropriate DefaultEA. - # Then join each subclause group with AND. - - my $field = $restriction->{'FIELD'}; - my $realfield = $field; # CustomFields fake up a fieldname, so - # we need to figure that out - - # One special case - # Rewrite LinkedTo meta field to the real field - if ( $field =~ /LinkedTo/ ) { - $realfield = $field = $restriction->{'TYPE'}; - } - - # Two special case - # Handle subkey fields with a different real field - if ( $field =~ /^(\w+)\./ ) { - $realfield = $1; - } - - die "I don't know about $field yet" - unless ( exists $FIELD_METADATA{$realfield} - or $restriction->{CUSTOMFIELD} ); - - my $type = $FIELD_METADATA{$realfield}->[0]; - my $op = $restriction->{'OPERATOR'}; - - my $value = ( - grep {defined} - map { $restriction->{$_} } qw(VALUE TICKET BASE TARGET) - )[0]; - - # this performs the moral equivalent of defined or/dor/C<//>, - # without the short circuiting.You need to use a 'defined or' - # type thing instead of just checking for truth values, because - # VALUE could be 0.(i.e. "false") - - # You could also use this, but I find it less aesthetic: - # (although it does short circuit) - #( defined $restriction->{'VALUE'}? $restriction->{VALUE} : - # defined $restriction->{'TICKET'} ? - # $restriction->{TICKET} : - # defined $restriction->{'BASE'} ? - # $restriction->{BASE} : - # defined $restriction->{'TARGET'} ? - # $restriction->{TARGET} ) - - my $ea = $restriction->{ENTRYAGGREGATOR} - || $DefaultEA{$type} - || "AND"; - if ( ref $ea ) { - die "Invalid operator $op for $field ($type)" - unless exists $ea->{$op}; - $ea = $ea->{$op}; - } - - # Each CustomField should be put into a different Clause so they - # are ANDed together. - if ( $restriction->{CUSTOMFIELD} ) { - $realfield = $field; - } - - exists $clause{$realfield} or $clause{$realfield} = []; - - # Escape Quotes - $field =~ s!(['\\])!\\$1!g; - $value =~ s!(['\\])!\\$1!g; - my $data = [ $ea, $type, $field, $op, $value ]; - - # here is where we store extra data, say if it's a keyword or - # something. (I.e. "TYPE SPECIFIC STUFF") - - if (lc $ea eq 'none') { - $clause{$realfield} = [ $data ]; - } else { - push @{ $clause{$realfield} }, $data; - } - } - return \%clause; -} - - - -=head2 _ProcessRestrictions PARAMHASH - -# The new _ProcessRestrictions is somewhat dependent on the SQL stuff, -# but isn't quite generic enough to move into Tickets_SQL. - -=cut - -sub _ProcessRestrictions { - my $self = shift; - - #Blow away ticket aliases since we'll need to regenerate them for - #a new search - delete $self->{'TicketAliases'}; - delete $self->{'items_array'}; - delete $self->{'item_map'}; - delete $self->{'raw_rows'}; - delete $self->{'rows'}; - delete $self->{'count_all'}; - - my $sql = $self->Query; # Violating the _SQL namespace - if ( !$sql || $self->{'RecalcTicketLimits'} ) { - - # "Restrictions to Clauses Branch\n"; - my $clauseRef = eval { $self->_RestrictionsToClauses; }; - if ($@) { - $RT::Logger->error( "RestrictionsToClauses: " . $@ ); - $self->FromSQL(""); - } - else { - $sql = $self->ClausesToSQL($clauseRef); - $self->FromSQL($sql) if $sql; - } - } - - $self->{'RecalcTicketLimits'} = 0; - -} - -=head2 _BuildItemMap - -Build up a L</ItemMap> of first/last/next/prev items, so that we can -display search nav quickly. - -=cut - -sub _BuildItemMap { - my $self = shift; - - my $window = RT->Config->Get('TicketsItemMapSize'); - - $self->{'item_map'} = {}; - - my $items = $self->ItemsArrayRefWindow( $window ); - return unless $items && @$items; - - my $prev = 0; - $self->{'item_map'}{'first'} = $items->[0]->EffectiveId; - for ( my $i = 0; $i < @$items; $i++ ) { - my $item = $items->[$i]; - my $id = $item->EffectiveId; - $self->{'item_map'}{$id}{'defined'} = 1; - $self->{'item_map'}{$id}{'prev'} = $prev; - $self->{'item_map'}{$id}{'next'} = $items->[$i+1]->EffectiveId - if $items->[$i+1]; - $prev = $id; - } - $self->{'item_map'}{'last'} = $prev - if !$window || @$items < $window; -} - -=head2 ItemMap - -Returns an a map of all items found by this search. The map is a hash -of the form: - - { - first => <first ticket id found>, - last => <last ticket id found or undef>, - - <ticket id> => { - prev => <the ticket id found before>, - next => <the ticket id found after>, - }, - <ticket id> => { - prev => ..., - next => ..., - }, - } - -=cut - -sub ItemMap { - my $self = shift; - $self->_BuildItemMap unless $self->{'item_map'}; - return $self->{'item_map'}; -} - - - - -=head2 PrepForSerialization - -You don't want to serialize a big tickets object, as -the {items} hash will be instantly invalid _and_ eat -lots of space - -=cut - -sub PrepForSerialization { - my $self = shift; - delete $self->{'items'}; - delete $self->{'items_array'}; - $self->RedoSearch(); -} - -=head1 FLAGS - -RT::Tickets supports several flags which alter search behavior: - - -allow_deleted_search (Otherwise never show deleted tickets in search results) -looking_at_type (otherwise limit to type=ticket) - -These flags are set by calling - -$tickets->{'flagname'} = 1; - -BUG: There should be an API for this - - - -=cut - - - -=head2 NewItem - -Returns an empty new RT::Ticket item - -=cut - -sub NewItem { - my $self = shift; - return(RT::Ticket->new($self->CurrentUser)); -} -RT::Base->_ImportOverlays(); - -1; |