rt/lib/RT/Interface/Web_Vendor.pm

   1 # Copyright (c) 2004 Ivan Kohler <ivan-rt@420.am>
   2 # Copyright (c) 2008 Freeside Internet Services, Inc.
   3 #
   4 # This work is made available to you under the terms of Version 2 of
   5 # the GNU General Public License. A copy of that license should have
   6 # been provided with this software, but in any event can be snarfed
   7 # from www.gnu.org.
   8 #
   9 # This work is distributed in the hope that it will be useful, but
  10 # WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # General Public License for more details.
  13
  14 =head1 NAME
  15
  16 RT::Interface::Web_Vendor
  17
  18 =head1 SYNOPSIS
  19
  20 =head1 DESCRIPTION
  21
  22 Freeside vendor overlay for RT::Interface::Web.
  23
  24 =begin testing
  25
  26 use_ok(RT::Interface::Web_Vendor);
  27
  28 =end testing
  29
  30 =cut
  31
  32 #package RT::Interface::Web;
  33 #use strict;
  34
  35 package HTML::Mason::Commands;
  36 use strict;
  37 no warnings qw(redefine);
  38
  39 =head2 ProcessTicketCustomers
  40
  41 =cut
  42
  43 sub ProcessTicketCustomers {
  44     my %args = (
  45         TicketObj => undef,
  46         ARGSRef   => undef,
  47         Debug     => 0,
  48         @_
  49     );
  50     my @results = ();
  51
  52     my $Ticket  = $args{'TicketObj'};
  53     my $ARGSRef = $args{'ARGSRef'};
  54     my $Debug   = $args{'Debug'};
  55     my $me = 'ProcessTicketCustomers';
  56
  57     ### false laziness w/RT::Interface::Web::ProcessTicketLinks
  58     # Delete links that are gone gone gone.
  59     foreach my $arg ( keys %$ARGSRef ) {
  60         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
  61             my $base   = $1;
  62             my $type   = $2;
  63             my $target = $3;
  64
  65             push @results,
  66               "Trying to delete: Base: $base Target: $target  Type $type";
  67             my ( $val, $msg ) = $Ticket->DeleteLink( Base   => $base,
  68                                                      Type   => $type,
  69                                                      Target => $target );
  70
  71             push @results, $msg;
  72
  73         }
  74
  75     }
  76     ###
  77
  78     ###
  79     #find new services
  80     ###
  81
  82     my @svcnums = map  { /^Ticket-AddService-(\d+)$/; $1 }
  83                   grep { /^Ticket-AddService-(\d+)$/ && $ARGSRef->{$_} }
  84                   keys %$ARGSRef;
  85
  86     my @custnums;
  87     foreach my $svcnum (@svcnums) {
  88         my @link = ( 'Type'   => 'MemberOf',
  89                      'Target' => "freeside://freeside/cust_svc/$svcnum",
  90                    );
  91
  92         my( $val, $msg ) = $Ticket->AddLink(@link);
  93         push @results, $msg;
  94         next if !$val;
  95
  96     }
  97
  98     ###
  99     #find new customers
 100     ###
 101
 102     push @custnums, map  { /^Ticket-AddCustomer-(\d+)$/; $1 }
 103                     grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 104                     keys %$ARGSRef;
 105
 106     #my @delete_custnums =
 107     #  map  { /^Ticket-AddCustomer-(\d+)$/; $1 }
 108     #  grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 109     #  keys %$ARGSRef;
 110
 111     ###
 112     #figure out if we're going to auto-link requestors, and find them if so
 113     ###
 114
 115     my $num_cur_cust = $Ticket->Customers->Count;
 116     my $num_new_cust = scalar(@custnums);
 117     warn "$me: $num_cur_cust current customers / $num_new_cust new customers\n"
 118       if $Debug;
 119
 120     #if we're linking the first ticket to one customer
 121     my $link_requestors = ( $num_cur_cust == 0 && $num_new_cust == 1 );
 122     warn "$me: adding a single customer to a previously customerless".
 123          " ticket, so linking customers to requestor too\n"
 124       if $Debug && $link_requestors;
 125
 126     my @Requestors = ();
 127     if ( $link_requestors ) {
 128
 129       #find any requestors without customers
 130       @Requestors =
 131         grep { ! $_->Customers->Count }
 132              @{ $Ticket->Requestors->UserMembersObj->ItemsArrayRef };
 133
 134       warn "$me: found ". scalar(@Requestors). " requestors without".
 135            " customers; linking them\n"
 136         if $Debug;
 137
 138     }
 139
 140     ###
 141     #remove any declared non-customer addresses
 142     ###
 143
 144     my $exclude_regexp = RT->Config->Get('NonCustomerEmailRegexp');
 145     @Requestors = grep { not $_->EmailAddress =~ $exclude_regexp } @Requestors
 146       if defined $exclude_regexp;
 147
 148     ###
 149     #link ticket (and requestors) to customers
 150     ###
 151
 152     foreach my $custnum ( @custnums ) {
 153
 154       my @link = ( 'Type'   => 'MemberOf',
 155                    'Target' => "freeside://freeside/cust_main/$custnum",
 156                  );
 157
 158       my( $val, $msg ) = $Ticket->AddLink(@link);
 159       push @results, $msg;
 160
 161       #add customer links to requestors
 162       foreach my $Requestor ( @Requestors ) {
 163         my( $val, $msg ) = $Requestor->AddLink(@link);
 164         push @results, $msg;
 165         warn "$me: linking requestor to custnum $custnum: $msg\n"
 166           if $Debug > 1;
 167       }
 168
 169     }
 170
 171     return @results;
 172
 173 }
 174
 175 #false laziness w/above... eventually it should go away in favor of this
 176 sub ProcessObjectCustomers {
 177     my %args = (
 178         Object => undef,
 179         ARGSRef   => undef,
 180         @_
 181     );
 182     my @results = ();
 183
 184     my $Object  = $args{'Object'};
 185     my $ARGSRef = $args{'ARGSRef'};
 186
 187     ### false laziness w/RT::Interface::Web::ProcessTicketLinks
 188     # Delete links that are gone gone gone.
 189     foreach my $arg ( keys %$ARGSRef ) {
 190         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
 191             my $base   = $1;
 192             my $type   = $2;
 193             my $target = $3;
 194
 195             push @results,
 196               "Trying to delete: Base: $base Target: $target  Type $type";
 197             my ( $val, $msg ) = $Object->DeleteLink( Base   => $base,
 198                                                      Type   => $type,
 199                                                      Target => $target );
 200
 201             push @results, $msg;
 202
 203         }
 204
 205     }
 206     ###
 207
 208     #my @delete_custnums =
 209     #  map  { /^Object-AddCustomer-(\d+)$/; $1 }
 210     #  grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 211     #  keys %$ARGSRef;
 212
 213     my @custnums = map  { /^Object-AddCustomer-(\d+)$/; $1 }
 214                    grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 215                    keys %$ARGSRef;
 216
 217     foreach my $custnum ( @custnums ) {
 218       my( $val, $msg ) =
 219         $Object->AddLink( 'Type'   => 'MemberOf',
 220                           'Target' => "freeside://freeside/cust_main/$custnum",
 221                         );
 222       push @results, $msg;
 223     }
 224
 225     return @results;
 226
 227 }
 228
 229 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 230
 231 Updates all core ticket fields except Status, and returns an array of results
 232 messages.
 233
 234 =cut
 235
 236 sub ProcessTicketBasics {
 237
 238     my %args = (
 239         TicketObj => undef,
 240         ARGSRef   => undef,
 241         @_
 242     );
 243
 244     my $TicketObj = $args{'TicketObj'};
 245     my $ARGSRef   = $args{'ARGSRef'};
 246
 247     # {{{ Set basic fields
 248     my @attribs = qw(
 249         Subject
 250         FinalPriority
 251         Priority
 252         TimeEstimated
 253         TimeWorked
 254         TimeLeft
 255         Type
 256         Queue
 257         WillResolve
 258     );
 259
 260     # the UI for editing WillResolve through Ticket Basics should allow
 261     # setting it to null
 262     if ( exists $ARGSRef->{'WillResolve_Date'} ) {
 263       my $to_date = delete($ARGSRef->{'WillResolve_Date'});
 264       my $DateObj = RT::Date->new($session{'CurrentUser'});
 265       if ( $to_date ) {
 266           $DateObj->Set(Format => 'unknown', Value => $to_date);
 267           if ( $DateObj->Unix > time ) {
 268             $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 269           } else {
 270             warn "Ticket ".$TicketObj->Id.": WillResolve date '$to_date' not accepted.\n";
 271             # and then don't set it in ARGSRef
 272           }
 273       } elsif ( $TicketObj and $TicketObj->WillResolveObj->Unix > 0 ) {
 274           $DateObj->Set(Value => 0);
 275           $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 276       }
 277     }
 278
 279     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 280         my $tempqueue = RT::Queue->new($RT::SystemUser);
 281         $tempqueue->Load( $ARGSRef->{'Queue'} );
 282         if ( $tempqueue->id ) {
 283             $ARGSRef->{'Queue'} = $tempqueue->id;
 284         }
 285     }
 286
 287     # RT core _will_ allow Set transactions that change these
 288     # fields to empty strings, but internally change the values
 289     # to zero.  This is sloppy and causes some problems.
 290     foreach my $field (qw(TimeWorked TimeEstimated TimeLeft)) {
 291       if (exists $ARGSRef->{$field}) {
 292         $ARGSRef->{$field} =~ s/\s//g;
 293         $ARGSRef->{$field} ||= 0;
 294       }
 295     }
 296
 297     my @results = UpdateRecordObject(
 298         AttributesRef => \@attribs,
 299         Object        => $TicketObj,
 300         ARGSRef       => $ARGSRef,
 301     );
 302
 303     # We special case owner changing, so we can use ForceOwnerChange
 304     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
 305         my ($ChownType);
 306         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 307             $ChownType = "Force";
 308         } else {
 309             $ChownType = "Give";
 310         }
 311
 312         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 313         push( @results, $msg );
 314     }
 315
 316     return (@results);
 317 }
 318
 319 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
 320
 321 Process updates to the Starts, Started, Told, Resolved, and WillResolve
 322 fields.
 323
 324 =cut
 325
 326 sub ProcessTicketDates {
 327     my %args = (
 328         TicketObj => undef,
 329         ARGSRef   => undef,
 330         @_
 331     );
 332
 333     my $Ticket  = $args{'TicketObj'};
 334     my $ARGSRef = $args{'ARGSRef'};
 335
 336     my (@results);
 337
 338     # {{{ Set date fields
 339     my @date_fields = qw(
 340         Told
 341         Resolved
 342         Starts
 343         Started
 344         Due
 345         WillResolve
 346     );
 347
 348     #Run through each field in this list. update the value if apropriate
 349     foreach my $field (@date_fields) {
 350         next unless exists $ARGSRef->{ $field . '_Date' };
 351         next if $ARGSRef->{ $field . '_Date' } eq '';
 352
 353         my ( $code, $msg );
 354
 355         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
 356         $DateObj->Set(
 357             Format => 'unknown',
 358             Value  => $ARGSRef->{ $field . '_Date' }
 359         );
 360
 361         if ( $field eq 'WillResolve'
 362               and $DateObj->Unix > 0
 363               and $DateObj->Unix <= time ) {
 364             push @results, "Can't set WillResolve date in the past.";
 365             next;
 366         }
 367
 368         my $obj = $field . "Obj";
 369         if (    ( defined $DateObj->Unix )
 370             and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
 371         {
 372             my $method = "Set$field";
 373             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
 374             push @results, "$msg";
 375         }
 376     }
 377
 378     # }}}
 379     return (@results);
 380 }
 381
 382 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
 383
 384 Process updates to the 'Status' field of the ticket.  If the new value
 385 of Status is 'resolved', this will check required custom fields before
 386 allowing the update.
 387
 388 =cut
 389
 390 sub ProcessTicketStatus {
 391     my %args = (
 392         TicketObj => undef,
 393         ARGSRef   => undef,
 394         @_
 395     );
 396
 397     my $TicketObj = $args{'TicketObj'};
 398     my $ARGSRef   = $args{'ARGSRef'};
 399     my @results;
 400
 401     return () if !$ARGSRef->{'Status'};
 402
 403     if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
 404         foreach my $field ( $TicketObj->MissingRequiredFields ) {
 405             push @results, loc('Missing required field: [_1]', $field->Name);
 406         }
 407     }
 408     if ( @results ) {
 409         $m->notes('RedirectToBasics' => 1);
 410         return @results;
 411     }
 412
 413     return UpdateRecordObject(
 414         AttributesRef => [ 'Status' ],
 415         Object        => $TicketObj,
 416         ARGSRef       => $ARGSRef,
 417     );
 418 }
 419
 420 sub default_FormatDate { $_[0]->AsString }
 421
 422 sub ProcessColumnMapValue {
 423     my $value = shift;
 424     my %args = ( Arguments => [],
 425                  Escape => 1,
 426                  FormatDate => \&default_FormatDate,
 427                  @_ );
 428
 429     if ( ref $value ) {
 430         if ( ref $value eq 'RT::Date' ) {
 431             return $args{FormatDate}->($value);
 432         } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
 433             my @tmp = $value->( @{ $args{'Arguments'} } );
 434             return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
 435         } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
 436             return join '', map ProcessColumnMapValue( $_, %args ), @$value;
 437         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
 438             return $$value;
 439         }
 440     }
 441
 442     return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
 443     return $value;
 444 }
 445
 446
 447 1;
 448