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         ## check if FS contact email exists, if not create it.
 169         if ( !qsearchs( {
 170             'table'     => 'contact_email',
 171             'hashref'   => { 'emailaddress' => $Requestor->{'values'}->{'emailaddress'}, },
 172            } ) ) {
 173              use FS::contact;
 174
 175              my $lname = $Requestor->{'values'}->{'realname'} ?
 176                 (split (/ /, $Requestor->{'values'}->{'realname'}))[-1] :
 177                 'Requestor';
 178
 179             my $fname = $Requestor->{'values'}->{'realname'} ?
 180                 (split (/ /, $Requestor->{'values'}->{'realname'}))[0] :
 181                 'RT';
 182
 183              my $contact = new FS::contact {
 184                 'custnum'       => $custnum,
 185                 'first'         => $fname,
 186                 'last'          => $lname,
 187                 'emailaddress'  => $Requestor->{'values'}->{'emailaddress'},
 188                 'comment'       => 'Auto created from RT requestor',
 189              };
 190              my $error = $contact->insert;
 191              push @results, 'Created Freeside contact for requestor ' . $Requestor->{'values'}->{'emailaddress'}
 192              unless $error;
 193         }
 194       }
 195
 196     }
 197
 198     return @results;
 199
 200 }
 201
 202 #false laziness w/above... eventually it should go away in favor of this
 203 sub ProcessObjectCustomers {
 204     my %args = (
 205         Object => undef,
 206         ARGSRef   => undef,
 207         @_
 208     );
 209     my @results = ();
 210
 211     my $Object  = $args{'Object'};
 212     my $ARGSRef = $args{'ARGSRef'};
 213
 214     ### false laziness w/RT::Interface::Web::ProcessTicketLinks
 215     # Delete links that are gone gone gone.
 216     foreach my $arg ( keys %$ARGSRef ) {
 217         if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
 218             my $base   = $1;
 219             my $type   = $2;
 220             my $target = $3;
 221
 222             push @results,
 223               "Trying to delete: Base: $base Target: $target  Type $type";
 224             my ( $val, $msg ) = $Object->DeleteLink( Base   => $base,
 225                                                      Type   => $type,
 226                                                      Target => $target );
 227
 228             push @results, $msg;
 229
 230         }
 231
 232     }
 233     ###
 234
 235     #my @delete_custnums =
 236     #  map  { /^Object-AddCustomer-(\d+)$/; $1 }
 237     #  grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 238     #  keys %$ARGSRef;
 239
 240     my @custnums = map  { /^Object-AddCustomer-(\d+)$/; $1 }
 241                    grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
 242                    keys %$ARGSRef;
 243
 244     foreach my $custnum ( @custnums ) {
 245       my( $val, $msg ) =
 246         $Object->AddLink( 'Type'   => 'MemberOf',
 247                           'Target' => "freeside://freeside/cust_main/$custnum",
 248                         );
 249       push @results, $msg;
 250     }
 251
 252     return @results;
 253
 254 }
 255
 256 =head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
 257
 258 Updates all core ticket fields except Status, and returns an array of results
 259 messages.
 260
 261 =cut
 262
 263 sub ProcessTicketBasics {
 264
 265     my %args = (
 266         TicketObj => undef,
 267         ARGSRef   => undef,
 268         @_
 269     );
 270
 271     my $TicketObj = $args{'TicketObj'};
 272     my $ARGSRef   = $args{'ARGSRef'};
 273
 274     # {{{ Set basic fields
 275     my @attribs = qw(
 276         Subject
 277         FinalPriority
 278         Priority
 279         TimeEstimated
 280         TimeWorked
 281         TimeLeft
 282         Type
 283         Queue
 284         WillResolve
 285     );
 286
 287     # the UI for editing WillResolve through Ticket Basics should allow
 288     # setting it to null
 289     if ( exists $ARGSRef->{'WillResolve_Date'} ) {
 290       my $to_date = delete($ARGSRef->{'WillResolve_Date'});
 291       my $DateObj = RT::Date->new($session{'CurrentUser'});
 292       if ( $to_date ) {
 293           $DateObj->Set(Format => 'unknown', Value => $to_date);
 294           if ( $DateObj->Unix > time ) {
 295             $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 296           } else {
 297             warn "Ticket ".$TicketObj->Id.": WillResolve date '$to_date' not accepted.\n";
 298             # and then don't set it in ARGSRef
 299           }
 300       } elsif ( $TicketObj and $TicketObj->WillResolveObj->Unix > 0 ) {
 301           $DateObj->Set(Value => 0);
 302           $ARGSRef->{'WillResolve'} = $DateObj->ISO;
 303       }
 304     }
 305
 306     if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
 307         my $tempqueue = RT::Queue->new($RT::SystemUser);
 308         $tempqueue->Load( $ARGSRef->{'Queue'} );
 309         if ( $tempqueue->id ) {
 310             $ARGSRef->{'Queue'} = $tempqueue->id;
 311         }
 312     }
 313
 314     # RT core _will_ allow Set transactions that change these
 315     # fields to empty strings, but internally change the values
 316     # to zero.  This is sloppy and causes some problems.
 317     foreach my $field (qw(TimeWorked TimeEstimated TimeLeft)) {
 318       if (exists $ARGSRef->{$field}) {
 319         $ARGSRef->{$field} =~ s/\s//g;
 320         $ARGSRef->{$field} ||= 0;
 321       }
 322     }
 323
 324     my @results = UpdateRecordObject(
 325         AttributesRef => \@attribs,
 326         Object        => $TicketObj,
 327         ARGSRef       => $ARGSRef,
 328     );
 329
 330     # We special case owner changing, so we can use ForceOwnerChange
 331     if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
 332         my ($ChownType);
 333         if ( $ARGSRef->{'ForceOwnerChange'} ) {
 334             $ChownType = "Force";
 335         } else {
 336             $ChownType = "Give";
 337         }
 338
 339         my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
 340         push( @results, $msg );
 341     }
 342
 343     return (@results);
 344 }
 345
 346 =head2 ProcessTicketDates (TicketObj => RT::Ticket, ARGSRef => {})
 347
 348 Process updates to the Starts, Started, Told, Resolved, and WillResolve
 349 fields.
 350
 351 =cut
 352
 353 sub ProcessTicketDates {
 354     my %args = (
 355         TicketObj => undef,
 356         ARGSRef   => undef,
 357         @_
 358     );
 359
 360     my $Ticket  = $args{'TicketObj'};
 361     my $ARGSRef = $args{'ARGSRef'};
 362
 363     my (@results);
 364
 365     # {{{ Set date fields
 366     my @date_fields = qw(
 367         Told
 368         Resolved
 369         Starts
 370         Started
 371         Due
 372         WillResolve
 373     );
 374
 375     #Run through each field in this list. update the value if apropriate
 376     foreach my $field (@date_fields) {
 377         next unless exists $ARGSRef->{ $field . '_Date' };
 378         next if $ARGSRef->{ $field . '_Date' } eq '';
 379
 380         my ( $code, $msg );
 381
 382         my $DateObj = RT::Date->new( $session{'CurrentUser'} );
 383         $DateObj->Set(
 384             Format => 'unknown',
 385             Value  => $ARGSRef->{ $field . '_Date' }
 386         );
 387
 388         if ( $field eq 'WillResolve'
 389               and $DateObj->Unix > 0
 390               and $DateObj->Unix <= time ) {
 391             push @results, "Can't set WillResolve date in the past.";
 392             next;
 393         }
 394
 395         my $obj = $field . "Obj";
 396         if (    ( defined $DateObj->Unix )
 397             and ( $DateObj->Unix != $Ticket->$obj()->Unix() ) )
 398         {
 399             my $method = "Set$field";
 400             my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
 401             push @results, "$msg";
 402         }
 403     }
 404
 405     # }}}
 406     return (@results);
 407 }
 408
 409 =head2 ProcessTicketStatus (TicketObj => RT::Ticket, ARGSRef => {})
 410
 411 Process updates to the 'Status' field of the ticket.  If the new value
 412 of Status is 'resolved', this will check required custom fields before
 413 allowing the update.
 414
 415 =cut
 416
 417 sub ProcessTicketStatus {
 418     my %args = (
 419         TicketObj => undef,
 420         ARGSRef   => undef,
 421         @_
 422     );
 423
 424     my $TicketObj = $args{'TicketObj'};
 425     my $ARGSRef   = $args{'ARGSRef'};
 426     my @results;
 427
 428     return () if !$ARGSRef->{'Status'};
 429
 430     if ( lc( $ARGSRef->{'Status'} ) eq 'resolved' ) {
 431         foreach my $field ( $TicketObj->MissingRequiredFields ) {
 432             push @results, loc('Missing required field: [_1]', $field->Name);
 433         }
 434     }
 435     if ( @results ) {
 436         $m->notes('RedirectToBasics' => 1);
 437         return @results;
 438     }
 439
 440     return UpdateRecordObject(
 441         AttributesRef => [ 'Status' ],
 442         Object        => $TicketObj,
 443         ARGSRef       => $ARGSRef,
 444     );
 445 }
 446
 447 sub default_FormatDate { $_[0]->AsString }
 448
 449 sub ProcessColumnMapValue {
 450     my $value = shift;
 451     my %args = ( Arguments => [],
 452                  Escape => 1,
 453                  @_ );
 454
 455     my $FormatDate = $m->notes('FormatDate') || \&default_FormatDate;
 456
 457     if ( ref $value ) {
 458         if ( ref $value eq 'RT::Date' ) {
 459             return $FormatDate->($value);
 460         } elsif ( UNIVERSAL::isa( $value, 'CODE' ) ) {
 461             my @tmp = $value->( @{ $args{'Arguments'} } );
 462             return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
 463         } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
 464             return join '', map ProcessColumnMapValue( $_, %args ), @$value;
 465         } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
 466             return $$value;
 467         }
 468     }
 469
 470     return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
 471     return $value;
 472 }
 473
 474
 475 1;
 476