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     my @results = UpdateRecordObject(
 288         AttributesRef => \@attribs,
 289         Object        => $TicketObj,
 290         ARGSRef       => $ARGSRef,
 291     );
 292
 293     # We special case owner changing, so we can use ForceOwnerChange
 294     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
 295         my ($ChownType);
 296         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 297             $ChownType = "Force";
 298         } else {
 299             $ChownType = "Give";
 300         }
 301
 302         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 303         push( @results, $msg );
 304     }
 305
 306     return (@results);
 307 }
 308
 309 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
 310
 311 Process updates to the Starts, Started, Told, Resolved, and WillResolve
 312 fields.
 313
 314 =cut
 315
 316 sub ProcessTicketDates {
 317     my %args = (
 318         TicketObj => undef,
 319         ARGSRef   => undef,
 320         @_
 321     );
 322
 323     my $Ticket  = $args{'TicketObj'};
 324     my $ARGSRef = $args{'ARGSRef'};
 325
 326     my (@results);
 327
 328     # {{{ Set date fields
 329     my @date_fields = qw(
 330         Told
 331         Resolved
 332         Starts
 333         Started
 334         Due
 335         WillResolve
 336     );
 337
 338     #Run through each field in this list. update the value if apropriate
 339     foreach my $field (@date_fields) {
 340         next unless exists $ARGSRef->{ $field . '_Date' };
 341         next if $ARGSRef->{ $field . '_Date' } eq '';
 342
 343         my ( $code, $msg );
 344
 345         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
 346         $DateObj->Set(
 347             Format => 'unknown',
 348             Value  => $ARGSRef->{ $field . '_Date' }
 349         );
 350
 351         if ( $field eq 'WillResolve'
 352               and $DateObj->Unix > 0
 353               and $DateObj->Unix <= time ) {
 354             push @results, "Can't set WillResolve date in the past.";
 355             next;
 356         }
 357
 358         my $obj = $field . "Obj";
 359         if (    ( defined $DateObj->Unix )
 360             and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
 361         {
 362             my $method = "Set$field";
 363             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
 364             push @results, "$msg";
 365         }
 366     }
 367
 368     # }}}
 369     return (@results);
 370 }
 371
 372 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
 373
 374 Process updates to the 'Status' field of the ticket.  If the new value
 375 of Status is 'resolved', this will check required custom fields before
 376 allowing the update.
 377
 378 =cut
 379
 380 sub ProcessTicketStatus {
 381     my %args = (
 382         TicketObj => undef,
 383         ARGSRef   => undef,
 384         @_
 385     );
 386
 387     my $TicketObj = $args{'TicketObj'};
 388     my $ARGSRef   = $args{'ARGSRef'};
 389     my @results;
 390
 391     return () if !$ARGSRef->{'Status'};
 392
 393     if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
 394         foreach my $field ( $TicketObj->MissingRequiredFields ) {
 395             push @results, loc('Missing required field: [_1]', $field->Name);
 396         }
 397     }
 398     if ( @results ) {
 399         $m->notes('RedirectToBasics' => 1);
 400         return @results;
 401     }
 402
 403     return UpdateRecordObject(
 404         AttributesRef => [ 'Status' ],
 405         Object        => $TicketObj,
 406         ARGSRef       => $ARGSRef,
 407     );
 408 }
 409
 410 sub default_FormatDate { $_[0]->AsString }
 411
 412 sub ProcessColumnMapValue {
 413     my $value = shift;
 414     my %args = ( Arguments => [],
 415                  Escape => 1,
 416                  FormatDate => \&default_FormatDate,
 417                  @_ );
 418
 419     if ( ref $value ) {
 420         if ( ref $value eq 'RT::Date' ) {
 421             return $args{FormatDate}->($value);
 422         } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
 423             my @tmp = $value->( @{ $args{'Arguments'} } );
 424             return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
 425         } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
 426             return join '', map ProcessColumnMapValue( $_, %args ), @$value;
 427         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
 428             return $$value;
 429         }
 430     }
 431
 432     return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
 433     return $value;
 434 }
 435
 436
 437 1;
 438