$value = $record->ut_alphan('column');
$value = $record->ut_phonen('column');
$value = $record->ut_anythingn('column');
+ $value = $record->ut_name('column');
$dbdef = reload_dbdef;
$dbdef = reload_dbdef "/non/standard/filename";
'';
}
+=item ut_name COLUMN
+
+Check/untaint proper names; allows alphanumerics, spaces and the following
+punctuation: , . - '
+
+May not be null.
+
+=cut
+
+sub ut_name {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal (name) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_zip COLUMN
+
+Check/untaint zip codes.
+
=cut
+sub ut_zip {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ or return "Illegal (zip) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
=item ut_anything COLUMN
Untaints arbitrary data. Be careful.
=head1 VERSION
-$Id: Record.pm,v 1.18 2001-07-30 07:33:08 ivan Exp $
+$Id: Record.pm,v 1.19 2001-07-30 10:41:44 ivan Exp $
=head1 BUGS
The Pg money kludge in the new method only strips `$'.
-The ut_phonen method assumes US-style phone numbers.
+The ut_phonen method only checks US-style phone numbers.
The _quote function should probably use ut_float instead of a regex.
or allow it to be set. Working around it is ugly any way around - DBI should
be fixed. (only affects RDBMS which return uppercase column names)
+ut_zip should take an optional country like ut_phone.
+
=head1 SEE ALSO
L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
=item fax - phone (optional)
+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
+
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+
=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
$self->ut_numbern('custnum')
|| $self->ut_number('agentnum')
|| $self->ut_number('refnum')
+ || $self->ut_name('last')
+ || $self->ut_name('first')
|| $self->ut_textn('company')
|| $self->ut_text('address1')
|| $self->ut_textn('address2')
return "Unknown referral"
unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
- or return "Illegal last name: ". $self->getfield('last');
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/
- or return "Illegal first name: ". $self->first;
- $self->first($1);
-
if ( $self->ss eq '' ) {
$self->ss('');
} else {
$self->ut_phonen('daytime', $self->country)
|| $self->ut_phonen('night', $self->country)
|| $self->ut_phonen('fax', $self->country)
+ || $self->ut_zip('zip', $self->country)
;
return $error if $error;
- $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return "Illegal zip: ". $self->zip;
- $self->zip($1);
+ if ( defined $self->dbdef_table->column('ship_last') ) {
+ if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
+ qw( last first company address1 address2 city county state zip
+ country daytime night fax )
+ ) # if any address fields differ
+ {
+ my $error =
+ $self->ut_name('ship_last')
+ || $self->ut_name('ship_first')
+ || $self->ut_textn('ship_company')
+ || $self->ut_text('ship_address1')
+ || $self->ut_textn('ship_address2')
+ || $self->ut_text('ship_city')
+ || $self->ut_textn('ship_county')
+ || $self->ut_textn('ship_state')
+ ;
+ return $error if $error;
+
+ #false laziness with above
+ $self->ship_country =~ /^(\w\w)$/
+ or return "Illegal ship_country: ". $self->ship_country;
+ $self->ship_country($1);
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->ship_country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown ship_state/ship_county/ship_country: ".
+ $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->ship_state,
+ 'county' => $self->ship_county,
+ 'country' => $self->ship_country,
+ } );
+ }
+ #eofalse
+
+ $error =
+ $self->ut_phonen('ship_daytime', $self->ship_country)
+ || $self->ut_phonen('ship_night', $self->ship_country)
+ || $self->ut_phonen('ship_fax', $self->ship_country)
+ || $self->ut_zip('ship_zip', $self->ship_country)
+ ;
+ return $error if $error;
+
+ } else { # ship_ info eq billing info, so don't store dup info in database
+ $self->setfield("ship_$_", '')
+ foreach qw( last first company address1 address2 city county state zip
+ country daytime night fax );
+ }
+ }
$self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
=head1 VERSION
-$Id: cust_main.pm,v 1.14 2001-06-03 10:51:54 ivan Exp $
+$Id: cust_main.pm,v 1.15 2001-07-30 10:41:44 ivan Exp $
=head1 BUGS
<%
-#
-# $Id: cust_main.cgi,v 1.1 2001-07-30 07:36:04 ivan Exp $
-#
-# Usage: post form to:
-# http://server.name/path/cust_main.cgi
-#
-# ivan@voicenet.com 96-dec-12
-#
-# rewrite ivan@sisd.com 98-mar-4
-#
-# now does browsing too ivan@sisd.com 98-mar-6
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# display total, use FS::CGI ivan@sisd.com 98-jul-17
-#
-# $Log: cust_main.cgi,v $
-# Revision 1.1 2001-07-30 07:36:04 ivan
-# templates!!!
-#
-# Revision 1.17 2001/04/23 16:07:54 ivan
-# fix
-# Insecure dependency in eval while running with -T switch at /usr/local/lib/site_perl/FS/Record.pm line 202.
-#
-# Revision 1.16 2001/02/07 19:45:45 ivan
-# tyop
-#
-# Revision 1.15 2000/07/17 16:45:41 ivan
-# first shot at invoice browsing and some other cleanups
-#
-# Revision 1.14 1999/08/12 04:45:21 ivan
-# typo - missed a paren
-#
-# Revision 1.13 1999/08/12 04:32:21 ivan
-# hidecancelledcustomers
-#
-# Revision 1.12 1999/07/17 10:38:52 ivan
-# scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
-# gave me a great bugreport at the last rhythmethod
-#
-# Revision 1.11 1999/04/09 04:22:34 ivan
-# also table()
-#
-# Revision 1.10 1999/04/09 03:52:55 ivan
-# explicit & for table/itable/ntable
-#
-# Revision 1.9 1999/02/28 00:03:55 ivan
-# removed misleading comments
-#
-# Revision 1.8 1999/02/07 09:59:36 ivan
-# more mod_perl fixes, and bugfixes Peter Wemm sent via email
-#
-# Revision 1.7 1999/01/25 12:19:11 ivan
-# yet more mod_perl stuff
-#
-# Revision 1.6 1999/01/19 05:14:12 ivan
-# for mod_perl: no more top-level my() variables; use vars instead
-# also the last s/create/new/;
-#
-# Revision 1.5 1999/01/18 09:41:37 ivan
-# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
-# (good idea anyway)
-#
-# Revision 1.4 1998/12/30 00:57:50 ivan
-# bug
-#
-# Revision 1.3 1998/12/17 09:41:08 ivan
-# s/CGI::(Base|Request)/CGI.pm/;
-#
-# Revision 1.2 1998/11/12 08:10:22 ivan
-# CGI.pm instead of CGI-modules
-# relative URLs using popurl
-# got rid of lots of little tables
-# s/agrep/String::Approx/;
-# bubble up packages and services and link (slow)
-#
+#<!-- $Id: cust_main.cgi,v 1.2 2001-07-30 10:41:44 ivan Exp $ -->
use strict;
#use vars qw( $conf %ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby );
use IO::Handle;
use String::Approx qw(amatch);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearch qsearchs dbdef);
use FS::CGI qw(header menubar eidiot popurl table);
use FS::cust_main;
use FS::cust_svc;
)), "$total matching customers found<BR>", &table(), <<END;
<TR>
<TH></TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
+ <TH>(bill) name</TH>
+ <TH>company</TH>
+END
+
+if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TH>(service) name</TH>
+ <TH>company</TH>
+END
+}
+
+print <<END;
<TH>Packages</TH>
<TH COLSPAN=2>Services</TH>
</TR>
<TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$last, $first</FONT></A></TD>
<TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD>
END
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ my($ship_last,$ship_first,$ship_company)=(
+ $cust_main->ship_last || $cust_main->getfield('last'),
+ $cust_main->ship_last ? $cust_main->ship_first : $cust_main->first,
+ $cust_main->ship_last ? $cust_main->ship_company : $cust_main->company,
+ );
+print <<END;
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$ship_last, $ship_first</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$ship_company</FONT></A></TD>
+END
+ }
my($n1)='';
foreach ( @{$all_pkgs{$custnum}} ) {
push @cust_main, qsearch('cust_main',{'last'=>$last});
+ push @cust_main, qsearch('cust_main',{'ship_last'=>$last})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
} else {
my(%last);
my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
+ push @all_last, grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+ if defined dbdef->table('cust_main')->column('ship_last');
if ($last_type{'Fuzzy'}) {
foreach ( amatch($last, [ qw(i) ], @all_last) ) {
$last{$_}++;
foreach ( keys %last ) {
push @cust_main, qsearch('cust_main',{'last'=>$_});
+ push @cust_main, qsearch('cust_main',{'ship_last'=>$_})
+ if defined dbdef->table('cust_main')->column('ship_last');
}
}
push @cust_main, qsearch('cust_main',{'company'=>$company});
+ push @cust_main, qsearch('cust_main',{'ship_company'=>$company})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
} else {
my(%company);
my(@all_company)=map $_->company, qsearch('cust_main',{});
+ push @all_company, grep $_, map $_->getfield('ship_company'), qsearch('cust_main',{})
+ if defined dbdef->table('cust_main')->column('ship_last');
if ($company_type{'Fuzzy'}) {
foreach ( amatch($company, [ qw(i) ], @all_company ) ) {
foreach ( keys %company ) {
push @cust_main, qsearch('cust_main',{'company'=>$_});
+ push @cust_main, qsearch('cust_main',{'ship_company'=>$_})
+ if defined dbdef->table('cust_main')->column('ship_last');
}
}
-<!-- $Id: cust_main.cgi,v 1.1 2001-07-30 07:36:04 ivan Exp $ -->
<%
+#<!-- $Id: cust_main.cgi,v 1.2 2001-07-30 10:41:44 ivan Exp $ -->
+use strict;
use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral
@packages $package @history @bills $bill @credits $credit
$balance $item @agents @referrals @invoicing_list $n1 $conf );
&ntable("#cccccc",2),
'<TR><TD ALIGN="right">Contact name</TD>',
'<TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}last"), ', ', $cust_main->get("${$pre}first"),
+ $cust_main->get("${pre}last"), ', ', $cust_main->get("${pre}first"),
'</TD></TR>',
'<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}company"),
+ $cust_main->get("${pre}company"),
'</TD></TR>',
'<TR><TD ALIGN="right">Address</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}address1"),
+ $cust_main->get("${pre}address1"),
'</TD></TR>',
;
print '<TR><TD ALIGN="right"> </TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}address2"), '</TD></TR>'
- if $cust_main->get("${$pre}address2");
+ $cust_main->get("${pre}address2"), '</TD></TR>'
+ if $cust_main->get("${pre}address2");
print '<TR><TD ALIGN="right">City</TD><TD BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}city"),
+ $cust_main->get("${pre}city"),
'</TD><TD ALIGN="right">State</TD><TD BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}state"),
+ $cust_main->get("${pre}state"),
'</TD><TD ALIGN="right">Zip</TD><TD BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}zip"), '</TD></TR>',
+ $cust_main->get("${pre}zip"), '</TD></TR>',
'<TR><TD ALIGN="right">Country</TD><TD BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}country"),
+ $cust_main->get("${pre}country"),
'</TD></TR>',
;
print '<TR><TD ALIGN="right">Day Phone</TD>',
'<TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}daytime") || ' ', '</TD></TR>',
+ $cust_main->get("${pre}daytime") || ' ', '</TD></TR>',
'<TR><TD ALIGN="right">Night Phone</TD>'.
'<TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}night") || ' ', '</TD></TR>',
+ $cust_main->get("${pre}night") || ' ', '</TD></TR>',
'<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
- $cust_main->get("${$pre}fax") || ' ', '</TD></TR>',
+ $cust_main->get("${pre}fax") || ' ', '</TD></TR>',
'</TABLE>', "</TD></TR></TABLE>"
;