service refactor!
[freeside.git] / FS / FS / UI / Web.pm
index dc45e01..3348d67 100644 (file)
@@ -1,6 +1,7 @@
 package FS::UI::Web;
 
-use vars qw($DEBUG);
+use strict;
+use vars qw($DEBUG $me);
 use FS::Conf;
 use FS::Record qw(dbdef);
 
@@ -8,6 +9,13 @@ use FS::Record qw(dbdef);
 #use FS::UI
 #@ISA = qw( FS::UI );
 
+$DEBUG = 0;
+$me = '[FS::UID::Web]';
+
+###
+# date parsing
+###
+
 use Date::Parse;
 sub parse_beginning_ending {
   my($cgi) = @_;
@@ -30,74 +38,263 @@ sub parse_beginning_ending {
   ( $beginning, $ending );
 }
 
+=item svc_url
+
+Returns a service URL, first checking to see if there is a service-specific
+page to link to, otherwise to a generic service handling page.  Options are
+passed as a list of name-value pairs, and include:
+
+=over 4
+
+=item * m - Mason request object ($m)
+
+=item * action - The action for which to construct "edit", "view", or "search"
+
+=item ** part_svc - Service definition (see L<FS::part_svc>)
+
+=item ** svcdb - Service table
+
+=item *** query - Query string
+
+=item *** svc   - FS::cust_svc or FS::svc_* object
+
+=item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
+
+=back 
+
+* Required fields
+
+** part_svc OR svcdb is required
+
+*** query OR svc is required
+
+=cut
+
+  # ##
+  # #required
+  # ##
+  #  'm'        => $m, #mason request object
+  #  'action'   => 'edit', #or 'view'
+  #
+  #  'part_svc' => $part_svc, #usual
+  #   #OR
+  #  'svcdb'    => 'svc_table',
+  #
+  #  'query'    => #optional query string
+  #   #OR
+  #  'svc'      => $svc_x, #or $cust_svc, it just needs a svcnum
+  #
+  # ##
+  # #optional
+  # ##
+  #  'ahref'    => 1, # if set true, returns <A HREF="$url">
+
+use FS::CGI qw(popurl);
+sub svc_url {
+  my %opt = @_;
+
+  #? return '' unless ref($opt{part_svc});
+
+  my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
+  my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
+  my $url;
+  warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
+    if $DEBUG;
+  if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) {
+    $url = "$svcdb.cgi?";
+  } else {
+
+    my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
+
+    $url = "$generic.html?svcdb=$svcdb;";
+    $url .= 'svcnum=' if $query =~ /^\d+(;|$)/;
+  }
+
+  my $p = popurl(2); #?
+  my $return = "$p$opt{action}/$url$query";
+
+  $return = qq!<A HREF="$return">! if $opt{ahref};
+
+  $return;
+}
+
+sub svc_link {
+  my($m, $part_svc, $cust_svc) = @_ or return '';
+  svc_X_link( $part_svc->svc, @_ );
+}
+
+sub svc_label_link {
+  my($m, $part_svc, $cust_svc) = @_ or return '';
+  svc_X_link( ($cust_svc->label)[1], @_ );
+}
+
+sub svc_X_link {
+  my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
+  my $ahref = svc_url(
+    'ahref'    => 1,
+    'm'        => $m,
+    'action'   => 'view',
+    'part_svc' => $part_svc,
+    'svc'      => $cust_svc,
+  );
+
+  "$ahref$x</A>";
+}
+
+sub parse_lt_gt {
+  my($cgi, $field) = @_;
+
+  my @search = ();
+
+  my %op = ( 
+    'lt' => '<',
+    'gt' => '>',
+  );
+
+  foreach my $op (keys %op) {
+
+    warn "checking for ${field}_$op field\n"
+      if $DEBUG;
+
+    if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*([\d\,\s]+(\.\d\d)?)\s*$/ ) {
+
+      my $num = $1;
+      $num =~ s/[\,\s]+//g;
+      my $search = "$field $op{$op} $num";
+      push @search, $search;
+
+      warn "found ${field}_$op field; adding search element $search\n"
+        if $DEBUG;
+    }
+
+  }
+
+  @search;
+
+}
+
+sub bytecount_unexact {
+  my $bc = shift;
+  return("$bc bytes")
+    if ($bc < 1000);
+  return(sprintf("%.2f Kbytes", $bc/1000))
+    if ($bc < 1000000);
+  return(sprintf("%.2f Mbytes", $bc/1000000))
+    if ($bc < 1000000000);
+  return(sprintf("%.2f Gbytes", $bc/1000000000));
+}
+
 ###
-# cust_main report methods
+# cust_main report subroutines
 ###
 
-=item cust_header
 
-Returns an array of customer information headers according to the
-B<cust-fields> configuration setting.
+=item cust_header [ CUST_FIELDS_VALUE ]
+
+Returns an array of customer information headers according to the supplied
+customer fields value, or if no value is supplied, the B<cust-fields>
+configuration value.
 
 =cut
 
 use vars qw( @cust_fields );
 
