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