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