diff options
49 files changed, 893 insertions, 1090 deletions
diff --git a/Artistic b/Artistic deleted file mode 100644 index 4ffc78e97..000000000 --- a/Artistic +++ /dev/null @@ -1,125 +0,0 @@ - The "Artistic License" - - Preamble - -The intent of this document is to state the conditions under which a -Package may be copied, such that the Copyright Holder maintains some -semblance of artistic control over the development of the Package, -while giving the users of the package the right to use and distribute -the Package in a more-or-less customary fashion, plus the right to make -reasonable modifications. - -It also grants you the rights to reuse parts of a Package in your own -programs without transferring this License to those programs, provided -that you meet some reasonable requirements. - -Definitions: - - "Package" refers to the collection of files distributed by the - Copyright Holder, and derivatives of that collection of files - created through textual modification. - - "Standard Version" refers to such a Package if it has not been - modified, or has been modified in accordance with the wishes - of the Copyright Holder as specified below. - - "Copyright Holder" is whoever is named in the copyright or - copyrights for the package. - - "You" is you, if you're thinking about copying or distributing - this Package. - - "Reasonable copying fee" is whatever you can justify on the - basis of media cost, duplication charges, time of people involved, - and so on. (You will not be required to justify it to the - Copyright Holder, but only to the computing community at large - as a market that must bear the fee.) - - "Freely Available" means that no fee is charged for the item - itself, though there may be fees involved in handling the item. - It also means that recipients of the item may redistribute it - under the same conditions they received it. - -1. You may make and give away verbatim copies of the source form of the -Standard Version of this Package without restriction, provided that you -duplicate all of the original copyright notices and associated disclaimers. - -2. You may apply bug fixes, portability fixes and other modifications -derived from the Public Domain or from the Copyright Holder. A Package -modified in such a way shall still be considered the Standard Version. - -3. You may otherwise modify your copy of this Package in any way, provided -that you insert a prominent notice in each changed file stating how and -when you changed that file, and provided that you do at least ONE of the -following: - - a) place your modifications in the Public Domain or otherwise make them - Freely Available, such as by posting said modifications to Usenet or - an equivalent medium, or placing the modifications on a major archive - site such as uunet.uu.net, or by allowing the Copyright Holder to include - your modifications in the Standard Version of the Package. - - b) use the modified Package only within your corporation or organization. - - c) rename any non-standard executables so the names do not conflict - with standard executables, which must also be provided, and provide - a separate manual page for each non-standard executable that clearly - documents how it differs from the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -4. You may distribute the programs of this Package in object code or -executable form, provided that you do at least ONE of the following: - - a) distribute a Standard Version of the executables and library files, - together with instructions (in the manual page or equivalent) on where - to get the Standard Version. - - b) accompany the distribution with the machine-readable source of - the Package with your modifications. - - c) give non-standard executables non-standard names, and clearly - document the differences in manual pages (or equivalent), together - with instructions on where to get the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -5. You may charge a reasonable copying fee for any distribution of this -Package. You may charge any fee you choose for support of this -Package. You may not charge a fee for this Package itself. However, -you may distribute this Package in aggregate with other (possibly -commercial) programs as part of a larger (possibly commercial) software -distribution provided that you do not advertise this Package as a -product of your own. - -6. The scripts and library files supplied as input to or produced as -output from the programs of this Package do not automatically fall -under the copyright of this Package, but belong to whomever generated -them, and may be sold commercially, and may be aggregated with this -Package. If such scripts or library files are aggregated with this -Package via the so-called "undump" or "unexec" methods of producing a -binary executable image, then distribution of such an image shall -neither be construed as a distribution of this Package nor shall it -fall under the restrictions of Paragraphs 3 and 4, provided that you do -not represent such an executable image as a Standard Version of this -Package. - -7. You may reuse parts of this Package in your own programs, provided that -you explicitly state where you got them from, in the source code (and, left -to your courtesy, in the documentation), duplicating all the associated -copyright notices and disclaimers. Besides your changes, if any, must be -clearly marked as such. Parts reused that way will no longer fall under this -license if, and only if, the name of your program(s) have no immediate -connection with the name of the Package itself or its associated programs. -You may then apply whatever restrictions you wish on the reused parts or -choose to place them in the Public Domain--this will apply only within the -context of your package. - -8. The name of the Copyright Holder may not be used to endorse or promote -products derived from this software without specific prior written permission. - -9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. - - The End diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 84b3c26ed..706ebe720 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1032,6 +1032,14 @@ httemplate/docs/config.html }, { + 'key' => 'radius-ip', + 'section' => '', + 'description' => 'RADIUS attribute for IP addresses.', + 'type' => 'select', + 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ], + }, + + { 'key' => 'svc_acct-alldomains', 'section' => '', 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.', diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 9a724feac..02fd4e390 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -426,11 +426,11 @@ sub AUTOLOAD { $field =~ s/.*://; if ( defined($value) ) { confess "errant AUTOLOAD $field for $self (arg $value)" - unless $self->can('setfield'); + unless ref($self) && $self->can('setfield'); $self->setfield($field,$value); } else { confess "errant AUTOLOAD $field for $self (no args)" - unless $self->can('getfield'); + unless ref($self) && $self->can('getfield'); $self->getfield($field); } } diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7e2ff388e..4302c504a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4,7 +4,12 @@ use strict; use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; -use Time::Local qw(timelocal_nocheck); +BEGIN { + eval "use Time::Local;"; + die "Time::Local version 1.05 required with Perl versions before 5.6" + if $] < 5.006 && !defined($Time::Local::VERSION); + eval "use Time::Local qw(timelocal timelocal_nocheck);"; +} use Date::Format; #use Date::Manip; use Business::CreditCard; @@ -301,23 +306,11 @@ sub insert { } } - #false laziness with sub replace - my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { - $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } + return "updating fuzzy search cache: $error"; } - #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -520,34 +513,47 @@ sub replace { if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card/check info has changed, want to retry realtime_card invoice events - #false laziness w/collect - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode =~ - /^\$cust_bill\->realtime_(card|ach|lec)\(\);$/ - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + # card/check/lec info has changed, want to retry realtime_ invoice events + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf + } + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; } - #false laziness with sub insert + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item queue_fuzzyfiles_update + +Used by insert & replace to update the fuzzy search cache + +=cut + +sub queue_fuzzyfiles_update { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + my $error = $queue->insert($self->getfield('last'), $self->company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -555,13 +561,12 @@ sub replace { if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('last'), $self->company); + $error = $queue->insert($self->getfield('ship_last'), $self->ship_company); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } - #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1271,7 +1276,10 @@ invoice_time - Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. -retry_card - Retry cards even when not scheduled by invoice events. +retry - Retry card/echeck/LEC transactions even when not scheduled by invoice +events. + +retry_card - Deprecated alias for 'retry' batch_card - This option is deprecated. See the invoice events web interface to control whether cards are batched or run against a realtime gateway. @@ -1305,26 +1313,16 @@ sub collect { return ''; } - if ( exists($options{'retry_card'}) && $options{'retry_card'} ) { - #false laziness w/replace - foreach my $cust_bill_event ( - grep { - #$_->part_bill_event->plan eq 'realtime-card' - $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' - && $_->status eq 'done' - && $_->statustext - } - map { $_->cust_bill_event } - grep { $_->cust_bill_event } - $self->open_cust_bill - ) { - my $error = $cust_bill_event->retry; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error scheduling invoice events for retry: $error"; - } + if ( exists($options{'retry_card'}) ) { + carp 'retry_card option passed to collect is deprecated; use retry'; + $options{'retry'} ||= $options{'retry_card'}; + } + if ( exists($options{'retry'}) && $options{'retry'} ) { + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - #eslaf } foreach my $cust_bill ( $self->cust_bill ) { @@ -1414,6 +1412,60 @@ sub collect { } +=item retry_realtime + +Schedules realtime credit card / electronic check / LEC billing events for +for retry. Useful if card information has changed or manual retry is desired. +The 'collect' method must be called to actually retry the transaction. + +Implementation details: For each of this customer's open invoices, changes +the status of the first "done" (with statustext error) realtime processing +event to "failed". + +=cut + +sub retry_realtime { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_bill ( + grep { $_->cust_bill_event } + $self->open_cust_bill + ) { + my @cust_bill_event = + sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds } + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode =~ + /\$cust_bill\->realtime_(card|ach|lec)$/ + && $_->status eq 'done' + && $_->statustext + } + $cust_bill->cust_bill_event; + next unless @cust_bill_event; + my $error = $cust_bill_event[0]->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice event for retry: $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] Runs a realtime credit card, ACH (electronic check) or phone bill transaction @@ -1504,6 +1556,10 @@ sub realtime_bop { ( $content{account_number}, $content{routing_code} ) = split('@', $self->payinfo); $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; } elsif ( $method eq 'LEC' ) { $content{phone} = $self->payinfo; } @@ -2501,4 +2557,3 @@ L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation. 1; - diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 8ac806519..c0cb6f4e9 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,7 +1,7 @@ package FS::cust_svc; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $ignore_quantity ); use Carp qw( cluck ); use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; @@ -17,6 +17,8 @@ use FS::part_export; @ISA = qw( FS::Record ); +$ignore_quantity = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -229,7 +231,7 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $quantity; + if scalar(@cust_svc) >= $quantity && (!$ignore_quantity || !$quantity); } ''; #no error diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9a1b9d864..ff519969d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -548,7 +548,7 @@ tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid -p $crypt_password $username' + default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, 'useradd_stdin' => { label=>'Insert command STDIN', @@ -564,7 +564,7 @@ tie my %shellcommands_options, 'Tie::IxHash', default=>'', }, 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', + default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. # 'find . -depth -print | cpio -pdm $new_dir; '. @@ -576,6 +576,9 @@ tie my %shellcommands_options, 'Tie::IxHash', type =>'textarea', default=>'', }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, 'suspend' => { label=>'Suspension command', default=>'', }, @@ -613,6 +616,9 @@ tie my %shellcommands_withdomain_options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, 'suspend' => { label=>'Suspension command', default=>'', }, @@ -685,6 +691,12 @@ tie my %sqlradius_options, 'Tie::IxHash', 'password' => { label=>'Database password' }, ; +tie my %sqlradius_withdomain_options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source ' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, +; + tie my %cyrus_options, 'Tie::IxHash', 'server' => { label=>'IMAP server' }, 'username' => { label=>'Admin username' }, @@ -692,7 +704,6 @@ tie my %cyrus_options, 'Tie::IxHash', ; tie my %cp_options, 'Tie::IxHash', - 'host' => { label=>'Hostname' }, 'port' => { label=>'Port number' }, 'username' => { label=>'Username' }, 'password' => { label=>'Password' }, @@ -876,9 +887,9 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', }, 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH.', + 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>', + 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="vpopmail" onClick=\'this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; this.form.useradd_stdin.value = ""; this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; this.form.userdel_stdin.value=""; this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; this.form.usermod_stdin.value = ""; this.form.usermod_pwonly.checked = true;\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>', }, 'ldap' => { @@ -891,7 +902,14 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.23/DBI.pm">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source. If using <a href="http://www.freeradius.org/">FreeRADIUS</a> 0.5 or above, make sure your <b>op</b> fields are set to allow NULL values.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. This export does not export RADIUS realms (see also sqlradius_withdomain). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.', + }, + + 'sqlradius_withdomain' => { + 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS) with realms', + 'options' => \%sqlradius_withdomain_options, + 'nodomain' => '', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. This export exports domains to RADIUS realms (see also sqlradius). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.', }, 'sqlmail' => { diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index d998c1d95..c4750dd5d 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -10,10 +10,10 @@ sub rebless { shift; } sub _export_insert { my( $self, $svc_acct ) = (shift, shift); $self->cp_queue( $svc_acct->svcnum, 'create_mailbox', - Mailbox => $svc_acct->username, - Password => $svc_acct->_password, - Workgroup => $self->option('workgroup'), - Domain => $svc_acct->domain, + 'Mailbox' => $svc_acct->username, + 'Password' => $svc_acct->_password, + 'Workgroup' => $self->option('workgroup'), + 'Domain' => $svc_acct->domain, ); } @@ -30,8 +30,30 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox', - Mailbox => $svc_acct->username, - Domain => $svc_acct->domain, + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + ); +} + +sub _export_suspend { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + 'OTHER' => 'T', + 'OTHER_SUSPEND' => 'T', + ); +} + +sub _export_unsuspend { + my( $self, $svc_acct ) = (shift, shift); + $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', + 'Mailbox' => $svc_acct->username, + 'Domain' => $svc_acct->domain, + 'PAYMENT' => 'F', + 'OTHER' => 'F', + 'OTHER_SUSPEND' => 'F', + 'OTHER_BOUNCE' => 'F', ); } @@ -42,7 +64,7 @@ sub cp_queue { 'job' => 'FS::part_export::cp::cp_command', }; $queue->insert( - $self->option('host'), + $self->machine, $self->option('port'), $self->option('username'), $self->option('password'), @@ -69,20 +91,22 @@ sub cp_command { #subroutine, not method ); } - my $other = 'F'; + #my $other = 'F'; if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { $new_password = $1; - $other = 'T'; + # $other = 'T'; } - cp_command($host, $port, $username, $password, 'set_mailbox_status', - Domain => $domain, - Mailbox => $new_username, - Other => $other, - Other_Bounce => $other, - ); + #cp_command($host, $port, $username, $password, $login_domain, + # 'set_mailbox_status', + # Domain => $domain, + # Mailbox => $new_username, + # Other => $other, + # Other_Bounce => $other, + #); if ( $old_password ne $new_password ) { - cp_command($host, $port, $username, $password, 'change_mailbox', + cp_command($host, $port, $username, $password, $login_domain, + 'change_mailbox', Domain => $domain, Mailbox => $new_username, Password => $new_password, diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm index 43d558a69..f6fcb6062 100644 --- a/FS/FS/part_export/forward_shellcommands.pm +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -29,13 +29,13 @@ sub _export_command { ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; } - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $svc_acct = $svc_forward->srcsvc_acct; $username = $svc_acct->username; $domain = $svc_acct->domain; - if ($self->dstsvc) { - $destination = $self->dstsvc_acct->email; + if ($svc_forward->dstsvc_acct) { + $destination = $svc_forward->dstsvc_acct->email; } else { - $destination = $self->dst; + $destination = $svc_forward->dst; } #done setting variables for the command @@ -59,22 +59,22 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } - my $old_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $old_svc_acct = $old->srcsvc_acct; $old_username = $old_svc_acct->username; $old_domain = $old_svc_acct->domain; - if ($self->dstsvc) { - $old_destination = $self->dstsvc_acct->email; + if ($old->dstsvc_acct) { + $old_destination = $old->dstsvc_acct->email; } else { - $old_destination = $self->dst; + $old_destination = $old->dst; } - my $new_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } ); + my $new_svc_acct = $new->srcsvc_acct; $new_username = $new_svc_acct->username; $new_domain = $new_svc_acct->domain; - if ($self->dstsvc) { - $new_destination = $self->dstsvc_acct->email; + if ($new->dstsvc) { + $new_destination = $new->dstsvc_acct->email; } else { - $new_destination = $self->dst; + $new_destination = $new->dst; } #done setting variables for the command diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index f592a838a..edc944009 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -75,12 +75,24 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } $new_finger = shell_quote $new_finger; - $quoted_new__password = shell_quote $new__password; + $quoted_new__password = shell_quote $new__password; #old, wrong? + $new_quoted_password = shell_quote $new__password; #new, better? $old_domain = $old->domain; $new_domain = $new->domain; $new_crypt_password = ''; #surpress "used only once" warnings $new_crypt_password = crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]); + if ( $self->option('usermod_pwonly') ) { + my $error = ''; + if ( $old_username ne $new_username ) { + $error ||= "can't change username"; + } + if ( $old_domain ne $new_domain ) { + $error ||= "can't change domain"; + } + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } $self->shellcommands_queue( $new->svcnum, user => $self->option('user')||'root', host => $self->machine, diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index 64f72df07..8ccad3c7e 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -1,9 +1,10 @@ package FS::part_export::sqlmail; use vars qw(@ISA); +use Digest::MD5 qw(md5_hex); use FS::Record qw(qsearchs); use FS::part_export; -use Digest::MD5 qw(md5_hex); +use FS::svc_domain; @ISA = qw(FS::part_export); diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 60450ee63..8a8f9beba 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -8,6 +8,11 @@ use FS::part_export; sub rebless { shift; } +sub export_username { + my($self, $svc_acct) = (shift, shift); + $svc_acct->username; +} + sub _export_insert { my($self, $svc_acct) = (shift, shift); @@ -16,14 +21,14 @@ sub _export_insert { my %attrib = $svc_acct->$method(); next unless keys %attrib; my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $svc_acct->username, %attrib ); + $table, $self->export_username($svc_acct), %attrib ); return $err_or_queue unless ref($err_or_queue); } my @groups = $svc_acct->radius_groups; if ( @groups ) { my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', - $svc_acct->username, @groups ); + $self->export_username($svc_acct), @groups ); return $err_or_queue unless ref($err_or_queue); } ''; @@ -44,9 +49,9 @@ sub _export_replace { my $dbh = dbh; my $jobnum = ''; - if ( $old->username ne $new->username ) { + if ( $self->export_username($old) ne $self->export_username($new) ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); + $self->export_username($new), $self->export_username($old) ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -63,7 +68,7 @@ sub _export_replace { } keys %new ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); + $table, $self->export_username($new), %new ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -80,7 +85,7 @@ sub _export_replace { my @del = grep { !exists $new{$_} } keys %old; if ( @del ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); + $table, $self->export_username($new), @del ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -109,7 +114,7 @@ sub _export_replace { if ( @delgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); + $self->export_username($new), @delgroups ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -125,7 +130,7 @@ sub _export_replace { if ( @newgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); + $self->export_username($new), @newgroups ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; @@ -147,7 +152,7 @@ sub _export_replace { sub _export_delete { my( $self, $svc_acct ) = (shift, shift); my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); + $self->export_username($svc_acct) ); ref($err_or_queue) ? '' : $err_or_queue; } diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm new file mode 100644 index 000000000..1c8f38c9d --- /dev/null +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -0,0 +1,12 @@ +package FS::part_export::sqlradius_withdomain; + +use vars qw(@ISA); +use FS::part_export::sqlradius; + +@ISA = qw(FS::part_export::sqlradius); + +sub export_username { + my($self, $svc_acct) = (shift, shift); + $svc_acct->email; +} + diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 60b0e01f9..6525864c4 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -267,11 +267,12 @@ SVCDB is specified and does not match the svcdb of the service definition, sub svcpart { my $self = shift; - my $svcdb = shift; - my @pkg_svc = $self->pkg_svc; - return '' if scalar(@pkg_svc) != 1 - || $pkg_svc[0]->quantity != 1 - || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb ); + my $svcdb = scalar(@_) ? shift : ''; + my @pkg_svc = grep { + $_->quantity == 1 + && ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) + } $self->pkg_svc; + return '' if scalar(@pkg_svc) != 1; $pkg_svc[0]->svcpart; } diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 497e59c94..5b8107fc8 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -9,7 +9,7 @@ use vars qw( @ISA $DEBUG $me $conf $username_uppercase $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine - $radius_password + $radius_password $radius_ip $dirhash @saltset @pw_set ); use Carp; @@ -68,6 +68,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { } $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; + $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -603,6 +604,8 @@ error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). +Calls any export-specific suspend hooks. + =cut sub suspend { @@ -627,6 +630,8 @@ an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). +Calls any export-specific unsuspend hooks. + =cut sub unsuspend { @@ -783,12 +788,14 @@ sub check { $recref->{quota} = $1; unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - unless ( $recref->{slipip} eq '0e0' ) { + if ( $recref->{slipip} eq '' ) { + $recref->{slipip} = ''; + } elsif ( $recref->{slipip} eq '0e0' ) { + $recref->{slipip} = '0e0'; + } else { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ or return "Illegal slipip: ". $self->slipip; $recref->{slipip} = $1; - } else { - $recref->{slipip} = '0e0'; } } @@ -860,7 +867,7 @@ sub radius_reply { ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); if ( $self->slipip && $self->slipip ne '0e0' ) { - $reply{'Framed-IP-Address'} = $self->slipip; + $reply{$radius_ip} = $self->slipip; } %reply; } diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index 3c9ea0130..196ab7ebb 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -142,8 +142,7 @@ sub popselector { function popstate_changed(what) { state = what.options[what.selectedIndex].text; - for (var i = what.form.popnum.length;i > 0;i--) - what.form.popnum.options[i] = null; + what.form.popnum.options.length = 0 what.form.popnum.options[0] = new Option("", "", false, true); END @@ -167,7 +166,13 @@ END $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>'; $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !; - foreach my $pop ( @svc_acct_pop ) { + my @initial_select; + if ( scalar(@svc_acct_pop) > 100 ) { + @initial_select = qsearchs( 'svc_acct_pop', { 'popnum' => $popnum } ); + } else { + @initial_select = @svc_acct_pop; + } + foreach my $pop ( @initial_select ) { $text .= qq!<OPTION VALUE="!. $pop->popnum. '"'. ( ( $popnum && $pop->popnum == $popnum ) ? ' SELECTED' : '' ). ">". $pop->text; @@ -182,7 +187,7 @@ END =head1 VERSION -$Id: svc_acct_pop.pm,v 1.7 2002-04-10 13:42:48 ivan Exp $ +$Id: svc_acct_pop.pm,v 1.9 2003-07-04 01:37:46 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 2e8866a56..32b94563d 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -324,7 +324,7 @@ sub check { } #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) { - if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) { + if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu)$/ ) { $recref->{domain} = "$1.$2"; # hmmmmmmmm. } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) { diff --git a/FS/MANIFEST b/FS/MANIFEST index 272b5b731..846f37310 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -3,31 +3,31 @@ MANIFEST MANIFEST.SKIP Makefile.PL README -bin/freeside-bill -bin/freeside-daily -bin/freeside-email -bin/freeside-queued bin/freeside-addoutsource bin/freeside-addoutsourceuser +bin/freeside-adduser +bin/freeside-apply-credits +bin/freeside-bill +bin/freeside-cc-receipts-report +bin/freeside-count-active-customers +bin/freeside-credit-report +bin/freeside-daily bin/freeside-deloutsource bin/freeside-deloutsourceuser -bin/freeside-apply-credits -bin/freeside-adduser bin/freeside-deluser -bin/freeside-setup -bin/freeside-setinvoice -bin/freeside-overdue +bin/freeside-email +bin/freeside-expiration-alerter +bin/freeside-queued bin/freeside-radgroup bin/freeside-receivables-report +bin/freeside-reexport bin/freeside-selfservice-server +bin/freeside-setinvoice +bin/freeside-setup bin/freeside-sqlradius-radacctd bin/freeside-sqlradius-reset bin/freeside-sqlradius-seconds bin/freeside-tax-report -bin/freeside-cc-receipts-report -bin/freeside-credit-report -bin/freeside-expiration-alerter -bin/freeside-reexport FS.pm FS/CGI.pm FS/InitHandler.pm @@ -130,6 +130,7 @@ t/Misc.t t/Record.t t/UID.t t/Msgcat.t +t/SearchCache.t t/cust_bill.t t/cust_bill_event.t t/cust_bill_pay.t @@ -146,6 +147,7 @@ t/cust_pay_batch.t t/cust_pkg.t t/cust_refund.t t/cust_svc.t +t/cust_tax_exempt.t t/domain_record.t t/nas.t t/part_bill_event.t @@ -190,6 +192,6 @@ t/svc_www.t t/type_pkgs.t t/queue.t t/queue_arg.t +t/queue_depend.t t/msgcat.t t/raddb.t -t/cust_tax_exempt.t diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue deleted file mode 100755 index 116245f9c..000000000 --- a/FS/bin/freeside-overdue +++ /dev/null @@ -1,196 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $days_to_pay $cust_main $cust_pkg - $cust_svc $svc_acct ); -use Getopt::Std; -use FS::cust_main; -use FS::cust_pkg; -use FS::cust_svc; -use FS::svc_acct; -use FS::Record qw(qsearch qsearchs); -use FS::UID qw(adminsuidsetup); - -&untaint_argv; -my %opt; -getopts('ed:qpl:scbyoi', \%opt); -my $user = shift or die &usage; - -adminsuidsetup $user; - -my $now = time; #eventually take a time option like freeside-bill -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($now) )[0,1,2,3,4,5]; -$mon++; -$year += 1900; - -foreach $cust_main ( qsearch('cust_main',{} ) ) { - - my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 ); - if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/ - && $cust_main->payby eq 'BILL') { - ( $eyear, $emon, $eday ) = ( $1, $2, $3 ); - } - - if ( ( $opt{d} - && $cust_main->balance_date(time - $opt{d} * 86400) > 0 - && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum, - 'susp' => "" } ) ) - || ( $opt{e} - && $cust_main->payby eq 'BILL' - && ( $eyear < $year - || ( $eyear == $year && $emon < $mon ) ) ) - ) { - - unless ( $opt{q} ) { - print $cust_main->custnum, "\t", - $cust_main->last, "\t", $cust_main->first, "\t", - $cust_main->balance_date(time-$opt{d} * 86400); - } - - if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { - print "\n\tAdding postal invoicing" unless $opt{q}; - my @invoicing_list = $cust_main->invoicing_list; - push @invoicing_list, 'POST'; - $cust_main->invoicing_list(\@invoicing_list); - } - - if ( $opt{l} ) { - print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; - my $error = $cust_main->charge($opt{l}, 'Late fee'); - # comment or plandata with info so we don't redo the same late fee every - # day - } - - foreach $cust_pkg ( qsearch( 'cust_pkg', - { 'custnum' => $cust_main->custnum } ) ) { - - if ($opt{s}) { - print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->suspend; - } - - if ($opt{c}) { - print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; - $cust_pkg->cancel; - } - - } - - if ( $opt{b} ) { - print "\n\tBilling" unless $opt{q}; - my $error = $cust_main->bill('time'=>$now); - warn "Error billing, customer #" . $cust_main->custnum . - ":" . $error if $error; - } - - if ( $opt{y} ) { - print "\n\tApplying outstanding payments and credits" unless $opt{q}; - $cust_main->apply_payments; - $cust_main->apply_credits; - } - - if ( $opt{o} ) { - print "\n\tCollecting" unless $opt{q}; - my $error = $cust_main->collect( - 'invoice_time' => $now, - 'batch_card' => $opt{i} ? 'no' : 'yes', - 'force_print' => 'yes', - ); - warn "Error collecting from customer #" . $cust_main->custnum. ":$error" - if $error; - } - - print "\n" unless $opt{q}; - - } - -} - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { - $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n"; -} - - -=head1 NAME - -freeside-overdue - Perform actions on overdue and/or expired accounts. - -=head1 SYNOPSIS - - freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user - -=head1 DESCRIPTION - -This script is deprecated in 1.4.0. You should use freeside-daily and invoice -events instead. - -Performs actions on overdue and/or expired accounts. - -Selection options (at least one selection option is required): - - -d: Customers with a balance due on invoices older than the supplied number - of days. Requires an integer argument. - - -e: Customers with a billing expiration date in the past. - -Action options: - - -q: Be quiet (by default, selected accounts are printed). - - -p: Add postal invoicing to the relevant customers. - - -l: Add a charge of the given amount to the relevant customers. - - -s: Suspend accounts. - - -c: Cancel accounts. - - -b: Bill customers (create invoices) - - -y: Apply unapplied payments and credits - - -o: Collect from customers (charge cards, print invoices) - - -i: real-time billing (as opposed to batch billing). only relevant - for credit cards. - - user: From the mapsecrets file - see config.html from the base documentation - -=head1 CRONTAB - -Example crontab entries: - -# suspend expired accounts -20 4 * * * freeside-overdue -e -s user - -# quietly add postal invoicing to customers over 30 days past due -20 4 * * * freeside-overdue -d 30 -p -q user - -# suspend accounts and charge a $10.23 fee for customers over 60 days past due -20 4 * * * freeside-overdue -d 60 -s -l 10.23 user - -# cancel accounts over 90 days past due -20 4 * * * freeside-overdue -d 90 -c user - -=head1 ORIGINAL AUTHORS - -Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? - -Ivan seems to be turning it into the "do-everything" CLI. - -=head1 BUGS - -Hell now that this is the do-everything CLI it should have --longoptions - -=cut - -1; - diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 518a2ad42..734744efe 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -373,7 +373,7 @@ sub tables_hash_hack { ], 'primary_key' => 'invnum', 'unique' => [], - 'index' => [ ['custnum'] ], + 'index' => [ ['custnum'], ['_date'] ], }, 'cust_bill_event' => { @@ -1074,7 +1074,7 @@ sub tables_hash_hack { 'addr_block' => { 'columns' => [ - 'blocknum', 'int', '', '', + 'blocknum', 'serial', '', '', 'routernum', 'int', '', '', 'ip_gateway', 'varchar', '', 15, 'ip_netmask', 'int', '', '', @@ -1086,7 +1086,7 @@ sub tables_hash_hack { 'part_sb_field' => { 'columns' => [ - 'sbfieldpart', 'int', '', '', + 'sbfieldpart', 'serial', '', '', 'svcpart', 'int', '', '', 'name', 'varchar', '', $char_d, 'length', 'int', '', '', diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 9d3a6a700..74f90a582 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -12,7 +12,9 @@ adminsuidsetup $user; #my $machine = shift or die &usage; -my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } ); +my @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); +push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); + foreach my $export ( @exports ) { my $icradius_dbh = DBI->connect( diff --git a/FS/t/part_export-sqlradius_withdomain.t b/FS/t/part_export-sqlradius_withdomain.t new file mode 100644 index 000000000..504bf679f --- /dev/null +++ b/FS/t/part_export-sqlradius_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlradius_withdomain; +$loaded=1; +print "ok 1\n"; @@ -58,8 +58,8 @@ SELFSERVICE_MACHINE = localhost #not changable yet FREESIDE_CONF = /usr/local/etc/freeside -VERSION=1.5.0pre1 -TAG=freeside_1_5_0pre1 +VERSION=1.5.0pre3 +TAG=freeside_1_5_0pre3 help: @echo "supported targets: aspdocs masondocs alldocs docs install-docs" @@ -1,32 +1,26 @@ Freeside -Copyright (C) 2000,2001,2002 Ivan Kohler +Copyright (C) 2000,2001,2002,2003 Ivan Kohler Copyright (C) 1999 Silicon Interactive Software Design All rights reserved This program is free software; you can redistribute it and/or modify - it under the terms of either: + it under the terms of: a) the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any - later version, or - - b) the "Artistic License" + later version This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the - GNU General Public License or the Artistic License for more details. + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program, in the file `GPL'; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - You should have received a copy of the Artistic License along with - this program, in the file `Artistic'; if not, download it from - http://www.perl.com/CPAN/doc/misc/license/Artistic - Freeside is a billing and administration package for Internet Service Providers. diff --git a/bin/apache.export b/bin/apache.export index 908313606..f0a6beefc 100755 --- a/bin/apache.export +++ b/bin/apache.export @@ -39,7 +39,7 @@ foreach my $export ( @exports ) { use vars qw($zone $username); $zone = $svc_www->domain_record->zone; $username = $svc_www->svc_acct->username; - print HTTPD_CONF eval(qq("$template")); + print HTTPD_CONF eval(qq("$template")). "\n\n"; } my $user = $export->option('user'); diff --git a/bin/create-history-tables b/bin/create-history-tables index 33eb0e5a3..39248bf3f 100755 --- a/bin/create-history-tables +++ b/bin/create-history-tables @@ -18,8 +18,9 @@ my $schema = dbdef(); #false laziness w/fs-setup my @tables = scalar(@ARGV) ? @ARGV - : grep { ! /^h_/ } $schema->tables; + : grep { ! /^(h|pg)_/ } $schema->tables; foreach my $table ( @tables ) { + next if grep { /^h_$table/ } $schema->tables; warn "creating history table for $table\n"; my $tableobj = $schema->table($table) or die "unknown table $table (did you run dbdef-create?)\n"; diff --git a/bin/fix-sequences b/bin/fix-sequences new file mode 100755 index 000000000..2ff89d3e5 --- /dev/null +++ b/bin/fix-sequences @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw + +# run dbdef-create first! + +use strict; +use DBI; +use DBIx::DBSchema 0.21; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; +use FS::UID qw(adminsuidsetup driver_name); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $schema = dbdef(); + +#false laziness w/fs-setup +my @tables = scalar(@ARGV) + ? @ARGV + : grep { ! /^h_/ } $schema->tables; +foreach my $table ( @tables ) { + my $tableobj = $schema->table($table) + or die "unknown table $table (did you run dbdef-create?)\n"; + + my $primary_key = $tableobj->primary_key; + next unless $primary_key; + + my $col = $tableobj->column($primary_key); + + + next unless uc($col->type) eq 'SERIAL' + || ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\(/i + ) + || ( driver_name eq 'mysql' + && defined($col->local) + && $col->local =~ /AUTO_INCREMENT/i + ); + + my $seq = "${table}_${primary_key}_seq"; + if ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\('"(public\.)?(\w+_seq)"'::text\)$/ + ) { + $seq = $2; + } + + warn "fixing sequence for $table\n"; + + + my $sql = "SELECT setval( '$seq', + ( SELECT max($primary_key) FROM $table ) );"; + + #warn $col->default. " $seq\n$sql\n"; + $dbh->do( $sql ) or die $dbh->errstr; + +} + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +sub usage { + die "Usage:\n fix-sequences user [ table table ... ] \n"; +} + diff --git a/bin/passwd.import b/bin/passwd.import index fbf27370f..093f8bafd 100755 --- a/bin/passwd.import +++ b/bin/passwd.import @@ -1,5 +1,5 @@ #!/usr/bin/perl -Tw -# $Id: passwd.import,v 1.5 2002-06-21 09:57:05 ivan Exp $ +# $Id: passwd.import,v 1.8 2003-06-12 14:08:00 ivan Exp $ use strict; use vars qw(%part_svc); @@ -14,7 +14,7 @@ use FS::part_svc; my $user = shift or die &usage; adminsuidsetup $user; -push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others? +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? my($spooldir)="/usr/local/etc/freeside/export.". datasrc; @@ -104,7 +104,13 @@ while (<PASSWD>) { }); my($error); $error=$svc_acct->insert; - die $error if $error; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$username: $error"; + } else { + die "$username: $error"; + } + } } diff --git a/bin/svc_acct_sm.import b/bin/svc_acct_sm.import deleted file mode 100755 index b668405f5..000000000 --- a/bin/svc_acct_sm.import +++ /dev/null @@ -1,262 +0,0 @@ -#!/usr/bin/perl -Tw -# -# $Id: svc_acct_sm.import,v 1.10 2001-08-21 02:43:18 ivan Exp $ - -use strict; -use vars qw(%d_part_svc %m_part_svc); -use Term::Query qw(query); -use Net::SCP qw(iscp); -use FS::UID qw(adminsuidsetup datasrc); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_sm; -use FS::svc_domain; -use FS::svc_acct; -use FS::part_svc; - -my $user = shift or die &usage; -adminsuidsetup $user; - -my($spooldir)="/usr/local/etc/freeside/export.". datasrc; - -my(%mta) = ( - 1 => "qmail", - 2 => "sendmail", -); - -### - -%d_part_svc = - map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'}); -%m_part_svc = - map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'}); - -die "No services with svcdb svc_domain!\n" unless %d_part_svc; -die "No services with svcdb svc_svc_acct_sm!\n" unless %m_part_svc; - -print "\n\n", - ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ), - "\n\n"; -$^W=0; #Term::Query isn't -w-safe -my $domain_svcpart = - query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ]; -$^W=1; - -print "\n\n", - ( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ), - "\n\n"; -$^W=0; #Term::Query isn't -w-safe -my $mailalias_svcpart = - query "Enter part number for mail aliases: ", 'irk', [ keys %m_part_svc ]; -$^W=1; - -print "\n\n", <<END; -Select your MTA from the following list. -END -print join "\n", map "$_: $mta{$_}", sort keys %mta; -print "\n\n"; -$^W=0; #Term::Query isn't -w-safe -my $mta = query ":", 'irk', [ keys %mta ]; -$^W=1; - -if ( $mta{$mta} eq "qmail" ) { - - print "\n\n", <<END; -Enter the location and name of your qmail control directory, for example -"mail.isp.com:/var/qmail/control" -END - my($control)=&getvalue(":"); - iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import"); -# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import"); - iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import"); - -# print "\n\n", <<END; -#Enter the name of the machine with your user .qmail files, for example -#"mail.isp.com" -#END -# print ":"; -# my($shellmachine)=&getvalue; - -} elsif ( $mta{$mta} eq "sendmail" ) { - - print "\n\n", <<END; -Enter the location and name of your sendmail virtual user table, for example -"mail.isp.com:/etc/virtusertable" -END - my($virtusertable)=&getvalue(":"); - iscp("root\@$virtusertable","$spooldir/virtusertable.import"); - - print "\n\n", <<END; -Enter the location and name of your sendmail.cw file, for example -"mail.isp.com:/etc/sendmail.cw" -END - my($sendmail_cw)=&getvalue(":"); - iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import"); - -} else { - die "Unknown MTA!\n"; -} - -sub getvalue { - my $prompt = shift; - $^W=0; #Term::Query isn't -w-safe - my $data = query $prompt, ''; - $^W=1; - $data; -} - -print "\n\n"; - -### - -$FS::svc_domain::whois_hack=1; -$FS::svc_acct_sm::nossh_hack=1; - -if ( $mta{$mta} eq "qmail" ) { - open(RCPTHOSTS,"<$spooldir/rcpthosts.import") - or die "Can't open $spooldir/rcpthosts.import: $!"; -} elsif ( $mta{$mta} eq "sendmail" ) { - open(RCPTHOSTS,"<$spooldir/sendmail.cw.import") - or die "Can't open $spooldir/sendmail.cw.import: $!"; -} else { - die "Unknown MTA!\n"; -} - -my(%svcnum); - -while (<RCPTHOSTS>) { - next if /^(#|$)/; - next if $mta{$mta} eq 'sendmail' && /^\s*$/; #blank lines - /^\.?([\w\-\.]+)$/ - #or do { warn "Strange rcpthosts/sendmail.cw line: $_"; next; }; - or die "Strange rcpthosts/sendmail.cw line: $_"; - my $domain = $1; - my($svc_domain); - unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) { - $svc_domain = new FS::svc_domain ({ - 'domain' => $domain, - 'svcpart' => $domain_svcpart, - 'action' => 'N', - }); - my $error = $svc_domain->insert; - #warn $error if $error; - die $error if $error; - } - $svcnum{$domain}=$svc_domain->svcnum; -} -close RCPTHOSTS; - -#these two loops have enough similar parts they should probably be merged -if ( $mta{$mta} eq "qmail" ) { - - open(VD_FIX,">$spooldir/virtualdomains.FIX"); - print VD_FIX "#!/usr/bin/perl\n"; - - open(VIRTUALDOMAINS,"<$spooldir/virtualdomains.import") - or die "Can't open $spooldir/virtualdomains.import: $!"; - while (<VIRTUALDOMAINS>) { - next if /^#/; - /^\.?([\w\-\.]+):(\w+)(\-([\w\-\.]+))?$/ - #or do { warn "Strange virtualdomains line: $_"; next; }; - or die "Strange virtualdomains line: $_"; - my($domain,$username,$dash_ext,$extension)=($1,$2,$3,$4); - $dash_ext ||= ''; - $extension ||= ''; - my($svc_acct)=qsearchs('svc_acct',{'username'=>$username}); - unless ( $svc_acct ) { - #warn "Unknown user $username in virtualdomains; skipping\n"; - #die "Unknown user $username in virtualdomains; skipping\n"; - next; - } - if ( $domain ne $extension ) { - #warn "virtualdomains line $domain:$username$dash_ext changed to $domain:$username-$domain\n"; - my($dir)=$svc_acct->dir; - my($qdomain)=$domain; - $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - #example to move .qmail files for virtual domains to their new location - #dry run - #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; print " $old -> $a\n"; }\''); - #the real thing - #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; rename $old, $a; }\''); - print VD_FIX <<END; -foreach \$file (<$dir/.qmail$dash_ext-*>) { - \$old = \$file; - \$file =~ s/\.qmail$dash_ext\-/\.qmail\-$qdomain\-/; - rename \$old, \$file; -} -END - } - - unless ( exists $svcnum{$domain} ) { - my($svc_domain) = new FS::svc_domain ({ - 'domain' => $domain, - 'svcpart' => $domain_svcpart, - 'action' => 'N', - }); - my $error = $svc_domain->insert; - #warn $error if $error; - die $error if $error; - $svcnum{$domain}=$svc_domain->svcnum; - } - - my($svc_acct_sm)=new FS::svc_acct_sm ({ - 'domsvc' => $svcnum{$domain}, - 'domuid' => $svc_acct->uid, - 'domuser' => '*', - 'svcpart' => $mailalias_svcpart, - }); - my($error)=''; - $error=$svc_acct_sm->insert; - #warn $error if $error; - die $error, ", domain $domain" if $error; - } - close VIRTUALDOMAINS; - close VD_FIX; - -} elsif ( $mta{$mta} eq "sendmail" ) { - - open(VIRTUSERTABLE,"<$spooldir/virtusertable.import") - or die "Can't open $spooldir/virtusertable.import: $!"; - while (<VIRTUSERTABLE>) { - next if /^#/; #comments? - next if /^\s*$/; #blank lines - /^([\w\-\.]+)?\@([\w\-\.]+)\t+([\w\-\.]+)$/ - #or do { warn "Strange virtusertable line: $_"; next; }; - or die "Strange virtusertable line: $_"; - my($domuser,$domain,$username)=($1,$2,$3); - my($svc_acct)=qsearchs('svc_acct',{'username'=>$username}); - unless ( $svc_acct ) { - #warn "Unknown user $username in virtusertable"; - die "Unknown user $username in virtusertable"; - next; - } - my($svc_acct_sm)=new FS::svc_acct_sm ({ - 'domsvc' => $svcnum{$domain}, - 'domuid' => $svc_acct->uid, - 'domuser' => $domuser || '*', - 'svcpart' => $mailalias_svcpart, - }); - my($error)=''; - $error=$svc_acct_sm->insert; - #warn $error if $error; - die $error if $error; - } - close VIRTUSERTABLE; - -} else { - die "Unknown MTA!\n"; -} - -#open(RECIPIENTMAP,"<$spooldir/recipientmap.import"); -#close RECIPIENTMAP; - -print "\n\n", <<END if $mta{$mta} eq "qmail"; -Don\'t forget to run $spooldir/virtualdomains.FIX before using -$spooldir/virtualdomains ! -END - -# - -sub usage { - die "Usage:\n\n svc_acct_sm.import user\n"; -} - diff --git a/etc/abbr_state.txt b/etc/abbr_state.txt new file mode 100644 index 000000000..7e4f57f78 --- /dev/null +++ b/etc/abbr_state.txt @@ -0,0 +1,72 @@ +State/Possession Abbreviation + +ALABAMA AL +ALASKA AK +AMERICAN SAMOA AS +ARIZONA AZ +ARKANSAS AR +CALIFORNIA CA +COLORADO CO +CONNECTICUT CT +DELAWARE DE +DISTRICT OF COLUMBIA DC +FEDERATED STATES OF MICRONESIA FM +FLORIDA FL +GEORGIA GA +GUAM GU +HAWAII HI +IDAHO ID +ILLINOIS IL +INDIANA IN +IOWA IA +KANSAS KS +KENTUCKY KY +LOUISIANA LA +MAINE ME +MARSHALL ISLANDS MH +MARYLAND MD +MASSACHUSETTS MA +MICHIGAN MI +MINNESOTA MN +MISSISSIPPI MS +MISSOURI MO +MONTANA MT +NEBRASKA NE +NEVADA NV +NEW HAMPSHIRE NH +NEW JERSEY NJ +NEW MEXICO NM +NEW YORK NY +NORTH CAROLINA NC +NORTH DAKOTA ND +NORTHERN MARIANA ISLANDS MP +OHIO OH +OKLAHOMA OK +OREGON OR +PALAU PW +PENNSYLVANIA PA +PUERTO RICO PR +RHODE ISLAND RI +SOUTH CAROLINA SC +SOUTH DAKOTA SD +TENNESSEE TN +TEXAS TX +UTAH UT +VERMONT VT +VIRGIN ISLANDS VI +VIRGINIA VA +WASHINGTON WA +WEST VIRGINIA WV +WISCONSIN WI +WYOMING WY + + +Military "State" Abbreviation + +Armed Forces Africa AE +Armed Forces Americas AA +(except Canada) +Armed Forces Canada AE +Armed Forces Europe AE +Armed Forces Middle East AE +Armed Forces Pacific AP diff --git a/etc/acp_logfile-parse b/etc/acp_logfile-parse deleted file mode 100755 index 5e258991b..000000000 --- a/etc/acp_logfile-parse +++ /dev/null @@ -1,197 +0,0 @@ -#!/usr/bin/perl - -### -# WHO WROTE THIS??? -### - -#require "perldb.pl"; - -# Compute SLIP/PPP log times -# Arguments -a Process entire file with totals -# -t Process only totals -# -f File to be processed if not current -# -d processing start date (default is entire file) -# -l to return all totals for dayuse -# -w name of tmp work file for dayuse -# user names - -require "time.pl"; - -$space=' '; - -unless (@ARGV[0]) { - print "Missing Arguments\n"; - print "-a - entire file\n"; - print "-t - totals only\n"; - print "-f - file name to be processed\n"; - print "-d - processing start date (yymmdd)\n"; - print "-l - return totals for dayuse\n"; - print "-w - tmp work file for dayuse\n"; - exit; -} # end if test for missing arguments - -$infile = "/usr/annex/acp_logfile"; -$tmpfile = "/tmp/ppp"; -$n = $#ARGV; -$start_yymmdd = ""; -for ($i = 0; $i <= $n; $i++) { - if ($ARGV[$i] eq "-a") { - $allflag = "true"; - } - elsif ($ARGV[$i] eq "-t") { - $totalflag = "true"; - } - elsif ($ARGV[$i] eq "-f") { - $i++; - $infile = $ARGV[$i]; - } - elsif ($ARGV[$i] eq "-d") { - $i++; - $start_yymmdd = $ARGV[$i]; - } #end start yymmdd - elsif ($ARGV[$i] eq "-l") { - $logflag = "true"; - $totalflag = "true"; - } # end log - elsif ($ARGV[$i] eq "-w") { - $i++; - $tmpfile = $ARGV[$i]; - } # end tmp file - else { - ($arg_user,$arg_yymmdd) = split (/:/, $ARGV[$i]); - $ip_user_date {$arg_user} = $ARGV[$i]; - $userflag = "true"; - } # end else - } # end for 1 = 1 to n - -open (IN,$infile) - || die "Can't open acp_logfile"; - -NEXTUSER: while (<IN>) { - chop; - ($add,$ether,$port,$date,$time,$type,$action,$user) = split(/:/); - - if ($logflag) { - $start_yymmdd = ''; - if ($ip_user_date{$user}) { - ($ip_user, $start_yymmdd) = - split (/:/, $ip_user_date{$user}); - } # end get date - } # end log flag - if ($start_yymmdd) { - if ($date < $start_yymmdd) { - next NEXTUSER; - } #end date compare - } #end if date - if ($userflag){ - if (!$ip_user_date{$user}) { - next NEXTUSER; - } # end user test - } # end by user or all - if (($totalflag) || - ($allflag) || - ($ip_user_date{$user})) { - if (($type eq 'ppp') || ($type eq 'slip')) { - - if ($action eq 'login') { - $login{$user} = "$time:$date"; - - } - elsif ($action eq 'logout') { - if (!$login{$user}) { - $login{$user} = "010101:$date"; - } #end pad user if carry over - ($stime,$sdate) = split(':',$login{$user}); - $start = &annex2sec($stime); - $end = &annex2sec($time); - - #If we went through midnight, add a day; - if ($end < $start) {$end += 86400;} - $timeon = $end - $start; - - $elapsed{$user} += $timeon; - - if (!$totalflag) { - print (&fmt_user($user), - ' ', &fmt_date($sdate), ' In: ', - &fmt_time($stime),' Out: ', - &fmt_time($time), - ' Elapsed: ', &fmt_sec($timeon), "\n"); - } # end total test - } #end elsif action - } # type = ppp of slip - } # check arguments -} -close IN; - -if ($logflag) { - open (TMPPPP, ">$tmpfile") - || die "Can't open ppp tmp file"; - foreach $user ( sort((keys(%elapsed))) ) { - $log_time = &fmt_sec($elapsed{$user}); - $tmp = join (':', - $user, - $log_time); - print (TMPPPP "$tmp\n"); - } - close (TMPPPP); -} - else { - print "\n\nTotal Time On For Period:\n"; - print "-------------------------\n"; - - foreach $user ( sort((keys(%elapsed))) ) { - print (&fmt_user($user), " ",&fmt_sec($elapsed{$user}), "\n"); - } - } -exit(0); - -#------------------------------------------------------- -#--------------- Subroutines Start Here ---------------- -#------------------------------------------------------- - -sub annex2sec { - local($time) = @_; - return( &time2sec( &break_annex($time) ) ); -} - -sub fmt_date { - local($date) = @_; - - return( substr($date,2,2).'/'.substr($date,4,2).'/'.substr($date,0,2) ); -} - -sub fmt_time { - local($time) = @_; - local($s,$m,$h) = &break_annex($time); - return ("$h:$m:$s"); -} - - -sub break_annex { - local($time) = @_; - local($h,$m,$s); - - $h=substr($time,0,2); - $m=substr($time,2,2); - $s=substr($time,4,2); - - return ($s,$m,$h); -} - -sub fmt_sec { - local(@t) = &sec2time(@_); - @t[2] += (@t[3]*24); - - foreach $a (@t) { - if ($a < 10) {$a = "0$a";} - } - - return ("@t[2]:@t[1]:@t[0]"); -} - -sub fmt_user { - local($user) = @_; - return( $user.substr($space,0,8 - length($user) ).' ' ); -} - diff --git a/etc/example-direct-cardin b/etc/example-direct-cardin deleted file mode 100755 index 1a4097221..000000000 --- a/etc/example-direct-cardin +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/local/bin/perl - -### -# THIS IS FROM CYBERCASH (is there a newer version?) -### - -$paymentserverhost = 'localhost'; -$paymentserverport = 8000; -$paymentserversecret = 'two-turntables'; -use CCLib qw(sendmserver); - -# first lets fake up some data -# use time of day and pid to give me my pretend -# order number -# you obviously need to get real data from somewhere... - -$oid = "test$$"; #fake order number. -$amount = 'usd 42.42'; -$ramount = 'usd 24.24'; -$pan = '4111111111111111'; -$name = 'John Q. Doe'; -$addr = '17 Richard Rd.'; -$city = 'Ivyland'; -$state = 'PA'; -$zip = '18974'; -$country = 'USA'; -$exp = '7/97'; - - -%result = &sendmserver('mauthcapture', - 'Order-ID', $oid, - 'Amount', $amount, - 'Card-Number', $pan, - 'Card-Name', $name, - 'Card-Address', $addr, - 'Card-City', $city, - 'Card-State', $state, - 'Card-Zip', $zip, - 'Card-Country', $country, - 'Card-Exp', $exp); - -# -# just dump results to stdout. -# you should process them... -# to allow results to affect operation of your fulfillment... -# -foreach (keys(%result)) { - print " $_ ==> $result{$_}\n"; -} - -print "\n"; - -exit; - -$trans=$result{'MTransactionNumber'}; -$code=$result{'MRetrievalCode'}; - -%result = &sendmserver('return', - 'Order-ID', $oid, - 'Return-Amount',$ramount, - 'Amount',$amount, - ); - -foreach (keys(%result)) { - print " $_ ==> $result{$_}\n"; -} - diff --git a/fs_signup/FS-SignupClient/cgi/signup.cgi b/fs_signup/FS-SignupClient/cgi/signup.cgi index e384aaf8e..57b93d4f0 100755 --- a/fs_signup/FS-SignupClient/cgi/signup.cgi +++ b/fs_signup/FS-SignupClient/cgi/signup.cgi @@ -1,12 +1,14 @@ #!/usr/bin/perl -Tw # -# $Id: signup.cgi,v 1.36 2003-04-21 20:53:57 ivan Exp $ +# $Id: signup.cgi,v 1.43 2003-07-04 03:21:42 ivan Exp $ use strict; -use vars qw( @payby $cgi $locales $packages $pops $init_data $error +use vars qw( @payby $cgi $locales $packages + $pops %pop %popnum2pop + $init_data $error $last $first $ss $company $address1 $address2 $city $state $county $country $zip $daytime $night $fax $invoicing_list $payby $payinfo - $paydate $payname $referral_custnum + $paydate $payname $referral_custnum $init_popstate $pkgpart $username $password $password2 $sec_phrase $popnum $agentnum $ieak_file $ieak_template $cck_file $cck_template @@ -137,6 +139,12 @@ if ( -e $decline_html ) { ( $locales, $packages, $pops, $init_data ) = signup_info(); @payby = @{$init_data->{'payby'}} if @{$init_data->{'payby'}}; $packages = $init_data->{agentnum2part_pkg}{$agentnum} if $agentnum; +%pop = (); +%popnum2pop = (); +foreach (@$pops) { + push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_; + $popnum2pop{$_->{popnum}} = $_; +} $cgi = new CGI; @@ -205,6 +213,7 @@ if ( defined $cgi->param('magic') ) { $password = $cgi->param('_password'); $popnum = $cgi->param('popnum'); #$agentnum, # = $cgi->param('agentnum'), + $init_popstate = $cgi->param('init_popstate'); if ( $cgi->param('_password') ne $cgi->param('_password2') ) { $error = $init_data->{msgcat}{passwords_dont_match}; #msgcat @@ -295,12 +304,14 @@ if ( defined $cgi->param('magic') ) { $sec_phrase = ''; $popnum = ''; $referral_custnum = $cgi->param('ref') || ''; + $init_popstate = $cgi->param('init_popstate') || ''; print_form; } sub print_form { $cgi->delete('ref'); + $cgi->delete('init_popstate'); $self_url = $cgi->self_url; $error = "Error: $error" if $error; @@ -328,7 +339,7 @@ sub print_okay { or die "fatal: invalid email_name got past FS::SignupClient::new_customer"; $email_name = $1; #global for template - my $pop = pop_info($cgi->param('popnum')); + my $pop = $popnum2pop{$cgi->param('popnum')}; #or die "fatal: invalid popnum got past FS::SignupClient::new_customer"; if ( $pop ) { ( $ac, $exch, $loc ) = ( $pop->{'ac'}, $pop->{'exch'}, $pop->{'loc'} ); @@ -366,15 +377,6 @@ sub print_okay { } } -sub pop_info { - my $popnum = shift; - my $pop; - foreach $pop ( @{$pops} ) { - if ( $pop->{'popnum'} == $popnum ) { return $pop; } - } - ''; -} - #horrible false laziness with FS/FS/svc_acct_pop.pm::popselector sub popselector { @@ -382,14 +384,16 @@ sub popselector { return '<INPUT TYPE="hidden" NAME="popnum" VALUE="">' unless @$pops; return $pops->[0]{city}. ', '. $pops->[0]{state}. - ' ('. $pops->[0]{ac}. ')/'. $pops->[0]{exch}. + ' ('. $pops->[0]{ac}. ')/'. $pops->[0]{exch}. '-'. $pops->[0]{loc}. '<INPUT TYPE="hidden" NAME="popnum" VALUE="'. $pops->[0]{popnum}. '">' if scalar(@$pops) == 1; - my %pop = (); - foreach (@$pops) { - push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_; - } + #my %pop = (); + #my %popnum2pop = (); + #foreach (@$pops) { + # push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_; + # $popnum2pop{$_->{popnum}} = $_; + #} my $text = <<END; <SCRIPT> @@ -398,16 +402,23 @@ sub popselector { var length = what.length; what.options[length] = optionName; } +END - function acstate_changed(what) { - state = what.options[what.selectedIndex].text; - for (var i = what.form.popac.length;i > 0;i--) - what.form.popac.options[i] = null; - what.form.popac.options[0] = new Option("Area code", "-1", false, true); + if ( $init_popstate ) { + $text .= '<INPUT TYPE="hidden" NAME="init_popstate" VALUE="'. + $init_popstate. '">'; + } else { + $text .= <<END; + function acstate_changed(what) { + state = what.options[what.selectedIndex].text; + what.form.popac.options.length = 0 + what.form.popac.options[0] = new Option("Area code", "-1", false, true); END + } - foreach my $state ( sort { $a cmp $b } keys %pop ) { - $text .= "\nif ( state == \"$state\" ) {\n"; + my @states = $init_popstate ? ( $init_popstate ) : keys %pop; + foreach my $state ( sort { $a cmp $b } @states ) { + $text .= "\nif ( state == \"$state\" ) {\n" unless $init_popstate; foreach my $ac ( sort { $a cmp $b } keys %{ $pop{$state} }) { $text .= "opt(what.form.popac, \"$ac\", \"$ac\");\n"; @@ -415,27 +426,26 @@ END $text .= "what.form.popac.options[what.form.popac.length-1].selected = true;\n"; } } - $text .= "}\n"; + $text .= "}\n" unless $init_popstate; } $text .= "popac_changed(what.form.popac)}\n"; $text .= <<END; function popac_changed(what) { ac = what.options[what.selectedIndex].text; - for (var i = what.form.popnum.length;i > 0;i--) - what.form.popnum.options[i] = null; + what.form.popnum.options.length = 0; what.form.popnum.options[0] = new Option("City", "-1", false, true); END - foreach my $state ( keys %pop ) { + foreach my $state ( @states ) { foreach my $popac ( keys %{ $pop{$state} } ) { $text .= "\nif ( ac == \"$popac\" ) {\n"; foreach my $pop ( @{$pop{$state}->{$popac}}) { my $o_popnum = $pop->{popnum}; my $poptext = $pop->{city}. ', '. $pop->{state}. - ' ('. $pop->{ac}. ')/'. $pop->{exch}; + ' ('. $pop->{ac}. ')/'. $pop->{exch}. '-'. $pop->{loc}; $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n"; if ($popnum == $o_popnum) { @@ -453,7 +463,7 @@ END qq!<TABLE CELLPADDING="0"><TR><TD><SELECT NAME="acstate"! . qq!SIZE=1 onChange="acstate_changed(this)"><OPTION VALUE=-1>State!; $text .= "<OPTION" . ($_ eq $cgi->param('acstate') ? " SELECTED" : "") . - ">$_" foreach sort { $a cmp $b } keys %pop; + ">$_" foreach sort { $a cmp $b } @states; $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD>'; $text .= @@ -462,12 +472,19 @@ END $text .= qq!<TR><TD><SELECT NAME="popnum" SIZE=1 STYLE="width: 20em"><OPTION>City!; + #comment this block to disable initial list polulation - foreach my $pop ( sort { $a->{state} cmp $b->{state} } @$pops ) { + my @initial_select = (); + if ( scalar( @$pops ) > 100 ) { + push @initial_select, $popnum2pop{$popnum} if $popnum2pop{$popnum}; + } else { + @initial_select = @$pops; + } + foreach my $pop ( sort { $a->{state} cmp $b->{state} } @initial_select ) { $text .= qq!<OPTION VALUE="!. $pop->{popnum}. '"'. ( ( $popnum && $pop->{popnum} == $popnum ) ? ' SELECTED' : '' ). ">". $pop->{city}. ', '. $pop->{state}. - ' ('. $pop->{ac}. ')/'. $pop->{exch}; + ' ('. $pop->{ac}. ')/'. $pop->{exch}. '-'. $pop->{loc}; } $text .= qq!</SELECT></TD></TR></TABLE>!; diff --git a/fs_signup/FS-SignupClient/cgi/stateselect.html b/fs_signup/FS-SignupClient/cgi/stateselect.html new file mode 100644 index 000000000..39823be83 --- /dev/null +++ b/fs_signup/FS-SignupClient/cgi/stateselect.html @@ -0,0 +1,80 @@ +<HTML><HEAD><TITLE>ISP Signup</TITLE></HEAD> +<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup - state selection</FONT><BR><BR> +<SCRIPT> +function gotoURL(object) { + window.location.href = object.options[object.selectedIndex].value; +} +</SCRIPT> +<FORM> +Select your state: +<SELECT NAME="init_popstate" onChange="gotoURL(this.form.init_popstate)"> +<OPTION VALUE="stateselect.html"></OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AL">ALABAMA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AK">ALASKA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AS">AMERICAN SAMOA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AZ">ARIZONA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AR">ARKANSAS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=CA">CALIFORNIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=CO">COLORADO</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=CT">CONNECTICUT</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=DE">DELAWARE</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=DC">DISTRICT OF COLUMBIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=FM">FEDERATED STATES OF MICRONESIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=FL">FLORIDA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=GA">GEORGIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=GU">GUAM</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=HI">HAWAII</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=ID">IDAHO</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=IL">ILLINOIS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=IN">INDIANA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=IA">IOWA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=KS">KANSAS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=KY">KENTUCKY</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=LA">LOUISIANA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=ME">MAINE</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MH">MARSHALL ISLANDS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MD">MARYLAND</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MA">MASSACHUSETTS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MI">MICHIGAN</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MN">MINNESOTA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MS">MISSISSIPPI</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MO">MISSOURI</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MT">MONTANA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NE">NEBRASKA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NV">NEVADA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NH">NEW HAMPSHIRE</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NJ">NEW JERSEY</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NM">NEW MEXICO</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NY">NEW YORK</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=NC">NORTH CAROLINA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=ND">NORTH DAKOTA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=MP">NORTHERN MARIANA ISLANDS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=OH">OHIO</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=OK">OKLAHOMA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=OR">OREGON</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=PW">PALAU</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=PA">PENNSYLVANIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=PR">PUERTO RICO</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=RI">RHODE ISLAND</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=SC">SOUTH CAROLINA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=SD">SOUTH DAKOTA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=TN">TENNESSEE</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=TX">TEXAS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=UT">UTAH</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=VT">VERMONT</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=VI">VIRGIN ISLANDS</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=VA">VIRGINIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=WA">WASHINGTON</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=WV">WEST VIRGINIA</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=WI">WISCONSIN</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=WY">WYOMING</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Africa</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AA">Armed Forces Americas</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Canada</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Europe</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Middle East</OPTION> +<OPTION VALUE="signup.cgi?init_popstate=AP">Armed Forces Pacific</OPTION> +</SELECT> +</FORM> +</BODY> +</HTML> diff --git a/fs_signup/fs_signup_server b/fs_signup/fs_signup_server index 36af40a57..d6eb4a8d5 100755 --- a/fs_signup/fs_signup_server +++ b/fs_signup/fs_signup_server @@ -162,7 +162,7 @@ while (1) { my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } ) or $error ||= "WARNING: unknown pkgpart: $pkgpart"; - my $svcpart = $part_pkg->svcpart unless $error; + my $svcpart = $part_pkg->svcpart('svc_acct') unless $error; my $cust_pkg = new FS::cust_pkg ( { #later#'custnum' => $custnum, diff --git a/htetc/global.asa b/htetc/global.asa index 5fd89957f..d87f1eac6 100644 --- a/htetc/global.asa +++ b/htetc/global.asa @@ -110,8 +110,12 @@ sub Script_OnFlush { my $ref = $Response->{BinaryRef}; #$$ref = $cgi->header( @FS::CGI::header ) . $$ref; #$$ref = $cgi->header() . $$ref; - if ( dbh->can('sprintProfile') ) { - if ( lc($Response->{ContentType}) eq 'text/html' ) { + #warn "Script_OnFlush called with dbh ". dbh. "\n"; + #if ( dbh->can('sprintProfile') ) { + if ( UNIVERSAL::can(dbh,'sprintProfile') ) { + #warn "dbh can sprintProfile\n"; + if ( lc($Response->{ContentType}) eq 'text/html' ) { #con + #warn "contenttype is sprintProfile\n"; $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i or warn "can't remove"; @@ -126,7 +130,9 @@ sub Script_OnFlush { } } -if ( defined(@DBIx::Profile::ISA) && DBIx::Profile::db->can('sprintProfile') ) { +#if ( defined(@DBIx::Profile::ISA) && DBIx::Profile::db->can('sprintProfile') ) { +#if ( defined(@DBIx::Profile::ISA) && UNIVERSAL::can('DBIx::Profile::db', 'sprintProfile') ) { +if ( defined(@DBIx::Profile::ISA) ) { #warn "enabling profiling redirects"; *CGI::redirect = sub { diff --git a/httemplate/browse/part_pkg.cgi b/httemplate/browse/part_pkg.cgi index 58422c67d..7b9436cee 100755 --- a/httemplate/browse/part_pkg.cgi +++ b/httemplate/browse/part_pkg.cgi @@ -11,15 +11,35 @@ if ( $cgi->param('showdisabled') ) { my @part_pkg = qsearch('part_pkg', \%search ); my $total = scalar(@part_pkg); +my $sortby; +my %num_active_cust_pkg; +if ( $cgi->param('active') ) { + my $active_sth = dbh->prepare( + 'SELECT COUNT(*) FROM cust_pkg WHERE pkgpart = ?'. + ' AND ( cancel IS NULL OR cancel = 0 )'. + ' AND ( susp IS NULL OR susp = 0 )' + ) or die dbh->errstr; + foreach my $part_pkg ( @part_pkg ) { + $active_sth->execute($part_pkg->pkgpart) or die $active_sth->errstr; + $num_active_cust_pkg{$part_pkg->pkgpart} = + $active_sth->fetchrow_arrayref->[0]; + } + $sortby = \*active_cust_pkg_sort; +} else { + $sortby = \*pkgpart_sort; +} + %> <%= header("Package Definition Listing",menubar( 'Main Menu' => $p )) %> -One or more services are grouped together into a package and given pricing -information. Customers purchase packages rather than purchase services -directly.<BR><BR> -<A HREF="<%= $p %>edit/part_pkg.cgi"><I>Add a new package definition</I></A> -<BR><BR> +<% unless ( $cgi->param('active') ) { %> + One or more service definitions are grouped together into a package + definition and given pricing information. Customers purchase packages + rather than purchase services directly.<BR><BR> + <A HREF="<%= $p %>edit/part_pkg.cgi"><I>Add a new package definition</I></A> + <BR><BR> +<% } %> -<%= $total %> packages +<%= $total %> package definitions <% if ( $cgi->param('showdisabled') ) { $cgi->param('showdisabled', 0); @@ -34,6 +54,10 @@ print &table(), <<END; <TR> <TH COLSPAN=$colspan>Package</TH> <TH>Comment</TH> +END +print ' <TH><FONT SIZE=-1>Customer<BR>packages</FONT></TH>' + if $cgi->param('active'); +print <<END; <TH><FONT SIZE=-1>Freq.</FONT></TH> <TH><FONT SIZE=-1>Plan</FONT></TH> <TH><FONT SIZE=-1>Data</FONT></TH> @@ -42,9 +66,7 @@ print &table(), <<END; </TR> END -foreach my $part_pkg ( sort { - $a->getfield('pkgpart') <=> $b->getfield('pkgpart') -} @part_pkg ) { +foreach my $part_pkg ( sort $sortby @part_pkg ) { my($hashref)=$part_pkg->hashref; my(@pkg_svc)=grep $_->getfield('quantity'), qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} }); @@ -73,6 +95,16 @@ END print <<END; <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD> <TD ROWSPAN=$rowspan>$hashref->{comment}</TD> +END + if ( $cgi->param('active') ) { + print " <TD ROWSPAN=$rowspan>"; + print '<FONT COLOR="#00CC00"><B>'. + $num_active_cust_pkg{$hashref->{'pkgpart'}}. + qq!</B></FONT> <A HREF="${p}search/cust_pkg.cgi?magic=active;pkgpart=$hashref->{pkgpart}">active</A>!; + # suspended/cancelled + print '</TD>'; + } + print <<END; <TD ROWSPAN=$rowspan>$hashref->{freq}</TD> <TD ROWSPAN=$rowspan>$hashref->{plan}</TD> <TD ROWSPAN=$rowspan>$plandata</TD> @@ -99,4 +131,14 @@ print <<END; </BODY> </HTML> END + + +sub pkgpart_sort { + $a->pkgpart <=> $b->pkgpart; +} + +sub active_cust_pkg_sort { + $num_active_cust_pkg{$b->pkgpart} <=> $num_active_cust_pkg{$a->pkgpart}; +} + %> diff --git a/httemplate/browse/part_svc.cgi b/httemplate/browse/part_svc.cgi index ee7a2622a..7c83924a2 100755 --- a/httemplate/browse/part_svc.cgi +++ b/httemplate/browse/part_svc.cgi @@ -23,7 +23,7 @@ function part_export_areyousure(href) { } </SCRIPT> - Services are items you offer to your customers.<BR><BR> + Service definitions are the templates for items you offer to your customers.<BR><BR> <FORM METHOD="POST" ACTION="<%= $p %>edit/part_svc.cgi"> <A HREF="<%= $p %>edit/part_svc.cgi"><I>Add a new service definition</I></A><% if ( @part_svc ) { %> or <SELECT NAME="clone"><OPTION></OPTION> @@ -34,7 +34,7 @@ function part_export_areyousure(href) { <% } %> </FORM><BR> -<%= $total %> services +<%= $total %> service definitions <%= $cgi->param('showdisabled') ? do { $cgi->param('showdisabled', 0); '( <a href="'. $cgi->self_url. '">hide disabled services</a> )'; } diff --git a/httemplate/docs/install.html b/httemplate/docs/install.html index 533decb7b..54614ccb3 100644 --- a/httemplate/docs/install.html +++ b/httemplate/docs/install.html @@ -144,9 +144,14 @@ PerlSetVar Debug 2 </ul></td> <td><ul> <li>Run <tt>make masondocs</tt> - <li>Copy <tt>masondocs/</tt> to your web server's document space. - <li>Copy <tt>htetc/handler.pl</tt> to an appropriate directory (use htetc/handler.pl-1.0x for Mason versions before 1.10). - <li>Edit <tt>handler.pl</tt> and set an appropriate <tt>data_dir</tt>, such as <tt>/usr/local/etc/freeside/masondata</tt> + <li>Copy <tt>masondocs/</tt> to your web server's document space. (For example: <tt>/usr/local/apache/htdocs/freeside-mason</tt>) + <li>Copy <tt>htetc/handler.pl</tt> to <tt>/usr/local/etc/freeside</tt> (use htetc/handler.pl-1.0x for Mason versions before 1.10). + <li>Edit <tt>handler.pl</tt> and: + <ul> + <li> set an appropriate <tt>comp_root</tt>, such as <tt>/usr/local/apache/htdocs/freeside-mason</tt> + <li> set an appropriate <tt>data_dir</tt>, such as <tt>/usr/local/etc/freeside/masondata</tt> + </ul> + <li>Configure Apache to use the <tt>handler.pl</tt> file and to execute .cgi files using HTML::Mason. For example: <font size="-1"><pre> PerlModule HTML::Mason diff --git a/httemplate/docs/upgrade10.html b/httemplate/docs/upgrade10.html index 6c4fe0c37..1035510db 100644 --- a/httemplate/docs/upgrade10.html +++ b/httemplate/docs/upgrade10.html @@ -1,7 +1,9 @@ <pre> -this is very incomplete +this is incomplete -install NetAddr::IP and Chart +install DBIx::DBSchema 0.21 + +install NetAddr::IP and Chart::Base CREATE TABLE cust_bill_pkg_detail ( detailnum serial, @@ -12,6 +14,107 @@ CREATE TABLE cust_bill_pkg_detail ( ); CREATE INDEX cust_bill_pkg_detail1 ON cust_bill_pkg_detail ( pkgnum, invnum ); -create all of the new broadband tables +CREATE TABLE router ( + routernum serial, + routername varchar(80), + svcnum int, + PRIMARY KEY (routernum) +); + +CREATE TABLE part_svc_router ( + svcpart int NOT NULL, + routernum int NOT NULL +); + +CREATE TABLE part_router_field ( + routerfieldpart serial, + name varchar(80), + length int NOT NULL, + check_block text, + list_source text, + PRIMARY KEY (routerfieldpart) +); + +CREATE TABLE router_field ( + routerfieldpart int NOT NULL, + routernum int NOT NULL, + value varchar(128) +); +CREATE UNIQUE INDEX router_field1 ON router_field ( routerfieldpart, routernum ); + +CREATE TABLE addr_block ( + blocknum serial, + routernum int NOT NULL, + ip_gateway varchar(15) NOT NULL, + ip_netmask int NOT NULL, + PRIMARY KEY (blocknum) +); +CREATE UNIQUE INDEX addr_block1 ON addr_block ( blocknum, routernum ); + +CREATE TABLE part_sb_field ( + sbfieldpart serial, + svcpart int NOT NULL, + name varchar(80) NOT NULL, + length int NOT NULL, + check_block text NULL, + list_source text NULL, + PRIMARY key (sbfieldpart) +); +CREATE UNIQUE INDEX part_sb_field1 ON part_sb_field ( sbfieldpart, svcpart ); + +CREATE TABLE sb_field ( + sbfieldpart int NOT NULL, + svcnum int NOT NULL, + value varchar(128) +); +CREATE UNIQUE INDEX sb_field1 ON sb_field ( sbfieldpart, svcnum ); + +CREATE TABLE svc_broadband ( + svcnum int NOT NULL, + blocknum int NOT NULL, + speed_up int NOT NULL, + speed_down int NOT NULL, + ip_addr varchar(15), + PRIMARY KEY (svcnum) +); + +DELETE INDEX cust_bill_pkg1; + +ALTER TABLE cust_bill_pkg ADD itemdesc varchar(80) NULL; +ALTER TABLE h_cust_bill_pkg ADD itemdesc varchar(80) NULL; +ALTER TABLE cust_main_county ADD taxname varchar(80) NULL; +ALTER TABLE h_cust_main_county ADD taxname varchar(80) NULL; +ALTER TABLE cust_pkg ADD last_bill int NULL; +ALTER TABLE h_cust_pkg ADD last_bill int NULL; + +dump database, edit: +- cust_main: increase otaker from 8 to 32 +- cust_main: change ss from char(11) to varchar(11) +- cust_credit: increase otaker from 8 to 32 +- cust_pkg: increase otaker from 8 to 32 +- cust_refund: increase otaker from 8 to 32 +- domain_record: increase reczone from 80 to 255 +- domain_record: change rectype from char to varchar +- domain_record: increase recdata from 80 to 255 +then reload + +optionally: + + CREATE INDEX cust_main6 ON cust_main ( daytime ); + CREATE INDEX cust_main7 ON cust_main ( night ); + CREATE INDEX cust_main8 ON cust_main ( fax ); + CREATE INDEX cust_main9 ON cust_main ( ship_daytime ); + CREATE INDEX cust_main10 ON cust_main ( ship_night ); + CREATE INDEX cust_main11 ON cust_main ( ship_fax ); + + serial columns + +mandatory again: + +dbdef-create username +create-history-tables username cust_bill_pkg_detail router part_svc_router part_router_field router_field addr_block part_sb_field sb_field svc_broadband +dbdef-create username + + </pre> diff --git a/httemplate/docs/upgrade9.html b/httemplate/docs/upgrade9.html index c6afe2b0f..24d1cce42 100644 --- a/httemplate/docs/upgrade9.html +++ b/httemplate/docs/upgrade9.html @@ -15,10 +15,11 @@ INSERT INTO msgcat ( msgnum, msgcode, locale, msg ) VALUES ( 18, 'daytime', 'en_US', 'Day Phone' ); INSERT INTO msgcat ( msgnum, msgcode, locale, msg ) VALUES ( 19, 'night', 'en_US', 'Night Phone' ); </pre> - <li>Optionally, apply the following changes to your database (performance improvement for large numbers of services or packages): + <li>Optionally, apply the following changes to your database (performance improvements): <pre> CREATE INDEX part_pkg1 ON part_pkg ( disabled ); CREATE INDEX part_svc1 ON part_svc ( disabled ); +CREATE INDEX cust_bill2 ON cust_bill ( _date ); </pre> <li>If you want to use ACH (electronic checks), you will need to make changes to your database. The easiest way to make these changes is to dump your database (with pg_dump), change the payinfo field in the cust_pay, cust_refund, h_cust_pay and h_cust_refund tables from varchar(16) to varchar(80), reload the database from the dump, and run dbdef-create <li>Restart Apache and freeside-queued. diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index 4defbc86f..cc60f1aeb 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -67,12 +67,14 @@ my $widget = new HTML::Widgets::SelectLayers( } $html .= '</SELECT>'; } elsif ( $type eq 'textarea' ) { - $html .= qq!<TEXTAREA NAME="$option" COLS=80 WRAP="virtual">!. + $html .= qq!<TEXTAREA NAME="$option" COLS=80 ROWS=8 WRAP="virtual">!. qq!$value</TEXTAREA>!; } elsif ( $type eq 'text' ) { $html .= qq!<INPUT TYPE="text" NAME="$option" VALUE="$value" SIZE=64>!; } elsif ( $type eq 'checkbox' ) { - $html .= qq!<INPUT TYPE="checkbox" NAME="$option" VALUE="1">!; + $html .= qq!<INPUT TYPE="checkbox" NAME="$option" VALUE="1"!; + $html .= ' CHECKED' if $value; + $html .= '>'; } else { $html .= "unknown type $type"; } diff --git a/httemplate/edit/svc_domain.cgi b/httemplate/edit/svc_domain.cgi index d20e1f336..ca0e3398f 100755 --- a/httemplate/edit/svc_domain.cgi +++ b/httemplate/edit/svc_domain.cgi @@ -87,7 +87,7 @@ print ' CHECKED' if $kludge_action eq 'M'; print qq!>Transfer!; print <<END; -<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26> +<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=63> <BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64> <P><INPUT TYPE="submit" VALUE="Submit"> </FORM> diff --git a/httemplate/index.html b/httemplate/index.html index e5bd11806..017ffcd88 100644 --- a/httemplate/index.html +++ b/httemplate/index.html @@ -67,7 +67,8 @@ <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>) <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>) </UL> - Financial reports + <A HREF="search/report_cust_pay.html">Payment report (by type and/or date range)</A> + <BR><BR>Financial reports <UL> <LI> <A HREF="search/report_receivables.cgi">current receivables</A> <LI> <A HREF="search/report_tax.html">tax reports</A> @@ -124,7 +125,8 @@ <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A> <LI><A HREF="search/cust_pkg.html">packages (by next bill date range)</A> </UL> - Invoices + <A HREF="browse/part_pkg.cgi?active=1">Package definitions (by number of active packages)</A> + <BR><BR>Invoices <UL> <LI><a href="search/cust_bill_event.html">Invoice event errors (failed credit cards)</a> <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>) @@ -134,7 +136,8 @@ <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>) <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>) </UL> - Financial reports + <A HREF="search/report_cust_pay.html">Payment Report (by type and/or date range)</A> + <BR><BR>Financial reports <UL> <LI> <A HREF="search/report_receivables.cgi">current receivables</A> <LI> <A HREF="search/report_tax.html">tax reports</A> diff --git a/httemplate/misc/bill.cgi b/httemplate/misc/bill.cgi index f048e5559..44d85b880 100755 --- a/httemplate/misc/bill.cgi +++ b/httemplate/misc/bill.cgi @@ -21,7 +21,8 @@ unless ( $error ) { #'batch_card'=> 'yes', #'batch_card'=> 'no', #'report_badcard'=> 'yes', - 'retry_card' => 'yes', + #'retry_card' => 'yes', + 'retry' => 'yes', ); } #&eidiot($error) if $error; diff --git a/httemplate/search/cust_bill_event.cgi b/httemplate/search/cust_bill_event.cgi index 9cb36d28e..b76f66b76 100644 --- a/httemplate/search/cust_bill_event.cgi +++ b/httemplate/search/cust_bill_event.cgi @@ -4,7 +4,7 @@ #false laziness with view/cust_bill.cgi $cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/; -my $beginning = str2time($1); +my $beginning = str2time($1) || 0; $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/; my $ending = str2time($1) + 86400; diff --git a/httemplate/search/cust_pay.cgi b/httemplate/search/cust_pay.cgi index b5bdf8296..7a983703f 100755 --- a/httemplate/search/cust_pay.cgi +++ b/httemplate/search/cust_pay.cgi @@ -1,12 +1,47 @@ <% -$cgi->param('payinfo') =~ /^\s*(\d+)\s*$/ or die "illegal payinfo"; -my $payinfo = $1; -$cgi->param('payby') =~ /^(\w+)$/ or die "illegal payby"; -my $payby = $1; -my @cust_pay = qsearch('cust_pay', { 'payinfo' => $payinfo, +my $sortby; +my @cust_pay; +if ( $cgi->param('magic') && $cgi->param('magic') eq '_date' ) { + + my %search; + if ( $cgi->param('payby') ) { + $cgi->param('payby') =~ /^(CARD|CHEK|BILL)$/ + or die "illegal payby ". $cgi->param('payby'); + $search{'payby'} = $1; + } + + #false laziness with cust_pkg.cgi + my $range = ''; + if ( $cgi->param('beginning') + && $cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/ ) { + my $beginning = str2time($1); + $range = " WHERE _date >= $beginning "; + } + if ( $cgi->param('ending') + && $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/ ) { + my $ending = str2time($1) + 86400; + $range .= ( $range ? ' AND ' : ' WHERE ' ). " _date <= $ending "; + } + $range =~ s/^\s*WHERE/ AND/ if scalar(keys %search) ; + + @cust_pay = qsearch('cust_pay', \%search, '', $range ); + + $sortby = \*date_sort; + +} else { + + $cgi->param('payinfo') =~ /^\s*(\d+)\s*$/ or die "illegal payinfo"; + my $payinfo = $1; + + $cgi->param('payby') =~ /^(\w+)$/ or die "illegal payby"; + my $payby = $1; + + @cust_pay = qsearch('cust_pay', { 'payinfo' => $payinfo, 'payby' => $payby } ); -my $sortby = \*date_sort; + $sortby = \*date_sort; + +} if (0) { #if ( scalar(@cust_pay) == 1 ) { @@ -16,7 +51,7 @@ if (0) { %> <!-- mason kludge --> <% - idiot("Check # not found."); + idiot("Payment not found."); #exit; } else { my $total = scalar(@cust_pay); @@ -24,9 +59,9 @@ if (0) { %> <!-- mason kludge --> <% - print header("Check # Search Results", menubar( + print header("Payment Search Results", menubar( 'Main Menu', popurl(2) - )), "$total matching check$s found<BR>", &table(), <<END; + )), "$total matching payment$s found<BR>", &table(), <<END; <TR> <TH></TH> <TH>Amount</TH> @@ -40,23 +75,36 @@ END foreach my $cust_pay ( sort $sortby grep(!$saw{$_->paynum}++, @cust_pay) ) { - my($paynum, $custnum, $payinfo, $amount, $date ) = ( + my($paynum, $custnum, $payby, $payinfo, $amount, $date ) = ( $cust_pay->paynum, $cust_pay->custnum, + $cust_pay->payby, $cust_pay->payinfo, sprintf("%.2f", $cust_pay->paid), $cust_pay->_date, ); - my $pdate = time2str("%b %d %Y", $date); + my $pdate = time2str("%b %d %Y", $date); my $rowspan = 1; my $view = popurl(2). "view/cust_main.cgi?". $custnum. "#". $payby. $payinfo; + my $payment_info; + if ( $payby eq 'CARD' ) { + $payment_info = 'Card #'. 'x'x(length($payinfo)-4). + substr($payinfo,(length($payinfo)-4)); + } elsif ( $payby eq 'CHEK' ) { + $payment_info = "E-check acct#$payinfo"; + } elsif ( $payby eq 'BILL' ) { + $payment_info = "Check #$payinfo"; + } else { + $payment_info = "$payby $payinfo"; + } + print <<END; <TR> - <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$payinfo</FONT></A></TD> + <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$payment_info</FONT></A></TD> <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$amount</FONT></A></TD> <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$pdate</FONT></A></TD> END diff --git a/httemplate/search/cust_pkg.cgi b/httemplate/search/cust_pkg.cgi index 538edf3f1..8b2fd0ca0 100755 --- a/httemplate/search/cust_pkg.cgi +++ b/httemplate/search/cust_pkg.cgi @@ -19,6 +19,8 @@ my @cust_pkg; if ( $cgi->param('magic') && $cgi->param('magic') eq 'bill' ) { $sortby=\*bill_sort; + + #false laziness with cust_pay.cgi my $range = ''; if ( $cgi->param('beginning') && $cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/ ) { @@ -44,7 +46,19 @@ if ( $cgi->param('magic') && $cgi->param('magic') eq 'bill' ) { } else { my $qual = ''; - if ( $query eq 'pkgnum' ) { + if ( $cgi->param('magic') && $cgi->param('magic') eq 'active' ) { + + $qual = 'WHERE ( susp IS NULL OR susp = 0 )'. + ' AND ( cancel IS NULL OR cancel = 0)'; + + $sortby = \*pkgnum_sort; + + if ( $cgi->param('pkgpart') =~ /^(\d+)$/ ) { + $qual .= " AND pkgpart = $1"; + } + + } elsif ( $query eq 'pkgnum' ) { + $sortby=\*pkgnum_sort; } elsif ( $query eq 'SUSP_pkgnum' ) { @@ -196,7 +210,7 @@ if ( scalar(@cust_pkg) == 1 ) { <TH><FONT SIZE=-1>Setup</FONT></TH> END - print '<TH><FONT SIZE=-1>Next<BR>bill</FONT></TH>' + print '<TH><FONT SIZE=-1>Last<BR>bill</FONT></TH>' if defined dbdef->table('cust_pkg')->column('last_bill'); print <<END; diff --git a/httemplate/search/report_cust_pay.html b/httemplate/search/report_cust_pay.html new file mode 100644 index 000000000..93053e1ee --- /dev/null +++ b/httemplate/search/report_cust_pay.html @@ -0,0 +1,24 @@ +<HTML> + <HEAD> + <TITLE>Payment report criteria</TITLE> + </HEAD> + <BODY> + <CENTER> + <H1>Payment report criteria</H1> + </CENTER> + <HR> + <FORM ACTION="cust_pay.cgi" METHOD="post"> + <INPUT TYPE="hidden" NAME="magic" VALUE="_date"> + Return <SELECT NAME="payby"> + <OPTION VALUE="">all</OPTION> + <OPTION VALUE="CARD">credit card</OPTION> + <OPTION VALUE="CHEK">electronic check (ACH)</OPTION> + <OPTION VALUE="BILL">check/cash</OPTION> + </SELECT> payments for period<BR> + from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i> + to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i> + <P><INPUT TYPE="submit" VALUE="Get Report"> + </FORM> + <HR> + </BODY> +</HTML> diff --git a/httemplate/view/cust_main.cgi b/httemplate/view/cust_main.cgi index 3934a3dcb..c36c9e265 100755 --- a/httemplate/view/cust_main.cgi +++ b/httemplate/view/cust_main.cgi @@ -20,7 +20,7 @@ print <<END; .package TH { font-size: medium } .package TR { font-size: smaller } .package .pkgnum { font-size: medium } -.package .provision { font-size: larger; font-weight: bold } +.package .provision { font-weight: bold } </STYLE> END @@ -290,7 +290,7 @@ if ( $conf->config('payby-default') ne 'HIDE' ) { print '</TD></TR></TABLE>'; if ( defined $cust_main->dbdef_table->column('comments') - && $cust_main->comments ) + && $cust_main->comments =~ /[^\s\n\r]/ ) { print "<BR>Comments". &ntable("#cccccc"). "<TR><TD>". &ntable("#cccccc",2). @@ -430,7 +430,7 @@ foreach my $pkg (sort pkgsort_pkgnum_cancel @$packages) { if ( $pkg->{cancel} ) { #status: cancelled - print '<TR><TD><FONT COLOR="#ff0000"><B>Cancelled</B> </FONT></TD>'. + print '<TR><TD><FONT COLOR="#ff0000"><B>Cancelled </B></FONT></TD>'. '<TD>'. pkg_datestr($pkg,'cancel'). '</TD></TR>'; unless ( $pkg->{setup} ) { print '<TR><TD COLSPAN=2>Never billed</TD></TR>'; @@ -848,9 +848,12 @@ sub svc_label_link { sub svc_provision_link { my ($pkg, $svcpart) = (shift,shift) or return ''; - return qq!<A CLASS="provision" HREF="${p1}/edit/$svcpart->{svcdb}.cgi?! . + ( my $svc_nbsp = $svcpart->{svc} ) =~ s/\s+/ /g; + return qq!<A CLASS="provision" HREF="${p}edit/$svcpart->{svcdb}.cgi?! . qq!pkgnum$pkg->{pkgnum}-svcpart$svcpart->{svcpart}">! . - qq!Provision $svcpart->{svc} (! . ($svcpart->{quantity} - $svcpart->{count}) . qq!)</A>!; + "Provision $svc_nbsp (". + ($svcpart->{quantity} - $svcpart->{count}). + ')</A>'; } sub svc_unprovision_link { |