+++ /dev/null
- 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
},
{
+ '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.',
$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);
}
}
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;
}
}
- #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;
'';
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";
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;
'';
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.
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 ) {
}
+=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
( $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;
}
1;
-
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;
@ISA = qw( FS::Record );
+$ignore_quantity = 0;
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
});
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
#'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',
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; '.
type =>'textarea',
default=>'',
},
+ 'usermod_pwonly' => { label=>'Disallow username changes',
+ type =>'checkbox',
+ },
'suspend' => { label=>'Suspension command',
default=>'',
},
type =>'textarea',
#default=>"$_password\n$_password\n",
},
+ 'usermod_pwonly' => { label=>'Disallow username changes',
+ type =>'checkbox',
+ },
'suspend' => { label=>'Suspension command',
default=>'',
},
'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' },
;
tie my %cp_options, 'Tie::IxHash',
- 'host' => { label=>'Hostname' },
'port' => { label=>'Port number' },
'username' => { label=>'Username' },
'password' => { label=>'Password' },
},
'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' => {
'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' => {
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,
);
}
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',
);
}
'job' => 'FS::part_export::cp::cp_command',
};
$queue->insert(
- $self->option('host'),
+ $self->machine,
$self->option('port'),
$self->option('username'),
$self->option('password'),
);
}
- 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,
${$_} = $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
${"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
${"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,
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);
sub rebless { shift; }
+sub export_username {
+ my($self, $svc_acct) = (shift, shift);
+ $svc_acct->username;
+}
+
sub _export_insert {
my($self, $svc_acct) = (shift, shift);
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);
}
'';
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;
} 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;
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;
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;
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;
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;
}
--- /dev/null
+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;
+}
+
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;
}
$username_uppercase
$welcome_template $welcome_from $welcome_subject $welcome_mimetype
$smtpmachine
- $radius_password
+ $radius_password $radius_ip
$dirhash
@saltset @pw_set );
use Carp;
}
$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' , '.' , '/' );
Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+Calls any export-specific suspend hooks.
+
=cut
sub suspend {
Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+Calls any export-specific unsuspend hooks.
+
=cut
sub unsuspend {
$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';
}
}
( $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;
}
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
$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;
=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
}
#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\-\.]+)$/ ) {
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
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
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
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
+++ /dev/null
-#!/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;
-
],
'primary_key' => 'invnum',
'unique' => [],
- 'index' => [ ['custnum'] ],
+ 'index' => [ ['custnum'], ['_date'] ],
},
'cust_bill_event' => {
'addr_block' => {
'columns' => [
- 'blocknum', 'int', '', '',
+ 'blocknum', 'serial', '', '',
'routernum', 'int', '', '',
'ip_gateway', 'varchar', '', 15,
'ip_netmask', 'int', '', '',
'part_sb_field' => {
'columns' => [
- 'sbfieldpart', 'int', '', '',
+ 'sbfieldpart', 'serial', '', '',
'svcpart', 'int', '', '',
'name', 'varchar', '', $char_d,
'length', 'int', '', '',
#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(
--- /dev/null
+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";
#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"
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.
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');
#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";
--- /dev/null
+#!/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";
+}
+
#!/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);
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;
});
my($error);
$error=$svc_acct->insert;
- die $error if $error;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$username: $error";
+ } else {
+ die "$username: $error";
+ }
+ }
}
+++ /dev/null
-#!/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";
-}
-
--- /dev/null
+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
+++ /dev/null
-#!/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) ).' ' );
-}
-
+++ /dev/null
-#!/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";
-}
-
#!/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
( $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;
$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
$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;
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'} );
}
}
-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 {
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>
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";
$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) {
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 .=
$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>!;
--- /dev/null
+<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>
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,
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";
}
}
-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 {
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);
<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>
</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} });
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>
</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};
+}
+
%>
}
</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>
<% } %>
</FORM><BR>
-<%= $total %> services
+<%= $total %> service definitions
<%= $cgi->param('showdisabled')
? do { $cgi->param('showdisabled', 0);
'( <a href="'. $cgi->self_url. '">hide disabled services</a> )'; }
</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
<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,
);
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>
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.
}
$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";
}
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>
<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>
<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>)
<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>
#'batch_card'=> 'yes',
#'batch_card'=> 'no',
#'report_badcard'=> 'yes',
- 'retry_card' => 'yes',
+ #'retry_card' => 'yes',
+ 'retry' => 'yes',
);
}
#&eidiot($error) if $error;
#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;
<%
-$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 ) {
%>
<!-- mason kludge -->
<%
- idiot("Check # not found.");
+ idiot("Payment not found.");
#exit;
} else {
my $total = scalar(@cust_pay);
%>
<!-- 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>
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
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})$/ ) {
} 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' ) {
<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;
--- /dev/null
+<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>
.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
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).
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>';
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 {
projects / freeside.git / commitdiff