From b4b0c7e72d7eaee2fbfc7022022c9698323203dd Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 31 Dec 2009 13:16:41 +0000 Subject: import rt 3.8.7 --- rt/lib/RT/ACE.pm | 11 +- rt/lib/RT/ACE_Overlay.pm | 317 +- rt/lib/RT/ACL.pm | 10 +- rt/lib/RT/ACL_Overlay.pm | 15 +- rt/lib/RT/Action.pm | 227 + rt/lib/RT/Action/AutoOpen.pm | 52 +- rt/lib/RT/Action/Autoreply.pm | 63 +- rt/lib/RT/Action/CreateTickets.pm | 265 +- rt/lib/RT/Action/EscalatePriority.pm | 11 +- rt/lib/RT/Action/ExtractSubjectTag.pm | 103 + rt/lib/RT/Action/Generic.pm | 177 +- rt/lib/RT/Action/LinearEscalate.pm | 279 + rt/lib/RT/Action/Notify.pm | 76 +- rt/lib/RT/Action/NotifyAsComment.pm | 10 +- rt/lib/RT/Action/NotifyGroup.pm | 209 + rt/lib/RT/Action/NotifyGroupAsComment.pm | 91 + rt/lib/RT/Action/RecordComment.pm | 9 +- rt/lib/RT/Action/RecordCorrespondence.pm | 9 +- rt/lib/RT/Action/ResolveMembers.pm | 9 +- rt/lib/RT/Action/SendEmail.pm | 1055 +- rt/lib/RT/Action/SetPriority.pm | 9 +- rt/lib/RT/Action/UserDefined.pm | 9 +- rt/lib/RT/Approval.pm | 74 + rt/lib/RT/Approval/Rule.pm | 85 + rt/lib/RT/Approval/Rule/Created.pm | 71 + rt/lib/RT/Approval/Rule/NewPending.pm | 97 + rt/lib/RT/Approval/Rule/Passed.pm | 110 + rt/lib/RT/Approval/Rule/Rejected.pm | 114 + rt/lib/RT/Attachment.pm | 5 +- rt/lib/RT/Attachment_Overlay.pm | 604 +- rt/lib/RT/Attachments.pm | 5 +- rt/lib/RT/Attachments_Overlay.pm | 195 +- rt/lib/RT/Attribute.pm | 5 +- rt/lib/RT/Attribute_Overlay.pm | 55 +- rt/lib/RT/Attributes.pm | 5 +- rt/lib/RT/Attributes_Overlay.pm | 43 +- rt/lib/RT/Base.pm | 15 +- rt/lib/RT/CachedGroupMember.pm | 5 +- rt/lib/RT/CachedGroupMember_Overlay.pm | 13 +- rt/lib/RT/CachedGroupMembers.pm | 5 +- rt/lib/RT/CachedGroupMembers_Overlay.pm | 10 +- rt/lib/RT/Condition.pm | 233 + rt/lib/RT/Condition/AnyTransaction.pm | 9 +- rt/lib/RT/Condition/BeforeDue.pm | 10 +- rt/lib/RT/Condition/CloseTicket.pm | 84 + rt/lib/RT/Condition/Generic.pm | 181 +- rt/lib/RT/Condition/Overdue.pm | 11 +- rt/lib/RT/Condition/OwnerChange.pm | 54 +- rt/lib/RT/Condition/PriorityChange.pm | 11 +- rt/lib/RT/Condition/PriorityExceeds.pm | 12 +- rt/lib/RT/Condition/QueueChange.pm | 12 +- rt/lib/RT/Condition/ReopenTicket.pm | 89 + rt/lib/RT/Condition/StatusChange.pm | 11 +- rt/lib/RT/Condition/UserDefined.pm | 12 +- rt/lib/RT/Config.pm | 894 ++ rt/lib/RT/Crypt/GnuPG.pm | 2450 +++++ rt/lib/RT/CurrentUser.pm | 326 +- rt/lib/RT/CustomField.pm | 19 +- rt/lib/RT/CustomFieldValue.pm | 5 +- rt/lib/RT/CustomFieldValue_Overlay.pm | 107 +- rt/lib/RT/CustomFieldValues.pm | 5 +- rt/lib/RT/CustomFieldValues/External.pm | 235 + rt/lib/RT/CustomFieldValues/Groups.pm | 88 + rt/lib/RT/CustomFieldValues_Overlay.pm | 16 +- rt/lib/RT/CustomField_Overlay.pm | 765 +- rt/lib/RT/CustomFields.pm | 5 +- rt/lib/RT/CustomFields_Overlay.pm | 55 +- rt/lib/RT/Dashboard.pm | 358 + rt/lib/RT/Date.pm | 1026 +- rt/lib/RT/EmailParser.pm | 358 +- rt/lib/RT/Graph/Tickets.pm | 358 + rt/lib/RT/Group.pm | 5 +- rt/lib/RT/GroupMember.pm | 5 +- rt/lib/RT/GroupMember_Overlay.pm | 20 +- rt/lib/RT/GroupMembers.pm | 5 +- rt/lib/RT/GroupMembers_Overlay.pm | 10 +- rt/lib/RT/Group_Overlay.pm | 339 +- rt/lib/RT/Groups.pm | 7 +- rt/lib/RT/Groups_Overlay.pm | 165 +- rt/lib/RT/Handle.pm | 1009 +- rt/lib/RT/I18N.pm | 91 +- rt/lib/RT/I18N/ar.po | 7509 ++++++++++++++ rt/lib/RT/I18N/bg.po | 7461 ++++++++++++++ rt/lib/RT/I18N/cs.pm | 5 +- rt/lib/RT/I18N/cs.po | 5539 ++++++++--- rt/lib/RT/I18N/da.po | 6184 ++++++++---- rt/lib/RT/I18N/de.po | 5708 ++++++++--- rt/lib/RT/I18N/en.po | 92 +- rt/lib/RT/I18N/es.po | 5797 ++++++++--- rt/lib/RT/I18N/fi.po | 6330 ++++++++---- rt/lib/RT/I18N/fr.po | 5754 ++++++++--- rt/lib/RT/I18N/he.po | 5365 +++++++--- rt/lib/RT/I18N/hr.po | 8617 ++++++++++++++++ rt/lib/RT/I18N/hu.po | 5441 +++++++--- rt/lib/RT/I18N/i_default.pm | 9 +- rt/lib/RT/I18N/id.po | 5364 +++++++--- rt/lib/RT/I18N/it.po | 5546 ++++++++--- rt/lib/RT/I18N/ja.po | 7374 ++++++++------ rt/lib/RT/I18N/nb.po | 9073 +++++++++++++++++ rt/lib/RT/I18N/nl.po | 5394 +++++++--- rt/lib/RT/I18N/pl.po | 5441 +++++++--- rt/lib/RT/I18N/pt.po | 7869 +++++++++++++++ rt/lib/RT/I18N/pt_BR.po | 9249 +++++++++++++++++ rt/lib/RT/I18N/rt.pot | 7460 ++++++++++++++ rt/lib/RT/I18N/ru.pm | 74 + rt/lib/RT/I18N/ru.po | 6876 +++++++------ rt/lib/RT/I18N/sv.po | 6160 ++++++++---- rt/lib/RT/I18N/tr.po | 5403 +++++++--- rt/lib/RT/I18N/zh_CN.po | 10953 ++++++++++++++++++++ rt/lib/RT/I18N/zh_TW.po | 10985 +++++++++++++++++++++ rt/lib/RT/Installer.pm | 340 + rt/lib/RT/Interface/CLI.pm | 24 +- rt/lib/RT/Interface/Email.pm | 1205 ++- rt/lib/RT/Interface/Email/Auth/GnuPG.pm | 211 +- rt/lib/RT/Interface/Email/Auth/MailFrom.pm | 99 +- rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm | 8 +- rt/lib/RT/Interface/REST.pm | 58 +- rt/lib/RT/Interface/Web.pm | 1849 ++-- rt/lib/RT/Interface/Web/Handler.pm | 78 +- rt/lib/RT/Interface/Web/Menu.pm | 5 +- rt/lib/RT/Interface/Web/Menu/Item.pm | 5 +- rt/lib/RT/Interface/Web/QueryBuilder.pm | 5 +- rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm | 180 +- rt/lib/RT/Interface/Web/Request.pm | 207 + rt/lib/RT/Interface/Web/Session.pm | 285 + rt/lib/RT/Interface/Web/Standalone.pm | 49 +- rt/lib/RT/Interface/Web/Standalone/PreFork.pm | 103 + rt/lib/RT/Link.pm | 5 +- rt/lib/RT/Link_Overlay.pm | 117 +- rt/lib/RT/Links.pm | 5 +- rt/lib/RT/Links_Overlay.pm | 14 +- rt/lib/RT/ObjectCustomField.pm | 5 +- rt/lib/RT/ObjectCustomFieldValue.pm | 5 +- rt/lib/RT/ObjectCustomFieldValue_Overlay.pm | 189 +- rt/lib/RT/ObjectCustomFieldValues.pm | 5 +- rt/lib/RT/ObjectCustomFieldValues_Overlay.pm | 81 +- rt/lib/RT/ObjectCustomField_Overlay.pm | 69 +- rt/lib/RT/ObjectCustomFields.pm | 5 +- rt/lib/RT/ObjectCustomFields_Overlay.pm | 29 +- rt/lib/RT/Plugin.pm | 141 + rt/lib/RT/Principal.pm | 5 +- rt/lib/RT/Principal_Overlay.pm | 105 +- rt/lib/RT/Principals.pm | 5 +- rt/lib/RT/Principals_Overlay.pm | 10 +- rt/lib/RT/Queue.pm | 5 +- rt/lib/RT/Queue_Overlay.pm | 330 +- rt/lib/RT/Queues.pm | 5 +- rt/lib/RT/Queues_Overlay.pm | 10 +- rt/lib/RT/Record.pm | 545 +- rt/lib/RT/Reminders.pm | 10 +- rt/lib/RT/Report/Tickets.pm | 307 +- rt/lib/RT/Report/Tickets/Entry.pm | 14 +- rt/lib/RT/Rule.pm | 118 + rt/lib/RT/Ruleset.pm | 94 + rt/lib/RT/SQL.pm | 302 + rt/lib/RT/SavedSearch.pm | 276 +- rt/lib/RT/SavedSearches.pm | 16 +- rt/lib/RT/Scrip.pm | 5 +- rt/lib/RT/ScripAction.pm | 5 +- rt/lib/RT/ScripAction_Overlay.pm | 10 +- rt/lib/RT/ScripActions.pm | 5 +- rt/lib/RT/ScripActions_Overlay.pm | 10 +- rt/lib/RT/ScripCondition.pm | 5 +- rt/lib/RT/ScripCondition_Overlay.pm | 10 +- rt/lib/RT/ScripConditions.pm | 5 +- rt/lib/RT/ScripConditions_Overlay.pm | 10 +- rt/lib/RT/Scrip_Overlay.pm | 71 +- rt/lib/RT/Scrips.pm | 5 +- rt/lib/RT/Scrips_Overlay.pm | 30 +- rt/lib/RT/Search.pm | 148 + rt/lib/RT/Search/ActiveTicketsInQueue.pm | 12 +- rt/lib/RT/Search/FromSQL.pm | 12 +- rt/lib/RT/Search/Generic.pm | 98 +- rt/lib/RT/Search/Googleish.pm | 51 +- rt/lib/RT/SearchBuilder.pm | 94 +- rt/lib/RT/SharedSetting.pm | 458 + rt/lib/RT/Shredder.pm | 868 ++ rt/lib/RT/Shredder/ACE.pm | 101 + rt/lib/RT/Shredder/Attachment.pm | 136 + rt/lib/RT/Shredder/CachedGroupMember.pm | 151 + rt/lib/RT/Shredder/Constants.pm | 141 + rt/lib/RT/Shredder/CustomField.pm | 126 + rt/lib/RT/Shredder/CustomFieldValue.pm | 94 + rt/lib/RT/Shredder/Dependencies.pm | 149 + rt/lib/RT/Shredder/Dependency.pm | 112 + rt/lib/RT/Shredder/Exceptions.pm | 113 + rt/lib/RT/Shredder/Group.pm | 185 + rt/lib/RT/Shredder/GroupMember.pm | 183 + rt/lib/RT/Shredder/Link.pm | 140 + rt/lib/RT/Shredder/ObjectCustomFieldValue.pm | 116 + rt/lib/RT/Shredder/POD.pm | 131 + rt/lib/RT/Shredder/Plugin.pm | 249 + rt/lib/RT/Shredder/Plugin/Attachments.pm | 141 + rt/lib/RT/Shredder/Plugin/Base.pm | 188 + rt/lib/RT/Shredder/Plugin/Base/Dump.pm | 70 + rt/lib/RT/Shredder/Plugin/Base/Search.pm | 142 + rt/lib/RT/Shredder/Plugin/Objects.pm | 107 + rt/lib/RT/Shredder/Plugin/SQLDump.pm | 96 + rt/lib/RT/Shredder/Plugin/Summary.pm | 188 + rt/lib/RT/Shredder/Plugin/Tickets.pm | 153 + rt/lib/RT/Shredder/Plugin/Users.pm | 260 + rt/lib/RT/Shredder/Principal.pm | 127 + rt/lib/RT/Shredder/Queue.pm | 106 + rt/lib/RT/Shredder/Record.pm | 273 + rt/lib/RT/Shredder/Scrip.pm | 130 + rt/lib/RT/Shredder/ScripAction.pm | 100 + rt/lib/RT/Shredder/ScripCondition.pm | 101 + rt/lib/RT/Shredder/Template.pm | 120 + rt/lib/RT/Shredder/Ticket.pm | 126 + rt/lib/RT/Shredder/Transaction.pm | 115 + rt/lib/RT/Shredder/User.pm | 191 + rt/lib/RT/StyleGuide.pod | 24 +- rt/lib/RT/System.pm | 103 +- rt/lib/RT/Template.pm | 5 +- rt/lib/RT/Template_Overlay.pm | 289 +- rt/lib/RT/Templates.pm | 5 +- rt/lib/RT/Templates_Overlay.pm | 10 +- rt/lib/RT/Test.pm | 1293 +++ rt/lib/RT/Test/Email.pm | 131 + rt/lib/RT/Test/Web.pm | 192 + rt/lib/RT/Ticket.pm | 67 +- rt/lib/RT/Ticket_Overlay.pm | 1412 ++- rt/lib/RT/Tickets.pm | 5 +- rt/lib/RT/Tickets_Overlay.pm | 1133 ++- rt/lib/RT/Tickets_Overlay_SQL.pm | 534 +- rt/lib/RT/Transaction.pm | 5 +- rt/lib/RT/Transaction_Overlay.pm | 482 +- rt/lib/RT/Transactions.pm | 5 +- rt/lib/RT/Transactions_Overlay.pm | 36 +- rt/lib/RT/URI.pm | 40 +- rt/lib/RT/URI/base.pm | 5 +- rt/lib/RT/URI/fsck_com_rt.pm | 39 +- rt/lib/RT/URI/t.pm | 22 +- rt/lib/RT/User.pm | 5 +- rt/lib/RT/User_Overlay.pm | 1050 +- rt/lib/RT/Users.pm | 5 +- rt/lib/RT/Users_Overlay.pm | 84 +- rt/lib/RT/Util.pm | 89 + 238 files changed, 171023 insertions(+), 37377 deletions(-) create mode 100755 rt/lib/RT/Action.pm create mode 100644 rt/lib/RT/Action/ExtractSubjectTag.pm create mode 100755 rt/lib/RT/Action/LinearEscalate.pm create mode 100644 rt/lib/RT/Action/NotifyGroup.pm create mode 100644 rt/lib/RT/Action/NotifyGroupAsComment.pm create mode 100644 rt/lib/RT/Approval.pm create mode 100644 rt/lib/RT/Approval/Rule.pm create mode 100644 rt/lib/RT/Approval/Rule/Created.pm create mode 100644 rt/lib/RT/Approval/Rule/NewPending.pm create mode 100644 rt/lib/RT/Approval/Rule/Passed.pm create mode 100644 rt/lib/RT/Approval/Rule/Rejected.pm create mode 100755 rt/lib/RT/Condition.pm create mode 100644 rt/lib/RT/Condition/CloseTicket.pm create mode 100644 rt/lib/RT/Condition/ReopenTicket.pm create mode 100644 rt/lib/RT/Config.pm create mode 100644 rt/lib/RT/Crypt/GnuPG.pm create mode 100644 rt/lib/RT/CustomFieldValues/External.pm create mode 100644 rt/lib/RT/CustomFieldValues/Groups.pm create mode 100644 rt/lib/RT/Dashboard.pm create mode 100644 rt/lib/RT/Graph/Tickets.pm create mode 100644 rt/lib/RT/I18N/ar.po create mode 100644 rt/lib/RT/I18N/bg.po create mode 100644 rt/lib/RT/I18N/hr.po create mode 100755 rt/lib/RT/I18N/nb.po create mode 100644 rt/lib/RT/I18N/pt.po create mode 100755 rt/lib/RT/I18N/pt_BR.po create mode 100644 rt/lib/RT/I18N/rt.pot create mode 100755 rt/lib/RT/I18N/ru.pm create mode 100644 rt/lib/RT/I18N/zh_CN.po create mode 100644 rt/lib/RT/I18N/zh_TW.po create mode 100644 rt/lib/RT/Installer.pm create mode 100644 rt/lib/RT/Interface/Web/Request.pm create mode 100644 rt/lib/RT/Interface/Web/Session.pm create mode 100644 rt/lib/RT/Interface/Web/Standalone/PreFork.pm create mode 100644 rt/lib/RT/Plugin.pm create mode 100644 rt/lib/RT/Rule.pm create mode 100644 rt/lib/RT/Ruleset.pm create mode 100644 rt/lib/RT/SQL.pm create mode 100755 rt/lib/RT/Search.pm create mode 100644 rt/lib/RT/SharedSetting.pm create mode 100644 rt/lib/RT/Shredder.pm create mode 100644 rt/lib/RT/Shredder/ACE.pm create mode 100644 rt/lib/RT/Shredder/Attachment.pm create mode 100644 rt/lib/RT/Shredder/CachedGroupMember.pm create mode 100644 rt/lib/RT/Shredder/Constants.pm create mode 100644 rt/lib/RT/Shredder/CustomField.pm create mode 100644 rt/lib/RT/Shredder/CustomFieldValue.pm create mode 100644 rt/lib/RT/Shredder/Dependencies.pm create mode 100644 rt/lib/RT/Shredder/Dependency.pm create mode 100644 rt/lib/RT/Shredder/Exceptions.pm create mode 100644 rt/lib/RT/Shredder/Group.pm create mode 100644 rt/lib/RT/Shredder/GroupMember.pm create mode 100644 rt/lib/RT/Shredder/Link.pm create mode 100644 rt/lib/RT/Shredder/ObjectCustomFieldValue.pm create mode 100644 rt/lib/RT/Shredder/POD.pm create mode 100644 rt/lib/RT/Shredder/Plugin.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Attachments.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Base.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Base/Dump.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Base/Search.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Objects.pm create mode 100644 rt/lib/RT/Shredder/Plugin/SQLDump.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Summary.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Tickets.pm create mode 100644 rt/lib/RT/Shredder/Plugin/Users.pm create mode 100644 rt/lib/RT/Shredder/Principal.pm create mode 100644 rt/lib/RT/Shredder/Queue.pm create mode 100644 rt/lib/RT/Shredder/Record.pm create mode 100644 rt/lib/RT/Shredder/Scrip.pm create mode 100644 rt/lib/RT/Shredder/ScripAction.pm create mode 100644 rt/lib/RT/Shredder/ScripCondition.pm create mode 100644 rt/lib/RT/Shredder/Template.pm create mode 100644 rt/lib/RT/Shredder/Ticket.pm create mode 100644 rt/lib/RT/Shredder/Transaction.pm create mode 100644 rt/lib/RT/Shredder/User.pm create mode 100644 rt/lib/RT/Test.pm create mode 100644 rt/lib/RT/Test/Email.pm create mode 100644 rt/lib/RT/Test/Web.pm create mode 100644 rt/lib/RT/Util.pm (limited to 'rt/lib/RT') diff --git a/rt/lib/RT/ACE.pm b/rt/lib/RT/ACE.pm index 0cd12174d..7f21ba05e 100755 --- a/rt/lib/RT/ACE.pm +++ b/rt/lib/RT/ACE.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # @@ -68,11 +69,7 @@ RT::ACE =cut package RT::ACE; -use RT::Record; - - -use vars qw( @ISA ); -@ISA= qw( RT::Record ); +use base 'RT::Record'; sub _Init { my $self = shift; diff --git a/rt/lib/RT/ACE_Overlay.pm b/rt/lib/RT/ACE_Overlay.pm index 1a245f31d..f2a2efdc0 100644 --- a/rt/lib/RT/ACE_Overlay.pm +++ b/rt/lib/RT/ACE_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 SYNOPSIS use RT::ACE; @@ -57,11 +58,6 @@ =head1 METHODS -=begin testing - -ok(require RT::ACE); - -=end testing =cut @@ -89,15 +85,6 @@ use vars qw ( # to real people or groups -=begin testing - -my $Queue = RT::Queue->new($RT::SystemUser); - -is ($Queue->AvailableRights->{'DeleteTicket'} , 'Delete tickets', "Found the delete ticket right"); -is ($RT::System->AvailableRights->{'SuperUser'}, 'Do anything and everything', "Found the superuser right"); - - -=end testing =cut @@ -149,6 +136,14 @@ sub LoadByValues { ObjectType => undef, @_ ); + if ( $args{'RightName'} ) { + my $canonic_name = $self->CanonicalizeRightName( $args{'RightName'} ); + unless ( $canonic_name ) { + return ( 0, $self->loc("Invalid right. Couldn't canonicalize right '[_1]'", $args{'RightName'}) ); + } + $args{'RightName'} = $canonic_name; + } + my $princ_obj; ( $princ_obj, $args{'PrincipalType'} ) = $self->_CanonicalizePrincipal( $args{'PrincipalId'}, @@ -216,11 +211,18 @@ PARAMS is a parameter hash with the following elements: sub Create { my $self = shift; - my %args = ( PrincipalId => undef, - PrincipalType => undef, - RightName => undef, - Object => undef, - @_ ); + my %args = ( + PrincipalId => undef, + PrincipalType => undef, + RightName => undef, + Object => undef, + @_ + ); + + unless ( $args{'RightName'} ) { + return ( 0, $self->loc('No right specified') ); + } + #if we haven't specified any sort of right, we're talking about a global right if (!defined $args{'Object'} && !defined $args{'ObjectId'} && !defined $args{'ObjectType'}) { $args{'Object'} = $RT::System; @@ -262,37 +264,23 @@ sub Create { # }}} # {{{ Canonicalize and check the right name - unless ( $args{'RightName'} ) { - return ( 0, $self->loc('Invalid right') ); + my $canonic_name = $self->CanonicalizeRightName( $args{'RightName'} ); + unless ( $canonic_name ) { + return ( 0, $self->loc("Invalid right. Couldn't canonicalize right '[_1]'", $args{'RightName'}) ); } - - $args{'RightName'} = $self->CanonicalizeRightName( $args{'RightName'} ); + $args{'RightName'} = $canonic_name; #check if it's a valid RightName - if ( ref ($args{'Object'} eq 'RT::Queue' )) { - unless ( exists $args{'Object'}->AvailableRights->{ $args{'RightName'} } ) { - $RT::Logger->warning("Couldn't validate right name". $args{'RightName'}); - return ( 0, $self->loc('Invalid right') ); - } - } - elsif ( ref ($args{'Object'} eq 'RT::Group' )) { - unless ( exists $args{'Object'}->AvailableRights->{ $args{'RightName'} } ) { - $RT::Logger->warning("Couldn't validate group right name". $args{'RightName'}); - return ( 0, $self->loc('Invalid right') ); - } - } - elsif ( ref ($args{'Object'} eq 'RT::System' )) { - my $q = RT::Queue->new($self->CurrentUser); - my $g = RT::Group->new($self->CurrentUser); - - unless (( exists $g->AvailableRights->{ $args{'RightName'} } ) - || ( exists $g->AvailableRights->{ $args{'RightName'} } ) - || ( exists $RT::System->AvailableRights->{ $args{'RightName'} } ) ) { - $RT::Logger->warning("Couldn't validate system right name - ". $args{'RightName'}); + if ( $args{'Object'}->can('AvailableRights') ) { + my $available = $args{'Object'}->AvailableRights; + unless ( grep $_ eq $args{'RightName'}, map $self->CanonicalizeRightName( $_ ), keys %$available ) { + $RT::Logger->warning( + "Couldn't validate right name '$args{'RightName'}'" + ." for object of ". ref( $args{'Object'} ) ." class" + ); return ( 0, $self->loc('Invalid right') ); } } - # }}} # Make sure the right doesn't already exist. @@ -318,7 +306,7 @@ sub Create { #Clear the key cache. TODO someday we may want to just clear a little bit of the keycache space. RT::Principal->InvalidateACLCache(); - if ( $id > 0 ) { + if ( $id ) { return ( $id, $self->loc('Right Granted') ); } else { @@ -340,216 +328,6 @@ or doesn't have the right to delegate rights. Always returns a tuple of (ReturnValue, Message) -=begin testing - -use_ok(RT::User); -my $user_a = RT::User->new($RT::SystemUser); -$user_a->Create( Name => 'DelegationA', Privileged => 1); -ok ($user_a->Id, "Created delegation user a"); - -my $user_b = RT::User->new($RT::SystemUser); -$user_b->Create( Name => 'DelegationB', Privileged => 1); -ok ($user_b->Id, "Created delegation user b"); - - -use_ok(RT::Queue); -my $q = RT::Queue->new($RT::SystemUser); -$q->Create(Name =>'DelegationTest'); -ok ($q->Id, "Created a delegation test queue"); - - -#------ First, we test whether a user can delegate a right that's been granted to him personally -my ($val, $msg) = $user_a->PrincipalObj->GrantRight(Object => $RT::System, Right => 'AdminOwnPersonalGroups'); -ok($val, $msg); - -($val, $msg) = $user_a->PrincipalObj->GrantRight(Object =>$q, Right => 'OwnTicket'); -ok($val, $msg); - -ok($user_a->HasRight( Object => $RT::System, Right => 'AdminOwnPersonalGroups') ,"user a has the right 'AdminOwnPersonalGroups' directly"); - -my $a_delegates = RT::Group->new($user_a); -$a_delegates->CreatePersonalGroup(Name => 'Delegates'); -ok( $a_delegates->Id ,"user a creates a personal group 'Delegates'"); -ok( $a_delegates->AddMember($user_b->PrincipalId) ,"user a adds user b to personal group 'delegates'"); - -ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to OwnTicket' in queue 'DelegationTest'"); -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a has the right to 'OwnTicket' in queue 'DelegationTest'"); -ok(!$user_a->HasRight( Object => $RT::System, Right => 'DelegateRights') ,"user a does not have the right 'delegate rights'"); - - -my $own_ticket_ace = RT::ACE->new($user_a); -my $user_a_equiv_group = RT::Group->new($user_a); -$user_a_equiv_group->LoadACLEquivalenceGroup($user_a->PrincipalObj); -ok ($user_a_equiv_group->Id, "Loaded the user A acl equivalence group"); -my $user_b_equiv_group = RT::Group->new($user_b); -$user_b_equiv_group->LoadACLEquivalenceGroup($user_b->PrincipalObj); -ok ($user_b_equiv_group->Id, "Loaded the user B acl equivalence group"); -$own_ticket_ace->LoadByValues( PrincipalType => 'Group', PrincipalId => $user_a_equiv_group->PrincipalId, Object=>$q, RightName => 'OwnTicket'); - -ok ($own_ticket_ace->Id, "Found the ACE we want to test with for now"); - - -($val, $msg) = $own_ticket_ace->Delegate(PrincipalId => $a_delegates->PrincipalId) ; -ok( !$val ,"user a tries and fails to delegate the right 'ownticket' in queue 'DelegationTest' to personal group 'delegates' - $msg"); - - -($val, $msg) = $user_a->PrincipalObj->GrantRight( Right => 'DelegateRights'); -ok($val, "user a is granted the right to 'delegate rights' - $msg"); - -ok($user_a->HasRight( Object => $RT::System, Right => 'DelegateRights') ,"user a has the right 'AdminOwnPersonalGroups' directly"); - -($val, $msg) = $own_ticket_ace->Delegate(PrincipalId => $a_delegates->PrincipalId) ; - -ok( $val ,"user a tries and succeeds to delegate the right 'ownticket' in queue 'DelegationTest' to personal group 'delegates' - $msg"); -ok( $user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); -my $delegated_ace = RT::ACE->new($user_a); -$delegated_ace->LoadByValues ( Object => $q, RightName => 'OwnTicket', PrincipalType => 'Group', -PrincipalId => $a_delegates->PrincipalId, DelegatedBy => $user_a->PrincipalId, DelegatedFrom => $own_ticket_ace->Id); -ok ($delegated_ace->Id, "Found the delegated ACE"); - -ok( $a_delegates->DeleteMember($user_b->PrincipalId) ,"user a removes b from pg 'delegates'"); -ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); -ok( $a_delegates->AddMember($user_b->PrincipalId) ,"user a adds user b to personal group 'delegates'"); -ok( $user_b->HasRight(Right => 'OwnTicket', Object=> $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); -ok( $delegated_ace->Delete ,"user a revokes pg 'delegates' right to 'OwnTickets' in queue 'DelegationTest'"); -ok( ! $user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); - -($val, $msg) = $own_ticket_ace->Delegate(PrincipalId => $a_delegates->PrincipalId) ; -ok( $val ,"user a delegates pg 'delegates' right to 'OwnTickets' in queue 'DelegationTest' - $msg"); - -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a does not have the right to own tickets in queue 'DelegationTest'"); - -($val, $msg) = $user_a->PrincipalObj->RevokeRight(Object=>$q, Right => 'OwnTicket'); -ok($val, "Revoked user a's right to own tickets in queue 'DelegationTest". $msg); - -ok( !$user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a does not have the right to own tickets in queue 'DelegationTest'"); - - ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); - -($val, $msg) = $user_a->PrincipalObj->GrantRight(Object=>$q, Right => 'OwnTicket'); -ok($val, $msg); - - ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a has the right to own tickets in queue 'DelegationTest'"); - - ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); - -# {{{ get back to a known clean state -($val, $msg) = $user_a->PrincipalObj->RevokeRight( Object => $q, Right => 'OwnTicket'); -ok($val, "Revoked user a's right to own tickets in queue 'DelegationTest -". $msg); -ok( !$user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"make sure that user a can't own tickets in queue 'DelegationTest'"); -# }}} - - -# {{{ Set up some groups and membership -my $del1 = RT::Group->new($RT::SystemUser); -($val, $msg) = $del1->CreateUserDefinedGroup(Name => 'Del1'); -ok( $val ,"create a group del1 - $msg"); - -my $del2 = RT::Group->new($RT::SystemUser); -($val, $msg) = $del2->CreateUserDefinedGroup(Name => 'Del2'); -ok( $val ,"create a group del2 - $msg"); -($val, $msg) = $del1->AddMember($del2->PrincipalId); -ok( $val,"make del2 a member of del1 - $msg"); - -my $del2a = RT::Group->new($RT::SystemUser); -($val, $msg) = $del2a->CreateUserDefinedGroup(Name => 'Del2a'); -ok( $val ,"create a group del2a - $msg"); -($val, $msg) = $del2->AddMember($del2a->PrincipalId); -ok($val ,"make del2a a member of del2 - $msg"); - -my $del2b = RT::Group->new($RT::SystemUser); -($val, $msg) = $del2b->CreateUserDefinedGroup(Name => 'Del2b'); -ok( $val ,"create a group del2b - $msg"); -($val, $msg) = $del2->AddMember($del2b->PrincipalId); -ok($val ,"make del2b a member of del2 - $msg"); - -($val, $msg) = $del2->AddMember($user_a->PrincipalId) ; -ok($val,"make 'user a' a member of del2 - $msg"); - -($val, $msg) = $del2b->AddMember($user_a->PrincipalId) ; -ok($val,"make 'user a' a member of del2b - $msg"); - -# }}} - -# {{{ Grant a right to a group and make sure that a submember can delegate the right and that it does not get yanked -# when a user is removed as a submember, when they're a sumember through another path -($val, $msg) = $del1->PrincipalObj->GrantRight( Object=> $q, Right => 'OwnTicket'); -ok( $val ,"grant del1 the right to 'OwnTicket' in queue 'DelegationTest' - $msg"); - -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"make sure that user a can own tickets in queue 'DelegationTest'"); - -my $group_ace= RT::ACE->new($user_a); -$group_ace->LoadByValues( PrincipalType => 'Group', PrincipalId => $del1->PrincipalId, Object => $q, RightName => 'OwnTicket'); - -ok ($group_ace->Id, "Found the ACE we want to test with for now"); - -($val, $msg) = $group_ace->Delegate(PrincipalId => $a_delegates->PrincipalId); - -ok( $val ,"user a tries and succeeds to delegate the right 'ownticket' in queue 'DelegationTest' to personal group 'delegates' - $msg"); -ok( $user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); - - -($val, $msg) = $del2b->DeleteMember($user_a->PrincipalId); -ok( $val ,"remove user a from group del2b - $msg"); -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a has the right to own tickets in queue 'DelegationTest'"); -ok( $user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); - -# }}} - -# {{{ When a user is removed froom a group by the only path they're in there by, make sure the delegations go away -($val, $msg) = $del2->DeleteMember($user_a->PrincipalId); -ok( $val ,"remove user a from group del2 - $msg"); -ok( !$user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a does not have the right to own tickets in queue 'DelegationTest' "); -ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest' "); -# }}} - -($val, $msg) = $del2->AddMember($user_a->PrincipalId); -ok( $val ,"make user a a member of group del2 - $msg"); - -($val, $msg) = $del2->PrincipalObj->GrantRight(Object=>$q, Right => 'OwnTicket'); -ok($val, "grant the right 'own tickets' in queue 'DelegationTest' to group del2 - $msg"); - -my $del2_right = RT::ACE->new($user_a); -$del2_right->LoadByValues( PrincipalId => $del2->PrincipalId, PrincipalType => 'Group', Object => $q, RightName => 'OwnTicket'); -ok ($del2_right->Id, "Found the right"); - -($val, $msg) = $del2_right->Delegate(PrincipalId => $a_delegates->PrincipalId); -ok( $val ,"user a tries and succeeds to delegate the right 'ownticket' in queue 'DelegationTest' gotten via del2 to personal group 'delegates' - $msg"); - -# They have it via del1 and del2 -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); - - -($val, $msg) = $del2->PrincipalObj->RevokeRight(Object=>$q, Right => 'OwnTicket'); -ok($val, "revoke the right 'own tickets' in queue 'DelegationTest' to group del2 - $msg"); -ok( $user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a does has the right to own tickets in queue 'DelegationTest' via del1"); -ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); - -($val, $msg) = $del2->PrincipalObj->GrantRight(Object=>$q, Right => 'OwnTicket'); -ok($val, "grant the right 'own tickets' in queue 'DelegationTest' to group del2 - $msg"); - - -$group_ace= RT::ACE->new($user_a); -$group_ace->LoadByValues( PrincipalType => 'Group', PrincipalId => $del1->PrincipalId, Object=>$q, RightName => 'OwnTicket'); - -ok ($group_ace->Id, "Found the ACE we want to test with for now"); - -($val, $msg) = $group_ace->Delegate(PrincipalId => $a_delegates->PrincipalId); - -ok( $val ,"user a tries and succeeds to delegate the right 'ownticket' in queue 'DelegationTest' to personal group 'delegates' - $msg"); - -ok( $user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b has the right to own tickets in queue 'DelegationTest'"); - -($val, $msg) = $del2->DeleteMember($user_a->PrincipalId); -ok( $val ,"remove user a from group del2 - $msg"); - -ok( !$user_a->HasRight(Right => 'OwnTicket', Object => $q) ,"user a does not have the right to own tickets in queue 'DelegationTest'"); - -ok( !$user_b->HasRight(Right => 'OwnTicket', Object => $q) ,"user b does not have the right to own tickets in queue 'DelegationTest'"); - - - -=end testing =cut @@ -762,6 +540,20 @@ sub _BootstrapCreate { # {{{ sub CanonicalizeRightName +sub RightName { + my $self = shift; + my $val = $self->_Value('RightName'); + return $val unless $val; + + my $available = $self->Object->AvailableRights; + foreach my $right ( keys %$available ) { + return $right if $val eq $self->CanonicalizeRightName($right); + } + + $RT::Logger->error("Invalid right. Couldn't canonicalize right '$val'"); + return $val; +} + =head2 CanonicalizeRightName Takes a queue or system right name in any case and returns it in @@ -771,14 +563,7 @@ the correct case. If it's not found, will return undef. sub CanonicalizeRightName { my $self = shift; - my $right = shift; - $right = lc $right; - if ( exists $LOWERCASERIGHTNAMES{"$right"} ) { - return ( $LOWERCASERIGHTNAMES{"$right"} ); - } - else { - return (undef); - } + return $LOWERCASERIGHTNAMES{ lc shift }; } # }}} @@ -899,7 +684,7 @@ Returns a tuple of (RT::Principal, PrincipalType) for the principal we really sub _CanonicalizePrincipal { my $self = shift; my $princ_id = shift; - my $princ_type = shift; + my $princ_type = shift || ''; my $princ_obj = RT::Principal->new($RT::SystemUser); $princ_obj->Load($princ_id); diff --git a/rt/lib/RT/ACL.pm b/rt/lib/RT/ACL.pm index 9641292e6..1dc66e8b6 100755 --- a/rt/lib/RT/ACL.pm +++ b/rt/lib/RT/ACL.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # @@ -71,12 +72,9 @@ use strict; package RT::ACL; -use RT::SearchBuilder; +use base 'RT::SearchBuilder'; use RT::ACE; -use vars qw( @ISA ); -@ISA= qw(RT::SearchBuilder); - sub _Init { my $self = shift; diff --git a/rt/lib/RT/ACL_Overlay.pm b/rt/lib/RT/ACL_Overlay.pm index 1329df07c..d645e4063 100644 --- a/rt/lib/RT/ACL_Overlay.pm +++ b/rt/lib/RT/ACL_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME RT::ACL - collection of RT ACE objects @@ -59,11 +60,6 @@ my $ACL = new RT::ACL($CurrentUser); =head1 METHODS -=begin testing - -ok(require RT::ACL); - -=end testing =cut @@ -318,7 +314,7 @@ sub _DoSearch { my $self = shift; # $RT::Logger->debug("Now in ".$self."->_DoSearch"); my $return = $self->SUPER::_DoSearch(@_); - # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return\n"); + # $RT::Logger->debug("In $self ->_DoSearch. return from SUPER::_DoSearch was $return"); $self->_BuildHash(); return ($return); } @@ -329,7 +325,8 @@ sub _BuildHash { my $self = shift; while (my $entry = $self->Next) { - my $hashkey = $entry->ObjectType . "-" . $entry->ObjectId . "-" . $entry->RightName . "-" . $entry->PrincipalId . "-" . $entry->PrincipalType; + my $hashkey = join '-', map $entry->__Value( $_ ), + qw(ObjectType ObjectId RightName PrincipalId PrincipalType); $self->{'as_hash'}->{"$hashkey"} =1; diff --git a/rt/lib/RT/Action.pm b/rt/lib/RT/Action.pm new file mode 100755 index 000000000..1918a7e37 --- /dev/null +++ b/rt/lib/RT/Action.pm @@ -0,0 +1,227 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Action - a generic baseclass for RT Actions + +=head1 SYNOPSIS + + use RT::Action; + +=head1 DESCRIPTION + +=head1 METHODS + + +=cut + +package RT::Action; + +use strict; +use Scalar::Util; + +use base qw/RT::Base/; + +# {{{ sub new +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->_Init(@_); + return $self; +} +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + my %args = ( Argument => undef, + CurrentUser => undef, + ScripActionObj => undef, + ScripObj => undef, + TemplateObj => undef, + TicketObj => undef, + TransactionObj => undef, + Type => undef, + + @_ ); + + $self->{'Argument'} = $args{'Argument'}; + $self->CurrentUser( $args{'CurrentUser'}); + $self->{'ScripActionObj'} = $args{'ScripActionObj'}; + $self->{'ScripObj'} = $args{'ScripObj'}; + $self->{'TemplateObj'} = $args{'TemplateObj'}; + $self->{'TicketObj'} = $args{'TicketObj'}; + $self->{'TransactionObj'} = $args{'TransactionObj'}; + $self->{'Type'} = $args{'Type'}; + + Scalar::Util::weaken($self->{'ScripActionObj'}); + Scalar::Util::weaken($self->{'ScripObj'}); + Scalar::Util::weaken($self->{'TemplateObj'}); + Scalar::Util::weaken($self->{'TicketObj'}); + Scalar::Util::weaken($self->{'TransactionObj'}); + +} +# }}} + +# Access Scripwide data + +# {{{ sub Argument +sub Argument { + my $self = shift; + return($self->{'Argument'}); +} +# }}} + +# {{{ sub TicketObj +sub TicketObj { + my $self = shift; + return($self->{'TicketObj'}); +} +# }}} + +# {{{ sub TransactionObj +sub TransactionObj { + my $self = shift; + return($self->{'TransactionObj'}); +} +# }}} + +# {{{ sub TemplateObj +sub TemplateObj { + my $self = shift; + return($self->{'TemplateObj'}); +} +# }}} + +# {{{ sub ScripObj +sub ScripObj { + my $self = shift; + return($self->{'ScripObj'}); +} +# }}} + +# {{{ sub ScripActionObj +sub ScripActionObj { + my $self = shift; + return($self->{'ScripActionObj'}); +} +# }}} + +# {{{ sub Type +sub Type { + my $self = shift; + return($self->{'Type'}); +} +# }}} + + +# Scrip methods + +#Do what we need to do and send it out. + +# {{{ sub Commit +sub Commit { + my $self = shift; + return(0, $self->loc("Commit Stubbed")); +} +# }}} + + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return $self->loc("No description for [_1]", ref $self); +} +# }}} + + +#Parse the templates, get things ready to go. + +# {{{ sub Prepare +sub Prepare { + my $self = shift; + return (0, $self->loc("Prepare Stubbed")); +} +# }}} + + +#If this rule applies to this transaction, return true. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + return(undef); +} +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + + # We need to clean up all the references that might maybe get + # oddly circular + $self->{'ScripActionObj'} = undef; + $self->{'ScripObj'} = undef; + $self->{'TemplateObj'} =undef + $self->{'TicketObj'} = undef; + $self->{'TransactionObj'} = undef; +} + +# }}} + +eval "require RT::Action_Vendor"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action_Vendor.pm}); +eval "require RT::Action_Local"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action_Local.pm}); + +1; diff --git a/rt/lib/RT/Action/AutoOpen.pm b/rt/lib/RT/Action/AutoOpen.pm index 004ed13cc..e1cf0ae7c 100644 --- a/rt/lib/RT/Action/AutoOpen.pm +++ b/rt/lib/RT/Action/AutoOpen.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,28 +45,25 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} -# This Action will open the BASE if a dependent is resolved. +# This Action will open the BASE if a dependent is resolved. package RT::Action::AutoOpen; -require RT::Action::Generic; use strict; -use vars qw/@ISA/; -@ISA=qw(RT::Action::Generic); +use warnings; -#Do what we need to do and send it out. +use base qw(RT::Action); -#What does this type of Action does +=head1 DESCRIPTION -# {{{ sub Describe -sub Describe { - my $self = shift; - return (ref $self ); -} -# }}} +Opens a ticket unless it's allready open, but only unless transaction +L. +Doesn't open a ticket if message's head has field C with +C substring. + +=cut -# {{{ sub Prepare sub Prepare { my $self = shift; @@ -83,22 +80,21 @@ sub Prepare { return 1; } -# }}} sub Commit { my $self = shift; - my $oldstatus = $self->TicketObj->Status(); - $self->TicketObj->__Set( Field => 'Status', Value => 'open' ); - $self->TicketObj->_NewTransaction( - Type => 'Status', - Field => 'Status', - OldValue => $oldstatus, - NewValue => 'open', - Data => 'Ticket auto-opened on incoming correspondence' - ); - - - return(1); + + my $oldstatus = $self->TicketObj->Status; + $self->TicketObj->__Set( Field => 'Status', Value => 'open' ); + $self->TicketObj->_NewTransaction( + Type => 'Status', + Field => 'Status', + OldValue => $oldstatus, + NewValue => 'open', + Data => 'Ticket auto-opened on incoming correspondence' + ); + + return 1; } eval "require RT::Action::AutoOpen_Vendor"; diff --git a/rt/lib/RT/Action/Autoreply.pm b/rt/lib/RT/Action/Autoreply.pm index ea56b9f5b..3734d819a 100755 --- a/rt/lib/RT/Action/Autoreply.pm +++ b/rt/lib/RT/Action/Autoreply.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,12 +45,13 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::Autoreply; -require RT::Action::SendEmail; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::SendEmail); +use warnings; + +use base qw(RT::Action::SendEmail); =head2 Prepare @@ -95,43 +96,37 @@ Set this message\'s return address to the apropriate queue address sub SetReturnAddress { my $self = shift; - my %args = ( is_comment => 0, - @_ - ); - my $replyto; - if ($args{'is_comment'}) { - $replyto = $self->TicketObj->QueueObj->CommentAddress || - $RT::CommentAddress; - } - else { - $replyto = $self->TicketObj->QueueObj->CorrespondAddress || - $RT::CorrespondAddress; - } - - unless ($self->TemplateObj->MIMEObj->head->get('From')) { - if ($RT::UseFriendlyFromLine) { - my $friendly_name = $self->TicketObj->QueueObj->Description || + my $friendly_name; + + if (RT->Config->Get('UseFriendlyFromLine')) { + $friendly_name = $self->TicketObj->QueueObj->Description || $self->TicketObj->QueueObj->Name; - $friendly_name =~ s/"/\\"/g; - $self->SetHeader( 'From', - sprintf($RT::FriendlyFromLineFormat, - $self->MIMEEncodeString( $friendly_name, $RT::EmailOutputEncoding ), $replyto), - ); } - else { - $self->SetHeader( 'From', $replyto ); - } - } - - unless ($self->TemplateObj->MIMEObj->head->get('Reply-To')) { - $self->SetHeader('Reply-To', "$replyto"); - } + + $self->SUPER::SetReturnAddress( @_, friendly_name => $friendly_name ); } # }}} +# {{{{ sub SetRTSpecialHeaders + +=head2 SetRTSpecialHeaders + +Set the C header to C, in accordance +with RFC3834. + +=cut + +sub SetRTSpecialHeaders { + my $self = shift; + $self->SUPER::SetRTSpecialHeaders(@_); + $self->SetHeader( 'Auto-Submitted', 'auto-replied' ); +} + +# }}} + eval "require RT::Action::Autoreply_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Autoreply_Vendor.pm}); eval "require RT::Action::Autoreply_Local"; diff --git a/rt/lib/RT/Action/CreateTickets.pm b/rt/lib/RT/Action/CreateTickets.pm index 40d18d357..4883ae3a8 100644 --- a/rt/lib/RT/Action/CreateTickets.pm +++ b/rt/lib/RT/Action/CreateTickets.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,13 +45,12 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::CreateTickets; -require RT::Action::Generic; +use base 'RT::Action'; use strict; use warnings; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Generic); use MIME::Entity; @@ -106,10 +105,12 @@ of perl inside the Text::Template using {} delimiters, but that such sections absolutely can not span a ===Create-Ticket boundary. After each ticket is created, it's stuffed into a hash called %Tickets -so as to be available during the creation of other tickets during the same -ScripAction. The hash is prepopulated with the ticket which triggered the -ScripAction as $Tickets{'TOP'}; you can also access that ticket using the -shorthand TOP. +so as to be available during the creation of other tickets during the +same ScripAction, using the key 'create-identifier', where +C is the id you put after C<===Create-Ticket:>. The hash +is prepopulated with the ticket which triggered the ScripAction as +$Tickets{'TOP'}; you can also access that ticket using the shorthand +TOP. A simple example: @@ -164,8 +165,9 @@ A convoluted example ENDOFCONTENT ===Create-Ticket: two Subject: Manager approval + Type: approval Depended-On-By: TOP - Refers-On: {$Tickets{"approval"}->Id} + Refers-To: {$Tickets{"create-approval"}->Id} Queue: ___Approvals Content-Type: text/plain Content: @@ -236,236 +238,6 @@ Refers-To, RefersTo, refersto, refers-to and r-e-f-er-s-tO will all be treated as the same thing. -=begin testing - -ok (require RT::Action::CreateTickets); -use_ok(RT::Scrip); -use_ok(RT::Template); -use_ok(RT::ScripAction); -use_ok(RT::ScripCondition); -use_ok(RT::Ticket); - -my $approvalsq = RT::Queue->new($RT::SystemUser); -$approvalsq->Create(Name => 'Approvals'); -ok ($approvalsq->Id, "Created Approvals test queue"); - - -my $approvals = -'===Create-Ticket: approval -Queue: ___Approvals -Type: approval -AdminCc: {join ("\nAdminCc: ",@admins) } -Depended-On-By: {$Tickets{"TOP"}->Id} -Refers-To: TOP -Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject} -Due: {time + 86400} -Content-Type: text/plain -Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject} -Blah -Blah -ENDOFCONTENT -===Create-Ticket: two -Subject: Manager approval. -Depended-On-By: approval -Queue: ___Approvals -Content-Type: text/plain -Content: -Your minion approved ticket {$Tickets{"TOP"}->Id}. you ok with that? -ENDOFCONTENT -'; - -ok ($approvals =~ /Content/, "Read in the approvals template"); - -my $apptemp = RT::Template->new($RT::SystemUser); -$apptemp->Create( Content => $approvals, Name => "Approvals", Queue => "0"); - -ok ($apptemp->Id); - -my $q = RT::Queue->new($RT::SystemUser); -$q->Create(Name => 'WorkflowTest'); -ok ($q->Id, "Created workflow test queue"); - -my $scrip = RT::Scrip->new($RT::SystemUser); -my ($sval, $smsg) =$scrip->Create( ScripCondition => 'On Transaction', - ScripAction => 'Create Tickets', - Template => 'Approvals', - Queue => $q->Id); -ok ($sval, $smsg); -ok ($scrip->Id, "Created the scrip"); -ok ($scrip->TemplateObj->Id, "Created the scrip template"); -ok ($scrip->ConditionObj->Id, "Created the scrip condition"); -ok ($scrip->ActionObj->Id, "Created the scrip action"); - -my $t = RT::Ticket->new($RT::SystemUser); -my($tid, $ttrans, $tmsg) = $t->Create(Subject => "Sample workflow test", - Owner => "root", - Queue => $q->Id); - -ok ($tid,$tmsg); - -my $deps = $t->DependsOn; -is ($deps->Count, 1, "The ticket we created depends on one other ticket"); -my $dependson= $deps->First->TargetObj; -ok ($dependson->Id, "It depends on a real ticket"); -unlike ($dependson->Subject, qr/{/, "The subject doesn't have braces in it. that means we're interpreting expressions"); -is ($t->ReferredToBy->Count,1, "It's only referred to by one other ticket"); -is ($t->ReferredToBy->First->BaseObj->Id,$t->DependsOn->First->TargetObj->Id, "The same ticket that depends on it refers to it."); -use RT::Action::CreateTickets; -my $action = RT::Action::CreateTickets->new( CurrentUser => $RT::SystemUser);; - -# comma-delimited templates -my $commas = <<"EOF"; -id,Queue,Subject,Owner,Content -ticket1,General,"foo, bar",root,blah -ticket2,General,foo bar,root,blah -ticket3,General,foo' bar,root,blah'boo -ticket4,General,foo' bar,,blah'boo -EOF - - -# Comma delimited templates with missing data -my $sparse_commas = <<"EOF"; -id,Queue,Subject,Owner,Requestor -ticket14,General,,,bobby -ticket15,General,,,tommy -ticket16,General,,suzie,tommy -ticket17,General,Foo "bar" baz,suzie,tommy -ticket18,General,'Foo "bar" baz',suzie,tommy -ticket19,General,'Foo bar' baz,suzie,tommy -EOF - - -# tab-delimited templates -my $tabs = <<"EOF"; -id\tQueue\tSubject\tOwner\tContent -ticket10\tGeneral\t"foo' bar"\troot\tblah' -ticket11\tGeneral\tfoo, bar\troot\tblah -ticket12\tGeneral\tfoo' bar\troot\tblah'boo -ticket13\tGeneral\tfoo' bar\t\tblah'boo -EOF - -my %expected; - -$expected{ticket1} = <Parse(Content =>$commas); -$action->Parse(Content =>$sparse_commas); -$action->Parse(Content => $tabs); - -my %got; -foreach (@{ $action->{'create_tickets'} }) { - $got{$_} = $action->{'templates'}->{$_}; -} - -foreach my $id ( sort keys %expected ) { - ok(exists($got{"create-$id"}), "template exists for $id"); - is($got{"create-$id"}, $expected{$id}, "template is correct for $id"); -} - -=end testing =head1 AUTHOR @@ -541,16 +313,16 @@ sub Prepare { my $self = shift; unless ( $self->TemplateObj ) { - $RT::Logger->warning("No template object handed to $self\n"); + $RT::Logger->warning("No template object handed to $self"); } unless ( $self->TransactionObj ) { - $RT::Logger->warning("No transaction object handed to $self\n"); + $RT::Logger->warning("No transaction object handed to $self"); } unless ( $self->TicketObj ) { - $RT::Logger->warning("No ticket object handed to $self\n"); + $RT::Logger->warning("No ticket object handed to $self"); } @@ -575,7 +347,6 @@ sub CreateByTemplate { my @results; # XXX: cargo cult programming that works. i'll be back. - use bytes; local %T::Tickets = %T::Tickets; local $T::TOP = $T::TOP; @@ -637,7 +408,6 @@ sub UpdateByTemplate { my $top = shift; # XXX: cargo cult programming that works. i'll be back. - use bytes; my @results; local %T::Tickets = %T::Tickets; @@ -894,7 +664,7 @@ sub ParseLines { } ); - $RT::Logger->debug("Workflow: yielding\n$content"); + $RT::Logger->debug("Workflow: yielding $content"); if ($err) { $RT::Logger->error( "Ticket creation failed: " . $err ); @@ -990,6 +760,7 @@ sub ParseLines { TimeLeft => $args{'timeleft'}, InitialPriority => $args{'initialpriority'} || 0, FinalPriority => $args{'finalpriority'} || 0, + SquelchMailTo => $args{'squelchmailto'}, Type => $args{'type'}, ); @@ -1223,7 +994,7 @@ sub GetUpdateTemplate { my $mode = $LINKTYPEMAP{$type}->{Mode}; my $method = $LINKTYPEMAP{$type}->{Type}; - my $links; + my $links = ''; while ( my $link = $t->$method->Next ) { $links .= ", " if $links; diff --git a/rt/lib/RT/Action/EscalatePriority.pm b/rt/lib/RT/Action/EscalatePriority.pm index 46635df05..bf9de92c2 100644 --- a/rt/lib/RT/Action/EscalatePriority.pm +++ b/rt/lib/RT/Action/EscalatePriority.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME RT::Action::EscalatePriority @@ -71,11 +72,9 @@ as the ticket heads toward its due date. package RT::Action::EscalatePriority; -require RT::Action::Generic; +use base 'RT::Action'; use strict; -use vars qw/@ISA/; -@ISA=qw(RT::Action::Generic); #Do what we need to do and send it out. @@ -155,7 +154,7 @@ sub Commit { my ($val, $msg) = $self->TicketObj->SetPriority($self->{'prio'}); unless ($val) { - $RT::Logger->debug($self . " $msg\n"); + $RT::Logger->debug($self . " $msg"); } } diff --git a/rt/lib/RT/Action/ExtractSubjectTag.pm b/rt/lib/RT/Action/ExtractSubjectTag.pm new file mode 100644 index 000000000..4a173ce76 --- /dev/null +++ b/rt/lib/RT/Action/ExtractSubjectTag.pm @@ -0,0 +1,103 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Action::ExtractSubjectTag; +use base 'RT::Action'; +use strict; + +sub Describe { + my $self = shift; + return ( ref $self ); +} + +sub Prepare { + return (1); +} + +sub Commit { + my $self = shift; + my $Transaction = $self->TransactionObj; + my $FirstAttachment = $Transaction->Attachments->First; + return 1 unless ($FirstAttachment); + + my $Ticket = $self->TicketObj; + + my $TicketSubject = $self->TicketObj->Subject; + my $origTicketSubject = $TicketSubject; + my $TransactionSubject = $FirstAttachment->Subject; + + my $match = RT->Config->Get('ExtractSubjectTagMatch'); + my $nomatch = RT->Config->Get('ExtractSubjectTagNoMatch'); + TAGLIST: while ( $TransactionSubject =~ /($match)/g ) { + my $tag = $1; + next if $tag =~ /$nomatch/; + foreach my $subject_tag ( RT->System->SubjectTag ) { + if ($tag =~ /\[\Q$subject_tag\E\s+\#(\d+)\s*\]/) { + next TAGLIST; + } + } + $TicketSubject .= " $tag" unless ( $TicketSubject =~ /\Q$tag\E/ ); + } + + $self->TicketObj->SetSubject($TicketSubject) + if ( $TicketSubject ne $origTicketSubject ); + + return (1); +} + +eval "require RT::Action::ExtractSubjectTag_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/ExtractSubjectTag_Vendor.pm}) { + die $@; +}; + +eval "require RT::Action::ExtractSubjectTag_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/ExtractSubjectTag_Local.pm}) { + die $@; +}; + +1; diff --git a/rt/lib/RT/Action/Generic.pm b/rt/lib/RT/Action/Generic.pm index 3232d4898..5e8ef32ce 100755 --- a/rt/lib/RT/Action/Generic.pm +++ b/rt/lib/RT/Action/Generic.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,9 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME - RT::Action::Generic - a generic baseclass for RT Actions + RT::Action::Generic - deprecated, see RT::Action =head1 SYNOPSIS @@ -55,177 +56,25 @@ =head1 DESCRIPTION -=head1 METHODS - -=begin testing +This module is provided only for backwards compatibility. -ok (require RT::Action::Generic); +=head1 METHODS -=end testing =cut -package RT::Action::Generic; - use strict; -use Scalar::Util; - -use base qw/RT::Base/; - -# {{{ sub new -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - $self->_Init(@_); - return $self; -} -# }}} - -# {{{ sub _Init -sub _Init { - my $self = shift; - my %args = ( Argument => undef, - CurrentUser => undef, - ScripActionObj => undef, - ScripObj => undef, - TemplateObj => undef, - TicketObj => undef, - TransactionObj => undef, - Type => undef, - - @_ ); - - $self->{'Argument'} = $args{'Argument'}; - $self->CurrentUser( $args{'CurrentUser'}); - $self->{'ScripActionObj'} = $args{'ScripActionObj'}; - $self->{'ScripObj'} = $args{'ScripObj'}; - $self->{'TemplateObj'} = $args{'TemplateObj'}; - $self->{'TicketObj'} = $args{'TicketObj'}; - $self->{'TransactionObj'} = $args{'TransactionObj'}; - $self->{'Type'} = $args{'Type'}; - - Scalar::Util::weaken($self->{'ScripActionObj'}); - Scalar::Util::weaken($self->{'ScripObj'}); - Scalar::Util::weaken($self->{'TemplateObj'}); - Scalar::Util::weaken($self->{'TicketObj'}); - Scalar::Util::weaken($self->{'TransactionObj'}); - -} -# }}} - -# Access Scripwide data - -# {{{ sub Argument -sub Argument { - my $self = shift; - return($self->{'Argument'}); -} -# }}} - -# {{{ sub TicketObj -sub TicketObj { - my $self = shift; - return($self->{'TicketObj'}); -} -# }}} - -# {{{ sub TransactionObj -sub TransactionObj { - my $self = shift; - return($self->{'TransactionObj'}); -} -# }}} - -# {{{ sub TemplateObj -sub TemplateObj { - my $self = shift; - return($self->{'TemplateObj'}); -} -# }}} - -# {{{ sub ScripObj -sub ScripObj { - my $self = shift; - return($self->{'ScripObj'}); -} -# }}} - -# {{{ sub ScripActionObj -sub ScripActionObj { - my $self = shift; - return($self->{'ScripActionObj'}); -} -# }}} - -# {{{ sub Type -sub Type { - my $self = shift; - return($self->{'Type'}); -} -# }}} - - -# Scrip methods - -#Do what we need to do and send it out. - -# {{{ sub Commit -sub Commit { - my $self = shift; - return(0, $self->loc("Commit Stubbed")); -} -# }}} - - -#What does this type of Action does - -# {{{ sub Describe -sub Describe { - my $self = shift; - return $self->loc("No description for [_1]", ref $self); -} -# }}} - - -#Parse the templates, get things ready to go. - -# {{{ sub Prepare -sub Prepare { - my $self = shift; - return (0, $self->loc("Prepare Stubbed")); -} -# }}} - - -#If this rule applies to this transaction, return true. - -# {{{ sub IsApplicable -sub IsApplicable { - my $self = shift; - return(undef); -} -# }}} - -# {{{ sub DESTROY -sub DESTROY { - my $self = shift; - - # We need to clean up all the references that might maybe get - # oddly circular - $self->{'ScripActionObj'} = undef; - $self->{'ScripObj'} = undef; - $self->{'TemplateObj'} =undef - $self->{'TicketObj'} = undef; - $self->{'TransactionObj'} = undef; -} - -# }}} +use warnings; +package RT::Action::Generic; +use base 'RT::Action'; eval "require RT::Action::Generic_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Vendor.pm}); +warn "RT::Action::Generic has become RT::Action. Please adjust your deprecated RT::Action::Generic_Vendor file at " . $INC{"RT/Action/Generic_Vendor.pm"} if !$@; + eval "require RT::Action::Generic_Local"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Generic_Local.pm}); +warn "RT::Action::Generic has become RT::Action. Please adjust your deprecated RT::Action::Generic_Local file at " . $INC{"RT/Action/Generic_Local.pm"} if !$@; 1; + diff --git a/rt/lib/RT/Action/LinearEscalate.pm b/rt/lib/RT/Action/LinearEscalate.pm new file mode 100755 index 000000000..9130f40ca --- /dev/null +++ b/rt/lib/RT/Action/LinearEscalate.pm @@ -0,0 +1,279 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Action::LinearEscalate - will move a ticket's priority toward its final priority. + +=head1 This vs. RT::Action::EscalatePriority + +This action doesn't change priority if due date is not set. + +This action honor the Starts date. + +This action can apply changes silently. + +This action can replace EscalatePriority completly. If you want to tickets +that have been created without Due date then you can add scrip that sets +default due date. For example a week then priorities of your tickets will +escalate linearly during the week from intial value towards final. + +=head1 This vs. LinearEscalate from the CPAN + +This action is an integration of the module from the CPAN into RT's core +that's happened in RT 3.8. If you're upgrading from 3.6 and have been using +module from the CPAN with old version of RT then you should uninstall it +and use this one. + +However, this action doesn't support control over config. Read +to find out ways to deal with it. + +=head1 DESCRIPTION + +LinearEscalate is a ScripAction that will move a ticket's priority +from its initial priority to its final priority linearly as +the ticket approaches its due date. + +It's intended to be called by an RT escalation tool. One such tool is called +rt-crontool and is located in $RTHOME/bin (see C for more details). + +=head1 USAGE + +Once the ScripAction is installed, the following script in "cron" +will get tickets to where they need to be: + + rt-crontool --search RT::Search::FromSQL --search-arg \ + "(Status='new' OR Status='open' OR Status = 'stalled')" \ + --action RT::Action::LinearEscalate + +The Starts date is associated with intial ticket's priority or +the Created field if the former is not set. End of interval is +the Due date. Tickets without due date B. + +=head1 CONFIGURATION + +Initial and Final priorities are controlled by queue's options +and can be defined using the web UI via Configuration tab. This +action should handle correctly situations when initial priority +is greater than final. + +LinearEscalate's behavior can be controlled by two options: + +=over 4 + +=item RecordTransaction - defaults to false and if option is true then +causes the tool to create a transaction on the ticket when it is escalated. + +=item UpdateLastUpdated - which defaults to true and updates the LastUpdated +field when the ticket is escalated, otherwise don't touch anything. + +=back + +You cannot set "UpdateLastUpdated" to false unless "RecordTransaction" +is also false. Well, you can, but we'll just ignore you. + +You can set this options using either in F, as action +argument in call to the rt-crontool or in DB if you want to use the action +in scrips. + +From a shell you can use the following command: + + rt-crontool --search RT::Search::FromSQL --search-arg \ + "(Status='new' OR Status='open' OR Status = 'stalled')" \ + --action RT::Action::LinearEscalate \ + --action-arg "RecordTransaction: 1" + +This ScripAction uses RT's internal _Set or __Set calls to set ticket +priority without running scrips or recording a transaction on each +update, if it's been said to. + +=cut + +package RT::Action::LinearEscalate; + +use strict; +use warnings; +use base qw(RT::Action); + +our $VERSION = '0.06'; + +#Do what we need to do and send it out. + +#What does this type of Action does + +sub Describe { + my $self = shift; + my $class = ref($self) || $self; + return "$class will move a ticket's priority toward its final priority."; +} + +sub Prepare { + my $self = shift; + + my $ticket = $self->TicketObj; + + my $due = $ticket->DueObj->Unix; + unless ( $due > 0 ) { + $RT::Logger->debug('Due is not set. Not escalating.'); + return 1; + } + + my $priority_range = ($ticket->FinalPriority ||0) - ($ticket->InitialPriority ||0); + unless ( $priority_range ) { + $RT::Logger->debug('Final and Initial priorities are equal. Not escalating.'); + return 1; + } + + if ( $ticket->Priority >= $ticket->FinalPriority && $priority_range > 0 ) { + $RT::Logger->debug('Current priority is greater than final. Not escalating.'); + return 1; + } + elsif ( $ticket->Priority <= $ticket->FinalPriority && $priority_range < 0 ) { + $RT::Logger->debug('Current priority is lower than final. Not escalating.'); + return 1; + } + + # TODO: compute the number of business days until the ticket is due + + # now we know we have a due date. for every day that passes, + # increment priority according to the formula + + my $starts = $ticket->StartsObj->Unix; + $starts = $ticket->CreatedObj->Unix unless $starts > 0; + my $now = time; + + # do nothing if we didn't reach starts or created date + if ( $starts > $now ) { + $RT::Logger->debug('Starts(Created) is in future. Not escalating.'); + return 1; + } + + $due = $starts + 1 if $due <= $starts; # +1 to avoid div by zero + + my $percent_complete = ($now-$starts)/($due - $starts); + + my $new_priority = int($percent_complete * $priority_range) + ($ticket->InitialPriority || 0); + $new_priority = $ticket->FinalPriority if $new_priority > $ticket->FinalPriority; + $self->{'new_priority'} = $new_priority; + + return 1; +} + +sub Commit { + my $self = shift; + + my $new_value = $self->{'new_priority'}; + return 1 unless defined $new_value; + + my $ticket = $self->TicketObj; + # if the priority hasn't changed do nothing + return 1 if $ticket->Priority == $new_value; + + # override defaults from argument + my ($record, $update) = (0, 1); + { + my $arg = $self->Argument || ''; + if ( $arg =~ /RecordTransaction:\s*(\d+)/i ) { + $record = $1; + $RT::Logger->debug("Overrode RecordTransaction: $record"); + } + if ( $arg =~ /UpdateLastUpdated:\s*(\d+)/i ) { + $update = $1; + $RT::Logger->debug("Overrode UpdateLastUpdated: $update"); + } + $update = 1 if $record; + } + + $RT::Logger->debug( + 'Linearly escalating priority of ticket #'. $ticket->Id + .' from '. $ticket->Priority .' to '. $new_value + .' and'. ($record? '': ' do not') .' record a transaction' + .' and'. ($update? '': ' do not') .' touch last updated field' + ); + + my ( $val, $msg ); + unless ( $record ) { + unless ( $update ) { + ( $val, $msg ) = $ticket->__Set( + Field => 'Priority', + Value => $new_value, + ); + } + else { + ( $val, $msg ) = $ticket->_Set( + Field => 'Priority', + Value => $new_value, + RecordTransaction => 0, + ); + } + } + else { + ( $val, $msg ) = $ticket->SetPriority( $new_value ); + } + + unless ($val) { + $RT::Logger->error( "Couldn't set new priority value: $msg" ); + return (0, $msg); + } + return 1; +} + +eval "require RT::Action::LinearEscalate_Vendor"; +die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/LinearEscalate_Vendor.pm} ); +eval "require RT::Action::LinearEscalate_Local"; +die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/LinearEscalate_Local.pm} ); + +1; + +=head1 AUTHORS + +Kevin Riggle Ekevinr@bestpractical.comE + +Ruslan Zakirov Eruz@bestpractical.comE + +=cut diff --git a/rt/lib/RT/Action/Notify.pm b/rt/lib/RT/Action/Notify.pm index 82cad1e58..30238fd61 100755 --- a/rt/lib/RT/Action/Notify.pm +++ b/rt/lib/RT/Action/Notify.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,14 +45,16 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # package RT::Action::Notify; -require RT::Action::SendEmail; -use Mail::Address; + use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::SendEmail); +use warnings; +use base qw(RT::Action::SendEmail); + +use Email::Address; =head2 Prepare @@ -67,8 +69,6 @@ sub Prepare { $self->SUPER::Prepare(); } -# {{{ sub SetRecipients - =head2 SetRecipients Sets the recipients of this meesage to Owner, Requestor, AdminCc, Cc or All. @@ -79,73 +79,63 @@ Explicitly B notify the creator of the transaction by default sub SetRecipients { my $self = shift; - my $arg = $self->Argument; + my $ticket = $self->TicketObj; + my $arg = $self->Argument; $arg =~ s/\bAll\b/Owner,Requestor,AdminCc,Cc/; my ( @To, @PseudoTo, @Cc, @Bcc ); if ( $arg =~ /\bOtherRecipients\b/ ) { - if ( $self->TransactionObj->Attachments->First ) { - my @cc_addresses = Mail::Address->parse($self->TransactionObj->Attachments->First->GetHeader('RT-Send-Cc')); - foreach my $addr (@cc_addresses) { - push @Cc, $addr->address; - } - my @bcc_addresses = Mail::Address->parse($self->TransactionObj->Attachments->First->GetHeader('RT-Send-Bcc')); - - foreach my $addr (@bcc_addresses) { - push @Bcc, $addr->address; - } - + if ( my $attachment = $self->TransactionObj->Attachments->First ) { + push @Cc, map { $_->address } Email::Address->parse( + $attachment->GetHeader('RT-Send-Cc') + ); + push @Bcc, map { $_->address } Email::Address->parse( + $attachment->GetHeader('RT-Send-Bcc') + ); } } if ( $arg =~ /\bRequestor\b/ ) { - push ( @To, $self->TicketObj->Requestors->MemberEmailAddresses ); + push @To, $ticket->Requestors->MemberEmailAddresses; } - - if ( $arg =~ /\bCc\b/ ) { #If we have a To, make the Ccs, Ccs, otherwise, promote them to To if (@To) { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @Cc, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, $ticket->Cc->MemberEmailAddresses ); + push ( @Cc, $ticket->QueueObj->Cc->MemberEmailAddresses ); } else { - push ( @Cc, $self->TicketObj->Cc->MemberEmailAddresses ); - push ( @To, $self->TicketObj->QueueObj->Cc->MemberEmailAddresses ); + push ( @Cc, $ticket->Cc->MemberEmailAddresses ); + push ( @To, $ticket->QueueObj->Cc->MemberEmailAddresses ); } } - if ( ( $arg =~ /\bOwner\b/ ) - && ( $self->TicketObj->OwnerObj->id != $RT::Nobody->id ) ) - { - - # If we're not sending to Ccs or requestors, + if ( $arg =~ /\bOwner\b/ && $ticket->OwnerObj->id != $RT::Nobody->id ) { + # If we're not sending to Ccs or requestors, # then the Owner can be the To. if (@To) { - push ( @Bcc, $self->TicketObj->OwnerObj->EmailAddress ); + push ( @Bcc, $ticket->OwnerObj->EmailAddress ); } else { - push ( @To, $self->TicketObj->OwnerObj->EmailAddress ); + push ( @To, $ticket->OwnerObj->EmailAddress ); } } if ( $arg =~ /\bAdminCc\b/ ) { - push ( @Bcc, $self->TicketObj->AdminCc->MemberEmailAddresses ); - push ( @Bcc, $self->TicketObj->QueueObj->AdminCc->MemberEmailAddresses ); + push ( @Bcc, $ticket->AdminCc->MemberEmailAddresses ); + push ( @Bcc, $ticket->QueueObj->AdminCc->MemberEmailAddresses ); } - if ($RT::UseFriendlyToLine) { + if ( RT->Config->Get('UseFriendlyToLine') ) { unless (@To) { - push ( - @PseudoTo, - sprintf($RT::FriendlyToLineFormat, $arg, $self->TicketObj->id), - ); + push @PseudoTo, + sprintf RT->Config->Get('FriendlyToLineFormat'), $arg, $ticket->id; } } @@ -154,7 +144,7 @@ sub SetRecipients { #Strip the sender out of the To, Cc and AdminCc and set the # recipients fields used to build the message by the superclass. # unless a flag is set - if ($RT::NotifyActor) { + if (RT->Config->Get('NotifyActor')) { @{ $self->{'To'} } = @To; @{ $self->{'Cc'} } = @Cc; @{ $self->{'Bcc'} } = @Bcc; @@ -169,8 +159,6 @@ sub SetRecipients { } -# }}} - eval "require RT::Action::Notify_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/Notify_Vendor.pm}); eval "require RT::Action::Notify_Local"; diff --git a/rt/lib/RT/Action/NotifyAsComment.pm b/rt/lib/RT/Action/NotifyAsComment.pm index 215f453d3..b2eb5acd8 100755 --- a/rt/lib/RT/Action/NotifyAsComment.pm +++ b/rt/lib/RT/Action/NotifyAsComment.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,13 +45,13 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::NotifyAsComment; require RT::Action::Notify; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Notify); - +use warnings; +use base qw(RT::Action::Notify); =head2 SetReturnAddress diff --git a/rt/lib/RT/Action/NotifyGroup.pm b/rt/lib/RT/Action/NotifyGroup.pm new file mode 100644 index 000000000..6b830cb86 --- /dev/null +++ b/rt/lib/RT/Action/NotifyGroup.pm @@ -0,0 +1,209 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Action::NotifyGroup - RT Action that sends notifications to groups and/or users + +=head1 DESCRIPTION + +RT action module that allow you to notify particular groups and/or users. +Distribution is shipped with C script that +is command line tool for managing NotifyGroup scrip actions. For more +more info see its documentation. + +=cut + +package RT::Action::NotifyGroup; + +use strict; +use warnings; +use base qw(RT::Action::Notify); + +require RT::User; +require RT::Group; + +=head1 METHODS + +=head2 SetRecipients + +Sets the recipients of this message to Groups and/or Users. + +=cut + +sub SetRecipients { + my $self = shift; + + my $arg = $self->Argument; + foreach( $self->__SplitArg( $arg ) ) { + $self->_HandleArgument( $_ ); + } + + my $creator = $self->TransactionObj->CreatorObj->EmailAddress(); + unless( $RT::NotifyActor ) { + @{ $self->{'To'} } = grep ( !/^\Q$creator\E$/, @{ $self->{'To'} } ); + } + + $self->{'seen_ueas'} = {}; + + return 1; +} + +sub _HandleArgument { + my $self = shift; + my $instance = shift; + + if ( $instance !~ /\D/ ) { + my $obj = RT::Principal->new( $self->CurrentUser ); + $obj->Load( $instance ); + return $self->_HandlePrincipal( $obj ); + } + + my $group = RT::Group->new( $self->CurrentUser ); + $group->LoadUserDefinedGroup( $instance ); + # to check disabled and so on + return $self->_HandlePrincipal( $group->PrincipalObj ) + if $group->id; + + require Email::Address; + + my $user = RT::User->new( $self->CurrentUser ); + if ( $instance =~ /^$Email::Address::addr_spec$/ ) { + $user->LoadByEmail( $instance ); + return $self->__PushUserAddress( $instance ) + unless $user->id; + } else { + $user->Load( $instance ); + } + return $self->_HandlePrincipal( $user->PrincipalObj ) + if $user->id; + + $RT::Logger->error( + "'$instance' is not principal id, group name, user name," + ." user email address or any email address" + ); + + return; +} + +sub _HandlePrincipal { + my $self = shift; + my $obj = shift; + unless( $obj->id ) { + $RT::Logger->error( "Couldn't load principal #$obj" ); + return; + } + if( $obj->Disabled ) { + $RT::Logger->info( "Principal #$obj is disabled => skip" ); + return; + } + if( !$obj->PrincipalType ) { + $RT::Logger->crit( "Principal #$obj has empty type" ); + } elsif( lc $obj->PrincipalType eq 'user' ) { + $self->__HandleUserArgument( $obj->Object ); + } elsif( lc $obj->PrincipalType eq 'group' ) { + $self->__HandleGroupArgument( $obj->Object ); + } else { + $RT::Logger->info( "Principal #$obj has unsupported type" ); + } + return; +} + +sub __HandleUserArgument { + my $self = shift; + my $obj = shift; + + my $uea = $obj->EmailAddress; + unless( $uea ) { + $RT::Logger->warning( "User #". $obj->id ." has no email address" ); + return; + } + $self->__PushUserAddress( $uea ); +} + +sub __HandleGroupArgument { + my $self = shift; + my $obj = shift; + + my $members = $obj->UserMembersObj; + while( my $m = $members->Next ) { + $self->__HandleUserArgument( $m ); + } +} + +sub __SplitArg { + return grep length, map {s/^\s+//; s/\s+$//; $_} split /,/, $_[1]; +} + +sub __PushUserAddress { + my $self = shift; + my $uea = shift; + push @{ $self->{'To'} }, $uea unless $self->{'seen_ueas'}{ $uea }++; + return; +} + + +=head1 AUTHOR + +Ruslan U. Zakirov Eruz@bestpractical.comE + +L, F + +=cut + +eval "require RT::Action::NotifyGroup_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyGroup_Vendor.pm}) { + die $@; +}; + +eval "require RT::Action::NotifyGroup_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyGroup_Local.pm}) { + die $@; +}; + +1; diff --git a/rt/lib/RT/Action/NotifyGroupAsComment.pm b/rt/lib/RT/Action/NotifyGroupAsComment.pm new file mode 100644 index 000000000..bee0a01a1 --- /dev/null +++ b/rt/lib/RT/Action/NotifyGroupAsComment.pm @@ -0,0 +1,91 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Action::NotifyGroupAsComment - RT Action that sends notifications to groups and/or users as comment + +=head1 DESCRIPTION + +This is subclass of L that send comments instead of replies. +See C and L docs for more info. + +=cut + +package RT::Action::NotifyGroupAsComment; + +use strict; +use warnings; + +use RT::Action::NotifyGroup; + +use base qw(RT::Action::NotifyGroup); + +sub SetReturnAddress { + my $self = shift; + $self->{'comment'} = 1; + return $self->SUPER::SetReturnAddress( @_, is_comment => 1 ); +} + +=head1 AUTHOR + +Ruslan U. Zakirov Eruz@bestpractical.comE + +=cut + +eval "require RT::Action::NotifyGroupAsComment_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyGroupAsComment_Vendor.pm}) { + die $@; +}; + +eval "require RT::Action::NotifyGroupAsComment_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Action/NotifyGroupAsComment_Local.pm}) { + die $@; +}; + +1; diff --git a/rt/lib/RT/Action/RecordComment.pm b/rt/lib/RT/Action/RecordComment.pm index c0256d6d7..bac17e96e 100644 --- a/rt/lib/RT/Action/RecordComment.pm +++ b/rt/lib/RT/Action/RecordComment.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,11 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::RecordComment; -require RT::Action::Generic; +use base 'RT::Action'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Generic); =head1 NAME diff --git a/rt/lib/RT/Action/RecordCorrespondence.pm b/rt/lib/RT/Action/RecordCorrespondence.pm index 10a890e4e..044893b97 100644 --- a/rt/lib/RT/Action/RecordCorrespondence.pm +++ b/rt/lib/RT/Action/RecordCorrespondence.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,11 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::RecordCorrespondence; -require RT::Action::Generic; +use base 'RT::Action'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Generic); =head1 NAME diff --git a/rt/lib/RT/Action/ResolveMembers.pm b/rt/lib/RT/Action/ResolveMembers.pm index fab049b0a..ff826ccc1 100644 --- a/rt/lib/RT/Action/ResolveMembers.pm +++ b/rt/lib/RT/Action/ResolveMembers.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,15 +45,14 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # This Action will resolve all members of a resolved group ticket package RT::Action::ResolveMembers; -require RT::Action::Generic; +use base 'RT::Action'; require RT::Links; use strict; -use vars qw/@ISA/; -@ISA=qw(RT::Action::Generic); #Do what we need to do and send it out. diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index ed5ec4fd6..a09bd3e56 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,20 +45,21 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Portions Copyright 2000 Tobias Brox package RT::Action::SendEmail; -require RT::Action::Generic; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Generic); +use warnings; -use MIME::Words qw(encode_mimeword); +use base qw(RT::Action); use RT::EmailParser; -use Mail::Address; -use Date::Format qw(strftime); +use RT::Interface::Email; +use Email::Address; +our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); + =head1 NAME @@ -68,53 +69,85 @@ RT::Action::AutoReply is a good example subclass. =head1 SYNOPSIS - require RT::Action::SendEmail; - @ISA = qw(RT::Action::SendEmail); - + use base 'RT::Action::SendEmail'; =head1 DESCRIPTION Basically, you create another module RT::Action::YourAction which ISA RT::Action::SendEmail. -=begin testing +=head1 METHODS -ok (require RT::Action::SendEmail); +=head2 CleanSlate -=end testing +Cleans class-wide options, like L or L. +=cut -=head1 AUTHOR - -Jesse Vincent and Tobias Brox +sub CleanSlate { + my $self = shift; + $self->SquelchMailTo(undef); + $self->AttachTickets(undef); +} -=head1 SEE ALSO +=head2 Commit -perl(1). +Sends the prepared message and writes outgoing record into DB if the feature is +activated in the config. =cut -# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) +sub Commit { + my $self = shift; + $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail'); + my $message = $self->TemplateObj->MIMEObj; -# {{{ sub Commit + my $orig_message; + if ( RT->Config->Get('RecordOutgoingEmail') + && RT->Config->Get('GnuPG')->{'Enable'} ) + { -sub Commit { - # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's - # ability to pass @_ to a 'post' routine. - my $self = $_[0]; + # it's hacky, but we should know if we're going to crypt things + my $attachment = $self->TransactionObj->Attachments->First; + + my %crypt; + foreach my $argument (qw(Sign Encrypt)) { + if ( $attachment + && defined $attachment->GetHeader("X-RT-$argument") ) + { + $crypt{$argument} = $attachment->GetHeader("X-RT-$argument"); + } else { + $crypt{$argument} = $self->TicketObj->QueueObj->$argument(); + } + } + if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) { + $orig_message = $message->dup; + } + } - my ($ret) = $self->SendMessage( $self->TemplateObj->MIMEObj ); - if ( $ret > 0 ) { - $self->RecordOutgoingMailTransaction( $self->TemplateObj->MIMEObj ) - if ($RT::RecordOutgoingEmail); + my ($ret) = $self->SendMessage($message); + if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) { + if ($orig_message) { + $message->attach( + Type => 'application/x-rt-original-message', + Disposition => 'inline', + Data => $orig_message->as_string, + ); + } + $self->RecordOutgoingMailTransaction($message); + $self->RecordDeferredRecipients(); } - return (abs $ret); + + + return ( abs $ret ); } -# }}} +=head2 Prepare + +Builds an outgoing email we're going to send using scrip's template. -# {{{ sub Prepare +=cut sub Prepare { my $self = shift; @@ -136,116 +169,116 @@ sub Prepare { $self->RemoveInappropriateRecipients(); my %seen; - foreach my $type qw(To Cc Bcc) { - @{ $self->{ $type } } = - grep defined && length && !$seen{ lc $_ }++, - @{ $self->{ $type } }; + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + @{ $self->{$type} } + = grep defined && length && !$seen{ lc $_ }++, + @{ $self->{$type} }; } # Go add all the Tos, Ccs and Bccs that we need to to the message to # make it happy, but only if we actually have values in those arrays. - # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc +# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc - $self->SetHeader( 'To', join ( ', ', @{ $self->{'To'} } ) ) - if ( ! $MIMEObj->head->get('To') && $self->{'To'} && @{ $self->{'To'} } ); - $self->SetHeader( 'Cc', join ( ', ', @{ $self->{'Cc'} } ) ) - if ( !$MIMEObj->head->get('Cc') && $self->{'Cc'} && @{ $self->{'Cc'} } ); - $self->SetHeader( 'Bcc', join ( ', ', @{ $self->{'Bcc'} } ) ) - if ( !$MIMEObj->head->get('Bcc') && $self->{'Bcc'} && @{ $self->{'Bcc'} } ); + for my $header (@EMAIL_RECIPIENT_HEADERS) { - # PseudoTo (fake to headers) shouldn't get matched for message recipients. + $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) ) + if ( !$MIMEObj->head->get($header) + && $self->{$header} + && @{ $self->{$header} } ); +} + # PseudoTo (fake to headers) shouldn't get matched for message recipients. # If we don't have any 'To' header (but do have other recipients), drop in # the pseudo-to header. - $self->SetHeader( 'To', join ( ', ', @{ $self->{'PseudoTo'} } ) ) - if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } ) - and ( !$MIMEObj->head->get('To') ) ) and ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc')); + $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) ) + if $self->{'PseudoTo'} + && @{ $self->{'PseudoTo'} } + && !$MIMEObj->head->get('To') + && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') ); # We should never have to set the MIME-Version header $self->SetHeader( 'MIME-Version', '1.0' ); # fsck.com #5959: Since RT sends 8bit mail, we should say so. - $self->SetHeader( 'Content-Transfer-Encoding','8bit'); + $self->SetHeader( 'Content-Transfer-Encoding', '8bit' ); # For security reasons, we only send out textual mails. - my @parts = $MIMEObj; - while (my $part = shift @parts) { - if ($part->is_multipart) { - push @parts, $part->parts; - } - else { - if ( RT::I18N::IsTextualContentType( $part->mime_type ) ) { - $part->head->mime_attr( "Content-Type" => $part->mime_type ) - } else { - $part->head->mime_attr( "Content-Type" => 'text/plain' ); - } - $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); - } + foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) { + my $type = $part->mime_type || 'text/plain'; + $type = 'text/plain' unless RT::I18N::IsTextualContentType($type); + $part->head->mime_attr( "Content-Type" => $type ); + $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); } - - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, + RT->Config->Get('EmailOutputEncoding'), + 'mime_words_ok', ); # Build up a MIME::Entity that looks like the original message. - $self->AddAttachments() if ( $MIMEObj->head->get('RT-Attach-Message') ); + $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message') + && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) ); + + $self->AddTickets; + + my $attachment = $self->TransactionObj->Attachments->First; + if ($attachment + && !( + $attachment->GetHeader('X-RT-Encrypt') + || $self->TicketObj->QueueObj->Encrypt + ) + ) + { + $attachment->SetHeader( 'X-RT-Encrypt' => 1 ) + if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq + 'Success'; + } return $result; - } -# }}} - -# }}} - - - =head2 To -Returns an array of Mail::Address objects containing all the To: recipients for this notification +Returns an array of L objects containing all the To: recipients for this notification =cut sub To { my $self = shift; - return ($self->_AddressesFromHeader('To')); + return ( $self->AddressesFromHeader('To') ); } =head2 Cc -Returns an array of Mail::Address objects containing all the Cc: recipients for this notification +Returns an array of L objects containing all the Cc: recipients for this notification =cut -sub Cc { +sub Cc { my $self = shift; - return ($self->_AddressesFromHeader('Cc')); + return ( $self->AddressesFromHeader('Cc') ); } =head2 Bcc -Returns an array of Mail::Address objects containing all the Bcc: recipients for this notification +Returns an array of L objects containing all the Bcc: recipients for this notification =cut - sub Bcc { my $self = shift; - return ($self->_AddressesFromHeader('Bcc')); + return ( $self->AddressesFromHeader('Bcc') ); } -sub _AddressesFromHeader { - my $self = shift; - my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); - my @addresses = Mail::Address->parse($header); +sub AddressesFromHeader { + my $self = shift; + my $field = shift; + my $header = $self->TemplateObj->MIMEObj->head->get($field); + my @addresses = Email::Address->parse($header); return (@addresses); } - -# {{{ SendMessage - =head2 SendMessage MIMEObj sends the message using RT's preferred API. @@ -254,6 +287,7 @@ TODO: Break this out to a separate module =cut sub SendMessage { + # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's # ability to pass @_ to a 'post' routine. my ( $self, $MIMEObj ) = @_; @@ -262,36 +296,36 @@ sub SendMessage { chomp $msgid; $self->ScripActionObj->{_Message_ID}++; - - $RT::Logger->info( $msgid . " #" - . $self->TicketObj->id . "/" - . $self->TransactionObj->id - . " - Scrip " - . $self->ScripObj->id . " " - . $self->ScripObj->Description ); - - #If we don't have any recipients to send to, don't send a message; - unless ( $MIMEObj->head->get('To') - || $MIMEObj->head->get('Cc') - || $MIMEObj->head->get('Bcc') ) - { - $RT::Logger->info( $msgid . " No recipients found. Not sending.\n" ); - return (-1); - } - unless ($MIMEObj->head->get('Date')) { - # We coerce localtime into an array since strftime has a flawed prototype that only accepts - # a list - $MIMEObj->head->replace(Date => strftime('%a, %d %b %Y %H:%M:%S %z', @{[localtime()]})); - } + $RT::Logger->info( $msgid . " #" + . $self->TicketObj->id . "/" + . $self->TransactionObj->id + . " - Scrip " + . ($self->ScripObj->id || '#rule'). " " + . ( $self->ScripObj->Description || '' ) ); + + my $status = RT::Interface::Email::SendEmail( + Entity => $MIMEObj, + Ticket => $self->TicketObj, + Transaction => $self->TransactionObj, + ); - return (0) unless ($self->OutputMIMEObject($MIMEObj)); + + return $status unless ($status > 0 || exists $self->{'Deferred'}); my $success = $msgid . " sent "; - foreach( qw(To Cc Bcc) ) { + foreach (@EMAIL_RECIPIENT_HEADERS) { my $recipients = $MIMEObj->head->get($_); - $success .= " $_: ". $recipients if $recipients; + $success .= " $_: " . $recipients if $recipients; } + + if( exists $self->{'Deferred'} ) { + for (qw(daily weekly susp)) { + $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } ) + if exists $self->{'Deferred'}{ $_ }; + } + } + $success =~ s/\n//g; $RT::Logger->info($success); @@ -299,140 +333,166 @@ sub SendMessage { return (1); } +=head2 AddAttachments -=head2 OutputMIMEObject MIME::Entity - -Sends C as an email message according to RT's mailer configuration. - -=cut - +Takes any attachments to this transaction and attaches them to the message +we're building. +=cut -sub OutputMIMEObject { +sub AddAttachments { my $self = shift; - my $MIMEObj = shift; - - my $msgid = $MIMEObj->head->get('Message-ID'); - chomp $msgid; - - my $SendmailArguments = $RT::SendmailArguments; - if (defined $RT::VERPPrefix && defined $RT::VERPDomain) { - my $EnvelopeFrom = $self->TransactionObj->CreatorObj->EmailAddress; - $EnvelopeFrom =~ s/@/=/g; - $EnvelopeFrom =~ s/\s//g; - $SendmailArguments .= " -f ${RT::VERPPrefix}${EnvelopeFrom}\@${RT::VERPDomain}"; - } - - if ( $RT::MailCommand eq 'sendmailpipe' ) { - eval { - # don't ignore CHLD signal to get proper exit code - local $SIG{'CHLD'} = 'DEFAULT'; + my $MIMEObj = $self->TemplateObj->MIMEObj; - my $mail; - unless( open $mail, "|$RT::SendmailPath $SendmailArguments" ) { - die "Couldn't run $RT::SendmailPath: $!"; - } + $MIMEObj->head->delete('RT-Attach-Message'); - # if something wrong with $mail->print we will get PIPE signal, handle it - local $SIG{'PIPE'} = sub { die "$RT::SendmailPath closed pipe" }; - $MIMEObj->print($mail); + my $attachments = RT::Attachments->new($RT::SystemUser); + $attachments->Limit( + FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id + ); - unless ( close $mail ) { - die "Close failed: $!" if $!; # system error - # sendmail exit statuses mostly errors with data not software - # TODO: status parsing: core dump, exit on signal or EX_* - $RT::Logger->warning( "$RT::SendmailPath exitted with status $?" ); - } - }; - if ($@) { - $RT::Logger->crit( $msgid . "Could not send mail: " . $@ ); - return 0; - } - } - else { - my @mailer_args = ($RT::MailCommand); - my $method = 'send'; + # Don't attach anything blank + $attachments->LimitNotEmpty; + $attachments->OrderBy( FIELD => 'id' ); - local $ENV{MAILADDRESS}; + # We want to make sure that we don't include the attachment that's + # being used as the "Content" of this message" unless that attachment's + # content type is not like text/... + my $transaction_content_obj = $self->TransactionObj->ContentObj; - if ( $RT::MailCommand eq 'sendmail' ) { - push @mailer_args, split(/\s+/, $SendmailArguments); - } - elsif ( $RT::MailCommand eq 'smtp' ) { - $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From'); - push @mailer_args, ( Host => $RT::SMTPServer ); - push @mailer_args, ( Debug => $RT::SMTPDebug ); - $method = 'smtpsend'; - } - else { - push @mailer_args, $RT::MailParams; + if ( $transaction_content_obj + && $transaction_content_obj->ContentType =~ m{text/}i ) + { + # If this was part of a multipart/alternative, skip all of the kids + my $parent = $transaction_content_obj->ParentObj; + if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'parent', + OPERATOR => '!=', + VALUE => $parent->Id, + ); + } else { + $attachments->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'id', + OPERATOR => '!=', + VALUE => $transaction_content_obj->Id, + ); } + } - unless ( $MIMEObj->$method(@mailer_args) ) { - $RT::Logger->crit( $msgid . "Could not send mail." ); - return (0); + # attach any of this transaction's attachments + my $seen_attachment = 0; + while ( my $attach = $attachments->Next ) { + if ( !$seen_attachment ) { + $MIMEObj->make_multipart( 'mixed', Force => 1 ); + $seen_attachment = 1; } + $self->AddAttachment($attach); } - return 1; } -# }}} - -# {{{ AddAttachments +=head2 AddAttachment $attachment -=head2 AddAttachments - -Takes any attachments to this transaction and attaches them to the message +Takes one attachment object of L class and attaches it to the message we're building. =cut +sub AddAttachment { + my $self = shift; + my $attach = shift; + my $MIMEObj = shift || $self->TemplateObj->MIMEObj; + + $MIMEObj->attach( + Type => $attach->ContentType, + Charset => $attach->OriginalEncoding, + Data => $attach->OriginalContent, + Filename => $self->MIMEEncodeString( $attach->Filename ), + 'RT-Attachment:' => $self->TicketObj->Id . "/" + . $self->TransactionObj->Id . "/" + . $attach->id, + Encoding => '-SUGGEST', + ); +} -sub AddAttachments { - my $self = shift; +=head2 AttachTickets [@IDs] - my $MIMEObj = $self->TemplateObj->MIMEObj; +Returns or set list of ticket's IDs that should be attached to an outgoing message. - $MIMEObj->head->delete('RT-Attach-Message'); +B this method works as a class method and setup things global, so you have to +clean list by passing undef as argument. - my $attachments = RT::Attachments->new($RT::SystemUser); - $attachments->Limit( - FIELD => 'TransactionId', - VALUE => $self->TransactionObj->Id - ); - $attachments->OrderBy( FIELD => 'id'); - - my $transaction_content_obj = $self->TransactionObj->ContentObj; +=cut - # attach any of this transaction's attachments - while ( my $attach = $attachments->Next ) { +{ + my $list = []; - # Don't attach anything blank - next unless ( $attach->ContentLength ); - -# We want to make sure that we don't include the attachment that's being used as the "Content" of this message. - next - if ( $transaction_content_obj - && $transaction_content_obj->Id == $attach->Id - && $transaction_content_obj->ContentType =~ qr{text/plain}i ); - $MIMEObj->make_multipart('mixed'); - $MIMEObj->attach( - Type => $attach->ContentType, - Charset => $attach->OriginalEncoding, - Data => $attach->OriginalContent, - Filename => $self->MIMEEncodeString( $attach->Filename, - $RT::EmailOutputEncoding ), - 'RT-Attachment:' => $self->TicketObj->Id."/".$self->TransactionObj->Id."/".$attach->id, - Encoding => '-SUGGEST' - ); + sub AttachTickets { + my $self = shift; + $list = [ grep defined, @_ ] if @_; + return @$list; } +} + +=head2 AddTickets + +Attaches tickets to the current message, list of tickets' ids get from +L method. +=cut + +sub AddTickets { + my $self = shift; + $self->AddTicket($_) foreach $self->AttachTickets; + return; } -# }}} +=head2 AddTicket $ID -# {{{ RecordOutgoingMailTransaction +Attaches a ticket with ID to the message. + +Each ticket is attached as multipart entity and all its messages and attachments +are attached as sub entities in order of creation, but only if transaction type +is Create or Correspond. + +=cut + +sub AddTicket { + my $self = shift; + my $tid = shift; + + # XXX: we need a current user here, but who is current user? + my $attachs = RT::Attachments->new($RT::SystemUser); + my $txn_alias = $attachs->TransactionAlias; + $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); + $attachs->Limit( + ALIAS => $txn_alias, + FIELD => 'Type', + VALUE => 'Correspond' + ); + $attachs->LimitByTicket($tid); + $attachs->LimitNotEmpty; + $attachs->OrderBy( FIELD => 'Created' ); + + my $ticket_mime = MIME::Entity->build( + Type => 'multipart/mixed', + Top => 0, + Description => "ticket #$tid", + ); + while ( my $attachment = $attachs->Next ) { + $self->AddAttachment( $attachment, $ticket_mime ); + } + if ( $ticket_mime->parts ) { + my $email_mime = $self->TemplateObj->MIMEObj; + $email_mime->make_multipart; + $email_mime->add_part($ticket_mime); + } + return; +} =head2 RecordOutgoingMailTransaction MIMEObj @@ -440,12 +500,9 @@ Record a transaction in RT with this outgoing message for future record-keeping =cut - - sub RecordOutgoingMailTransaction { - my $self = shift; + my $self = shift; my $MIMEObj = shift; - my @parts = $MIMEObj->parts; my @attachments; @@ -453,26 +510,28 @@ sub RecordOutgoingMailTransaction { foreach my $part (@parts) { my $attach = $part->head->get('RT-Attachment'); if ($attach) { - $RT::Logger->debug("We found an attachment. we want to not record it."); + $RT::Logger->debug( + "We found an attachment. we want to not record it."); push @attachments, $attach; } else { $RT::Logger->debug("We found a part. we want to record it."); push @keep, $part; } } - $MIMEObj->parts(\@keep); + $MIMEObj->parts( \@keep ); foreach my $attachment (@attachments) { - $MIMEObj->head->add('RT-Attachment', $attachment); + $MIMEObj->head->add( 'RT-Attachment', $attachment ); } RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); - my $transaction = RT::Transaction->new($self->TransactionObj->CurrentUser); + my $transaction + = RT::Transaction->new( $self->TransactionObj->CurrentUser ); - # XXX: TODO -> Record attachments as references to things in the attachments table, maybe. +# XXX: TODO -> Record attachments as references to things in the attachments table, maybe. my $type; - if ($self->TransactionObj->Type eq 'Comment') { + if ( $self->TransactionObj->Type eq 'Comment' ) { $type = 'CommentEmailRecord'; } else { $type = 'EmailRecord'; @@ -489,19 +548,15 @@ sub RecordOutgoingMailTransaction { ActivateScrips => 0 ); - if( $id ) { - $self->{'OutgoingMailTransaction'} = $id; + if ($id) { + $self->{'OutgoingMailTransaction'} = $id; } else { - $RT::Logger->warning( "Could not record outgoing message transaction: $msg" ); + $RT::Logger->warning( + "Could not record outgoing message transaction: $msg"); } return $id; } -# }}} -# - -# {{{ sub SetRTSpecialHeaders - =head2 SetRTSpecialHeaders This routine adds all the random headers that RT wants in a mail message @@ -514,161 +569,266 @@ sub SetRTSpecialHeaders { $self->SetSubject(); $self->SetSubjectToken(); - $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding ) - if ($RT::EmailOutputEncoding); + $self->SetHeaderAsEncoding( 'Subject', + RT->Config->Get('EmailOutputEncoding') ) + if ( RT->Config->Get('EmailOutputEncoding') ); $self->SetReturnAddress(); $self->SetReferencesHeaders(); - unless ($self->TemplateObj->MIMEObj->head->get('Message-ID')) { - # Get Message-ID for this txn - my $msgid = ""; - $msgid = $self->TransactionObj->Message->First->GetHeader("RT-Message-ID") - || $self->TransactionObj->Message->First->GetHeader("Message-ID") - if $self->TransactionObj->Message && $self->TransactionObj->Message->First; + unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) { - # If there is one, and we can parse it, then base our Message-ID on it - if ($msgid - and $msgid =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\Q$RT::Organization\E>$/ + # Get Message-ID for this txn + my $msgid = ""; + if ( my $msg = $self->TransactionObj->Message->First ) { + $msgid = $msg->GetHeader("RT-Message-ID") + || $msg->GetHeader("Message-ID"); + } + + # If there is one, and we can parse it, then base our Message-ID on it + if ( $msgid + and $msgid + =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/ "<$1." . $self->TicketObj->id . "-" . $self->ScripObj->id . "-" . $self->ScripActionObj->{_Message_ID} - . "@" . $RT::Organization . ">"/eg - and $2 == $self->TicketObj->id) { - $self->SetHeader( "Message-ID" => $msgid ); - } else { - $self->SetHeader( 'Message-ID', - "TicketObj->id . "-" - . $self->ScripObj->id . "-" # Scrip - . $self->ScripActionObj->{_Message_ID} . "@" # Email sent - . $RT::Organization - . ">" ); - } + . "@" . RT->Config->Get('Organization') . ">"/eg + and $2 == $self->TicketObj->id + ) + { + $self->SetHeader( "Message-ID" => $msgid ); + } else { + $self->SetHeader( + 'Message-ID' => RT::Interface::Email::GenMessageId( + Ticket => $self->TicketObj, + Scrip => $self->ScripObj, + ScripAction => $self->ScripActionObj + ), + ); + } } $self->SetHeader( 'Precedence', "bulk" ) - unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ); + unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ); - $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname ); + $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); $self->SetHeader( 'RT-Ticket', - $RT::rtname . " #" . $self->TicketObj->id() ); + RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); $self->SetHeader( 'Managed-by', "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); - $self->SetHeader( 'RT-Originator', - $self->TransactionObj->CreatorObj->EmailAddress ); +# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be +# refactored into user's method. + if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress ) { + $self->SetHeader( 'RT-Originator', $email ); + } } -# }}} +sub DeferDigestRecipients { + my $self = shift; + $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id ); + + # The digest attribute will be an array of notifications that need to + # be sent for this transaction. The array will have the following + # format for its objects. + # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc} + # -> sent -> {true|false} + # The "sent" flag will be used by the cron job to indicate that it has + # run on this transaction. + # In a perfect world we might move this hash construction to the + # extension module itself. + my $digest_hash = {}; + + foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) { + # If we have a "PseudoTo", the "To" contains it, so we don't need to access it + next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) ); + $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) ); + + # Store the 'daily digest' folk in an array. + my ( @send_now, @daily_digest, @weekly_digest, @suspended ); + + # Have to get the list of addresses directly from the MIME header + # at this point. + $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); + foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { + next unless $rcpt; + my $user_obj = RT::User->new($RT::SystemUser); + $user_obj->LoadByEmail($rcpt); + if ( ! $user_obj->id ) { + # If there's an email address in here without an associated + # RT user, pass it on through. + $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail."); + push( @send_now, $rcpt ); + next; + } -# }}} + my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; + $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); -# {{{ RemoveInappropriateRecipients + if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) } + elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) } + elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) } + else { push( @send_now, $rcpt ) } + } -=head2 RemoveInappropriateRecipients + # Reset the relevant mail field. + $RT::Logger->debug( "Removing deferred recipients from $mailfield: line"); + if (@send_now) { + $self->SetHeader( $mailfield, join( ', ', @send_now ) ); + } else { # No recipients! Remove the header. + $self->TemplateObj->MIMEObj->head->delete($mailfield); + } -Remove addresses that are RT addresses or that are on this transaction's blacklist + # Push the deferred addresses into the appropriate field in + # our attribute hash, with the appropriate mail header. + $RT::Logger->debug( + "Setting deferred recipients for attribute creation"); + $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest); + $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest); + $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended); + } -=cut + if ( scalar keys %$digest_hash ) { -sub RemoveInappropriateRecipients { + # Save the hash so that we can add it as an attribute to the + # outgoing email transaction. + $self->{'Deferred'} = $digest_hash; + } else { + $RT::Logger->debug( "No recipients found for deferred delivery on " + . "transaction #" + . $self->TransactionObj->id ); + } +} + + + +sub RecordDeferredRecipients { my $self = shift; + return unless exists $self->{'Deferred'}; + + my $txn_id = $self->{'OutgoingMailTransaction'}; + return unless $txn_id; - my $msgid = $self->TemplateObj->MIMEObj->head->get ('Message-Id'); + my $txn_obj = RT::Transaction->new( $self->CurrentUser ); + $txn_obj->Load( $txn_id ); + my( $ret, $msg ) = $txn_obj->AddAttribute( + Name => 'DeferredRecipients', + Content => $self->{'Deferred'} + ); + $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) + unless $ret; + return ($ret,$msg); +} +=head2 SquelchMailTo [@ADDRESSES] - my @blacklist; +Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses. +To empty list pass undefined argument. + +B that this method can be called as class method and works globaly. Don't forget to +clean this list when blocking is not required anymore, pass undef to do this. + +=cut - my @types = qw/To Cc Bcc/; +{ + my $squelch = []; - # Weed out any RT addresses. We really don't want to talk to ourselves! - foreach my $type (@types) { - @{ $self->{$type} } = - RT::EmailParser::CullRTAddresses( "", @{ $self->{$type} } ); + sub SquelchMailTo { + my $self = shift; + if (@_) { + $squelch = [ grep defined, @_ ]; + } + return @$squelch; } +} + +=head2 RemoveInappropriateRecipients + +Remove addresses that are RT addresses or that are on this transaction's blacklist + +=cut + +sub RemoveInappropriateRecipients { + my $self = shift; + + my @blacklist = (); # If there are no recipients, don't try to send the message. # If the transaction has content and has the header RT-Squelch-Replies-To - if ( $self->TransactionObj->Attachments->First() ) { - if ( - $self->TransactionObj->Attachments->First->GetHeader( - 'RT-DetectedAutoGenerated') - ) - { + my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); + if ( my $attachment = $self->TransactionObj->Attachments->First ) { + + if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { # What do we want to do with this? It's probably (?) a bounce # caused by one of the watcher addresses being broken. # Default ("true") is to redistribute, for historical reasons. - if ( !$RT::RedistributeAutoGeneratedMessages ) { + if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { # Don't send to any watchers. - @{ $self->{'To'} } = (); - @{ $self->{'Cc'} } = (); - @{ $self->{'Bcc'} } = (); - - $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message based on site configuration.\n"); - } - elsif ( $RT::RedistributeAutoGeneratedMessages eq 'privileged' ) { + @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message based on site configuration." + ); + } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq + 'privileged' ) + { # Only send to "privileged" watchers. - # - - foreach my $type (@types) { - + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { foreach my $addr ( @{ $self->{$type} } ) { my $user = RT::User->new($RT::SystemUser); $user->LoadByEmail($addr); - @{ $self->{$type} } = - grep ( !/^\Q$addr\E$/, @{ $self->{$type} } ) - if ( !$user->Privileged ); - + push @blacklist, $addr if ( !$user->Privileged ); } } - $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message to unprivileged users based on site configuration.\n"); - + $RT::Logger->info( $msgid + . " The incoming message was autogenerated. " + . "Not redistributing this message to unprivileged users based on site configuration." + ); } - } - my $squelch = - $self->TransactionObj->Attachments->First->GetHeader( - 'RT-Squelch-Replies-To'); - - if ($squelch) { - @blacklist = split( /,/, $squelch ); + if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { + push @blacklist, split( /,/, $squelch ); } } - # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist - my @non_recipients = $self->TicketObj->SquelchMailTo; - foreach my $attribute (@non_recipients) { - push @blacklist, $attribute->Content; - } +# Let's grab the SquelchMailTo attribue and push those entries into the @blacklist + push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo; + push @blacklist, $self->SquelchMailTo; # Cycle through the people we're sending to and pull out anyone on the # system blacklist - foreach my $person_to_yank (@blacklist) { - $person_to_yank =~ s/\s//g; - foreach my $type (@types) { - @{ $self->{$type} } = - grep ( !/^\Q$person_to_yank\E$/, @{ $self->{$type} } ); + # Trim leading and trailing spaces. + @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist)); + + foreach my $type (@EMAIL_RECIPIENT_HEADERS) { + my @addrs; + foreach my $addr ( @{ $self->{$type} } ) { + + # Weed out any RT addresses. We really don't want to talk to ourselves! + # If we get a reply back, that means it's not an RT address + if ( !RT::EmailParser->CullRTAddresses($addr) ) { + $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); + next; + } + if ( grep /^\Q$addr\E$/, @blacklist ) { + $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); + next; + } + push @addrs, $addr; } + @{ $self->{$type} } = @addrs; } } -# }}} -# {{{ sub SetReturnAddress - =head2 SetReturnAddress is_comment => BOOLEAN Calculate and set From and Reply-To headers based on the is_comment flag. @@ -680,6 +840,7 @@ sub SetReturnAddress { my $self = shift; my %args = ( is_comment => 0, + friendly_name => undef, @_ ); @@ -689,33 +850,35 @@ sub SetReturnAddress { if ( $args{'is_comment'} ) { $replyto = $self->TicketObj->QueueObj->CommentAddress - || $RT::CommentAddress; - } - else { + || RT->Config->Get('CommentAddress'); + } else { $replyto = $self->TicketObj->QueueObj->CorrespondAddress - || $RT::CorrespondAddress; + || RT->Config->Get('CorrespondAddress'); } unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { - if ($RT::UseFriendlyFromLine) { - my $friendly_name = $self->TransactionObj->CreatorObj->RealName - || $self->TransactionObj->CreatorObj->Name; - if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string - $friendly_name = $1; + if ( RT->Config->Get('UseFriendlyFromLine') ) { + my $friendly_name = $args{friendly_name}; + + unless ( $friendly_name ) { + $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName; + if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string + $friendly_name = $1; + } } $friendly_name =~ s/"/\\"/g; $self->SetHeader( 'From', sprintf( - $RT::FriendlyFromLineFormat, - $self->MIMEEncodeString( $friendly_name, - $RT::EmailOutputEncoding ), + RT->Config->Get('FriendlyFromLineFormat'), + $self->MIMEEncodeString( + $friendly_name, RT->Config->Get('EmailOutputEncoding') + ), $replyto ), ); - } - else { + } else { $self->SetHeader( 'From', $replyto ); } } @@ -726,10 +889,6 @@ sub SetReturnAddress { } -# }}} - -# {{{ sub SetHeader - =head2 SetHeader FIELD, VALUE Set the FIELD of the current MIME object into VALUE. @@ -743,20 +902,16 @@ sub SetHeader { chomp $val; chomp $field; - $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 ); - $self->TemplateObj->MIMEObj->head->replace( $field, $val ); - return $self->TemplateObj->MIMEObj->head->get($field); + my $head = $self->TemplateObj->MIMEObj->head; + $head->fold_length( $field, 10000 ); + $head->replace( $field, $val ); + return $head->get($field); } -# }}} - - -# {{{ sub SetSubject - =head2 SetSubject -This routine sets the subject. it does not add the rt tag. that gets done elsewhere -If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get +This routine sets the subject. it does not add the rt tag. That gets done elsewhere +If subject is already defined via template, it uses that. otherwise, it tries to get the transaction's subject. =cut @@ -765,39 +920,29 @@ sub SetSubject { my $self = shift; my $subject; - my $message = $self->TransactionObj->Attachments; if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { return (); } + + my $message = $self->TransactionObj->Attachments; + $message->RowsPerPage(1); if ( $self->{'Subject'} ) { $subject = $self->{'Subject'}; + } elsif ( my $first = $message->First ) { + my $tmp = $first->GetHeader('Subject'); + $subject = defined $tmp ? $tmp : $self->TicketObj->Subject; + } else { + $subject = $self->TicketObj->Subject; } - elsif ( ( $message->First() ) && ( $message->First->Headers ) ) { - my $header = $message->First->Headers(); - $header =~ s/\n\s+/ /g; - if ( $header =~ /^Subject: (.*?)$/m ) { - $subject = $1; - } - else { - $subject = $self->TicketObj->Subject(); - } - - } - else { - $subject = $self->TicketObj->Subject(); - } + $subject = '' unless defined $subject; + chomp $subject; - $subject =~ s/(\r\n|\n|\s)/ /gi; + $subject =~ s/(\r\n|\n|\s)/ /g; - chomp $subject; $self->SetHeader( 'Subject', $subject ); } -# }}} - -# {{{ sub SetSubjectToken - =head2 SetSubjectToken This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. @@ -806,22 +951,16 @@ This routine fixes the RT tag in the subject. It's unlikely that you want to ove sub SetSubjectToken { my $self = shift; - my $sub = $self->TemplateObj->MIMEObj->head->get('Subject'); - my $id = $self->TicketObj->id; - - my $token_re = $RT::EmailSubjectTagRegex; - $token_re = qr/\Q$RT::rtname\E/o unless $token_re; - return if $sub =~ /\[$token_re\s+#$id\]/; - $sub =~ s/(\r\n|\n|\s)/ /gi; - chomp $sub; - $self->TemplateObj->MIMEObj->head->replace( - Subject => "[$RT::rtname #$id] $sub", + my $head = $self->TemplateObj->MIMEObj->head; + $head->replace( + Subject => RT::Interface::Email::AddSubjectTag( + Encode::decode_utf8( $head->get('Subject') ), + $self->TicketObj, + ), ); } -# }}} - =head2 SetReferencesHeaders Set References and In-Reply-To headers for this message. @@ -829,18 +968,14 @@ Set References and In-Reply-To headers for this message. =cut sub SetReferencesHeaders { - my $self = shift; my ( @in_reply_to, @references, @msgid ); - my $attachments = $self->TransactionObj->Message; - - if ( my $top = $attachments->First() ) { - @in_reply_to = split(/\s+/m, $top->GetHeader('In-Reply-To') || ''); - @references = split(/\s+/m, $top->GetHeader('References') || '' ); - @msgid = split(/\s+/m, $top->GetHeader('Message-ID') || ''); - } - else { + if ( my $top = $self->TransactionObj->Message->First ) { + @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' ); + @references = split( /\s+/m, $top->GetHeader('References') || '' ); + @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' ); + } else { return (undef); } @@ -848,53 +983,54 @@ sub SetReferencesHeaders { # the RT Web UI, and hence we want to *not* append its Message-ID # to the References and In-Reply-To. OR it came from an outside # source, and we should treat it as per the RFC - if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@$RT::Organization>/) { + my $org = RT->Config->Get('Organization'); + if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) { + + # Make all references which are internal be to version which we + # have sent out - # Make all references which are internal be to version which we - # have sent out - for (@references, @in_reply_to) { - s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@$RT::Organization>$/ + for ( @references, @in_reply_to ) { + s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/ "<$1." . $self->TicketObj->id . "-" . $self->ScripObj->id . "-" . $self->ScripActionObj->{_Message_ID} . - "@" . $RT::Organization . ">"/eg - } + "@" . $org . ">"/eg + } - # In reply to whatever the internal message was in reply to - $self->SetHeader( 'In-Reply-To', join( " ", ( @in_reply_to ))); + # In reply to whatever the internal message was in reply to + $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); - # Default the references to whatever we're in reply to - @references = @in_reply_to unless @references; + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; - # References are unchanged from internal + # References are unchanged from internal } else { - # In reply to that message - $self->SetHeader( 'In-Reply-To', join( " ", ( @msgid ))); - # Default the references to whatever we're in reply to - @references = @in_reply_to unless @references; + # In reply to that message + $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) ); - # Push that message onto the end of the references - push @references, @msgid; + # Default the references to whatever we're in reply to + @references = @in_reply_to unless @references; + + # Push that message onto the end of the references + push @references, @msgid; } # Push pseudo-ref to the front my $pseudo_ref = $self->PseudoReference; - @references = ($pseudo_ref, grep { $_ ne $pseudo_ref } @references); + @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); # If there are more than 10 references headers, remove all but the # first four and the last six (Gotta keep this from growing # forever) - splice(@references, 4, -6) if ($#references >= 10); + splice( @references, 4, -6 ) if ( $#references >= 10 ); # Add on the references - $self->SetHeader( 'References', join( " ", @references) ); + $self->SetHeader( 'References', join( " ", @references ) ); $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); } -# }}} - =head2 PseudoReference Returns a fake Message-ID: header for the ticket to allow a base level of threading @@ -904,13 +1040,13 @@ Returns a fake Message-ID: header for the ticket to allow a base level of thread sub PseudoReference { my $self = shift; - my $pseudo_ref = 'TicketObj->id .'@'.$RT::Organization .'>'; + my $pseudo_ref + = 'TicketObj->id . '@' + . RT->Config->Get('Organization') . '>'; return $pseudo_ref; } - -# {{{ SetHeadingAsEncoding - =head2 SetHeaderAsEncoding($field_name, $charset_encoding) This routine converts the field into specified charset encoding. @@ -921,86 +1057,37 @@ sub SetHeaderAsEncoding { my $self = shift; my ( $field, $enc ) = ( shift, shift ); - if ($field eq 'From' and $RT::SMTPFrom) { - $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom ); - return; - } - - my $value = $self->TemplateObj->MIMEObj->head->get($field); - - $value = $self->MIMEEncodeString($value, $enc); + my $head = $self->TemplateObj->MIMEObj->head; - $self->TemplateObj->MIMEObj->head->replace( $field, $value ); + if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { + $head->replace( $field, RT->Config->Get('SMTPFrom') ); + return; + } + my $value = $head->get( $field ); + $value = $self->MIMEEncodeString( $value, $enc ); + $head->replace( $field, $value ); -} -# }}} +} -# {{{ MIMEEncodeString +=head2 MIMEEncodeString -=head2 MIMEEncodeString STRING ENCODING +Takes a perl string and optional encoding pass it over +L. -Takes a string and a possible encoding and returns the string wrapped in MIME goo. +Basicly encode a string using B encoding according to RFC2047. =cut sub MIMEEncodeString { - my $self = shift; - my $value = shift; - # using RFC2047 notation, sec 2. - # encoded-word = "=?" charset "?" encoding "?" encoded-text "?=" - my $charset = shift; - my $encoding = 'B'; - # An 'encoded-word' may not be more than 75 characters long - # - # MIME encoding increases 4/3*(number of bytes), and always in multiples - # of 4. Thus we have to find the best available value of bytes available - # for each chunk. - # - # First we get the integer max which max*4/3 would fit on space. - # Then we find the greater multiple of 3 lower or equal than $max. - my $max = int(((75-length('=?'.$charset.'?'.$encoding.'?'.'?='))*3)/4); - $max = int($max/3)*3; - - chomp $value; - - if ( $max <= 0 ) { - # gives an error... - $RT::Logger->crit("Can't encode! Charset or encoding too big.\n"); - return ($value); - } - - return ($value) unless $value =~ /[^\x20-\x7e]/; - - $value =~ s/\s*$//; - - # we need perl string to split thing char by char - Encode::_utf8_on($value) unless Encode::is_utf8( $value ); - - my ($tmp, @chunks) = ('', ()); - while ( length $value ) { - my $char = substr($value, 0, 1, ''); - my $octets = Encode::encode( $charset, $char ); - if ( length($tmp) + length($octets) > $max ) { - push @chunks, $tmp; - $tmp = ''; - } - $tmp .= $octets; - } - push @chunks, $tmp if length $tmp; - - # encode an join chuncks - $value = join "\n ", - map encode_mimeword( $_, $encoding, $charset ), @chunks ; - return($value); + my $self = shift; + return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); } -# }}} - eval "require RT::Action::SendEmail_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm}); +die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm} ); eval "require RT::Action::SendEmail_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm}); +die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm} ); 1; diff --git a/rt/lib/RT/Action/SetPriority.pm b/rt/lib/RT/Action/SetPriority.pm index b4c8ee199..9b0838926 100644 --- a/rt/lib/RT/Action/SetPriority.pm +++ b/rt/lib/RT/Action/SetPriority.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,12 +45,11 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Action::SetPriority; -require RT::Action::Generic; +use base 'RT::Action'; use strict; -use vars qw/@ISA/; -@ISA=qw(RT::Action::Generic); #Do what we need to do and send it out. diff --git a/rt/lib/RT/Action/UserDefined.pm b/rt/lib/RT/Action/UserDefined.pm index 7bf6eee51..80ef49224 100644 --- a/rt/lib/RT/Action/UserDefined.pm +++ b/rt/lib/RT/Action/UserDefined.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,14 +45,11 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - package RT::Action::UserDefined; -use RT::Action::Generic; +use base 'RT::Action'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Action::Generic); =head2 Prepare diff --git a/rt/lib/RT/Approval.pm b/rt/lib/RT/Approval.pm new file mode 100644 index 000000000..c381ba1d2 --- /dev/null +++ b/rt/lib/RT/Approval.pm @@ -0,0 +1,74 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval; +use strict; +use warnings; + +use RT::Ruleset; + +RT::Ruleset->Add( + Name => 'Approval', + Rules => [ + 'RT::Approval::Rule::NewPending', + 'RT::Approval::Rule::Rejected', + 'RT::Approval::Rule::Passed', + 'RT::Approval::Rule::Created', + ]); + +eval "require RT::Approval_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Approval_Vendor.pm}) { + die $@; +}; + +eval "require RT::Approval_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Approval_Local.pm}) { + die $@; +}; + +1; diff --git a/rt/lib/RT/Approval/Rule.pm b/rt/lib/RT/Approval/Rule.pm new file mode 100644 index 000000000..37ca478d4 --- /dev/null +++ b/rt/lib/RT/Approval/Rule.pm @@ -0,0 +1,85 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval::Rule; +use strict; +use warnings; + +use base 'RT::Rule'; + +use constant _Queue => '___Approvals'; + +sub Prepare { + my $self = shift; + return unless $self->SUPER::Prepare(); + $self->TicketObj->Type eq 'approval'; +} + +sub GetTemplate { + my ($self, $template_name, %args) = @_; + my $template = RT::Template->new($self->CurrentUser); + $template->Load($template_name) or return; + my ($result, $msg) = $template->Parse(%args); + + # XXX: error handling + + return $template; +} + +eval "require RT::Approval::Rule_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Approval/Rule_Vendor.pm}) { + die $@; +}; + +eval "require RT::Approval::Rule_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Approval/Rule_Local.pm}) { + die $@; +}; + +1; + diff --git a/rt/lib/RT/Approval/Rule/Created.pm b/rt/lib/RT/Approval/Rule/Created.pm new file mode 100644 index 000000000..73ba2db32 --- /dev/null +++ b/rt/lib/RT/Approval/Rule/Created.pm @@ -0,0 +1,71 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval::Rule::Created; +use strict; +use warnings; +use base 'RT::Approval::Rule'; + +use constant _Stage => 'TransactionBatch'; + +use constant Description => "Notify Owner of their ticket has been approved by some or all approvers"; # loc + +sub Prepare { + my $self = shift; + return unless $self->SUPER::Prepare(); + + $self->TransactionObj->Type eq 'Create' && + !$self->TicketObj->HasUnresolvedDependencies( Type => 'approval' ); +} + +sub Commit { + my $self = shift; + $self->RunScripAction('Open Tickets' => 'Blank'); +} + +1; diff --git a/rt/lib/RT/Approval/Rule/NewPending.pm b/rt/lib/RT/Approval/Rule/NewPending.pm new file mode 100644 index 000000000..5a6f1ed16 --- /dev/null +++ b/rt/lib/RT/Approval/Rule/NewPending.pm @@ -0,0 +1,97 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval::Rule::NewPending; +use strict; +use warnings; +use base 'RT::Approval::Rule'; + +use constant Description => "When an approval ticket is created, notify the Owner and AdminCc of the item awaiting their approval"; # loc + +sub Prepare { + my $self = shift; + return unless $self->SUPER::Prepare(); + + $self->OnStatusChange('open') and + eval { $T::Approving = ($self->TicketObj->AllDependedOnBy( Type => 'ticket' ))[0] } +} + +sub Commit { + my $self = shift; + my ($top) = $self->TicketObj->AllDependedOnBy( Type => 'ticket' ); + my $t = $self->TicketObj->Transactions; + my $to; + while ( my $o = $t->Next ) { + $to = $o, last if $o->Type eq 'Create'; + } + + # XXX: this makes the owner incorrect so notify owner won't work + # local $self->{TicketObj} = $top; + + # first txn entry of the approval ticket + local $self->{TransactionObj} = $to; + $self->RunScripAction('Notify Owner', 'New Pending Approval', @_); + + return; + + # this generates more correct content of the message, but not sure + # if ccmessageto is the right way to do this. + my $template = $self->GetTemplate('New Pending Approval', + TicketObj => $top, + TransactionObj => $to) + or return; + + my ( $result, $msg ) = $template->Parse( + TicketObj => $top, + ); + $self->TicketObj->Comment( CcMessageTo => $self->TicketObj->OwnerObj->EmailAddress, + MIMEObj => $template->MIMEObj ); + +} + +1; diff --git a/rt/lib/RT/Approval/Rule/Passed.pm b/rt/lib/RT/Approval/Rule/Passed.pm new file mode 100644 index 000000000..3134019bf --- /dev/null +++ b/rt/lib/RT/Approval/Rule/Passed.pm @@ -0,0 +1,110 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval::Rule::Passed; +use strict; +use warnings; +use base 'RT::Approval::Rule'; + +use constant Description => "Notify Owner of their ticket has been approved by some or all approvers"; # loc + +sub Prepare { + my $self = shift; + return unless $self->SUPER::Prepare(); + + $self->OnStatusChange('resolved'); +} + +sub Commit { + my $self = shift; + my $note; + my $t = $self->TicketObj->Transactions; + + while ( my $o = $t->Next ) { + next unless $o->Type eq 'Correspond'; + $note .= $o->Content . "\n" if $o->ContentObj; + } + + my ($top) = $self->TicketObj->AllDependedOnBy( Type => 'ticket' ); + my $links = $self->TicketObj->DependedOnBy; + + while ( my $link = $links->Next ) { + my $obj = $link->BaseObj; + next unless $obj->Type eq 'approval'; + + for my $other ($obj->AllDependsOn( Type => 'approval' )) { + if ( $other->QueueObj->IsActiveStatus( $other->Status ) ) { + $other->__Set( + Field => 'Status', + Value => 'deleted', + ); + } + + } + $obj->SetStatus( Status => 'open', Force => 1 ); + } + + my $passed = !$top->HasUnresolvedDependencies( Type => 'approval' ); + my $template = $self->GetTemplate( + $passed ? 'All Approvals Passed' : 'Approval Passed', + TicketObj => $top, + Approval => $self->TicketObj, + Notes => $note, + ) or die; + + $top->Correspond( MIMEObj => $template->MIMEObj ); + + if ($passed) { + $self->RunScripAction('Notify Owner', 'Approval Ready for Owner', + TicketObj => $top); + } + + return; +} + +1; diff --git a/rt/lib/RT/Approval/Rule/Rejected.pm b/rt/lib/RT/Approval/Rule/Rejected.pm new file mode 100644 index 000000000..7353f635d --- /dev/null +++ b/rt/lib/RT/Approval/Rule/Rejected.pm @@ -0,0 +1,114 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Approval::Rule::Rejected; +use strict; +use warnings; +use base 'RT::Approval::Rule'; + +use constant Description => "If an approval is rejected, reject the original and delete pending approvals"; # loc + +sub Prepare { + my $self = shift; + return unless $self->SUPER::Prepare(); + + return (0) + unless $self->OnStatusChange('rejected') or $self->OnStatusChange('deleted') +} + +sub Commit { # XXX: from custom prepare code + my $self = shift; + if ( my ($rejected) = + $self->TicketObj->AllDependedOnBy( Type => 'ticket' ) ) { + my $note = ''; + if ( RT->Config->Get('ApprovalRejectionNotes') ) { + my $t = $self->TicketObj->Transactions; + while ( my $o = $t->Next ) { + next unless $o->Type eq 'Correspond'; + $note .= $o->Content . "\n" if $o->ContentObj; + } + } + + my $template = $self->GetTemplate('Approval Rejected', + TicketObj => $rejected, + Approval => $self->TicketObj, + Notes => $note); + + $rejected->Correspond( MIMEObj => $template->MIMEObj ); + $rejected->SetStatus( + Status => 'rejected', + Force => 1, + ); + } + my $links = $self->TicketObj->DependedOnBy; + foreach my $link ( @{ $links->ItemsArrayRef } ) { + my $obj = $link->BaseObj; + if ( $obj->QueueObj->IsActiveStatus( $obj->Status ) ) { + if ( $obj->Type eq 'approval' ) { + $obj->SetStatus( + Status => 'deleted', + Force => 1, + ); + } + } + } + + $links = $self->TicketObj->DependsOn; + foreach my $link ( @{ $links->ItemsArrayRef } ) { + my $obj = $link->TargetObj; + if ( $obj->QueueObj->IsActiveStatus( $obj->Status ) ) { + $obj->SetStatus( + Status => 'deleted', + Force => 1, + ); + } + } + +} + +1; diff --git a/rt/lib/RT/Attachment.pm b/rt/lib/RT/Attachment.pm index f0a19874c..4327238e6 100755 --- a/rt/lib/RT/Attachment.pm +++ b/rt/lib/RT/Attachment.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/Attachment_Overlay.pm b/rt/lib/RT/Attachment_Overlay.pm index 7ab6d0ae9..1d508c0fe 100644 --- a/rt/lib/RT/Attachment_Overlay.pm +++ b/rt/lib/RT/Attachment_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,10 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} -=head1 SYNOPSIS - use RT::Attachment; +=head1 SYNOPSIS + use RT::Attachment; =head1 DESCRIPTION @@ -56,15 +56,9 @@ This module should never be instantiated directly by client code. it's an intern module which should only be instantiated through exported APIs in Ticket, Queue and other similar objects. - =head1 METHODS -=begin testing - -ok (require RT::Attachment); - -=end testing =cut @@ -74,13 +68,12 @@ package RT::Attachment; use strict; no warnings qw(redefine); +use RT::Transaction; use MIME::Base64; use MIME::QuotedPrint; - -# {{{ sub _OverlayAccessible sub _OverlayAccessible { - { + { TransactionId => { 'read'=>1, 'public'=>1, 'write' => 0 }, MessageId => { 'read'=>1, 'write' => 0 }, Parent => { 'read'=>1, 'write' => 0 }, @@ -94,32 +87,6 @@ sub _OverlayAccessible { Created => { 'read'=>1, 'auto'=>1, }, }; } -# }}} - -# {{{ sub TransactionObj - -=head2 TransactionObj - -Returns the transaction object asscoiated with this attachment. - -=cut - -sub TransactionObj { - require RT::Transaction; - my $self=shift; - unless (exists $self->{_TransactionObj}) { - $self->{_TransactionObj}=RT::Transaction->new($self->CurrentUser); - $self->{_TransactionObj}->Load($self->TransactionId); - } - unless ($self->{_TransactionObj}->Id) { - $RT::Logger->crit("Attachment ".$self->id." can't find transaction ".$self->TransactionId." which it is ostensibly part of. That's bad"); - } - return $self->{_TransactionObj}; -} - -# }}} - -# {{{ sub Create =head2 Create @@ -139,20 +106,19 @@ sub Create { Attachment => undef, @_ ); - #For ease of reference + # For ease of reference my $Attachment = $args{'Attachment'}; - #if we didn't specify a ticket, we need to bail - if ( $args{'TransactionId'} == 0 ) { - $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction\n" ); + # if we didn't specify a ticket, we need to bail + unless ( $args{'TransactionId'} ) { + $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" ); return (0); - } - #If we possibly can, collapse it to a singlepart + # If we possibly can, collapse it to a singlepart $Attachment->make_singlepart; - #Get the subject + # Get the subject my $Subject = $Attachment->head->get( 'subject', 0 ); defined($Subject) or $Subject = ''; chomp($Subject); @@ -161,27 +127,30 @@ sub Create { my $MessageId = $Attachment->head->get( 'Message-ID', 0 ); defined($MessageId) or $MessageId = ''; chomp ($MessageId); - $MessageId =~ s/^<(.*)>$/$1/go; - + $MessageId =~ s/^<(.*?)>$/$1/o; #Get the filename my $Filename = $Attachment->head->recommended_filename; + # MIME::Head doesn't support perl strings well and can return + # octets which later will be double encoded in low-level code + my $head = $Attachment->head->as_string; + utf8::decode( $head ); + # If a message has no bodyhandle, that means that it has subparts (or appears to) # and we should act accordingly. unless ( defined $Attachment->bodyhandle ) { - - my $id = $self->SUPER::Create( + my ($id) = $self->SUPER::Create( TransactionId => $args{'TransactionId'}, - Parent => 0, + Parent => $args{'Parent'}, ContentType => $Attachment->mime_type, - Headers => $Attachment->head->as_string, + Headers => $head, MessageId => $MessageId, - Subject => $Subject + Subject => $Subject, ); - + unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr); } foreach my $part ( $Attachment->parts ) { @@ -192,7 +161,7 @@ sub Create { Attachment => $part, ); unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); } } return ($id); @@ -201,69 +170,115 @@ sub Create { #If it's not multipart else { - my ($ContentEncoding, $Body) = $self->_EncodeLOB( $Attachment->bodyhandle->as_string, - $Attachment->mime_type - ); + my ($ContentEncoding, $Body) = $self->_EncodeLOB( + $Attachment->bodyhandle->as_string, + $Attachment->mime_type + ); + my $id = $self->SUPER::Create( TransactionId => $args{'TransactionId'}, ContentType => $Attachment->mime_type, ContentEncoding => $ContentEncoding, Parent => $args{'Parent'}, - Headers => $Attachment->head->as_string, + Headers => $head, Subject => $Subject, Content => $Body, Filename => $Filename, MessageId => $MessageId, ); + unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); } - - return ($id); + return $id; } } -# }}} - - =head2 Import Create an attachment exactly as specified in the named parameters. =cut - sub Import { my $self = shift; - my %args = ( ContentEncoding => 'none', + my %args = ( ContentEncoding => 'none', @_ ); - @_ ); + ( $args{'ContentEncoding'}, $args{'Content'} ) = + $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} ); + return ( $self->SUPER::Create(%args) ); +} - ($args{'ContentEncoding'}, $args{'Content'}) = $self->_EncodeLOB($args{'Content'}, $args{'MimeType'}); +=head2 TransactionObj - return($self->SUPER::Create(%args)); +Returns the transaction object asscoiated with this attachment. + +=cut + +sub TransactionObj { + my $self = shift; + + unless ( $self->{_TransactionObj} ) { + $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser ); + $self->{_TransactionObj}->Load( $self->TransactionId ); + } + + unless ($self->{_TransactionObj}->Id) { + $RT::Logger->crit( "Attachment ". $self->id + ." can't find transaction ". $self->TransactionId + ." which it is ostensibly part of. That's bad"); + } + return $self->{_TransactionObj}; } -# {{{ sub Content +=head2 ParentObj -=head2 Content +Returns a parent's L object if this attachment +has a parent, otherwise returns undef. -Returns the attachment's content. if it's base64 encoded, decode it -before returning it. +=cut + +sub ParentObj { + my $self = shift; + return undef unless $self->Parent; + + my $parent = RT::Attachment->new( $self->CurrentUser ); + $parent->LoadById( $self->Parent ); + return $parent; +} + +=head2 Children + +Returns an L object which is preloaded with +all attachments objects with this attachment\'s Id as their +C. =cut -sub Content { - my $self = shift; - $self->_DecodeLOB($self->ContentType, $self->ContentEncoding, $self->_Value('Content', decode_utf8 => 0)); +sub Children { + my $self = shift; + + my $kids = RT::Attachments->new( $self->CurrentUser ); + $kids->ChildrenOf( $self->Id ); + return($kids); } +=head2 Content -# }}} +Returns the attachment's content. if it's base64 encoded, decode it +before returning it. +=cut -# {{{ sub OriginalContent +sub Content { + my $self = shift; + return $self->_DecodeLOB( + $self->ContentType, + $self->ContentEncoding, + $self->_Value('Content', decode_utf8 => 0), + ); +} =head2 OriginalContent @@ -274,43 +289,37 @@ original encoding. =cut sub OriginalContent { - my $self = shift; - - return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); - - my $enc = $self->OriginalEncoding; - - my $content; - if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) { - $content = $self->_Value('Content', decode_utf8 => 0); - } elsif ( $self->ContentEncoding eq 'base64' ) { - $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); - } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { - $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); - } else { - return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); - } - - # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. - local $@; - Encode::_utf8_off($content); - - if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { - # If we somehow fail to do the decode, at least push out the raw bits - eval {return( Encode::decode_utf8($content))} || return ($content); - } - - eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; - if ($@) { - $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); - } - return $content; -} + my $self = shift; -# }}} + return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); + my $enc = $self->OriginalEncoding; + my $content; + if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { + $content = $self->_Value('Content', decode_utf8 => 0); + } elsif ( $self->ContentEncoding eq 'base64' ) { + $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); + } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { + $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); + } else { + return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); + } + + # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. + local $@; + Encode::_utf8_off($content); -# {{{ sub OriginalEncoding + if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { + # If we somehow fail to do the decode, at least push out the raw bits + eval { return( Encode::decode_utf8($content)) } || return ($content); + } + + eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; + if ($@) { + $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); + } + return $content; +} =head2 OriginalEncoding @@ -319,35 +328,34 @@ Returns the attachment's original encoding. =cut sub OriginalEncoding { - my $self = shift; - return $self->GetHeader('X-RT-Original-Encoding'); + my $self = shift; + return $self->GetHeader('X-RT-Original-Encoding'); } -# }}} - -# {{{ sub Children - -=head2 Children +=head2 ContentLength - Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent' +Returns length of L in bytes. =cut -sub Children { +sub ContentLength { my $self = shift; - - my $kids = new RT::Attachments($self->CurrentUser); - $kids->ChildrenOf($self->Id); - return($kids); -} - -# }}} -# {{{ UTILITIES + return undef unless $self->TransactionObj->CurrentUserCanSee; -# {{{ sub Quote + my $len = $self->GetHeader('Content-Length'); + unless ( defined $len ) { + use bytes; + no warnings 'uninitialized'; + $len = length($self->Content); + $self->SetHeader('Content-Length' => $len); + } + return $len; +} +=head2 Quote +=cut sub Quote { my $self=shift; @@ -399,9 +407,64 @@ sub Quote { return (\$body, $max); } -# }}} -# {{{ sub NiceHeaders - pulls out only the most relevant headers +=head2 ContentAsMIME + +Returns MIME entity built from this attachment. + +=cut + +sub ContentAsMIME { + my $self = shift; + + my $entity = new MIME::Entity; + foreach my $header ($self->SplitHeaders) { + my ($h_key, $h_val) = split /:/, $header, 2; + $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) ); + } + + use MIME::Body; + $entity->bodyhandle( + MIME::Body::Scalar->new( $self->OriginalContent ) + ); + + return $entity; +} + + +=head2 Addresses + +Returns a hashref of all addresses related to this attachment. +The keys of the hash are C, C, C, C, C +and C. The values are references to lists of +L objects. + +=cut + +sub Addresses { + my $self = shift; + + my %data = (); + my $current_user_address = lc $self->CurrentUser->EmailAddress; + my $correspond = lc $self->TransactionObj->TicketObj->QueueObj->CorrespondAddress; + my $comment = lc $self->TransactionObj->TicketObj->QueueObj->CommentAddress; + foreach my $hdr (qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc)) { + my @Addresses; + my $line = $self->GetHeader($hdr); + + foreach my $AddrObj ( Email::Address->parse( $line )) { + my $address = $AddrObj->address; + $address = lc RT::User->CanonicalizeEmailAddress($address); + next if ( $current_user_address eq $address ); + next if ( $comment eq $address ); + next if ( $correspond eq $address ); + next if ( RT::EmailParser->IsRTAddress($address) ); + push @Addresses, $AddrObj ; + } + $data{$hdr} = \@Addresses; + } + return \%data; +} =head2 NiceHeaders @@ -420,34 +483,37 @@ sub NiceHeaders { } return $hdrs; } -# }}} - -# {{{ sub Headers =head2 Headers Returns this object's headers as a string. This method specifically removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc. We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send -out mail. (The mailing rules are separated from the ticket update code by -an abstraction barrier that makes it impossible to pass this data directly +out mail. The mailing rules are separated from the ticket update code by +an abstraction barrier that makes it impossible to pass this data directly. =cut sub Headers { - my $self = shift; - my $hdrs=""; - my @headers = grep { !/^RT-Send-Bcc/i } $self->_SplitHeaders; - return join("\n",@headers); - + return join("\n", $_[0]->SplitHeaders); } +=head2 EncodedHeaders -# }}} +Takes encoding as argument and returns the attachment's headers as octets in encoded +using the encoding. -# {{{ sub GetHeader +This is not protection using quoted printable or base64 encoding. -=head2 GetHeader ( 'Tag') +=cut + +sub EncodedHeaders { + my $self = shift; + my $encoding = shift || 'utf8'; + return Encode::encode( $encoding, $self->Headers ); +} + +=head2 GetHeader $TAG Returns the value of the header Tag as a string. This bypasses the weeding out done in Headers() above. @@ -458,17 +524,52 @@ sub GetHeader { my $self = shift; my $tag = shift; foreach my $line ($self->_SplitHeaders) { - if ($line =~ /^\Q$tag\E:\s+(.*)$/si) { #if we find the header, return its value - return ($1); - } + next unless $line =~ /^\Q$tag\E:\s+(.*)$/si; + + #if we find the header, return its value + return ($1); } # we found no header. return an empty string return undef; } -# }}} -# {{{ sub SetHeader +=head2 DelHeader $TAG + +Delete a field from the attachment's headers. + +=cut + +sub DelHeader { + my $self = shift; + my $tag = shift; + + my $newheader = ''; + foreach my $line ($self->_SplitHeaders) { + next if $line =~ /^\Q$tag\E:\s+(.*)$/is; + $newheader .= "$line\n"; + } + return $self->__Set( Field => 'Headers', Value => $newheader); +} + +=head2 AddHeader $TAG, $VALUE, ... + +Add one or many fields to the attachment's headers. + +=cut + +sub AddHeader { + my $self = shift; + + my $newheader = $self->__Value( 'Headers' ); + while ( my ($tag, $value) = splice @_, 0, 2 ) { + $value = '' unless defined $value; + $value =~ s/\s+$//s; + $value =~ s/\r+\n/\n /g; + $newheader .= "$tag: $value\n"; + } + return $self->__Set( Field => 'Headers', Value => $newheader); +} =head2 SetHeader ( 'Tag', 'Value' ) @@ -479,8 +580,8 @@ Replace or add a Header to the attachment's headers. sub SetHeader { my $self = shift; my $tag = shift; - my $newheader = ''; + my $newheader = ''; foreach my $line ($self->_SplitHeaders) { if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) { $newheader .= "$tag: $_[0]\n"; @@ -494,80 +595,26 @@ sub SetHeader { $newheader .= "$tag: $_[0]\n" if defined $tag; $self->__Set( Field => 'Headers', Value => $newheader); } -# }}} -# {{{ sub _Value +=head2 SplitHeaders -=head2 _Value +Returns an array of this attachment object's headers, with one header +per array entry. Multiple lines are folded. -Takes the name of a table column. -Returns its value as a string, if the user passes an ACL check +B returns C field. =cut -sub _Value { - - my $self = shift; - my $field = shift; - - #if the field is public, return it. - if ( $self->_Accessible( $field, 'public' ) ) { - return ( $self->__Value( $field, @_ ) ); - } - - #If it's a comment, we need to be extra special careful - elsif ( $self->TransactionObj->Type =~ /^Comment/ ) { - if ( $self->TransactionObj->CurrentUserHasRight('ShowTicketComments') ) - { - return ( $self->__Value( $field, @_ ) ); - } - } - elsif ( $self->TransactionObj->CurrentUserHasRight('ShowTicket') ) { - return ( $self->__Value( $field, @_ ) ); - } - - #if they ain't got rights to see, don't let em - else { - return (undef); - } - +sub SplitHeaders { + my $self = shift; + return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) ); } -# }}} - =head2 _SplitHeaders Returns an array of this attachment object's headers, with one header per array entry. multiple lines are folded. -=begin testing - -my $test1 = "From: jesse"; -my @headers = RT::Attachment->_SplitHeaders($test1); -is ($#headers, 0, $test1 ); - -my $test2 = qq{From: jesse -To: bobby -Subject: foo -}; - -@headers = RT::Attachment->_SplitHeaders($test2); -is ($#headers, 2, "testing a bunch of singline multiple headers" ); - - -my $test3 = qq{From: jesse -To: bobby, - Suzie, - Sally, - Joey: bizzy, -Subject: foo -}; - -@headers = RT::Attachment->_SplitHeaders($test3); -is ($#headers, 2, "testing a bunch of singline multiple headers" ); - - -=end testing =cut @@ -583,35 +630,130 @@ sub _SplitHeaders { } -sub ContentLength { +sub Encrypt { my $self = shift; - unless ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and - ($self->TransactionObj->Type eq 'Comment') ) or - ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) { - return undef; + my $txn = $self->TransactionObj; + return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; + return (0, $self->loc('Permission Denied')) + unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); + return (0, $self->loc('GnuPG integration is disabled')) + unless RT->Config->Get('GnuPG')->{'Enable'}; + return (0, $self->loc('Attachments encryption is disabled')) + unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'}; + + require RT::Crypt::GnuPG; + + my $type = $self->ContentType; + if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + return (1, $self->loc('Already encrypted')); + } elsif ( $type =~ /^multipart\//i ) { + return (1, $self->loc('No need to encrypt')); + } else { + $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"}; } - if (my $len = $self->GetHeader('Content-Length')) { - return $len; + my $queue = $txn->TicketObj->QueueObj; + my $encrypt_for; + foreach my $address ( grep $_, + $queue->CorrespondAddress, + $queue->CommentAddress, + RT->Config->Get('CorrespondAddress'), + RT->Config->Get('CommentAddress'), + ) { + my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' ); + next if $res{'exit_code'} || !$res{'info'}; + %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address ); + next if $res{'exit_code'} || !$res{'info'}; + $encrypt_for = $address; + } + unless ( $encrypt_for ) { + return (0, $self->loc('No key suitable for encryption')); } - { - use bytes; - my $len = length($self->Content); - $self->SetHeader('Content-Length' => $len); - return $len; + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + + my $content = $self->Content; + my %res = RT::Crypt::GnuPG::SignEncryptContent( + Content => \$content, + Sign => 0, + Encrypt => 1, + Recipients => [ $encrypt_for ], + ); + if ( $res{'exit_code'} ) { + return (0, $self->loc('GnuPG error. Contact with administrator')); } + + my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); + unless ( $status ) { + return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg)); + } + return (1, $self->loc('Successfuly encrypted data')); } -# }}} +sub Decrypt { + my $self = shift; + + my $txn = $self->TransactionObj; + return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; + return (0, $self->loc('Permission Denied')) + unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); + return (0, $self->loc('GnuPG integration is disabled')) + unless RT->Config->Get('GnuPG')->{'Enable'}; + + require RT::Crypt::GnuPG; + + my $type = $self->ContentType; + if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + ($type) = ($type =~ /original-type="(.*)"/i); + $type ||= 'application/octeat-stream'; + } else { + return (1, $self->loc('Is not encrypted')); + } + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + + my $content = $self->Content; + my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, ); + if ( $res{'exit_code'} ) { + return (0, $self->loc('GnuPG error. Contact with administrator')); + } + + my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); + unless ( $status ) { + return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg)); + } + return (1, $self->loc('Successfuly decrypted data')); +} + +=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' ) ) { + return ( $self->__Value( $field, @_ ) ); + } + + return undef unless $self->TransactionObj->CurrentUserCanSee; + return $self->__Value( $field, @_ ); +} -# Transactions don't change. by adding this cache congif directiove, we don't lose pathalogically on long tickets. +# Transactions don't change. by adding this cache congif directiove, +# we don't lose pathalogically on long tickets. sub _CacheConfig { { - 'cache_p' => 1, - 'fast_update_p' => 1, - 'cache_for_sec' => 180, + 'cache_p' => 1, + 'fast_update_p' => 1, + 'cache_for_sec' => 180, } } diff --git a/rt/lib/RT/Attachments.pm b/rt/lib/RT/Attachments.pm index 44115492f..416cde6ba 100755 --- a/rt/lib/RT/Attachments.pm +++ b/rt/lib/RT/Attachments.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/Attachments_Overlay.pm b/rt/lib/RT/Attachments_Overlay.pm index cedceac52..83cc96d21 100644 --- a/rt/lib/RT/Attachments_Overlay.pm +++ b/rt/lib/RT/Attachments_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME RT::Attachments - a collection of RT::Attachment objects @@ -62,11 +63,6 @@ should only be accessed through exported APIs in Ticket, Queue and other similar =head1 METHODS -=begin testing - -ok (require RT::Attachments); - -=end testing =cut @@ -76,20 +72,48 @@ package RT::Attachments; use strict; no warnings qw(redefine); -# {{{ sub _Init +use RT::Attachment; + sub _Init { - my $self = shift; - - $self->{'table'} = "Attachments"; - $self->{'primary_key'} = "id"; - $self->OrderBy ( FIELD => 'id', - ORDER => 'ASC'); - return ( $self->SUPER::_Init(@_)); + my $self = shift; + $self->{'table'} = "Attachments"; + $self->{'primary_key'} = "id"; + $self->OrderBy( + FIELD => 'id', + ORDER => 'ASC', + ); + return $self->SUPER::_Init( @_ ); } -# }}} +sub CleanSlate { + my $self = shift; + delete $self->{_sql_transaction_alias}; + return $self->SUPER::CleanSlate( @_ ); +} + + +=head2 TransactionAlias -# {{{ sub ContentType +Returns alias for transactions table with applied join condition. +Always return the same alias, so if you want to build some complex +or recursive joining then you have to create new alias youself. + +=cut + +sub TransactionAlias { + my $self = shift; + return $self->{'_sql_transaction_alias'} + if $self->{'_sql_transaction_alias'}; + + my $res = $self->NewAlias('Transactions'); + $self->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'TransactionId', + VALUE => $res . '.id', + QUOTEVALUE => 0, + ); + return $self->{'_sql_transaction_alias'} = $res; +} =head2 ContentType (VALUE => 'text/plain', ENTRYAGGREGATOR => 'OR', OPERATOR => '=' ) @@ -99,20 +123,16 @@ Limit result set to attachments of ContentType 'TYPE'... sub ContentType { - my $self = shift; - my %args = ( VALUE => 'text/plain', - OPERATOR => '=', - ENTRYAGGREGATOR => 'OR', - @_); - - $self->Limit ( FIELD => 'ContentType', - VALUE => $args{'VALUE'}, - OPERATOR => $args{'OPERATOR'}, - ENTRYAGGREGATOR => $args{'ENTRYAGGREGATOR'}); + my $self = shift; + my %args = ( + VALUE => 'text/plain', + OPERATOR => '=', + ENTRYAGGREGATOR => 'OR', + @_ + ); + + return $self->Limit ( %args, FIELD => 'ContentType' ); } -# }}} - -# {{{ sub ChildrenOf =head2 ChildrenOf ID @@ -122,52 +142,101 @@ Limit result set to children of Attachment ID sub ChildrenOf { - my $self = shift; - my $attachment = shift; - $self->Limit ( FIELD => 'Parent', - VALUE => $attachment); + my $self = shift; + my $attachment = shift; + return $self->Limit( + FIELD => 'Parent', + VALUE => $attachment + ); +} + +=head2 LimitNotEmpty + +Limit result set to attachments with not empty content. + +=cut + +sub LimitNotEmpty { + my $self = shift; + $self->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'Content', + OPERATOR => 'IS NOT', + VALUE => 'NULL', + QUOTEVALUE => 0, + ); + + # http://rt3.fsck.com/Ticket/Display.html?id=12483 + if ( RT->Config->Get('DatabaseType') ne 'Oracle' ) { + $self->Limit( + ENTRYAGGREGATOR => 'AND', + FIELD => 'Content', + OPERATOR => '!=', + VALUE => '', + ); + } + return; +} + +=head2 LimitByTicket $ticket_id + +Limit result set to attachments of a ticket. + +=cut + +sub LimitByTicket { + my $self = shift; + my $tid = shift; + + my $transactions = $self->TransactionAlias; + $self->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $transactions, + FIELD => 'ObjectType', + VALUE => 'RT::Ticket', + ); + + my $tickets = $self->NewAlias('Tickets'); + $self->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $tickets, + FIELD => 'id', + VALUE => $transactions . '.ObjectId', + QUOTEVALUE => 0, + ); + $self->Limit( + ENTRYAGGREGATOR => 'AND', + ALIAS => $tickets, + FIELD => 'EffectiveId', + VALUE => $tid, + ); + return; } -# }}} # {{{ sub NewItem sub NewItem { my $self = shift; - - use RT::Attachment; - my $item = new RT::Attachment($self->CurrentUser); - return($item); + return RT::Attachment->new( $self->CurrentUser ); } # }}} # {{{ sub Next sub Next { my $self = shift; - - my $Attachment = $self->SUPER::Next(); - if ((defined($Attachment)) and (ref($Attachment))) { - if ($Attachment->TransactionObj->__Value('Type') =~ /^Comment/ && - $Attachment->TransactionObj->TicketObj->CurrentUserHasRight('ShowTicketComments')) { - return($Attachment); - } elsif ($Attachment->TransactionObj->__Value('Type') !~ /^Comment/ && - $Attachment->TransactionObj->TicketObj->CurrentUserHasRight('ShowTicket')) { - return($Attachment); - } - - #If the user doesn't have the right to show this ticket - else { - return($self->Next()); - } + + my $Attachment = $self->SUPER::Next; + return $Attachment unless $Attachment; + + my $txn = $Attachment->TransactionObj; + if ( $txn->__Value('Type') eq 'Comment' ) { + return $Attachment if $txn->CurrentUserHasRight('ShowTicketComments'); + } elsif ( $txn->CurrentUserHasRight('ShowTicket') ) { + return $Attachment; } - #if there never was any ticket - else { - return(undef); - } + # If the user doesn't have the right to show this ticket + return $self->Next; } # }}} - 1; - - - - +1; diff --git a/rt/lib/RT/Attribute.pm b/rt/lib/RT/Attribute.pm index e513c287c..dcdfd7f45 100644 --- a/rt/lib/RT/Attribute.pm +++ b/rt/lib/RT/Attribute.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/Attribute_Overlay.pm b/rt/lib/RT/Attribute_Overlay.pm index 72071f562..4d201da7a 100644 --- a/rt/lib/RT/Attribute_Overlay.pm +++ b/rt/lib/RT/Attribute_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Attribute; use strict; @@ -271,55 +272,23 @@ sub _SerializeContent { sub SetContent { my $self = shift; my $content = shift; - + # Call __Value to avoid ACL check. - if ($self->__Value('ContentType') eq 'storable') { - # We eval the serialization because it will lose on a coderef. - eval {$content = $self->_SerializeContent($content); }; - if ($@) { - $RT::Logger->error("For some reason, content couldn't be frozen"); - return(0, $@); - } + if ( $self->__Value('ContentType') eq 'storable' ) { + # We eval the serialization because it will lose on a coderef. + $content = eval { $self->_SerializeContent($content) }; + if ($@) { + $RT::Logger->error("Content couldn't be frozen: $@"); + return(0, "Content couldn't be frozen"); + } } - return ($self->SUPER::SetContent($content)); + return $self->SUPER::SetContent( $content ); } =head2 SubValue KEY Returns the subvalue for $key. -=begin testing - -my $user = $RT::SystemUser; -my ($id, $msg) = $user->AddAttribute(Name => 'SavedSearch', Content => { Query => 'Foo'} ); -ok ($id, $msg); -my $attr = RT::Attribute->new($RT::SystemUser); -$attr->Load($id); -ok($attr->Name eq 'SavedSearch'); -$attr->SetSubValues( Format => 'baz'); - -my $format = $attr->SubValue('Format'); -is ($format , 'baz'); - -$attr->SetSubValues( Format => 'bar'); -$format = $attr->SubValue('Format'); -is ($format , 'bar'); - -$attr->DeleteAllSubValues(); -$format = $attr->SubValue('Format'); -is ($format, undef); - -$attr->SetSubValues(Format => 'This is a format'); - -my $attr2 = RT::Attribute->new($RT::SystemUser); -$attr2->Load($id); -is ($attr2->SubValue('Format'), 'This is a format'); -$attr2->Delete; -my $attr3 = RT::Attribute->new($RT::SystemUser); -my ($id) = $attr3->Load($id); -is ($id, 0); - -=end testing =cut diff --git a/rt/lib/RT/Attributes.pm b/rt/lib/RT/Attributes.pm index 12f659fa0..b96b3e26a 100644 --- a/rt/lib/RT/Attributes.pm +++ b/rt/lib/RT/Attributes.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/Attributes_Overlay.pm b/rt/lib/RT/Attributes_Overlay.pm index e0c2f5a04..ebe8c4cf1 100644 --- a/rt/lib/RT/Attributes_Overlay.pm +++ b/rt/lib/RT/Attributes_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,14 +45,15 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME - RT::Attributes - collection of RT::Attribute objects +RT::Attributes - collection of RT::Attribute objects =head1 SYNOPSIS - use RT::Attributes; -my $Attributes = new RT::Attributes($CurrentUser); + use RT::Attributes; + my $Attributes = new RT::Attributes($CurrentUser); =head1 DESCRIPTION @@ -154,22 +155,28 @@ the matching name. sub DeleteEntry { my $self = shift; - my %args = ( Name => undef, - Content => undef, - id => undef, - @_); + my %args = ( + Name => undef, + Content => undef, + id => undef, + @_ + ); my $found = 0; - foreach my $attr ($self->Named($args{'Name'})){ - if ((!defined $args{'id'} and !defined $args{'Content'}) - or (defined $args{'id'} and $attr->id eq $args{'id'}) - or (defined $args{'Content'} and $attr->Content eq $args{'Content'})) { - my ($id, $msg) = $attr->Delete; - return ($id, $msg) unless $id; - $found = 1; - } + foreach my $attr ( $self->Named( $args{'Name'} ) ) { + if ( ( !defined $args{'id'} and !defined $args{'Content'} ) + or ( defined $args{'id'} and $attr->id eq $args{'id'} ) + or ( defined $args{'Content'} and $attr->Content eq $args{'Content'} ) ) + { + my ($id, $msg) = $attr->Delete; + return ($id, $msg) unless $id; + $found = 1; + } } return (0, "No entry found") unless $found; - $self->_DoSearch(); + $self->RedoSearch; + # XXX: above string must work but because of bug in DBIx::SB it doesn't, + # to reproduce delete string below and run t/api/attribute-tests.t + $self->_DoSearch; return (1, $self->loc('Attribute Deleted')); } diff --git a/rt/lib/RT/Base.pm b/rt/lib/RT/Base.pm index 9a3ab6964..f276aa24e 100644 --- a/rt/lib/RT/Base.pm +++ b/rt/lib/RT/Base.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,9 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Base; -use Carp; -use Scalar::Util; +use Carp (); +use Scalar::Util (); use strict; use vars qw(@EXPORT); @@ -101,8 +102,8 @@ sub CurrentUser { unless ( ref $self->{'user'} && $self->{'user'}->isa('RT::CurrentUser') ) { my $msg = "$self was created without a CurrentUser." ." Any RT object which is subclass of RT::Base must be created" - ." with a RT::CurrentUser or a RT::User obejct as the first argument."; - $msg .= "\n". Carp::cluck() if @_; + ." with a RT::CurrentUser or a RT::User object as the first argument."; + $msg .= "\n". Carp::longmess() if @_; $RT::Logger->error( $msg ); return $self->{'user'} = undef; @@ -146,7 +147,6 @@ sub loc { return $user->loc(@_); } else { - use Carp; Carp::confess("No currentuser"); return ("Critical error:$self has no CurrentUser", $self); } @@ -158,7 +158,6 @@ sub loc_fuzzy { return $user->loc_fuzzy(@_); } else { - use Carp; Carp::confess("No currentuser"); return ("Critical error:$self has no CurrentUser", $self); } diff --git a/rt/lib/RT/CachedGroupMember.pm b/rt/lib/RT/CachedGroupMember.pm index 933c13bf9..1c9188f62 100644 --- a/rt/lib/RT/CachedGroupMember.pm +++ b/rt/lib/RT/CachedGroupMember.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/CachedGroupMember_Overlay.pm b/rt/lib/RT/CachedGroupMember_Overlay.pm index ffbbc8daf..a292afb77 100644 --- a/rt/lib/RT/CachedGroupMember_Overlay.pm +++ b/rt/lib/RT/CachedGroupMember_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::CachedGroupMember; use strict; @@ -148,6 +149,8 @@ sub Create { } } + return $id if $args{'Member'}->id == $args{'Group'}->id; + if ( $args{'Member'}->IsGroup() ) { my $GroupMembers = $args{'Member'}->Object->MembersObj(); while ( my $member = $GroupMembers->Next() ) { @@ -215,7 +218,7 @@ sub Delete { # Unless $self->GroupObj still has the member recursively $self->MemberObj # (Since we deleted the database row above, $self no longer counts) - unless ( $self->GroupObj->Object->HasMemberRecursively( $self->MemberObj ) ) { + unless ( $self->GroupObj->Object->HasMemberRecursively( $self->MemberId ) ) { # Find all ACEs granted to $self->GroupId @@ -260,7 +263,7 @@ sub SetDisabled { my $val = shift; # if it's already disabled, we're good. - return {1} if ($self->__Value('Disabled') == $val); + return (1) if ( $self->__Value('Disabled') == $val); my $err = $self->SUPER::SetDisabled($val); my ($retval, $msg) = $err->as_array(); unless ($retval) { @@ -286,7 +289,7 @@ sub SetDisabled { # Unless $self->GroupObj still has the member recursively $self->MemberObj # (Since we SetDisabledd the database row above, $self no longer counts) - unless ( $self->GroupObj->Object->HasMemberRecursively( $self->MemberObj ) ) { + unless ( $self->GroupObj->Object->HasMemberRecursively( $self->MemberId ) ) { # Find all ACEs granted to $self->GroupId my $acl = RT::ACL->new($RT::SystemUser); $acl->LimitToPrincipal( Id => $self->GroupId ); diff --git a/rt/lib/RT/CachedGroupMembers.pm b/rt/lib/RT/CachedGroupMembers.pm index a7448d1d6..992856c36 100644 --- a/rt/lib/RT/CachedGroupMembers.pm +++ b/rt/lib/RT/CachedGroupMembers.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + # Autogenerated by DBIx::SearchBuilder factory (by ) # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. # diff --git a/rt/lib/RT/CachedGroupMembers_Overlay.pm b/rt/lib/RT/CachedGroupMembers_Overlay.pm index c3b4fdd0d..9331553d3 100644 --- a/rt/lib/RT/CachedGroupMembers_Overlay.pm +++ b/rt/lib/RT/CachedGroupMembers_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,6 +45,7 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME RT::CachedGroupMembers - a collection of RT::GroupMember objects @@ -59,11 +60,6 @@ =head1 METHODS -=begin testing - -ok (require RT::CachedGroupMembers); - -=end testing =cut diff --git a/rt/lib/RT/Condition.pm b/rt/lib/RT/Condition.pm new file mode 100755 index 000000000..be7c4c56d --- /dev/null +++ b/rt/lib/RT/Condition.pm @@ -0,0 +1,233 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Condition - generic baseclass for scrip condition; + +=head1 SYNOPSIS + + use RT::Condition; + my $foo = RT::Condition->new( + TransactionObj => $tr, + TicketObj => $ti, + ScripObj => $scr, + Argument => $arg, + Type => $type); + + if ($foo->IsApplicable) { + # do something + } + + +=head1 DESCRIPTION + + +=head1 METHODS + + + + +=cut + +package RT::Condition; + +use strict; +use warnings; + +use base qw/RT::Base/; + +# {{{ sub new +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + $self->_Init(@_); + return $self; +} +# }}} + +# {{{ sub _Init +sub _Init { + my $self = shift; + my %args = ( TransactionObj => undef, + TicketObj => undef, + ScripObj => undef, + TemplateObj => undef, + Argument => undef, + ApplicableTransTypes => undef, + CurrentUser => undef, + @_ ); + + $self->{'Argument'} = $args{'Argument'}; + $self->{'ScripObj'} = $args{'ScripObj'}; + $self->{'TicketObj'} = $args{'TicketObj'}; + $self->{'TransactionObj'} = $args{'TransactionObj'}; + $self->{'ApplicableTransTypes'} = $args{'ApplicableTransTypes'}; + $self->CurrentUser($args{'CurrentUser'}); +} +# }}} + +# Access Scripwide data + +# {{{ sub Argument + +=head2 Argument + +Return the optional argument associated with this ScripCondition + +=cut + +sub Argument { + my $self = shift; + return($self->{'Argument'}); +} +# }}} + +# {{{ sub TicketObj + +=head2 TicketObj + +Return the ticket object we're talking about + +=cut + +sub TicketObj { + my $self = shift; + return($self->{'TicketObj'}); +} +# }}} + +# {{{ sub ScripObj + +=head2 ScripObj + +Return the Scrip object we're talking about + +=cut + +sub ScripObj { + my $self = shift; + return($self->{'ScripObj'}); +} +# }}} +# {{{ sub TransactionObj + +=head2 TransactionObj + +Return the transaction object we're talking about + +=cut + +sub TransactionObj { + my $self = shift; + return($self->{'TransactionObj'}); +} +# }}} + +# {{{ sub Type + +=head2 Type + + + +=cut + +sub ApplicableTransTypes { + my $self = shift; + return($self->{'ApplicableTransTypes'}); +} +# }}} + + +# Scrip methods + + +#What does this type of Action does + +# {{{ sub Describe +sub Describe { + my $self = shift; + return ($self->loc("No description for [_1]", ref $self)); +} +# }}} + + +#Parse the templates, get things ready to go. + +#If this rule applies to this transaction, return true. + +# {{{ sub IsApplicable +sub IsApplicable { + my $self = shift; + return(undef); +} +# }}} + +# {{{ sub DESTROY +sub DESTROY { + my $self = shift; + + # We need to clean up all the references that might maybe get + # oddly circular + $self->{'TemplateObj'} =undef + $self->{'TicketObj'} = undef; + $self->{'TransactionObj'} = undef; + $self->{'ScripObj'} = undef; + +} + +# }}} + +eval "require RT::Condition_Vendor"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition_Vendor.pm}); +eval "require RT::Condition_Local"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition_Local.pm}); + +1; diff --git a/rt/lib/RT/Condition/AnyTransaction.pm b/rt/lib/RT/Condition/AnyTransaction.pm index 9b1bb8cfb..1b90aa53e 100644 --- a/rt/lib/RT/Condition/AnyTransaction.pm +++ b/rt/lib/RT/Condition/AnyTransaction.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,14 +45,11 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - package RT::Condition::AnyTransaction; -require RT::Condition::Generic; +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable diff --git a/rt/lib/RT/Condition/BeforeDue.pm b/rt/lib/RT/Condition/BeforeDue.pm index c42e07b26..b392f38b7 100644 --- a/rt/lib/RT/Condition/BeforeDue.pm +++ b/rt/lib/RT/Condition/BeforeDue.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,15 +45,13 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + package RT::Condition::BeforeDue; -require RT::Condition::Generic; +use base 'RT::Condition'; use RT::Date; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); - sub IsApplicable { my $self = shift; diff --git a/rt/lib/RT/Condition/CloseTicket.pm b/rt/lib/RT/Condition/CloseTicket.pm new file mode 100644 index 000000000..ded04482f --- /dev/null +++ b/rt/lib/RT/Condition/CloseTicket.pm @@ -0,0 +1,84 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Condition::CloseTicket; + +use strict; +use warnings; + +use base 'RT::Condition'; + + +=head2 IsApplicable + +If the ticket was closed, ie status was changed from any active status to +an inactive. See F for C and C +options. + +=cut + +sub IsApplicable { + my $self = shift; + + my $txn = $self->TransactionObj; + return 0 unless $txn->Type eq "Status" || + ( $txn->Type eq "Set" && $txn->Field eq "Status" ); + + my $queue = $self->TicketObj->QueueObj; + return 0 unless $queue->IsActiveStatus( $txn->OldValue ); + return 0 unless $queue->IsInactiveStatus( $txn->NewValue ); + + return 1; +} + +eval "require RT::Condition::CloseTicket_Vendor"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/CloseTicket_Vendor.pm}); +eval "require RT::Condition::CloseTicket_Local"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/CloseTicket_Local.pm}); + +1; diff --git a/rt/lib/RT/Condition/Generic.pm b/rt/lib/RT/Condition/Generic.pm index da6ec476c..08baeda25 100755 --- a/rt/lib/RT/Condition/Generic.pm +++ b/rt/lib/RT/Condition/Generic.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,191 +45,36 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} + =head1 NAME - RT::Condition::Generic - ; + RT::Condition::Generic - deprecated, see RT::Condition =head1 SYNOPSIS - use RT::Condition::Generic; - my $foo = RT::Condition::Generic->new( - TransactionObj => $tr, - TicketObj => $ti, - ScripObj => $scr, - Argument => $arg, - Type => $type); - - if ($foo->IsApplicable) { - # do something - } - + use RT::Condition::Generic; =head1 DESCRIPTION +This module is provided only for backwards compatibility. =head1 METHODS -=begin testing - -ok (require RT::Condition::Generic); - -=end testing - - =cut -package RT::Condition::Generic; - use strict; -use base qw/RT::Base/; - -# {{{ sub new -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - bless ($self, $class); - $self->_Init(@_); - return $self; -} -# }}} - -# {{{ sub _Init -sub _Init { - my $self = shift; - my %args = ( TransactionObj => undef, - TicketObj => undef, - ScripObj => undef, - TemplateObj => undef, - Argument => undef, - ApplicableTransTypes => undef, - CurrentUser => undef, - @_ ); - - $self->{'Argument'} = $args{'Argument'}; - $self->{'ScripObj'} = $args{'ScripObj'}; - $self->{'TicketObj'} = $args{'TicketObj'}; - $self->{'TransactionObj'} = $args{'TransactionObj'}; - $self->{'ApplicableTransTypes'} = $args{'ApplicableTransTypes'}; - $self->CurrentUser($args{'CurrentUser'}); -} -# }}} - -# Access Scripwide data - -# {{{ sub Argument - -=head2 Argument - -Return the optional argument associated with this ScripCondition - -=cut - -sub Argument { - my $self = shift; - return($self->{'Argument'}); -} -# }}} - -# {{{ sub TicketObj - -=head2 TicketObj - -Return the ticket object we're talking about - -=cut - -sub TicketObj { - my $self = shift; - return($self->{'TicketObj'}); -} -# }}} - -# {{{ sub ScripObj - -=head2 ScripObj - -Return the Scrip object we're talking about - -=cut - -sub ScripObj { - my $self = shift; - return($self->{'ScripObj'}); -} -# }}} -# {{{ sub TransactionObj - -=head2 TransactionObj - -Return the transaction object we're talking about - -=cut - -sub TransactionObj { - my $self = shift; - return($self->{'TransactionObj'}); -} -# }}} - -# {{{ sub Type - -=head2 Type - - - -=cut - -sub ApplicableTransTypes { - my $self = shift; - return($self->{'ApplicableTransTypes'}); -} -# }}} - - -# Scrip methods - - -#What does this type of Action does - -# {{{ sub Describe -sub Describe { - my $self = shift; - return ($self->loc("No description for [_1]", ref $self)); -} -# }}} - - -#Parse the templates, get things ready to go. - -#If this rule applies to this transaction, return true. - -# {{{ sub IsApplicable -sub IsApplicable { - my $self = shift; - return(undef); -} -# }}} - -# {{{ sub DESTROY -sub DESTROY { - my $self = shift; - - # We need to clean up all the references that might maybe get - # oddly circular - $self->{'TemplateObj'} =undef - $self->{'TicketObj'} = undef; - $self->{'TransactionObj'} = undef; - $self->{'ScripObj'} = undef; - -} - -# }}} +use warnings; +package RT::Condition::Generic; +use base 'RT::Condition'; eval "require RT::Condition::Generic_Vendor"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/Generic_Vendor.pm}); +warn "RT::Condition::Generic has become RT::Condition. Please adjust your RT::Condition::Generic_Vendor file at " . $INC{"RT/Condition/Generic_Vendor.pm"} if !$@; + eval "require RT::Condition::Generic_Local"; die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/Generic_Local.pm}); +warn "RT::Condition::Generic has become RT::Condition. Please adjust your RT::Condition::Generic_Local file at " . $INC{"RT/Condition/Generic_Local.pm"} if !$@; 1; + diff --git a/rt/lib/RT/Condition/Overdue.pm b/rt/lib/RT/Condition/Overdue.pm index 4fb7f0d50..44d5f22e6 100644 --- a/rt/lib/RT/Condition/Overdue.pm +++ b/rt/lib/RT/Condition/Overdue.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,8 +45,6 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - =head1 NAME @@ -59,11 +57,8 @@ Returns true if the ticket we're operating on is overdue =cut package RT::Condition::Overdue; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable diff --git a/rt/lib/RT/Condition/OwnerChange.pm b/rt/lib/RT/Condition/OwnerChange.pm index 2e10602dc..da9025304 100644 --- a/rt/lib/RT/Condition/OwnerChange.pm +++ b/rt/lib/RT/Condition/OwnerChange.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,69 +45,23 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - package RT::Condition::OwnerChange; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable If we're changing the owner return true, otherwise return false -=begin testing - -my $q = RT::Queue->new($RT::SystemUser); -$q->Create(Name =>'ownerChangeTest'); - -ok($q->Id, "Created a scriptest queue"); - -my $s1 = RT::Scrip->new($RT::SystemUser); -my ($val, $msg) =$s1->Create( Queue => $q->Id, - ScripAction => 'User Defined', - ScripCondition => 'On Owner Change', - CustomIsApplicableCode => '', - CustomPrepareCode => 'return 1', - CustomCommitCode => ' - $self->TicketObj->SetPriority($self->TicketObj->Priority+1); - return(1); - ', - Template => 'Blank' - ); -ok($val,$msg); - -my $ticket = RT::Ticket->new($RT::SystemUser); -my ($tv,$ttv,$tm) = $ticket->Create(Queue => $q->Id, - Subject => "hair on fire", - InitialPriority => '20' - ); -ok($tv, $tm); -ok($ticket->SetOwner('root')); -is ($ticket->Priority , '21', "Ticket priority is set right"); -ok($ticket->Steal); -is ($ticket->Priority , '22', "Ticket priority is set right"); -ok($ticket->Untake); -is ($ticket->Priority , '23', "Ticket priority is set right"); -ok($ticket->Take); -is ($ticket->Priority , '24', "Ticket priority is set right"); - - - - - -=end testing =cut sub IsApplicable { my $self = shift; - if ($self->TransactionObj->Field eq 'Owner') { + if ( ( $self->TransactionObj->Field || '' ) eq 'Owner' ) { return(1); } else { diff --git a/rt/lib/RT/Condition/PriorityChange.pm b/rt/lib/RT/Condition/PriorityChange.pm index 533cc4b31..268587a52 100644 --- a/rt/lib/RT/Condition/PriorityChange.pm +++ b/rt/lib/RT/Condition/PriorityChange.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,15 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - package RT::Condition::PriorityChange; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable diff --git a/rt/lib/RT/Condition/PriorityExceeds.pm b/rt/lib/RT/Condition/PriorityExceeds.pm index 5f92957be..20089dbc3 100644 --- a/rt/lib/RT/Condition/PriorityExceeds.pm +++ b/rt/lib/RT/Condition/PriorityExceeds.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,16 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - package RT::Condition::PriorityExceeds; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); - =head2 IsApplicable diff --git a/rt/lib/RT/Condition/QueueChange.pm b/rt/lib/RT/Condition/QueueChange.pm index d5fbeecce..250a2de23 100644 --- a/rt/lib/RT/Condition/QueueChange.pm +++ b/rt/lib/RT/Condition/QueueChange.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,16 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - package RT::Condition::QueueChange; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); - =head2 IsApplicable diff --git a/rt/lib/RT/Condition/ReopenTicket.pm b/rt/lib/RT/Condition/ReopenTicket.pm new file mode 100644 index 000000000..1b62845f0 --- /dev/null +++ b/rt/lib/RT/Condition/ReopenTicket.pm @@ -0,0 +1,89 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::Condition::ReopenTicket; + +use strict; +use warnings; + +use base 'RT::Condition'; + + +=head2 IsApplicable + +If the ticket was repopened, ie status was changed from any inactive status to +an active. See F for C and C +options. + +=cut + +sub IsApplicable { + my $self = shift; + + my $txn = $self->TransactionObj; + return 0 unless $txn->Type eq "Status" || + ( $txn->Type eq "Set" && $txn->Field eq "Status" ); + + my $queue = $self->TicketObj->QueueObj; + return 0 unless $queue->IsInactiveStatus( $txn->OldValue ); + return 0 unless $queue->IsActiveStatus( $txn->NewValue ); + + $RT::Logger->debug("Condition 'On Reopen' triggered " + ."for ticket #". $self->TicketObj->id + ." transaction #". $txn->id + ); + + return 1; +} + +eval "require RT::Condition::ReopenTicket_Vendor"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/ReopenTicket_Vendor.pm}); +eval "require RT::Condition::ReopenTicket_Local"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Condition/ReopenTicket_Local.pm}); + +1; diff --git a/rt/lib/RT/Condition/StatusChange.pm b/rt/lib/RT/Condition/StatusChange.pm index 20da9e728..285b71da6 100644 --- a/rt/lib/RT/Condition/StatusChange.pm +++ b/rt/lib/RT/Condition/StatusChange.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,15 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - - package RT::Condition::StatusChange; -require RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable diff --git a/rt/lib/RT/Condition/UserDefined.pm b/rt/lib/RT/Condition/UserDefined.pm index f4d2e270c..f339e9a80 100644 --- a/rt/lib/RT/Condition/UserDefined.pm +++ b/rt/lib/RT/Condition/UserDefined.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,15 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - package RT::Condition::UserDefined; - -use RT::Condition::Generic; - +use base 'RT::Condition'; use strict; -use vars qw/@ISA/; -@ISA = qw(RT::Condition::Generic); =head2 IsApplicable @@ -64,6 +59,7 @@ This happens on every transaction. it's always applicable sub IsApplicable { my $self = shift; + local $@; my $retval = eval $self->ScripObj->CustomIsApplicableCode; if ($@) { $RT::Logger->error("Scrip ".$self->ScripObj->Id. " IsApplicable failed: ".$@); diff --git a/rt/lib/RT/Config.pm b/rt/lib/RT/Config.pm new file mode 100644 index 000000000..76c45dcbd --- /dev/null +++ b/rt/lib/RT/Config.pm @@ -0,0 +1,894 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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 = new RT::Config; + $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 class provide access to RT's and RT extensions' config files. + +RT uses two files for site configuring: + +First file is F - core config file. This file is shipped +with RT distribution and contains default values for all available options. +B + +Second file is F - 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<< _Config.pm >> and F<< _SiteConfig.pm >> names for +config files, where is extension name. + +B: 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. + +=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 = new RT::Queues($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; + }, + } + }, + UsernameFormat => { + Section => 'General', + Overridable => 1, + SortOrder => 2, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Username format', # loc + Values => [qw(concise verbose)], + ValuesLabel => { + concise => 'Short usernames', # loc_left_pair + verbose => 'Name and email address', # loc_left_pair + }, + }, + }, + WebDefaultStylesheet => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Select', + WidgetArguments => { + Description => 'Theme', #loc + # XXX: we need support for 'get values callback' + Values => [qw(3.5-default 3.4-compat web2)], + }, + }, + MessageBoxRichText => { + Section => 'General', + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'WYSIWYG message composer' # loc + } + }, + MessageBoxRichTextHeight => { + Section => 'General', + Overridable => 1, + SortOrder => 5, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'WYSIWYG composer height', # loc + } + }, + MessageBoxWidth => { + Section => 'General', + Overridable => 1, + SortOrder => 6, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box width', #loc + }, + }, + MessageBoxHeight => { + Section => 'General', + Overridable => 1, + SortOrder => 7, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Message box height', #loc + }, + }, + SearchResultsRefreshInterval => { + Section => 'General', #loc + Overridable => 1, + SortOrder => 8, + 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 + DefaultSummaryRows => { + Section => 'RT at a glance', #loc + Overridable => 1, + SortOrder => 1, + Widget => '/Widgets/Form/Integer', + WidgetArguments => { + Description => 'Number of search results', #loc + }, + }, + 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 + }, + }, + ShowUnreadMessageNotifications => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 3, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'Notify me of unread messages', #loc + }, + + }, + PlainTextPre => { + Section => 'Ticket display', + Overridable => 1, + SortOrder => 4, + Widget => '/Widgets/Form/Boolean', + WidgetArguments => { + Description => 'add 
 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
+        },
+    },
+
+    # 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 = new RT::Date($HTML::Mason::Commands::session{'CurrentUser'});
+                              $date->Set;
+                              foreach my $value ($date->Formatters) {
+                                 push @{$ret->{Values}}, $value;
+                                 $ret->{ValuesLabel}{$value} = $date->$value();
+                              }
+                              return $ret;
+            },
+        },
+    },
+
+    # 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
+            ]
+        }
+    },
+
+    # 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
+    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' },
+    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;
+            }
+        }
+    },
+);
+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 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 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/(?_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 && $@ =~ qr{^Can't locate \Q$args{File}};
+        if ( $is_site || $@ !~ qr{^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 = <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 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). 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 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 ( $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 or RTFM's
+                warn
+                    "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
+                    ." It's may be ok, but we want you to be aware."
+                    ." This option earlier has been set 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;
+}
+
+{
+    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 '::';
+
+        my %ref_sym = (
+            SCALAR => '$',
+            ARRAY  => '@',
+            HASH   => '%',
+            CODE   => '&',
+        );
+        no strict 'refs';
+        my $name = undef;
+
+        # scan $pack's nametable(hash)
+        foreach my $k ( keys %{$pack} ) {
+
+            # hash for main:: has reference on itself
+            next if $k eq 'main::';
+
+            # if entry has trailing '::' then
+            # it is link to other name space
+            if ( $k =~ /::$/ ) {
+                $name = $self->__GetNameByRef( $ref, $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;
+
+            # get entry for type we are looking for
+            # XXX skip references to scalars or other references.
+            # Otherwie 5.10 goes boom. may be we should skip any
+            # reference
+            return if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF';
+            my $entry_ref = *{$entry}{ ref($ref) };
+            next unless $entry_ref;
+
+            # if references are equal then we've found
+            if ( $entry_ref == $ref ) {
+                $last_pack = $pack;
+                return ( $ref_sym{ ref($ref) } || '*' ) . $pack . $k;
+            }
+        }
+        return '';
+    }
+}
+
+=head2 Metadata
+
+
+=head2 Meta
+
+=cut
+
+sub Meta {
+    return $META{ $_[1] };
+}
+
+sub Sections {
+    my $self = shift;
+    my %seen;
+    return sort
+        grep !$seen{$_}++,
+        map $_->{'Section'} || 'General',
+        values %META;
+}
+
+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;
+}
+
+eval "require RT::Config_Vendor";
+if ($@ && $@ !~ qr{^Can't locate RT/Config_Vendor.pm}) {
+    die $@;
+};
+
+eval "require RT::Config_Local";
+if ($@ && $@ !~ qr{^Can't locate RT/Config_Local.pm}) {
+    die $@;
+};
+
+1;
diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm
new file mode 100644
index 000000000..5581df153
--- /dev/null
+++ b/rt/lib/RT/Crypt/GnuPG.pm
@@ -0,0 +1,2450 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          
+# 
+# (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 }}}
+
+use strict;
+use warnings;
+
+package RT::Crypt::GnuPG;
+
+use IO::Handle;
+use GnuPG::Interface;
+use RT::EmailParser ();
+use RT::Util 'safe_run_child';
+
+=head1 NAME
+
+RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)
+
+=head1 DESCRIPTION
+
+This module provides support for encryption and signing of outgoing messages, 
+as well as the decryption and verification of incoming email.
+
+=head1 CONFIGURATION
+
+You can control the configuration of this subsystem from RT's configuration file.
+Some options are available via the web interface, but to enable this functionality, you
+MUST start in the configuration file.
+
+There are two hashes, GnuPG and GnuPGOptions in the configuration file. The 
+first one controls RT specific options. It enables you to enable/disable facility 
+or change the format of messages. The second one is a hash with options for the 
+'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys 
+and set almost any option 'gnupg' supports on your system.
+
+=head2 %GnuPG
+
+=head3 Enabling GnuPG
+
+Set to true value to enable this subsystem:
+
+    Set( %GnuPG,
+        Enable => 1,
+        ... other options ...
+    );
+
+However, note that you B add the 'Auth::GnuPG' email filter to enable
+the handling of incoming encrypted/signed messages.
+
+=head3 Format of outgoing messages
+
+Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
+option in the RT config:
+
+    Set( %GnuPG,
+        ... other options ...
+        OutgoingMessagesFormat => 'RFC',
+        ... other options ...
+    );
+
+or
+
+    Set( %GnuPG,
+        ... other options ...
+        OutgoingMessagesFormat => 'Inline',
+        ... other options ...
+    );
+
+This framework implements two formats of signing and encrypting of email messages:
+
+=over
+
+=item RFC
+
+This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
+Technique described in these RFCs is well supported by many mail user
+agents (MUA), but some MUAs support only inline signatures and encryption,
+so it's possible to use inline format (see below).
+
+=item Inline
+
+This format doesn't take advantage of MIME, but some mail clients do
+not support GPG/MIME.
+
+We sign text parts using clear signatures. For each attachments another
+attachment with a signature is added with '.sig' extension.
+
+Encryption of text parts is implemented using inline format, other parts
+are replaced with attachments with the filename extension '.pgp'.
+
+This format is discouraged because modern mail clients typically don't support
+it well.
+
+=back
+
+=head3 Encrypting data in the database
+
+You can allow users to encrypt data in the database using
+option C. By default it's disabled.
+Users must have rights to see and modify tickets to use
+this feature.
+
+=head2 %GnuPGOptions
+
+Use this hash to set options of the 'gnupg' program. You can define almost any
+option you want which  gnupg supports, but never try to set options which
+change output format or gnupg's commands, such as --sign (command),
+--list-options (option) and other.
+
+Some GnuPG options take arguments while others take none. (Such as  --use-agent).
+For options without specific value use C as hash value.
+To disable these option just comment them out or delete them from the hash
+
+    Set(%GnuPGOptions,
+        'option-with-value' => 'value',
+        'enabled-option-without-value' => undef,
+        # 'commented-option' => 'value or undef',
+    );
+
+B that options may contain '-' character and such options B be
+quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.
+
+=over
+
+=item --homedir
+
+The GnuPG home directory, by default it is set to F.
+
+You can manage this data with the 'gpg' commandline utility 
+using the GNUPGHOME environment variable or --homedir option. 
+Other utilities may be used as well.
+
+In a standard installation, access to this directory should be granted to
+the web server user which is running RT's web interface, but if you're running
+cronjobs or other utilities that access RT directly via API and may generate
+encrypted/signed notifications then the users you execute these scripts under
+must have access too. 
+
+However, granting access to the dir to many users makes your setup less secure,
+some features, such as auto-import of keys, may not be available if you do not.
+To enable this features and suppress warnings about permissions on
+the dir use --no-permission-warning.
+
+=item --digest-algo
+
+This option is required in advance when RFC format for outgoing messages is
+used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
+default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
+SHA256 or other, however use `gpg --version` command to get information about
+supported algorithms by your gpg. These algorithms are listed as hash-functions.
+
+=item --use-agent
+
+This option lets you use GPG Agent to cache the passphrase of RT's key. See
+L
+for information about GPG Agent.
+
+=item --passphrase
+
+This option lets you set the passphrase of RT's key directly. This option is
+special in that it isn't passed directly to GPG, but is put into a file that
+GPG then reads (which is more secure). The downside is that anyone who has read
+access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
+the --use-agent option instead.
+
+=item other
+
+Read `man gpg` to get list of all options this program support.
+
+=back
+
+=head2 Per-queue options
+
+Using the web interface it's possible to enable signing and/or encrypting by
+default. As an administrative user of RT, open 'Configuration' then 'Queues',
+and select a queue. On the page you can see information about the queue's keys 
+at the bottom and two checkboxes to choose default actions.
+
+As well, encryption is enabled for autoreplies and other notifications when
+an encypted message enters system via mailgate interface even if queue's
+option is disabled.
+
+=head2 Handling incoming messages
+
+To enable handling of encrypted and signed message in the RT you should add
+'Auth::GnuPG' mail plugin.
+
+    Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
+
+See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.
+
+=head2 Errors handling
+
+There are several global templates created in the database by default. RT
+uses these templates to send error messages to users or RT's owner. These 
+templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can 
+adjust the text of the messages using the web interface.
+
+Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
+in RT's templates are not available in these templates, but each template
+used for errors reporting has set of available data structures you can use to
+build better messages. See default templates and descriptions below.
+
+As well, you can disable particular notification by deleting content of
+a template. You can delete a template too, but in this case you'll see
+error messages in the logs when RT can not load template you've deleted.
+
+=head3 Problems with public keys
+
+Template 'Error: public key' is used to inform the user that RT has problems with
+his public key and won't be able to send him encrypted content. There are several 
+reasons why RT can't use a key. However, the actual reason is not sent to the user, 
+but sent to RT owner using 'Error to RT owner: public key'.
+
+The possible reasons: "Not Found", "Ambiguous specification", "Wrong
+key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
+old", "Policy mismatch", "Not a secret key", "Key not trusted" or
+"No specific reason given".
+
+Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
+unless 'always trust' mode is enabled.
+
+In the 'Error: public key' template there are a few additional variables available:
+
+=over 4
+
+=item $Message - user friendly error message
+
+=item $Reason - short reason as listed above
+
+=item $Recipient - recipient's identification
+
+=item $AddressObj - L object containing recipient's email address
+
+=back
+
+A message can have several invalid recipients, to avoid sending many emails
+to the RT owner the system sends one message to the owner, grouped by
+recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
+array is available where each element is a hash reference that describes one
+recipient using the same fields as described above. So it's something like:
+
+    @BadRecipients = (
+        { Message => '...', Reason => '...', Recipient => '...', ...},
+        { Message => '...', Reason => '...', Recipient => '...', ...},
+        ...
+    )
+
+=head3 Private key doesn't exist
+
+Template 'Error: no private key' is used to inform the user that
+he sent an encrypted email, but we have no private key to decrypt
+it.
+
+In this template C<$Message> object of L class
+available. It's the message RT received.
+
+=head3 Invalid data
+
+Template 'Error: bad GnuPG data' used to inform the user that a
+message he sent has invalid data and can not be handled.
+
+There are several reasons for this error, but most of them are data
+corruption or absence of expected information.
+
+In this template C<@Messages> array is available and contains list
+of error messages.
+
+=head1 FOR DEVELOPERS
+
+=head2 Documentation and references
+
+* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
+Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
+MIME types.
+
+* RFC3156 - MIME Security with Pretty Good Privacy (PGP),
+updates RFC2015.
+
+=cut
+
+# gnupg options supported by GnuPG::Interface
+# other otions should be handled via extra_args argument
+my %supported_opt = map { $_ => 1 } qw(
+       always_trust
+       armor
+       batch
+       comment
+       compress_algo
+       default_key
+       encrypt_to
+       extra_args
+       force_v3_sigs
+       homedir
+       logger_fd
+       no_greeting
+       no_options
+       no_verbose
+       openpgp
+       options
+       passphrase_fd
+       quiet
+       recipients
+       rfc1991
+       status_fd
+       textmode
+       verbose
+);
+
+# DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't
+# need them, just pass 'new IO::Handle' and then close it after safe_run_child.
+# we don't want to leak anything into FCGI/Apache/MP handles, this break things.
+# So code should look like:
+#        my $handles = GnuPG::Handles->new(
+#            stdin  => ($handle{'stdin'}  = new IO::Handle),
+#            stdout => ($handle{'stdout'} = new IO::Handle),
+#            stderr => ($handle{'stderr'}  = new IO::Handle),
+#            ...
+#        );
+
+=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]
+
+Signs and/or encrypts an email message with GnuPG utility.
+
+=over
+
+=item Signing
+
+During signing you can pass C argument to set key we sign with this option
+overrides gnupg's C option. If C argument is not provided
+then address of a message sender is used.
+
+As well you can pass C, but if value is undefined then L
+called to get it.
+
+=item Encrypting
+
+During encryption you can pass a C array, otherwise C, C and
+C fields of the message are used to fetch the list.
+
+=back
+
+Returns a hash with the following keys:
+
+* exit_code
+* error
+* logger
+* status
+* message
+
+=cut
+
+sub SignEncrypt {
+    my %args = (@_);
+
+    my $entity = $args{'Entity'};
+    if ( $args{'Sign'} && !defined $args{'Signer'} ) {
+        $args{'Signer'} = UseKeyForSigning()
+            || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address;
+    }
+    if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
+        my %seen;
+        $args{'Recipients'} = [
+            grep $_ && !$seen{ $_ }++, map $_->address,
+            map Email::Address->parse( $entity->head->get( $_ ) ),
+            qw(To Cc Bcc)
+        ];
+    }
+    
+    my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
+    if ( $format eq 'inline' ) {
+        return SignEncryptInline( %args );
+    } else {
+        return SignEncryptRFC3156( %args );
+    }
+}
+
+sub SignEncryptRFC3156 {
+    my %args = (
+        Entity => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => undef,
+
+        @_
+    );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnuPGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined $args{'Passphrase'};
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $opt{'default_key'} = $args{'Signer'}
+        if $args{'Sign'} && $args{'Signer'};
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    my $entity = $args{'Entity'};
+
+    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
+        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
+    }
+
+    my %res;
+    if ( $args{'Sign'} && !$args{'Encrypt'} ) {
+        # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
+        foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
+            my $tenc = $_->head->mime_encoding;
+            unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
+                $_->head->mime_attr( 'Content-Transfer-Encoding'
+                    => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
+                );
+            }
+        }
+
+        my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
+        my %handle = %$handle_list;
+
+        $gnupg->passphrase( $args{'Passphrase'} );
+
+        eval {
+            local $SIG{'CHLD'} = 'DEFAULT';
+            my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
+            $entity->make_multipart( 'mixed', Force => 1 );
+            {
+                local $SIG{'PIPE'} = 'IGNORE';
+                $entity->parts(0)->print( $handle{'stdin'} );
+                close $handle{'stdin'};
+            }
+            waitpid $pid, 0;
+        };
+        my $err = $@;
+        my @signature = readline $handle{'stdout'};
+        close $handle{'stdout'};
+
+        $res{'exit_code'} = $?;
+        foreach ( qw(stderr logger status) ) {
+            $res{$_} = do { local $/; readline $handle{$_} };
+            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+            close $handle{$_};
+        }
+        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+        if ( $err || $res{'exit_code'} ) {
+            $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+            return %res;
+        }
+
+        # setup RFC1847(Ch.2.1) requirements
+        my $protocol = 'application/pgp-signature';
+        $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
+        $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
+        $entity->head->mime_attr( 'Content-Type.micalg'   => 'pgp-'. lc $opt{'digest-algo'} );
+        $entity->attach(
+            Type        => $protocol,
+            Disposition => 'inline',
+            Data        => \@signature,
+            Encoding    => '7bit',
+        );
+    }
+    if ( $args{'Encrypt'} ) {
+        my %seen;
+        $gnupg->options->push_recipients( $_ ) foreach 
+            map UseKeyForEncryption($_) || $_,
+            grep !$seen{ $_ }++, map $_->address,
+            map Email::Address->parse( $entity->head->get( $_ ) ),
+            qw(To Cc Bcc);
+
+        my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+        binmode $tmp_fh, ':raw';
+
+        my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
+        my %handle = %$handle_list;
+        $handles->options( 'stdout'  )->{'direct'} = 1;
+        $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
+
+        eval {
+            local $SIG{'CHLD'} = 'DEFAULT';
+            my $pid = safe_run_child { $args{'Sign'}
+                ? $gnupg->sign_and_encrypt( handles => $handles )
+                : $gnupg->encrypt( handles => $handles ) };
+            $entity->make_multipart( 'mixed', Force => 1 );
+            {
+                local $SIG{'PIPE'} = 'IGNORE';
+                $entity->parts(0)->print( $handle{'stdin'} );
+                close $handle{'stdin'};
+            }
+            waitpid $pid, 0;
+        };
+
+        $res{'exit_code'} = $?;
+        foreach ( qw(stderr logger status) ) {
+            $res{$_} = do { local $/; readline $handle{$_} };
+            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+            close $handle{$_};
+        }
+        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+        if ( $@ || $? ) {
+            $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
+            return %res;
+        }
+
+        my $protocol = 'application/pgp-encrypted';
+        $entity->parts([]);
+        $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
+        $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
+        $entity->attach(
+            Type        => $protocol,
+            Disposition => 'inline',
+            Data        => ['Version: 1',''],
+            Encoding    => '7bit',
+        );
+        $entity->attach(
+            Type        => 'application/octet-stream',
+            Disposition => 'inline',
+            Path        => $tmp_fn,
+            Filename    => '',
+            Encoding    => '7bit',
+        );
+        $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
+    }
+    return %res;
+}
+
+sub SignEncryptInline {
+    my %args = ( @_ );
+
+    my $entity = $args{'Entity'};
+
+    my %res;
+    $entity->make_singlepart;
+    if ( $entity->is_multipart ) {
+        foreach ( $entity->parts ) {
+            %res = SignEncryptInline( @_, Entity => $_ );
+            return %res if $res{'exit_code'};
+        }
+        return %res;
+    }
+
+    return _SignEncryptTextInline( @_ )
+        if $entity->effective_type =~ /^text\//i;
+
+    return _SignEncryptAttachmentInline( @_ );
+}
+
+sub _SignEncryptTextInline {
+    my %args = (
+        Entity => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => undef,
+
+        @_
+    );
+    return unless $args{'Sign'} || $args{'Encrypt'};
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnupGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $opt{'default_key'} = $args{'Signer'}
+        if $args{'Sign'} && $args{'Signer'};
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
+        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
+    }
+
+    if ( $args{'Encrypt'} ) {
+        $gnupg->options->push_recipients( $_ ) foreach 
+            map UseKeyForEncryption($_) || $_,
+            @{ $args{'Recipients'} || [] };
+    }
+
+    my %res;
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
+    my %handle = %$handle_list;
+
+    $handles->options( 'stdout'  )->{'direct'} = 1;
+    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
+
+    my $entity = $args{'Entity'};
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $method = $args{'Sign'} && $args{'Encrypt'}
+            ? 'sign_and_encrypt'
+            : ($args{'Sign'}? 'clearsign': 'encrypt');
+        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $entity->bodyhandle->print( $handle{'stdin'} );
+            close $handle{'stdin'};
+        }
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    my $err = $@;
+
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+        return %res;
+    }
+
+    $entity->bodyhandle( new MIME::Body::File $tmp_fn );
+    $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
+
+    return %res;
+}
+
+sub _SignEncryptAttachmentInline {
+    my %args = (
+        Entity => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => undef,
+
+        @_
+    );
+    return unless $args{'Sign'} || $args{'Encrypt'};
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnupGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $opt{'default_key'} = $args{'Signer'}
+        if $args{'Sign'} && $args{'Signer'};
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
+        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
+    }
+
+    my $entity = $args{'Entity'};
+    if ( $args{'Encrypt'} ) {
+        $gnupg->options->push_recipients( $_ ) foreach
+            map UseKeyForEncryption($_) || $_,
+            @{ $args{'Recipients'} || [] };
+    }
+
+    my %res;
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
+    my %handle = %$handle_list;
+    $handles->options( 'stdout'  )->{'direct'} = 1;
+    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
+
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $method = $args{'Sign'} && $args{'Encrypt'}
+            ? 'sign_and_encrypt'
+            : ($args{'Sign'}? 'detach_sign': 'encrypt');
+        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $entity->bodyhandle->print( $handle{'stdin'} );
+            close $handle{'stdin'};
+        }
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    my $err = $@;
+
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+        return %res;
+    }
+
+    my $filename = $entity->head->recommended_filename || 'no_name';
+    if ( $args{'Sign'} && !$args{'Encrypt'} ) {
+        $entity->make_multipart;
+        $entity->attach(
+            Type     => 'application/octet-stream',
+            Path     => $tmp_fn,
+            Filename => "$filename.sig",
+            Disposition => 'attachment',
+        );
+    } else {
+        $entity->bodyhandle( new MIME::Body::File $tmp_fn );
+        $entity->effective_type('application/octet-stream');
+        $entity->head->mime_attr( $_ => "$filename.pgp" )
+            foreach (qw(Content-Type.name Content-Disposition.filename));
+
+    }
+    $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
+
+    return %res;
+}
+
+sub SignEncryptContent {
+    my %args = (
+        Content => undef,
+
+        Sign => 1,
+        Signer => undef,
+        Passphrase => undef,
+
+        Encrypt => 1,
+        Recipients => undef,
+
+        @_
+    );
+    return unless $args{'Sign'} || $args{'Encrypt'};
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnupGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $opt{'default_key'} = $args{'Signer'}
+        if $args{'Sign'} && $args{'Signer'};
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
+        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
+    }
+
+    if ( $args{'Encrypt'} ) {
+        $gnupg->options->push_recipients( $_ ) foreach 
+            map UseKeyForEncryption($_) || $_,
+            @{ $args{'Recipients'} || [] };
+    }
+
+    my %res;
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
+    my %handle = %$handle_list;
+    $handles->options( 'stdout'  )->{'direct'} = 1;
+    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
+
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $method = $args{'Sign'} && $args{'Encrypt'}
+            ? 'sign_and_encrypt'
+            : ($args{'Sign'}? 'clearsign': 'encrypt');
+        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $handle{'stdin'}->print( ${ $args{'Content'} } );
+            close $handle{'stdin'};
+        }
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    my $err = $@;
+
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+        return %res;
+    }
+
+    ${ $args{'Content'} } = '';
+    seek $tmp_fh, 0, 0;
+    while (1) {
+        my $status = read $tmp_fh, my $buf, 4*1024;
+        unless ( defined $status ) {
+            $RT::Logger->crit( "couldn't read message: $!" );
+        } elsif ( !$status ) {
+            last;
+        }
+        ${ $args{'Content'} } .= $buf;
+    }
+
+    return %res;
+}
+
+sub FindProtectedParts {
+    my %args = ( Entity => undef, CheckBody => 1, @_ );
+    my $entity = $args{'Entity'};
+
+    # inline PGP block, only in singlepart
+    unless ( $entity->is_multipart ) {
+        my $io = $entity->open('r');
+        unless ( $io ) {
+            $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
+            return ();
+        }
+        while ( defined($_ = $io->getline) ) {
+            next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
+            my $type = $1? 'signed': 'encrypted';
+            $RT::Logger->debug("Found $type inline part");
+            return {
+                Type    => $type,
+                Format  => 'Inline',
+                Data  => $entity,
+            };
+        }
+        $io->close;
+        return ();
+    }
+
+    # RFC3156, multipart/{signed,encrypted}
+    if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
+        unless ( $entity->parts == 2 ) {
+            $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
+            return ();
+        }
+
+        my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
+        unless ( $protocol ) {
+            $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
+            return ();
+        }
+
+        if ( $type eq 'multipart/encrypted' ) {
+            unless ( $protocol eq 'application/pgp-encrypted' ) {
+                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
+                return ();
+            }
+            $RT::Logger->debug("Found encrypted according to RFC3156 part");
+            return {
+                Type    => 'encrypted',
+                Format  => 'RFC3156',
+                Top   => $entity,
+                Data  => $entity->parts(1),
+                Info    => $entity->parts(0),
+            };
+        } else {
+            unless ( $protocol eq 'application/pgp-signature' ) {
+                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
+                return ();
+            }
+            $RT::Logger->debug("Found signed according to RFC3156 part");
+            return {
+                Type      => 'signed',
+                Format    => 'RFC3156',
+                Top     => $entity,
+                Data    => $entity->parts(0),
+                Signature => $entity->parts(1),
+            };
+        }
+    }
+
+    # attachments signed with signature in another part
+    my @file_indices;
+    foreach my $i ( 0 .. $entity->parts - 1 ) {
+        my $part = $entity->parts($i);
+
+        # we can not associate a signature within an attachment
+        # without file names
+        my $fname = $part->head->recommended_filename;
+        next unless $fname;
+
+        if ( $part->effective_type eq 'application/pgp-signature' ) {
+            push @file_indices, $i;
+        }
+        elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
+            push @file_indices, $i;
+        }
+    }
+
+    my (@res, %skip);
+    foreach my $i ( @file_indices ) {
+        my $sig_part = $entity->parts($i);
+        $skip{"$sig_part"}++;
+        my $sig_name = $sig_part->head->recommended_filename;
+        my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
+
+        my ($data_part_idx) =
+            grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
+            grep $sig_part  ne  $entity->parts($_),
+                0 .. $entity->parts - 1;
+        unless ( defined $data_part_idx ) {
+            $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
+            next;
+        }
+        my $data_part_in = $entity->parts($data_part_idx);
+
+        $skip{"$data_part_in"}++;
+        $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
+        push @res, {
+            Type      => 'signed',
+            Format    => 'Attachment',
+            Top       => $entity,
+            Data      => $data_part_in,
+            Signature => $sig_part,
+        };
+    }
+
+    # attachments with inline encryption
+    my @encrypted_indices =
+        grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.pgp$/}
+            0 .. $entity->parts - 1;
+
+    foreach my $i ( @encrypted_indices ) {
+        my $part = $entity->parts($i);
+        $skip{"$part"}++;
+        $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
+        push @res, {
+            Type      => 'encrypted',
+            Format    => 'Attachment',
+            Top     => $entity,
+            Data    => $part,
+        };
+    }
+
+    push @res, FindProtectedParts( Entity => $_ )
+        foreach grep !$skip{"$_"}, $entity->parts;
+
+    return @res;
+}
+
+=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
+
+=cut
+
+sub VerifyDecrypt {
+    my %args = ( Entity => undef, Detach => 1, SetStatus => 1, @_ );
+    my @protected = FindProtectedParts( Entity => $args{'Entity'} );
+    my @res;
+    # XXX: detaching may brake nested signatures
+    foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
+        if ( $item->{'Format'} eq 'RFC3156' ) {
+            push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
+            if ( $args{'Detach'} ) {
+                $item->{'Top'}->parts( [ $item->{'Data'} ] );
+                $item->{'Top'}->make_singlepart;
+            }
+            $item->{'Top'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        } elsif ( $item->{'Format'} eq 'Inline' ) {
+            push @res, { VerifyInline( %$item ) };
+            $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        } elsif ( $item->{'Format'} eq 'Attachment' ) {
+            push @res, { VerifyAttachment( %$item ) };
+            if ( $args{'Detach'} ) {
+                $item->{'Top'}->parts( [ grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts ] );
+                $item->{'Top'}->make_singlepart;
+            }
+            $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        }
+    }
+    foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
+        if ( $item->{'Format'} eq 'RFC3156' ) {
+            push @res, { DecryptRFC3156( %$item ) };
+            $item->{'Top'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        } elsif ( $item->{'Format'} eq 'Inline' ) {
+            push @res, { DecryptInline( %$item ) };
+            $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        } elsif ( $item->{'Format'} eq 'Attachment' ) {
+            push @res, { DecryptAttachment( %$item ) };
+            $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} )
+                if $args{'SetStatus'};
+        }
+    }
+    return @res;
+}
+
+sub VerifyInline { return DecryptInline( @_ ) }
+
+sub VerifyAttachment {
+    my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    foreach ( $args{'Data'}, $args{'Signature'} ) {
+        next unless $_->bodyhandle->is_encoded;
+
+        require RT::EmailParser;
+        RT::EmailParser->_DecodeBody($_);
+    }
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+    $args{'Data'}->bodyhandle->print( $tmp_fh );
+    $tmp_fh->flush;
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    my %res;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $pid = safe_run_child { $gnupg->verify(
+            handles => $handles, command_args => [ '-', $tmp_fn ]
+        ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
+            close $handle{'stdin'};
+        }
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $@ || $? ) {
+        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+    }
+    return %res;
+}
+
+sub VerifyRFC3156 {
+    my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw:eol(CRLF?)';
+    $args{'Data'}->print( $tmp_fh );
+    $tmp_fh->flush;
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    my %res;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $pid = safe_run_child { $gnupg->verify(
+            handles => $handles, command_args => [ '-', $tmp_fn ]
+        ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
+            close $handle{'stdin'};
+        }
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $@ || $? ) {
+        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+    }
+    return %res;
+}
+
+sub DecryptRFC3156 {
+    my %args = (
+        Data => undef,
+        Info => undef,
+        Top => undef,
+        Passphrase => undef,
+        @_
+    );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnupGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Data'}->bodyhandle->is_encoded ) {
+        require RT::EmailParser;
+        RT::EmailParser->_DecodeBody($args{'Data'});
+    }
+
+    $args{'Passphrase'} = GetPassphrase()
+        unless defined $args{'Passphrase'};
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
+    my %handle = %$handle_list;
+    $handles->options( 'stdout' )->{'direct'} = 1;
+
+    my %res;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        $gnupg->passphrase( $args{'Passphrase'} );
+        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
+            close $handle{'stdin'}
+        }
+
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+
+    # if the decryption is fine but the signature is bad, then without this
+    # status check we lose the decrypted text
+    # XXX: add argument to the function to control this check
+    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
+        if ( $@ || $? ) {
+            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+            return %res;
+        }
+    }
+
+    seek $tmp_fh, 0, 0;
+    my $parser = new RT::EmailParser;
+    my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
+    $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
+    $args{'Top'}->parts( [] );
+    $args{'Top'}->add_part( $decrypted );
+    $args{'Top'}->make_singlepart;
+    return %res;
+}
+
+sub DecryptInline {
+    my %args = (
+        Data => undef,
+        Passphrase => undef,
+        @_
+    );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnuPGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Data'}->bodyhandle->is_encoded ) {
+        require RT::EmailParser;
+        RT::EmailParser->_DecodeBody($args{'Data'});
+    }
+
+    $args{'Passphrase'} = GetPassphrase()
+        unless defined $args{'Passphrase'};
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my $io = $args{'Data'}->open('r');
+    unless ( $io ) {
+        die "Entity has no body, never should happen";
+    }
+
+    my ($had_literal, $in_block) = ('', 0);
+    my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $block_fh, ':raw';
+
+    my %res;
+    while ( defined(my $str = $io->getline) ) {
+        if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
+            print $block_fh $str;
+            $in_block--;
+            next if $in_block > 0;
+
+            seek $block_fh, 0, 0;
+
+            my ($res_fh, $res_fn);
+            ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
+                %args,
+                GnuPG => $gnupg,
+                BlockHandle => $block_fh,
+            );
+            return %res unless $res_fh;
+
+            print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
+            while (my $buf = <$res_fh> ) {
+                print $tmp_fh $buf;
+            }
+            print $tmp_fh "-----END OF PART-----\n" if $had_literal;
+
+            ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
+            binmode $block_fh, ':raw';
+            $in_block = 0;
+        }
+        elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
+            $in_block++;
+            print $block_fh $str;
+        }
+        elsif ( $in_block ) {
+            print $block_fh $str;
+        }
+        else {
+            print $tmp_fh $str;
+            $had_literal = 1 if /\S/s;
+        }
+    }
+    $io->close;
+
+    seek $tmp_fh, 0, 0;
+    $args{'Data'}->bodyhandle( new MIME::Body::File $tmp_fn );
+    $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
+    return %res;
+}
+
+sub _DecryptInlineBlock {
+    my %args = (
+        GnuPG => undef,
+        BlockHandle => undef,
+        Passphrase => undef,
+        @_
+    );
+    my $gnupg = $args{'GnuPG'};
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(
+            stdin => $args{'BlockHandle'}, 
+            stdout => $tmp_fh);
+    my %handle = %$handle_list;
+    $handles->options( 'stdout' )->{'direct'} = 1;
+    $handles->options( 'stdin' )->{'direct'} = 1;
+
+    my %res;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        $gnupg->passphrase( $args{'Passphrase'} );
+        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+
+    # if the decryption is fine but the signature is bad, then without this
+    # status check we lose the decrypted text
+    # XXX: add argument to the function to control this check
+    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
+        if ( $@ || $? ) {
+            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+            return (undef, undef, %res);
+        }
+    }
+
+    seek $tmp_fh, 0, 0;
+    return ($tmp_fh, $tmp_fn, %res);
+}
+
+sub DecryptAttachment {
+    my %args = (
+        Top  => undef,
+        Data => undef,
+        Passphrase => undef,
+        @_
+    );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnuPGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    if ( $args{'Data'}->bodyhandle->is_encoded ) {
+        require RT::EmailParser;
+        RT::EmailParser->_DecodeBody($args{'Data'});
+    }
+
+    $args{'Passphrase'} = GetPassphrase()
+        unless defined $args{'Passphrase'};
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+    $args{'Data'}->bodyhandle->print( $tmp_fh );
+    seek $tmp_fh, 0, 0;
+
+    my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
+        %args,
+        GnuPG => $gnupg,
+        BlockHandle => $tmp_fh,
+    );
+    return %res unless $res_fh;
+
+    $args{'Data'}->bodyhandle( new MIME::Body::File $res_fn );
+    $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
+
+    my $filename = $args{'Data'}->head->recommended_filename;
+    $filename =~ s/\.pgp$//i;
+    $args{'Data'}->head->mime_attr( $_ => $filename )
+        foreach (qw(Content-Type.name Content-Disposition.filename));
+
+    return %res;
+}
+
+sub DecryptContent {
+    my %args = (
+        Content => undef,
+        Passphrase => undef,
+        @_
+    );
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+
+    # handling passphrase in GnupGOptions
+    $args{'Passphrase'} = delete $opt{'passphrase'}
+        if !defined($args{'Passphrase'});
+
+    $opt{'digest-algo'} ||= 'SHA1';
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    $args{'Passphrase'} = GetPassphrase()
+        unless defined $args{'Passphrase'};
+
+    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
+    binmode $tmp_fh, ':raw';
+
+    my ($handles, $handle_list) = _make_gpg_handles(
+            stdout => $tmp_fh);
+    my %handle = %$handle_list;
+    $handles->options( 'stdout' )->{'direct'} = 1;
+
+    my %res;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        $gnupg->passphrase( $args{'Passphrase'} );
+        my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
+        {
+            local $SIG{'PIPE'} = 'IGNORE';
+            print { $handle{'stdin'} } ${ $args{'Content'} };
+            close $handle{'stdin'};
+        }
+
+        waitpid $pid, 0;
+    };
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+
+    # if the decryption is fine but the signature is bad, then without this
+    # status check we lose the decrypted text
+    # XXX: add argument to the function to control this check
+    if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
+        if ( $@ || $? ) {
+            $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+            return %res;
+        }
+    }
+
+    ${ $args{'Content'} } = '';
+    seek $tmp_fh, 0, 0;
+    while (1) {
+        my $status = read $tmp_fh, my $buf, 4*1024;
+        unless ( defined $status ) {
+            $RT::Logger->crit( "couldn't read message: $!" );
+        } elsif ( !$status ) {
+            last;
+        }
+        ${ $args{'Content'} } .= $buf;
+    }
+
+    return %res;
+}
+
+=head2 GetPassphrase [ Address => undef ]
+
+Returns passphrase, called whenever it's required with Address as a named argument.
+
+=cut
+
+sub GetPassphrase {
+    my %args = ( Address => undef, @_ );
+    return 'test';
+}
+
+=head2 ParseStatus
+
+Takes a string containing output of gnupg status stream. Parses it and returns
+array of hashes. Each element of array is a hash ref and represents line or
+group of lines in the status message.
+
+All hashes have Operation, Status and Message elements.
+
+=over
+
+=item Operation
+
+Classification of operations gnupg performs. Now we have support
+for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
+values.
+
+=item Status
+
+Informs about success. Value is 'DONE' on success, other values means that
+an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
+
+=item Message
+
+User friendly message.
+
+=back
+
+This parser is based on information from GnuPG distribution, see also
+F in the RT distribution.
+
+=cut
+
+my %REASON_CODE_TO_TEXT = (
+    NODATA => {
+        1 => "No armored data",
+        2 => "Expected a packet, but did not found one",
+        3 => "Invalid packet found",
+        4 => "Signature expected, but not found",
+    },
+    INV_RECP => {
+        0 => "No specific reason given",
+        1 => "Not Found",
+        2 => "Ambigious specification",
+        3 => "Wrong key usage",
+        4 => "Key revoked",
+        5 => "Key expired",
+        6 => "No CRL known",
+        7 => "CRL too old",
+        8 => "Policy mismatch",
+        9 => "Not a secret key",
+        10 => "Key not trusted",
+    },
+    ERRSIG => {
+        0 => 'not specified',
+        4 => 'unknown algorithm',
+        9 => 'missing public key',
+    },
+);
+
+sub ReasonCodeToText {
+    my $keyword = shift;
+    my $code = shift;
+    return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
+        if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
+    return 'unknown';
+}
+
+my %simple_keyword = (
+    NO_RECP => {
+        Operation => 'RecipientsCheck',
+        Status    => 'ERROR',
+        Message   => 'No recipients',
+    },
+    UNEXPECTED => {
+        Operation => 'Data',
+        Status    => 'ERROR',
+        Message   => 'Unexpected data has been encountered',
+    },
+    BADARMOR => {
+        Operation => 'Data',
+        Status    => 'ERROR',
+        Message   => 'The ASCII armor is corrupted',
+    },
+);
+
+# keywords we parse
+my %parse_keyword = map { $_ => 1 } qw(
+    USERID_HINT
+    SIG_CREATED GOODSIG BADSIG ERRSIG
+    END_ENCRYPTION
+    DECRYPTION_FAILED DECRYPTION_OKAY
+    BAD_PASSPHRASE GOOD_PASSPHRASE
+    NO_SECKEY NO_PUBKEY
+    NO_RECP INV_RECP NODATA UNEXPECTED
+);
+
+# keywords we ignore without any messages as we parse them using other
+# keywords as starting point or just ignore as they are useless for us
+my %ignore_keyword = map { $_ => 1 } qw(
+    NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
+    BEGIN_ENCRYPTION SIG_ID VALIDSIG
+    ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
+    TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
+);
+
+sub ParseStatus {
+    my $status = shift;
+    return () unless $status;
+
+    my @status;
+    while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
+        push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
+    }
+    $status = join "\n", @status;
+    study $status;
+
+    my @res;
+    my (%user_hint, $latest_user_main_key);
+    for ( my $i = 0; $i < @status; $i++ ) {
+        my $line = $status[$i];
+        my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
+        if ( $simple_keyword{ $keyword } ) {
+            push @res, $simple_keyword{ $keyword };
+            $res[-1]->{'Keyword'} = $keyword;
+            next;
+        }
+        unless ( $parse_keyword{ $keyword } ) {
+            $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
+            next;
+        }
+
+        if ( $keyword eq 'USERID_HINT' ) {
+            my %tmp = _ParseUserHint($status, $line);
+            $latest_user_main_key = $tmp{'MainKey'};
+            if ( $user_hint{ $tmp{'MainKey'} } ) {
+                while ( my ($k, $v) = each %tmp ) {
+                    $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
+                }
+            } else {
+                $user_hint{ $tmp{'MainKey'} } = \%tmp;
+            }
+            next;
+        }
+        elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
+            my $key_id = $args;
+            my %res = (
+                Operation => 'PassphraseCheck',
+                Status    => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
+                Key       => $key_id,
+            );
+            $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
+            foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
+                next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
+                next if $key_id && $2 ne $key_id;
+                @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
+                last;
+            }
+            $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
+            $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
+            if ( exists $res{'User'}->{'EmailAddress'} ) {
+                $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
+            } else {
+                $res{'Message'} .= " for '0x$key_id'";
+            }
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'END_ENCRYPTION' ) {
+            my %res = (
+                Operation => 'Encrypt',
+                Status    => 'DONE',
+                Message   => 'Data has been encrypted',
+            );
+            foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
+                next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
+                @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
+                last;
+            }
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
+            my %res = ( Operation => 'Decrypt' );
+            @res{'Status', 'Message'} = 
+                $keyword eq 'DECRYPTION_FAILED'
+                ? ('ERROR', 'Decryption failed')
+                : ('DONE',  'Decryption process succeeded');
+
+            foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
+                next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
+                my ($key, $alg, $key_length) = ($1, $2, $3);
+
+                my %encrypted_to = (
+                    Message   => "The message is encrypted to '0x$key'",
+                    User      => ( $user_hint{ $key } ||= {} ),
+                    Key       => $key,
+                    KeyLength => $key_length,
+                    Algorithm => $alg,
+                );
+
+                push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
+            }
+
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
+            my ($key) = split /\s+/, $args;
+            my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
+            my %res = (
+                Operation => 'KeyCheck',
+                Status    => 'MISSING',
+                Message   => ucfirst( $type ) ." key '0x$key' is not available",
+                Key       => $key,
+                KeyType   => $type,
+            );
+            $res{'User'} = ( $user_hint{ $key } ||= {} );
+            $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
+            push @res, \%res;
+        }
+        # GOODSIG, BADSIG, VALIDSIG, TRUST_*
+        elsif ( $keyword eq 'GOODSIG' ) {
+            my %res = (
+                Operation  => 'Verify',
+                Status     => 'DONE',
+                Message    => 'The signature is good',
+            );
+            @res{qw(Key UserString)} = split /\s+/, $args, 2;
+            $res{'Message'} .= ', signed by '. $res{'UserString'};
+
+            foreach my $line ( @status[ $i .. $#status ] ) {
+                next unless $line =~ /^TRUST_(\S+)/;
+                $res{'Trust'} = $1;
+                last;
+            }
+            $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
+
+            foreach my $line ( @status[ $i .. $#status ] ) {
+                next unless $line =~ /^VALIDSIG\s+(.*)/;
+                @res{ qw(
+                    Fingerprint
+                    CreationDate
+                    Timestamp
+                    ExpireTimestamp
+                    Version
+                    Reserved
+                    PubkeyAlgo
+                    HashAlgo
+                    Class
+                    PKFingerprint
+                    Other
+                ) } = split /\s+/, $1, 10;
+                last;
+            }
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'BADSIG' ) {
+            my %res = (
+                Operation  => 'Verify',
+                Status     => 'BAD',
+                Message    => 'The signature has not been verified okay',
+            );
+            @res{qw(Key UserString)} = split /\s+/, $args, 2;
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'ERRSIG' ) {
+            my %res = (
+                Operation => 'Verify',
+                Status    => 'ERROR',
+                Message   => 'Not possible to check the signature',
+            );
+            @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
+                = split /\s+/, $args, 7;
+
+            $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
+            $res{'Message'} .= ", the reason is ". $res{'Reason'};
+
+            push @res, \%res;
+        }
+        elsif ( $keyword eq 'SIG_CREATED' ) {
+            # SIG_CREATED      
+            my @props = split /\s+/, $args;
+            push @res, {
+                Operation      => 'Sign',
+                Status         => 'DONE',
+                Message        => "Signed message",
+                Type           => $props[0],
+                PubKeyAlgo     => $props[1],
+                HashKeyAlgo    => $props[2],
+                Class          => $props[3],
+                Timestamp      => $props[4],
+                KeyFingerprint => $props[5],
+                User           => $user_hint{ $latest_user_main_key },
+            };
+            $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
+                if $user_hint{ $latest_user_main_key };
+        }
+        elsif ( $keyword eq 'INV_RECP' ) {
+            my ($rcode, $recipient) = split /\s+/, $args, 2;
+            my $reason = ReasonCodeToText( $keyword, $rcode );
+            push @res, {
+                Operation  => 'RecipientsCheck',
+                Status     => 'ERROR',
+                Message    => "Recipient '$recipient' is unusable, the reason is '$reason'",
+                Recipient  => $recipient,
+                ReasonCode => $rcode,
+                Reason     => $reason,
+            };
+        }
+        elsif ( $keyword eq 'NODATA' ) {
+            my $rcode = (split /\s+/, $args)[0];
+            my $reason = ReasonCodeToText( $keyword, $rcode );
+            push @res, {
+                Operation  => 'Data',
+                Status     => 'ERROR',
+                Message    => "No data has been found. The reason is '$reason'",
+                ReasonCode => $rcode,
+                Reason     => $reason,
+            };
+        }
+        else {
+            $RT::Logger->warning("Keyword $keyword is unknown");
+            next;
+        }
+        $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
+    }
+    return @res;
+}
+
+sub _ParseUserHint {
+    my ($status, $hint) = (@_);
+    my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
+    return () unless $main_key_id;
+    return (
+        MainKey      => $main_key_id,
+        String       => $user_str,
+        EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
+    );
+}
+
+sub _PrepareGnuPGOptions {
+    my %opt = @_;
+    my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
+    $res{'extra_args'} ||= [];
+    foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
+        push @{ $res{'extra_args'} }, '--'. lc $o;
+        push @{ $res{'extra_args'} }, $opt{ $o }
+            if defined $opt{ $o };
+    }
+    return %res;
+}
+
+{ my %key;
+# no args -> clear
+# one arg -> return preferred key
+# many -> set
+sub UseKeyForEncryption {
+    unless ( @_ ) {
+        %key = ();
+    } elsif ( @_ > 1 ) {
+        %key = (%key, @_);
+        $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
+    } else {
+        return $key{ $_[0] };
+    }
+    return ();
+} }
+
+=head2 UseKeyForSigning
+
+Returns or sets identifier of the key that should be used for signing.
+
+Returns the current value when called without arguments.
+
+Sets new value when called with one argument and unsets if it's undef.
+
+=cut
+
+{ my $key;
+sub UseKeyForSigning {
+    if ( @_ ) {
+        $key = $_[0];
+    }
+    return $key;
+} }
+
+=head2 GetKeysForEncryption
+
+Takes identifier and returns keys suitable for encryption.
+
+B that keys for which trust level is not set are
+also listed.
+
+=cut
+
+sub GetKeysForEncryption {
+    my $key_id = shift;
+    my %res = GetKeysInfo( $key_id, 'public', @_ );
+    return %res if $res{'exit_code'};
+    return %res unless $res{'info'};
+
+    foreach my $key ( splice @{ $res{'info'} } ) {
+        # skip disabled keys
+        next if $key->{'Capabilities'} =~ /D/;
+        # skip keys not suitable for encryption
+        next unless $key->{'Capabilities'} =~ /e/i;
+        # skip disabled, expired, revoke and keys with no trust,
+        # but leave keys with unknown trust level
+        next if $key->{'TrustLevel'} < 0;
+
+        push @{ $res{'info'} }, $key;
+    }
+    delete $res{'info'} unless @{ $res{'info'} };
+    return %res;
+}
+
+sub GetKeysForSigning {
+    my $key_id = shift;
+    return GetKeysInfo( $key_id, 'private', @_ );
+}
+
+sub CheckRecipients {
+    my @recipients = (@_);
+
+    my ($status, @issues) = (1, ());
+
+    my %seen;
+    foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
+        my %res = GetKeysForEncryption( $address );
+        if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
+            # good, one suitable and trusted key 
+            next;
+        }
+        my $user = RT::User->new( $RT::SystemUser );
+        $user->LoadByEmail( $address );
+        # it's possible that we have no User record with the email
+        $user = undef unless $user->id;
+
+        if ( my $fpr = UseKeyForEncryption( $address ) ) {
+            if ( $res{'info'} && @{ $res{'info'} } ) {
+                next if
+                    grep lc $_->{'Fingerprint'} eq lc $fpr,
+                    grep $_->{'TrustLevel'} > 0,
+                    @{ $res{'info'} };
+            }
+
+            $status = 0;
+            my %issue = (
+                EmailAddress => $address,
+                $user? (User => $user) : (),
+                Keys => undef,
+            );
+            $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
+            push @issues, \%issue;
+            next;
+        }
+
+        my $prefered_key;
+        $prefered_key = $user->PreferredKey if $user;
+        #XXX: prefered key is not yet implemented...
+
+        # classify errors
+        $status = 0;
+        my %issue = (
+            EmailAddress => $address,
+            $user? (User => $user) : (),
+            Keys => undef,
+        );
+
+        unless ( $res{'info'} && @{ $res{'info'} } ) {
+            # no key
+            $issue{'Message'} = "There is no key suitable for encryption."; #loc
+        }
+        elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
+            # trust is not set
+            $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
+        }
+        else {
+            # multiple keys
+            $issue{'Message'} = "There are several keys suitable for encryption."; #loc
+        }
+        push @issues, \%issue;
+    }
+    return ($status, @issues);
+}
+
+sub GetPublicKeyInfo {
+    return GetKeyInfo( shift, 'public', @_ );
+}
+
+sub GetPrivateKeyInfo {
+    return GetKeyInfo( shift, 'private', @_ );
+}
+
+sub GetKeyInfo {
+    my %res = GetKeysInfo(@_);
+    $res{'info'} = $res{'info'}->[0];
+    return %res;
+}
+
+sub GetKeysInfo {
+    my $email = shift;
+    my $type = shift || 'public';
+    my $force = shift;
+
+    unless ( $email ) {
+        return (exit_code => 0) unless $force;
+    }
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $opt{'digest-algo'} ||= 'SHA1';
+    $opt{'with-colons'} = undef; # parseable format
+    $opt{'fingerprint'} = undef; # show fingerprint
+    $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    my %res;
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
+        my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email? (command_args => $email) : () ) };
+        close $handle{'stdin'};
+        waitpid $pid, 0;
+    };
+
+    my @info = readline $handle{'stdout'};
+    close $handle{'stdout'};
+
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $@ || $? ) {
+        $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
+        return %res;
+    }
+
+    @info = ParseKeysInfo( @info );
+    $res{'info'} = \@info;
+    return %res;
+}
+
+sub ParseKeysInfo {
+    my @lines = @_;
+
+    my %gpg_opt = RT->Config->Get('GnuPGOptions');
+
+    my @res = ();
+    foreach my $line( @lines ) {
+        chomp $line;
+        my $tag;
+        ($tag, $line) = split /:/, $line, 2;
+        if ( $tag eq 'pub' ) {
+            my %info;
+            @info{ qw(
+                TrustChar KeyLength Algorithm Key
+                Created Expire Empty OwnerTrustChar
+                Empty Empty Capabilities Other
+            ) } = split /:/, $line, 12;
+
+            # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
+            # for any model except 'always', so you can change models and see changes, but not for 'always'
+            # we try to handle it in a simple way - we set ultimate trust for any key with trust
+            # level >= 0 if trust model is 'always'
+            my $always_trust;
+            $always_trust = 1 if exists $gpg_opt{'always-trust'};
+            $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
+            @info{qw(Trust TrustTerse TrustLevel)} = 
+                _ConvertTrustChar( $info{'TrustChar'} );
+            if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
+                @info{qw(Trust TrustTerse TrustLevel)} = 
+                    _ConvertTrustChar( 'u' );
+            }
+
+            @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
+                _ConvertTrustChar( $info{'OwnerTrustChar'} );
+            $info{ $_ } = _ParseDate( $info{ $_ } )
+                foreach qw(Created Expire);
+            push @res, \%info;
+        }
+        elsif ( $tag eq 'sec' ) {
+            my %info;
+            @info{ qw(
+                Empty KeyLength Algorithm Key
+                Created Expire Empty OwnerTrustChar
+                Empty Empty Capabilities Other
+            ) } = split /:/, $line, 12;
+            @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
+                _ConvertTrustChar( $info{'OwnerTrustChar'} );
+            $info{ $_ } = _ParseDate( $info{ $_ } )
+                foreach qw(Created Expire);
+            push @res, \%info;
+        }
+        elsif ( $tag eq 'uid' ) {
+            my %info;
+            @info{ qw(Trust Created Expire String) }
+                = (split /:/, $line)[0,4,5,8];
+            $info{ $_ } = _ParseDate( $info{ $_ } )
+                foreach qw(Created Expire);
+            push @{ $res[-1]{'User'} ||= [] }, \%info;
+        }
+        elsif ( $tag eq 'fpr' ) {
+            $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
+        }
+    }
+    return @res;
+}
+
+{
+    my %verbose = (
+        # deprecated
+        d   => [
+            "The key has been disabled", #loc
+            "key disabled", #loc
+            "-2"
+        ],
+
+        r   => [
+            "The key has been revoked", #loc
+            "key revoked", #loc
+            -3,
+        ],
+
+        e   => [ "The key has expired", #loc
+            "key expired", #loc
+            '-4',
+        ],
+
+        n   => [ "Don't trust this key at all", #loc
+            'none', #loc
+            -1,
+        ],
+
+        #gpupg docs says that '-' and 'q' may safely be treated as the same value
+        '-' => [
+            'Unknown (no trust value assigned)', #loc
+            'not set',
+            0,
+        ],
+        q   => [
+            'Unknown (no trust value assigned)', #loc
+            'not set',
+            0,
+        ],
+        o   => [
+            'Unknown (this value is new to the system)', #loc
+            'unknown',
+            0,
+        ],
+
+        m   => [
+            "There is marginal trust in this key", #loc
+            'marginal', #loc
+            1,
+        ],
+        f   => [
+            "The key is fully trusted", #loc
+            'full', #loc
+            2,
+        ],
+        u   => [
+            "The key is ultimately trusted", #loc
+            'ultimate', #loc
+            3,
+        ],
+    );
+
+    sub _ConvertTrustChar {
+        my $value = shift;
+        return @{ $verbose{'-'} } unless $value;
+        $value = substr $value, 0, 1;
+        return @{ $verbose{ $value } || $verbose{'o'} };
+    }
+}
+
+sub _ParseDate {
+    my $value = shift;
+    # never
+    return $value unless $value;
+
+    require RT::Date;
+    my $obj = RT::Date->new( $RT::SystemUser );
+    # unix time
+    if ( $value =~ /^\d+$/ ) {
+        $obj->Set( Value => $value );
+    } else {
+        $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
+    }
+    return $obj;
+}
+
+sub DeleteKey {
+    my $key = shift;
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        local @ENV{'LANG', 'LC_ALL'} = ('C', 'C');
+        my $pid = safe_run_child { $gnupg->wrap_call(
+            handles => $handles,
+            commands => ['--delete-secret-and-public-key'],
+            command_args => [$key],
+        ) };
+        close $handle{'stdin'};
+        while ( my $str = readline $handle{'status'} ) {
+            if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
+                print { $handle{'command'} } "y\n";
+            }
+        }
+        waitpid $pid, 0;
+    };
+    my $err = $@;
+    close $handle{'stdout'};
+
+    my %res;
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+    }
+    return %res;
+}
+
+sub ImportKey {
+    my $key = shift;
+
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        meta_interactive => 0,
+    );
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        local @ENV{'LANG', 'LC_ALL'} = ('C', 'C');
+        my $pid = safe_run_child { $gnupg->wrap_call(
+            handles => $handles,
+            commands => ['--import'],
+        ) };
+        print { $handle{'stdin'} } $key;
+        close $handle{'stdin'};
+        waitpid $pid, 0;
+    };
+    my $err = $@;
+    close $handle{'stdout'};
+
+    my %res;
+    $res{'exit_code'} = $?;
+    foreach ( qw(stderr logger status) ) {
+        $res{$_} = do { local $/; readline $handle{$_} };
+        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
+        close $handle{$_};
+    }
+    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
+    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
+    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
+    if ( $err || $res{'exit_code'} ) {
+        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
+    }
+    return %res;
+}
+
+=head2 KEY
+
+Signs a small message with the key, to make sure the key exists and 
+we have a useable passphrase. The first argument MUST be a key identifier
+of the signer: either email address, key id or finger print.
+
+Returns a true value if all went well.
+
+=cut
+
+sub DrySign {
+    my $from = shift;
+
+    my $mime = MIME::Entity->build(
+        Type    => "text/plain",
+        From    => 'nobody@localhost',
+        To      => 'nobody@localhost',
+        Subject => "dry sign",
+        Data    => ['t'],
+    );
+
+    my %res = SignEncrypt(
+        Sign    => 1,
+        Encrypt => 0,
+        Entity  => $mime,
+        Signer  => $from,
+    );
+
+    return $res{exit_code} == 0;
+}
+
+1;
+
+=head2 Probe
+
+This routine returns true if RT's GnuPG support is configured and working 
+properly (and false otherwise).
+
+
+=cut
+
+
+sub Probe {
+    my $gnupg = new GnuPG::Interface;
+    my %opt = RT->Config->Get('GnuPGOptions');
+    $gnupg->options->hash_init(
+        _PrepareGnuPGOptions( %opt ),
+        armor => 1,
+        meta_interactive => 0,
+    );
+
+    my ($handles, $handle_list) = _make_gpg_handles();
+    my %handle = %$handle_list;
+
+    local $@;
+    eval {
+        local $SIG{'CHLD'} = 'DEFAULT';
+        my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
+        close $handle{'stdin'};
+        waitpid $pid, 0;
+    };
+    if ( $@ ) {
+        $RT::Logger->debug(
+            "Probe for GPG failed."
+            ." Couldn't run `gpg --version`: ". $@
+        );
+        return 0;
+    }
+
+# on some systems gpg exits with code 2, but still 100% functional,
+# it's general error system error or incorrect command, command is correct,
+# but there is no way to get actuall error
+    if ( $? && ($? >> 8) != 2 ) {
+        $RT::Logger->debug(
+            "Probe for GPG failed."
+            ." Process exitted with code ". ($? >> 8)
+            . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
+        );
+        return 0;
+    }
+    return 1;
+}
+
+
+sub _make_gpg_handles {
+    my %handle_map = (
+        stdin  => IO::Handle->new(),
+        stdout => IO::Handle->new(),
+        stderr => IO::Handle->new(),
+        logger => IO::Handle->new(),
+        status => IO::Handle->new(),
+        command => IO::Handle->new(),
+
+
+            @_);
+
+    my $handles = GnuPG::Handles->new(%handle_map);
+    return ($handles, \%handle_map);
+}
+
+eval "require RT::Crypt::GnuPG_Vendor";
+if ($@ && $@ !~ qr{^Can't locate RT/Crypt/GnuPG_Vendor.pm}) {
+    die $@;
+};
+
+eval "require RT::Crypt::GnuPG_Local";
+if ($@ && $@ !~ qr{^Can't locate RT/Crypt/GnuPG_Local.pm}) {
+    die $@;
+};
+
+# helper package to avoid using temp file
+package IO::Handle::CRLF;
+
+use base qw(IO::Handle);
+
+sub print {
+    my ($self, @args) = (@_);
+    s/\r*\n/\x0D\x0A/g foreach @args;
+    return $self->SUPER::print( @args );
+}
+
+1;
diff --git a/rt/lib/RT/CurrentUser.pm b/rt/lib/RT/CurrentUser.pm
index 3193034a5..b674d4e60 100755
--- a/rt/lib/RT/CurrentUser.pm
+++ b/rt/lib/RT/CurrentUser.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,39 +45,55 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::CurrentUser - an RT object representing the current user
 
 =head1 SYNOPSIS
 
-  use RT::CurrentUser
+    use RT::CurrentUser;
+
+    # laod
+    my $current_user = new RT::CurrentUser;
+    $current_user->Load(...);
+    # or
+    my $current_user = RT::CurrentUser->new( $user_obj );
+    # or
+    my $current_user = RT::CurrentUser->new( $address || $name || $id );
+
+    # manipulation
+    $current_user->UserObj->SetName('new_name');
 
 
 =head1 DESCRIPTION
 
+B subclass of L class. Used to define the current
+user. You should pass an instance of this class to constructors of
+many RT classes, then the instance used to check ACLs and localize
+strings.
 
 =head1 METHODS
 
+See also L for a list of methods this class has.
 
-=begin testing
+=head2 new
 
-ok (require RT::CurrentUser);
-
-=end testing
+Returns new CurrentUser object. Unlike all other classes of RT it takes
+either subclass of C class object or scalar value that is
+passed to Load method.
 
 =cut
 
 
 package RT::CurrentUser;
 
-use RT::Record;
 use RT::I18N;
 
 use strict;
-use base qw/RT::Record/;
+use warnings;
 
-# {{{ sub _Init 
+use base qw/RT::User/;
 
 #The basic idea here is that $self->CurrentUser is always supposed
 # to be a CurrentUser object. but that's hard to do when we're trying to load
@@ -89,107 +105,69 @@ sub _Init {
 
     $self->{'table'} = "Users";
 
-    if ( defined($User) ) {
-
-        if (   UNIVERSAL::isa( $User, 'RT::User' )
-            || UNIVERSAL::isa( $User, 'RT::CurrentUser' ) )
-        {
-            $self->Load( $User->id );
+    if ( defined $User ) {
 
+        if ( UNIVERSAL::isa( $User, 'RT::User' ) ) {
+            $self->LoadById( $User->id );
         }
-        elsif ( ref($User) ) {
+        elsif ( ref $User ) {
             $RT::Logger->crit(
                 "RT::CurrentUser->new() called with a bogus argument: $User");
         }
         else {
-            $self->Load($User);
+            $self->Load( $User );
         }
     }
 
-    $self->_BuildTableAttributes();
+    $self->_BuildTableAttributes;
 
 }
-# }}}
 
-# {{{ sub Create
+=head2 Create, Delete and Set*
+
+As stated above it's a subclass of L, but this class is read-only
+and calls to these methods are illegal. Return 'permission denied' message
+and log an error.
+
+=cut
 
 sub Create {
     my $self = shift;
+    $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
     return (0, $self->loc('Permission Denied'));
 }
 
-# }}}
-
-# {{{ sub Delete
-
 sub Delete {
     my $self = shift;
+    $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
     return (0, $self->loc('Permission Denied'));
 }
 
-# }}}
-
-# {{{ sub UserObj
-
-=head2 UserObj
-
-  Returns the RT::User object associated with this CurrentUser object.
-
-=cut
-
-sub UserObj {
+sub _Set {
     my $self = shift;
-    
-	use RT::User;
-	my $user = RT::User->new($self);
-
-	unless ($user->Load($self->Id)) {
-	    $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id));
-	}
-    return ($user);
+    $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
+    return (0, $self->loc('Permission Denied'));
 }
-# }}}
-
-# {{{ sub PrincipalObj 
 
-=head2 PrincipalObj
+=head2 UserObj
 
-    Returns this user's principal object.  this is just a helper routine for
-    $self->UserObj->PrincipalObj
+Returns the L object associated with this CurrentUser object.
 
 =cut
 
-sub PrincipalObj {
+sub UserObj {
     my $self = shift;
-    return($self->UserObj->PrincipalObj);
-}
-
 
-# }}}
-
-
-# {{{ sub PrincipalId 
-
-=head2 PrincipalId
-
-    Returns this user's principal Id.  this is just a helper routine for
-    $self->UserObj->PrincipalId
-
-=cut
-
-sub PrincipalId {
-    my $self = shift;
-    return($self->UserObj->PrincipalId);
+    my $user = RT::User->new( $self );
+    unless ( $user->LoadById( $self->Id ) ) {
+        $RT::Logger->error(
+            $self->loc("Couldn't load [_1] from the users database.\n", $self->Id)
+        );
+    }
+    return $user;
 }
 
-
-# }}}
-
-
-# {{{ sub _Accessible 
-
-
- sub _CoreAccessible  {
+sub _CoreAccessible  {
      {
          Name           => { 'read' => 1 },
            Gecos        => { 'read' => 1 },
@@ -200,29 +178,6 @@ sub PrincipalId {
      };
   
 }
-# }}}
-
-# {{{ sub LoadByEmail
-
-=head2 LoadByEmail
-
-Loads a User into this CurrentUser object.
-Takes the email address of the user to load.
-
-=cut
-
-sub LoadByEmail  {
-    my $self = shift;
-    my $identifier = shift;
-
-    $identifier = RT::User::CanonicalizeEmailAddress(undef, $identifier);
-        
-    $self->LoadByCol("EmailAddress",$identifier);
-    
-}
-# }}}
-
-# {{{ sub LoadByGecos
 
 =head2 LoadByGecos
 
@@ -233,14 +188,8 @@ Takes a unix username as its only argument.
 
 sub LoadByGecos  {
     my $self = shift;
-    my $identifier = shift;
-        
-    $self->LoadByCol("Gecos",$identifier);
-    
+    return $self->LoadByCol( "Gecos", shift );
 }
-# }}}
-
-# {{{ sub LoadByName
 
 =head2 LoadByName
 
@@ -251,154 +200,50 @@ Takes a Name.
 
 sub LoadByName {
     my $self = shift;
-    my $identifier = shift;
-    $self->LoadByCol("Name",$identifier);
-    
-}
-# }}}
-
-# {{{ sub Load 
-
-=head2 Load
-
-Loads a User into this CurrentUser object.
-Takes either an integer (users id column reference) or a Name
-The latter is deprecated. Instead, you should use LoadByName.
-Formerly, this routine also took email addresses. 
-
-=cut
-
-sub Load  {
-  my $self = shift;
-  my $identifier = shift;
-
-  #if it's an int, load by id. otherwise, load by name.
-  if ($identifier !~ /\D/) {
-    $self->SUPER::LoadById($identifier);
-  }
-
-  elsif (UNIVERSAL::isa($identifier,"RT::User")) {
-         # DWIM if they pass a user in
-         $self->SUPER::LoadById($identifier->Id);
-  } 
-  else {
-      # This is a bit dangerous, we might get false authen if somebody
-      # uses ambigous userids or real names:
-      $self->LoadByCol("Name",$identifier);
-  }
-}
-
-# }}}
-
-# {{{ sub IsPassword
-
-=head2 IsPassword
-
-Takes a password as a string.  Passes it off to IsPassword in this
-user's UserObj.  If it is the user's password and the user isn't
-disabled, returns 1.
-
-Otherwise, returns undef.
-
-=cut
-
-sub IsPassword { 
-  my $self = shift;
-  my $value = shift;
-  
-  return ($self->UserObj->IsPassword($value)); 
-}
-
-# }}}
-
-# {{{ sub Privileged
-
-=head2 Privileged
-
-Returns true if the current user can be granted rights and be
-a member of groups.
-
-=cut
-
-sub Privileged {
-    my $self = shift;
-    return ($self->UserObj->Privileged());
-}
-
-# }}}
-
-
-# {{{ sub HasRight
-
-=head2 HasRight
-
-calls $self->UserObj->HasRight with the arguments passed in
-
-=cut
-
-sub HasRight {
-  my $self = shift;
-  return ($self->UserObj->HasRight(@_));
+    return $self->LoadByCol( "Name", shift );
 }
 
-# }}}
-
-# {{{ Localization
-
 =head2 LanguageHandle
 
 Returns this current user's langauge handle. Should take a language
 specification. but currently doesn't
 
-=begin testing
-
-ok (my $cu = RT::CurrentUser->new('root'));
-ok (my $lh = $cu->LanguageHandle('en-us'));
-ok (defined $lh);
-ok ($lh->isa('Locale::Maketext'));
-is ($cu->loc('TEST_STRING'), "Concrete Mixer", "Localized TEST_STRING into English");
-ok ($lh = $cu->LanguageHandle('fr'));
-SKIP: {
-    skip "fr locale is not loaded", 1 unless grep $_ eq 'fr', @RT::LexiconLanguages;
-    is ($cu->loc('Before'), "Avant", "Localized TEST_STRING into Frenc");
-}
-
-=end testing
-
 =cut 
 
 sub LanguageHandle {
     my $self = shift;
-    if (   ( !defined $self->{'LangHandle'} )
-        || ( !UNIVERSAL::can( $self->{'LangHandle'}, 'maketext' ) )
-        || (@_) ) {
-        if ( !$RT::SystemUser or ($self->id || 0) == $RT::SystemUser->id() ) {
-            @_ = qw(en-US);
+    if (   !defined $self->{'LangHandle'}
+        || !UNIVERSAL::can( $self->{'LangHandle'}, 'maketext' )
+        || @_ )
+    {
+        if ( my $lang = $self->Lang ) {
+            push @_, $lang;
         }
-
-        elsif ( $self->Lang ) {
-            push @_, $self->Lang;
+        elsif ( $self->id && ($self->id == ($RT::SystemUser->id||0) || $self->id == ($RT::Nobody->id||0)) ) {
+            # don't use ENV magic for system users
+            push @_, 'en';
         }
+
         $self->{'LangHandle'} = RT::I18N->get_handle(@_);
     }
 
     # Fall back to english.
     unless ( $self->{'LangHandle'} ) {
-        die "We couldn't get a dictionary. Nye mogu naidti slovar. No puedo encontrar dictionario.";
+        die "We couldn't get a dictionary. Ne mogu naidti slovar. No puedo encontrar dictionario.";
     }
-    return ( $self->{'LangHandle'} );
+    return $self->{'LangHandle'};
 }
 
 sub loc {
     my $self = shift;
-    return '' if $_[0] eq '';
+    return '' if !defined $_[0] || $_[0] eq '';
 
     my $handle = $self->LanguageHandle;
 
     if (@_ == 1) {
-	# pre-scan the lexicon hashes to return _AUTO keys verbatim,
-	# to keep locstrings containing '[' and '~' from tripping over Maketext
-	return $_[0] unless grep { exists $_->{$_[0]} } @{ $handle->_lex_refs };
+        # pre-scan the lexicon hashes to return _AUTO keys verbatim,
+        # to keep locstrings containing '[' and '~' from tripping over Maketext
+        return $_[0] unless grep exists $_->{$_[0]}, @{ $handle->_lex_refs };
     }
 
     return $handle->maketext(@_);
@@ -406,20 +251,17 @@ sub loc {
 
 sub loc_fuzzy {
     my $self = shift;
-    return '' if (!$_[0] ||  $_[0] eq '');
+    return '' if !defined $_[0] || $_[0] eq '';
 
     # XXX: work around perl's deficiency when matching utf8 data
     return $_[0] if Encode::is_utf8($_[0]);
-    my $result = $self->LanguageHandle->maketext_fuzzy(@_);
 
-    return($result);
+    return $self->LanguageHandle->maketext_fuzzy( @_ );
 }
-# }}}
-
 
 =head2 CurrentUser
 
-Return  the current currentuser object
+Return the current currentuser object
 
 =cut
 
@@ -437,9 +279,9 @@ representing whether the authentication succeeded.
 If both $nonce and $created are specified, validate $password against:
 
     encode_base64(sha1(
-	$nonce .
-	$created .
-	sha1_hex( "$username:$realm:$server_pass" )
+        $nonce .
+        $created .
+        sha1_hex( "$username:$realm:$server_pass" )
     ))
 
 where $server_pass is the md5_hex(password) digest stored in the
@@ -458,9 +300,9 @@ sub Authenticate {
     my $username = $self->UserObj->Name or return;
     my $server_pass = $self->UserObj->__Value('Password') or return;
     my $auth_digest = MIME::Base64::encode_base64(Digest::SHA1::sha1(
-	$nonce .
-	$created .
-	Digest::MD5::md5_hex("$username:$realm:$server_pass")
+        $nonce .
+        $created .
+        Digest::MD5::md5_hex("$username:$realm:$server_pass")
     ));
 
     chomp($password);
@@ -469,13 +311,9 @@ sub Authenticate {
     return ($password eq $auth_digest);
 }
 
-# }}}
-
-
 eval "require RT::CurrentUser_Vendor";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Vendor.pm});
 eval "require RT::CurrentUser_Local";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Local.pm});
 
 1;
- 
diff --git a/rt/lib/RT/CustomField.pm b/rt/lib/RT/CustomField.pm
index ba51d5b1c..995728f67 100644
--- a/rt/lib/RT/CustomField.pm
+++ b/rt/lib/RT/CustomField.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 # Autogenerated by DBIx::SearchBuilder factory (by )
 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
 # 
@@ -92,7 +93,7 @@ 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'.
+  longtext 'Pattern'.
   smallint(6) 'Repeated'.
   varchar(255) 'Description'.
   int(11) 'SortOrder'.
@@ -119,8 +120,10 @@ sub Create {
                 SortOrder => '0',
                 LookupType => '',
                 Disabled => '0',
+                LinkToValue => '',
+                IncludeContentForValue => '',
 
-		  @_);
+                  @_);
     $self->SUPER::Create(
                          Name => $args{'Name'},
                          Type => $args{'Type'},
@@ -131,6 +134,8 @@ sub Create {
                          SortOrder => $args{'SortOrder'},
                          LookupType => $args{'LookupType'},
                          Disabled => $args{'Disabled'},
+                         LinkToValue => $args{'LinkToValue'},
+                         IncludeContentForValue => $args{'IncludeContentForValue'}
 );
 
 }
@@ -203,7 +208,7 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 =head2 Pattern
 
 Returns the current value of Pattern. 
-(In the database, Pattern is stored as varchar(255).)
+(In the database, Pattern is stored as longtext.)
 
 
 
@@ -212,7 +217,7 @@ Returns the current value of Pattern.
 
 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 varchar(255).)
+(In the database, Pattern will be stored as a longtext.)
 
 
 =cut
@@ -357,7 +362,7 @@ sub _CoreAccessible {
         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 => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
+		{read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'longtext', default => ''},
         Repeated => 
 		{read => 1, write => 1, sql_type => 5, length => 6,  is_blob => 0,  is_numeric => 1,  type => 'smallint(6)', default => '0'},
         Description => 
diff --git a/rt/lib/RT/CustomFieldValue.pm b/rt/lib/RT/CustomFieldValue.pm
index 3a081769b..59edee3d7 100644
--- a/rt/lib/RT/CustomFieldValue.pm
+++ b/rt/lib/RT/CustomFieldValue.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 # Autogenerated by DBIx::SearchBuilder factory (by )
 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
 # 
diff --git a/rt/lib/RT/CustomFieldValue_Overlay.pm b/rt/lib/RT/CustomFieldValue_Overlay.pm
index be1070d6a..5511e520e 100644
--- a/rt/lib/RT/CustomFieldValue_Overlay.pm
+++ b/rt/lib/RT/CustomFieldValue_Overlay.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 use warnings;
 use strict;
 
@@ -62,36 +63,114 @@ from being integers.
 
 sub Create {
     my $self = shift;
-    my %args = @_;
-    (defined $args{$_} or delete $args{$_}) for keys %args;
-    %args = ((CustomField => '0',
-              Name => '',
-              Description => '',
-              SortOrder => '0',
-              Category => ''), %args);
+    my %args = (
+        CustomField => 0,
+        Name        => '',
+        Description => '',
+        SortOrder   => 0,
+        Category    => '',
+        @_,
+    );
+
+    my $cf_id = ref $args{'CustomField'}? $args{'CustomField'}->id: $args{'CustomField'};
+
+    my $cf = RT::CustomField->new( $self->CurrentUser );
+    $cf->Load( $cf_id );
+    unless ( $cf->id ) {
+        return (0, $self->loc("Couldn't load Custom Field #[_1]", $cf_id));
+    }
+    unless ( $cf->CurrentUserHasRight('AdminCustomField') ) {
+        return (0, $self->loc('Permission Denied'));
+    }
 
     my ($id, $msg) = $self->SUPER::Create(
-        map {$_ => $args{$_}} qw(CustomField Name Description SortOrder)
+        CustomField => $cf_id,
+        map { $_ => $args{$_} } qw(Name Description SortOrder)
     );
-    if ($id and length $args{Category}) {
+    return ($id, $msg) unless $id;
+
+    if ( defined $args{'Category'} && length $args{'Category'} ) {
         # $self would be loaded at this stage
-        $self->SetCategory($args{Category});
+        my ($status, $msg) = $self->SetCategory( $args{'Category'} );
+        unless ( $status ) {
+            $RT::Logger->error("Couldn't set category: $msg");
+        }
     }
+
     return ($id, $msg);
 }
 
+=head2 Category
+
+Returns the Category assigned to this Value
+Returns udef if there is no Category
+
+=cut
+
 sub Category {
     my $self = shift;
     my $attr = $self->FirstAttribute('Category') or return undef;
     return $attr->Content;
 }
 
+=head2 SetCategory Category
+
+Takes a string Category and stores it as an attribute of this CustomFieldValue
+
+=cut
+
 sub SetCategory {
     my $self = shift;
     my $category = shift;
-    $self->SetAttribute(Name => 'Category', Content => $category);
+    if ( defined $category && length $category ) {
+        return $self->SetAttribute(
+            Name    => 'Category',
+            Content => $category,
+        );
+    }
+    else {
+        my ($status, $msg) = $self->DeleteAttribute( 'Category' );
+        unless ( $status ) {
+            $RT::Logger->warning("Couldn't delete atribute: $msg");
+        }
+        # return true even if there was no category
+        return (1, $self->loc('Category unset'));
+    }
 }
 
-sub ValidateName { 1 };
+sub ValidateName {
+    return defined $_[1] && length $_[1];
+};
+
+=head2 DeleteCategory
+
+Deletes the category associated with this value
+Returns -1 if there is no Category
+
+=cut
+
+sub DeleteCategory {
+    my $self = shift;
+    my $attr = $self->FirstAttribute('Category') or return (-1,'No Category Set');
+    return $attr->Delete;
+}
+
+=head2 Delete
+
+Make sure we delete our Category when we're deleted
+
+=cut
+
+sub Delete {
+    my $self = shift;
+
+    my ($result, $msg) = $self->DeleteCategory;
+
+    unless ($result) {
+        return ($result, $msg);
+    }
+
+    return $self->SUPER::Delete(@_);
+}
 
 1;
diff --git a/rt/lib/RT/CustomFieldValues.pm b/rt/lib/RT/CustomFieldValues.pm
index 32ab860e8..3539a804a 100644
--- a/rt/lib/RT/CustomFieldValues.pm
+++ b/rt/lib/RT/CustomFieldValues.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 # Autogenerated by DBIx::SearchBuilder factory (by )
 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
 # 
diff --git a/rt/lib/RT/CustomFieldValues/External.pm b/rt/lib/RT/CustomFieldValues/External.pm
new file mode 100644
index 000000000..645f13678
--- /dev/null
+++ b/rt/lib/RT/CustomFieldValues/External.pm
@@ -0,0 +1,235 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          
+# 
+# (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::CustomFieldValues::External;
+
+use strict;
+use warnings;
+
+use base qw(RT::CustomFieldValues);
+
+=head1 NAME
+
+RT::CustomFieldValues::External - Pull possible values for a custom
+field from an arbitrary external data source.
+
+=head1 SYNOPSIS
+
+Custom field value lists can be produced by creating a class that
+inherits from C, and overloading
+C and C.  See
+L for a simple example.
+
+=head1 DESCRIPTION
+
+Subclasses should implement the following methods:
+
+=head2 SourceDescription
+
+This method should return a string describing the data source; this is
+the identifier by which the user will see the dropdown.
+
+=head2 ExternalValues
+
+This method should return an array reference of hash references.  The
+hash references should contain keys for C, C, and
+C.
+
+=head1 SEE ALSO
+
+L
+
+=cut
+
+sub _Init {
+    my $self = shift;
+    $self->Table( '' );
+    return ( $self->SUPER::_Init(@_) );
+}
+
+sub CleanSlate {
+    my $self = shift;
+    delete $self->{ $_ } foreach qw(
+        __external_cf
+        __external_cf_limits
+    );
+    return $self->SUPER::CleanSlate(@_);
+}
+
+sub _ClonedAttributes {
+    my $self = shift;
+    return qw(
+        __external_cf
+        __external_cf_limits
+    ), $self->SUPER::_ClonedAttributes;
+}
+
+sub Limit {
+    my $self = shift;
+    my %args = (@_);
+    push @{ $self->{'__external_cf_limits'} ||= [] }, {
+        %args,
+        CALLBACK => $self->__BuildLimitCheck( %args ),
+    };
+    return $self->SUPER::Limit( %args );
+}
+
+sub __BuildLimitCheck {
+    my ($self, %args) = (@_);
+    return undef unless $args{'FIELD'} =~ /^(?:Name|Description)$/;
+
+    $args{'OPERATOR'} ||= '=';
+    my $quoted_value = $args{'VALUE'};
+    if ( $quoted_value ) {
+        $quoted_value =~ s/'/\\'/g;
+        $quoted_value = "'$quoted_value'";
+    }
+
+    my $code = <$args{'FIELD'};
+my \$condition = $quoted_value;
+END
+
+    if ( $args{'OPERATOR'} =~ /^(?:=|!=|<>)$/ ) {
+        $code .= 'return 0 unless defined $value;';
+        my %h = ( '=' => ' eq ', '!=' => ' ne ', '<>' => ' ne ' );
+        $code .= 'return 0 unless $value'. $h{ $args{'OPERATOR'} } .'$condition;';
+        $code .= 'return 1;'
+    }
+    elsif ( $args{'OPERATOR'} =~ /^(?:LIKE|NOT LIKE)$/i ) {
+        $code .= 'return 0 unless defined $value;';
+        my %h = ( 'LIKE' => ' =~ ', 'NOT LIKE' => ' !~ ' );
+        $code .= 'return 0 unless $value'. $h{ uc $args{'OPERATOR'} } .'/\Q$condition/i;';
+        $code .= 'return 1;'
+    }
+    else {
+        $code .= 'return 0;'
+    }
+    $code = "sub {$code}";
+    my $cb = eval "$code";
+    $RT::Logger->error( "Couldn't build callback '$code': $@" ) if $@;
+    return $cb;
+}
+
+sub __BuildAggregatorsCheck {
+    my $self = shift;
+
+    my %h = ( OR => ' || ', AND => ' && ' );
+    
+    my $code = '';
+    for( my $i = 0; $i < @{ $self->{'__external_cf_limits'} }; $i++ ) {
+        next unless $self->{'__external_cf_limits'}->[$i]->{'CALLBACK'};
+        $code .= $h{ uc($self->{'__external_cf_limits'}->[$i]->{'ENTRYAGGREGATOR'} || 'OR') } if $code;
+        $code .= '$sb->{\'__external_cf_limits\'}->['. $i .']->{\'CALLBACK\'}->($record)';
+    }
+    return unless $code;
+
+    $code = "sub { my (\$sb,\$record) = (\@_); return $code }";
+    my $cb = eval "$code";
+    $RT::Logger->error( "Couldn't build callback '$code': $@" ) if $@;
+    return $cb;
+}
+
+sub _DoSearch {
+    my $self = shift;
+
+    delete $self->{'items'};
+
+    my %defaults = (
+            id => 1,
+            name => '',
+            customfield => $self->{'__external_cf'},
+            sortorder => 0,
+            description => '',
+            creator => $RT::SystemUser->id,
+            created => undef,
+            lastupdatedby => $RT::SystemUser->id,
+            lastupdated => undef,
+    );
+
+    my $i = 0;
+
+    my $check = $self->__BuildAggregatorsCheck;
+    foreach( @{ $self->ExternalValues } ) {
+        my $value = $self->NewItem;
+        $value->LoadFromHash( { %defaults, %$_ } );
+        next if $check && !$check->( $self, $value );
+        $self->AddRecord( $value );
+    }
+    $self->{'must_redo_search'} = 0;
+    return $self->_RecordCount;
+}
+
+sub _DoCount {
+    my $self = shift;
+
+    my $count;
+    $count = $self->_DoSearch if $self->{'must_redo_search'};
+    $count = $self->_RecordCount unless defined $count;
+
+    return $self->{'count_all'} = $self->{'raw_rows'} = $count;
+}
+
+sub LimitToCustomField {
+    my $self = shift;
+    $self->{'__external_cf'} = $_[0];
+    return $self->SUPER::LimitToCustomField( @_ );
+}
+
+eval "require RT::CustomFieldValues::External_Vendor";
+if ($@ && $@ !~ qr{^Can't locate RT/CustomFieldValues/External_Vendor.pm}) {
+    die $@;
+};
+
+eval "require RT::CustomFieldValues::External_Local";
+if ($@ && $@ !~ qr{^Can't locate RT/CustomFieldValues/External_Local.pm}) {
+    die $@;
+};
+
+1;
diff --git a/rt/lib/RT/CustomFieldValues/Groups.pm b/rt/lib/RT/CustomFieldValues/Groups.pm
new file mode 100644
index 000000000..5d40c7775
--- /dev/null
+++ b/rt/lib/RT/CustomFieldValues/Groups.pm
@@ -0,0 +1,88 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          
+# 
+# (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::CustomFieldValues::Groups;
+
+use strict;
+use warnings;
+
+use base qw(RT::CustomFieldValues::External);
+
+sub SourceDescription {
+    return 'RT user defined groups';
+}
+
+sub ExternalValues {
+    my $self = shift;
+
+    my @res;
+    my $i = 0;
+    my $groups = RT::Groups->new( $self->CurrentUser );
+    $groups->LimitToUserDefinedGroups;
+    $groups->OrderByCols( { FIELD => 'Name' } );
+    while( my $group = $groups->Next ) {
+        push @res, {
+            name        => $group->Name,
+            description => $group->Description,
+            sortorder   => $i++,
+        };
+    }
+    return \@res;
+}
+
+eval "require RT::CustomFieldValues::Groups_Vendor";
+if ($@ && $@ !~ qr{^Can't locate RT/CustomFieldValues/Groups_Vendor.pm}) {
+    die $@;
+};
+
+eval "require RT::CustomFieldValues::Groups_Local";
+if ($@ && $@ !~ qr{^Can't locate RT/CustomFieldValues/Groups_Local.pm}) {
+    die $@;
+};
+
+1;
diff --git a/rt/lib/RT/CustomFieldValues_Overlay.pm b/rt/lib/RT/CustomFieldValues_Overlay.pm
index 543a9860b..4c6d7f84d 100644
--- a/rt/lib/RT/CustomFieldValues_Overlay.pm
+++ b/rt/lib/RT/CustomFieldValues_Overlay.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,9 +45,11 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 package RT::CustomFieldValues;
 
 use strict;
+use warnings;
 no warnings qw(redefine);
 
 # {{{ sub LimitToCustomField
@@ -61,13 +63,13 @@ Limits the returned set to values for the custom field with Id FIELD
 sub LimitToCustomField {
     my $self = shift;
     my $cf = shift;
-    return ($self->Limit( FIELD => 'CustomField',
-			  VALUE => $cf,
-			  OPERATOR => '='));
-
+    return $self->Limit(
+        FIELD    => 'CustomField',
+        VALUE    => $cf,
+        OPERATOR => '=',
+    );
 }
 
 # }}}
 
 1;
-
diff --git a/rt/lib/RT/CustomField_Overlay.pm b/rt/lib/RT/CustomField_Overlay.pm
index 2bb42edbf..9286d7a1d 100644
--- a/rt/lib/RT/CustomField_Overlay.pm
+++ b/rt/lib/RT/CustomField_Overlay.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,69 +45,73 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 package RT::CustomField;
 
 use strict;
 no warnings qw(redefine);
 
-use vars qw(%FieldTypes $RIGHTS %FRIENDLY_OBJECT_TYPES);
-
 use RT::CustomFieldValues;
 use RT::ObjectCustomFieldValues;
 
 
-%FieldTypes = (
+our %FieldTypes = (
     Select => [
-        'Select multiple values',	# loc
-        'Select one value',		# loc
-        'Select up to [_1] values',	# loc
+        'Select multiple values',    # loc
+        'Select one value',        # loc
+        'Select up to [_1] values',    # loc
     ],
     Freeform => [
-        'Enter multiple values',	# loc
-        'Enter one value',		# loc
-        'Enter up to [_1] values',	# loc
+        'Enter multiple values',    # loc
+        'Enter one value',        # loc
+        'Enter up to [_1] values',    # loc
     ],
     Text => [
-        'Fill in multiple text areas',	# loc
-        'Fill in one text area',	# loc
+        'Fill in multiple text areas',    # loc
+        'Fill in one text area',    # loc
         'Fill in up to [_1] text areas',# loc
     ],
     Wikitext => [
-        'Fill in multiple wikitext areas',	# loc
-        'Fill in one wikitext area',	# loc
+        'Fill in multiple wikitext areas',    # loc
+        'Fill in one wikitext area',    # loc
         'Fill in up to [_1] wikitext areas',# loc
     ],
     Image => [
-        'Upload multiple images',	# loc
-        'Upload one image',		# loc
-        'Upload up to [_1] images',	# loc
+        'Upload multiple images',    # loc
+        'Upload one image',        # loc
+        'Upload up to [_1] images',    # loc
     ],
     Binary => [
-        'Upload multiple files',	# loc
-        'Upload one file',		# loc
-        'Upload up to [_1] files',	# loc
+        'Upload multiple files',    # loc
+        'Upload one file',        # loc
+        'Upload up to [_1] files',    # loc
     ],
     Combobox => [
-        'Combobox: Select or enter multiple values',	# loc
-        'Combobox: Select or enter one value',		# loc
-        'Combobox: Select or enter up to [_1] values',	# loc
+        'Combobox: Select or enter multiple values',    # loc
+        'Combobox: Select or enter one value',        # loc
+        'Combobox: Select or enter up to [_1] values',    # loc
+    ],
+    Autocomplete => [
+        'Enter multiple values with autocompletion',    # loc
+        'Enter one value with autocompletion',            # loc
+        'Enter up to [_1] values with autocompletion',    # loc
     ],
 );
 
 
-%FRIENDLY_OBJECT_TYPES =  ();
+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
 
-$RIGHTS = {
+our $RIGHTS = {
     SeeCustomField            => 'See custom fields',       # loc_pair
     AdminCustomField          => 'Create, delete and modify custom fields',        # loc_pair
     ModifyCustomField         => 'Add, delete and modify custom field values for objects' #loc_pair
-
 };
 
 # Tell RT::ACE that this sort of object can get acls granted
@@ -117,23 +121,34 @@ foreach my $right ( keys %{$RIGHTS} ) {
     $RT::ACE::LOWERCASERIGHTNAMES{ lc $right } = $right;
 }
 
+=head2 AddRights C, C [, ...]
+
+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);
+    return $RIGHTS;
 }
 
 =head1 NAME
 
-  RT::CustomField_Overlay 
+  RT::CustomField_Overlay - overlay for RT::CustomField
 
 =head1 DESCRIPTION
 
 =head1 'CORE' METHODS
 
-=cut
-
-
-
 =head2 Create PARAMHASH
 
 Create takes a hash of values and creates a row in the database:
@@ -148,49 +163,48 @@ Create takes a hash of values and creates a row in the database:
   varchar(255) 'LookupType'.
   smallint(6) 'Disabled'.
 
-  'LookupType' is generally the result of either 
-  RT::Ticket->CustomFieldLookupType or RT::Transaction->CustomFieldLookupType
+C is generally the result of either
+CCustomFieldLookupType> or CCustomFieldLookupType>.
 
 =cut
 
-
-
-
 sub Create {
     my $self = shift;
-    my %args = ( 
-                Name => '',
-                Type => '',
-		MaxValues => '0',
-		Pattern  => '',
-                Description => '',
-                Disabled => '0',
-		LookupType  => '',
-		Repeated  => '0',
-
-		  @_);
-
-    unless ($self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField')) {
+    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);
+    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;
+    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
+    # 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';
+        $args{'LookupType'} = 'RT::Queue-RT::Ticket';
     }
     else {
         my $queue = RT::Queue->new($self->CurrentUser);
@@ -205,32 +219,51 @@ sub Create {
         $args{'Queue'} = $queue->Id;
     }
 
-    my ($ok, $msg) = $self->_IsValidRegex($args{'Pattern'});
-    if (!$ok) {
-        return (0, $self->loc("Invalid pattern: [_1]", $msg));
+    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->warning("Support for 'multiple' Texts or Comboboxes is not implemented");
+        $args{'MaxValues'} = 1;
     }
 
-    my $rv = $self->SUPER::Create(
-                         Name => $args{'Name'},
-                         Type => $args{'Type'},
-                         MaxValues => $args{'MaxValues'},
-                         Pattern  => $args{'Pattern'},
-                         Description => $args{'Description'},
-                         Disabled => $args{'Disabled'},
-			 LookupType => $args{'LookupType'},
-			 Repeated => $args{'Repeated'},
-);
+    (my $rv, $msg) = $self->SUPER::Create(
+        Name        => $args{'Name'},
+        Type        => $args{'Type'},
+        MaxValues   => $args{'MaxValues'},
+        Pattern     => $args{'Pattern'},
+        Description => $args{'Description'},
+        Disabled    => $args{'Disabled'},
+        LookupType  => $args{'LookupType'},
+        Repeated    => $args{'Repeated'},
+    );
+
+    if ( exists $args{'LinkValueTo'}) {
+	$self->SetLinkValueTo($args{'LinkValueTo'});
+    }
+
+    if ( exists $args{'IncludeContentForValue'}) {
+	$self->SetIncludeContentForValue($args{'IncludeContentForValue'});
+    }
+
+    if ( exists $args{'ValuesClass'} ) {
+        $self->SetValuesClass( $args{'ValuesClass'} );
+    }
 
-    return $rv unless exists $args{'Queue'};
+    if ( exists $args{'BasedOn'} ) {
+        $self->SetBasedOn( $args{'BasedOn'} );
+    }
+
+    return ($rv, $msg) unless exists $args{'Queue'};
 
     # Compat code -- create a new ObjectCustomField mapping
-    my $OCF = RT::ObjectCustomField->new($self->CurrentUser);
+    my $OCF = RT::ObjectCustomField->new( $self->CurrentUser );
     $OCF->Create(
-	CustomField => $self->Id,
-	ObjectId => $args{'Queue'},
+        CustomField => $self->Id,
+        ObjectId => $args{'Queue'},
     );
 
-    return $rv;
+    return ($rv, $msg);
 }
 
 =head2 Load ID/NAME
@@ -239,22 +272,21 @@ Load a custom field.  If the value handed in is an integer, load by custom field
 
 =cut
 
-
 sub Load {
     my $self = shift;
-    my $id = shift;
+    my $id = shift || '';
 
-    if ($id =~ /^\d+$/) {
-        return ($self->SUPER::Load($id));
+    if ( $id =~ /^\d+$/ ) {
+        return $self->SUPER::Load( $id );
     } else {
-        return($self->LoadByName(Name => $id));
+        return $self->LoadByName( Name => $id );
     }
 }
 
 
 # {{{ sub LoadByName
 
-=head2  LoadByName (Queue => QUEUEID, Name => NAME)
+=head2 LoadByName (Queue => QUEUEID, Name => NAME)
 
 Loads the Custom field named NAME.
 
@@ -284,91 +316,82 @@ sub LoadByName {
         @_,
     );
 
+    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+$/) {
-	my $QueueObj = RT::Queue->new($self->CurrentUser);
-	$QueueObj->Load($args{'Queue'});
-	$args{'Queue'} = $QueueObj->Id;
+    if ( defined $args{'Queue'} && $args{'Queue'} =~ /\D/ ) {
+        my $QueueObj = RT::Queue->new( $self->CurrentUser );
+        $QueueObj->Load( $args{'Queue'} );
+        $args{'Queue'} = $QueueObj->Id;
     }
 
     # XXX - really naive implementation.  Slow. - not really. still just one query
 
-    my $CFs = RT::CustomFields->new($self->CurrentUser);
-
-    $CFs->Limit( FIELD => 'Name', VALUE => $args{'Name'}, CASESENSITIVE => 0);
+    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'} );
+    if ( defined $args{'Queue'} ) {
+        $CFs->LimitToQueue( $args{'Queue'} );
     }
 
-    # When loading by name, it's ok if they're disabled. That's not a big deal.
+    # When loading by name, we _can_ load disabled fields, but prefer
+    # non-disabled fields.
     $CFs->{'find_disabled_rows'}=1;
+    $CFs->OrderByCols(
+        { FIELD => "Disabled", ORDER => 'ASC' },
+    );
 
     # We only want one entry.
     $CFs->RowsPerPage(1);
-    unless ($CFs->First) {
-        return(0);
-    }
-    return($self->Load($CFs->First->id));
 
+    # 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 );
 }
 
 # }}}
 
 # {{{ Dealing with custom field values 
 
-=begin testing
-
-use_ok(RT::CustomField);
-ok(my $cf = RT::CustomField->new($RT::SystemUser));
-ok(my ($id, $msg)=  $cf->Create( Name => 'TestingCF',
-                                 Queue => '0',
-                                 SortOrder => '1',
-                                 Description => 'A Testing custom field',
-                                 Type=> 'SelectSingle'), 'Created a global CustomField');
-ok($id != 0, 'Global custom field correctly created');
-ok ($cf->SingleValue);
-is($cf->Type, 'Select');
-is($cf->MaxValues, 1);
-
-my ($val, $msg) = $cf->SetMaxValues('0');
-ok($val, $msg);
-is($cf->Type, 'Select');
-is($cf->MaxValues, 0);
-ok(!$cf->SingleValue );
-ok(my ($bogus_val, $bogus_msg) = $cf->SetType('BogusType') , "Trying to set a custom field's type to a bogus type");
-ok($bogus_val == 0, "Unable to set a custom field's type to a bogus type");
-
-ok(my $bad_cf = RT::CustomField->new($RT::SystemUser));
-ok(my ($bad_id, $bad_msg)=  $cf->Create( Name => 'TestingCF-bad',
-                                 Queue => '0',
-                                 SortOrder => '1',
-                                 Description => 'A Testing custom field with a bogus Type',
-                                 Type=> 'SelectSingleton'), 'Created a global CustomField with a bogus type');
-ok($bad_id == 0, 'Global custom field correctly decided to not create a cf with a bogus type ');
-
-=end testing
+
+=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 method.
 
 =cut
 
-# {{{ AddValue
+*ValuesObj = \&Values;
 
-=head2 AddValue HASH
+sub Values {
+    my $self = shift;
 
-Create a new value for this CustomField.  Takes a paramhash containing the elements Name, Description and SortOrder
+    my $class = $self->ValuesClass || '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 );
+    }
+    return ($cf_values);
+}
 
-=begin testing
+# {{{ AddValue
 
-ok(my $cf = RT::CustomField->new($RT::SystemUser));
-$cf->Load(1);
-ok($cf->Id == 1);
-ok(my ($val,$msg)  = $cf->AddValue(Name => 'foo' , Description => 'TestCFValue', SortOrder => '6'));
-ok($val != 0);
-ok (my ($delval, $delmsg) = $cf->DeleteValue($val));
-ok ($delval,"Deleting a cf value: $delmsg");
+=head3 AddValue HASH
 
-=end testing
+Create a new value for this CustomField.  Takes a paramhash containing the elements Name, Description and SortOrder
 
 =cut
 
@@ -382,11 +405,11 @@ sub AddValue {
 
     # allow zero value
     if ( !defined $args{'Name'} || $args{'Name'} eq '' ) {
-        return(0, $self->loc("Can't add a custom field value without a name"));
+        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));
+    my $newval = RT::CustomFieldValue->new( $self->CurrentUser );
+    return $newval->Create( %args, CustomField => $self->Id );
 }
 
 
@@ -394,147 +417,38 @@ sub AddValue {
 
 # {{{ DeleteValue
 
-=head2 DeleteValue ID
+=head3 DeleteValue ID
 
-Deletes a value from this custom field by id. 
+Deletes a value from this custom field by id.
 
-Does not remove this value for any article which has had it selected	
+Does not remove this value for any article which has had it selected
 
 =cut
 
 sub DeleteValue {
-	my $self = shift;
+    my $self = shift;
     my $id = shift;
-    unless ($self->CurrentUserHasRight('AdminCustomField')) {
+    unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
         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();
-    if ($retval) {
-        return ($retval, $self->loc("Custom field value deleted"));
-    } else {
-        return(0, $self->loc("Custom field value could not be deleted"));
+    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"));
     }
-}
-
-# }}}
-
-# {{{ Values
-
-=head2 Values FIELD
-
-Return a CustomFieldeValues object of all acceptable values for this Custom Field.
-
-
-=cut
-
-*ValuesObj = \&Values;
-
-sub Values {
-    my $self = shift;
-
-    my $cf_values = RT::CustomFieldValues->new($self->CurrentUser);
-    # if the user has no rights, return an empty object
-    if ($self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
-        $cf_values->LimitToCustomField($self->Id);
+    unless ( $val_to_del->CustomField == $self->Id ) {
+        return (0, $self->loc("That is not a value for this custom field"));
     }
-    return ($cf_values);
-}
-
-# }}}
-
-# }}}
-
-# {{{ Ticket related routines
-
-# {{{ ValuesForTicket
-
-=head2 ValuesForTicket TICKET
-
-Returns a RT::ObjectCustomFieldValues object of this Field's values for TICKET.
-TICKET is a ticket id.
-
-This is deprecated -- use ValuesForObject instead.
-
-
-=cut
-
-sub ValuesForTicket {
-	my $self = shift;
-    my $ticket_id = shift;
-    
-    $RT::Logger->debug( ref($self) . " -> ValuesForTicket deprecated in favor of ValuesForObject at (". join(":",caller).")"); 
-    my $ticket = RT::Ticket->new($self->CurrentUser);
-    $ticket->Load($ticket_id);
-
-    return $self->ValuesForObject($ticket);
-}
-
-# }}}
-
-# {{{ AddValueForTicket
-
-=head2 AddValueForTicket HASH
-
-Adds a custom field value for a ticket. Takes a param hash of Ticket and Content
-
-This is deprecated -- use AddValueForObject instead.
-
-=cut
-
-sub AddValueForTicket {
-	my $self = shift;
-	my %args = ( Ticket => undef,
-                 Content => undef,
-		     @_ );
-    $RT::Logger->debug( ref($self) . " -> AddValueForTicket deprecated in favor of AddValueForObject at (". join(":",caller).")");
-
-
-    my $ticket = RT::Ticket->new($self->CurrentUser);
-    $ticket->Load($args{'Ticket'});
-    return($self->AddValueForObject(Content => $args{'Content'}, Object => $ticket,@_));
-
-}
-
-
-# }}}
-
-# {{{ DeleteValueForTicket
-
-=head2 DeleteValueForTicket HASH
-
-Adds a custom field value for a ticket. Takes a param hash of Ticket and Content
-
-This is deprecated -- use DeleteValueForObject instead.
-
-=cut
-
-sub DeleteValueForTicket {
-	my $self = shift;
-	my %args = ( Ticket => undef,
-                 Content => undef,
-		     @_ );
-
-    $RT::Logger->debug( ref($self) . " -> DeleteValueForTicket deprecated in favor of DeleteValueForObject at (". join(":",caller).")"); 
-
-
-    my $ticket = RT::Ticket->new($self->CurrentUser);
-    $ticket->load($args{'Ticket'});
-    return ($self->DeleteValueForObject(Object => $ticket, Content => $args{'Content'}, @_));
 
+    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
@@ -547,18 +461,14 @@ sub ValidateQueue {
     my $self = shift;
     my $id = shift;
 
-    if ($id eq '0') { # 0 means "Global" null would _not_ be ok.
-        return (1); 
-    }
-
-    my $q = RT::Queue->new($RT::SystemUser);
-    $q->Load($id);
-    unless ($q->id) {
-        return undef;
-    }
-    return (1);
-
+    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;
 }
 
 
@@ -571,13 +481,13 @@ Retuns an array of the types of CustomField that are supported
 =cut
 
 sub Types {
-	return (keys %FieldTypes);
+    return (keys %FieldTypes);
 }
 
 # }}}
 
 # {{{ IsSelectionType
- 
+
 =head2 IsSelectionType 
 
 Retuns a boolean value indicating whether the C method makes sense
@@ -587,12 +497,49 @@ to this Custom Field.
 
 sub IsSelectionType {
     my $self = shift;
-    $self->Type =~ /(?:Select|Combobox)/;
+    my $type = @_? shift : $self->Type;
+    return undef unless $type;
+
+    $type =~ /(?:Select|Combobox|Autocomplete)/;
 }
 
 # }}}
 
 
+=head2 IsExternalValues
+
+=cut
+
+sub IsExternalValues {
+    my $self = shift;
+    my $selectable = $self->IsSelectionType( @_ );
+    return $selectable unless $selectable;
+
+    my $class = $self->ValuesClass;
+    return 0 if $class eq 'RT::CustomFieldValues';
+    return 1;
+}
+
+sub ValuesClass {
+    my $self = shift;
+    return '' unless $self->IsSelectionType;
+
+    my $class = $self->FirstAttribute( 'ValuesClass' );
+    $class = $class->Content if $class;
+    return $class || 'RT::CustomFieldValues';
+}
+
+sub SetValuesClass {
+    my $self = shift;
+    my $class = shift || 'RT::CustomFieldValues';
+
+    if( $class eq 'RT::CustomFieldValues' ) {
+        return $self->DeleteAttribute( 'ValuesClass' );
+    }
+    return $self->SetAttribute( Name => 'ValuesClass', Content => $class );
+}
+
+
 =head2 FriendlyType [TYPE, MAX_VALUES]
 
 Returns a localized human-readable version of the custom field type.
@@ -605,9 +552,10 @@ sub FriendlyType {
 
     my $type = @_ ? shift : $self->Type;
     my $max  = @_ ? shift : $self->MaxValues;
+    $max = 0 unless $max;
 
     if (my $friendly_type = $FieldTypes{$type}[$max>2 ? 2 : $max]) {
-	return ( $self->loc( $friendly_type, $max ) );
+        return ( $self->loc( $friendly_type, $max ) );
     }
     else {
         return ( $self->loc( $type ) );
@@ -626,14 +574,6 @@ sub FriendlyTypeComposite {
 Takes a single string. returns true if that string is a value
 type of custom field
 
-=begin testing
-
-ok(my $cf = RT::CustomField->new($RT::SystemUser));
-ok($cf->ValidateType('SelectSingle'));
-ok($cf->ValidateType('SelectMultiple'));
-ok(!$cf->ValidateType('SelectFooMultiple'));
-
-=end testing
 
 =cut
 
@@ -641,12 +581,12 @@ 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 ( $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);
+    if ( $FieldTypes{$type} ) {
+        return 1;
     }
     else {
         return undef;
@@ -658,8 +598,8 @@ 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);
+        $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")");
+        $self->SetMaxValues($1 ? 1 : 0);
     }
     $self->SUPER::SetType($type);
 }
@@ -696,8 +636,8 @@ sub _IsValidRegex {
     my $regex = shift or return (1, 'valid');
 
     local $^W; local $@;
-    $SIG{__DIE__} = sub { 1 };
-    $SIG{__WARN__} = sub { 1 };
+    local $SIG{__DIE__} = sub { 1 };
+    local $SIG{__WARN__} = sub { 1 };
 
     if (eval { qr/$regex/; 1 }) {
         return (1, 'valid');
@@ -720,7 +660,7 @@ Returns false if it accepts multiple values
 
 sub SingleValue {
     my $self = shift;
-    if ($self->MaxValues == 1) {
+    if (($self->MaxValues||0) == 1) {
         return 1;
     } 
     else {
@@ -730,7 +670,7 @@ sub SingleValue {
 
 sub UnlimitedValues {
     my $self = shift;
-    if ($self->MaxValues == 0) {
+    if (($self->MaxValues||0) == 0) {
         return 1;
     } 
     else {
@@ -740,8 +680,6 @@ sub UnlimitedValues {
 
 # }}}
 
-# {{{ sub CurrentUserHasRight
-
 =head2 CurrentUserHasRight RIGHT
 
 Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args.
@@ -753,13 +691,44 @@ sub CurrentUserHasRight {
     my $right = shift;
 
     return $self->CurrentUser->HasRight(
-	Object => $self,
-	Right  => $right,
+        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.
 
+=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 _Set
 
 sub _Set {
@@ -768,7 +737,7 @@ sub _Set {
     unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
         return ( 0, $self->loc('Permission Denied') );
     }
-    return ( $self->SUPER::_Set(@_) );
+    return $self->SUPER::_Set( @_ );
 
 }
 
@@ -784,16 +753,18 @@ Returns its value as a string, if the user passes an ACL check
 =cut
 
 sub _Value {
-
     my $self  = shift;
-    my $field = shift;
+    return undef unless $self->id;
 
     # we need to do the rights check
-    unless ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
-	    return (undef);
+    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($field) );
-
+    return $self->__Value( @_ );
 }
 
 # }}}
@@ -802,44 +773,39 @@ sub _Value {
 =head2 SetDisabled
 
 Takes a boolean.
-1 will cause this custom field to no longer be avaialble for tickets.
-0 will re-enable this queue
+1 will cause this custom field to no longer be avaialble for objects.
+0 will re-enable this field.
 
 =cut
 
 # }}}
 
-sub Queue {
-    $RT::Logger->debug( ref($_[0]) . " -> Queue deprecated at (". join(":",caller).")");
-    
-    return 0;
-}
-
-sub SetQueue {
-    $RT::Logger->debug( ref($_[0]) . " -> SetQueue deprecated at (". join(":",caller).")");
-
-    return 0;
-}
-
-sub QueueObj {
-    $RT::Logger->debug( ref($_[0]) . " -> QueueObj deprecated at (". join(":",caller).")");
-
-    return undef;
-}
-
 =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);
-    $self->SetType($type);
-    $self->SetMaxValues($max_values);
+    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;
+    }
+    return 1, $self->loc(
+        "Type changed from '[_1]' to '[_2]'",
+        $self->FriendlyTypeComposite( $old ),
+        $self->FriendlyTypeComposite( $composite ),
+    );
 }
 
 =head2 SetLookupType
@@ -851,13 +817,13 @@ Autrijus: care to doc how LookupTypes work?
 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};
+    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};
     }
-    $self->SUPER::SetLookupType($lookup);
+    return $self->SUPER::SetLookupType($lookup);
 }
 
 =head2 TypeComposite
@@ -869,7 +835,7 @@ Returns a composite value composed of this object's type and maximum values
 
 sub TypeComposite {
     my $self = shift;
-    join('-', $self->Type, $self->MaxValues);
+    return join '-', ($self->Type || ''), ($self->MaxValues || 0);
 }
 
 =head2 TypeComposites
@@ -896,13 +862,15 @@ sub LookupTypes {
 }
 
 my @FriendlyObjectTypes = (
-    "[_1] objects",		    # loc
-    "[_1]'s [_2] objects",	    # loc
+    "[_1] objects",            # loc
+    "[_1]'s [_2] objects",        # loc
     "[_1]'s [_2]'s [_3] objects",   # loc
 );
 
 =head2 FriendlyTypeLookup
 
+Returns a localized description of the type of this custom field
+
 =cut
 
 sub FriendlyLookupType {
@@ -910,7 +878,7 @@ sub FriendlyLookupType {
     my $lookup = shift || $self->LookupType;
    
     return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} ))
-      	           if (defined  $FRIENDLY_OBJECT_TYPES{$lookup} );
+                     if (defined  $FRIENDLY_OBJECT_TYPES{$lookup} );
 
     my @types = map { s/^RT::// ? $self->loc($_) : $_ }
       grep { defined and length }
@@ -935,7 +903,7 @@ sub AddToObject {
     my $id = $object->Id || 0;
 
     unless (index($self->LookupType, ref($object)) == 0) {
-    	return ( 0, $self->loc('Lookup type mismatch') );
+        return ( 0, $self->loc('Lookup type mismatch') );
     }
 
     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
@@ -943,7 +911,6 @@ sub AddToObject {
     }
 
     my $ObjectCF = RT::ObjectCustomField->new( $self->CurrentUser );
-
     $ObjectCF->LoadByCols( ObjectId => $id, CustomField => $self->Id );
     if ( $ObjectCF->Id ) {
         return ( 0, $self->loc("That is already the current value") );
@@ -970,7 +937,7 @@ sub RemoveFromObject {
     my $id = $object->Id || 0;
 
     unless (index($self->LookupType, ref($object)) == 0) {
-	return ( 0, $self->loc('Object type mismatch') );
+        return ( 0, $self->loc('Object type mismatch') );
     }
 
     unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
@@ -978,7 +945,6 @@ sub RemoveFromObject {
     }
 
     my $ObjectCF = RT::ObjectCustomField->new( $self->CurrentUser );
-
     $ObjectCF->LoadByCols( ObjectId => $id, CustomField => $self->Id );
     unless ( $ObjectCF->Id ) {
         return ( 0, $self->loc("This custom field does not apply to that object") );
@@ -1017,21 +983,20 @@ sub AddValueForObject {
         ContentType  => undef,
         @_
     );
-    my $obj = $args{'Object'} or return;
+    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}) ) {
+    unless ( $self->MatchPattern($args{'Content'}) ) {
         return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
     }
 
     $RT::Handle->BeginTransaction;
 
-    my $current_values = $self->ValuesForObject($obj);
-
     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)
@@ -1042,17 +1007,14 @@ sub AddValueForObject {
 
         while ($extra_values) {
             my $extra_item = $current_values->Next;
-
             unless ( $extra_item->id ) {
-                $RT::Logger->crit(
-"We were just asked to delete a custom fieldvalue that doesn't exist!"
-                );
+                $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--;
-
         }
     }
     my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
@@ -1067,7 +1029,7 @@ sub AddValueForObject {
 
     unless ($val) {
         $RT::Handle->Rollback();
-        return ($val);
+        return ($val, $self->loc("Couldn't create record"));
     }
 
     $RT::Handle->Commit();
@@ -1088,10 +1050,9 @@ and returns a boolean; returns true if the Pattern is empty.
 
 sub MatchPattern {
     my $self = shift;
-    my $regex = $self->Pattern;
+    my $regex = $self->Pattern or return 1;
 
-    return 1 if !length($regex);
-    return ($_[0] =~ $regex);
+    return (( defined $_[0] ? $_[0] : '') =~ $regex);
 }
 
 
@@ -1110,8 +1071,8 @@ sub FriendlyPattern {
     my $self = shift;
     my $regex = $self->Pattern;
 
-    return '' if !length($regex);
-    if ($regex =~ /\(\?#([^)]*)\)/) {
+    return '' unless length $regex;
+    if ( $regex =~ /\(\?#([^)]*)\)/ ) {
         return '[' . $self->loc($1) . ']';
     }
     else {
@@ -1137,7 +1098,7 @@ sub DeleteValueForObject {
     my %args = ( Object => undef,
                  Content => undef,
                  Id => undef,
-		     @_ );
+             @_ );
 
 
     unless ($self->CurrentUserHasRight('ModifyCustomField')) {
@@ -1147,14 +1108,14 @@ sub DeleteValueForObject {
     my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser);
 
     if (my $id = $args{'Id'}) {
-	$oldval->Load($id);
+        $oldval->Load($id);
     }
     unless ($oldval->id) { 
-	$oldval->LoadByObjectContentAndCustomField(
-	    Object => $args{'Object'}, 
-	    Content =>  $args{'Content'}, 
-	    CustomField => $self->Id,
-	);
+        $oldval->LoadByObjectContentAndCustomField(
+            Object => $args{'Object'}, 
+            Content =>  $args{'Content'}, 
+            CustomField => $self->Id,
+        );
     }
 
 
@@ -1180,26 +1141,26 @@ sub DeleteValueForObject {
 
 =head2 ValuesForObject OBJECT
 
-Return an RT::ObjectCustomFieldValues object containing all of this custom field's values for OBJECT 
+Return an L object containing all of this custom field's values for OBJECT 
 
 =cut
 
 sub ValuesForObject {
-	my $self = shift;
+    my $self = shift;
     my $object = shift;
 
-	my $values = new RT::ObjectCustomFieldValues($self->CurrentUser);
-	unless ($self->CurrentUserHasRight('SeeCustomField')) {
+    my $values = new RT::ObjectCustomFieldValues($self->CurrentUser);
+    unless ($self->CurrentUserHasRight('SeeCustomField')) {
         # Return an empty object if they have no rights to see
         return ($values);
     }
-	
-	
-	$values->LimitToCustomField($self->Id);
-	$values->LimitToEnabled();
+    
+    
+    $values->LimitToCustomField($self->Id);
+    $values->LimitToEnabled();
     $values->LimitToObject($object);
 
-	return ($values);
+    return ($values);
 }
 
 
@@ -1209,10 +1170,10 @@ 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-RT::Ticket'                 => "Tickets",                # loc
+    'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions",    # loc
+    'RT::User'                             => "Users",                  # loc
+    'RT::Group'                            => "Groups",                 # loc
 
 This is a class method. 
 
@@ -1275,8 +1236,6 @@ With two arguments, attemptes to set the relevant template value.
 
 =cut
 
-
-
 sub _URLTemplate {
     my $self          = shift;
     my $template_name = shift;
@@ -1300,4 +1259,34 @@ sub _URLTemplate {
 
     }
 }
+
+sub SetBasedOn {
+    my $self = shift;
+    my $value = shift;
+
+    return $self->DeleteAttribute( "BasedOn" )
+        unless defined $value and length $value;
+
+    my $cf = RT::CustomField->new( $self->CurrentUser );
+    $cf->Load( ref $value ? $value->Id : $value );
+
+    return (0, "Permission denied")
+        unless $cf->Id && $cf->CurrentUserHasRight('SeeCustomField');
+
+    return $self->AddAttribute(
+        Name => "BasedOn",
+        Description => "Custom field whose CF we depend on",
+        Content => $cf->Id,
+    );
+}
+
+sub BasedOnObj {
+    my $self = shift;
+    my $obj = RT::CustomField->new( $self->CurrentUser );
+
+    my $attribute = $self->FirstAttribute("BasedOn");
+    $obj->Load($attribute->Content) if defined $attribute;
+    return $obj;
+}
+
 1;
diff --git a/rt/lib/RT/CustomFields.pm b/rt/lib/RT/CustomFields.pm
index 7ac18fb4e..27867e8e0 100644
--- a/rt/lib/RT/CustomFields.pm
+++ b/rt/lib/RT/CustomFields.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 # Autogenerated by DBIx::SearchBuilder factory (by )
 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
 # 
diff --git a/rt/lib/RT/CustomFields_Overlay.pm b/rt/lib/RT/CustomFields_Overlay.pm
index b9f3787f4..0f117c64c 100644
--- a/rt/lib/RT/CustomFields_Overlay.pm
+++ b/rt/lib/RT/CustomFields_Overlay.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::CustomFields - a collection of RT CustomField objects
@@ -58,11 +59,6 @@
 =head1 METHODS
 
 
-=begin testing
-
-ok (require RT::CustomFields);
-
-=end testing
 
 =cut
 
@@ -186,25 +182,32 @@ Returns the next custom field that this user can see.
 sub Next {
     my $self = shift;
     
-    
     my $CF = $self->SUPER::Next();
-    if ((defined($CF)) and (ref($CF))) {
-
-	if ($CF->CurrentUserHasRight('SeeCustomField')) {
-	    return($CF);
-	}
-	
-	#If the user doesn't have the right to show this queue
-	else {	
-	    return($self->Next());
-	}
-    }
-    #if there never was any queue
-    else {
-	return(undef);
-    }	
-    
+    return $CF unless $CF;
+
+    $CF->SetContextOject( $self->ContextObject );
+
+    return $self->Next unless $CF->CurrentUserHasRight('SeeCustomField');
+    return $CF;
 }
+
+sub SetContextObject {
+    my $self = shift;
+    return $self->{'context_object'} = shift;
+}
+  
+sub ContextObject {
+    my $self = shift;
+    return $self->{'context_object'};
+}
+
+sub NewItem {
+    my $self = shift;
+    my $res = RT::CustomField->new($self->CurrentUser);
+    $res->SetContextObject($self->ContextObject);
+    return $res;
+}
+
 # }}}
 
 sub LimitToLookupType  {
@@ -251,7 +254,7 @@ sub LimitToGlobalOrObjectId {
                  ENTRYAGGREGATOR => 'OR' ) unless $global_only;
 
     $self->OrderByCols(
-	{ ALIAS => $self->_OCFAlias, FIELD => 'ObjectId' },
+	{ ALIAS => $self->_OCFAlias, FIELD => 'ObjectId', ORDER => 'DESC' },
 	{ ALIAS => $self->_OCFAlias, FIELD => 'SortOrder' },
     );
     
@@ -259,6 +262,6 @@ sub LimitToGlobalOrObjectId {
     #$self->OrderBy( ALIAS => $class_cfs , FIELD => "SortOrder", ORDER => 'ASC');
 
 }
-  
+
 1;
 
diff --git a/rt/lib/RT/Dashboard.pm b/rt/lib/RT/Dashboard.pm
new file mode 100644
index 000000000..c0531c464
--- /dev/null
+++ b/rt/lib/RT/Dashboard.pm
@@ -0,0 +1,358 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+#                                          
+# 
+# (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::Dashboard - an API for saving and retrieving dashboards
+
+=head1 SYNOPSIS
+
+  use RT::Dashboard
+
+=head1 DESCRIPTION
+
+  Dashboard is an object that can belong to either an RT::User or an
+  RT::Group.  It consists of an ID, a name, and a number of
+  saved searches and portlets.
+
+=head1 METHODS
+
+
+=cut
+
+package RT::Dashboard;
+
+use RT::SavedSearch;
+
+use strict;
+use warnings;
+use base qw/RT::SharedSetting/;
+
+use RT::System;
+RT::System::AddRights(
+    SubscribeDashboard => 'Subscribe to dashboards', #loc_pair
+
+    SeeDashboard       => 'View system dashboards', #loc_pair
+    CreateDashboard    => 'Create system dashboards', #loc_pair
+    ModifyDashboard    => 'Modify system dashboards', #loc_pair
+    DeleteDashboard    => 'Delete system dashboards', #loc_pair
+
+    SeeOwnDashboard    => 'View personal dashboards', #loc_pair
+    CreateOwnDashboard => 'Create personal dashboards', #loc_pair
+    ModifyOwnDashboard => 'Modify personal dashboards', #loc_pair
+    DeleteOwnDashboard => 'Delete personal dashboards', #loc_pair
+);
+
+
+=head2 ObjectName
+
+An object of this class is called "dashboard"
+
+=cut
+
+sub ObjectName { "dashboard" }
+
+sub SaveAttribute {
+    my $self   = shift;
+    my $object = shift;
+    my $args   = shift;
+
+    return $object->AddAttribute(
+        'Name'        => 'Dashboard',
+        'Description' => $args->{'Name'},
+        'Content'     => {Panes => $args->{'Panes'}},
+    );
+}
+
+sub UpdateAttribute {
+    my $self = shift;
+    my $args = shift;
+
+    my ($status, $msg) = (1, undef);
+    if (defined $args->{'Panes'}) {
+        ($status, $msg) = $self->{'Attribute'}->SetSubValues(
+            Panes => $args->{'Panes'},
+        );
+    }
+
+    if ($status && $args->{'Name'}) {
+        ($status, $msg) = $self->{'Attribute'}->SetDescription($args->{'Name'})
+            unless $self->Name eq $args->{'Name'};
+    }
+
+    if ($status && $args->{'Privacy'}) {
+        my ($new_obj_type, $new_obj_id) = split /-/, $args->{'Privacy'};
+        my ($obj_type, $obj_id) = split /-/, $self->Privacy;
+
+        my $attr = $self->{'Attribute'};
+        if ($new_obj_type ne $obj_type) {
+            ($status, $msg) = $attr->SetObjectType($new_obj_type);
+        }
+        if ($status && $new_obj_id != $obj_id ) {
+            ($status, $msg) = $attr->SetObjectId($new_obj_id);
+        }
+        $self->{'Privacy'} = $args->{'Privacy'} if $status;
+    }
+
+    return ($status, $msg);
+}
+
+=head2 Panes
+
+Returns a hashref of pane name to portlets
+
+=cut
+
+sub Panes {
+    my $self = shift;
+    return unless ref($self->{'Attribute'}) eq 'RT::Attribute';
+    return $self->{'Attribute'}->SubValue('Panes') || {};
+}
+
+=head2 Portlets
+
+Returns the list of this dashboard's portlets, each a hashref with key
+C being C or C.
+
+=cut
+
+sub Portlets {
+    my $self = shift;
+    return map { @$_ } values %{ $self->Panes };
+}
+
+=head2 Dashboards
+
+Returns a list of loaded sub-dashboards
+
+=cut
+
+sub Dashboards {
+    my $self = shift;
+    return map {
+        my $search = RT::Dashboard->new($self->CurrentUser);
+        $search->LoadById($_->{id});
+        $search
+    } grep { $_->{portlet_type} eq 'dashboard' } $self->Portlets;
+}
+
+=head2 Searches
+
+Returns a list of loaded saved searches
+
+=cut
+
+sub Searches {
+    my $self = shift;
+    return map {
+        my $search = RT::SavedSearch->new($self->CurrentUser);
+        $search->Load($_->{privacy}, $_->{id});
+        $search
+    } grep { $_->{portlet_type} eq 'search' } $self->Portlets;
+}
+
+=head2 ShowSearchName Portlet
+
+Returns an array for one saved search, suitable for passing to
+/Elements/ShowSearch.
+
+=cut
+
+sub ShowSearchName {
+    my $self = shift;
+    my $portlet = shift;
+
+    if ($portlet->{privacy} eq 'RT::System') {
+        return Name => $portlet->{description};
+    }
+
+    return SavedSearch => join('-', $portlet->{privacy}, 'SavedSearch', $portlet->{id});
+}
+
+=head2 PossibleHiddenSearches
+
+This will return a list of saved searches that are potentially not visible by
+all users for whom the dashboard is visible. You may pass in a privacy to
+use instead of the dashboard's privacy.
+
+=cut
+
+sub PossibleHiddenSearches {
+    my $self = shift;
+    my $privacy = shift || $self->Privacy;
+
+    return grep { !$_->IsVisibleTo($privacy) } $self->Searches, $self->Dashboards;
+}
+
+# _PrivacyObjects: returns a list of objects that can be used to load
+# dashboards from. If the Modify parameter is true, then check modify rights.
+# If the Create parameter is true, then check create rights. Otherwise, check
+# read rights.
+
+sub _PrivacyObjects {
+    my $self = shift;
+    my %args = @_;
+
+    my $CurrentUser = $self->CurrentUser;
+    my @objects;
+
+    my $prefix = $args{Modify} ? "Modify"
+               : $args{Create} ? "Create"
+                               : "See";
+
+    push @objects, $CurrentUser->UserObj
+        if $self->CurrentUser->HasRight(
+            Right  => "${prefix}OwnDashboard",
+            Object => $RT::System,
+        );
+
+    my $groups = RT::Groups->new($CurrentUser);
+    $groups->LimitToUserDefinedGroups;
+    $groups->WithMember( PrincipalId => $CurrentUser->Id,
+                         Recursively => 1 );
+
+    push @objects, grep {
+        $self->CurrentUser->HasRight(
+            Right  => "${prefix}GroupDashboard",
+            Object => $_,
+        )
+    } @{ $groups->ItemsArrayRef };
+
+    push @objects, RT::System->new($CurrentUser)
+        if $CurrentUser->HasRight(
+            Right  => "${prefix}Dashboard",
+            Object => $RT::System,
+        );
+
+    return @objects;
+}
+
+# ACLs
+
+sub _CurrentUserCan {
+    my $self    = shift;
+    my $privacy = shift || $self->Privacy;
+    my %args    = @_;
+
+    if (!defined($privacy)) {
+        $RT::Logger->debug("No privacy provided to $self->_CurrentUserCan");
+        return 0;
+    }
+
+    my $object = $self->_GetObject($privacy);
+    return 0 unless $object;
+
+    my $level;
+
+       if ($object->isa('RT::User'))   { $level = 'Own' }
+    elsif ($object->isa('RT::Group'))  { $level = 'Group' }
+    elsif ($object->isa('RT::System')) { $level = '' }
+    else {
+        $RT::Logger->error("Unknown object $object from privacy $privacy");
+        return 0;
+    }
+
+    # users are mildly special-cased, since we actually have to check that
+    # the user is operating on himself
+    if ($object->isa('RT::User')) {
+        return 0 unless $object->Id == $self->CurrentUser->Id;
+    }
+
+    my $right = $args{FullRight}
+             || join('', $args{Right}, $level, 'Dashboard');
+
+    # all rights, except group rights, are global
+    $object = $RT::System unless $object->isa('RT::Group');
+
+    return $self->CurrentUser->HasRight(
+        Right  => $right,
+        Object => $object,
+    );
+}
+
+sub CurrentUserCanSee {
+    my $self    = shift;
+    my $privacy = shift;
+
+    $self->_CurrentUserCan($privacy, Right => 'See');
+}
+
+sub CurrentUserCanCreate {
+    my $self    = shift;
+    my $privacy = shift;
+
+    $self->_CurrentUserCan($privacy, Right => 'Create');
+}
+
+sub CurrentUserCanModify {
+    my $self    = shift;
+    my $privacy = shift;
+
+    $self->_CurrentUserCan($privacy, Right => 'Modify');
+}
+
+sub CurrentUserCanDelete {
+    my $self    = shift;
+    my $privacy = shift;
+
+    $self->_CurrentUserCan($privacy, Right => 'Delete');
+}
+
+sub CurrentUserCanSubscribe {
+    my $self    = shift;
+    my $privacy = shift;
+
+    $self->_CurrentUserCan($privacy, FullRight => 'SubscribeDashboard');
+}
+
+eval "require RT::Dashboard_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Dashboard_Vendor.pm});
+eval "require RT::Dashboard_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Dashboard_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Date.pm b/rt/lib/RT/Date.pm
index 8e9383fd7..fc4c43ce4 100644
--- a/rt/lib/RT/Date.pm
+++ b/rt/lib/RT/Date.pm
@@ -1,8 +1,8 @@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
 #                                          
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -45,6 +45,7 @@
 # those contributions and any derivatives thereof.
 # 
 # END BPS TAGGED BLOCK }}}
+
 =head1 NAME
 
   RT::Date - a simple Object Oriented date.
@@ -59,11 +60,6 @@ RT Date is a simple Date Object designed to be speedy and easy for RT to use
 
 The fact that it assumes that a time of 0 means "never" is probably a bug.
 
-=begin testing
-
-ok (require RT::Date);
-
-=end testing
 
 =head1 METHODS
 
@@ -73,12 +69,11 @@ ok (require RT::Date);
 package RT::Date;
 
 use Time::Local;
-
-use RT::Base;
+use POSIX qw(tzset);
 
 use strict;
-use vars qw/@ISA/;
-@ISA = qw/RT::Base/;
+use warnings;
+use base qw/RT::Base/;
 
 use vars qw($MINUTE $HOUR $DAY $WEEK $MONTH $YEAR);
 
@@ -86,30 +81,68 @@ $MINUTE = 60;
 $HOUR   = 60 * $MINUTE;
 $DAY    = 24 * $HOUR;
 $WEEK   = 7 * $DAY;
-$MONTH  = 4 * $WEEK;
-$YEAR   = 365 * $DAY;
-
-# {{{ sub new 
-
-sub new  {
-  my $proto = shift;
-  my $class = ref($proto) || $proto;
-  my $self  = {};
-  bless ($self, $class);
-  $self->CurrentUser(@_);
-  $self->Unix(0);
-  return $self;
+$MONTH  = 30.4375 * $DAY;
+$YEAR   = 365.25 * $DAY;
+
+our @MONTHS = (
+    'Jan', # loc
+    'Feb', # loc
+    'Mar', # loc
+    'Apr', # loc
+    'May', # loc
+    'Jun', # loc
+    'Jul', # loc
+    'Aug', # loc
+    'Sep', # loc
+    'Oct', # loc
+    'Nov', # loc
+    'Dec', # loc
+);
+
+our @DAYS_OF_WEEK = (
+    'Sun', # loc
+    'Mon', # loc
+    'Tue', # loc
+    'Wed', # loc
+    'Thu', # loc
+    'Fri', # loc
+    'Sat', # loc
+);
+
+our @FORMATTERS = (
+    'DefaultFormat', # loc
+    'ISO',           # loc
+    'W3CDTF',        # loc
+    'RFC2822',       # loc
+    'RFC2616',       # loc
+    'iCal',          # loc
+);
+if ( eval 'use DateTime qw(); 1;' && eval 'use DateTime::Locale qw(); 1;' && 
+     DateTime->can('format_cldr') && DateTime::Locale::root->can('date_format_full') ) {
+    push @FORMATTERS, 'LocalizedDateTime'; # loc
 }
 
-# }}}
+=head2 new
+
+Object constructor takes one argument C object.
 
-# {{{ sub Set
+=cut
 
-=head2 sub Set
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self  = {};
+    bless ($self, $class);
+    $self->CurrentUser(@_);
+    $self->Unix(0);
+    return $self;
+}
 
-takes a param hash with the fields 'Format' and 'Value'
+=head2 Set
 
-if $args->{'Format'} is 'unix', takes the number of seconds since the epoch 
+Takes a param hash with the fields C, C and C.
+
+If $args->{'Format'} is 'unix', takes the number of seconds since the epoch.
 
 If $args->{'Format'} is ISO, tries to parse an ISO date.
 
@@ -118,114 +151,100 @@ things out. This is a heavyweight operation that should never be called from
 within RT's core. But it's really useful for something like the textbox date
 entry where we let the user do whatever they want.
 
-If $args->{'Value'}  is 0, assumes you mean never.
-
-=begin testing
-
-use_ok(RT::Date);
-my $date = RT::Date->new($RT::SystemUser);
-$date->Set(Format => 'unix', Value => '0');
-ok ($date->ISO eq '1970-01-01 00:00:00', "Set a date to midnight 1/1/1970 GMT");
-
-=end testing
+If $args->{'Value'} is 0, assumes you mean never.
 
 =cut
 
 sub Set {
     my $self = shift;
-    my %args = ( Format => 'unix',
-                 Value  => time,
-                 @_ );
-    if ( !$args{'Value'}
-         || ( ( $args{'Value'} =~ /^\d*$/ ) and ( $args{'Value'} == 0 ) ) ) {
-        $self->Unix(-1);
-        return ( $self->Unix() );
-    }
+    my %args = (
+        Format   => 'unix',
+        Value    => time,
+        Timezone => 'user',
+        @_
+    );
+
+    return $self->Unix(0) unless $args{'Value'};
 
     if ( $args{'Format'} =~ /^unix$/i ) {
-        $self->Unix( $args{'Value'} );
+        return $self->Unix( $args{'Value'} );
     }
-
     elsif ( $args{'Format'} =~ /^(sql|datemanip|iso)$/i ) {
-	$args{'Value'} =~ s!/!-!g;
-
-        if (( $args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ )
-            || ( $args{'Value'} =~
-                 /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/ )
-            || ( $args{'Value'} =~
-                 /^(\d{4}?)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)\+00$/ )
-            || ($args{'Value'} =~ /^(\d{4}?)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/ )
+        $args{'Value'} =~ s!/!-!g;
+
+        if (   ( $args{'Value'} =~ /^(\d{4})?(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ )
+            || ( $args{'Value'} =~ /^(\d{4})?(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/ )
+            || ( $args{'Value'} =~ /^(?:(\d{4})-)?(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)$/ )
+            || ( $args{'Value'} =~ /^(?:(\d{4})-)?(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)\+00$/ )
           ) {
 
-            my $year  = $1;
-            my $mon   = $2;
-            my $mday  = $3;
-            my $hours = $4;
-            my $min   = $5;
-            my $sec   = $6;
+            my ($year, $mon, $mday, $hours, $min, $sec)  = ($1, $2, $3, $4, $5, $6);
+
+            # use current year if string has no value
+            $year ||= (localtime time)[5] + 1900;
 
             #timegm expects month as 0->11
             $mon--;
 
-            #now that we've parsed it, deal with the case where everything
-            #was 0
-            if ( $mon == -1 ) {
-                $self->Unix(-1);
-            }
-            else {
-
-                #Dateamnip strings aren't in GMT.
-                if ( $args{'Format'} =~ /^datemanip$/i ) {
-                    $self->Unix(
-                          timelocal( $sec, $min, $hours, $mday, $mon, $year ) );
-                }
-
-                #ISO and SQL dates are in GMT
-                else {
-                    $self->Unix(
-                             timegm( $sec, $min, $hours, $mday, $mon, $year ) );
-                }
-
-                $self->Unix(-1) unless $self->Unix;
-            }
+            #now that we've parsed it, deal with the case where everything was 0
+            return $self->Unix(0) if $mon < 0 || $mon > 11;
+
+            my $tz = lc $args{'Format'} eq 'datemanip'? 'user': 'utc';
+            $self->Unix( $self->Timelocal( $tz, $sec, $min, $hours, $mday, $mon, $year ) );
+
+            $self->Unix(0) unless $self->Unix > 0;
         }
         else {
-            use Carp;
-            Carp::cluck;
-            $RT::Logger->debug(
-                     "Couldn't parse date $args{'Value'} as a $args{'Format'}");
-
+            $RT::Logger->warning(
+                "Couldn't parse date '$args{'Value'}' as a $args{'Format'} format"
+            );
+            return $self->Unix(0);
         }
     }
     elsif ( $args{'Format'} =~ /^unknown$/i ) {
         require Time::ParseDate;
-
-        #Convert it to an ISO format string
-
-	my $date = Time::ParseDate::parsedate($args{'Value'},
-			UK => $RT::DateDayBeforeMonth,
-			PREFER_PAST => $RT::AmbiguousDayInPast,
-			PREFER_FUTURE => !($RT::AmbiguousDayInPast));
-
-        #This date has now been set to a date in the _local_ timezone.
-        #since ISO dates are known to be in GMT (for RT's purposes);
-
-        $RT::Logger->debug( "RT::Date used date::parse to make "
-                            . $args{'Value'}
-                            . " $date\n" );
-
-        return ( $self->Set( Format => 'unix', Value => "$date" ) );
+        # the module supports only legacy timezones like PDT or EST...
+        # so we parse date as GMT and later apply offset, this only
+        # should be applied to absolute times, so compensate shift in NOW
+        my $now = time;
+        $now += ($self->Localtime( $args{Timezone}, $now ))[9];
+        my $date = Time::ParseDate::parsedate(
+            $args{'Value'},
+            GMT           => 1,
+            NOW           => $now,
+            UK            => RT->Config->Get('DateDayBeforeMonth'),
+            PREFER_PAST   => RT->Config->Get('AmbiguousDayInPast'),
+            PREFER_FUTURE => RT->Config->Get('AmbiguousDayInFuture'),
+        );
+        # apply timezone offset
+        $date -= ($self->Localtime( $args{Timezone}, $date ))[9];
+
+        $RT::Logger->debug(
+            "RT::Date used Time::ParseDate to make '$args{'Value'}' $date\n"
+        );
+
+        return $self->Set( Format => 'unix', Value => $date);
     }
     else {
-        die "Unknown Date format: " . $args{'Format'} . "\n";
+        $RT::Logger->error(
+            "Unknown Date format: $args{'Format'}\n"
+        );
+        return $self->Unix(0);
     }
 
-    return ( $self->Unix() );
+    return $self->Unix;
 }
 
-# }}}
+=head2 SetToNow
 
-# {{{ sub SetToMidnight 
+Set the object's time to the current time. Takes no arguments
+and returns unix time.
+
+=cut
+
+sub SetToNow {
+    return $_[0]->Unix(time);
+}
 
 =head2 SetToMidnight [Timezone => 'utc']
 
@@ -236,131 +255,114 @@ Arguments:
 
 =over 4
 
-=item Timezone - Timezone context C or C
+=item Timezone
+
+Timezone context C, C or C. See also L.
+
+=back
 
 =cut
 
 sub SetToMidnight {
     my $self = shift;
-    my %args = ( Timezone => 'UTC', @_ );
-    if ( lc $args{'Timezone'} eq 'server' ) {
-        $self->Unix( Time::Local::timelocal( 0,0,0,(localtime $self->Unix)[3..7] ) );
-    } else {
-        $self->Unix( Time::Local::timegm( 0,0,0,(gmtime $self->Unix)[3..7] ) );
-    }
-    return ($self->Unix);
-}
-
-
-# }}}
-
-# {{{ sub SetToNow
-sub SetToNow {
-	my $self = shift;
-	return($self->Set(Format => 'unix', Value => time))
+    my %args = ( Timezone => '', @_ );
+    my $new = $self->Timelocal(
+        $args{'Timezone'},
+        0,0,0,($self->Localtime( $args{'Timezone'} ))[3..9]
+    );
+    return $self->Unix( $new );
 }
-# }}}
-
-# {{{ sub Diff
 
 =head2 Diff
 
-Takes either an RT::Date object or the date in unixtime format as a string
+Takes either an C object or the date in unixtime format as a string,
+if nothing is specified uses the current time.
 
-Returns the differnce between $self and that time as a number of seconds
+Returns the differnce between the time in the current object and that time
+as a number of seconds. Returns C if any of two compared values is
+incorrect or not set.
 
 =cut
 
 sub Diff {
     my $self = shift;
     my $other = shift;
-
-    if (ref($other) eq 'RT::Date') {
-	$other=$other->Unix;
+    $other = time unless defined $other;
+    if ( UNIVERSAL::isa( $other, 'RT::Date' ) ) {
+        $other = $other->Unix;
     }
-    return ($self->Unix - $other);
-}
-# }}}
+    return undef unless $other=~ /^\d+$/ && $other > 0;
 
-# {{{ sub DiffAsString
+    my $unix = $self->Unix;
+    return undef unless $unix > 0;
 
-=head2 sub DiffAsString
+    return $unix - $other;
+}
+
+=head2 DiffAsString
 
-Takes either an RT::Date object or the date in unixtime format as a string
+Takes either an C object or the date in unixtime format as a string,
+if nothing is specified uses the current time.
 
-Returns the differnce between $self and that time as a number of seconds as
-as string fit for human consumption
+Returns the differnce between C<$self> and that time as a number of seconds as
+a localized string fit for human consumption. Returns empty string if any of
+two compared values is incorrect or not set.
 
 =cut
 
 sub DiffAsString {
     my $self = shift;
-    my $other = shift;
-
-
-    if ($other < 1) {
-	return ("");
-    }
-    if ($self->Unix < 1) {
-	return("");
-    }
-    my $diff = $self->Diff($other);
+    my $diff = $self->Diff( @_ );
+    return '' unless defined $diff;
 
-    return ($self->DurationAsString($diff));
+    return $self->DurationAsString( $diff );
 }
-# }}}
-
-# {{{ sub DurationAsString
-
 
 =head2 DurationAsString
 
-Takes a number of seconds. returns a string describing that duration
+Takes a number of seconds. Returns a localized string describing
+that duration.
 
 =cut
 
 sub DurationAsString {
-
     my $self     = shift;
-    my $duration = shift;
-
-    my ( $negative, $s );
+    my $duration = int shift;
 
-    $negative = 1 if ( $duration < 0 );
+    my ( $negative, $s, $time_unit );
+    $negative = 1 if $duration < 0;
+    $duration = abs $duration;
 
-    $duration = abs($duration);
-
-    my $time_unit;
     if ( $duration < $MINUTE ) {
         $s         = $duration;
         $time_unit = $self->loc("sec");
     }
     elsif ( $duration < ( 2 * $HOUR ) ) {
-        $s         = int( $duration / $MINUTE );
+        $s         = int( $duration / $MINUTE + 0.5 );
         $time_unit = $self->loc("min");
     }
     elsif ( $duration < ( 2 * $DAY ) ) {
-        $s         = int( $duration / $HOUR );
+        $s         = int( $duration / $HOUR + 0.5 );
         $time_unit = $self->loc("hours");
     }
     elsif ( $duration < ( 2 * $WEEK ) ) {
-        $s         = int( $duration / $DAY );
+        $s         = int( $duration / $DAY + 0.5 );
         $time_unit = $self->loc("days");
     }
     elsif ( $duration < ( 2 * $MONTH ) ) {
-        $s         = int( $duration / $WEEK );
+        $s         = int( $duration / $WEEK + 0.5 );
         $time_unit = $self->loc("weeks");
     }
     elsif ( $duration < $YEAR ) {
-        $s         = int( $duration / $MONTH );
+        $s         = int( $duration / $MONTH + 0.5 );
         $time_unit = $self->loc("months");
     }
     else {
-        $s         = int( $duration / $YEAR );
+        $s         = int( $duration / $YEAR + 0.5 );
         $time_unit = $self->loc("years");
     }
 
-    if ($negative) {
+    if ( $negative ) {
         return $self->loc( "[_1] [_2] ago", $s, $time_unit );
     }
     else {
@@ -368,47 +370,46 @@ sub DurationAsString {
     }
 }
 
-# }}}
+=head2 AgeAsString
 
-# {{{ sub AgeAsString
+Takes nothing. Returns a string that's the differnce between the
+time in the object and now.
 
-=head2 sub AgeAsString
+=cut
 
-Takes nothing
+sub AgeAsString { return $_[0]->DiffAsString }
 
-Returns a string that's the differnce between the time in the object and now
 
-=cut
 
-sub AgeAsString {
-    my $self = shift;
-    return ($self->DiffAsString(time));
-    }
-# }}}
+=head2 AsString
 
-# {{{ sub AsString
+Returns the object's time as a localized string with curent user's prefered
+format and timezone.
 
-=head2 sub AsString
-
-Returns the object\'s time as a string with the current timezone.
+If the current user didn't choose prefered format then system wide setting is
+used or L if the latter is not specified. See config option
+C.
 
 =cut
 
 sub AsString {
     my $self = shift;
-    return ($self->loc("Not set")) if ($self->Unix <= 0);
+    my %args = (@_);
 
-    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($self->Unix);
+    return $self->loc("Not set") unless $self->Unix > 0;
 
-    return $self->loc("[_1] [_2] [_3] [_4]:[_5]:[_6] [_7]", $self->GetWeekday($wday), $self->GetMonth($mon), map {sprintf "%02d", $_} ($mday, $hour, $min, $sec), ($year+1900));
-}
-# }}}
+    my $format = RT->Config->Get( 'DateTimeFormat', $self->CurrentUser ) || 'DefaultFormat';
+    $format = { Format => $format } unless ref $format;
+    %args = (%$format, %args);
 
-# {{{ GetWeekday
+    return $self->Get( Timezone => 'user', %args );
+}
 
 =head2 GetWeekday DAY
 
-Takes an integer day of week and returns a localized string for that day of week
+Takes an integer day of week and returns a localized string for
+that day of week. Valid values are from range 0-6, Note that B<0
+is sunday>.
 
 =cut
 
@@ -416,227 +417,628 @@ sub GetWeekday {
     my $self = shift;
     my $dow = shift;
     
-    return $self->loc('Mon.') if ($dow == 1);
-    return $self->loc('Tue.') if ($dow == 2);
-    return $self->loc('Wed.') if ($dow == 3);
-    return $self->loc('Thu.') if ($dow == 4);
-    return $self->loc('Fri.') if ($dow == 5);
-    return $self->loc('Sat.') if ($dow == 6);
-    return $self->loc('Sun.') if ($dow == 0);
+    return $self->loc($DAYS_OF_WEEK[$dow])
+        if $DAYS_OF_WEEK[$dow];
+    return '';
 }
 
-# }}}
-
-# {{{ GetMonth
-
-=head2 GetMonth DAY
+=head2 GetMonth MONTH
 
-Takes an integer month and returns a localized string for that month 
+Takes an integer month and returns a localized string for that month.
+Valid values are from from range 0-11.
 
 =cut
 
 sub GetMonth {
     my $self = shift;
-   my $mon = shift;
-
-    # We do this rather than an array so that we don't call localize 12x what we need to
-    return $self->loc('Jan.') if ($mon == 0);
-    return $self->loc('Feb.') if ($mon == 1);
-    return $self->loc('Mar.') if ($mon == 2);
-    return $self->loc('Apr.') if ($mon == 3);
-    return $self->loc('May.') if ($mon == 4);
-    return $self->loc('Jun.') if ($mon == 5);
-    return $self->loc('Jul.') if ($mon == 6);
-    return $self->loc('Aug.') if ($mon == 7);
-    return $self->loc('Sep.') if ($mon == 8);
-    return $self->loc('Oct.') if ($mon == 9);
-    return $self->loc('Nov.') if ($mon == 10);
-    return $self->loc('Dec.') if ($mon == 11);
-}
-
-# }}}
+    my $mon = shift;
 
-# {{{ sub AddSeconds
+    return $self->loc($MONTHS[$mon])
+        if $MONTHS[$mon];
+    return '';
+}
 
-=head2 sub AddSeconds
+=head2 AddSeconds SECONDS
 
-Takes a number of seconds as a string
+Takes a number of seconds and returns the new unix time.
 
-Returns the new time
+Negative value can be used to substract seconds.
 
 =cut
 
 sub AddSeconds {
     my $self = shift;
-    my $delta = shift;
+    my $delta = shift or return $self->Unix;
     
     $self->Set(Format => 'unix', Value => ($self->Unix + $delta));
-    
+ 
     return ($self->Unix);
-    
+}
+
+=head2 AddDays [DAYS]
 
+Adds C<24 hours * DAYS> to the current time. Adds one day when
+no argument is specified. Negative value can be used to substract
+days.
+
+Returns new unix time.
+
+=cut
+
+sub AddDays {
+    my $self = shift;
+    my $days = shift || 1;
+    return $self->AddSeconds( $days * $DAY );
 }
 
-# }}}
+=head2 AddDay
+
+Adds 24 hours to the current time. Returns new unix time.
 
-# {{{ sub AddDays
+=cut
 
-=head2 AddDays $DAYS
+sub AddDay { return $_[0]->AddSeconds($DAY) }
 
-Adds 24 hours * $DAYS to the current time
+=head2 Unix [unixtime]
+
+Optionally takes a date in unix seconds since the epoch format.
+Returns the number of seconds since the epoch
 
 =cut
 
-sub AddDays {
+sub Unix {
+    my $self = shift; 
+    $self->{'time'} = int(shift || 0) if @_;
+    return $self->{'time'};
+}
+
+=head2 DateTime
+
+Alias for L method. Arguments C and