-sub cust_sql_fields {
-  my @fields = qw( last first company );
-  push @fields, map "ship_$_", @fields
-    if dbdef->table('cust_main')->column('ship_last');
-  map "cust_main.$_", @fields;
-}
-
 sub cust_header {
 
   warn "FS::svc_Common::cust_header called"
     if $DEBUG;
 
-  my $conf = new FS::Conf;
-
   my %header2method = (
-    'Customer'           => 'name',
-    'Cust#'              => 'custnum',
-    'Name'               => 'contact',
-    'Company'            => 'company',
-    '(bill) Customer'    => 'name',
-    '(service) Customer' => 'ship_name',
-    '(bill) Name'        => 'contact',
-    '(service) Name'     => 'ship_contact',
-    '(bill) Company'     => 'company',
-    '(service) Company'  => 'ship_company',
+    'Customer'                 => 'name',
+    'Cust#'                    => 'custnum',
+    'Name'                     => 'contact',
+    'Company'                  => 'company',
+    '(bill) Customer'          => 'name',
+    '(service) Customer'       => 'ship_name',
+    '(bill) Name'              => 'contact',
+    '(service) Name'           => 'ship_contact',
+    '(bill) Company'           => 'company',
+    '(service) Company'        => 'ship_company',
+    'Address 1'                => 'address1',
+    'Address 2'                => 'address2',
+    'City'                     => 'city',
+    'State'                    => 'state',
+    'Zip'                      => 'zip',
+    'Country'                  => 'country_full',
+    'Day phone'                => 'daytime', # XXX should use msgcat, but how?
+    'Night phone'              => 'night',   # XXX should use msgcat, but how?
+    'Invoicing email(s)'       => 'invoicing_list_emailonly',
   );
 
+  my $cust_fields;
   my @cust_header;
-  if (    $conf->exists('cust-fields')
-       && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):/
-     )
-  {
-    warn "  found cust-fields configuration value"
-      if $DEBUG;
+  if ( @_ && $_[0] ) {
 
-    my $cust_fields = $1;
-     @cust_header = split(/ \| /, $cust_fields);
-     @cust_fields = map { $header2method{$_} } @cust_header;
-  } else { 
-    warn "  no cust-fields configuration value found; using default 'Customer'"
+    warn "  using supplied cust-fields override".
+          " (ignoring cust-fields config file)"
       if $DEBUG;
-    @cust_header = ( 'Customer' );
-    @cust_fields = ( 'name' );
+    $cust_fields = shift;
+
+  } else {
+
+    my $conf = new FS::Conf;
+    if (    $conf->exists('cust-fields')
+         && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):?/
+       )
+    {
+      warn "  found cust-fields configuration value"
+        if $DEBUG;
+      $cust_fields = $1;
+    } else { 
+      warn "  no cust-fields configuration value found; using default 'Customer'"
+        if $DEBUG;
+      $cust_fields = 'Customer';
+    }
+  
   }
 
+  @cust_header = split(/ \| /, $cust_fields);
+  @cust_fields = map { $header2method{$_} } @cust_header;
+
   #my $svc_x = shift;
   @cust_header;
 }
 
-=item cust_fields
+=item cust_sql_fields [ CUST_FIELDS_VALUE ]
+
+Returns a list of fields for the SELECT portion of an SQL query.
+
+As with L<the cust_header subroutine|/cust_header>, the fields returned are
+defined by the supplied customer fields setting, or if no customer fields
+setting is supplied, the <B>cust-fields</B> configuration value. 
+
+=cut
+
+sub cust_sql_fields {
+
+  my @fields = qw( last first company );
+  push @fields, map "ship_$_", @fields;
+  push @fields, 'country';
+
+  cust_header(@_);
+  #inefficientish, but tiny lists and only run once per page
+  push @fields,
+    grep { my $field = $_; grep { $_ eq $field } @cust_fields }
+         qw( address1 address2 city state zip daytime night );
+
+  map "cust_main.$_", @fields;
+}
+
+=item cust_fields SVC_OBJECT [ CUST_FIELDS_VALUE ]
 
 Given a svc_ object that contains fields from cust_main (say, from a
 JOINed search.  See httemplate/search/svc_* for examples), returns an array
-of customer information according to the <B>cust-fields</B> configuration
-setting, or "(unlinked)" if this service is not linked to a customer.
+of customer information, or "(unlinked)" if this service is not linked to a
+customer.
+
+As with L<the cust_header subroutine|/cust_header>, the fields returned are
+defined by the supplied customer fields setting, or if no customer fields
+setting is supplied, the <B>cust-fields</B> configuration value. 
 
 =cut
 
@@ -107,7 +304,8 @@ sub cust_fields {
        "(cust_fields: @cust_fields)"
     if $DEBUG > 1;
 
-  cust_header() unless @cust_fields;
+  #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
+  #                                     #override incase we were passed as a sub
 
   my $seen_unlinked = 0;
   map { 
@@ -184,6 +382,10 @@ sub process {
 
     $self->job_status(@args);
 
+  } else {
+
+    die "unknown sub $sub";
+
   }
 
 }
@@ -228,11 +430,19 @@ sub start_job {
   my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) );
 
   if ( $error ) {
+
+    warn "job not inserted: $error\n"
+      if $DEBUG;
+
     $error;  #this doesn't seem to be handled well,
              # will trigger "illegal jobnum" below?
              # (should never be an error inserting the job, though, only thing
              #  would be Pg f%*kage)
   } else {
+
+    warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
+      if $DEBUG;
+
     $job->jobnum;
   }
   
@@ -253,7 +463,7 @@ sub job_status {
   my @return;
   if ( $job && $job->status ne 'failed' ) {
     @return = ( 'progress', $job->statustext );
-  } elsif ( !$job ) { #handle job gone case : job sucessful
+  } elsif ( !$job ) { #handle job gone case : job successful
                       # so close popup, redirect parent window...
     @return = ( 'complete' );
   } else {