'FREESIDE_1_4_BRANCH'.
autoconfiguration support for the signup server, lots of great mailing
lists posts which I shamelessly made into documentation, fixes to get rid of
the embarassing and non-database-normal "owed" field, and many other things
-I'm forgetting. Most recently Kristian and Mark (last name?) contributed
-the IP address tracking and svc_broadband in 1.5.
+I'm forgetting.
Jeff Finucane <jeff@cmh.net> send in a bunch of bugfixes (for the sendmail
export, cancel-unaudited.cgi), patches to support billing date modification,
"Stephen Bechard" <steve@destek.net> sent in patches for svc_www services and
other fixes.
-Charles A Beasley <cbeasley@noment.net> contributed quota editing for the
-Infostreet export.
-
-Richard Siddall <richard.siddall@elirion.net> sent in Mason fixes and other
-things I'm probably forgetting.
-
Everything else is my (Ivan Kohler <ivan@420.am>) fault.
L<FS::svc_forward> - Mail forwarding class
+L<FS::svc_acct_sm> - (Depreciated) Vitual mail alias class
+
L<FS::svc_www> - Web virtual host class.
L<FS::part_svc> - Service definition class
L<FS::cust_bill_pkg> - Invoice line item class
-L<FS::cust_bill_pkg_detail> - Invoice line item detail class
-
L<FS::part_bill_event> - Invoice event definition class
L<FS::cust_bill_event> - Completed invoice event class
references."
If you've never used OO modules before,
-http://www.perl.com/doc/FMTEYEWTK/easy_objects.html might help you out.
+http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out.
=head1 DESCRIPTION
package FS::ClientAPI;
use strict;
-use vars qw(%handler $domain);
+use vars qw(%handler);
%handler = ();
#find modules
foreach my $INC ( @INC ) {
- foreach my $file ( glob("$INC/FS/ClientAPI/*.pm") ) {
+ foreach my $file ( glob("$INC/FS/ClientAPI/*") ) {
$file =~ /\/(\w+)\.pm$/ or do {
warn "unrecognized ClientAPI file: $file";
next
use vars qw($cache);
use Digest::MD5 qw(md5_hex);
use Date::Format;
-use Business::CreditCard;
use Cache::SharedMemoryCache; #store in db?
use FS::CGI qw(small_custview); #doh
use FS::Conf;
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearchs);
use FS::svc_acct;
use FS::svc_domain;
use FS::cust_main;
use FS::cust_bill;
-use FS::cust_main_county;
use FS::ClientAPI; #hmm
FS::ClientAPI->register_handlers(
- 'MyAccount/login' => \&login,
- 'MyAccount/customer_info' => \&customer_info,
- 'MyAccount/invoice' => \&invoice,
- 'MyAccount/cancel' => \&cancel,
- 'MyAccount/payment_info' => \&payment_info,
- 'MyAccount/process_payment' => \&process_payment,
+ 'MyAccount/login' => \&login,
+ 'MyAccount/customer_info' => \&customer_info,
+ 'MyAccount/invoice' => \&invoice,
+ 'MyAccount/cancel' => \&cancel,
);
#store in db?
}
+
return { 'error' => '',
'custnum' => $custnum,
%return,
}
-sub payment_info {
- my $p = shift;
- my $session = $cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my %return;
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- $return{balance} = $cust_main->balance;
-
- $return{payname} = $cust_main->payname
- || ( $cust_main->first. ' '. $cust_main->get('last') );
-
- $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip);
-
- $return{payby} = $cust_main->payby;
-
- if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) {
- warn $return{card_type} = cardtype($cust_main->payinfo);
- $return{payinfo} = $cust_main->payinfo;
-
- if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
- @return{'month', 'year'} = ( $2, $1 );
- } elsif ( $cust_main->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- @return{'month', 'year'} = ( $1, $3 );
- }
-
- }
-
- #list all counties/states/countries
- $return{'cust_main_county'} =
- [ map { $_->hashref } qsearch('cust_main_county', {}) ],
-
- #shortcut for one-country folks
- my $conf = new FS::Conf;
- my %states = map { $_->state => 1 }
- qsearch('cust_main_county', {
- 'country' => $conf->config('defaultcountry') || 'US'
- } );
- $return{'states'} = [ sort { $a cmp $b } keys %states ];
-
- $return{card_types} = {
- 'VISA' => 'VISA card',
- 'MasterCard' => 'MasterCard',
- 'Discover' => 'Discover card',
- 'American Express' => 'American Express card',
- };
-
- my $_date = time;
- $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
-
- return { 'error' => '',
- %return,
- };
-
-};
-
-sub process_payment {
- my $p = shift;
-
- my $session = $cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my %return;
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- if ( $p->{'save'} ) {
- my $new = new FS::cust_main { $cust_main->hash };
- $new->set( $_ => $p->{$_} )
- foreach qw( payname address1 address2 city state zip payinfo );
- $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' );
- $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' );
- my $error = $new->replace($cust_main);
- return { 'error' => $error } if $error;
- $cust_main = $new;
- }
-
- my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, quiet=>1,
- 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01',
- map { $_ => $p->{$_} }
- qw( payname address1 address2 city state zip payinfo )
- );
- return { 'error' => $error } if $error;
-
- $cust_main->apply_payments;
-
- return { 'error' => '' };
-
-}
-
sub invoice {
my $p = shift;
my $session = $cache->get($p->{'session_id'})
sub passwd {
my $packet = shift;
- my $domain = $FS::ClientAPI::domain || $packet->{'domain'};
- my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
- or return { error => "Domain $domain not found" };
+ #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } )
+ # or return { error => "Domain $domain not found" };
my $old_password = $packet->{'old_password'};
my $new_password = $packet->{'new_password'};
my $svc_acct =
( length($old_password) < 13
&& qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- 'domsvc' => $svc_domain->svcnum,
+ #'domsvc' => $svc_domain->svcnum,
'_password' => $old_password } )
)
|| qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- 'domsvc' => $svc_domain->svcnum,
+ #'domsvc' => $svc_domain->svcnum,
'_password' => $old_password } );
unless ( $svc_acct ) { return { error => 'Incorrect password.' } }
},
{
+ 'key' => 'cybercash3.2',
+ 'section' => 'billing',
+ 'description' => '<a href="http://www.cybercash.com/cashregister/">CyberCash Cashregister v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').',
+ 'type' => 'textarea',
+ },
+
+ {
'key' => 'cyrus',
'section' => 'deprecated',
'description' => '<b>DEPRECATED</b>, add a <i>cyrus</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.',
},
{
+ 'key' => 'domain',
+ 'section' => 'deprecated',
+ 'description' => 'Your domain name.',
+ 'type' => 'text',
+ },
+
+ {
'key' => 'editreferrals',
'section' => 'UI',
'description' => 'Enable advertising source modification for existing customers',
},
{
- 'key' => 'exclude_ip_addr',
- 'section' => '',
- 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)',
- 'type' => 'textarea',
- },
-
- {
'key' => 'erpcdmachines',
'section' => 'deprecated',
'description' => '<b>DEPRECATED</b>, ERPCD is no longer supported. Used to be ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'',
'section' => '',
'description' => 'Acceptable payment types for the signup server',
'type' => 'selectmultiple',
- 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ],
+ 'select_enum' => [ qw(CARD CHEK LECB PREPAY BILL COMP) ],
},
{
'section' => 'UI',
'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.',
'type' => 'select',
- 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL COMP HIDE) ],
+ 'select_enum' => [ '', qw(CARD CHEK LECB BILL COMP HIDE) ],
},
{
package FS::InitHandler;
-# this leaks memory under graceful restarts and i wouldn't use it on any
-# modern server. useful for very slow machines with memory to spare, just
-# always do a full restart
-
use strict;
use vars qw($DEBUG);
use FS::UID qw(adminsuidsetup);
use FS::session;
use FS::svc_acct;
use FS::svc_acct_pop;
+ use FS::svc_acct_sm;
use FS::svc_domain;
use FS::svc_forward;
use FS::svc_www;
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.21;
-use FS::UID qw(dbh getotaker datasrc driver_name);
+use DBIx::DBSchema 0.19;
+use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
$hashref = $record->hashref;
$error = $record->insert;
+ #$error = $record->add; #deprecated
$error = $record->delete;
+ #$error = $record->del; #deprecated
$error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #deprecated
- # external use deprecated - handled by the database (at least for Pg, mysql)
$value = $record->unique('column');
$error = $record->ut_float('column');
$quoted_value = _quote($value,'table','field');
- #deprecated
+ #depriciated
$fields = hfields('table');
if ( $fields->{Field} ) { # etc.
my $self = {};
bless ($self, $class);
if ( defined $self->table ) {
- cluck "create constructor is deprecated, use new!";
+ cluck "create constructor is depriciated, use new!";
$self->new(@_);
} else {
croak "FS::Record::create called (not from a subclass)!";
my $column = $_;
if ( ref($record->{$_}) ) {
$op = $record->{$_}{'op'} if $record->{$_}{'op'};
- #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
+ #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i;
if ( uc($op) eq 'ILIKE' ) {
$op = 'LIKE';
$record->{$_}{'value'} = lc($record->{$_}{'value'});
=cut
sub table {
-# cluck "warning: FS::Record::table deprecated; supply one in subclass!";
+# cluck "warning: FS::Record::table depriciated; supply one in subclass!";
my $self = shift;
$self -> {'Table'};
}
return $error if $error;
#single-field unique keys are given a value if false
- #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
+ #(like MySQL's AUTO_INCREMENT)
foreach ( $self->dbdef_table->unique->singles ) {
$self->unique($_) unless $self->getfield($_);
}
-
- #and also the primary key, if the database isn't going to
+ #and also the primary key
my $primary_key = $self->dbdef_table->primary_key;
- my $db_seq = 0;
- if ( $primary_key ) {
- my $col = $self->dbdef_table->column($primary_key);
-
- $db_seq =
- 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
- );
- $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq;
- }
+ $self->unique($primary_key)
+ if $primary_key && ! $self->getfield($primary_key);
- my $table = $self->table;
#false laziness w/delete
my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
$self->fields
;
- my @values = map { _quote( $self->getfield($_), $table, $_) } @fields;
+ my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
#eslaf
- my $statement = "INSERT INTO $table ( ".
+ my $statement = "INSERT INTO ". $self->table. " ( ".
join( ', ', @fields ).
") VALUES (".
join( ', ', @values ).
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
+ my $h_sth;
+ if ( defined $dbdef->table('h_'. $self->table) ) {
+ my $h_statement = $self->_h_statement('insert');
+ warn "[debug]$me $h_statement\n" if $DEBUG > 2;
+ $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+ } else {
+ $h_sth = '';
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
-
- if ( $db_seq ) { # get inserted id from the database, if applicable
- warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
- my $insertid = '';
- if ( driver_name eq 'Pg' ) {
-
- my $oid = $sth->{'pg_oid_status'};
- my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
- my $i_sth = dbh->prepare($i_sql) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- $i_sth->execute($oid) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return $i_sth->errstr;
- };
- $insertid = $i_sth->fetchrow_arrayref->[0];
-
- } elsif ( driver_name eq 'mysql' ) {
-
- $insertid = dbh->{'mysql_insertid'};
- # work around mysql_insertid being null some of the time, ala RT :/
- unless ( $insertid ) {
- warn "WARNING: DBD::mysql didn't return mysql_insertid; ".
- "using SELECT LAST_INSERT_ID();";
- my $i_sql = "SELECT LAST_INSERT_ID()";
- my $i_sth = dbh->prepare($i_sql) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- $i_sth->execute or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return $i_sth->errstr;
- };
- $insertid = $i_sth->fetchrow_arrayref->[0];
- }
-
- } else {
- dbh->rollback if $FS::UID::AutoCommit;
- return "don't know how to retreive inserted ids from ". driver_name.
- ", try using counterfiles (maybe run dbdef-create?)";
- }
- $self->setfield($primary_key, $insertid);
- }
-
- my $h_sth;
- if ( defined $dbdef->table('h_'. $table) ) {
- my $h_statement = $self->_h_statement('insert');
- warn "[debug]$me $h_statement\n" if $DEBUG > 2;
- $h_sth = dbh->prepare($h_statement) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- } else {
- $h_sth = '';
- }
$h_sth->execute or return $h_sth->errstr if $h_sth;
-
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
=cut
sub add {
- cluck "warning: FS::Record::add deprecated!";
+ cluck "warning: FS::Record::add depriciated!";
insert @_; #call method in this scope
}
map {
$self->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
+ ? ( driver_name =~ /^Pg$/i
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
=cut
sub del {
- cluck "warning: FS::Record::del deprecated!";
+ cluck "warning: FS::Record::del depriciated!";
&delete(@_); #call method in this scope
}
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
+ ? ( driver_name =~ /^Pg$/i
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
=cut
sub rep {
- cluck "warning: FS::Record::rep deprecated!";
+ cluck "warning: FS::Record::rep depriciated!";
replace @_; #call method in this scope
}
=item unique COLUMN
-B<Warning>: External use is B<deprecated>.
-
-Replaces COLUMN in record with a unique number, using counters in the
-filesystem. Used by the B<insert> method on single-field unique columns
-(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys
-that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql).
-
+Replaces COLUMN in record with a unique number. Called by the B<add> method
+on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
Returns the new value.
=cut
my($self,$field) = @_;
my($table)=$self->table;
+ #croak("&FS::UID::checkruid failed") unless &checkruid;
+
croak "Unique called on field $field, but it is ",
$self->getfield($field),
", not null!"
# my($counter) = new File::CounterFile "$user/$table.$field",0;
# endhack
- my $index = $counter->inc;
- $index = $counter->inc while qsearchs($table, { $field=>$index } );
+ my($index)=$counter->inc;
+ $index=$counter->inc
+ while qsearchs($table,{$field=>$index}); #just in case
$index =~ /^(\d*)$/;
$index=$1;
=item hfields TABLE
-This is deprecated. Don't use it.
+This is depriciated. Don't use it.
It returns a hash-type list with the fields of this record's table set true.
=cut
sub hfields {
- carp "warning: hfields is deprecated";
+ carp "warning: hfields is depriciated";
my($table)=@_;
my(%hash);
foreach (fields($table)) {
This module should probably be renamed, since much of the functionality is
of general use. It is not completely unlike Adapter::DBI (see below).
-Exported qsearch and qsearchs should be deprecated in favor of method calls
+Exported qsearch and qsearchs should be depriciated in favor of method calls
(against an FS::Record object like the old search and searchs that qsearch
and qsearchs were on top of.)
The various WHERE clauses should be subroutined.
-table string should be deprecated in favor of DBIx::DBSchema::Table.
+table string should be depriciated in favor of DBIx::DBSchema::Table.
No doubt we could benefit from a Tied hash. Documenting how exists / defined
true maps to the database (and WHERE clauses) would also help.
use strict;
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
- $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
- $driver_name $AutoCommit
+ $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
+ $AutoCommit
);
use subs qw(
getsecrets cgisetotaker
getsecrets;
$dbh = DBI->connect($datasrc,$db_user,$db_pass, {
'AutoCommit' => 0,
- #'ChopBlanks' => 1,
+ 'ChopBlanks' => 1,
} ) or die "DBI->connect error: $DBI::errstr\n";
foreach ( keys %callback ) {
# breaks multi-database installs # delete $callback{$_}; #run once
}
- &{$_} foreach @callback;
-
$dbh;
}
-=item install_callback
-
-A package can install a callback to be run in adminsuidsetup by passing
-a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
-run already, the callback will also be run immediately.
-
- $coderef = sub { warn "Hi, I'm returning your call!" };
- FS::UID->install_callback($coderef);
-
- install_callback FS::UID sub {
- warn "Hi, I'm returning your call!"
- };
-
-=cut
-
-sub install_callback {
- my $class = shift;
- my $callback = shift;
- push @callback, $callback;
- &{$callback} if $dbh;
-}
-
=item cgisuidsetup CGI_object
Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
=cut
sub getotaker {
- $user;
+ #$user;
+ #stupid kludge until schema otaker fields are not 8 chars
+ substr($user,0,8);
}
=item cgisetotaker
=head1 CALLBACKS
-Warning: this interface is (still) likely to change in future releases.
-
-New (experimental) callback interface:
-
-A package can install a callback to be run in adminsuidsetup by passing
-a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
-run already, the callback will also be run immediately.
-
- $coderef = sub { warn "Hi, I'm returning your call!" };
- FS::UID->install_callback($coderef);
-
- install_callback FS::UID sub {
- warn "Hi, I'm returning your call!"
- };
-
-Old (deprecated) callback interface:
+Warning: this interface is likely to change in future releases.
A package can install a callback to be run in adminsuidsetup by putting a
coderef into the hash %FS::UID::callback :
$coderef = sub { warn "Hi, I'm returning your call!" };
- $FS::UID::callback{'Package::Name'} = $coderef;
+ $FS::UID::callback{'Package::Name'};
+
+=head1 VERSION
+
+$Id: UID.pm,v 1.19 2002-08-29 06:02:52 ivan Exp $
=head1 BUGS
Goes through contortions to support non-OO syntax with multiple datasrc's.
-Callbacks are (still) inelegant.
+Callbacks are inelegant.
=head1 SEE ALSO
+++ /dev/null
-package FS::addr_block;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs qsearch dbh );
-use FS::router;
-use FS::svc_broadband;
-use FS::Conf;
-use NetAddr::IP;
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::addr_block - Object methods for addr_block records
-
-=head1 SYNOPSIS
-
- use FS::addr_block;
-
- $record = new FS::addr_block \%hash;
- $record = new FS::addr_block { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::addr_block record describes an address block assigned for broadband
-access. FS::addr_block inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item blocknum - primary key, used in FS::svc_broadband to associate
-services to the block.
-
-=item routernum - the router (see FS::router) to which this
-block is assigned.
-
-=item ip_gateway - the gateway address used by customers within this block.
-
-=item ip_netmask - the netmask of the block, expressed as an integer.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'addr_block'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-sub delete {
- my $self = shift;
- return 'Block must be deallocated before deletion'
- if $self->router;
-
- $self->SUPER::delete;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_number('routernum')
- || $self->ut_ip('ip_gateway')
- || $self->ut_number('ip_netmask')
- ;
- return $error if $error;
-
-
- # A routernum of 0 indicates an unassigned block and is allowed
- return "Unknown routernum"
- if ($self->routernum and not $self->router);
-
- my $self_addr = $self->NetAddr;
- return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
- unless $self_addr;
-
- if (not $self->blocknum) {
- my @block = grep {
- my $block_addr = $_->NetAddr;
- if($block_addr->contains($self_addr)
- or $self_addr->contains($block_addr)) { $_; };
- } qsearch( 'addr_block', {});
- foreach(@block) {
- return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
- }
- }
-
- '';
-}
-
-
-=item router
-
-Returns the FS::router object corresponding to this object. If the
-block is unassigned, returns undef.
-
-=cut
-
-sub router {
- my $self = shift;
- return qsearchs('router', { routernum => $self->routernum });
-}
-
-=item svc_broadband
-
-Returns a list of FS::svc_broadband objects associated
-with this object.
-
-=cut
-
-sub svc_broadband {
- my $self = shift;
- return qsearch('svc_broadband', { blocknum => $self->blocknum });
-}
-
-=item NetAddr
-
-Returns a NetAddr::IP object for this block's address and netmask.
-
-=cut
-
-sub NetAddr {
- my $self = shift;
-
- return new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
-}
-
-=item next_free_addr
-
-Returns a NetAddr::IP object corresponding to the first unassigned address
-in the block (other than the network, broadcast, or gateway address). If
-there are no free addresses, returns false.
-
-=cut
-
-sub next_free_addr {
- my $self = shift;
-
- my $conf = new FS::Conf;
- my @excludeaddr = $conf->config('exclude_ip_addr');
-
- my @used = (
- map { $_->NetAddr->addr }
- ($self,
- qsearch('svc_broadband', { blocknum => $self->blocknum }) ),
- @excludeaddr );
-
- my @free = $self->NetAddr->hostenum;
- while (my $ip = shift @free) {
- if (not grep {$_ eq $ip->addr;} @used) { return $ip; };
- }
-
- '';
-
-}
-
-=item allocate
-
-Allocates this address block to a router. Takes an FS::router object
-as an argument.
-
-At present it's not possible to reallocate a block to a different router
-except by deallocating it first, which requires that none of its addresses
-be assigned. This is probably as it should be.
-
-=cut
-
-sub allocate {
- my ($self, $router) = @_;
-
- return 'Block is already allocated'
- if($self->router);
-
- return 'Block must be allocated to a router'
- unless(ref $router eq 'FS::router');
-
- my @svc = $self->svc_broadband;
- if (@svc) {
- return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
- }
-
- my $new = new FS::addr_block {$self->hash};
- $new->routernum($router->routernum);
- return $new->replace($self);
-
-}
-
-=item deallocate
-
-Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
-block are assigned to services, it fails.
-
-=cut
-
-sub deallocate {
- my $self = shift;
-
- my @svc = $self->svc_broadband;
- if (@svc) {
- return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc;
- }
-
- my $new = new FS::addr_block {$self->hash};
- $new->routernum(0);
- return $new->replace($self);
-}
-
-=item split_block
-
-Splits this address block into two equal blocks, occupying the same space as
-the original block. The first of the two will also have the same blocknum.
-The gateway address of each block will be set to the first usable address, i.e.
-(network address)+1. Since this method is designed for use on unallocated
-blocks, this is probably the correct behavior.
-
-(At present, splitting allocated blocks is disallowed. Anyone who wants to
-implement this is reminded that each split costs three addresses, and any
-customers who were using these addresses will have to be moved; depending on
-how full the block was before being split, they might have to be moved to a
-different block. Anyone who I<still> wants to implement it is asked to tie it
-to a configuration switch so that site admins can disallow it.)
-
-=cut
-
-sub split_block {
-
- # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
- # something to atomicize functions, so that we can say
- #
- # sub split_block : atomic {
- #
- # instead of repeating all this AutoCommit verbage in every
- # sub that does more than one database operation.
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $self = shift;
- my $error;
-
- if ($self->router) {
- return 'Block is already allocated';
- }
-
- #TODO: Smallest allowed block should be a config option.
- if ($self->NetAddr->masklen() ge 30) {
- return 'Cannot split blocks with a mask length >= 30';
- }
-
- my (@new, @ip);
- $ip[0] = $self->NetAddr;
- @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
-
- foreach (0,1) {
- $new[$_] = new FS::addr_block {$self->hash};
- $new[$_]->ip_gateway($ip[$_]->addr);
- $new[$_]->ip_netmask($ip[$_]->masklen);
- }
-
- $new[1]->blocknum('');
-
- $error = $new[0]->replace($self);
- if ($error) {
- $dbh->rollback;
- return $error;
- }
-
- $error = $new[1]->insert;
- if ($error) {
- $dbh->rollback;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-}
-
-=item merge
-
-To be implemented.
-
-=back
-
-=head1 BUGS
-
-Minimum block size should be a config option. It's hardcoded at /30 right
-now because that's the smallest block that makes any sense at all.
-
-=cut
-
-1;
-
use strict;
use vars qw( @ISA $conf $money_char );
+use vars qw( $lpr $invoice_from $smtpmachine );
+use vars qw( $cybercash );
+use vars qw( $xaction $E_NoErr );
+use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options );
+use vars qw( $ach_processor $ach_login $ach_password $ach_action @ach_options );
use vars qw( $invoice_lines @buf ); #yuck
+use vars qw( $quiet );
use Date::Format;
+use Mail::Internet 1.44;
+use Mail::Header;
use Text::Template;
use FS::UID qw( datasrc );
use FS::Record qw( qsearch qsearchs );
-use FS::Misc qw( send_email );
use FS::cust_main;
use FS::cust_bill_pkg;
use FS::cust_credit;
@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
+$FS::UID::callback{'FS::cust_bill'} = sub {
+
$conf = new FS::Conf;
+
$money_char = $conf->config('money_char') || '$';
-} );
+
+ $lpr = $conf->config('lpr');
+ $invoice_from = $conf->config('invoice_from');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ ( $bop_processor,$bop_login, $bop_password, $bop_action ) = ( '', '', '', '');
+ @bop_options = ();
+ ( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', '');
+ @ach_options = ();
+
+ if ( $conf->exists('cybercash3.2') ) {
+ require CCMckLib3_2;
+ #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
+ require CCMckDirectLib3_2;
+ #qw(SendCC2_1Server);
+ require CCMckErrno3_2;
+ #qw(MCKGetErrorMessage $E_NoErr);
+ import CCMckErrno3_2 qw($E_NoErr);
+
+ my $merchant_conf;
+ ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
+ my $status = &CCMckLib3_2::InitConfig($merchant_conf);
+ if ( $status != $E_NoErr ) {
+ warn "CCMckLib3_2::InitConfig error:\n";
+ foreach my $key (keys %CCMckLib3_2::Config) {
+ warn " $key => $CCMckLib3_2::Config{$key}\n"
+ }
+ my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
+ die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
+ }
+ $cybercash='cybercash3.2';
+ } elsif ( $conf->exists('business-onlinepayment') ) {
+ ( $bop_processor,
+ $bop_login,
+ $bop_password,
+ $bop_action,
+ @bop_options
+ ) = $conf->config('business-onlinepayment');
+ $bop_action ||= 'normal authorization';
+ ( $ach_processor, $ach_login, $ach_password, $ach_action, @ach_options ) =
+ ( $bop_processor, $bop_login, $bop_password, $bop_action, @bop_options );
+ eval "use Business::OnlinePayment";
+ }
+
+ if ( $conf->exists('business-onlinepayment-ach') ) {
+ ( $ach_processor,
+ $ach_login,
+ $ach_password,
+ $ach_action,
+ @ach_options
+ ) = $conf->config('business-onlinepayment-ach');
+ $ach_action ||= 'normal authorization';
+ eval "use Business::OnlinePayment";
+ }
+
+};
=head1 NAME
my @print_text = $self->print_text('', $template);
my @invoicing_list = $self->cust_main->invoicing_list;
- if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email
+ if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email
#better to notify this person than silence
- @invoicing_list = ($conf->config('invoice_from')) unless @invoicing_list;
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from'),
- 'to' => [ grep { $_ ne 'POST' } @invoicing_list ],
- 'subject' => 'Invoice',
- 'body' => \@print_text,
+ @invoicing_list = ($invoice_from) unless @invoicing_list;
+
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card
+ #$ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Invoice",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ @print_text ], #( date)
);
- return "can't send invoice: $error" if $error;
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or return "(customer # ". $self->custnum. ") can't send invoice email".
+ " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ).
+ " via server $smtpmachine with SMTP: $!";
}
if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal
- my $lpr = $conf->config('lpr');
open(LPR, "|$lpr")
or return "Can't open pipe to $lpr: $!";
print LPR @print_text;
time2str("%x", $cust_bill_pkg->edate),
);
- } else { #pkgnum tax
+ } else { #pkgnum Tax
next unless $cust_bill_pkg->setup != 0;
- my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc')
- ? ( $cust_bill_pkg->itemdesc || 'Tax' )
- : 'Tax';
($pkg, $setup, $recur, $sdate, $edate) =
- ( $itemdesc, sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' );
+ ( 'Tax', sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' );
}
$csv->combine(
sub realtime_card {
my $self = shift;
- $self->realtime_bop( 'CC', @_ );
+ $self->realtime_bop(
+ 'CC',
+ $bop_processor,
+ $bop_login,
+ $bop_password,
+ $bop_action,
+ \@bop_options,
+ @_
+ );
}
=item realtime_ach
sub realtime_ach {
my $self = shift;
- $self->realtime_bop( 'ECHECK', @_ );
+ $self->realtime_bop(
+ 'ECHECK',
+ $ach_processor,
+ $ach_login,
+ $ach_password,
+ $ach_action,
+ \@ach_options,
+ @_
+ );
}
=item realtime_lec
sub realtime_lec {
my $self = shift;
- $self->realtime_bop( 'LEC', @_ );
+ $self->realtime_bop(
+ 'LEC',
+ $bop_processor,
+ $bop_login,
+ $bop_password,
+ $bop_action,
+ \@bop_options,
+ @_
+ );
}
sub realtime_bop {
- my( $self, $method ) = @_;
+ my( $self, $method, $processor, $login, $password, $action, $options ) = @_;
+
+ #trim an extraneous blank line
+ pop @$options if scalar(@$options) % 2 && $options->[-1] =~ /^\s*$/;
my $cust_main = $self->cust_main;
my $amount = $self->owed;
+ my $address = $cust_main->address1;
+ $address .= ", ". $cust_main->address2 if $cust_main->address2;
+
+ my($payname, $payfirst, $paylast);
+ if ( $cust_main->payname && $method ne 'ECHECK' ) {
+ $payname = $cust_main->payname;
+ $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
+ or do {
+ #$dbh->rollback if $oldAutoCommit;
+ return "Illegal payname $payname";
+ };
+ ($payfirst, $paylast) = ($1, $2);
+ } else {
+ $payfirst = $cust_main->getfield('first');
+ $paylast = $cust_main->getfield('last');
+ $payname = "$payfirst $paylast";
+ }
+
+ my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list;
+ if ( $conf->exists('emailinvoiceauto')
+ || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
+ push @invoicing_list, $cust_main->all_emails;
+ }
+ my $email = $invoicing_list[0];
+
+ my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
+
my $description = 'Internet Services';
if ( $conf->exists('business-onlinepayment-description') ) {
my $dtempl = $conf->config('business-onlinepayment-description');
grep { $_->pkgnum } $self->cust_bill_pkg
);
$description = eval qq("$dtempl");
+
+ }
+
+ my %content;
+ if ( $method eq 'CC' ) {
+ $content{card_number} = $cust_main->payinfo;
+ $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ $content{expiration} = "$2/$1";
+ } elsif ( $method eq 'ECHECK' ) {
+ my($account_number,$routing_code) = $cust_main->payinfo;
+ ( $content{account_number}, $content{routing_code} ) =
+ split('@', $cust_main->payinfo);
+ $content{bank_name} = $cust_main->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} = $cust_main->payinfo;
+ }
+
+ my $transaction =
+ new Business::OnlinePayment( $processor, @$options );
+ $transaction->content(
+ 'type' => $method,
+ 'login' => $login,
+ 'password' => $password,
+ 'action' => $action1,
+ 'description' => $description,
+ 'amount' => $amount,
+ 'invoice_number' => $self->invnum,
+ 'customer_id' => $self->custnum,
+ 'last_name' => $paylast,
+ 'first_name' => $payfirst,
+ 'name' => $payname,
+ 'address' => $address,
+ 'city' => $cust_main->city,
+ 'state' => $cust_main->state,
+ 'zip' => $cust_main->zip,
+ 'country' => $cust_main->country,
+ 'referer' => 'http://cleanwhisker.420.am/',
+ 'email' => $email,
+ 'phone' => $cust_main->daytime || $cust_main->night,
+ %content, #after
+ );
+ $transaction->submit();
+
+ if ( $transaction->is_success() && $action2 ) {
+ my $auth = $transaction->authorization;
+ my $ordernum = $transaction->can('order_number')
+ ? $transaction->order_number
+ : '';
+
+ #warn "********* $auth ***********\n";
+ #warn "********* $ordernum ***********\n";
+ my $capture =
+ new Business::OnlinePayment( $processor, @$options );
+
+ my %capture = (
+ %content,
+ type => $method,
+ action => $action2,
+ login => $login,
+ password => $password,
+ order_number => $ordernum,
+ amount => $amount,
+ authorization => $auth,
+ description => $description,
+ );
+
+ foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
+ transaction_sequence_num local_transaction_date
+ local_transaction_time AVS_result_code )) {
+ $capture{$field} = $transaction->$field() if $transaction->can($field);
+ }
+
+ $capture->content( %capture );
+
+ $capture->submit();
+
+ unless ( $capture->is_success ) {
+ my $e = "Authorization sucessful but capture failed, invnum #".
+ $self->invnum. ': '. $capture->result_code.
+ ": ". $capture->error_message;
+ warn $e;
+ return $e;
+ }
+
+ }
+
+ if ( $transaction->is_success() ) {
+
+ my %method2payby = (
+ 'CC' => 'CARD',
+ 'ECHECK' => 'CHEK',
+ 'LEC' => 'LECB',
+ );
+
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $self->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => $method2payby{$method},
+ 'payinfo' => $cust_main->payinfo,
+ 'paybatch' => "$processor:". $transaction->authorization,
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ my $e = 'WARNING: Card/ACH debited but database not updated - '.
+ 'error applying payment, invnum #' . $self->invnum.
+ " ($processor): $error";
+ warn $e;
+ return $e;
+ } else {
+ return '';
+ }
+ #} elsif ( $options{'report_badcard'} ) {
+ } else {
+
+ my $perror = "$processor error, invnum #". $self->invnum. ': '.
+ $transaction->result_code. ": ". $transaction->error_message;
+
+ if ( !$quiet && $conf->exists('emaildecline')
+ && grep { $_ ne 'POST' } $cust_main->invoicing_list
+ ) {
+ my @templ = $conf->config('declinetemplate');
+ my $template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @templ ],
+ ) or return "($perror) can't create template: $Text::Template::ERROR";
+ $template->compile()
+ or return "($perror) can't compile template: $Text::Template::ERROR";
+
+ my $templ_hash = { error => $transaction->error_message };
+
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Your payment could not be processed",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $template->fill_in(HASH => $templ_hash) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or return "($perror) (customer # ". $self->custnum.
+ ") can't send card decline email to ".
+ join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ).
+ " via server $smtpmachine with SMTP: $!";
+ }
+
+ return $perror;
}
- $cust_main->realtime_bop($method, $amount,
- 'description' => $description,
- 'invnum' => $self->invnum,
+}
+
+=item realtime_card_cybercash
+
+Attempts to pay this invoice with the CyberCash CashRegister realtime gateway.
+
+=cut
+
+sub realtime_card_cybercash {
+ my $self = shift;
+ my $cust_main = $self->cust_main;
+ my $amount = $self->owed;
+
+ return "CyberCash CashRegister real-time card processing not enabled!"
+ unless $cybercash eq 'cybercash3.2';
+
+ my $address = $cust_main->address1;
+ $address .= ", ". $cust_main->address2 if $cust_main->address2;
+
+ #fix exp. date
+ #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
+
+ #
+
+ my $paybatch = $self->invnum.
+ '-' . time2str("%y%m%d%H%M%S", time);
+
+ my $payname = $cust_main->payname ||
+ $cust_main->getfield('first').' '.$cust_main->getfield('last');
+
+ my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country;
+
+ my @full_xaction = ( $xaction,
+ 'Order-ID' => $paybatch,
+ 'Amount' => "usd $amount",
+ 'Card-Number' => $cust_main->getfield('payinfo'),
+ 'Card-Name' => $payname,
+ 'Card-Address' => $address,
+ 'Card-City' => $cust_main->getfield('city'),
+ 'Card-State' => $cust_main->getfield('state'),
+ 'Card-Zip' => $cust_main->getfield('zip'),
+ 'Card-Country' => $country,
+ 'Card-Exp' => $exp,
);
+ my %result;
+ %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
+
+ if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $self->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $cust_main->payinfo,
+ 'paybatch' => "$cybercash:$paybatch",
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ my $e = 'WARNING: Card debited but database not updated - '.
+ 'error applying payment, invnum #' . $self->invnum.
+ " (CyberCash Order-ID $paybatch): $error";
+ warn $e;
+ return $e;
+ } else {
+ return '';
+ }
+# } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
+# || $options{'report_badcard'}
+# ) {
+ } else {
+ return 'Cybercash error, invnum #' .
+ $self->invnum. ':'. $result{'MErrMsg'};
+ }
+
}
=item batch_card
}
#new charges
- foreach my $cust_bill_pkg (
- ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first
- ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes
- ) {
+ foreach ( $self->cust_bill_pkg ) {
- if ( $cust_bill_pkg->pkgnum ) {
+ if ( $_->pkgnum ) {
- my $cust_pkg = qsearchs('cust_pkg', { pkgnum =>$cust_bill_pkg->pkgnum } );
- my $part_pkg = qsearchs('part_pkg', { pkgpart=>$cust_pkg->pkgpart } );
- my $pkg = $part_pkg->pkg;
+ my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
+ my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
+ my($pkg)=$part_pkg->pkg;
- if ( $cust_bill_pkg->setup != 0 ) {
- push @buf, [ "$pkg Setup",
- $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ];
+ if ( $_->setup != 0 ) {
+ push @buf, [ "$pkg Setup", $money_char. sprintf("%10.2f",$_->setup) ];
push @buf,
map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels;
}
- if ( $cust_bill_pkg->recur != 0 ) {
+ if ( $_->recur != 0 ) {
push @buf, [
- "$pkg (" . time2str("%x", $cust_bill_pkg->sdate) . " - " .
- time2str("%x", $cust_bill_pkg->edate) . ")",
- $money_char. sprintf("%10.2f", $cust_bill_pkg->recur)
+ "$pkg (" . time2str("%x",$_->sdate) . " - " .
+ time2str("%x",$_->edate) . ")",
+ $money_char. sprintf("%10.2f",$_->recur)
];
push @buf,
map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels;
}
- push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details;
-
- } else { #pkgnum tax or one-shot line item
- my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc')
- ? ( $cust_bill_pkg->itemdesc || 'Tax' )
- : 'Tax';
- if ( $cust_bill_pkg->setup != 0 ) {
- push @buf, [ $itemdesc,
- $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ];
- }
- if ( $cust_bill_pkg->recur != 0 ) {
- push @buf, [ "$itemdesc (". time2str("%x", $cust_bill_pkg->sdate). " - "
- . time2str("%x", $cust_bill_pkg->edate). ")",
- $money_char. sprintf("%10.2f", $cust_bill_pkg->recur)
- ];
- }
+ } else { #pkgnum Tax
+ push @buf,["Tax", $money_char. sprintf("%10.2f",$_->setup) ]
+ if $_->setup != 0;
}
}
=back
+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.41.2.21 2003-06-30 18:56:02 ivan Exp $
+
=head1 BUGS
The delete method.
use strict;
use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbdef dbh );
+use FS::Record qw( qsearchs );
use FS::cust_pkg;
use FS::cust_bill;
-use FS::cust_bill_pkg_detail;
-@ISA = qw( FS::Record );
+@ISA = qw(FS::Record );
=head1 NAME
=item edate - ending date of recurring fee
-=item itemdesc - Line item description (currentlty used only when pkgnum is 0)
-
=back
sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
Adds this line item to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- 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 $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
- }
-
- foreach my $detail ( @{$self->get('details')} ) {
- my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
- 'pkgnum' => $self->pkgnum,
- 'invnum' => $self->invnum,
- 'detail' => $detail,
- };
- $error = $cust_bill_pkg_detail->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
=item delete
Currently unimplemented. I don't remove line items because there would then be
|| $self->ut_money('recur')
|| $self->ut_numbern('sdate')
|| $self->ut_numbern('edate')
- || $self->ut_textn('itemdesc')
;
return $error if $error;
qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
}
-=item details
-
-Returns an array of detail information for the invoice line item.
-
-=cut
+=back
-sub details {
- my $self = shift;
- return () unless defined dbdef->table('cust_bill_pkg_detail');
- map { $_->detail }
- qsearch ( 'cust_bill_pkg_detail', { 'pkgnum' => $self->pkgnum,
- 'invnum' => $self->invnum, } );
- #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum });
-}
+=head1 VERSION
-=back
+$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $
=head1 BUGS
+++ /dev/null
-package FS::cust_bill_pkg_detail;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_detail;
-
- $record = new FS::cust_bill_pkg_detail \%hash;
- $record = new FS::cust_bill_pkg_detail { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_detail object represents additional detail information for
-an invoice line item (see L<FS::cust_bill_pkg>). FS::cust_bill_pkg_detail
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item detailnum - primary key
-
-=item pkgnum -
-
-=item invnum -
-
-=item detail - detail description
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new line item detail. To add the line item detail to the database,
-see L<"insert">.
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-# the new method can be inherited from FS::Record, if a table method is defined
-
-sub table { 'cust_bill_pkg_detail'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid line item detail. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('detailnum')
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_foreign_key('invnum', 'cust_pkg', 'invnum')
- || $self->ut_text('detail')
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
use Business::CreditCard;
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch dbdef );
-use FS::Misc qw( send_email );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
@ISA = qw( FS::Record );
-$Debug = 1;
+$Debug = 0;
#$Debug = 1;
$import = 0;
#ask FS::UID to run this stuff for us later
-#$FS::UID::callback{'FS::cust_main'} = sub {
-install_callback FS::UID sub {
+$FS::UID::callback{'FS::cust_main'} = sub {
$conf = new FS::Conf;
#yes, need it for stuff below (prolly should be cached)
};
=item ship_fax - phone (optional)
-=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
+=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
=item comments - comments (optional)
-=item referral_custnum - referring customer number
-
=back
=head1 METHODS
}
# packages
- $error = $self->order_pkgs($cust_pkgs, \$seconds);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ foreach my $cust_pkg ( keys %$cust_pkgs ) {
+ $cust_pkg->custnum( $self->custnum );
+ $error = $cust_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting cust_pkg (transaction rolled back): $error";
+ }
+ foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+ $svc_something->pkgnum( $cust_pkg->pkgnum );
+ if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
+ $svc_something->seconds( $svc_something->seconds + $seconds );
+ $seconds = 0;
+ }
+ $error = $svc_something->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ #return "inserting svc_ (transaction rolled back): $error";
+ return $error;
+ }
+ }
}
if ( $seconds ) {
}
-=item order_pkgs
-
-document me. like ->insert(%cust_pkg) on an existing record
-
-=cut
-
-sub order_pkgs {
- my $self = shift;
- my $cust_pkgs = shift;
- my $seconds = 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_pkg ( keys %$cust_pkgs ) {
- $cust_pkg->custnum( $self->custnum );
- my $error = $cust_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_pkg (transaction rolled back): $error";
- }
- foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
- $svc_something->pkgnum( $cust_pkg->pkgnum );
- if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) {
- $svc_something->seconds( $svc_something->seconds + $$seconds );
- $$seconds = 0;
- }
- $error = $svc_something->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "inserting svc_ (transaction rolled back): $error";
- return $error;
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
-
=item delete NEW_CUSTNUM
This deletes the customer. If there is an error, returns the error, otherwise
}
}
- $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/
+ $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/
or return "Illegal payby: ". $self->payby;
$self->payby($1);
- if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) {
+ if ( $self->payby eq 'CARD' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
return gettext('unknown_card_type')
if cardtype($self->payinfo) eq "Unknown";
- } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) {
+ } elsif ( $self->payby eq 'CHEK' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/[^\d\@]//g;
unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/;
$self->paydate('');
} else {
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $self->paydate("$y-$m-01");
+ $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
+ or return "Illegal expiration date: ". $self->paydate;
+ my $y = length($2) == 4 ? $2 : "20$2";
+ $self->paydate("$y-$1-01");
my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
return gettext('expired_card')
if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
}
if ( $self->payname eq '' && $self->payby ne 'CHEK' &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
+ ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
$self->payname =~ /^([\w \,\.\-\']+)$/
my( $total_setup, $total_recur ) = ( 0, 0 );
#my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
my @cust_bill_pkg = ();
- #my $tax = 0;##
+ my $tax = 0;##
#my $taxable_charged = 0;##
#my $charged = 0;##
- my %tax;
-
foreach my $cust_pkg (
qsearch('cust_pkg', { 'custnum' => $self->custnum } )
) {
my %hash = $cust_pkg->hash;
my $old_cust_pkg = new FS::cust_pkg \%hash;
- my @details = ();
-
# bill setup
my $setup = 0;
unless ( $cust_pkg->setup ) {
}
if ( $setup > 0 || $recur > 0 ) {
my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'recur' => $recur,
- 'sdate' => $sdate,
- 'edate' => $cust_pkg->bill,
- 'details' => \@details,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'recur' => $recur,
+ 'sdate' => $sdate,
+ 'edate' => $cust_pkg->bill,
});
push @cust_bill_pkg, $cust_bill_pkg;
$total_setup += $setup;
} #if $cust_main_county->exempt_amount
$taxable_charged = sprintf( "%.2f", $taxable_charged);
-
- #$tax += $taxable_charged * $cust_main_county->tax / 100
- $tax{ $cust_main_county->taxname || 'Tax' } +=
- $taxable_charged * $cust_main_county->tax / 100
+ $tax += $taxable_charged * $cust_main_county->tax / 100
} #unless $self->tax =~ /Y/i
# || $self->payby eq 'COMP'
# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
# );
- foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) {
- my $tax = sprintf("%.2f", $tax{$taxname} );
+ $tax = sprintf("%.2f", $tax);
+ if ( $tax > 0 ) {
$charged = sprintf( "%.2f", $charged+$tax );
my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $taxname,
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
});
push @cust_bill_pkg, $cust_bill_pkg;
}
(Attempt to) collect money for this customer's outstanding invoices (see
L<FS::cust_bill>). Usually used after the bill method.
-Depending on the value of `payby', this may print or email an invoice (I<BILL>,
-I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic
-check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>).
+Depending on the value of `payby', this may print an invoice (`BILL'), charge
+a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
Most actions are now triggered by invoice events; see L<FS::part_bill_event>
and the invoice events web interface.
}
-=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment realtime gateway. See
-L<http://420.am/business-onlinepayment> for supported gateways.
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-Available options are: I<description>, I<invnum>, I<quiet>
-
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
-
-If an I<invnum> is specified, this payment (if sucessful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method.
-
-I<quiet> can be set true to surpress email decline notices.
-
-(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
-
-=cut
-
-sub realtime_bop {
- my( $self, $method, $amount, %options ) = @_;
- if ( $Debug ) {
- warn "$self $method $amount\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- $options{'description'} ||= 'Internet services';
-
- #pre-requisites
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
- eval "use Business::OnlinePayment";
- die $@ if $@;
-
- #overrides
- $self->set( $_ => $options{$_} )
- foreach grep { exists($options{$_}) }
- qw( payname address1 address2 city state zip payinfo paydate );
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach');
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
-
- #massage data
-
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- my($payname, $payfirst, $paylast);
- if ( $self->payname && $method ne 'ECHECK' ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $payname";
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('last');
- $payname = "$payfirst $paylast";
- }
-
- my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list;
- if ( $conf->exists('emailinvoiceauto')
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
- my $email = $invoicing_list[0];
-
- my %content;
- if ( $method eq 'CC' ) {
- $content{card_number} = $self->payinfo;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
- } elsif ( $method eq 'ECHECK' ) {
- my($account_number,$routing_code) = $self->payinfo;
- ( $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;
- }
-
- #transaction(s)
-
- my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
-
- my $transaction =
- new Business::OnlinePayment( $processor, @bop_options );
- $transaction->content(
- 'type' => $method,
- 'login' => $login,
- 'password' => $password,
- 'action' => $action1,
- 'description' => $options{'description'},
- 'amount' => $amount,
- 'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- 'last_name' => $paylast,
- 'first_name' => $payfirst,
- 'name' => $payname,
- 'address' => $address,
- 'city' => $self->city,
- 'state' => $self->state,
- 'zip' => $self->zip,
- 'country' => $self->country,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- );
- $transaction->submit();
-
- if ( $transaction->is_success() && $action2 ) {
- my $auth = $transaction->authorization;
- my $ordernum = $transaction->can('order_number')
- ? $transaction->order_number
- : '';
-
- my $capture =
- new Business::OnlinePayment( $processor, @bop_options );
-
- my %capture = (
- %content,
- type => $method,
- action => $action2,
- login => $login,
- password => $password,
- order_number => $ordernum,
- amount => $amount,
- authorization => $auth,
- description => $options{'description'},
- );
-
- foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code
- transaction_sequence_num local_transaction_date
- local_transaction_time AVS_result_code )) {
- $capture{$field} = $transaction->$field() if $transaction->can($field);
- }
-
- $capture->content( %capture );
-
- $capture->submit();
-
- unless ( $capture->is_success ) {
- my $e = "Authorization sucessful but capture failed, custnum #".
- $self->custnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- #result handling
- if ( $transaction->is_success() ) {
-
- my %method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
- );
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $amount,
- '_date' => '',
- 'payby' => $method2payby{$method},
- 'payinfo' => $self->payinfo,
- 'paybatch' => "$processor:". $transaction->authorization,
- } );
- my $error = $cust_pay->insert;
- if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- 'error applying payment, invnum #' . $self->invnum.
- " ($processor): $error";
- warn $e;
- return $e;
- } else {
- return '';
- }
-
- } else {
-
- my $perror = "$processor error: ". $transaction->error_message;
-
- if ( !$options{'quiet'} && $conf->exists('emaildecline')
- && grep { $_ ne 'POST' } $self->invoicing_list
- ) {
- my @templ = $conf->config('declinetemplate');
- my $template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @templ ],
- ) or return "($perror) can't create template: $Text::Template::ERROR";
- $template->compile()
- or return "($perror) can't compile template: $Text::Template::ERROR";
-
- my $templ_hash = { error => $transaction->error_message };
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from'),
- 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
- 'subject' => 'Your payment could not be processed',
- 'body' => [ $template->fill_in(HASH => $templ_hash) ],
- );
-
- $perror .= " (also received error sending decline notification: $error)"
- if $error;
-
- }
-
- return $perror;
- }
-
-}
-
=item total_owed
Returns the total owed for this customer on all invoices
=item exempt_amount
-=item taxname - if defined, printed on invoices instead of "Tax"
-
=back
=head1 METHODS
|| $self->ut_float('tax')
|| $self->ut_textn('taxclass') # ...
|| $self->ut_money('exempt_amount')
- || $self->ut_textn('taxname')
;
}
unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } );
} elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) {
my($user, $domain) = ($1, $2);
+# if ( $domain eq $mydomain ) {
+# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } );
+# return "Unknown local account: $user\@$domain (specified literally)"
+# unless $svc_acct;
+# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!";
+# $self->dest($1);
+# }
$self->dest("$1\@$2");
} else {
return gettext("illegal_email_invoice_address");
=head1 VERSION
-$Id: cust_main_invoice.pm,v 1.13 2002-09-18 22:50:44 ivan Exp $
+$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $
=head1 BUGS
package FS::cust_pay;
use strict;
-use vars qw( @ISA $conf $unsuspendauto );
+use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from );
use Date::Format;
+use Mail::Header;
+use Mail::Internet 1.44;
use Business::CreditCard;
use FS::UID qw( dbh );
use FS::Record qw( dbh qsearch qsearchs dbh );
-use FS::Misc qw(send_email);
use FS::cust_bill;
use FS::cust_bill_pay;
use FS::cust_main;
@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
+$FS::UID::callback{'FS::cust_pay'} = sub {
+
$conf = new FS::Conf;
$unsuspendauto = $conf->exists('unsuspendauto');
-} );
+ $smtpmachine = $conf->config('smtpmachine');
+ $invoice_from = $conf->config('invoice_from');
+
+};
=head1 NAME
if ( $conf->config('deletepayments') ne '' ) {
my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum });
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from'), #??? well as good as any
- 'to' => $conf->config('deletepayments'),
- 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
- 'body' => [
+ #false laziness w/FS::cust_bill::send & fs_signup_server
+ $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". $conf->config('deletepayments'),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: FREESIDE NOTIFICATION: Payment deleted",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [
"This is an automatic message from your Freeside installation\n",
"informing you that the following payment has been deleted:\n",
"\n",
'paybatch: '. $self->paybatch. "\n",
],
);
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't send payment deletion notification: $error";
- }
-
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "(customer # ". $self->custnum.
+ ") can't send payment deletion email to ".
+ $conf->config('deletepayments').
+ " via server $smtpmachine with SMTP: $!";
+ };
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
=head1 VERSION
-$Id: cust_pay.pm,v 1.24 2003-05-19 12:00:44 ivan Exp $
+$Id: cust_pay.pm,v 1.21.4.2 2002-11-19 09:52:02 ivan Exp $
=head1 BUGS
package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck);
-use vars qw( $quiet );
+use vars qw(@ISA $quiet $disable_agentcheck);
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearch qsearchs );
-use FS::Misc qw( send_email );
use FS::cust_svc;
use FS::part_pkg;
use FS::cust_main;
# setup }
# because they load configuraion by setting FS::UID::callback (see TODO)
use FS::svc_acct;
+use FS::svc_acct_sm;
use FS::svc_domain;
use FS::svc_www;
use FS::svc_forward;
-# for sending cancel emails in sub cancel
+# need all this for sending cancel emails in sub cancel
+
use FS::Conf;
+use Date::Format;
+use Mail::Internet 1.44;
+use Mail::Header;
@ISA = qw( FS::Record );
=item bill - date (next bill date)
-=item last_bill - last bill date
-
=item susp - date
=item expire - date
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
my $conf = new FS::Conf;
- my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
- if ( !$quiet && $conf->exists('emailcancel') && @invoicing_list ) {
- my $conf = new FS::Conf;
- my $error = send_email(
- 'from' => $conf->config('invoice_from'),
- 'to' => \@invoicing_list,
- 'subject' => $conf->config('cancelsubject'),
- 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
- );
- #should this do something on errors?
+
+ if ( !$quiet && $conf->exists('emailcancel')
+ && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) {
+
+ my @invoicing_list = $self->cust_main->invoicing_list;
+
+ my $invoice_from = $conf->config('invoice_from');
+ my @print_text = map "$_\n", $conf->config('cancelmessage');
+ my $subject = $conf->config('cancelsubject');
+ my $smtpmachine = $conf->config('smtpmachine');
+
+ if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card
+ #$ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: $subject",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ @print_text ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 );
+ #should this return an error?
+ }
}
''; #no errors
sub last_bill {
my $self = shift;
- if ( $self->dbdef_table->column('last_bill') ) {
- return $self->setfield('last_bill', $_[0]) if @_;
+ if ( $self->dbdef_table->column('manual_flag') ) {
+ return $self->setfield('last_bill', $_[1]) if @_;
return $self->getfield('last_bill') if $self->getfield('last_bill');
}
my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END
-(exclusive).
+TIMESTAMP_END (exclusive).
TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
}
-=item transfer DEST_PKGNUM
-
-Transfers as many services as possible from this package to another package.
-The destination package must already exist. Services are moved only if
-the destination allows services with the correct I<svcnum> (not svcdb).
-Any services that can't be moved remain in the original package.
-
-Returns an error, if there is one; otherwise, returns the number of services
-that couldn't be moved.
-
-=cut
-
-sub transfer {
- my ($self, $dest_pkgnum) = @_;
-
- my $remaining = 0;
- my $dest;
- my %target;
- my $pkg_svc;
-
- if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
- $dest = $dest_pkgnum;
- $dest_pkgnum = $dest->pkgnum;
- } else {
- $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
- }
-
- return ('Package does not exist: '.$dest_pkgnum) unless $dest;
-
- foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
- $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
- }
-
- my $cust_svc;
-
- foreach $cust_svc ($dest->cust_svc) {
- $target{$cust_svc->svcpart}--;
- }
-
- foreach $cust_svc ($self->cust_svc) {
- if($target{$cust_svc->svcpart} > 0) {
- $target{$cust_svc->svcpart}--;
- my $new = new FS::cust_svc {
- svcnum => $cust_svc->svcnum,
- svcpart => $cust_svc->svcpart,
- pkgnum => $dest_pkgnum };
- my $error = $new->replace($cust_svc);
- return $error if $error;
- } else {
- $remaining++
- }
- }
- return $remaining;
-}
-
=back
=head1 SUBROUTINES
=cut
sub order {
+ my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
+ $remove_pkgnums = [] unless defined($remove_pkgnums);
- # Rewritten to make use of the transfer() method, and in general
- # to not suck so badly.
-
- my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
-
- # Transactionize this whole mess
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error;
- my $cust_main = qsearchs('cust_main', { custnum => $custnum });
- return "Customer not found: $custnum" unless $cust_main;
-
- # Create the new packages.
- my $cust_pkg;
- foreach (@$pkgparts) {
- $cust_pkg = new FS::cust_pkg { custnum => $custnum,
- pkgpart => $_ };
- $error = $cust_pkg->insert;
- if ($error) {
+ # generate %part_pkg
+ # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
+ #
+ my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
+ my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
+ my %part_pkg = %{ $agent->pkgpart_hashref };
+
+ my(%svcnum);
+ # generate %svcnum
+ # for those packages being removed:
+ #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
+ my($pkgnum);
+ foreach $pkgnum ( @{$remove_pkgnums} ) {
+ foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
+ push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
+ }
+ }
+
+ my @cust_svc;
+ #generate @cust_svc
+ # for those packages the customer is purchasing:
+ # @{$pkgparts} is a list of said packages, by pkgpart
+ # @cust_svc is a corresponding list of lists of FS::Record objects
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ unless ( $part_pkg{$pkgpart} ) {
$dbh->rollback if $oldAutoCommit;
- return $error;
+ return "Customer not permitted to purchase pkgpart $pkgpart!";
}
- push @$return_cust_pkg, $cust_pkg;
+ push @cust_svc, [
+ map {
+ ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
+ } map { $_->svcpart }
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } )
+ ];
}
- # $return_cust_pkg now contains refs to all of the newly
- # created packages.
-
- # Transfer services and cancel old packages.
- foreach my $old_pkgnum (@$remove_pkgnum) {
- my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
- foreach my $new_pkg (@$return_cust_pkg) {
- $error = $old_pkg->transfer($new_pkg);
- if ($error and $error == 0) {
- # $old_pkg->transfer failed.
- $dbh->rollback if $oldAutoCommit;
- return $error;
+
+ #special-case until this can be handled better
+ # move services to new svcparts - even if the svcparts don't match (svcdb
+ # needs to...)
+ # looks like they're moved in no particular order, ewwwwwwww
+ # and looks like just one of each svcpart can be moved... o well
+
+ #start with still-leftover services
+ #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ next unless @{ $svcnum{$svcpart} };
+
+ my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
+
+ #find an empty place to put one
+ my $i = 0;
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ my @pkg_svc =
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } );
+ #my @pkg_svc =
+ # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
+ if ( ! @{$cust_svc[$i]} #find an empty place to put them with
+ && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
+ @pkg_svc
+ ) {
+ my $new_svcpart =
+ ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
+ my $cust_svc = shift @{$svcnum{$svcpart}};
+ $cust_svc->svcpart($new_svcpart);
+ #warn "changing from $svcpart to $new_svcpart!!!\n";
+ $cust_svc[$i] = [ $cust_svc ];
}
+ $i++;
}
- if ($error > 0) {
- # Transfers were successful, but we went through all of the
- # new packages and still had services left on the old package.
- # We can't cancel the package under the circumstances, so abort.
+
+ }
+
+ #check for leftover services
+ foreach (keys %svcnum) {
+ next unless @{ $svcnum{$_} };
+ $dbh->rollback if $oldAutoCommit;
+ return "Leftover services, svcpart $_: svcnum ".
+ join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
+ }
+
+ #no leftover services, let's make changes.
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ #first cancel old packages
+ foreach my $pkgnum ( @{$remove_pkgnums} ) {
+ my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ unless ( $old ) {
$dbh->rollback if $oldAutoCommit;
- return "Unable to transfer all services from package ".$old_pkg->pkgnum;
+ return "Package $pkgnum not found to remove!";
}
- $error = $old_pkg->cancel;
- if ($error) {
- $dbh->rollback;
- return $error;
+ my(%hash) = $old->hash;
+ $hash{'cancel'}=time;
+ my($new) = new FS::cust_pkg ( \%hash );
+ my($error)=$new->replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't update package $pkgnum: $error";
}
}
+
+ #now add new packages, changing cust_svc records if necessary
+ my $pkgpart;
+ while ($pkgpart=shift @{$pkgparts} ) {
+
+ my $new = new FS::cust_pkg {
+ 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ };
+ my $error = $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't insert new cust_pkg record: $error";
+ }
+ push @{$return_cust_pkg}, $new if $return_cust_pkg;
+ my $pkgnum = $new->pkgnum;
+
+ foreach my $cust_svc ( @{ shift @cust_svc } ) {
+ my(%hash) = $cust_svc->hash;
+ $hash{'pkgnum'}=$pkgnum;
+ my $new = new FS::cust_svc ( \%hash );
+
+ #avoid Record diffing missing changed svcpart field from above.
+ my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
+
+ my $error = $new->replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't link old service to new package: $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
+
+ ''; #no errors
}
=back
Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
method to pass dates to the recur_prog expression, it should do so.
-FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
-loaded via 'use' at compile time, rather than via 'require' in sub { setup,
-suspend, unsuspend, cancel } because they use %FS::UID::callback to load
-configuration values. Probably need a subroutine which decides what to do
-based on whether or not we've fetched the user yet, rather than a hash. See
-FS::UID and the TODO.
+FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
+compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
+cancel } because they use %FS::UID::callback to load configuration values.
+Probably need a subroutine which decides what to do based on whether or not
+we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
Now that things are transactional should the check in the insert method be
moved to check ?
=head1 VERSION
-$Id: cust_refund.pm,v 1.20 2002-11-19 09:51:58 ivan Exp $
+$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $
=head1 BUGS
package FS::cust_svc;
use strict;
-use vars qw( @ISA $ignore_quantity );
+use vars qw( @ISA );
use Carp qw( cluck );
use FS::Record qw( qsearch qsearchs dbh );
use FS::cust_pkg;
use FS::part_svc;
use FS::pkg_svc;
use FS::svc_acct;
+use FS::svc_acct_sm;
use FS::svc_domain;
use FS::svc_forward;
-use FS::svc_broadband;
use FS::domain_record;
use FS::part_export;
@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 && (!$ignore_quantity || !$quantity);
+ if scalar(@cust_svc) >= $quantity;
}
''; #no error
my $tag;
if ( $svcdb eq 'svc_acct' ) {
$tag = $svc_x->email;
+ } elsif ( $svcdb eq 'svc_acct_sm' ) {
+ my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
+ my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
+ my $domain = $svc_domain->domain;
+ $tag = "$domuser\@$domain";
} elsif ( $svcdb eq 'svc_forward' ) {
my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
$tag = $svc_acct->email. '->';
} elsif ( $svcdb eq 'svc_www' ) {
my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
$tag = $domain->zone;
- } elsif ( $svcdb eq 'svc_broadband' ) {
- $tag = $svc_x->ip_addr;
} else {
cluck "warning: asked for label of unsupported svcdb; using svcnum";
$tag = $svc_x->getfield('svcnum');
if ( $self->rectype eq 'SOA' ) {
my $recdata = $self->recdata;
$recdata =~ s/\s+/ /g;
- $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
+ $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i
or return "Illegal data for SOA record: $recdata";
$self->recdata($1);
} elsif ( $self->rectype eq 'NS' ) {
=head1 VERSION
-$Id: domain_record.pm,v 1.15 2003-04-29 18:28:50 khoff Exp $
+$Id: domain_record.pm,v 1.11.4.2 2003-03-29 04:52:35 ivan Exp $
=head1 BUGS
=item eventpart - primary key
-=item payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP
+=item payby - CARD, CHEK, LECB, BILL, or COMP
=item event - event name
}
my $error = $self->ut_numbern('eventpart')
- || $self->ut_enum('payby', [qw( CARD DCRD CHEK DCHK LECB BILL COMP )] )
+ || $self->ut_enum('payby', [qw( CARD CHEK LECB BILL COMP )] )
|| $self->ut_text('event')
|| $self->ut_anything('eventcode')
|| $self->ut_number('seconds')
=item svc_x
-Returns a list of associated FS::svc_* records.
+Returns a list of associate FS::svc_* records.
=cut
;
tie my %bind_options, 'Tie::IxHash',
- #'machine' => { label=>'named machine' },
- 'named_conf' => { label => 'named.conf location',
- default=> '/etc/bind/named.conf' },
- 'zonepath' => { label => 'path to zone files',
- default=> '/etc/bind/', },
- 'bind_release' => { label => 'ISC BIND Release',
- type => 'select',
- options => [qw(BIND8 BIND9)],
- default => 'BIND8' },
- 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.',
- default => '1D' },
+ #'machine' => { label=>'named machine' },
+ 'named_conf' => { label => 'named.conf location',
+ default=> '/etc/bind/named.conf' },
+ 'zonepath' => { label => 'path to zone files',
+ default=> '/etc/bind/', },
;
tie my %bind_slave_options, 'Tie::IxHash',
- #'machine' => { label=> 'Slave machine' },
- 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
- 'named_conf' => { label => 'named.conf location',
- default => '/etc/bind/named.conf' },
- 'bind_release' => { label => 'ISC BIND Release',
- type => 'select',
- options => [qw(BIND8 BIND9)],
- default => 'BIND8' },
- 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.',
- default => '1D' },
+ #'machine' => { label=> 'Slave machine' },
+ 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
+ 'named_conf' => { label => 'named.conf location',
+ default => '/etc/bind/named.conf' },
;
tie my %http_options, 'Tie::IxHash',
;
tie my %sqlmail_options, 'Tie::IxHash',
- 'datasrc' => { label => 'DBI data source' },
- 'username' => { label => 'Database username' },
- 'password' => { label => 'Database password' },
- 'server_type' => {
- label => 'Server type',
- type => 'select',
- options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
- courier_crypt)],
- default => ['dovecot_plain'], },
- 'svc_acct_table' => { label => 'User Table', default => 'user_acct' },
- 'svc_forward_table' => { label => 'Forward Table', default => 'forward' },
- 'svc_domain_table' => { label => 'Domain Table', default => 'domain' },
- 'svc_acct_fields' => { label => 'svc_acct Export Fields',
- default => 'username _password domsvc svcnum' },
- 'svc_forward_fields' => { label => 'svc_forward Export Fields',
- default => 'domain svcnum catchall' },
- 'svc_domain_fields' => { label => 'svc_domain Export Fields',
- default => 'srcsvc dstsvc dst' },
- 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)},
- type => 'checkbox' },
-
+ 'datasrc' => { label=>'DBI data source' },
+ 'username' => { label=>'Database username' },
+ 'password' => { label=>'Database password' },
;
tie my %ldap_options, 'Tie::IxHash',
'sqlmail' => {
'desc' => 'Real-time export to SQL-backed mail server',
'options' => \%sqlmail_options,
- 'nodomain' => '',
+ 'nodomain' => 'Y',
'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)',
},
},
+ 'svc_acct_sm' => {},
+
'svc_forward' => {
'sqlmail' => {
'desc' => 'Real-time export to SQL-backed mail server',
},
},
- 'svc_broadband' => {
- },
-
);
=back
+++ /dev/null
-package FS::part_router_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::router_field;
-use FS::router;
-
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::part_router_field - Object methods for part_router_field records
-
-=head1 SYNOPSIS
-
- use FS::part_router_field;
-
- $record = new FS::part_router_field \%hash;
- $record = new FS::part_router_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-A part_router_field represents an xfield definition for routers. For more
-information on xfields, see L<FS::part_sb_field>.
-
-The following fields are supported:
-
-=over 4
-
-=item routerfieldpart - primary key (assigned automatically)
-
-=item name - name of field
-
-=item length
-
-=item check_block
-
-=item list_source
-
-(See L<FS::part_sb_field> for details on these fields.)
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'part_router_field'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error = '';
-
- $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i
- or return "Invalid field name for part_router_field";
-
- ''; #no error
-}
-
-=item list_values
-
-Equivalent to "eval($part_router_field->list_source)".
-
-=cut
-
-sub list_values {
- my $self = shift;
- return () unless $self->list_source;
- my @opts = eval($self->list_source);
- if($@) {
- warn $@;
- return ();
- } else {
- return @opts;
- }
-}
-
-=back
-
-=head1 VERSION
-
-$Id:
-
-=head1 BUGS
-
-Needless duplication of much of FS::part_sb_field, with the result that most of
-the warnings about it apply here also.
-
-=head1 SEE ALSO
-
-FS::svc_broadband, FS::router, FS::router_field, schema.html
-from the base documentation.
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::part_sb_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::part_sb_field - Object methods for part_sb_field records
-
-=head1 SYNOPSIS
-
- use FS::part_sb_field;
-
- $record = new FS::part_sb_field \%hash;
- $record = new FS::part_sb_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_sb_field object represents an extended field (xfield) definition
-for svc_broadband's sb_field mechanism (see L<FS::svc_broadband>).
-FS::part_sb_field inherits from FS::Record. The following fields are
-currently supported:
-
-=over 2
-
-=item sbfieldpart - primary key (assigned automatically)
-
-=item name - name of the field
-
-=item svcpart - service type for which this field is available (see L<FS::part_svc>)
-
-=item length - length of the contents of the field (see note #1)
-
-=item check_block - validation routine (see note #2)
-
-=item list_source - enumeration routine (see note #3)
-
-=back
-
-=head1 BACKGROUND
-
-Broadband services, unlike dialup services, are provided over a wide
-variety of physical media (DSL, wireless, cable modems, digital circuits)
-and network architectures (Ethernet, PPP, ATM). For many of these access
-mechanisms, adding a new customer requires knowledge of some properties
-of the physical connection (circuit number, the type of CPE in use, etc.).
-It is unreasonable to expect ISPs to alter Freeside's schema (and the
-associated library and UI code) to make each of these parameters a field in
-svc_broadband.
-
-Hence sb_field and part_sb_field. They allow the Freeside administrator to
-define 'extended fields' ('xfields') associated with svc_broadband records.
-These are I<not> processed in any way by Freeside itself; they exist solely for
-use by exports (see L<FS::part_export>) and technical support staff.
-
-For a parallel mechanism (at the per-router level rather than per-service),
-see L<FS::part_router_field>.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'part_sb_field'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error = '';
-
- $error = $self->ut_numbern('svcpart');
- return $error if $error;
-
- unless (qsearchs('part_svc', { svcpart => $self->svcpart }))
- { return "Unknown svcpart: " . $self->svcpart;}
-
- $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i
- or return "Invalid field name for part_sb_field";
-
- #How to check input_block, display_block, and check_block?
-
- ''; #no error
-}
-
-=item list_values
-
-If the I<list_source> field is set, this method eval()s it and
-returns its output. If the field is empty, list_values returns
-an empty list.
-
-Any arguments passed to this method will be received by the list_source
-code, but this behavior is a fortuitous accident and may be removed in
-the future.
-
-=cut
-
-sub list_values {
- my $self = shift;
- return () unless $self->list_source;
-
- my @opts = eval($self->list_source);
- if($@) {
- warn $@;
- return ();
- } else {
- return @opts;
- }
-}
-
-=item part_svc
-
-Returns the FS::part_svc object associated with this field definition.
-
-=cut
-
-sub part_svc {
- my $self = shift;
- return qsearchs('part_svc', { svcpart => $self->svcpart });
-}
-
-=back
-
-=head1 VERSION
-
-$Id:
-
-=head1 NOTES
-
-=over
-
-=item 1.
-
-The I<length> field is not enforced. It provides a hint to UI
-code about how to display the field on a form. If you want to enforce a
-minimum or maximum length for a field, use a I<check_block>.
-
-=item 2.
-
-The check_block mechanism used here as well as in
-FS::part_router_field allows the user to define validation rules.
-
-When FS::sb_field::check is called, the proposed value of the xfield is
-assigned to $_. The check_block is then eval()'d and its return value
-captured. If the return value is false (empty/zero/undef), $_ is then assigned
-back into the field and stored in the database.
-
-Therefore a check_block can do three different things with the value: allow
-it, allow it with a modification, or reject it. This is very flexible, but
-somewhat dangerous. Some warnings:
-
-=over 2
-
-=item *
-
-Assume that $_ has had I<no> error checking prior to the
-check_block. That's what the check_block is for, after all. It could
-contain I<anything>: evil shell commands in backquotes, 100kb JPEG images,
-the Klez virus, whatever.
-
-=item *
-
-If your check_block modifies the input value, it should probably
-produce a value that wouldn't be modified by going through the same
-check_block again. (That is, it should map input values into its own
-eigenspace.) The reason is that if someone calls $new->replace($old),
-where $new and $old contain the same value for the field, they probably
-want the field to keep its old value, not to get transformed by the
-check_block again. So don't do silly things like '$_++' or
-'tr/A-Za-z/a-zA-Z/'.
-
-=item *
-
-Don't alter the contents of the database. I<Reading> the database
-is perfectly reasonable, but writing to it is a bad idea. Remember that
-check() might get called more than once, as described above.
-
-=item *
-
-The check_block probably won't even get called if the user submits
-an I<empty> sb_field. So at present, you can't set up a default value with
-something like 's/^$/foo/'. Conversely, don't replace the submitted value
-with an empty string. It probably will get stored, but might be deleted at
-any time.
-
-=back
-
-=item 3.
-
-The list_source mechanism is a UI hint (like length) to generate
-drop-down or list boxes. If list_source contains a value, the UI code can
-eval() it and use the results as the options on the list.
-
-Note 'can'. This is not a substitute for check_block. The HTML interface
-currently requires that the user pick one of the options on the list
-because that's the way HTML drop-down boxes work, but in the future the UI
-code might add an 'Other (please specify)' option and a text box so that
-the user can enter something else. Or it might ignore list_source and just
-generate a text box. Or the interface might be rewritten in MS Access,
-where drop-down boxes have text boxes built in. Data validation is the job
-of check(), not the front end.
-
-Note also that a list of literals evaluates to itself, so a list_source
-like
-
-C<('Windows', 'MacOS', 'Linux')>
-
-or
-
-C<qw(Windows MacOS Linux)>
-
-means exactly what you'd think.
-
-=head1 BUGS
-
-The lack of any way to do default values. We might add this as another UI
-hint (since, for the most part, it's the UI's job to figure out which fields
-have had values entered into them). In fact, there are lots of things we
-should add as UI hints.
-
-Oh, and the documentation is probably full of lies.
-
-=head1 SEE ALSO
-
-FS::svc_broadband, FS::sb_field, schema.html from the base documentation.
-
-=cut
-
-1;
-
my @fields = eval { fields( $recref->{svcdb} ) }; #might die
return "Unknown svcdb!" unless @fields;
+##REPLACED BY part_svc_column
+# my $svcdb;
+# foreach $svcdb ( qw(
+# svc_acct svc_acct_sm svc_domain
+# ) ) {
+# my @rows = map { /^${svcdb}__(.*)$/; $1 }
+# grep ! /_flag$/,
+# grep /^${svcdb}__/,
+# fields('part_svc');
+# foreach my $row (@rows) {
+# unless ( $svcdb eq $recref->{svcdb} ) {
+# $recref->{$svcdb.'__'.$row}='';
+# $recref->{$svcdb.'__'.$row.'_flag'}='';
+# next;
+# }
+# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
+# or return "Illegal flag for $svcdb $row";
+# $recref->{$svcdb.'__'.$row.'_flag'} = $1;
+#
+# my $error = $self->ut_anything($svcdb.'__'.$row);
+# return $error if $error;
+#
+# }
+# }
+
''; #no error
}
=cut
sub part_svc_column {
- my( $self, $columnname) = @_;
- $self->svcpart &&
- qsearchs('part_svc_column', {
- 'svcpart' => $self->svcpart,
- 'columnname' => $columnname,
- }
+ my $self = shift;
+ my $columnname = shift;
+ qsearchs('part_svc_column', {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $columnname,
+ }
) or new FS::part_svc_column {
'svcpart' => $self->svcpart,
'columnname' => $columnname,
+++ /dev/null
-package FS::part_svc_router;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearchs);
-use FS::router;
-use FS::part_svc;
-
-@ISA = qw(FS::Record);
-
-sub table { 'part_svc_router'; }
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
- || $self->ut_foreign_key('routernum', 'router', 'routernum');
- return $error if $error;
- ''; #no error
-}
-
-sub router {
- my $self = shift;
- return qsearchs('router', { routernum => $self->routernum });
-}
-
-sub part_svc {
- my $self = shift;
- return qsearchs('part_svc', { svcpart => $self->svcpart });
-}
-
-1;
=head1 VERSION
-$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $
+$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
=head1 BUGS
+++ /dev/null
-package FS::router;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs qsearch );
-use FS::addr_block;
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::router - Object methods for router records
-
-=head1 SYNOPSIS
-
- use FS::router;
-
- $record = new FS::router \%hash;
- $record = new FS::router { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::router record describes a broadband router, such as a DSLAM or a wireless
- access point. FS::router inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item routernum - primary key
-
-=item routername - descriptive name for the router
-
-=item svcnum - svcnum of the owning FS::svc_broadband, if appropriate
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'router'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('routernum')
- || $self->ut_text('routername');
- return $error if $error;
-
- '';
-}
-
-=item addr_block
-
-Returns a list of FS::addr_block objects (address blocks) associated
-with this object.
-
-=cut
-
-sub addr_block {
- my $self = shift;
- return qsearch('addr_block', { routernum => $self->routernum });
-}
-
-=item router_field
-
-Returns a list of FS::router_field objects assigned to this object.
-
-=cut
-
-sub router_field {
- my $self = shift;
-
- return qsearch('router_field', { routernum => $self->routernum });
-}
-
-=item part_svc_router
-
-Returns a list of FS::part_svc_router objects associated with this
-object. This is unlikely to be useful for any purpose other than retrieving
-the associated FS::part_svc objects. See below.
-
-=cut
-
-sub part_svc_router {
- my $self = shift;
- return qsearch('part_svc_router', { routernum => $self->routernum });
-}
-
-=item part_svc
-
-Returns a list of FS::part_svc objects associated with this object.
-
-=cut
-
-sub part_svc {
- my $self = shift;
- return map { qsearchs('part_svc', { svcpart => $_->svcpart }) }
- $self->part_svc_router;
-}
-
-=back
-
-=head1 VERSION
-
-$Id:
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-FS::svc_broadband, FS::router, FS::addr_block, FS::router_field, FS::part_svc,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::router_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::part_router_field;
-use FS::router;
-
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::router_field - Object methods for router_field records
-
-=head1 SYNOPSIS
-
- use FS::router_field;
-
- $record = new FS::router_field \%hash;
- $record = new FS::router_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-FS::router_field contains values of router xfields. See FS::part_sb_field
-for details on the xfield mechanism.
-
-=over 4
-
-=item routerfieldpart - Type of router_field as defined by
-FS::part_router_field
-
-=item routernum - The FS::router to which this value belongs.
-
-=item value - The contents of the field.
-
-=back
-
-=head1 METHODS
-
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'router_field'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- return "routernum must be defined" unless $self->routernum;
- return "routerfieldpart must be defined" unless $self->routerfieldpart;
-
- my $part_router_field = $self->part_router_field;
- $_ = $self->value;
-
- my $check_block = $part_router_field->check_block;
- if ($check_block) {
- $@ = '';
- my $error = (eval($check_block) or $@);
- return $error if $error;
- $self->setfield('value' => $_);
- }
-
- ''; #no error
-}
-
-=item part_router_field
-
-Returns a reference to the FS:part_router_field that defines this
-FS::router_field
-
-=cut
-
-sub part_router_field {
- my $self = shift;
-
- return qsearchs('part_router_field',
- { routerfieldpart => $self->routerfieldpart });
-}
-
-=item router
-
-Returns a reference to the FS::router to which this FS::router_field
-belongs.
-
-=cut
-
-sub router {
- my $self = shift;
-
- return qsearchs('router', { routernum => $self->routernum });
-}
-
-=back
-
-=head1 VERSION
-
-$Id:
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-FS::svc_broadband, FS::router, FS::router_block, FS::router_field,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::sb_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::part_sb_field;
-
-use UNIVERSAL qw( can );
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::sb_field - Object methods for sb_field records
-
-=head1 SYNOPSIS
-
- use FS::sb_field;
-
- $record = new FS::sb_field \%hash;
- $record = new FS::sb_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-See L<FS::part_sb_field> for details on this table's mission in life.
-FS::sb_field contains the actual values of the xfields defined in
-part_sb_field.
-
-The following fields are supported:
-
-=over 4
-
-=item sbfieldpart - Type of sb_field as defined by FS::part_sb_field
-
-=item svcnum - The svc_broadband to which this value belongs.
-
-=item value - The contents of the field.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub table { 'sb_field'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks the value against the check_block of the corresponding part_sb_field.
-Returns whatever the check_block returned (unless the check_block dies, in
-which case check returns the die message). Therefore, if the check_block
-wants to allow the value to be stored, it must return false. See
-L<FS::part_sb_field> for details.
-
-=cut
-
-sub check {
- my $self = shift;
-
- return "svcnum must be defined" unless $self->svcnum;
- return "sbfieldpart must be defined" unless $self->sbfieldpart;
-
- my $part_sb_field = $self->part_sb_field;
-
- $_ = $self->value;
-
- my $check_block = $self->part_sb_field->check_block;
- if ($check_block) {
- $@ = '';
- my $error = (eval($check_block) or $@); # treat fatal errors as errors
- return $error if $error;
- $self->setfield('value' => $_);
- }
-
- ''; #no error
-}
-
-=item part_sb_field
-
-Returns a reference to the FS::part_sb_field that defines this FS::sb_field.
-
-=cut
-
-sub part_sb_field {
- my $self = shift;
-
- return qsearchs('part_sb_field', { sbfieldpart => $self->sbfieldpart });
-}
-
-=back
-
-=item svc_broadband
-
-Returns a reference to the FS::svc_broadband to which this value is attached.
-Nobody's ever going to use this function, but here it is anyway.
-
-=cut
-
-sub svc_broadband {
- my $self = shift;
-
- return qsearchs('svc_broadband', { svcnum => $self->svcnum });
-}
-
-=head1 VERSION
-
-$Id:
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::svc_broadband>, schema.html
-from the base documentation.
-
-=cut
-
-1;
-
$username_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
$username_uppercase
+ $mydomain
$welcome_template $welcome_from $welcome_subject $welcome_mimetype
$smtpmachine
$radius_password $radius_ip
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh );
use FS::svc_Common;
+use Net::SSH;
use FS::cust_svc;
use FS::part_svc;
use FS::svc_acct_pop;
+use FS::svc_acct_sm;
use FS::cust_main_invoice;
use FS::svc_domain;
use FS::raddb;
$username_nodash = $conf->exists('username-nodash');
$username_uppercase = $conf->exists('username-uppercase');
$username_ampersand = $conf->exists('username-ampersand');
+ $mydomain = $conf->config('domain');
$dirhash = $conf->config('dirhash') || 0;
if ( $conf->exists('welcome_email') ) {
$welcome_template = new Text::Template (
sub delete {
my $self = shift;
+ if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
+ return "Can't delete an account which has (svc_acct_sm) mail aliases!"
+ if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
+ }
+
return "Can't delete an account which is a (svc_forward) source!"
if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
$recref->{quota} = $1;
unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
- if ( $recref->{slipip} eq '' ) {
- $recref->{slipip} = '';
- } elsif ( $recref->{slipip} eq '0e0' ) {
- $recref->{slipip} = '0e0';
- } else {
+ unless ( $recref->{slipip} eq '0e0' ) {
$recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
- or return "Illegal slipip: ". $self->slipip;
+ or return "Illegal slipip". $self->slipip;
$recref->{slipip} = $1;
+ } else {
+ $recref->{slipip} = '0e0';
}
}
my $self = shift;
my $password = $self->_password;
my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
- ( $pw_attrib => $password,
+ ( $pw_attrib => $self->_password,
map {
/^(rc_(.*))$/;
my($column, $attrib) = ($1, $2);
sub domain {
my $self = shift;
- die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
- my $svc_domain = $self->svc_domain
- or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
- $svc_domain->domain;
+ if ( $self->domsvc ) {
+ #$self->svc_domain->domain;
+ my $svc_domain = $self->svc_domain
+ or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
+ $svc_domain->domain;
+ } else {
+ $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
+ }
}
=item svc_domain
started in the specified range but are still open are counted from session
start to the end of the range (unless they are over 1 day old, in which case
they are presumed missing their stop record and not counted). Also, sessions
-which end in therange but started earlier are counted from the start of the
+which end in the range but started earlier are counted from the start of the
range to session end. Finally, sessions which start before the range but end
after are counted for the entire range.
$self->cust_svc->attribute_since_sqlradacct(@_);
}
+
=item radius_groups
Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
=item send_email
-This is the FS::svc_acct job-queue-able version. It still uses
-FS::Misc::send_email under-the-hood.
-
=cut
sub send_email {
my %opt = @_;
- eval "use FS::Misc qw(send_email)";
- die $@ if $@;
+ use Date::Format;
+ use Mail::Internet 1.44;
+ use Mail::Header;
$opt{mimetype} ||= 'text/plain';
$opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
- my $error = send_email(
- 'from' => $opt{from},
- 'to' => $opt{to},
- 'subject' => $opt{subject},
- 'content-type' => $opt{mimetype},
- 'body' => [ map "$_\n", split("\n", $opt{body}) ],
+ $ENV{MAILADDRESS} = $opt{from};
+ my $header = new Mail::Header ( [
+ "From: $opt{from}",
+ "To: $opt{to}",
+ "Sender: $opt{from}",
+ "Reply-To: $opt{from}",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: $opt{subject}",
+ "Content-Type: $opt{mimetype}",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ map "$_\n", split("\n", $opt{body}) ],
);
- die $error if $error;
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!";
}
=item check_and_rebuild_fuzzyfiles
L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
-L<freeside-queued>), L<FS::svc_acct_pop>,
+L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
schema.html from the base documentation.
=cut
=head1 VERSION
-$Id: svc_acct_pop.pm,v 1.9 2003-07-04 01:37:46 ivan Exp $
+$Id: svc_acct_pop.pm,v 1.7.4.2 2003-07-04 01:37:44 ivan Exp $
=head1 BUGS
--- /dev/null
+package FS::svc_acct_sm;
+
+use strict;
+use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines );
+use FS::Record qw( fields qsearch qsearchs );
+use FS::svc_Common;
+use FS::cust_svc;
+use Net::SSH qw(ssh);
+use FS::Conf;
+use FS::svc_acct;
+use FS::svc_domain;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+#$FS::UID::callback{'FS::svc_acct_sm'} = sub {
+# $conf = new FS::Conf;
+# $shellmachine = $conf->exists('qmailmachines')
+# ? $conf->config('shellmachine')
+# : '';
+#};
+
+=head1 NAME
+
+FS::svc_acct_sm - Object methods for svc_acct_sm records
+
+=head1 SYNOPSIS
+
+ use FS::svc_acct_sm;
+
+ $record = new FS::svc_acct_sm \%hash;
+ $record = new FS::svc_acct_sm { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 WARNING
+
+FS::svc_acct_sm is B<depreciated>. This class is only included for migration
+purposes. See L<FS::svc_forward>.
+
+=head1 DESCRIPTION
+
+An FS::svc_acct_sm object represents a virtual mail alias. FS::svc_acct_sm
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatcially for new accounts)
+
+=item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
+
+=item domuid - uid of the target account (see L<FS::svc_acct>)
+
+=item domuser - virtual username
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new virtual mail alias. To add the virtual mail alias to the
+database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_acct_sm'; }
+
+=item insert
+
+Adds this virtual mail alias to the database. If there is an error, returns
+the error, otherwise returns false.
+
+The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+ #If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
+ #exist, and domuser is `*' (meaning a catch-all mailbox), the command:
+ #
+ # [ -e $dir/.qmail-$qdomain-default ] || {
+ # touch $dir/.qmail-$qdomain-default;
+ # chown $uid:$gid $dir/.qmail-$qdomain-default;
+ # }
+ #
+ #is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
+ #This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ $error=$self->check;
+ return $error if $error;
+
+ return "Domain username (domuser) in use for this domain (domsvc)"
+ if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
+ 'domsvc' => $self->domsvc,
+ } );
+
+ return "First domain username (domuser) for domain (domsvc) must be " .
+ qq='*' (catch-all)!=
+ if $self->domuser ne '*'
+ && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } )
+ && ! $conf->exists('maildisablecatchall');
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
+ #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } );
+ #my ( $uid, $gid, $dir, $domain ) = (
+ # $svc_acct->uid,
+ # $svc_acct->gid,
+ # $svc_acct->dir,
+ # $svc_domain->domain,
+ #);
+ #my $qdomain = $domain;
+ #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
+ #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
+ # if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
+
+ ''; #no error
+
+}
+
+=item delete
+
+Deletes this virtual mail alias from the database. If there is an error,
+returns the error, otherwise returns false.
+
+The corresponding FS::cust_svc record will be deleted as well.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ return "Domain username (domuser) in use for this domain (domsvc)"
+ if ( $old->domuser ne $new->domuser
+ || $old->domsvc != $new->domsvc
+ ) && qsearchs('svc_acct_sm',{
+ 'domuser'=> $new->domuser,
+ 'domsvc' => $new->domsvc,
+ } )
+ ;
+
+ $new->SUPER::replace($old);
+
+}
+
+=item suspend
+
+Just returns false (no error) for now.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Just returns false (no error) for now.
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Just returns false (no error) for now.
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid virtual mail alias. If there is
+an error, returns the error, otherwise returns false. Called by the insert and
+replace methods.
+
+Sets any fixed values; see L<FS::part_svc>.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $error;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ #my $part_svc = $x;
+
+ my($recref) = $self->hashref;
+
+ $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
+ or return "Illegal domain username (domuser)";
+ $recref->{domuser} = $1;
+
+ $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
+ $recref->{domsvc} = $1;
+ my($svc_domain);
+ return "Unknown domsvc" unless
+ $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
+
+ $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
+ $recref->{domuid} = $1;
+ my($svc_acct);
+ return "Unknown uid" unless
+ $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
+
+=head1 BUGS
+
+The remote commands should be configurable.
+
+The $recref stuff in sub check should be cleaned up.
+
+=head1 SEE ALSO
+
+L<FS::svc_forward>
+
+L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
+L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
+++ /dev/null
-package FS::svc_broadband;
-
-use strict;
-use vars qw(@ISA $conf);
-use FS::Record qw( qsearchs qsearch dbh );
-use FS::svc_Common;
-use FS::cust_svc;
-use FS::addr_block;
-use NetAddr::IP;
-
-@ISA = qw( FS::svc_Common );
-
-$FS::UID::callback{'FS::svc_broadband'} = sub {
- $conf = new FS::Conf;
-};
-
-=head1 NAME
-
-FS::svc_broadband - Object methods for svc_broadband records
-
-=head1 SYNOPSIS
-
- use FS::svc_broadband;
-
- $record = new FS::svc_broadband \%hash;
- $record = new FS::svc_broadband { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_broadband object represents a 'broadband' Internet connection, such
-as a DSL, cable modem, or fixed wireless link. These services are assumed to
-have the following properties:
-
-FS::svc_broadband inherits from FS::svc_Common. The following fields are
-currently supported:
-
-=over 4
-
-=item svcnum - primary key
-
-=item blocknum - see FS::addr_block
-
-=item
-speed_up - maximum upload speed, in bits per second. If set to zero, upload
-speed will be unlimited. Exports that do traffic shaping should handle this
-correctly, and not blindly set the upload speed to zero and kill the customer's
-connection.
-
-=item
-speed_down - maximum download speed, as above
-
-=item ip_addr - the customer's IP address. If the customer needs more than one
-IP address, set this to the address of the customer's router. As a result, the
-customer's router will have the same address for both its internal and external
-interfaces thus saving address space. This has been found to work on most NAT
-routers available.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new svc_broadband. To add the record to the database, see
-"insert".
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-sub table { 'svc_broadband'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields pkgnum and svcpart (see FS::cust_svc) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-=cut
-
-# Standard FS::svc_Common::insert
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# Standard FS::svc_Common::delete
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# Standard FS::svc_Common::replace
-
-=item sb_field
-
-Returns a list of FS::sb_field objects assigned to this object.
-
-=cut
-
-sub sb_field {
- my $self = shift;
-
- return qsearch( 'sb_field', { svcnum => $self->svcnum } );
-}
-
-=item sb_field_hashref
-
-Returns a hashref of the FS::sb_field key/value pairs for this object.
-
-Deprecated. Please don't use it.
-
-=cut
-
-# Kristian wrote this, but don't hold it against him. He was under a powerful
-# distracting influence whom he evidently found much more interesting than
-# svc_broadband.pm. I can't say I blame him.
-
-sub sb_field_hashref {
- my $self = shift;
- my $svcpart = shift;
-
- if ((not $svcpart) && ($self->cust_svc)) {
- $svcpart = $self->cust_svc->svcpart;
- }
-
- my $hashref = {};
-
- map {
- my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart,
- svcnum => $self->svcnum });
- $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : '';
- } qsearch('part_sb_field', { svcpart => $svcpart });
-
- return $hashref;
-
-}
-
-=item suspend
-
-Called by the suspend method of FS::cust_pkg (see FS::cust_pkg).
-
-=item unsuspend
-
-Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg).
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see FS::cust_pkg).
-
-=item check
-
-Checks all fields to make sure this is a valid broadband service. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $x = $self->setfixed;
-
- return $x unless ref($x);
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum')
- || $self->ut_number('speed_up')
- || $self->ut_number('speed_down')
- || $self->ut_ipn('ip_addr')
- ;
- return $error if $error;
-
- if($self->speed_up < 0) { return 'speed_up must be positive'; }
- if($self->speed_down < 0) { return 'speed_down must be positive'; }
-
- if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') {
- $self->ip_addr($self->addr_block->next_free_addr->addr);
- if (not $self->ip_addr) {
- return "No free addresses in addr_block (blocknum: ".$self->blocknum.")";
- }
- }
-
- # This should catch errors in the ip_addr. If it doesn't,
- # they'll almost certainly not map into the block anyway.
- my $self_addr = $self->NetAddr; #netmask is /32
- return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr;
-
- my $block_addr = $self->addr_block->NetAddr;
- unless ($block_addr->contains($self_addr)) {
- return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr;
- }
-
- my $router = $self->addr_block->router
- or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum;
- if(grep { $_->routernum == $router->routernum} $self->allowed_routers) {
- } # do nothing
- else {
- return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;
- }
-
-
- ''; #no error
-}
-
-=item NetAddr
-
-Returns a NetAddr::IP object containing the IP address of this service. The netmask
-is /32.
-
-=cut
-
-sub NetAddr {
- my $self = shift;
- return new NetAddr::IP ($self->ip_addr);
-}
-
-=item addr_block
-
-Returns the FS::addr_block record (i.e. the address block) for this broadband service.
-
-=cut
-
-sub addr_block {
- my $self = shift;
-
- return qsearchs('addr_block', { blocknum => $self->blocknum });
-}
-
-=back
-
-=item allowed_routers
-
-Returns a list of allowed FS::router objects.
-
-=cut
-
-sub allowed_routers {
- my $self = shift;
-
- return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart });
-}
-
-=head1 BUGS
-
-I think there's one place in the code where we actually use sb_field_hashref.
-That's a bug in itself.
-
-The real problem with it is that we're still grappling with the question of how
-tightly xfields should be integrated with real fields. There are a few
-different directions we could go with it--we I<could> override several
-functions in Record so that xfields behave almost exactly like real fields (can
-be set with setfield(), appear in fields() and hash(), used as criteria in
-qsearch(), etc.).
-
-=head1 SEE ALSO
-
-FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field,
-FS::part_svc, schema.html from the base documentation.
-
-=cut
-
-1;
-
package FS::svc_domain;
use strict;
-use vars qw( @ISA $whois_hack $conf
+use vars qw( @ISA $whois_hack $conf $smtpmachine
@defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine
$soarefresh $soaretry
);
use Carp;
+use Mail::Internet 1.44;
+use Mail::Header;
use Date::Format;
use Net::Whois 1.0;
use FS::Record qw(fields qsearch qsearchs dbh);
$FS::UID::callback{'FS::domain'} = sub {
$conf = new FS::Conf;
+ $smtpmachine = $conf->config('smtpmachine');
+
@defaultrecords = $conf->config('defaultrecords');
$soadefaultttl = $conf->config('soadefaultttl');
$soaemail = $conf->config('soaemail');
return "Can't delete a domain which has accounts!"
if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } );
+ return "Can't delete a domain with (svc_acct_sm) mail aliases!"
+ if defined( $FS::Record::dbdef->table('svc_acct_sm') )
+ && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } );
+
#return "Can't delete a domain with (domain_record) zone entries!"
# if qsearch('domain_record', { 'svcnum' => $self->svcnum } );
=head1 VERSION
-$Id: type_pkgs.pm,v 1.2 2002-10-04 12:57:06 ivan Exp $
+$Id: type_pkgs.pm,v 1.1.14.1 2002-10-04 12:56:35 ivan Exp $
=head1 BUGS
bin/freeside-deluser
bin/freeside-email
bin/freeside-expiration-alerter
+bin/freeside-overdue
bin/freeside-queued
bin/freeside-radgroup
bin/freeside-receivables-report
FS/ClientAPI/MyAccount.pm
FS/Conf.pm
FS/ConfItem.pm
-FS/Misc.pm
FS/Record.pm
FS/SearchCache.pm
FS/UI/Base.pm
FS/agent_type.pm
FS/cust_bill.pm
FS/cust_bill_pkg.pm
-FS/cust_bill_pkg_detail.pm
FS/cust_credit.pm
FS/cust_credit_bill.pm
FS/cust_main.pm
FS/part_referral.pm
FS/part_svc.pm
FS/part_svc_column.pm
-FS/part_router_field.pm
-FS/part_sb_field.pm
-FS/part_svc_router.pm
FS/pkg_svc.pm
FS/svc_Common.pm
FS/svc_acct.pm
FS/svc_acct_pop.pm
-FS/svc_broadband.pm
+FS/svc_acct_sm.pm
FS/svc_domain.pm
-FS/router.pm
-FS/router_field.pm
FS/type_pkgs.pm
FS/nas.pm
FS/port.pm
FS/prepay_credit.pm
FS/svc_www.pm
FS/svc_forward.pm
-FS/sb_field.pm
FS/raddb.pm
FS/radius_usergroup.pm
FS/queue.pm
t/ClientAPI.t
t/Conf.t
t/ConfItem.t
-t/Misc.t
t/Record.t
t/UID.t
t/Msgcat.t
t/cust_bill_event.t
t/cust_bill_pay.t
t/cust_bill_pkg.t
-t/cust_bill_pkg_detail.t
t/cust_credit.t
t/cust_credit_bill.t
t/cust_credit_refund.t
t/session.t
t/svc_acct.t
t/svc_acct_pop.t
+t/svc_acct_sm.t
t/svc_Common.t
t/svc_domain.t
t/svc_forward.t
[ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \
|| ( freeside-setup $username 2>/dev/null; \
- /home/ivan/freeside/bin/populate-msgcat $username )
+ /home/ivan/freeside/bin/populate-msgcat $username; 2>/dev/null )
#!/usr/bin/perl -w
#
-# $Id: freeside-adduser,v 1.8 2002-09-27 05:36:29 ivan Exp $
+# $Id: freeside-adduser,v 1.7 2002-08-25 01:16:30 ivan Exp $
use strict;
use vars qw($opt_h $opt_b $opt_c $opt_s);
-use Fcntl qw(:flock);
use Getopt::Std;
my $FREESIDE_CONF = "/usr/local/etc/freeside";
my $secretfile = $opt_s || 'secrets';
open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets")
- and flock(MAPSECRETS,LOCK_EX)
- or die "can't open $FREESIDE_CONF/mapsecrets: $!";
+ or die "can't open $FREESIDE_CONF/mapsecrets: $!";
print MAPSECRETS "$user $secretfile\n";
close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!";
=head1 VERSION
-$Id: freeside-cc-receipts-report,v 1.5 2002-09-09 22:57:34 ivan Exp $
+$Id: freeside-cc-receipts-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $
=head1 BUGS
=head1 VERSION
-$Id: freeside-credit-report,v 1.5 2002-09-09 22:57:34 ivan Exp $
+$Id: freeside-credit-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $
=head1 BUGS
-d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
but be careful.
- -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
+ -p: Only process customers with the specified payby (CARD, CHEK, BILL, COMP, LECB)
-v: enable debugging
adminsuidsetup $user;
my $conf = new FS::Conf;
+my $domain = $conf->config('domain');
my @svc_acct = qsearch('svc_acct', {});
-my @emails = map $_->email, @svc_acct;
+my @usernames = map $_->username, @svc_acct;
+my @emails = map "$_\@$domain", @usernames;
print join("\n", @emails), "\n";
=head1 VERSION
-$Id: freeside-email,v 1.2 2002-09-18 22:50:44 ivan Exp $
+$Id: freeside-email,v 1.1 2001-05-15 07:52:34 ivan Exp $
=head1 BUGS
my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
#credit cards expire at the end of the month/year of their exp date
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
+ if ($payby eq 'CARD') {
($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
$expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
$expire_time--;
$FS::alerter::_template::first = $first;
$FS::alerter::_template::last = $last;
$FS::alerter::_template::company = $company;
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
+ if ($payby eq 'CARD') {
$FS::alerter::_template::payby = "credit card (" .
substr($payinfo, 0, 2) . "xxxxxxxxxx" .
substr($payinfo, -4) . ")";
=head1 VERSION
-$Id: freeside-expiration-alerter,v 1.5 2003-04-21 20:53:57 ivan Exp $
+$Id: freeside-expiration-alerter,v 1.3.4.1 2002-09-16 09:27:12 ivan Exp $
=head1 BUGS
--- /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;
+
=head1 VERSION
-$Id: freeside-receivables-report,v 1.6 2002-09-09 22:57:34 ivan Exp $
+$Id: freeside-receivables-report,v 1.5.4.1 2002-09-09 22:57:32 ivan Exp $
=head1 BUGS
use vars qw($opt_s);
use Getopt::Std;
use DBI;
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema 0.20;
use DBIx::DBSchema::Table;
use DBIx::DBSchema::Column;
use DBIx::DBSchema::ColGroup::Unique;
my $cust_main = $dbdef->table('cust_main');
unless ($ship) { #remove ship_ from cust_main
$cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns );
-} else { #add indices
- push @{$cust_main->index->lol_ref},
- map { [ "ship_$_" ] } qw( last company daytime night fax );
+} else { #add indices on ship_last and ship_company
+ push @{$cust_main->index->lol_ref}, ( ['ship_last'], ['ship_company'] )
}
#add radius attributes to svc_acct
));
}
+##make part_svc table (but now as object)
+#
+#my($part_svc)=$dbdef->table('part_svc');
+#
+##because of svc_acct_pop
+##foreach (grep /^svc_/, $dbdef->tables) {
+##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
+#foreach (qw(svc_acct svc_domain svc_forward svc_www)) {
+# my($table)=$dbdef->table($_);
+# my($col);
+# foreach $col ( $table->columns ) {
+# next if $col =~ /^svcnum$/;
+# $part_svc->addcolumn( new DBIx::DBSchema::Column (
+# $table->name. '__' . $table->column($col)->name,
+# 'varchar', #$table->column($col)->type,
+# 'NULL',
+# $char_d, #$table->column($col)->length,
+# ));
+# $part_svc->addcolumn ( new DBIx::DBSchema::Column (
+# $table->name. '__'. $table->column($col)->name . "_flag",
+# 'char',
+# 'NULL',
+# 1,
+# ));
+# }
+#}
+
#create history tables (false laziness w/create-history-tables)
foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) {
my $tableobj = $dbdef->table($table)
'default' => '',
'local' => '',
} ),
- map {
- my $column = $tableobj->column($_);
-
- #clone so as to not disturb the original
- $column = DBIx::DBSchema::Column->new( {
- map { $_ => $column->$_() }
- qw( name type null length default local )
- } );
-
- $column->type('int')
- if $column->type eq 'serial';
- #$column->default('')
- # if $column->default =~ /^nextval\(/i;
- #( my $local = $column->local ) =~ s/AUTO_INCREMENT//i;
- #$column->local($local);
- $column;
- } $tableobj->columns
+ map { $tableobj->column($_) } $tableobj->columns
],
} );
$dbdef->addtable($h_tableobj);
[ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ],
[ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ],
[ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
- [ 'DCRD', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
- [ 'DCHK', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
) {
my $part_bill_event = new FS::part_bill_event({
'agent' => {
'columns' => [
- 'agentnum', 'serial', '', '',
+ 'agentnum', 'int', '', '',
'agent', 'varchar', '', $char_d,
'typenum', 'int', '', '',
'freq', 'int', 'NULL', '',
'agent_type' => {
'columns' => [
- 'typenum', 'serial', '', '',
+ 'typenum', 'int', '', '',
'atype', 'varchar', '', $char_d,
],
'primary_key' => 'typenum',
'cust_bill' => {
'columns' => [
- 'invnum', 'serial', '', '',
+ 'invnum', 'int', '', '',
'custnum', 'int', '', '',
'_date', @date_type,
'charged', @money_type,
'cust_bill_event' => {
'columns' => [
- 'eventnum', 'serial', '', '',
+ 'eventnum', 'int', '', '',
'invnum', 'int', '', '',
'eventpart', 'int', '', '',
'_date', @date_type,
'part_bill_event' => {
'columns' => [
- 'eventpart', 'serial', '', '',
+ 'eventpart', 'int', '', '',
'payby', 'char', '', 4,
'event', 'varchar', '', $char_d,
'eventcode', @perl_type,
'recur', @money_type,
'sdate', @date_type,
'edate', @date_type,
- 'itemdesc', 'varchar', 'NULL', $char_d,
],
'primary_key' => '',
- 'unique' => [],
+ 'unique' => [ ['pkgnum', 'invnum'] ],
'index' => [ ['invnum'] ],
},
- 'cust_bill_pkg_detail' => {
- 'columns' => [
- 'detailnum', 'serial', '', '',
- 'pkgnum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'detail', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'detailnum',
- 'unique' => [],
- 'index' => [ [ 'pkgnum', 'invnum' ] ],
- },
-
'cust_credit' => {
'columns' => [
- 'crednum', 'serial', '', '',
+ 'crednum', 'int', '', '',
'custnum', 'int', '', '',
'_date', @date_type,
'amount', @money_type,
- 'otaker', 'varchar', '', 32,
+ 'otaker', 'varchar', '', 8,
'reason', 'text', 'NULL', '',
'closed', 'char', 'NULL', 1,
],
'cust_credit_bill' => {
'columns' => [
- 'creditbillnum', 'serial', '', '',
+ 'creditbillnum', 'int', '', '',
'crednum', 'int', '', '',
'invnum', 'int', '', '',
'_date', @date_type,
'cust_main' => {
'columns' => [
- 'custnum', 'serial', '', '',
+ 'custnum', 'int', '', '',
'agentnum', 'int', '', '',
# 'titlenum', 'int', 'NULL', '',
'last', 'varchar', '', $char_d,
# 'middle', 'varchar', 'NULL', $char_d,
'first', 'varchar', '', $char_d,
- 'ss', 'varchar', 'NULL', 11,
+ 'ss', 'char', 'NULL', 11,
'company', 'varchar', 'NULL', $char_d,
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'paydate', 'varchar', 'NULL', 10,
'payname', 'varchar', 'NULL', $char_d,
'tax', 'char', 'NULL', 1,
- 'otaker', 'varchar', '', 32,
+ 'otaker', 'varchar', '', 8,
'refnum', 'int', '', '',
'referral_custnum', 'int', 'NULL', '',
'comments', 'text', 'NULL', '',
'primary_key' => 'custnum',
'unique' => [],
#'index' => [ ['last'], ['company'] ],
- 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ],
- [ 'daytime' ], [ 'night' ], [ 'fax' ],
- ],
+ 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ] ],
},
'cust_main_invoice' => {
'columns' => [
- 'destnum', 'serial', '', '',
+ 'destnum', 'int', '', '',
'custnum', 'int', '', '',
'dest', 'varchar', '', $char_d,
],
#cust_main_county for validation and to provide
# a tax rate.
'columns' => [
- 'taxnum', 'serial', '', '',
+ 'taxnum', 'int', '', '',
'state', 'varchar', 'NULL', $char_d,
'county', 'varchar', 'NULL', $char_d,
'country', 'char', '', 2,
'taxclass', 'varchar', 'NULL', $char_d,
'exempt_amount', @money_type,
'tax', 'real', '', '', #tax %
- 'taxname', 'varchar', 'NULL', $char_d,
],
'primary_key' => 'taxnum',
'unique' => [],
'cust_pay' => {
'columns' => [
- 'paynum', 'serial', '', '',
+ 'paynum', 'int', '', '',
#now cust_bill_pay #'invnum', 'int', '', '',
'custnum', 'int', '', '',
'paid', @money_type,
'_date', @date_type,
'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
# payment type table.
- 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
+ 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
'closed', 'char', 'NULL', 1,
],
'cust_bill_pay' => {
'columns' => [
- 'billpaynum', 'serial', '', '',
+ 'billpaynum', 'int', '', '',
'invnum', 'int', '', '',
'paynum', 'int', '', '',
'amount', @money_type,
'cust_pay_batch' => { #what's this used for again? list of customers
#in current CARD batch? (necessarily CARD?)
'columns' => [
- 'paybatchnum', 'serial', '', '',
+ 'paybatchnum', 'int', '', '',
'invnum', 'int', '', '',
'custnum', 'int', '', '',
'last', 'varchar', '', $char_d,
'cust_pkg' => {
'columns' => [
- 'pkgnum', 'serial', '', '',
+ 'pkgnum', 'int', '', '',
'custnum', 'int', '', '',
'pkgpart', 'int', '', '',
- 'otaker', 'varchar', '', 32,
+ 'otaker', 'varchar', '', 8,
'setup', @date_type,
'bill', @date_type,
- 'last_bill', @date_type,
'susp', @date_type,
'cancel', @date_type,
'expire', @date_type,
'cust_refund' => {
'columns' => [
- 'refundnum', 'serial', '', '',
+ 'refundnum', 'int', '', '',
#now cust_credit_refund #'crednum', 'int', '', '',
'custnum', 'int', '', '',
'_date', @date_type,
'refund', @money_type,
- 'otaker', 'varchar', '', 32,
+ 'otaker', 'varchar', '', 8,
'reason', 'varchar', '', $char_d,
'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
# into payment type table.
- 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
+ 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
'paybatch', 'varchar', 'NULL', $char_d,
'closed', 'char', 'NULL', 1,
],
'cust_credit_refund' => {
'columns' => [
- 'creditrefundnum', 'serial', '', '',
+ 'creditrefundnum', 'int', '', '',
'crednum', 'int', '', '',
'refundnum', 'int', '', '',
'amount', @money_type,
'cust_svc' => {
'columns' => [
- 'svcnum', 'serial', '', '',
+ 'svcnum', 'int', '', '',
'pkgnum', 'int', 'NULL', '',
'svcpart', 'int', '', '',
],
'part_pkg' => {
'columns' => [
- 'pkgpart', 'serial', '', '',
+ 'pkgpart', 'int', '', '',
'pkg', 'varchar', '', $char_d,
'comment', 'varchar', '', $char_d,
'setup', @perl_type,
'part_referral' => {
'columns' => [
- 'refnum', 'serial', '', '',
+ 'refnum', 'int', '', '',
'referral', 'varchar', '', $char_d,
],
'primary_key' => 'refnum',
'part_svc' => {
'columns' => [
- 'svcpart', 'serial', '', '',
+ 'svcpart', 'int', '', '',
'svc', 'varchar', '', $char_d,
'svcdb', 'varchar', '', $char_d,
'disabled', 'char', 'NULL', 1,
'part_svc_column' => {
'columns' => [
- 'columnnum', 'serial', '', '',
+ 'columnnum', 'int', '', '',
'svcpart', 'int', '', '',
'columnname', 'varchar', '', 64,
'columnvalue', 'varchar', 'NULL', $char_d,
#(this should be renamed to part_pop)
'svc_acct_pop' => {
'columns' => [
- 'popnum', 'serial', '', '',
+ 'popnum', 'int', '', '',
'city', 'varchar', '', $char_d,
'state', 'varchar', '', $char_d,
'ac', 'char', '', 3,
'part_pop_local' => {
'columns' => [
- 'localnum', 'serial', '', '',
+ 'localnum', 'int', '', '',
'popnum', 'int', '', '',
'city', 'varchar', 'NULL', $char_d,
'state', 'char', 'NULL', 2,
'index' => [ ['username'], ['domsvc'] ],
},
+# 'svc_acct_sm' => {
+# 'columns' => [
+# 'svcnum', 'int', '', '',
+# 'domsvc', 'int', '', '',
+# 'domuid', 'int', '', '',
+# 'domuser', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'svcnum',
+# 'unique' => [ [] ],
+# 'index' => [ ['domsvc'], ['domuid'] ],
+# },
+
#'svc_charge' => {
# 'columns' => [
# 'svcnum', 'int', '', '',
'domain_record' => {
'columns' => [
- 'recnum', 'serial', '', '',
+ 'recnum', 'int', '', '',
'svcnum', 'int', '', '',
- #'reczone', 'varchar', '', $char_d,
- 'reczone', 'varchar', '', 255,
+ 'reczone', 'varchar', '', $char_d,
'recaf', 'char', '', 2,
- 'rectype', 'varchar', '', 5,
- #'recdata', 'varchar', '', $char_d,
- 'recdata', 'varchar', '', 255,
+ 'rectype', 'char', '', 5,
+ 'recdata', 'varchar', '', $char_d,
],
'primary_key' => 'recnum',
'unique' => [],
'prepay_credit' => {
'columns' => [
- 'prepaynum', 'serial', '', '',
+ 'prepaynum', 'int', '', '',
'identifier', 'varchar', '', $char_d,
'amount', @money_type,
'seconds', 'int', 'NULL', '',
'port' => {
'columns' => [
- 'portnum', 'serial', '', '',
+ 'portnum', 'int', '', '',
'ip', 'varchar', 'NULL', 15,
'nasport', 'int', 'NULL', '',
'nasnum', 'int', '', '',
'nas' => {
'columns' => [
- 'nasnum', 'serial', '', '',
+ 'nasnum', 'int', '', '',
'nas', 'varchar', '', $char_d,
'nasip', 'varchar', '', 15,
'nasfqdn', 'varchar', '', $char_d,
'session' => {
'columns' => [
- 'sessionnum', 'serial', '', '',
+ 'sessionnum', 'int', '', '',
'portnum', 'int', '', '',
'svcnum', 'int', '', '',
'login', @date_type,
'queue' => {
'columns' => [
- 'jobnum', 'serial', '', '',
+ 'jobnum', 'int', '', '',
'job', 'text', '', '',
'_date', 'int', '', '',
'status', 'varchar', '', $char_d,
'queue_arg' => {
'columns' => [
- 'argnum', 'serial', '', '',
+ 'argnum', 'int', '', '',
'jobnum', 'int', '', '',
'arg', 'text', 'NULL', '',
],
'queue_depend' => {
'columns' => [
- 'dependnum', 'serial', '', '',
+ 'dependnum', 'int', '', '',
'jobnum', 'int', '', '',
'depend_jobnum', 'int', '', '',
],
'export_svc' => {
'columns' => [
- 'exportsvcnum' => 'serial', '', '',
+ 'exportsvcnum' => 'int', '', '',
'exportnum' => 'int', '', '',
'svcpart' => 'int', '', '',
],
'part_export' => {
'columns' => [
- 'exportnum', 'serial', '', '',
+ 'exportnum', 'int', '', '',
#'svcpart', 'int', '', '',
'machine', 'varchar', '', $char_d,
'exporttype', 'varchar', '', $char_d,
'part_export_option' => {
'columns' => [
- 'optionnum', 'serial', '', '',
+ 'optionnum', 'int', '', '',
'exportnum', 'int', '', '',
'optionname', 'varchar', '', $char_d,
'optionvalue', 'text', 'NULL', '',
'radius_usergroup' => {
'columns' => [
- 'usergroupnum', 'serial', '', '',
+ 'usergroupnum', 'int', '', '',
'svcnum', 'int', '', '',
'groupname', 'varchar', '', $char_d,
],
'msgcat' => {
'columns' => [
- 'msgnum', 'serial', '', '',
+ 'msgnum', 'int', '', '',
'msgcode', 'varchar', '', $char_d,
'locale', 'varchar', '', 16,
'msg', 'text', '', '',
'cust_tax_exempt' => {
'columns' => [
- 'exemptnum', 'serial', '', '',
+ 'exemptnum', 'int', '', '',
'custnum', 'int', '', '',
'taxnum', 'int', '', '',
'year', 'int', '', '',
'index' => [],
},
- 'router' => {
- 'columns' => [
- 'routernum', 'serial', '', '',
- 'routername', 'varchar', '', $char_d,
- 'svcnum', 'int', '0', '',
- ],
- 'primary_key' => 'routernum',
- 'unique' => [],
- 'index' => [],
- },
- 'part_svc_router' => {
- 'columns' => [
- 'svcpart', 'int', '', '',
- 'routernum', 'int', '', '',
- ],
- 'primary_key' => '',
- 'unique' => [],
- 'index' => [],
- },
-
- 'part_router_field' => {
- 'columns' => [
- 'routerfieldpart', 'serial', '', '',
- 'name', 'varchar', '', $char_d,
- 'length', 'int', '', '',
- 'check_block', 'text', 'NULL', '',
- 'list_source', 'text', 'NULL', '',
- ],
- 'primary_key' => 'routerfieldpart',
- 'unique' => [],
- 'index' => [],
- },
-
- 'router_field' => {
- 'columns' => [
- 'routerfieldpart', 'int', '', '',
- 'routernum', 'int', '', '',
- 'value', 'varchar', '', 128,
- ],
- 'primary_key' => '',
- 'unique' => [ [ 'routerfieldpart', 'routernum' ] ],
- 'index' => [],
- },
-
- 'addr_block' => {
- 'columns' => [
- 'blocknum', 'serial', '', '',
- 'routernum', 'int', '', '',
- 'ip_gateway', 'varchar', '', 15,
- 'ip_netmask', 'int', '', '',
- ],
- 'primary_key' => 'blocknum',
- 'unique' => [ [ 'blocknum', 'routernum' ] ],
- 'index' => [],
- },
-
- 'part_sb_field' => {
- 'columns' => [
- 'sbfieldpart', 'serial', '', '',
- 'svcpart', 'int', '', '',
- 'name', 'varchar', '', $char_d,
- 'length', 'int', '', '',
- 'check_block', 'text', 'NULL', '',
- 'list_source', 'text', 'NULL', '',
- ],
- 'primary_key' => 'sbfieldpart',
- 'unique' => [ [ 'sbfieldpart', 'svcpart' ] ],
- 'index' => [],
- },
-
- 'sb_field' => {
- 'columns' => [
- 'sbfieldpart', 'int', '', '',
- 'svcnum', 'int', '', '',
- 'value', 'varchar', '', 128,
- ],
- 'primary_key' => '',
- 'unique' => [ [ 'sbfieldpart', 'svcnum' ] ],
- 'index' => [],
- },
-
- 'svc_broadband' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'blocknum', 'int', '', '',
- 'speed_up', 'int', '', '',
- 'speed_down', 'int', '', '',
- 'ip_addr', 'varchar', '', 15,
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [],
- },
);
=head1 VERSION
-$Id: freeside-tax-report,v 1.5 2002-09-09 22:57:34 ivan Exp $
+$Id: freeside-tax-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $
=head1 BUGS
+++ /dev/null
-BEGIN { $| = 1; print "1..1\n" }
-END {print "not ok 1\n" unless $loaded;}
-use FS::cust_bill_pkg_detail;
-$loaded=1;
-print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_acct_sm;
+$loaded=1;
+print "ok 1\n";
SIGNUP_AGENTNUM = 2
SIGNUP_REFNUM = 2
-SELFSERVICE_USER = fs_selfservice
+SELFSERVICE_USER = nostart
SELFSERVICE_MACHINE = localhost
#---
#not changable yet
FREESIDE_CONF = /usr/local/etc/freeside
-VERSION=1.5.0pre2
-TAG=freeside_1_5_0pre2
+VERSION=1.4.1rc4
+TAG=freeside_1_4_1rc4
help:
@echo "supported targets: aspdocs masondocs alldocs docs install-docs"
#these are probably only useful if you're me...
upload-docs: forcehtmlman
- ssh cleanwhisker.420.am rm -rf /var/www/www.sisd.com/freeside/devdocs
- scp -pr httemplate/docs cleanwhisker.420.am:/var/www/www.sisd.com/freeside/devdocs
+ ssh cleanwhisker.420.am rm -rf /var/www/www.sisd.com/freeside/docs
+ scp -pr httemplate/docs cleanwhisker.420.am:/var/www/www.sisd.com/freeside/docs
+#release: upload-docs update-webdemo
release: upload-docs
- cd /home/ivan/freeside
+ cd /home/ivan/freeside1.4
#cvs tag ${TAG}
cvs tag -F ${TAG}
mv freeside-${VERSION} freeside-${VERSION}.tar.gz ..
update-webdemo:
- ssh ivan@pouncequick.420.am '( cd freeside; cvs update -d -P )'
+ ssh ivan@pouncequick.420.am '( cd freeside; cvs update -r FREESIDE_1_4_BRANCH -d -P )'
#ssh root@pouncequick.420.am '( cd /home/ivan/freeside; make clean; make deploy )'
ssh root@pouncequick.420.am '( cd /home/ivan/freeside; make deploy )'
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 the
- GNU General Public License for more details.
+ GNU General Public License more details.
You should have received a copy of the GNU General Public
License along with this program, in the file `GPL'; if not,
+++ /dev/null
-preliminary upgrade instructions
-
-schema changes:
- *** get svc_broadband changes from pc-intouch
- *** otaker changes s/8/32 all otkaer fields
- *** optional: sequence changes
- *** add column cust_main_county.taxname
- *** add column cust_bill_pkg.itemdesc
- *** drop index cust_bill_pkg1
- *** add index part_pkg1 and part_svc1
-
-install DBIx::DBSchema 0.21
-install NetAddr::IP
-
-Run dbdef-create
-something about history tables
-Restart apache and freeside-queued
my $machine = $export->machine;
my $prefix = "$spooldir/$machine";
- my $bind_rel = $export->option('bind_release');
- my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
- my $minttl = $export->option('bind9_minttl');
-
#prevent old domain files from piling up
#rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
open (DB_MASTER,">$prefix/db.$domain")
or die "can't open $prefix/db.$domain: $!";
- if ($bind_rel eq 'BIND9') {
- print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n";
- }
-
my @domain_records =
qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
foreach my $domain_record (
} ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
# warn $rsync->out;
- ssh("root\@$machine", "$ndc_cmd reload");
+ ssh("root\@$machine", 'ndc reload');
}
my $machine = $sexport->machine;
my $prefix = "$spooldir/$machine";
- my $bind_rel = $sexport->option('bind_release');
- my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
-
#prevent old domain files from piling up
#rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
} ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
# warn $rsync->out;
- ssh("root\@$machine", "$ndc_cmd reload");
+ ssh("root\@$machine", 'ndc reload');
}
close NAMED_CONF;
use strict;
use DBI;
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema 0.20;
use DBIx::DBSchema::Table;
use DBIx::DBSchema::Column;
use DBIx::DBSchema::ColGroup::Unique;
'default' => '',
'local' => '',
} ),
- map {
- my $column = $tableobj->column($_);
- $column->type('int')
- if $column->type eq 'serial';
- $column->default('')
- if $column->default =~ /^nextval\(/i;
- ( my $local = $column->local ) =~ s/AUTO_INCREMENT//i;
- $column->local($local);
- $column;
- } $tableobj->columns
+ map { $tableobj->column($_) } $tableobj->columns
],
} );
foreach my $statement ( $h_tableobj->sql_create_table($dbh) ) {
#!/usr/bin/perl -Tw
#
-# $Id: dbdef-create,v 1.6 2002-09-19 13:34:52 ivan Exp $
+# $Id: dbdef-create,v 1.5 2001-08-21 02:43:18 ivan Exp $
use strict;
use DBI;
-use DBIx::DBSchema 0.21;
+use DBIx::DBSchema;
use FS::UID qw(adminsuidsetup datasrc driver_name);
my $user = shift or die &usage;
+++ /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";
-}
-
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: fs-setup,v 1.96.4.7 2003-06-14 02:02:25 ivan Exp $
+
+#to delay loading dbdef until we're ready
+BEGIN { $FS::Record::setup_hack = 1; }
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.20;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Record;
+use FS::cust_main_county;
+use FS::raddb;
+use FS::part_bill_event;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+
+#print "\nEnter the maximum username length: ";
+#my($username_len)=&getvalue;
+my $username_len = 32; #usernamemax config file
+
+print "\n\n", <<END, ":";
+Freeside tracks the RADIUS User-Name, check attribute Password and
+reply attribute Framed-IP-Address for each user. You can specify additional
+check and reply attributes (or you can add them later with the
+fs-radius-add-check and fs-radius-add-reply programs).
+
+First enter any additional RADIUS check attributes you need to track for each
+user, separated by whitespace.
+END
+my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+print "\n\n", <<END, ":";
+Now enter any additional reply attributes you need to track for each user,
+separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+print "\n\n", <<END, ":";
+Do you wish to enable the tracking of a second, separate shipping/service
+address?
+END
+my $ship = &_yesno;
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+sub _yesno {
+ print " [y/N]:";
+ my $x = scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+#my(@date_type) = ( 'timestamp', '', '' );
+my(@date_type) = ( 'int', 'NULL', '' );
+my(@perl_type) = ( 'text', 'NULL', '' );
+my @money_type = ( 'decimal', '', '10,2' );
+
+###
+# create a dbdef object from the old data structure
+###
+
+my(%tables)=&tables_hash_hack;
+
+#turn it into objects
+my($dbdef) = new DBIx::DBSchema ( map {
+ my(@columns);
+ while (@{$tables{$_}{'columns'}}) {
+ my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
+ push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length );
+ }
+ DBIx::DBSchema::Table->new(
+ $_,
+ $tables{$_}{'primary_key'},
+ DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}),
+ DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}),
+ @columns,
+ );
+} (keys %tables) );
+
+my $cust_main = $dbdef->table('cust_main');
+unless ($ship) { #remove ship_ from cust_main
+ $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns );
+} else { #add indices
+ push @{$cust_main->index->lol_ref},
+ map { [ "ship_$_" ] } qw( last company daytime night fax );
+}
+
+#add radius attributes to svc_acct
+
+my($svc_acct)=$dbdef->table('svc_acct');
+
+my($attribute);
+foreach $attribute (@attributes) {
+ $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
+ 'radius_'. $attribute,
+ 'varchar',
+ 'NULL',
+ $char_d,
+ ));
+}
+
+foreach $attribute (@check_attributes) {
+ $svc_acct->addcolumn( new DBIx::DBSchema::Column (
+ 'rc_'. $attribute,
+ 'varchar',
+ 'NULL',
+ $char_d,
+ ));
+}
+
+##make part_svc table (but now as object)
+#
+#my($part_svc)=$dbdef->table('part_svc');
+#
+##because of svc_acct_pop
+##foreach (grep /^svc_/, $dbdef->tables) {
+##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
+#foreach (qw(svc_acct svc_domain svc_forward svc_www)) {
+# my($table)=$dbdef->table($_);
+# my($col);
+# foreach $col ( $table->columns ) {
+# next if $col =~ /^svcnum$/;
+# $part_svc->addcolumn( new DBIx::DBSchema::Column (
+# $table->name. '__' . $table->column($col)->name,
+# 'varchar', #$table->column($col)->type,
+# 'NULL',
+# $char_d, #$table->column($col)->length,
+# ));
+# $part_svc->addcolumn ( new DBIx::DBSchema::Column (
+# $table->name. '__'. $table->column($col)->name . "_flag",
+# 'char',
+# 'NULL',
+# 1,
+# ));
+# }
+#}
+
+#create history tables (false laziness w/create-history-tables)
+foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) {
+ my $tableobj = $dbdef->table($table)
+ or die "unknown table $table";
+
+ die "unique->lol_ref undefined for $table"
+ unless defined $tableobj->unique->lol_ref;
+ die "index->lol_ref undefined for $table"
+ unless defined $tableobj->index->lol_ref;
+
+ my $h_tableobj = DBIx::DBSchema::Table->new( {
+ name => "h_$table",
+ primary_key => 'historynum',
+ unique => DBIx::DBSchema::ColGroup::Unique->new( [] ),
+ 'index' => DBIx::DBSchema::ColGroup::Index->new( [
+ @{$tableobj->unique->lol_ref},
+ @{$tableobj->index->lol_ref}
+ ] ),
+ columns => [
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'historynum',
+ 'type' => 'serial',
+ 'null' => 'NOT NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_date',
+ 'type' => 'int',
+ 'null' => 'NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_user',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_action',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ map { $tableobj->column($_) } $tableobj->columns
+ ],
+ } );
+ $dbdef->addtable($h_tableobj);
+}
+
+#important
+$dbdef->save($dbdef_file);
+&FS::Record::reload_dbdef($dbdef_file);
+
+###
+# create 'em
+###
+
+my($dbh)=adminsuidsetup $user;
+
+#create tables
+$|=1;
+
+foreach my $statement ( $dbdef->sql($dbh) ) {
+ $dbh->do( $statement )
+ or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
+}
+
+#not really sample data (and shouldn't default to US)
+
+#cust_main_county
+
+#USPS state codes
+foreach ( qw(
+AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
+ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
+SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'state' => $_,
+ 'tax' => 0,
+ 'country' => 'US',
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson)
+foreach ( qw(
+VIC NSW NT QLD TAS ACT WA SA
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'state' => $_,
+ 'tax' => 0,
+ 'country' => 'AU',
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#ISO 2-letter country codes (same as country TLDs) except US and AU
+foreach ( qw(
+AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO
+BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI
+HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA
+GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL
+IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV
+ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG
+NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM
+ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ
+TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH
+YE YU ZR ZM ZW
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'tax' => 0,
+ 'country' => $_,
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#billing events
+foreach my $aref (
+ [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ],
+ [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ],
+ [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
+) {
+
+ my $part_bill_event = new FS::part_bill_event({
+ 'payby' => $aref->[0],
+ 'event' => $aref->[1],
+ 'eventcode' => $aref->[2],
+ 'seconds' => 0,
+ 'weight' => $aref->[3],
+ 'plan' => $aref->[4],
+ });
+ my($error);
+ $error=$part_bill_event->insert;
+ die $error if $error;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+print "Freeside database initialized sucessfully\n";
+
+sub usage {
+ die "Usage:\n fs-setup user\n";
+}
+
+###
+# Now it becomes an object. much better.
+###
+sub tables_hash_hack {
+
+ #note that s/(date|change)/_$1/; to avoid keyword conflict.
+ #put a kludge in FS::Record to catch this or? (pry need some date-handling
+ #stuff anyway also)
+
+ my(%tables)=( #yech.}
+
+ 'agent' => {
+ 'columns' => [
+ 'agentnum', 'int', '', '',
+ 'agent', 'varchar', '', $char_d,
+ 'typenum', 'int', '', '',
+ 'freq', 'int', 'NULL', '',
+ 'prog', @perl_type,
+ ],
+ 'primary_key' => 'agentnum',
+ 'unique' => [],
+ 'index' => [ ['typenum'] ],
+ },
+
+ 'agent_type' => {
+ 'columns' => [
+ 'typenum', 'int', '', '',
+ 'atype', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'typenum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ 'type_pkgs' => {
+ 'columns' => [
+ 'typenum', 'int', '', '',
+ 'pkgpart', 'int', '', '',
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['typenum', 'pkgpart'] ],
+ 'index' => [ ['typenum'] ],
+ },
+
+ 'cust_bill' => {
+ 'columns' => [
+ 'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ '_date', @date_type,
+ 'charged', @money_type,
+ 'printed', 'int', '', '',
+ 'closed', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'invnum',
+ 'unique' => [],
+ 'index' => [ ['custnum'], ['_date'] ],
+ },
+
+ 'cust_bill_event' => {
+ 'columns' => [
+ 'eventnum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'eventpart', 'int', '', '',
+ '_date', @date_type,
+ 'status', 'varchar', '', $char_d,
+ 'statustext', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'eventnum',
+ #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
+ 'unique' => [],
+ 'index' => [ ['invnum'], ['status'] ],
+ },
+
+ 'part_bill_event' => {
+ 'columns' => [
+ 'eventpart', 'int', '', '',
+ 'payby', 'char', '', 4,
+ 'event', 'varchar', '', $char_d,
+ 'eventcode', @perl_type,
+ 'seconds', 'int', 'NULL', '',
+ 'weight', 'int', '', '',
+ 'plan', 'varchar', 'NULL', $char_d,
+ 'plandata', 'text', 'NULL', '',
+ 'disabled', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'eventpart',
+ 'unique' => [],
+ 'index' => [ ['payby'] ],
+ },
+
+ 'cust_bill_pkg' => {
+ 'columns' => [
+ 'pkgnum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'setup', @money_type,
+ 'recur', @money_type,
+ 'sdate', @date_type,
+ 'edate', @date_type,
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['pkgnum', 'invnum'] ],
+ 'index' => [ ['invnum'] ],
+ },
+
+ 'cust_credit' => {
+ 'columns' => [
+ 'crednum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ '_date', @date_type,
+ 'amount', @money_type,
+ 'otaker', 'varchar', '', 8,
+ 'reason', 'text', 'NULL', '',
+ 'closed', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'crednum',
+ 'unique' => [],
+ 'index' => [ ['custnum'] ],
+ },
+
+ 'cust_credit_bill' => {
+ 'columns' => [
+ 'creditbillnum', 'int', '', '',
+ 'crednum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ '_date', @date_type,
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'creditbillnum',
+ 'unique' => [],
+ 'index' => [ ['crednum'], ['invnum'] ],
+ },
+
+ 'cust_main' => {
+ 'columns' => [
+ 'custnum', 'int', '', '',
+ 'agentnum', 'int', '', '',
+# 'titlenum', 'int', 'NULL', '',
+ 'last', 'varchar', '', $char_d,
+# 'middle', 'varchar', 'NULL', $char_d,
+ 'first', 'varchar', '', $char_d,
+ 'ss', 'char', 'NULL', 11,
+ 'company', 'varchar', 'NULL', $char_d,
+ 'address1', 'varchar', '', $char_d,
+ 'address2', 'varchar', 'NULL', $char_d,
+ 'city', 'varchar', '', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'zip', 'varchar', '', 10,
+ 'country', 'char', '', 2,
+ 'daytime', 'varchar', 'NULL', 20,
+ 'night', 'varchar', 'NULL', 20,
+ 'fax', 'varchar', 'NULL', 12,
+ 'ship_last', 'varchar', 'NULL', $char_d,
+# 'ship_middle', 'varchar', 'NULL', $char_d,
+ 'ship_first', 'varchar', 'NULL', $char_d,
+ 'ship_company', 'varchar', 'NULL', $char_d,
+ 'ship_address1', 'varchar', 'NULL', $char_d,
+ 'ship_address2', 'varchar', 'NULL', $char_d,
+ 'ship_city', 'varchar', 'NULL', $char_d,
+ 'ship_county', 'varchar', 'NULL', $char_d,
+ 'ship_state', 'varchar', 'NULL', $char_d,
+ 'ship_zip', 'varchar', 'NULL', 10,
+ 'ship_country', 'char', 'NULL', 2,
+ 'ship_daytime', 'varchar', 'NULL', 20,
+ 'ship_night', 'varchar', 'NULL', 20,
+ 'ship_fax', 'varchar', 'NULL', 12,
+ 'payby', 'char', '', 4,
+ 'payinfo', 'varchar', 'NULL', $char_d,
+ #'paydate', @date_type,
+ 'paydate', 'varchar', 'NULL', 10,
+ 'payname', 'varchar', 'NULL', $char_d,
+ 'tax', 'char', 'NULL', 1,
+ 'otaker', 'varchar', '', 8,
+ 'refnum', 'int', '', '',
+ 'referral_custnum', 'int', 'NULL', '',
+ 'comments', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'custnum',
+ 'unique' => [],
+ #'index' => [ ['last'], ['company'] ],
+ 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ],
+ [ 'daytime' ], [ 'night' ], [ 'fax' ],
+ ],
+ },
+
+ 'cust_main_invoice' => {
+ 'columns' => [
+ 'destnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'dest', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'destnum',
+ 'unique' => [],
+ 'index' => [ ['custnum'], ],
+ },
+
+ 'cust_main_county' => { #county+state+country are checked off the
+ #cust_main_county for validation and to provide
+ # a tax rate.
+ 'columns' => [
+ 'taxnum', 'int', '', '',
+ 'state', 'varchar', 'NULL', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'country', 'char', '', 2,
+ 'taxclass', 'varchar', 'NULL', $char_d,
+ 'exempt_amount', @money_type,
+ 'tax', 'real', '', '', #tax %
+ ],
+ 'primary_key' => 'taxnum',
+ 'unique' => [],
+ # 'unique' => [ ['taxnum'], ['state', 'county'] ],
+ 'index' => [],
+ },
+
+ 'cust_pay' => {
+ 'columns' => [
+ 'paynum', 'int', '', '',
+ #now cust_bill_pay #'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'paid', @money_type,
+ '_date', @date_type,
+ 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
+ # payment type table.
+ 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
+ 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
+ 'closed', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'paynum',
+ 'unique' => [],
+ 'index' => [ [ 'custnum' ], [ 'paybatch' ] ],
+ },
+
+ 'cust_bill_pay' => {
+ 'columns' => [
+ 'billpaynum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'paynum', 'int', '', '',
+ 'amount', @money_type,
+ '_date', @date_type
+ ],
+ 'primary_key' => 'billpaynum',
+ 'unique' => [],
+ 'index' => [ [ 'paynum' ], [ 'invnum' ] ],
+ },
+
+ 'cust_pay_batch' => { #what's this used for again? list of customers
+ #in current CARD batch? (necessarily CARD?)
+ 'columns' => [
+ 'paybatchnum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'last', 'varchar', '', $char_d,
+ 'first', 'varchar', '', $char_d,
+ 'address1', 'varchar', '', $char_d,
+ 'address2', 'varchar', 'NULL', $char_d,
+ 'city', 'varchar', '', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'zip', 'varchar', '', 10,
+ 'country', 'char', '', 2,
+# 'trancode', 'int', '', '',
+ 'cardnum', 'varchar', '', 16,
+ #'exp', @date_type,
+ 'exp', 'varchar', '', 11,
+ 'payname', 'varchar', 'NULL', $char_d,
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'paybatchnum',
+ 'unique' => [],
+ 'index' => [ ['invnum'], ['custnum'] ],
+ },
+
+ 'cust_pkg' => {
+ 'columns' => [
+ 'pkgnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'pkgpart', 'int', '', '',
+ 'otaker', 'varchar', '', 8,
+ 'setup', @date_type,
+ 'bill', @date_type,
+ 'susp', @date_type,
+ 'cancel', @date_type,
+ 'expire', @date_type,
+ 'manual_flag', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'pkgnum',
+ 'unique' => [],
+ 'index' => [ ['custnum'] ],
+ },
+
+ 'cust_refund' => {
+ 'columns' => [
+ 'refundnum', 'int', '', '',
+ #now cust_credit_refund #'crednum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ '_date', @date_type,
+ 'refund', @money_type,
+ 'otaker', 'varchar', '', 8,
+ 'reason', 'varchar', '', $char_d,
+ 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
+ # into payment type table.
+ 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
+ 'paybatch', 'varchar', 'NULL', $char_d,
+ 'closed', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'refundnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ 'cust_credit_refund' => {
+ 'columns' => [
+ 'creditrefundnum', 'int', '', '',
+ 'crednum', 'int', '', '',
+ 'refundnum', 'int', '', '',
+ 'amount', @money_type,
+ '_date', @date_type
+ ],
+ 'primary_key' => 'creditrefundnum',
+ 'unique' => [],
+ 'index' => [ [ 'crednum', 'refundnum' ] ],
+ },
+
+
+ 'cust_svc' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'pkgnum', 'int', 'NULL', '',
+ 'svcpart', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [],
+ 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
+ },
+
+ 'part_pkg' => {
+ 'columns' => [
+ 'pkgpart', 'int', '', '',
+ 'pkg', 'varchar', '', $char_d,
+ 'comment', 'varchar', '', $char_d,
+ 'setup', @perl_type,
+ 'freq', 'int', '', '', #billing frequency (months)
+ 'recur', @perl_type,
+ 'setuptax', 'char', 'NULL', 1,
+ 'recurtax', 'char', 'NULL', 1,
+ 'plan', 'varchar', 'NULL', $char_d,
+ 'plandata', 'text', 'NULL', '',
+ 'disabled', 'char', 'NULL', 1,
+ 'taxclass', 'varchar', 'NULL', $char_d,
+ ],
+ 'primary_key' => 'pkgpart',
+ 'unique' => [],
+ 'index' => [ [ 'disabled' ] ],
+ },
+
+# 'part_title' => {
+# 'columns' => [
+# 'titlenum', 'int', '', '',
+# 'title', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'titlenum',
+# 'unique' => [ [] ],
+# 'index' => [ [] ],
+# },
+
+ 'pkg_svc' => {
+ 'columns' => [
+ 'pkgpart', 'int', '', '',
+ 'svcpart', 'int', '', '',
+ 'quantity', 'int', '', '',
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['pkgpart', 'svcpart'] ],
+ 'index' => [ ['pkgpart'] ],
+ },
+
+ 'part_referral' => {
+ 'columns' => [
+ 'refnum', 'int', '', '',
+ 'referral', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'refnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ 'part_svc' => {
+ 'columns' => [
+ 'svcpart', 'int', '', '',
+ 'svc', 'varchar', '', $char_d,
+ 'svcdb', 'varchar', '', $char_d,
+ 'disabled', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'svcpart',
+ 'unique' => [],
+ 'index' => [ [ 'disabled' ] ],
+ },
+
+ 'part_svc_column' => {
+ 'columns' => [
+ 'columnnum', 'int', '', '',
+ 'svcpart', 'int', '', '',
+ 'columnname', 'varchar', '', 64,
+ 'columnvalue', 'varchar', 'NULL', $char_d,
+ 'columnflag', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'columnnum',
+ 'unique' => [ [ 'svcpart', 'columnname' ] ],
+ 'index' => [ [ 'svcpart' ] ],
+ },
+
+ #(this should be renamed to part_pop)
+ 'svc_acct_pop' => {
+ 'columns' => [
+ 'popnum', 'int', '', '',
+ 'city', 'varchar', '', $char_d,
+ 'state', 'varchar', '', $char_d,
+ 'ac', 'char', '', 3,
+ 'exch', 'char', '', 3,
+ 'loc', 'char', 'NULL', 4, #NULL for legacy purposes
+ ],
+ 'primary_key' => 'popnum',
+ 'unique' => [],
+ 'index' => [ [ 'state' ] ],
+ },
+
+ 'part_pop_local' => {
+ 'columns' => [
+ 'localnum', 'int', '', '',
+ 'popnum', 'int', '', '',
+ 'city', 'varchar', 'NULL', $char_d,
+ 'state', 'char', 'NULL', 2,
+ 'npa', 'char', '', 3,
+ 'nxx', 'char', '', 3,
+ ],
+ 'primary_key' => 'localnum',
+ 'unique' => [],
+ 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ],
+ },
+
+ 'svc_acct' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'username', 'varchar', '', $username_len, #unique (& remove dup code)
+ '_password', 'varchar', '', 50, #13 for encryped pw's plus ' *SUSPENDED* (mp5 passwords can be 34)
+ 'sec_phrase', 'varchar', 'NULL', $char_d,
+ 'popnum', 'int', 'NULL', '',
+ 'uid', 'int', 'NULL', '',
+ 'gid', 'int', 'NULL', '',
+ 'finger', 'varchar', 'NULL', $char_d,
+ 'dir', 'varchar', 'NULL', $char_d,
+ 'shell', 'varchar', 'NULL', $char_d,
+ 'quota', 'varchar', 'NULL', $char_d,
+ 'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
+ 'seconds', 'int', 'NULL', '', #uhhhh
+ 'domsvc', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ #'unique' => [ [ 'username', 'domsvc' ] ],
+ 'unique' => [],
+ 'index' => [ ['username'], ['domsvc'] ],
+ },
+
+# 'svc_acct_sm' => {
+# 'columns' => [
+# 'svcnum', 'int', '', '',
+# 'domsvc', 'int', '', '',
+# 'domuid', 'int', '', '',
+# 'domuser', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'svcnum',
+# 'unique' => [ [] ],
+# 'index' => [ ['domsvc'], ['domuid'] ],
+# },
+
+ #'svc_charge' => {
+ # 'columns' => [
+ # 'svcnum', 'int', '', '',
+ # 'amount', @money_type,
+ # ],
+ # 'primary_key' => 'svcnum',
+ # 'unique' => [ [] ],
+ # 'index' => [ [] ],
+ #},
+
+ 'svc_domain' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'domain', 'varchar', '', $char_d,
+ 'catchall', 'int', 'NULL', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ ['domain'] ],
+ 'index' => [],
+ },
+
+ 'domain_record' => {
+ 'columns' => [
+ 'recnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ #'reczone', 'varchar', '', $char_d,
+ 'reczone', 'varchar', '', 255,
+ 'recaf', 'char', '', 2,
+ 'rectype', 'char', '', 5,
+ #'recdata', 'varchar', '', $char_d,
+ 'recdata', 'varchar', '', 255,
+ ],
+ 'primary_key' => 'recnum',
+ 'unique' => [],
+ 'index' => [ ['svcnum'] ],
+ },
+
+ 'svc_forward' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'srcsvc', 'int', '', '',
+ 'dstsvc', 'int', '', '',
+ 'dst', 'varchar', 'NULL', $char_d,
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [],
+ 'index' => [ ['srcsvc'], ['dstsvc'] ],
+ },
+
+ 'svc_www' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'recnum', 'int', '', '',
+ 'usersvc', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ #'svc_wo' => {
+ # 'columns' => [
+ # 'svcnum', 'int', '', '',
+ # 'svcnum', 'int', '', '',
+ # 'svcnum', 'int', '', '',
+ # 'worker', 'varchar', '', $char_d,
+ # '_date', @date_type,
+ # ],
+ # 'primary_key' => 'svcnum',
+ # 'unique' => [ [] ],
+ # 'index' => [ [] ],
+ #},
+
+ 'prepay_credit' => {
+ 'columns' => [
+ 'prepaynum', 'int', '', '',
+ 'identifier', 'varchar', '', $char_d,
+ 'amount', @money_type,
+ 'seconds', 'int', 'NULL', '',
+ ],
+ 'primary_key' => 'prepaynum',
+ 'unique' => [ ['identifier'] ],
+ 'index' => [],
+ },
+
+ 'port' => {
+ 'columns' => [
+ 'portnum', 'int', '', '',
+ 'ip', 'varchar', 'NULL', 15,
+ 'nasport', 'int', 'NULL', '',
+ 'nasnum', 'int', '', '',
+ ],
+ 'primary_key' => 'portnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ 'nas' => {
+ 'columns' => [
+ 'nasnum', 'int', '', '',
+ 'nas', 'varchar', '', $char_d,
+ 'nasip', 'varchar', '', 15,
+ 'nasfqdn', 'varchar', '', $char_d,
+ 'last', 'int', '', '',
+ ],
+ 'primary_key' => 'nasnum',
+ 'unique' => [ [ 'nas' ], [ 'nasip' ] ],
+ 'index' => [ [ 'last' ] ],
+ },
+
+ 'session' => {
+ 'columns' => [
+ 'sessionnum', 'int', '', '',
+ 'portnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ 'login', @date_type,
+ 'logout', @date_type,
+ ],
+ 'primary_key' => 'sessionnum',
+ 'unique' => [],
+ 'index' => [ [ 'portnum' ] ],
+ },
+
+ 'queue' => {
+ 'columns' => [
+ 'jobnum', 'int', '', '',
+ 'job', 'text', '', '',
+ '_date', 'int', '', '',
+ 'status', 'varchar', '', $char_d,
+ 'statustext', 'text', 'NULL', '',
+ 'svcnum', 'int', 'NULL', '',
+ ],
+ 'primary_key' => 'jobnum',
+ 'unique' => [],
+ 'index' => [ [ 'svcnum' ], [ 'status' ] ],
+ },
+
+ 'queue_arg' => {
+ 'columns' => [
+ 'argnum', 'int', '', '',
+ 'jobnum', 'int', '', '',
+ 'arg', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'argnum',
+ 'unique' => [],
+ 'index' => [ [ 'jobnum' ] ],
+ },
+
+ 'queue_depend' => {
+ 'columns' => [
+ 'dependnum', 'int', '', '',
+ 'jobnum', 'int', '', '',
+ 'depend_jobnum', 'int', '', '',
+ ],
+ 'primary_key' => 'dependnum',
+ 'unique' => [],
+ 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ],
+ },
+
+ 'export_svc' => {
+ 'columns' => [
+ 'exportsvcnum' => 'int', '', '',
+ 'exportnum' => 'int', '', '',
+ 'svcpart' => 'int', '', '',
+ ],
+ 'primary_key' => 'exportsvcnum',
+ 'unique' => [ [ 'exportnum', 'svcpart' ] ],
+ 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ],
+ },
+
+ 'part_export' => {
+ 'columns' => [
+ 'exportnum', 'int', '', '',
+ #'svcpart', 'int', '', '',
+ 'machine', 'varchar', '', $char_d,
+ 'exporttype', 'varchar', '', $char_d,
+ 'nodomain', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'exportnum',
+ 'unique' => [],
+ 'index' => [ [ 'machine' ], [ 'exporttype' ] ],
+ },
+
+ 'part_export_option' => {
+ 'columns' => [
+ 'optionnum', 'int', '', '',
+ 'exportnum', 'int', '', '',
+ 'optionname', 'varchar', '', $char_d,
+ 'optionvalue', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'optionnum',
+ 'unique' => [],
+ 'index' => [ [ 'exportnum' ], [ 'optionname' ] ],
+ },
+
+ 'radius_usergroup' => {
+ 'columns' => [
+ 'usergroupnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ 'groupname', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'usergroupnum',
+ 'unique' => [],
+ 'index' => [ [ 'svcnum' ], [ 'groupname' ] ],
+ },
+
+ 'msgcat' => {
+ 'columns' => [
+ 'msgnum', 'int', '', '',
+ 'msgcode', 'varchar', '', $char_d,
+ 'locale', 'varchar', '', 16,
+ 'msg', 'text', '', '',
+ ],
+ 'primary_key' => 'msgnum',
+ 'unique' => [ [ 'msgcode', 'locale' ] ],
+ 'index' => [],
+ },
+
+ 'cust_tax_exempt' => {
+ 'columns' => [
+ 'exemptnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'taxnum', 'int', '', '',
+ 'year', 'int', '', '',
+ 'month', 'int', '', '',
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'exemptnum',
+ 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ],
+ 'index' => [],
+ },
+
+
+
+ );
+
+ %tables;
+
+}
+
#!/usr/bin/perl -Tw
-# $Id: passwd.import,v 1.8 2003-06-12 14:08:00 ivan Exp $
+# $Id: passwd.import,v 1.5.4.3 2003-06-12 14:08:02 ivan Exp $
use strict;
use vars qw(%part_svc);
--- /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";
+}
+
}
sub myexport_insert { #subroutine, not method
- my( $username, $password ) = @_;
- #do things with $username and $password
}
-
sub myexport_replace { #subroutine, not method
}
-
sub myexport_delete { #subroutine, not method
- my( $username ) = @_;
- #do things with $username
}
+++ /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
-package FS::MailAdminClient;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK $fs_mailadmind_socket);
-use Exporter;
-use Socket;
-use FileHandle;
-use IO::Handle;
-
-$VERSION = '0.01';
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( signup_info authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward new_customer );
-
-$fs_mailadmind_socket = "/usr/local/freeside/fs_mailadmind_socket";
-
-$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
-$ENV{'SHELL'} = '/bin/sh';
-$ENV{'IFS'} = " \t\n";
-$ENV{'CDPATH'} = '';
-$ENV{'ENV'} = '';
-$ENV{'BASH_ENV'} = '';
-
-my $freeside_uid = scalar(getpwnam('freeside'));
-die "not running as the freeside user\n" if $> != $freeside_uid;
-
-=head1 NAME
-
-FS::MailAdminClient - Freeside mail administration client API
-
-=head1 SYNOPSIS
-
- use FS::MailAdminClient qw( signup_info list_mailboxes new_customer );
-
- ( $locales, $packages, $pops ) = signup_info;
-
- ( $accounts ) = list_mailboxes;
-
- $error = new_customer ( {
- 'first' => $first,
- 'last' => $last,
- 'ss' => $ss,
- 'comapny' => $company,
- 'address1' => $address1,
- 'address2' => $address2,
- 'city' => $city,
- 'county' => $county,
- 'state' => $state,
- 'zip' => $zip,
- 'country' => $country,
- 'daytime' => $daytime,
- 'night' => $night,
- 'fax' => $fax,
- 'payby' => $payby,
- 'payinfo' => $payinfo,
- 'paydate' => $paydate,
- 'payname' => $payname,
- 'invoicing_list' => $invoicing_list,
- 'pkgpart' => $pkgpart,
- 'username' => $username,
- '_password' => $password,
- 'popnum' => $popnum,
- } );
-
-=head1 DESCRIPTION
-
-This module provides an API for a remote mail administration server.
-
-It needs to be run as the freeside user. Because of this, the program which
-calls these subroutines should be written very carefully.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item signup_info
-
-Returns three array references of hash references.
-
-The first set of hash references is of allowable locales. Each hash reference
-has the following keys:
- taxnum
- state
- county
- country
-
-The second set of hash references is of allowable packages. Each hash
-reference has the following keys:
- pkgpart
- pkg
-
-The third set of hash references is of allowable POPs (Points Of Presence).
-Each hash reference has the following keys:
- popnum
- city
- state
- ac
- exch
-
-=cut
-
-sub signup_info {
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "signup_info\n";
- SOCK->flush;
-
- chop ( my $n_cust_main_county = <SOCK> );
- my @cust_main_county = map {
- chop ( my $taxnum = <SOCK> );
- chop ( my $state = <SOCK> );
- chop ( my $county = <SOCK> );
- chop ( my $country = <SOCK> );
- {
- 'taxnum' => $taxnum,
- 'state' => $state,
- 'county' => $county,
- 'country' => $country,
- };
- } 1 .. $n_cust_main_county;
-
- chop ( my $n_part_pkg = <SOCK> );
- my @part_pkg = map {
- chop ( my $pkgpart = <SOCK> );
- chop ( my $pkg = <SOCK> );
- {
- 'pkgpart' => $pkgpart,
- 'pkg' => $pkg,
- };
- } 1 .. $n_part_pkg;
-
- chop ( my $n_svc_acct_pop = <SOCK> );
- my @svc_acct_pop = map {
- chop ( my $popnum = <SOCK> );
- chop ( my $city = <SOCK> );
- chop ( my $state = <SOCK> );
- chop ( my $ac = <SOCK> );
- chop ( my $exch = <SOCK> );
- chop ( my $loc = <SOCK> );
- {
- 'popnum' => $popnum,
- 'city' => $city,
- 'state' => $state,
- 'ac' => $ac,
- 'exch' => $exch,
- 'loc' => $loc,
- };
- } 1 .. $n_svc_acct_pop;
-
- close SOCK;
-
- \@cust_main_county, \@part_pkg, \@svc_acct_pop;
-}
-
-=item authenticate
-
-Authentictes against a service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- _password
-
-Returns a scalar error message of the form "authuser OK|FAILED" or an error
-message.
-
-=cut
-
-sub authenticate {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "authenticate", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item list_packages
-
-Returns one array reference of hash references.
-
-The set of hash references is of existing packages. Each hash reference
-has the following keys:
- pkgnum
- domain
- account
-
-=cut
-
-sub list_packages {
- my $user = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_packages\n", $user, "\n";
- SOCK->flush;
-
- chop ( my $n_packages = <SOCK> );
- my @packages = map {
- chop ( my $pkgnum = <SOCK> );
- chop ( my $domain = <SOCK> );
- chop ( my $account = <SOCK> );
- {
- 'pkgnum' => $pkgnum,
- 'domain' => $domain,
- 'account' => $account,
- };
- } 1 .. $n_packages;
-
- close SOCK;
-
- \@packages;
-}
-
-=item list_mailboxes
-
-Returns one array references of hash references.
-
-The set of hash references is of existing accounts. Each hash reference
-has the following keys:
- svcnum
- username
- _password
-
-=cut
-
-sub list_mailboxes {
- my ($user, $package) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_mailboxes\n", $user, "\n", $package, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_acct = <SOCK> );
- my @svc_acct = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $username = <SOCK> );
- chop ( my $_password = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'username' => $username,
- '_password' => $_password,
- };
- } 1 .. $n_svc_acct;
-
- close SOCK;
-
- \@svc_acct;
-}
-
-=item delete_mailbox
-
-Deletes a mailbox service from the remote Freeside system. Requires a hash
-reference as a paramater with the following keys:
- authuser
- account
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub delete_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "delete_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser account
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item password_mailbox
-
-Changes the password for a mailbox service on the remote Freeside system.
- Requires a hash reference as a paramater with the following keys:
- authuser
- account
- _password
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub password_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "password_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser account _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item add_mailbox
-
-Creates a mailbox service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- package
- account
- _password
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub add_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "add_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser package account _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item list_forwards
-
-Returns one array references of hash references.
-
-The set of hash references is of existing forwards. Each hash reference
-has the following keys:
- svcnum
- dest
-
-=cut
-
-sub list_forwards {
- my ($user, $service) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_forwards\n", $user, "\n", $service, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_forward = <SOCK> );
- my @svc_forward = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $dest = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'dest' => $dest,
- };
- } 1 .. $n_svc_forward;
-
- close SOCK;
-
- \@svc_forward;
-}
-
-=item list_pkg_forwards
-
-Returns one array references of hash references.
-
-The set of hash references is of existing forwards. Each hash reference
-has the following keys:
- svcnum
- srcsvc
- dest
-
-=cut
-
-sub list_pkg_forwards {
- my ($user, $package) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_pkg_forwards\n", $user, "\n", $package, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_forward = <SOCK> );
- my @svc_forward = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $srcsvc = <SOCK> );
- chop ( my $dest = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'srcsvc' => $srcsvc,
- 'dest' => $dest,
- };
- } 1 .. $n_svc_forward;
-
- close SOCK;
-
- \@svc_forward;
-}
-
-=item delete_forward
-
-Deletes a forward service from the remote Freeside system. Requires a hash
-reference as a paramater with the following keys:
- authuser
- svcnum
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub delete_forward {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "delete_forward", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser svcnum
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item add_forward
-
-Creates a forward service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- package
- source
- dest
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub add_forward {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "add_forward", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser package source dest
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item new_customer HASHREF
-
-Adds a customer to the remote Freeside system. Requires a hash reference as
-a paramater with the following keys:
- first
- last
- ss
- comapny
- address1
- address2
- city
- county
- state
- zip
- country
- daytime
- night
- fax
- payby
- payinfo
- paydate
- payname
- invoicing_list
- pkgpart
- username
- _password
- popnum
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub new_customer {
- my $hashref = shift;
-
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "new_customer\n";
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- first last ss company address1 address2 city county state zip country
- daytime night fax payby payinfo paydate payname invoicing_list
- pkgpart username _password popnum
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- $error;
-}
-
-=back
-
-=head1 VERSION
-
-$Id: MailAdminClient.pm,v 1.1 2001-10-18 15:04:54 jeff Exp $
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<fs_signupd>, L<FS::SignupServer>, L<FS::cust_main>
-
-=cut
-
-1;
-
+++ /dev/null
-#!/usr/bin/perl
-########################################################################
-# #
-# mailadmin.cgi NCI2000 #
-# Jeff Finucane <jeff@nci2000.net> #
-# 26 April 2001 #
-# #
-########################################################################
-
-use DBI;
-use strict;
-use CGI;
-use FS::MailAdminClient qw(authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward);
-
-my $sessionfile = '/usr/local/apache/htdocs/mailadmin/adminsess'; # session file
-my $tmpdir = '/usr/local/apache/htdocs/mailadmin/tmp'; # Location to store temp files
-my $cookiedomain = ".your.dom"; # domain if THIS server, should prepend with a '.'
-my $cookieexpire = '+12h'; # expire the cookie session after this much idle time
-my $sessexpire = 43200; # expire session after this long of no use (in seconds)
-
-my $body = "<body bgcolor=dddddd>";
-
-#### Should not have to change anything under this line ####
-my $printmainpage = 1;
-my $i = 0;
-my $printheader = 1;
-my $query = new CGI;
-my $cgi = $query->url();
-my $now = getdatetime();
-my $current_package = 0;
-my $current_account = 0;
-my $current_domname = "";
-
-# if they are trying to login we wont check the session yet
-if ($query->param('login') eq '' && $query->param('action') ne 'login') {
- checksession();
- printheader();
-}
-
-if ($query->param('login') ne '') {
-
- my $username = $query->param('username');
- my $password = $query->param('password');
-
- if (!checkuserpass($username, $password)) {
- printheader();
- error('not_admin');
- }
-
- my @alpha = ('A'..'Z', 'a'..'z', 0..9);
- my $sessid = '';
- for (my $i = 0; $i < 10; $i++) {
- $sessid .= @alpha[rand(@alpha)];
- }
-
- my $cookie1 = $query->cookie(-name=>'username',
- -value=>$username,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $cookie2 = $query->cookie(-name=>'ma_sessionid',
- -value=>$sessid,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $now = time();
- open(NEWSESS, ">>$sessionfile") || error('open');
- print NEWSESS "$username $sessid $now 0 0\n";
- close(NEWSESS);
-
- print $query->header(-COOKIE=>[$cookie1, $cookie2]);
-
- $printmainpage = 1;
-
-} elsif ($query->param('action') eq 'blankframe') {
-
- print "<html>$body</body></html>\n";
- $printmainpage = 0;
-
-} elsif ($query->param('action') eq 'list_packages') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- my $list = list_packages($username);
- print "<html>$body\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Package Number</td><td><p>Description</td></tr>\n";
- foreach my $package ( @{$list} ) {
- print "<tr>";
- print "<td></td><td><p>$package->{'pkgnum'}</td><td><p>$package->{'domain'}</td>\n";
- print "<td></td><td><a href=\"$cgi\?action=select&package=$package->{'pkgnum'}&account=$package->{'account'}&domname=$package->{'domain'}\" target=\"rightmainframe\">select</td>\n";
- print "</tr>";
- }
- print "</table>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'list_mailboxes') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $list = list_mailboxes($username, $current_package);
- my $forwardlist = list_pkg_forwards($username, $current_package);
- print "<html>$body\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username</td><td><p>Password</td></tr>\n";
- foreach my $account ( @{$list} ) {
- print "<tr>";
- print "<td></td><td><p>$account->{'username'}</td><td><p>$account->{'_password'}</td>\n";
- print "<td></td><td><a href=\"$cgi\?action=change&account=$account->{'svcnum'}&mailbox=$account->{'username'}\" target=\"rightmainframe\">change</td>\n";
- print "</tr>";
-
-# my $forwardlist = list_forwards($username, $account->{'svcnum'});
-# foreach my $forward ( @{$forwardlist} ) {
-# my $label = qq!=> ! . $forward->{'dest'};
-# print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
-# }
- foreach my $forward ( @{$forwardlist} ) {
- if ($forward->{'srcsvc'} == $account->{'svcnum'}) {
- my $label = qq!=> ! . $forward->{'dest'};
- print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
- }
- }
-
- }
- print "</table>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'select') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- $current_package = $query->param('package');
- $current_account = $query->param('account');
- $current_domname = $query->param('domname');
- set_package();
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center>\n";
- print "<p>Selected package $current_package\n";
- print "</center>\n";
- print "</form>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'change') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
- my $list = list_forwards($username, $account);
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username</td><td><p>$mailbox</td></tr>\n";
- print "<input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=hidden name=\"mailbox\" value=\"$mailbox\">\n";
- foreach my $forward ( @{$list} ) {
- my $label = qq!=> ! . $forward->{'dest'};
-# print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
- print "<tr><td></td><td></td><td><p>$label</td><td><a href=\"$cgi\?action=deleteforward&service=$forward->{'svcnum'}&mailbox=$mailbox&dest=$forward->{'dest'}\" target=\"rightmainframe\">remove</td></tr>\n";
- }
- print "<tr><td></td><td><p>Password</td><td><input type=text name=\"_password\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"deleteaccount\" value=\"Delete This User\">\n";
- print "<input type=submit name=\"changepassword\" value=\"Change The Password\">\n";
- print "<input type=submit name=\"addforward\" value=\"Add Forwarding\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p> You may delete this user and all mailforwarding by pressing <B>Delete This User</B>.\n";
- print "<p> To set or change the password for this user, type the new password in the box next to <B>Password</B> and press <B>Change The Password</B>.\n";
- print "<p> If you would like to have mail destined for this user forwarded to another email address then press the <B>Add Forwarding</B> button.\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteaccount') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<p>Are you certain you want to delete user $mailbox?\n";
- print "<p><input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=submit name=\"deleteaccounty\" value=\"Confirm\">\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteaccounty') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
-
- if ( my $error = delete_mailbox ( {
- 'authuser' => $username,
- 'account' => $account,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Deleted\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('changepassword') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $_password = $query->param('_password');
-
- if ( my $error = password_mailbox ( {
- 'authuser' => $username,
- 'account' => $account,
- '_password' => $_password,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Changed\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'newmailbox') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username </td><td><input type=text name=\"account\" value=\"\"></td><td>@ " . $current_domname . "</td></tr>\n";
- print "<tr><td></td><td><p>Password</td><td><input type=text name=\"_password\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"addmailbox\" value=\"Add This User\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p>Use this screen to add a new mailbox user. If the domain name of the email address (the part after the <B>@</B> sign) is not what you expect then you may need to use <B>List Packages</B> to select the package with the correct domain.\n";
- print "<p>Enter the first portion of the email address in the box adjacent to <B>Username</B> and enter the password for that user in the space next to <B>Password</B>. Then press the button labeled <B>Add The User</B>.\n";
- print "<p>If you do not want to add a new user at this time then select a choice from the menu at the left, such as <B>List Mailboxes</B>.\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('addmailbox') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $_password = $query->param('_password');
-
- if ( my $error = add_mailbox ( {
- 'authuser' => $username,
- 'package' => $current_package,
- 'account' => $account,
- '_password' => $_password,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Created\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'deleteforward') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $svcnum = $query->param('service');
- my $mailbox = $query->param('mailbox');
- my $dest = $query->param('dest');
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<p>Are you certain you want to remove the forwarding from $mailbox to $dest?\n";
- print "<p><input type=hidden name=\"service\" value=\"$svcnum\">\n";
- print "<input type=submit name=\"deleteforwardy\" value=\"Confirm\">\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteforwardy') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $service = $query->param('service');
-
- if ( my $error = delete_forward ( {
- 'authuser' => $username,
- 'svcnum' => $service,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Forwarding Removed\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('addforward') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
-
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=hidden name=\"mailbox\" value=\"$mailbox\">\n";
- print "<tr><td>Forward mail from </td><td><p>$mailbox:</td><td> to </td></tr>\n";
- print "<tr><td></td><td><p>Destination:</td><td><input type=text name=\"dest\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"addforwarddst\" value=\"Add the Forwarding\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p> If you would like mail originally destined for the above address to be forwarded to a different email address then type that email address in the box next to <B>Destination:</B> and press the <B>Add the Forwarding</B> button.\n";
- print "<p> If you do not want to add mail forwarding then select a choice from the menu at the left, such as <B>List Accounts</B>.\n";
-
- $printmainpage=0;
-
-} elsif ($query->param('addforwarddst') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $dest = $query->param('dest');
-
- if ( my $error = add_forward ( {
- 'authuser' => $username,
- 'package' => $current_package,
- 'source' => $account,
- 'dest' => $dest,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Forwarding Created\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'navframe') {
-
- print "<html><body bgcolor=bbbbbb>\n";
- print "<center><h2>NCI2000 MAIL ADMIN Web Interface</h2></center>\n";
-
- print "<br><center>Choose Action:</center><br>\n";
- print "<center><table border=0>\n";
- print "<ul>\n";
- print "<tr><td><li><a href=\"$cgi\?action=logout\" target=\"_top\">Log Off</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=list_packages\" target=\"rightmainframe\">List Packages</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=list_mailboxes\" target=\"rightmainframe\">List Accounts</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=newmailbox\" target=\"rightmainframe\">Add Account</a></td><tr>\n";
- print "</ul>\n";
- print "</table></center>\n";
-
- print "<br><br><br>\n";
- print "</body></html>\n";
-
- $printmainpage = 0;
-
-} elsif ($query->param('action') eq 'rightmainframe') {
-
- print "<html>$body\n";
- print "<br><br><br>\n";
- print "<font size=4><----- Please choose function on the left menu</font>\n";
- print "<br><br>\n";
- print "<p> Choose <B>Log Off</B> when you are finished. This helps prevent unauthorized access to your accounts.\n";
- print "<p> Use <B>List Packages</B> when you administer multiple packages. When you have multiple domains at NCI2000 you are likely to have multiple packages. Use of <B>List Packages</B> is not necessary if administer only one package.\n";
- print "<p> Use <B>List Accounts</B> to view your current arrangement of mailboxes. From this list you my choose to make changes to existing mailboxes or delete mailboxes. If you would like to modify the forwarding associated with a mailbox then choose it from this list.\n";
- print "<p> Use <B>Add Account</B> when you would like an additional mailbox. After you have added the mailbox you may choose to make additional changes from the list provided by <B>List Accounts<B>.\n";
- print "</body></html>\n";
-
- $printmainpage = 0;
-
-}
-
-
-if ($query->param('action') eq 'login') {
-
- printheader();
- printlogin();
-
-} elsif ($query->param('action') eq 'logout') {
-
- destroysession();
- printheader();
- printlogin();
-
-} elsif ($printmainpage) {
-
-
- print "<html><head><title>NCI2000 MAIL ADMIN Web Interface</title></head>\n";
- print "<FRAMESET cols=\"160,*\" BORDER=\"3\">\n";
- print "<FRAME NAME=\"navframe\" src=\"$cgi?action=navframe\">\n";
- print "<FRAME NAME=\"rightmainframe\" src=\"$cgi?action=rightmainframe\">\n";
- print "</FRAMESET>\n";
- print "</html>\n";
-
-
-}
-
-sub getdatetime {
- my $today = localtime(time());
- my ($day,$mon,$dayofmon,$time,$year) = split(/\s+/,$today);
- my @datemonths = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
-
- my $numidx = "01";
- my ($nummon);
- foreach my $mons (@datemonths) {
- if ($mon eq $mons) {
- $nummon = $numidx;
- }
- $numidx++;
- }
-
- return "$year-$nummon-$dayofmon $time";
-
-}
-
-sub error {
-
- my $error = shift;
- my $arg1 = shift;
-
- printheader();
-
- if ($error eq 'not_admin') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>Unauthorized attempt to access mail administration.</font>\n";
- print "<br><font face=arial>Please login again if you think this is an error.</font>\n";
- print "<form><input type=button value=\"<<Back\" OnClick=\"history.back()\"></form>\n";
- print "</body></html>\n";
- } elsif ($error eq 'exists') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>The user you are trying to enter already exists. Please go back and enter a different username</font>\n";
- print "</font></body></html>\n";
- } elsif ($error eq 'ingroup') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>This user is already in the group <i>$arg1</i>. Please go back and deselect group <i>$arg1</i> from the list.</font>\n";
- print "<form><input type=button value=\"<<Back\" OnClick=\"history.back()\"></form>\n";
- print "</font></body></html>\n";
- } elsif ($error eq 'sess_expired') {
- print "<html>$body\n";
- print "<center><font size=4>Your session has expired.</font></center>\n";
- print "<br><br><center>Please login again <a href=\"$cgi\?action=login\" target=\"_top\"> HERE</a></center>\n";
- print "</body></html>\n";
- } elsif ($error eq 'open') {
- print "<html>$body\n";
- print "<center><font size=4>Unable to open or rename file.</font></center>\n";
- print "<br><br><center>If this continues, please contact your administrator</center>\n";
- print "</body></html>\n";
- }
-
-
- exit;
-
-}
-
-
-#print a html header if not printed yet
-sub printheader {
-
- if ($printheader) {
- print "Content-Type: text/html\n\n";
- $printheader = 0;
- }
-
-}
-
-
-#verify user can access administration
-sub checksession {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- print NEWSESS "$user $sess $now $pkgnum $svcdomain $domname\n";
- $current_package=$pkgnum;
- $current_account=$svcdomain;
- $current_domname=$domname;
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- my $cookie1 = $query->cookie(-name=>'username',
- -value=>$username,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $cookie2 = $query->cookie(-name=>'ma_sessionid',
- -value=>$sessionid,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- print $query->header(-COOKIE=>[$cookie1, $cookie2]);
-
- $printheader = 0;
-
- return 0;
-
-}
-
-sub destroysession {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- $printheader = 0;
-
- return 0;
-
-}
-
-# checks the username and pass against the database
-sub checkuserpass {
-
- my $username = shift;
- my $password = shift;
-
- my $error = authenticate ( {
- 'authuser' => $username,
- '_password' => $password,
- } );
-
- if ($error eq "$username OK") {
- return 1;
- }else{
- return 0;
- }
-
-}
-
-#printlogin prints a login page
-sub printlogin {
-
- print "<html>$body\n";
- print "<center><font size=4>Please login to access MAIL ADMIN</font></center>\n";
- print "<form action=\"$cgi\" method=post>\n";
- print "<center>Email Address: <input type=text name=\"username\">\n";
- print "<br>Email Password: <input type=password name=\"password\">\n";
- print "<br><input type=submit name=\"login\" value=\"Login\">\n";
- print "</form></center>\n";
- print "</body></html>\n";
-}
-
-
-#select_package chooses a administrable package if more than one exists
-sub select_package {
- my $user = shift;
- my $packages = list_packages($user);
- if (scalar(@{$packages}) eq 1) {
- $current_package = @{$packages}[0]->{'pkgnum'};
- set_package();
- }
- if (scalar(@{$packages}) > 1) {
-# print $query->redirect("$cgi\?action=list_packages");
- print "<p>No package selected. You must first <a href=\"$cgi\?action=list_packages\" target=\"rightmainframe\">select a package</a>.\n";
- exit;
- }
-}
-
-sub set_package {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- print NEWSESS "$user $sess $time $current_package $current_account $current_domname\n";
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- $printheader = 0;
-
- return 0;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-
-eval 'exec /usr/bin/perl -Tw -S $0 ${1+"$@"}'
- if 0; # not running under some shell
-#
-# fs_mailadmind
-#
-# This is run REMOTELY over ssh by fs_mailadmin_server.
-#
-
-use strict;
-use Socket;
-
-use vars qw( $Debug );
-
-$Debug = 0;
-
-my($fs_mailadmind_socket)="/usr/local/freeside/fs_mailadmind_socket";
-
-$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
-$ENV{'SHELL'} = '/bin/sh';
-$ENV{'IFS'} = " \t\n";
-$ENV{'CDPATH'} = '';
-$ENV{'ENV'} = '';
-$ENV{'BASH_ENV'} = '';
-
-$|=1;
-
-warn "[fs_mailadmind] Reading locales...\n" if $Debug;
-chomp( my $n_cust_main_county = <STDIN> );
-my @cust_main_county = map {
- chomp( my $taxnum = <STDIN> );
- chomp( my $state = <STDIN> );
- chomp( my $county = <STDIN> );
- chomp( my $country = <STDIN> );
- {
- 'taxnum' => $taxnum,
- 'state' => $state,
- 'county' => $county,
- 'country' => $country,
- };
-} ( 1 .. $n_cust_main_county );
-
-warn "[fs_mailadmind] Reading package definitions...\n" if $Debug;
-chomp( my $n_part_pkg = <STDIN> );
-my @part_pkg = map {
- chomp( my $pkgpart = <STDIN> );
- chomp( my $pkg = <STDIN> );
- {
- 'pkgpart' => $pkgpart,
- 'pkg' => $pkg,
- };
-} ( 1 .. $n_part_pkg );
-
-warn "[fs_mailadmind] Reading POPs...\n" if $Debug;
-chomp( my $n_svc_acct_pop = <STDIN> );
-my @svc_acct_pop = map {
- chomp( my $popnum = <STDIN> );
- chomp( my $city = <STDIN> );
- chomp( my $state = <STDIN> );
- chomp( my $ac = <STDIN> );
- chomp( my $exch = <STDIN> );
- chomp( my $loc = <STDIN> );
- {
- 'popnum' => $popnum,
- 'city' => $city,
- 'state' => $state,
- 'ac' => $ac,
- 'exch' => $exch,
- 'loc' => $loc,
- };
-} ( 1 .. $n_svc_acct_pop );
-
-warn "[fs_mailadmind] Creating $fs_mailadmind_socket\n" if $Debug;
-my $uaddr = sockaddr_un($fs_mailadmind_socket);
-my $proto = getprotobyname('tcp');
-socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
-unlink($fs_mailadmind_socket);
-bind(Server, $uaddr) or die "bind: $!";
-listen(Server,SOMAXCONN) or die "listen: $!";
-
-warn "[fs_mailadmind] Entering main loop...\n" if $Debug;
-my $paddr;
-for ( ; $paddr = accept(Client,Server); close Client) {
-
- chop( my $command = <Client> );
-
- if ( $command eq "signup_info" ) {
- warn "[fs_mailadmind] sending signup info...\n" if $Debug;
- print Client join("\n", $n_cust_main_county,
- map {
- $_->{taxnum},
- $_->{state},
- $_->{county},
- $_->{country},
- } @cust_main_county
- ), "\n";
-
- print Client join("\n", $n_part_pkg,
- map {
- $_->{pkgpart},
- $_->{pkg},
- } @part_pkg
- ), "\n";
-
- print Client join("\n", $n_svc_acct_pop,
- map {
- $_->{popnum},
- $_->{city},
- $_->{state},
- $_->{ac},
- $_->{exch},
- $_->{loc},
- } @svc_acct_pop
- ), "\n";
-
- } elsif ( $command eq "new_customer" ) {
- warn "[fs_mailadmind] reading customer signup...\n" if $Debug;
- my(
- $first, $last, $ss, $company, $address1, $address2, $city, $county,
- $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
- $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
- $popnum,
- ) = map { scalar(<Client>) } ( 1 .. 23 );
-
- warn "[fs_mailadmind] sending customer data to remote server...\n" if $Debug;
- print
- $first, $last, $ss, $company, $address1, $address2, $city, $county,
- $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
- $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
- $popnum,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "authenticate" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading authentication material...\n" if $Debug;
- chop( my $password = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "authenticate\n", $user, "\n", $password, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "list_packages" ) {
- warn "[fs_mailadmind] reading user information to list_packages...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_packages\n", $user, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_packages = <STDIN> );
- my @packages = map {
- chomp( my $pkgnum = <STDIN> );
- chomp( my $domain = <STDIN> );
- chomp( my $account = <STDIN> );
- {
- 'pkgnum' => $pkgnum,
- 'domain' => $domain,
- 'account' => $account,
- };
- } ( 1 .. $n_packages );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_packages,
- map {
- $_->{pkgnum},
- $_->{domain},
- $_->{account},
- } @packages
- ), "\n";
-
- } elsif ( $command eq "list_mailboxes" ) {
- warn "[fs_mailadmind] reading user information to list_mailboxes...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading package number to list_mailboxes...\n" if $Debug;
- chop( my $package = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_mailboxes\n", $user, "\n", $package, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_acct = <STDIN> );
- my @svc_acct = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $username = <STDIN> );
- chomp( my $_password = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'username' => $username,
- '_password' => $_password,
- };
- } ( 1 .. $n_svc_acct );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_acct,
- map {
- $_->{svcnum},
- $_->{username},
- $_->{_password},
- } @svc_acct
- ), "\n";
-
- } elsif ( $command eq "delete_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to delete...\n" if $Debug;
- chop( my $account = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "delete_mailbox\n", $user, "\n", $account, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "password_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to password...\n" if $Debug;
- my(
- $account, $_password,
- ) = map { scalar(<Client>) } ( 1 .. 2 );
-
- warn "[fs_mailadmind] sending password data to remote server...\n" if $Debug;
- print "password_mailbox", "\n";
- print
- $user, "\n", $account, $_password,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "add_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to create...\n" if $Debug;
- my(
- $package, $account, $_password,
- ) = map { scalar(<Client>) } ( 1 .. 3 );
-
- warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug;
- print "add_mailbox", "\n";
- print
- $user, "\n", $package, $account, $_password,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "add_forward" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading forward information to create...\n" if $Debug;
- my(
- $package, $source, $dest,
- ) = map { scalar(<Client>) } ( 1 .. 3 );
-
- warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug;
- print "add_forward", "\n";
- print
- $user, "\n", $package, $source, $dest,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "delete_forward" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading forward information to delete...\n" if $Debug;
- chop( my $service = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "delete_forward\n", $user, "\n", $service, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "list_forwards" ) {
- warn "[fs_mailadmind] reading user information to list_forwards...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug;
- chop( my $service = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_forwards\n", $user, "\n", $service, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_forward = <STDIN> );
- my @svc_forward = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $dest = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'dest' => $dest,
- };
- } ( 1 .. $n_svc_forward );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_forward,
- map {
- $_->{svcnum},
- $_->{dest},
- } @svc_forward
- ), "\n";
-
- } elsif ( $command eq "list_pkg_forwards" ) {
- warn "[fs_mailadmind] reading user information to list_pkg_forwards...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug;
- chop( my $package = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_pkg_forwards\n", $user, "\n", $package, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_forward = <STDIN> );
- my @svc_forward = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $srcsvc = <STDIN> );
- chomp( my $dest = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'srcsvc' => $srcsvc,
- 'dest' => $dest,
- };
- } ( 1 .. $n_svc_forward );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_forward,
- map {
- $_->{svcnum},
- $_->{srcsvc},
- $_->{dest},
- } @svc_forward
- ), "\n";
-
- } else {
- die "unexpected command from client: $command";
- }
-
-}
-
+++ /dev/null
-
-This collection of files implements a 'self-administered mail service.'
-Configuration is similar to fs_signupd
-
-Additionally you will need to modify the database:
-
-CREATE TABLE svc_acct_admin (
- svcnum int primary key,
- adminsvc int not null
-);
-
-creating both as keys might be good
-
-(and perform the dbdef-create)
-
-
-As it exists now, a package containing one svc_domain, at least one
-svc_acct_admin, and other services can have its svc_acct's and svc_forward's
-manipulated by the svc_acct referenced by a svc_acct_admin in the package.
-
-One svc_acct may be referenced as svc_acct_admin for multiple packages.
-
-fs_mailadmin_server contains hard coded references to service numbers which
-will require editing for your system.
-
-It's not a lot, but it might provide inspiration.
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# fs_mailadmin_server
-#
-
-use strict;
-use IO::Handle;
-use FS::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_county;
-use FS::cust_main;
-use FS::svc_acct_admin;
-
-use vars qw( $opt $Debug $conf $default_domain );
-
-$Debug = 1;
-
-#my @payby = qw(CARD PREPAY);
-
-my $user = shift or die &usage;
-&adminsuidsetup( $user );
-
-$conf = new FS::Conf;
-$default_domain = $conf->config('domain');
-
-my $machine = shift or die &usage;
-
-my $agentnum = shift or die &usage;
-my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage;
-my $pkgpart = $agent->pkgpart_hashref;
-
-my $refnum = shift or die &usage;
-
-#causing trouble for some folks
-#$SIG{CHLD} = sub { wait() };
-
-my($fs_mailadmind)=$conf->config('fs_mailadmind');
-
-while (1) {
- my($reader,$writer)=(new IO::Handle, new IO::Handle);
- $writer->autoflush(1);
- warn "[fs_mailadmin_server] Connecting to $machine...\n" if $Debug;
- sshopen2($machine,$reader,$writer,$fs_mailadmind);
-
- my $data;
-
- warn "[fs_mailadmin_server] Sending locales...\n" if $Debug;
- my @cust_main_county = qsearch('cust_main_county', {} );
- print $writer $data = join("\n",
- ( scalar(@cust_main_county) || die "no tax rates (cust_main_county records)" ),
- map {
- $_->taxnum,
- $_->state,
- $_->county,
- $_->country,
- } @cust_main_county
- ),"\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Sending package definitions...\n" if $Debug;
- my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
- qsearch( 'part_pkg', {} );
- print $writer $data = join("\n",
- ( scalar(@part_pkg) || die "no usable package definitions, agent $agentnum" ),
- map {
- $_->pkgpart,
- $_->pkg,
- } @part_pkg
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Sending POPs...\n" if $Debug;
- my @svc_acct_pop = qsearch ('svc_acct_pop',{} );
- print $writer $data = join("\n",
- ( scalar(@svc_acct_pop) || die "No points of presence (svc_acct_pop records)" ),
- map {
- $_->popnum,
- $_->city,
- $_->state,
- $_->ac,
- $_->exch,
- $_->loc,
- } @svc_acct_pop
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Entering main loop...\n" if $Debug;
-COMMAND: while (1) {
- warn "[fs_mailadmin_server] Reading (waiting for) command...\n" if $Debug;
- chop( my($command, $user) = map { scalar(<$reader>) } ( 1 .. 2 ) );
- my $domain = $default_domain;
- $user =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/;
- ($user, $domain) = ($1, $2);
-
- if ($command eq 'authenticate'){
- warn "[fs_mailadmin_server] Processing authenticate command for $user \n" if $Debug;
- chop( my($password) = map { scalar(<$reader>) } ( 1 .. 1 ) );
-
- my $error = '';
-
- my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain });
-
- if (scalar(@svc_domain) != 1) {
- warn "Nonexistant or duplicate service account for \"$domain\"";
- next COMMAND;
- }
-
- my @svc_acct = qsearchs('svc_acct', { 'username' => $user,
- 'domsvc' => $svc_domain[0]->svcnum });
- if (scalar(@svc_acct) != 1) {
- die "Nonexistant or duplicate service account for \"$user\"";
- next COMMAND;
- }
-
- if ($svc_acct[0]->_password eq $password) {
- $error = "$user\@$domain OK";
- }else{
- $error = "$user\@$domain FAILED";
- }
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
- }
- elsif ($command eq 'list_packages'){
- warn "[fs_mailadmin_server] Processing list_packages command for $user \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my %packages;
- my %accounts;
-
- foreach my $package (@packages) {
- $packages{my $pkgnum = $package->getfield('pkgnum')} = $default_domain;
- $accounts{$pkgnum} = 0;
- my @services = qsearch('cust_svc', { 'pkgnum' => $pkgnum });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '4'){
- my $account=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') });
- $packages{$pkgnum}=$account->getfield('domain');
- $accounts{$pkgnum}=$account->getfield('svcnum');
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(keys(%packages)) ),
- map {
- $_,
- $packages{$_},
- $accounts{$_},
- } keys(%packages)
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- }elsif ($command eq 'list_mailboxes'){
-
- warn "[fs_mailadmin_server] Processing list_mailboxes command for $user" if $Debug;
- chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "package $pkgnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @accounts;
-
- foreach my $package (@packages) {
- next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '2'){
- my $account=qsearchs('svc_acct', { 'svcnum' => $service->getfield('svcnum') });
-# $accounts[$#accounts+1]=$account->getfield('username');
- $accounts[$#accounts+1]=$account;
- }
- }
- }
-
- print $writer $data = join("\n",
-# ( scalar(@accounts) || die "No accounts (svc_acct records)" ),
- ( scalar(@accounts) ),
- map {
- $_->svcnum,
-# $_->username,
- $_->email,
-# $_->_password,
- '*****',
- } @accounts
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- } elsif ($command eq 'delete_mailbox'){
- warn "[fs_mailadmin_server] Processing delete_mailbox command for $user " if $Debug;
- chop( my($account) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "account $account \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error;
- if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' };
- if (! $error && check_administrator(\@packages, $svc_acct[0])){
-# not sure about the next three lines... do we delete? or return error
- foreach my $svc_forward (qsearch('svc_forward', { 'dstsvc' => $svc_acct[0]->getfield('svcnum') })) {
- $error ||= $svc_forward->delete;
- }
- foreach my $svc_forward (qsearch('svc_forward', { 'srcsvc' => $svc_acct[0]->getfield('svcnum') })) {
- $error ||= $svc_forward->delete;
- }
- $error ||= $svc_acct[0]->delete;
- } else {
- $error ||= "Illegal attempt to remove service";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'password_mailbox'){
- warn "[fs_mailadmin_server] Processing password_mailbox command for $user " if $Debug;
- chop( my($account, $_password) = map { scalar(<$reader>) } ( 1 .. 2 ) );
- warn "account $account with password $_password \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error;
- if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account.' };
-
- if (! $error && check_administrator(\@packages, $svc_acct[0])){
- my $new = new FS::svc_acct ({$svc_acct[0]->hash});
- $new->setfield('_password' => $_password);
- $error ||= $new->replace($svc_acct[0]);
- } else {
- $error ||= "Illegal attempt to change password";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'add_mailbox'){
- warn "[fs_mailadmin_server] Processing add_mailbox command for $user " if $Debug;
- chop( my($target_package, $account, $_password) = map { scalar(<$reader>) } ( 1 .. 3 ) );
- warn "in package $target_package account $account with password $_password \n" if $Debug;
-
- my $found_package;
- my $domainsvc=0;
- my $svcpart=2; # this is 'email box'
- my $svcpartsm=3; # this is 'domain alias'
- my $error = '';
- my $found = 0;
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- foreach my $package (@packages) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- $found_package=$package;
- my @services = qsearch('cust_svc', { 'pkgnum' => $target_package });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '4'){
- my @svc_domain=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') });
- if (scalar(@svc_domain) eq 1) {
- $domainsvc=$svc_domain[0]->getfield('svcnum');
- }
- }
- }
- last;
- }
- }
- warn "User $user does not have administration rights to package $target_package\n" unless $found;
- $error ||= "User $user does not have administration rights to package $target_package\n" unless $found;
-
- my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')});
-
- #list of services this pkgpart includes (although at the moment we only care
- # about $svcpart
- my $pkg_svc;
- my %pkg_svc = ();
- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
- }
-
- my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'),
- 'svcpart' => $svcpart,
- });
-
- if (scalar(@services) >= $pkg_svc{$svcpart}) {
- $error="Maximum allowed already reached.";
- }
-
- my $svc_acct = new FS::svc_acct ( {
- 'pkgnum' => $found_package->pkgnum,
- 'svcpart' => $svcpart,
- 'username' => $account,
- 'domsvc' => $domainsvc,
- '_password' => $_password,
- } );
-
- my $y = $svc_acct->setdefault; # arguably should be in new method
- $error ||= $y unless ref($y);
- #and just in case you were silly
- $svc_acct->pkgnum($found_package->pkgnum);
- $svc_acct->svcpart($svcpart);
- $svc_acct->username($account);
- $svc_acct->domsvc($domainsvc);
- $svc_acct->_password($_password);
-
- $error ||= $svc_acct->check;
-
- if ( ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $error ||= $svc_acct->insert;
- warn "WARNING: $error on pre-checked svc_acct record!" if $error;
- }
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- }elsif ($command eq 'list_forwards'){
-
- warn "[fs_mailadmin_server] Processing list_forwards command for $user" if $Debug;
- chop( my($svcnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "service $svcnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @forwards;
-
- foreach my $package (@packages) {
-# next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '10'){
- my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') });
- $forwards[$#forwards+1]=$forward if ($forward->getfield('srcsvc') == $svcnum);
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(@forwards) ),
- map {
- $_->svcnum,
- ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst),
- } @forwards
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- }elsif ($command eq 'list_pkg_forwards'){
-
- warn "[fs_mailadmin_server] Processing list_pkg_forwards command for $user" if $Debug;
- chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "package $pkgnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @forwards;
-
- foreach my $package (@packages) {
- next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '10'){
- my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') });
- $forwards[$#forwards+1]=$forward;
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(@forwards) ),
- map {
- $_->svcnum,
- $_->srcsvc,
- ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst),
- } @forwards
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- } elsif ($command eq 'delete_forward'){
- warn "[fs_mailadmin_server] Processing delete_forward command for $user " if $Debug;
- chop( my($forward) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "forward $forward \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_forward = qsearchs('svc_forward', { 'svcnum' => $forward }) unless $error;
- if (scalar(@svc_forward) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' };
- if (! $error && check_administrator(\@packages, $svc_forward[0])){
-# not sure about the next three lines... do we delete? or return error
- $error ||= $svc_forward[0]->delete;
- } else {
- $error ||= "Illegal attempt to remove service";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'add_forward'){
- warn "[fs_mailadmin_server] Processing add_forward command for $user " if $Debug;
- chop( my($target_package, $source, $dest) = map { scalar(<$reader>) } ( 1 .. 3 ) );
- warn "in package $target_package source $source with destination $dest \n" if $Debug;
-
- my $found_package;
- my $domainsvc=0;
- my $svcpart=10; # this is 'forward service'
- my $error = '';
- my $found = 0;
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- foreach my $package (@packages) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- $found_package=$package;
- last;
- }
- }
- warn "User $user does not have administration rights to package $target_package\n" unless $found;
- $error ||= "User $user does not have administration rights to package $target_package\n" unless $found;
-
- my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $source });
- warn "Forwarding source $source does not exist.\n" unless $svc_acct;
- $error ||= "Forwarding source $source does not exist.\n" unless $svc_acct;
-
- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $source });
- warn "Forwarding source $source not attached to any account.\n" unless $cust_svc;
- $error ||= "Forwarding source $source not attached to any account.\n" unless $cust_svc;
-
- if ( ! $error ) {
- warn "Forwarding source $source is not in package $target_package\n"
- unless ($cust_svc->getfield('pkgnum') == $target_package);
- $error ||= "Forwarding source $source is not in package $target_package\n"
- unless ($cust_svc->getfield('pkgnum') == $target_package);
- }
-
- my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')});
-
- #list of services this pkgpart includes (although at the moment we only care
- # about $svcpart
- my $pkg_svc;
- my %pkg_svc = ();
- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
- }
-
- my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'),
- 'svcpart' => $svcpart,
- });
-
- if (scalar(@services) >= $pkg_svc{$svcpart}) {
- $error="Maximum allowed already reached.";
- }
-
- my $svc_forward = new FS::svc_forward ( {
- 'pkgnum' => $found_package->pkgnum,
- 'svcpart' => $svcpart,
- 'srcsvc' => $source,
- 'dstsvc' => 0,
- 'dst' => $dest,
- } );
-
- my $y = $svc_forward->setdefault; # arguably should be in new method
- $error ||= $y unless ref($y);
- #and just in case you were silly
- $svc_forward->pkgnum($found_package->pkgnum);
- $svc_forward->svcpart($svcpart);
- $svc_forward->srcsvc($source);
- $svc_forward->dstsvc(0);
- $svc_forward->dst($dest);
-
- $error ||= $svc_forward->check;
-
- if ( ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $error ||= $svc_forward->insert;
- warn "WARNING: $error on pre-checked svc_forward record!" if $error;
- }
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } else {
- warn "[fs_mailadmin_server] Bad command: $command \n" if $Debug;
- print $writer "Bad command \n";
- }
- }
- close $writer;
- close $reader;
- warn "connection to $machine lost! waiting 60 seconds...\n";
- sleep 60;
- warn "reconnecting...\n";
-}
-
-sub usage {
- die "Usage:\n\n fs_mailadmin_server user machine agentnum refnum\n";
-}
-
-#sub find_administrable_packages {
-# my $user = shift;
-#
-# my $error = '';
-#
-# my @svc_acct = qsearchs('svc_acct', { 'username' => $user });
-# if (scalar(@svc_acct) != 1) {
-# die "Nonexistant or duplicate service account for \"$user\"";
-# }
-#
-# my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct[0]->getfield('svcnum') });
-# if (scalar(@cust_svc) != 1 ) {
-# die "Nonexistant or duplicate customer service for \"$user\"";
-# }
-#
-# my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
-# if (scalar(@cust_pkg) != 1) {
-# die "Nonexistant or duplicate customer package for \"$user\"";
-# }
-#
-# my @cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg[0]->getfield('custnum') });
-# if (scalar(@cust_main) != 1 ) {
-# die "Nonexistant or duplicate customer for \"$user\"";
-# }
-#
-# my @packages = $cust_main[0]->ncancelled_pkgs;
-#}
-
-sub find_administrable_packages {
- my $user = shift;
- my $domain = shift;
-
- my @packages;
- my $error = '';
-
- my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain });
-
- if (scalar(@svc_domain) != 1) {
- die "Nonexistant or duplicate service account for \"$domain\"";
- }
-
- my @svc_acct = qsearchs('svc_acct', { 'username' => $user,
- 'domsvc' => $svc_domain[0]->svcnum });
- if (scalar(@svc_acct) != 1) {
- die "Nonexistant or duplicate service account for \"$user\"";
- }
-
- my @svc_acct_admin = qsearch('svc_acct_admin', {'adminsvc' => $svc_acct[0]->getfield('svcnum') });
- die "Nonexistant or duplicate customer service for \"$user\"" unless scalar(@svc_acct_admin);
-
- foreach my $svc_acct_admin (@svc_acct_admin) {
- my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_admin->getfield('svcnum') });
- if (scalar(@cust_svc) != 1 ) {
- die "Nonexistant or duplicate customer service for admin \"$svc_acct_admin->getfield('svcnum')\"";
- }
-
- my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
- if (scalar(@cust_pkg) != 1) {
- die "Nonexistant or duplicate customer package for admin \"$user\"";
- }
-
- push @packages, $cust_pkg[0] unless $cust_pkg[0]->getfield('cancel');
-
- }
- (@packages);
-}
-
-sub check_administrator {
- my ($allowed_packages_aref, $svc_acct_ref) = @_;
-
- my $error = '';
- my $found = 0;
-
- {
- my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_ref->getfield('svcnum') });
- if (scalar(@cust_svc) != 1 ) {
- warn "Nonexistant or duplicate customer service for \"$svc_acct_ref->getfield('username')\"";
- last;
- }
-
- my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
- if (scalar(@cust_pkg) != 1) {
- warn "Nonexistant or duplicate customer package for \"$svc_acct_ref->getfield('username')\"";
- last;
- }
-
- foreach my $package (@$allowed_packages_aref) {
- if ($package->getfield('pkgnum') eq $cust_pkg[0]->getfield('pkgnum')) {
- $found = 1;
- last;
- }
- }
- }
-
- $found;
-}
-
-sub check_add {
- my ($allowed_packages_aref, $target_package) = @_;
-
- my $error = '';
- my $found = 0;
-
- foreach my $package (@$allowed_packages_aref) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- last;
- }
- }
-
- $found;
-}
-
#!/bin/sh
-kill `cat /var/run/freeside-selfservice-server.fs_selfservice.pid`
-
( cd ..; make deploy; cd fs_selfservice )
cd FS-SelfService
perl Makefile.PL && make && make install
+cd ..
+kill `cat /var/run/freeside-selfservice-server.ivan.pid`; sleep 3
+./freeside-selfservice-server ivan localhost
+
cp /home/ivan/freeside/fs_selfservice/FS-SelfService/cgi/* /var/www/MyAccount
chown freeside /var/www/MyAccount/selfservice.cgi
chmod 755 /var/www/MyAccount/selfservice.cgi
$socket = "/usr/local/freeside/selfservice_socket";
%autoload = (
- 'passwd' => 'passwd/passwd',
- 'chfn' => 'passwd/passwd',
- 'chsh' => 'passwd/passwd',
- 'login' => 'MyAccount/login',
- 'customer_info' => 'MyAccount/customer_info',
- 'invoice' => 'MyAccount/invoice',
- 'cancel' => 'MyAccount/cancel',
- 'payment_info' => 'MyAccount/payment_info',
- 'process_payment' => 'MyAccount/process_payment',
+ 'passwd' => 'passwd/passwd',
+ 'chfn' => 'passwd/passwd',
+ 'chsh' => 'passwd/passwd',
+ 'login' => 'MyAccount/login',
+ 'customer_info' => 'MyAccount/customer_info',
+ 'invoice' => 'MyAccount/invoice',
+ 'cancel' => 'MyAccount/cancel',
);
@EXPORT_OK = keys %autoload;
<TH ALIGN="right">Username </TH>
<TD>
<!-- <INPUT TYPE="text" NAME="username" VALUE="<%= $username %>"> -->
- <INPUT TYPE="text" NAME="username" VALUE="hslink">
+ <INPUT TYPE="text" NAME="username" VALUE="awctwincities-l">
</TD>
</TR>
<TR>
<TH ALIGN="right">Password </TH>
<TD>
<!-- <INPUT TYPE="password" NAME="password"> -->
- <INPUT TYPE="password" NAME="password" VALUE="UwjM5zdb">
+ <INPUT TYPE="password" NAME="password" VALUE="6lrnsfCc">
</TD>
</TR>
</TABLE>
<!-- <A HREF="<%= $url %>other">SomethingElse</A><BR> -->
</TD><TD VALIGN="top">
<FONT SIZE=4>Make a payment</FONT><BR><BR>
-<FORM NAME="OneTrueForm" METHOD="POST" ACTION="<%=$selfurl%>" onSubmit="document.OneTrueForm.process.disabled=true">
+<FORM METHOD="POST" ACTION="<%=$selfurl%>">
<INPUT TYPE="hidden" NAME="session" VALUE="<%=$session_id%>">
-<INPUT TYPE="hidden" NAME="action" VALUE="payment_results">
-<TABLE BGCOLOR="#cccccc">
-<TR>
- <TD ALIGN="right">Amount Due</TD>
- <TD>
- <TABLE><TR><TD BGCOLOR="#ffffff">
- $<%=sprintf("%.2f",$balance)%>
- </TD></TR></TABLE>
- </TD>
-</TR>
-<TR>
- <TD ALIGN="right">Payment amount</TD>
- <TD>
- <TABLE><TR><TD BGCOLOR="#ffffff">
- $<INPUT TYPE="text" NAME="amount" SIZE=8 VALUE="<%=sprintf("%.2f",$balance)%>">
- </TD></TR></TABLE>
- </TD>
-</TR><TR>
- <TD ALIGN="right">Card type</TD>
- <TD>
- <SELECT NAME="card_type"><OPTION></OPTION>
- <%= foreach ( keys %card_types ) {
- $selected = $card_type eq $card_types{$_} ? ' SELECTED' : '';
- $OUT .= qq(<OPTION$selected VALUE="). $card_types{$_}. qq(">$_\n);
- } %>
- </SELECT>
- </TD>
-</TD><TR>
- <TD ALIGN="right">Card number</TD>
- <TD>
- <TABLE>
- <TR>
- <TD>
- <INPUT TYPE="text" NAME="payinfo" SIZE=20 MAXLENGTH=19 VALUE="<%=$payinfo%>"> </TD>
- <TD>Exp.</TD>
- <TD>
- <SELECT NAME="month">
- <%= for ( ( map "0$_", 1 .. 9 ), 11, 12 ) {
- $OUT .= '<OPTION'. ($_ eq $month ? ' SELECTED' : ''). ">$_\n";
- } %>
- </SELECT>
- </TD>
- <TD> / </TD>
- <TD>
- <SELECT NAME="year">
- <%= for ( 2003 .. 2012 ) {
- $OUT .= '<OPTION'. ($_ eq $year ? ' SELECTED' : ''). ">$_\n";
- } %>
- </SELECT>
- </TD>
- </TR>
- </TABLE>
- </TD>
-</TR><TR>
- <TD ALIGN="right">Exact name on card</TD>
- <TD><INPUT TYPE="text" SIZE=32 MAXLENGTH=80 NAME="payname" VALUE="<%=$payname%>"></TD>
-</TR><TR>
- <TD ALIGN="right">Card billing address</TD>
- <TD>
- <INPUT TYPE="text" SIZE=40 MAXLENGTH=80 NAME="address1" VALUE="<%=$address1%>">
- </TD>
-</TR><TR>
- <TD ALIGN="right">Address line 2</TD>
- <TD>
- <INPUT TYPE="text" SIZE=40 MAXLENGTH=80 NAME="address2" VALUE="<%=$address2%>">
- </TD>
-</TR><TR>
- <TD ALIGN="right">City</TD>
- <TD>
- <TABLE>
- <TR>
- <TD>
- <INPUT TYPE="text" NAME="city" SIZE="12" MAXLENGTH=80 VALUE="<%=$city%>">
- </TD>
- <TD>State</TD>
- <TD>
- <SELECT NAME="state">
- <%= for ( @states ) {
- $OUT .= '<OPTION'. ($_ eq $state ? ' SELECTED' : '' ). ">$_\n";
- } %>
- </SELECT>
- </TD>
- <TD>Zip</TD>
- <TD>
- <INPUT TYPE="text" NAME="zip" SIZE=11 MAXLENGTH=10 VALUE="<%=$zip%>">
- </TD>
- </TR>
- </TABLE>
- </TD>
-</TR><TR>
- <TD COLSPAN=2>
- <INPUT TYPE="checkbox" CHECKED NAME="save" VALUE="1">
- Remember this information
- </TD>
-</TR><TR>
- <TD COLSPAN=2>
- <INPUT TYPE="checkbox"<%= $payby eq 'CARD' ? ' CHECKED' : '' %> NAME="auto" VALUE="1" onClick="if (this.checked) { document.OneTrueForm.save.checked=true; }">
- Charge future payments to this card automatically
- </TD>
-</TR>
-</TABLE>
-<BR>
-<INPUT TYPE="hidden" NAME="paybatch" VALUE="<%=$paybatch%>">
-<INPUT TYPE="submit" NAME="process" VALUE="Process payment"> <!-- onClick="this.disabled=true"> -->
+<INPUT TYPE="hidden" NAME="action" VALUE="process_payment">
+Amount: <INPUT TYPE="text" VALUE="<%=sprintf("%.2f",$balance)%>"><BR><BR>
+<INPUT TYPE="submit" VALUE="Process payment">
</FORM>
</TD></TR></TABLE>
<HR>
</TD><TD VALIGN="top">
Hello <%= $name %>!<BR><BR>
-<%= $small_custview %>
+Your contact information<BR><%= $small_custview %>
<BR>
-<%= if ( $balance > 0 ) {
- $OUT .= qq! <B><A HREF="${url}make_payment">Make a payment</A></B><BR><BR>!;
+<%= if ( $balance ) {
+ $OUT .= qq! <B><A HREF="${url}make_payment">Make a $balance payment</A></B>!;
} %>
+<BR><BR>
+<!--<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">
+<TR><TH>Invoice</TH><TH>Date</TH><TH>Owed</TH></TR>-->
<%=
if ( @open_invoices ) {
$OUT .= '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=2 BGCOLOR="#eeeeee">'.
+++ /dev/null
-<HTML><HEAD><TITLE>MyAccount</TITLE></HEAD>
-<BODY BGCOLOR="#eeeeee"><FONT SIZE=5>MyAccount</FONT><BR><BR>
-<%= $url = "$selfurl?session=$session_id;action="; ''; %>
-<TABLE BORDER=0 CELLPADDING=4><TR><TD VALIGN="top" HEIGHT=384 BGCOLOR="#dddddd">
-<A HREF="<%= $url %>myaccount">MyAccount</A><BR>
-<!-- <A HREF="<%= $url %>other">SomethingElse</A><BR> -->
-</TD><TD VALIGN="top">
-<FONT SIZE=4>Payment results</FONT><BR><BR>
-<%= if ( $error ) {
- $OUT .= qq!<FONT SIZE="+1" COLOR="#ff0000">Error processing your payment: $error</FONT>!;
-} else {
- $OUT .= 'Your payment was processed sucessfully. Thank you.';
-} %>
-</TD></TR></TABLE>
-<HR>
-<FONT SIZE="-2">powered by <a href="http://www.sisd.com/freeside">freeside</a></FONT>
-</BODY></HTML>
-
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Text::Template;
-use FS::SelfService qw( login customer_info invoice payment_info
- process_payment );
+use FS::SelfService qw(login customer_info invoice);
$template_dir = '.';
$session_id = $cgi->param('session');
-$cgi->param('action') =~
- /^(myaccount|view_invoice|make_payment|payment_results)$/
+$cgi->param('action') =~ /^(myaccount|view_invoice|make_payment)$/
or die "unknown action ". $cgi->param('action');
my $action = $1;
#warn $result->{'open_invoices'};
#warn scalar(@{$result->{'open_invoices'}});
-warn "processing template $action\n";
do_template($action, {
'session_id' => $session_id,
%{$result}
}
sub make_payment {
- payment_info( 'session_id' => $session_id );
-}
-
-sub payment_results {
-
- use Business::CreditCard;
-
- $cgi->param('amount') =~ /^\s*(\d+(\.\d{2})?)\s*$/
- or die "illegal amount"; #!!!
- my $amount = $1;
-
- my $payinfo = $cgi->param('payinfo');
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
- or die "illegal card"; #!!!
- $payinfo = $1;
- validate($payinfo)
- #or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
- or die "invalid card"; #!!!
- cardtype($payinfo) eq $cgi->param('card_type')
- #or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type');
- or die "not a ". $cgi->param('card_type');
-
- $cgi->param('month') =~ /^(\d{2})$/ or die "illegal month";
- my $month = $1;
- $cgi->param('year') =~ /^(\d{4})$/ or die "illegal year";
- my $year = $1;
-
- $cgi->param('payname') =~ /^(.{0,80})$/ or die "illegal payname";
- my $payname = $1;
-
- $cgi->param('address1') =~ /^(.{0,80})$/ or die "illegal address1";
- my $address1 = $1;
-
- $cgi->param('address2') =~ /^(.{0,80})$/ or die "illegal address2";
- my $address2 = $1;
-
- $cgi->param('city') =~ /^(.{0,80})$/ or die "illegal city";
- my $city = $1;
-
- $cgi->param('state') =~ /^(.{2})$/ or die "illegal state";
- my $state = $1;
-
- $cgi->param('zip') =~ /^(.{0,10})$/ or die "illegal zip";
- my $zip = $1;
-
- my $save = 0;
- $save = 1 if $cgi->param('save');
-
- my $auto = 0;
- $auto = 1 if $cgi->param('auto');
-
- $cgi->param('paybatch') =~ /^([\w\-\.]+)$/ or die "illegal paybatch";
- my $paybatch = $1;
-
- process_payment(
- 'session_id' => $session_id,
- 'amount' => $amount,
- 'payinfo' => $payinfo,
- 'month' => $month,
- 'year' => $year,
- 'payname' => $payname,
- 'address1' => $address1,
- 'address2' => $address2,
- 'city' => $city,
- 'state' => $state,
- 'zip' => $zip,
- 'save' => $save,
- 'auto' => $auto,
- 'paybatch' => $paybatch,
- );
}
#!/usr/bin/perl -Tw
#
-# $Id: signup.cgi,v 1.43 2003-07-04 03:21:42 ivan Exp $
+# $Id: signup.cgi,v 1.29.2.14 2003-07-04 03:21:41 ivan Exp $
use strict;
use vars qw( @payby $cgi $locales $packages
%pop = ();
%popnum2pop = ();
foreach (@$pops) {
- push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_;
+ #push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_;
+ push @{ $pop{ $_->{state} } }, $_;
$popnum2pop{$_->{popnum}} = $_;
}
}
$payby = $cgi->param('payby');
- if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) {
+ if ( $payby eq 'CHEK' ) {
#$payinfo = join('@', map { $cgi->param( $payby. "_payinfo$_" ) } (1,2) );
- $payinfo = $cgi->param($payby. '_payinfo1'). '@'.
- $cgi->param($payby. '_payinfo2');
+ $payinfo = $cgi->param('CHEK_payinfo1').'@'.$cgi->param('CHEK_payinfo2');
} else {
$payinfo = $cgi->param( $payby. '_payinfo' );
}
$password = $cgi->param('_password');
$popnum = $cgi->param('popnum');
#$agentnum, # = $cgi->param('agentnum'),
- $init_popstate = $cgi->param('init_popstate');
+ $init_popstate = $cgi->param('init_popstate');
if ( $cgi->param('_password') ne $cgi->param('_password2') ) {
$error = $init_data->{msgcat}{passwords_dont_match}; #msgcat
} else {
$password2 = $cgi->param('_password2');
- if ( $payby =~ /^(CARD|DCRD)$/ && $cgi->param('CARD_type') ) {
+ if ( $payby eq 'CARD' && $cgi->param('CARD_type') ) {
$payinfo =~ s/\D//g;
$payinfo =~ /^(\d{13,16})$/
$address1 = '';
$address2 = '';
$city = '';
- $state = $init_data->{statedefault};
+ $state = $cgi->param('init_popstate') || $init_data->{statedefault};
$county = '';
$country = $init_data->{countrydefault};
$zip = '';
#horrible false laziness with FS/FS/svc_acct_pop.pm::popselector
sub popselector {
-
- my( $popnum ) = @_;
+ my( $popnum, $state ) = @_;
return '<INPUT TYPE="hidden" NAME="popnum" VALUE="">' unless @$pops;
return $pops->[0]{city}. ', '. $pops->[0]{state}.
if scalar(@$pops) == 1;
#my %pop = ();
- #my %popnum2pop = ();
- #foreach (@$pops) {
- # push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_;
- # $popnum2pop{$_->{popnum}} = $_;
- #}
+ #push @{ $pop{$_->{state}} }, $_ foreach @$pops;
- my $text = <<END;
- <SCRIPT>
- function opt(what,href,text) {
- var optionName = new Option(text, href, false, false)
- var length = what.length;
- what.options[length] = optionName;
- }
-END
+ my $text;
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
- }
-
- 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";
- if ($ac eq $cgi->param('popac')) {
- $text .= "what.form.popac.options[what.form.popac.length-1].selected = true;\n";
+ <SCRIPT>
+ function opt(what,href,text) {
+ var optionName = new Option(text, href, false, false)
+ var length = what.length;
+ what.options[length] = optionName;
}
- }
- $text .= "}\n" unless $init_popstate;
- }
- $text .= "popac_changed(what.form.popac)}\n";
-
- $text .= <<END;
- function popac_changed(what) {
- ac = what.options[what.selectedIndex].text;
- what.form.popnum.options.length = 0;
- what.form.popnum.options[0] = new Option("City", "-1", false, true);
-
+ function popstate_changed(what) {
+ state = what.options[what.selectedIndex].text;
+ what.form.popnum.options.length = 0;
+ what.form.popnum.options[0] = new Option("", "", false, true);
END
- foreach my $state ( @states ) {
- foreach my $popac ( keys %{ $pop{$state} } ) {
- $text .= "\nif ( ac == \"$popac\" ) {\n";
+ foreach my $popstate ( sort { $a cmp $b } keys %pop ) {
+ $text .= "\nif ( state == \"$popstate\" ) {\n";
- foreach my $pop ( @{$pop{$state}->{$popac}}) {
+ foreach my $pop ( @{$pop{$popstate}}) {
my $o_popnum = $pop->{popnum};
my $poptext = $pop->{city}. ', '. $pop->{state}.
' ('. $pop->{ac}. ')/'. $pop->{exch}. '-'. $pop->{loc};
- $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n";
- if ($popnum == $o_popnum) {
- $text .= "what.form.popnum.options[what.form.popnum.length-1].selected = true;\n";
- }
+ $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n"
}
$text .= "}\n";
}
- }
-
-
- $text .= "}\n</SCRIPT>\n";
-
- $text .=
- 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 } @states;
- $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD>';
- $text .=
- qq!<SELECT NAME="popac" SIZE=1 onChange="popac_changed(this)">!.
- qq!<OPTION>Area code</SELECT></TR><TR VALIGN="top">!;
+ $text .= "}\n</SCRIPT>\n";
- $text .= qq!<TR><TD><SELECT NAME="popnum" SIZE=1 STYLE="width: 20em"><OPTION>City!;
+ $text .=
+ qq!<SELECT NAME="popstate" SIZE=1 onChange="popstate_changed(this)">!.
+ qq!<OPTION> !;
+ $text .= "<OPTION>$_" foreach sort { $a cmp $b } keys %pop;
+ $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>';
+ }
+ $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !;
- #comment this block to disable initial list polulation
+ #comment this block to disable initial list population
my @initial_select = ();
- if ( scalar( @$pops ) > 100 ) {
- push @initial_select, $popnum2pop{$popnum} if $popnum2pop{$popnum};
+ if ( $init_popstate ) {
+ @initial_select = grep { $_->{state} eq $init_popstate } @$pops;
} else {
- @initial_select = @$pops;
+ 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}. '"'.
$pop->{city}. ', '. $pop->{state}.
' ('. $pop->{ac}. ')/'. $pop->{exch}. '-'. $pop->{loc};
}
-
- $text .= qq!</SELECT></TD></TR></TABLE>!;
+ $text .= '</SELECT>';
$text;
-
}
sub expselect {
my %payby = (
'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD"). qq!<BR><font color="#ff0000">*</font>Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
- 'DCRD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="DCRD_payinfo" VALUE="" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("DCRD"). qq!<BR><font color="#ff0000">*</font>Name on card<BR><INPUT TYPE="text" NAME="DCRD_payname" VALUE="">!,
'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="" MAXLENGTH=10><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="">!,
- 'DCHK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="DCHK_payinfo1" VALUE="" MAXLENGTH=10><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="DCHK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="DCHK_month" VALUE="12"><INPUT TYPE="hidden" NAME="DCHK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="DCHK_payname" VALUE="">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR><font color="#ff0000">*</font>Exp !. expselect("BILL", "12-2037"). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR><font color="#ff0000">*</font>Exp !. expselect("COMP"),
my( $account, $aba ) = split('@', $payinfo);
my %paybychecked = (
'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD", $paydate). qq!<BR><font color="#ff0000">*</font>Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
- 'DCRD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="DCRD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("DCRD", $paydate). qq!<BR><font color="#ff0000">*</font>Name on card<BR><INPUT TYPE="text" NAME="DCRD_payname" VALUE="$payname">!,
'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="$account" MAXLENGTH=10><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="$payname">!,
- 'DCHK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="DCHK_payinfo1" VALUE="$account" MAXLENGTH=10><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="DCHK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="DCHK_month" VALUE="12"><INPUT TYPE="hidden" NAME="DCHK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="DCHK_payname" VALUE="$payname">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="$payinfo" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR><font color="#ff0000">*</font>Exp !. expselect("BILL", $paydate). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR><font color="#ff0000">*</font>Exp !. expselect("COMP", $paydate),
-BEGIN { eval "use Devel::AutoProfiler;"; } #only if installed...
-#BEGIN { package Devel::AutoProfiler; use vars qw(%caller_info); }
-#use Devel::AutoProfiler;
-
use strict;
use vars qw( $cgi $p );
use CGI;
#use CGI::Carp qw(fatalsToBrowser);
use Date::Format;
use Date::Parse;
-use Time::Local;
use Tie::IxHash;
use HTML::Entities;
use IO::Handle;
use IO::File;
use String::Approx qw(amatch);
-use Chart::LinesPoints;
use HTML::Widgets::SelectLayers 0.02;
use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
use FS::Record qw(qsearch qsearchs fields dbdef);
use FS::Conf;
use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
- small_custview myexit http_header);
+ small_custview myexit);
use FS::Msgcat qw(gettext geterror);
use FS::agent;
use FS::part_pkg;
use FS::part_referral;
use FS::part_svc;
-use FS::part_svc_router;
use FS::pkg_svc;
use FS::port;
use FS::queue qw(joblisting);
use FS::session;
use FS::svc_acct;
use FS::svc_acct_pop qw(popselector);
+use FS::svc_acct_sm;
use FS::svc_domain;
use FS::svc_forward;
use FS::svc_www;
-use FS::router;
-use FS::part_router_field;
-use FS::router_field;
-use FS::addr_block;
-use FS::part_sb_field;
-use FS::sb_field;
-use FS::svc_broadband;
use FS::type_pkgs;
use FS::part_export;
use FS::part_export_option;
&cgisuidsetup($cgi);
$p = popurl(2);
#print $cgi->header( '-expires' => 'now' );
- dbh->{'private_profile'} = {} if dbh->can('sprintProfile');
-
- #really should check for FS::Profiler or something
- # Devel::AutoProfiler _our_ VERSION? thanks a fucking lot
- if ( Devel::AutoProfiler->can('__recursively_fetch_subs_in_package') ) {
- #should check to see it's my special version. well, switch to FS::Profiler
-
- #nicked from Devel::AutoProfiler::INIT
- my %subs = Devel::AutoProfiler::__recursively_fetch_subs_in_package('main');
-
-
- SUB : while( my ($name, $ref) = each(%subs) )
- {
- #next if $name =~ /^(main::)?Apache::/;
- next unless $name =~ /FS/;
- foreach my $sub (@Devel::AutoProfiler::do_not_instrument_this_sub)
- {
- if ($name =~ /$sub/)
- {
- next SUB;
- }
- }
- next if ($Devel::AutoProfiler::do_not_instrument_this_sub{$name});
- #warn "INIT name is $name \n";
- Devel::AutoProfiler::__instrument_sub($name, $ref);
- }
-
- }
-
}
sub Script_OnFlush {
my $ref = $Response->{BinaryRef};
- #$$ref = $cgi->header( @FS::CGI::header ) . $$ref;
- #$$ref = $cgi->header() . $$ref;
- #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";
+ $$ref = $cgi->header( @FS::CGI::header ) . $$ref;
+ if ( dbh->can('sprintProfile') ) {
+
+ $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i
+ or warn "can't remove";
- #$$ref .= '<PRE>'. ("\n"x96). encode_entities(dbh->sprintProfile()). '</PRE>';
- # wtf? konqueror...
- $$ref .= '<PRE>'. ("\n"x4096). encode_entities(dbh->sprintProfile()).
- "\n\n". &sprintAutoProfile(). '</PRE>';
+ #$$ref .= '<PRE>'. ("\n"x96). encode_entities(dbh->sprintProfile()). '</PRE>';
+ # wtf? konqueror...
+ $$ref .= '<PRE>'. ("\n"x4096). encode_entities(dbh->sprintProfile()). '</PRE>';
- $$ref .= '</BODY></HTML>';
- }
+ $$ref .= '</BODY></HTML>';
+
dbh->{'private_profile'} = {};
}
}
-
-#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( $self, $location) = @_;
- my $page =
- $cgi->header.
- qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A><BR><BR>!.
- '<PRE>'. encode_entities(dbh->sprintProfile()).
- "\n\n". &sprintAutoProfile(). '</PRE>'.
- '</BODY></HTML>';
- dbh->{'private_profile'} = {};
- return $page;
- };
-
-}
-
-sub by_total_time
-{
- return $a->{total_time_in_sub} <=> $b->{total_time_in_sub};
-}
-
-sub sprintAutoProfile {
- my %caller_info = %Devel::AutoProfiler::caller_info;
- return unless keys %caller_info;
-
- %Devel::AutoProfiler::caller_info = ();
-
- my @keys = keys(%caller_info);
-
- foreach my $key (@keys)
- {
- my $href = $caller_info{$key};
-
- $href->{who_am_i} = $key;
- }
-
- my @subs = values(%caller_info);
-
- #my @sorted = sort by_total_time ( @subs );
- my @sorted = reverse sort by_total_time ( @subs );
-
- # print Dumper \@sorted;
-
- my @readable_info;
-
- foreach my $sort (@sorted)
- {
- push(@readable_info, delete($sort->{who_am_i}));
- push(@readable_info, $sort);
- }
-
- use Data::Dumper;
- return encode_entities(Dumper(\@readable_info));
-
-}
-
-1;
-
#use CGI::Carp qw(fatalsToBrowser);
use Date::Format;
use Date::Parse;
- use Time::Local;
use Tie::IxHash;
use HTML::Entities;
use IO::Handle;
use IO::File;
use String::Approx qw(amatch);
- use Chart::LinesPoints;
use HTML::Widgets::SelectLayers 0.02;
use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
use FS::Record qw(qsearch qsearchs fields dbdef);
use FS::Conf;
use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
- small_custview myexit http_header);
+ small_custview myexit);
use FS::Msgcat qw(gettext geterror);
use FS::agent;
use FS::part_pkg;
use FS::part_referral;
use FS::part_svc;
- use FS::part_svc_router;
use FS::pkg_svc;
use FS::port;
use FS::queue qw(joblisting);
use FS::svc_domain;
use FS::svc_forward;
use FS::svc_www;
- use FS::router;
- use FS::part_router_field;
- use FS::router_field;
- use FS::addr_block;
- use FS::part_sb_field;
- use FS::sb_field;
- use FS::svc_broadband;
use FS::type_pkgs;
use FS::part_export;
use FS::part_export_option;
+++ /dev/null
-<%= header('Address Blocks', menubar('Main Menu' => $p)) %>
-<%
-
-use NetAddr::IP;
-
-my @addr_block = qsearch('addr_block', {});
-my @router = qsearch('router', {});
-my $block;
-my $p2 = popurl(2);
-my $path = $p2 . "edit/process/addr_block";
-
-%>
-
-<% if ($cgi->param('error')) { %>
- <FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT>
- <BR><BR>
-<% } %>
-
-<%=table()%>
-
-<% foreach $block (sort {$a->NetAddr cmp $b->NetAddr} @addr_block) { %>
- <TR>
- <TD><%=$block->NetAddr%></TD>
- <% if (my $router = $block->router) { %>
- <% if (scalar($block->svc_broadband) == 0) { %>
- <TD>
- <%=$router->routername%>
- </TD>
- <TD>
- <FORM ACTION="<%=$path%>/deallocate.cgi" METHOD="POST">
- <INPUT TYPE="hidden" NAME="blocknum" VALUE="<%=$block->blocknum%>">
- <INPUT TYPE="submit" NAME="submit" VALUE="Deallocate">
- </FORM>
- </TD>
- <% } else { %>
- <TD COLSPAN="2">
- <%=$router->routername%>
- </TD>
- <% } %>
- <% } else { %>
- <TD>
- <FORM ACTION="<%=$path%>/allocate.cgi" METHOD="POST">
- <INPUT TYPE="hidden" NAME="blocknum" VALUE="<%=$block->blocknum%>">
- <SELECT NAME="routernum" SIZE="1">
- <% foreach (@router) { %>
- <OPTION VALUE="<%=$_->routernum %>"><%=$_->routername%></OPTION>
- <% } %>
- </SELECT>
- <INPUT TYPE="submit" NAME="submit" VALUE="Allocate">
- </FORM>
- </TD>
- <TD>
- <FORM ACTION="<%=$path%>/split.cgi" METHOD="POST">
- <INPUT TYPE="hidden" NAME="blocknum" VALUE="<%=$block->blocknum%>">
- <INPUT TYPE="submit" NAME="submit" VALUE="Split">
- </FORM>
- </TD>
- </TR>
-<% }
- } %>
- <TR><TD COLSPAN="3"><BR></TD></TR>
- <TR>
- <FORM ACTION="<%=$path%>/add.cgi" METHOD="POST">
- <TD>Gateway/Netmask</TD>
- <TD>
- <INPUT TYPE="text" NAME="ip_gateway" SIZE="15">/<INPUT TYPE="text" NAME="ip_netmask" SIZE="2">
- </TD>
- <TD>
- <INPUT TYPE="submit" NAME="submit" VALUE="Add">
- </TD>
- </FORM>
- </TR>
-</TABLE>
-</BODY>
-</HTML>
-
<TH><FONT SIZE=-1>Country</FONT></TH>
<TH><FONT SIZE=-1>State</FONT></TH>
<TH>County</TH>
- <TH>Taxclass<BR><FONT SIZE=-1>(per-package classification)</FONT></TH>
- <TH>Tax name<BR><FONT SIZE=-1>(printed on invoices)</FONT></TH>
+ <TH>Taxclass</TH>
<TH><FONT SIZE=-1>Tax</FONT></TH>
<TH><FONT SIZE=-1>Exempt<BR>per<BR>month</TH>
</TR>
}
print "</TD>";
- print "<TD";
- if ( $hashref->{taxname} ) {
- print ' BGCOLOR="#ffffff">'. $hashref->{taxname};
- } else {
- print ' BGCOLOR="#cccccc">Tax';
- }
- print "</TD>";
-
print "<TD BGCOLOR=\"#ffffff\">$hashref->{tax}%</TD>".
'<TD BGCOLOR="#ffffff">$'.
sprintf("%.2f", $hashref->{exempt_amount} || 0). '</TD>'.
+++ /dev/null
-<%
-
-use FS::Record qw(qsearch dbdef);
-use DBIx::DBSchema;
-use DBIx::DBSchema::Table;
-
-my $error;
-my $p2 = popurl(2);
-my ($table) = $cgi->keywords;
-my $dbdef = dbdef or die "Cannot fetch dbdef!";
-my $dbdef_table = $dbdef->table($table) or die "Cannot fetch schema for $table";
-
-my $pkey = $dbdef_table->primary_key or die "Cannot fetch pkey for $table";
-print header("Browse $table", menubar('Main Menu' => $p));
-
-my @rec = qsearch($table, {});
-my @col = $dbdef_table->columns;
-
-if ($cgi->param('error')) { %>
- <FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT>
- <BR><BR>
-<% }
-%>
-<A HREF="<%=$p2%>edit/<%=$table%>.cgi"><I>Add a new <%=$table%></I></A><BR><BR>
-
-<%=table()%>
-<TH>
-<% foreach (grep { $_ ne $pkey } @col) {
- %><TD><%=$_%></TD>
- <% } %>
-</TH>
-<% foreach $rec (sort {$a->getfield($pkey) cmp $b->getfield($pkey) } @rec) {
- %>
- <TR>
- <TD>
- <A HREF="<%=$p2%>edit/<%=$table%>.cgi?<%=$rec->getfield($pkey)%>">
- <%=$rec->getfield($pkey)%></A> </TD> <%
- foreach $col (grep { $_ ne $pkey } @col) { %>
- <TD><%=$rec->getfield($col)%></TD> <% } %>
- </A>
- </TR>
-<% } %>
-</TABLE>
-</BODY>
-</HTML>
-
+++ /dev/null
-<%= header('svc_broadband extended fields', menubar('Main Menu' => $p)) %>
-<%
-
-my @psf = qsearch('part_sb_field', {});
-my $block;
-my $p2 = popurl(2);
-
-%>
-
-<% if ($cgi->param('error')) { %>
- <FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT>
- <BR><BR>
-<% } %>
-
-<A HREF="<%=$p2%>edit/part_sb_field.cgi"><I>Add a new field</I></A><BR><BR>
-
-<%=table()%>
-<TH><TD>Field name</TD><TD>Service type</TD></TH>
-<% foreach $psf (sort {$a->name cmp $b->name} @psf) { %>
- <TR>
- <TD></TD>
- <TD>
- <A HREF="<%=$p2%>edit/part_sb_field.cgi?<%=$psf->sbfieldpart%>">
- <%=$psf->name%></A></TD>
- <TD><%=$psf->part_svc->svc%></TD>
- </TR>
-<% } %>
-</TABLE>
-</BODY>
-</HTML>
-
+++ /dev/null
-<%= header('Routers', menubar('Main Menu' => $p)) %>
-<%
-
-my @router = qsearch('router', {});
-my $p2 = popurl(2);
-
-%>
-
-<% if ($cgi->param('error')) { %>
- <FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT>
- <BR><BR>
-<% } %>
-
-<A HREF="<%=$p2%>edit/router.cgi"><I>Add a new router</I></A><BR><BR>
-
-<%=table()%>
-<!-- <TH><TD>Field name</TD><TD>Field value</TD></TH> -->
-<% foreach $router (sort {$a->routernum <=> $b->routernum} @router) { %>
- <TR>
-<!-- <TD ROWSPAN="<%=scalar($router->router_field) + 2%>"> -->
- <TD>
- <A HREF="<%=$p2%>edit/router.cgi?<%=$router->routernum%>"><%=$router->routername%></A>
- </TD>
- <!--
- <% foreach (sort { $a->part_router_field->name cmp $b->part_router_field->name } $router->router_field ) { %>
- <TR>
- <TD BGCOLOR="#cccccc" ALIGN="right"><%=$_->part_router_field->name%></TD>
- <TD BGCOLOR="#ffffff"><%=$_->value%></TD>
- </TR>
- <% } %>
- -->
- </TR>
-<% } %>
-</TABLE>
-</BODY>
-</HTML>
-
<img src="overview.png">
<ul>
<li><a href="install.html">New Installation</a>
+ <li><a href="upgrade4.html">Upgrading from 1.2.x to 1.2.2</a>
+ <li><a href="upgrade5.html">Upgrading from 1.2.2 to 1.2.3</a>
+ <li><a href="upgrade6.html">Upgrading from 1.2.3 to 1.3.0</a>
<li><a href="upgrade7.html">Upgrading from 1.3.0 to 1.3.1</a>
<li><a href="upgrade8.html">Upgrading from 1.3.1 to 1.4.0</a>
<li><a href="upgrade9.html">Upgrading from 1.4.0 to 1.4.1</a>
- <li><a href="upgrade10.html">Upgrading from 1.4.1 (or 1.4.2?) to 1.5.0</a>
<!--
<li><a href="config.html">Configuration files</a>
!-->
<li><a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>
<li><a href="http://search.cpan.org/search?dist=Storable">Storable</a>
<!-- MyAccounts, maybe only for dev <li><a href="http://search.cpan.org/search?dist=Cache-Cache">Cache::Cache</a> -->
- <li><a href="http://search.cpan.org/search?dist=NetAddr-IP">NetAddr-IP</a>
- <li><a href="http://search.cpan.org/search?dist=Chart">Chart</a>
<li><a href="http://search.cpan.org/search?dist=ApacheDBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
</ul>
</ul>
$ <a href="man/bin/freeside-adduser.html">freeside-adduser</a> -h /usr/local/etc/freeside/htpasswd <i>username</i></pre></font>
</ul>
<i>(using other auth types, add each user to your <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache authentication</a> and then run: <tt>freeside-adduser <b>username</b></tt></i>
- <li>As the freeside UNIX user, run <tt>freeside-setup <b>username</b></tt> to create the database tables, passing the username of a Freeside user you created above:
+ <li>As the freeside UNIX user, run <tt>bin/fs-setup <b>username</b></tt> (in the untar'ed freeside directory) to create the database tables, passing the username of a Freeside user you created above:
<pre>
$ su freeside
-$ freeside-setup <b>username</b>
+$ cd <b>/path/to/freeside/</b>
+$ bin/fs-setup <b>username</b>
</pre>
- Alternately, use the -s option to enable shipping addresses: <tt>freeside-setup -s <b>username</b></tt>
<li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt> (in the untar'ed freeside directory) to populate the message catalog, passing the username of a Freeside user you created above:
<pre>
$ su freeside
<li>POP mail accounts have entries in passwd only, and have a particular shell.
<li>Everything else in passwd is a shell account.
</ul>
-
<!-- <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="../browse/part_svc.cgi">services</a> as follows:
+ <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="../browse/part_svc.cgi">services</a> as follows:
<ul>
<li>Domain (table svc_acct)
<li>Mail alias (table svc_acct_sm)
</ul>
--->
<li><a name="cust_main">Importing customer data</a>
<ul>
<li>Manually
<li><a name="part_bill_event" href="man/FS/part_bill_event.html">part_bill_event</a> - Invoice event definitions
<ul>
<li>eventpart - primary key
- <li>payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP
+ <li>payby - CARD, CHEK, LECB, BILL, or COMP
<li>event - event name
<li>eventcode - event action
<li>seconds - how long after the invoice date (<a href="#cust_bill">cust_bill</a>._date) events of this type are triggered
<li>recur - recurring fee
<li>sdate - starting date
<li>edate - ending date
- <li>itemdesc - Line item description (currently used only when pkgnum is 0)
- </ul>
- <li><a name="cust_bill_pkg_detail" href="man/FS/cust_bill_pkg_detail.html">cust_bill_pkg_detail</a> - Invoice line items detail
- <ul>
- <li>detailnum - primary key
- <li>pkgnum -
- <li>invnum -
- <li>detail - Detail description
</ul>
<li><a name="cust_credit" href="man/FS/cust_credit.html">cust_credit</a> - Credits. The equivalent of a negative <a href="#cust_bill">cust_bill</a> record.
<ul>
<li><i>ship_daytime</i>
<li><i>ship_night</i>
<li><i>ship_fax</i>
- <li>payby - CARD, DCHK, CHEK, DCHK, LECB, BILL, or COMP
+ <li>payby - CARD, CHEK, LECB, BILL, or COMP
<li>payinfo - card number, P.O.#, or comp issuer
<li>paydate - expiration date
<li>payname - billing name (name on card)
<li>tax - % rate
<li>taxclass
<li>exempt_amount
- <li>taxname - if defined, printed on invoices instead of "Tax"
</ul>
<li><a name="cust_tax_exempt" href="man/FS/cust_tax_exempt.html">cust_tax_exempt</a> - Tax exemption record
<ul>
<li>pkgpart - <a href="#part_pkg">Package definition</a>
<li>setup - date
<li>bill - next bill date
- <li>last_bill - last bill date
<li>susp - (past) suspension date
<li>expire - (future) cancellation date
<li>cancel - (past) cancellation date
<ul>
<li>svcpart - primary key
<li>svc - name of this service
- <li>svcdb - table used for this service: svc_acct, svc_forward, svc_domain, svc_charge or svc_wo
+ <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_forward, svc_domain, svc_charge or svc_wo
<li>disabled - Disabled flag, empty or `Y'
<!-- <li><i>table</i>__<i>field</i> - Default or fixed value for <i>field</i> in <i>table</i>
<li><i>table</i>__<i>field</i>_flag - null, D or F
<li>npa - area code
<li>nxx - exchange
</ul>
+ <li><a name="svc_acct_sm" href="man/FS/svc_acct_sm.html">svc_acct_sm</a> - <b>DEPRECIATED</b> Domain mail aliases
+ <ul>
+ <li>svcnum - <a href="#cust_svc">primary key</a>
+ <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
+ <li>domuid - <a href="#svc_acct">Account</a> (by uid)
+ <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
+ </ul>
<li><a name="svc_domain" href="man/FS/svc_domain.html">svc_domain</a> - Domains
<ul>
<li>svcnum - <a href="#cust_svc">primary key</a>
<li><i>username</i> is a customer username from the svc_acct table
<li><i>portnum</i>, <i>ip</i> or <i>nasport</i> and <i>nasnum</i> uniquely identify a port in the <a href="schema.html#port">port</a> database table.
</ul>
- <li>RADIUS - One of:
+ <li>RADIUS
<ul>
- <li>Run the <b>freeside-sqlradius-radacctd</b> daemon to import radacct
- records from all configured sqlradius exports:
- <tt>freeside-sqlradius-radacctd username</tt>
<li>Configure your RADIUS server's login and logout callbacks to use the command-line <tt>freeside-login</tt> and <tt>freeside-logout</tt> utilites.
- <li> <i>(incomplete)</i>Use the <b>fs_radlog/fs_radlogd</b> tool to
- import records from a text radacct file.
</ul>
</ul>
<h2>Callbacks</h2>
+++ /dev/null
-<pre>
-this is incomplete
-
-install DBIx::DBSchema 0.21
-
-install NetAddr::IP and Chart::Base
-
-CREATE TABLE cust_bill_pkg_detail (
- detailnum serial,
- pkgnum int NOT NULL,
- invnum int NOT NULL,
- detail varchar(80),
- PRIMARY KEY (detailnum)
-);
-CREATE INDEX cust_bill_pkg_detail1 ON cust_bill_pkg_detail ( pkgnum, invnum );
-
-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>
--- /dev/null
+<head>
+ <title>Upgrading to 1.2.2</title>
+</head>
+<body>
+<h1>Upgrading to 1.2.2 from 1.2.x</h1>
+<ul>
+ <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
+ <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.
+ <li>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Install the Perl modules <a href="http://www.perl.com/CPAN/modules/by-module/Locale/">Locale-Codes</a> and <a href="http://www.perl.com/CPAN/modules/by-module/Net/">Net-Whois</a>.
+ <li>Apply the following changes to your database:
+<pre>
+ALTER TABLE cust_pay_batch CHANGE exp exp VARCHAR(11);
+</pre>
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</pre>
+ <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.3.0</title>
+</head>
+<body>
+<h1>Upgrading to 1.2.3 from 1.2.2</h1>
+<ul>
+ <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
+ <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.
+ <li>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Apply the following changes to your database:
+<pre>
+ALTER TABLE svc_acct_pop ADD loc CHAR(4);
+CREATE TABLE prepay_credit (
+ prepaynum int NOT NULL,
+ identifier varchar(80) NOT NULL,
+ amount decimal(10,2) NOT NULL,
+ PRIMARY KEY (prepaynum),
+ INDEX (identifier)
+);
+</pre>
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</pre>
+ <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.3.0</title>
+</head>
+<body>
+<h1>Upgrading to 1.3.0 from 1.2.3</h1>
+<ul>
+ <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
+ <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.
+ <li>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
+ <li>If migrating from less than 1.2.3, see these <a href="upgrade5.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>As 1.3.0 requires transactions, <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are no longer supported</b>. Converting to <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended. If you really want to use MySQL, convert your tables to one of the <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>.
+ <li>Copy the <i>invoice_template</i> file from the <i>conf/</i> directory in the distribution to your <a href="config.html">configuration directory</a>.
+ <li>Install the <a href="http://search.cpan.org/search?dist=Text-Template">Text-Template</a>, <a href="http://search.cpan.org/search?dist=DBIx-DBSchema">DBIx-DBSchema</a>, <a href="http://search.cpan.org/search?dist=Net-SSH">Net-SSH</a>, <a href="http://search.cpan.org/search?dist=String-ShellQuote">String-ShellQuote</a> and <a href="http://search.cpan.org/search?dist=Net-SCP">Net-SCP</a> Perl modules.
+ <li>Apply the following changes to your database:
+<pre>
+CREATE TABLE domain_record (
+ recnum int NOT NULL,
+ svcnum int NOT NULL,
+ reczone varchar(80) NOT NULL,
+ recaf char(2) NOT NULL,
+ rectype char(5) NOT NULL,
+ recdata varchar(80) NOT NULL,
+ PRIMARY KEY (recnum)
+);
+CREATE TABLE svc_www (
+ svcnum int NOT NULL,
+ recnum int NOT NULL,
+ usersvc int NOT NULL,
+ PRIMARY KEY (svcnum)
+);
+ALTER TABLE part_svc ADD svc_www__recnum varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_www__recnum_flag char(1) NULL;
+ALTER TABLE part_svc ADD svc_www__usersvc varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_www__uesrsvc_flag char(1) NULL;
+ALTER TABLE svc_acct CHANGE _password _password varchar(50) NULL;
+ALTER TABLE svc_acct ADD seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
+ALTER TABLE prepay_credit ADD seconds integer NULL;
+
+</pre>
+ <li>If your database supports dropping columns:
+<pre>
+ALTER TABLE cust_bill DROP owed;
+ALTER TABLE cust_credit DROP credited;
+</pre>
+ Or, if your database does not support dropping columns, you can do this:
+<pre>
+ALTER TABLE cust_bill CHANGE owed depriciated decimal(10,2);
+ALTER TABLE cust_credit CHANGE credited depriciated2 decimal(10,2);
+</pre>
+
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</pre>
+ <li>Run bin/dbdef-create.
+</body>
<!-- mason kludge -->
<%
-# <!-- $Id: REAL_cust_pkg.cgi,v 1.5 2003-04-01 01:22:24 ivan Exp $ -->
+# <!-- $Id: REAL_cust_pkg.cgi,v 1.4.4.1 2003-04-01 01:22:31 ivan Exp $ -->
my $error ='';
my $pkgnum = '';
print qq!<INPUT TYPE="hidden" NAME="invoicing_list" VALUE="!.
join(', ', $cust_main->invoicing_list). '">';
- foreach my $payby (qw( CARD DCRD CHEK DCHK LECB BILL COMP )) {
+ foreach my $payby (qw( CARD CHEK LECB BILL COMP )) {
foreach my $field (qw( payinfo payname )) {
print qq!<INPUT TYPE="hidden" NAME="${payby}_$field" VALUE="!.
$cust_main->getfield($field). '">';
);
my %payby = (
- 'CARD' => qq!Credit card (automatic)<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
- 'DCRD' => qq!Credit card (on-demand)<BR>${r}<INPUT TYPE="text" NAME="DCRD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("DCRD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="DCRD_payname" VALUE="">!,
- 'CHEK' => qq!Electronic check (automatic)<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE=""><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="">!,
- 'DCHK' => qq!Electronic check (on-demand)<BR>${r}Account number <INPUT TYPE="text" NAME="DCHK_payinfo1" VALUE=""><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="DCHK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="DCHK_month" VALUE="12"><INPUT TYPE="hidden" NAME="DCHK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="DCHK_payname" VALUE="">!,
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
+ 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE=""><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR><INPUT TYPE="hidden" NAME="BILL_month" VALUE="12"><INPUT TYPE="hidden" NAME="BILL_year" VALUE="2037">Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="">!,
'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
my( $account, $aba ) = split('@', $payinfo);
my %paybychecked = (
- 'CARD' => qq!Credit card (automatic)<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
- 'DCRD' => qq!Credit card (on-demand)<BR>${r}<INPUT TYPE="text" NAME="DCRD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("DCRD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="DCRD_payname" VALUE="$payname">!,
- 'CHEK' => qq!Electronic check (automatic)<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="$account"><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="$payname">!,
- 'DCHK' => qq!Electronic check (on-demand)<BR>${r}Account number <INPUT TYPE="text" NAME="DCHK_payinfo1" VALUE="$account"><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="DCHK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="DCHK_month" VALUE="12"><INPUT TYPE="hidden" NAME="DCHK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="DCHK_payname" VALUE="$payname">!,
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
+ 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="$account"><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="$payname">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="$payinfo" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR><INPUT TYPE="hidden" NAME="BILL_month" VALUE="12"><INPUT TYPE="hidden" NAME="BILL_year" VALUE="2037">Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate),
);
$cust_main->payby($payby_default) unless $cust_main->payby;
- for (qw(CARD DCRD CHEK DCHK LECB BILL COMP)) {
+ for (qw(CARD CHEK LECB BILL COMP)) {
print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
if ($cust_main->payby eq "$_") {
print qq! CHECKED> $paybychecked{$_}</TD>!;
<TH><FONT SIZE=-1>Country</FONT></TH>
<TH><FONT SIZE=-1>State</FONT></TH>
<TH><FONT SIZE=-1>County</FONT></TH>
- <TH><FONT SIZE=-1>Taxclass</FONT><BR><FONT SIZE=-2>(per-package classification)</FONT></TH>
- <TH><FONT SIZE=-1>Tax name</FONT><BR><FONT SIZE=-2>(printed on invoices)</FONT></TH>
+ <TH><FONT SIZE=-1>Taxclass</FONT></TH>
<TH><FONT SIZE=-1>Tax</FONT></TH>
<TH><FONT SIZE=-1>Exempt<BR>per<BR>month</TH>
</TR>
: ' BGCOLOR="#cccccc">(ALL)'
, "</TD>";
- print qq!<TD><INPUT TYPE="text" NAME="taxname!, $hashref->{taxnum},
- qq!" VALUE="!, $hashref->{taxname}, qq!"></TD>!;
print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD>!;
print qq!<TD>\$<INPUT TYPE="text" NAME="exempt_amount!, $hashref->{taxnum},
<TR><TD ALIGN="right">Payby</TD><TD><SELECT NAME="payby">
END
-for (qw(CARD DCRD CHEK DCHK LECB BILL COMP)) {
+for (qw(CARD CHEK LECB BILL COMP)) {
print qq!<OPTION VALUE="$_"!;
if ($part_bill_event->payby eq $_) {
print " SELECTED>$_</OPTION>";
'weight' => 30,
},
+ 'realtime-card-cybercash' => {
+ 'name' => '(<b>deprecated</b>) Run card with <a href="http://www.cybercash.com/cashregister">CyberCash CashRegister</a> realtime gateway',
+ 'code' => '$cust_bill->realtime_card_cybercash();',
+ 'weight' => 30,
+ },
+
'realtime-lec' => {
'name' => 'Run phone bill ("LEC") billing with a <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> realtime gateway',
'code' => '$cust_bill->realtime_lec();',
},
'fieldorder' => [qw( setup_fee recur_flat recur_included_hours recur_hourly_charge recur_included_input recur_input_charge recur_included_output recur_output_charge recur_included_total recur_total_charge )],
'setup' => 'what.setup_fee.value',
- 'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; my $totalcharge = sprintf(\"%.2f\", \' + what.recur_total_charge.value + \' * $total); my $hourscharge = sprintf(\"%.2f\", \' + what.recur_hourly_charge.value + \' * $hours); push @details, \"Last month\\\'s excess data \". sprintf(\"%.1f\", $total). \" megs: \\\$$totalcharge\", \"Last month\\\'s excess time \". sprintf(\"%.1f\", $hours). \" hours: \\\$$hourscharge\"; \' + what.recur_flat.value + \' + $hourscharge + \' + what.recur_input_charge.value + \' * $input + \' + what.recur_output_charge.value + \' * $output + $totalcharge ;\'',
+ 'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; \' + what.recur_flat.value + \' + \' + what.recur_hourly_charge.value + \' * $hours + \' + what.recur_input_charge.value + \' * $input + \' + what.recur_output_charge.value + \' * $output + \' + what.recur_total_charge.value + \' * $total ;\'',
},
;
+++ /dev/null
-<!-- mason kludge -->
-<%
-my ($routerfieldpart, $part_router_field);
-
-if ( $cgi->param('error') ) {
- $part_router_field = new FS::part_router_field ( {
- map { $_, scalar($cgi->param($_)) } fields('part_router_field')});
- $routerfieldpart = $part_router_field->routerfieldpart;
-} else {
- my($query) = $cgi->keywords;
- if ( $query =~ /^(\d+)$/ ) { #editing
- $routerfieldpart=$1;
- $part_router_field=qsearchs('part_router_field',
- {'routerfieldpart' => $routerfieldpart})
- or die "Unknown routerfieldpart!";
-
- } else { #adding
- $part_router_field = new FS::part_router_field({});
- }
-}
-my $action = $part_router_field->routerfieldpart ? 'Edit' : 'Add';
-
-my $p1 = popurl(1);
-print header("$action Router Extended Field Definition",
- menubar('Main Menu' => $p,
- 'View all Extended Fields' => $p. 'browse/generic.cgi?part_router_field')
- );
-
-print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-%>
-<FORM ACTION="<%=$p1%>process/generic.cgi" METHOD=POST>
-
-<INPUT TYPE="hidden" NAME="table" VALUE="part_router_field">
-<INPUT TYPE="hidden" NAME="routerfieldpart" VALUE="<%=
- $routerfieldpart%>">
-Field #<B><%=$routerfieldpart or "(NEW)"%></B><BR><BR>
-
-<%=ntable("#cccccc",2)%>
- <TR>
- <TD ALIGN="right">Name</TD>
- <TD><INPUT TYPE="text" NAME="name" MAXLENGTH=15 VALUE="<%=
- $part_router_field->name%>"></TD>
- </TR>
- <TR>
- <TD ALIGN="right">Length</TD>
- <TD><INPUT TYPE="text" NAME="length" MAXLENGTH=4 VALUE="<%=
- $part_router_field->length%>"></TD>
- </TR>
- <TR>
- <TD ALIGN="right">check_block</TD>
- <TD><TEXTAREA COLS="20" ROWS="4" NAME="check_block"><%=
- $part_router_field->check_block%></TEXTAREA></TD>
- </TR>
- <TR>
- <TD ALIGN="right">list_source</TD>
- <TD><TEXTAREA COLS="20" ROWS="4" NAME="list_source"><%=
- $part_router_field->list_source%></TEXTAREA></TD>
- </TR>
-</TABLE><BR><INPUT TYPE="submit" VALUE="Submit">
-
-</FORM>
-
-<BR><BR>
-<FONT SIZE=-2>If you don't understand what <I>check_block</I> and
-<I>list_source</I> mean, <B>LEAVE THEM BLANK</B>. We mean it.</FONT>
-
-
-</BODY>
-</HTML>
+++ /dev/null
-<!-- mason kludge -->
-<%
-my ($sbfieldpart, $part_sb_field);
-
-if ( $cgi->param('error') ) {
- $part_sb_field = new FS::part_sb_field ( {
- map { $_, scalar($cgi->param($_)) } fields('part_sb_field')});
- $sbfieldpart = $part_sb_field->sbfieldpart;
-} else {
- my($query) = $cgi->keywords;
- if ( $query =~ /^(\d+)$/ ) { #editing
- $sbfieldpart=$1;
- $part_sb_field=qsearchs('part_sb_field',
- {'sbfieldpart' => $sbfieldpart})
- or die "Unknown sbfieldpart!";
-
- } else { #adding
- $part_sb_field = new FS::part_sb_field({});
- }
-}
-my $action = $part_sb_field->sbfieldpart ? 'Edit' : 'Add';
-
-my $p1 = popurl(1);
-print header("$action svc_broadband Extended Field Definition", '');
-
-print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-%>
-<FORM ACTION="<%=$p1%>process/generic.cgi" METHOD="POST">
-
-<INPUT TYPE="hidden" NAME="table" VALUE="part_sb_field">
-<INPUT TYPE="hidden" NAME="redirect_ok"
- VALUE="<%=popurl(2)%>browse/part_sb_field.cgi">
-<INPUT TYPE="hidden" NAME="sbfieldpart" VALUE="<%=
- $sbfieldpart%>">
-Field #<B><%=$sbfieldpart or "(NEW)"%></B><BR><BR>
-
-<%=ntable("#cccccc",2)%>
- <TR>
- <TD ALIGN="right">Name</TD>
- <TD><INPUT TYPE="text" NAME="name" MAXLENGTH=15 VALUE="<%=
- $part_sb_field->name%>"></TD>
- </TR>
- <TR>
- <TD ALIGN="right">Length</TD>
- <TD><INPUT TYPE="text" NAME="length" MAXLENGTH=4 VALUE="<%=
- $part_sb_field->length%>"></TD>
- </TR>
- <TR>
- <TD ALIGN="right">Service</TD>
- <TD><SELECT SIZE=1 NAME="svcpart"><%
- foreach my $part_svc (qsearch('part_svc', {svcdb => 'svc_broadband'})) {
- %><OPTION VALUE="<%=$part_svc->svcpart%>"<%=
- ($part_svc->svcpart == $part_sb_field->svcpart) ? ' SELECTED' : ''%>">
- <%=$part_svc->svc%>
- <% } %>
- </SELECT></TD>
- <TR>
- <TD ALIGN="right">check_block</TD>
- <TD><TEXTAREA COLS="20" ROWS="4" NAME="check_block"><%=
- $part_sb_field->check_block%></TEXTAREA></TD>
- </TR>
- <TR>
- <TD ALIGN="right">list_source</TD>
- <TD><TEXTAREA COLS="20" ROWS="4" NAME="list_source"><%=
- $part_sb_field->list_source%></TEXTAREA></TD>
- </TR>
-</TABLE><BR><INPUT TYPE="submit" VALUE="Submit">
-
-</FORM>
-
-<BR><BR>
-<FONT SIZE=-2>If you don't understand what <I>check_block</I> and
-<I>list_source</I> mean, <B>LEAVE THEM BLANK</B>. We mean it.</FONT>
-
-
-</BODY>
-</HTML>
Services are items you offer to your customers.
<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
<LI>svc_domain - Domains
+ <LI>svc_acct_sm - <B>deprecated</B> (use svc_forward for new installations) Virtual domain mail aliasing.
<LI>svc_forward - mail forwarding
<LI>svc_www - Virtual domain website
- <LI>svc_broadband - Broadband/High-speed Internet service
<!-- <LI>svc_charge - One-time charges (Partially unimplemented)
<LI>svc_wo - Work orders (Partially unimplemented)
-->
'svc_domain' => {
'domain' => 'Domain',
},
+ 'svc_acct_sm' => {
+ 'domuser' => 'domuser@virtualdomain.com',
+ 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
+ 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
+ },
'svc_forward' => {
'srcsvc' => 'service from which mail is to be forwarded',
'dstsvc' => 'service to which mail is to be forwarded',
#'recnum' => '',
#'usersvc' => '',
},
- 'svc_broadband' => {
- 'actypenum' => 'This is the actypenum that refers to the type of AC that can be provisioned for this service. This field must be set fixed.',
- 'speed_down' => 'Maximum download speed for this service in Kbps. 0 denotes unlimited.',
- 'speed_up' => 'Maximum upload speed for this service in Kbps. 0 denotes unlimited.',
- 'acnum' => 'acnum of a specific AC that this service is restricted to. Not required',
- 'ip_addr' => 'IP address. Leave blank for automatic assignment.',
- 'ip_netmask' => 'Mask length, aka. netmask bits. (Eg. 255.255.255.0 == 24)',
- 'mac_addr' => 'MAC address which is used by some ACs for access control. Specified by 6 colon seperated hex octets. (Eg. 00:00:0a:bc:1a:2b)',
- 'location' => 'Defines the physically location at which this service was installed. This is not necessarily the billing address',
- },
);
my @dbs = $hashref->{svcdb}
? ( $hashref->{svcdb} )
- : qw( svc_acct svc_domain svc_forward svc_www svc_broadband );
+ : qw( svc_acct svc_domain svc_acct_sm svc_forward svc_www );
tie my %svcdb, 'Tie::IxHash', map { $_=>$_ } @dbs;
my $widget = new HTML::Widgets::SelectLayers(
+++ /dev/null
-<%
-
-my $error = '';
-my $ip_gateway = $cgi->param('ip_gateway');
-my $ip_netmask = $cgi->param('ip_netmask');
-
-my $new = new FS::addr_block {
- ip_gateway => $ip_gateway,
- ip_netmask => $ip_netmask,
- routernum => 0 };
-
-$error = $new->insert;
-
-if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi?". $cgi->query_string );
-} else {
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi");
-}
-%>
+++ /dev/null
-<%
-my $error = '';
-my $blocknum = $cgi->param('blocknum');
-my $routernum = $cgi->param('routernum');
-
-my $addr_block = qsearchs('addr_block', { blocknum => $blocknum });
-my $router = qsearchs('router', { routernum => $routernum });
-
-if($addr_block) {
- if ($router) {
- $error = $addr_block->allocate($router);
- } else {
- $error = "Cannot find router with routernum $routernum";
- }
-} else {
- $error = "Cannot find block with blocknum $blocknum";
-}
-
-if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi?" . $cgi->query_string);
-} else {
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi");
-}
-%>
+++ /dev/null
-<%
-my $error = '';
-my $blocknum = $cgi->param('blocknum');
-
-my $addr_block = qsearchs('addr_block', { blocknum => $blocknum });
-
-if($addr_block) {
- my $router = $addr_block->router;
- if ($router) {
- $error = $addr_block->deallocate($router);
- } else {
- $error = "Block is not allocated to a router";
- }
-} else {
- $error = "Cannot find block with blocknum $blocknum";
-}
-
-if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi?" . $cgi->query_string);
-} else {
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi");
-}
-%>
+++ /dev/null
-<%
-my $error = '';
-my $blocknum = $cgi->param('blocknum');
-my $addr_block = qsearchs('addr_block', { blocknum => $blocknum });
-
-if ( $addr_block) {
- $error = $addr_block->split_block;
-} else {
- $error = "Unknown blocknum: $blocknum";
-}
-
-
-if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi?". $cgi->query_string );
-} else {
- print $cgi->redirect(popurl(4). "browse/addr_block.cgi");
-}
-%>
my $payby = $cgi->param('payby');
if ( $payby ) {
- if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) {
+ if ( $payby eq 'CHEK' ) {
$cgi->param('payinfo',
- $cgi->param($payby. '_payinfo1'). '@'. $cgi->param($payby. '_payinfo2') );
+ $cgi->param('CHEK_payinfo1'). '@'. $cgi->param('CHEK_payinfo2') );
} else {
$cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) );
}
foreach ( grep { /^tax\d+$/ } $cgi->param ) {
/^tax(\d+)$/ or die "Illegal form $_!";
- my $taxnum = $1;
- my $old = qsearchs('cust_main_county', { 'taxnum' => $taxnum })
+ my($taxnum)=$1;
+ my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
or die "Couldn't find taxnum $taxnum!";
- next unless $old->tax != $cgi->param("tax$taxnum")
- || $old->exempt_amount != $cgi->param("exempt_amount$taxnum")
- || $old->taxname ne $cgi->param("taxname$taxnum");
+ my $exempt_amount = $cgi->param("exempt_amount$taxnum");
+ next unless $old->tax ne $cgi->param("tax$taxnum")
+ || $old->exempt_amount ne $exempt_amount;
my %hash = $old->hash;
$hash{tax} = $cgi->param("tax$taxnum");
- $hash{exempt_amount} = $cgi->param("exempt_amount$taxnum");
- $hash{taxname} = $cgi->param("taxname$taxnum");
- my $new = new FS::cust_main_county \%hash;
- my $error = $new->replace($old);
+ $hash{exempt_amount} = $exempt_amount;
+ my($new)=new FS::cust_main_county \%hash;
+ my($error)=$new->replace($old);
if ( $error ) {
$cgi->param('error', $error);
print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string );
+++ /dev/null
-<%
-
-# Welcome to generic.cgi.
-#
-# This script provides a generic edit/process/ backend for simple table
-# editing. All it knows how to do is take the values entered into
-# the script and insert them into the table specified by $cgi->param('table').
-# If there's an existing record with the same primary key, it will be
-# replaced. (Deletion will be added in the future.)
-#
-# Special cgi params for this script:
-# table: the name of the table to be edited. The script will die horribly
-# if it can't find the table.
-# redirect_ok: URL to be displayed after a successful edit. The value of
-# the record's primary key will be passed as a keyword.
-# Defaults to (freeside root)/view/$table.cgi.
-# redirect_error: URL to be displayed if there's an error. The original
-# query string, plus the error message, will be passed.
-# Defaults to $cgi->referer() (i.e. go back where you
-# came from).
-
-
-use FS::Record qw(qsearchs dbdef);
-use DBIx::DBSchema;
-use DBIx::DBSchema::Table;
-
-
-my $error;
-my $p2 = popurl(2);
-my $p3 = popurl(3);
-my $table = $cgi->param('table');
-my $dbdef = dbdef or die "Cannot fetch dbdef!";
-
-my $dbdef_table = $dbdef->table($table) or die "Cannot fetch schema for $table";
-
-my $pkey = $dbdef_table->primary_key or die "Cannot fetch pkey for $table";
-my $pkey_val = $cgi->param($pkey);
-
-
-#warn "new FS::Record ( $table, (hashref) )";
-my $new = FS::Record::new ( "FS::$table", {
- map { $_, scalar($cgi->param($_)) } fields($table)
-} );
-
-#warn 'created $new of class '.ref($new);
-
-if($pkey_val and (my $old = qsearchs($table, { $pkey, $pkey_val} ))) {
- # edit
- $error = $new->replace($old);
-} else {
- #add
- $error = $new->insert;
- $pkey_val = $new->getfield($pkey);
- # New records usually don't have their primary keys set until after
- # they've been checked/inserted, so grab the new $pkey_val so we can
- # redirect to it.
-}
-
-my $redirect_ok = (($cgi->param('redirect_ok')) ?
- $cgi->param('redirect_ok') : $p3."browse/generic.cgi?$table");
-my $redirect_error = (($cgi->param('redirect_error')) ?
- $cgi->param('redirect_error') : $cgi->referer());
-
-if($error) {
- $cgi->param('error', $error);
- print $cgi->redirect($redirect_error . '?' . $cgi->query_string);
-} else {
- print $cgi->redirect($redirect_ok);
-}
-%>
push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ) } @fields;
} grep defined( $FS::Record::dbdef->table($_) ),
- qw( svc_acct svc_domain svc_forward svc_www svc_broadband )
+ qw( svc_acct svc_domain svc_acct_sm svc_forward svc_www )
)
} );
+++ /dev/null
-<%
-
-use FS::UID qw(dbh);
-
-my $dbh = dbh;
-local $FS::UID::AutoCommit=0;
-
-sub check {
- my $error = shift;
- if($error) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(3) . "edit/router.cgi?". $cgi->query_string);
- $dbh->rollback;
- exit;
- }
-}
-
-my $error = '';
-my $routernum = $cgi->param('routernum');
-my $routername = $cgi->param('routername');
-my $old = qsearchs('router', { routernum => $routernum });
-my @old_rf;
-my @old_psr;
-
-my $new = new FS::router {
- routernum => $routernum,
- routername => $routername,
- svcnum => 0
- };
-
-if($old) {
- if($old->routername ne $new->routername) {
- $error = $new->replace($old);
- } #else do nothing
-} else {
- $error = $new->insert;
- $routernum = $new->routernum;
-}
-
-check($error);
-
-if ($old) {
- @old_psr = $old->part_svc_router;
- foreach $psr (@old_psr) {
- if($cgi->param('svcpart_'.$psr->svcpart) eq 'ON') {
- # do nothing
- } else {
- $error = $psr->delete;
- }
- }
- check($error);
- @old_rf = $old->router_field;
- foreach $rf (@old_rf) {
- if(my $new_val = $cgi->param('rf_'.$rf->routerfieldpart)) {
- if($new_val ne $rf->value) {
- my $new_rf = new FS::router_field
- { routernum => $routernum,
- value => $new_val,
- routerfieldpart => $rf->routerfieldpart };
- $error = $new_rf->replace($rf);
- } #else do nothing
- } else {
- $error = $rf->delete;
- }
- check($error);
- }
-}
-
-foreach($cgi->param) {
- if($cgi->param($_) eq 'ON' and /^svcpart_(\d+)$/) {
- my $svcpart = $1;
- if(grep {$_->svcpart == $svcpart} @old_psr) {
- # do nothing
- } else {
- my $new_psr = new FS::part_svc_router { svcpart => $svcpart,
- routernum => $routernum };
- $error = $new_psr->insert;
- }
- check($error);
- } elsif($cgi->param($_) ne '' and /^rf_(\d+)$/) {
- my $part = $1;
- if(my @x = grep {$_->routerfieldpart == $part} @old_rf) {
- # already handled all of these
- } else {
- my $new_rf = new FS::router_field
- { routernum => $routernum,
- value => $cgi->param('rf_'.$part),
- routerfieldpart => $part };
- $error = $new_rf->insert;
- check($error);
- }
- }
-}
-
-
-
-# Yay, everything worked!
-$dbh->commit or die $dbh->errstr;
-print $cgi->redirect(popurl(3). "browse/router.cgi");
-
-%>
--- /dev/null
+<%
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum =$1;
+
+my $old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
+
+#unmunge domsvc and domuid
+#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] );
+#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] );
+
+my $new = new FS::svc_acct_sm ( {
+ map {
+ ($_, scalar($cgi->param($_)));
+ #} qw(svcnum pkgnum svcpart domuser domuid domsvc)
+ } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) )
+} );
+
+my $error = '';
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->getfield('svcnum');
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum");
+}
+
+%>
+++ /dev/null
-<%
-
-# If it's stupid but it works, it's not stupid.
-# -- U.S. Army
-
-local $FS::UID::AutoCommit = 0;
-my $dbh = FS::UID::dbh;
-
-$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my $svcnum = $1;
-
-my $old; my @old_sbf;
-if ( $svcnum ) {
- $old = qsearchs('svc_broadband', { 'svcnum' => $svcnum } )
- or die "fatal: can't find broadband service (svcnum $svcnum)!";
- @old_sbf = $old->sb_field;
-} else {
- $old = '';
-}
-
-my $new = new FS::svc_broadband ( {
- map {
- ($_, scalar($cgi->param($_)));
- } ( fields('svc_broadband'), qw( pkgnum svcpart ) )
-} );
-
-my $error;
-if ( $svcnum ) {
- $error = $new->replace($old);
-} else {
- $error = $new->insert;
- $svcnum = $new->svcnum;
-}
-
-unless ($error) {
- my $sb_field;
-
- foreach ($cgi->param) {
- #warn "\$cgi->param $_: " . $cgi->param($_);
- if(/^sbf_(\d+)/) {
- my $part = $1;
- #warn "\$part $part";
- $sb_field = new FS::sb_field
- { svcnum => $svcnum,
- value => $cgi->param($_),
- sbfieldpart => $part };
- if (my @x = grep { $_->sbfieldpart eq $part } @old_sbf) {
- #if (my $old_sb_field = (grep { $_->sbfieldpart eq $part} @old_Sbf)[0]) {
- #warn "array: " . scalar(@x);
- if (length($sb_field->value) && ($sb_field->value ne $x[0]->value)) {
- #warn "replacing " . $x[0]->value . " with " . $sb_field->value;
- $error = $sb_field->replace($x[0]);
- #$error = $sb_field->replace($old_sb_field);
- } elsif (length($sb_field->value) == 0) {
- #warn "delete";
- $error = $x[0]->delete;
- }
- } else {
- if (length($sb_field->value) > 0) {
- #warn "insert";
- $error = $sb_field->insert;
- }
- # else do nothing
- }
- }
- }
-}
-
-if ( $error ) {
- $cgi->param('error', $error);
- $cgi->param('ip_addr', $new->ip_addr);
- $dbh->rollback;
- print $cgi->redirect(popurl(2). "svc_broadband.cgi?". $cgi->query_string );
-} else {
- $dbh->commit or die $dbh->errstr;
- print $cgi->redirect(popurl(3). "view/svc_broadband.cgi?" . $svcnum );
-}
-
-%>
+++ /dev/null
-<HTML><BODY>
-
-<%
-
-my $router;
-if ( $cgi->keywords ) {
- my($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $router = qsearchs('router', { routernum => $1 })
- or print $cgi->redirect(popurl(2)."browse/router.cgi") ;
-} else {
- $router = new FS::router ( {
- map { $_, scalar($cgi->param($_)) } fields('router')
- } );
-}
-
-my $routernum = $router->routernum;
-my $action = $routernum ? 'Edit' : 'Add';
-my $hashref = $router->hashref;
-
-print header("$action Router", menubar(
- 'Main Menu' => "$p",
- 'View all routers' => "${p}browse/router.cgi",
-));
-
-if($cgi->param('error')) {
-%> <FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT>
-<% } %>
-
-<FORM ACTION="<%=popurl(1)%>process/router.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="routernum" VALUE="<%=$routernum%>">
- Router #<%=$routernum or "(NEW)"%>
-
-<BR><BR>Name <INPUT TYPE="text" NAME="routername" SIZE=32 VALUE="<%=$hashref->{routername}%>">
-
-<BR><BR>
-Custom fields:
-<BR>
-<%=table() %>
-
-<%
-# I know, I know. Massive false laziness with edit/svc_broadband.cgi. But
-# Kristian won't let me generalize the custom field mechanism to every table in
-# the database, so this is what we get. <snarl>
-# -- MW
-
-my @part_router_field = qsearch('part_router_field', { });
-my %rf = map { $_->part_router_field->name, $_->value } $router->router_field;
-foreach (sort { $a->name cmp $b->name } @part_router_field) {
- %>
- <TR>
- <TD ALIGN="right"><%=$_->name%></TD>
- <TD><%
- if(my @opts = $_->list_values) {
- %> <SELECT NAME="rf_<%=$_->routerfieldpart%>" SIZE="1">
- <%
- foreach $opt (@opts) {
- %> <OPTION VALUE="<%=$opt%>"<%=($opt eq $rf{$_->name})
- ? ' SELECTED' : ''%>>
- <%=$opt%>
- </OPTION>
- <% } %>
- </SELECT>
- <% } else { %>
- <INPUT NAME="rf_<%=$_->routerfieldpart%>"
- VALUE="<%=$rf{$_->name}%>"
- <%=$_->length ? 'SIZE="'.$_->length.'"' : ''%>>
- <% } %></TD>
- </TR>
-<% } %>
-</TABLE>
-
-
-
-<BR><BR>Select the service types available on this router<BR>
-<%
-
-foreach my $part_svc ( qsearch('part_svc', { svcdb => 'svc_broadband',
- disabled => '' }) ) {
- %>
- <BR>
- <INPUT TYPE="checkbox" NAME="svcpart_<%=$part_svc->svcpart%>"<%=
- qsearchs('part_svc_router', { svcpart => $part_svc->svcpart,
- routernum => $routernum } ) ? 'CHECKED' : ''%> VALUE="ON">
- <A HREF="<%=${p}%>edit/part_svc.cgi?<%=$part_svc->svcpart%>">
- <%=$part_svc->svcpart%>: <%=$part_svc->svc%></A>
- <% } %>
-
- <BR><BR><INPUT TYPE="submit" VALUE="Apply changes">
- </FORM>
-</BODY></HTML>
-
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($svcnum, $pkgnum, $svcpart, $part_svc, $svc_acct_sm );
+if ( $cgi->param('error') ) {
+ $svc_acct_sm = new FS::svc_acct_sm ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm')
+ } );
+ $svcnum = $svc_acct_sm->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ #$part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ #die "No part_svc entry!" unless $part_svc;
+} else {
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct_sm) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ #$part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ #die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_acct_sm = new FS::svc_acct_sm({});
+
+ foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ my $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ $svc_acct_sm->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+
+ }
+}
+my $action = $svc_acct_sm->svcnum ? 'Edit' : 'Add';
+
+my %username = ();
+my %domain = ();
+if ($pkgnum) {
+
+ #find all possible uids (and usernames)
+
+ my @u_acct_svcparts = ();
+ foreach my $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
+ }
+ }
+ }
+
+ #find all possible domains (and domsvc's)
+
+ my @d_acct_svcparts = ();
+ foreach my $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
+ push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
+ }
+
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@d_acct_svcparts) {
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
+ }
+ }
+ }
+
+} elsif ( $action eq 'Edit' ) {
+
+ my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
+ $username{$svc_acct_sm->uid} = $svc_acct->username;
+
+ my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
+ $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
+
+} else {
+ die "\$action eq Add, but \$pkgnum is null!\n";
+}
+
+my $p1 = popurl(1);
+print header("Mail Alias $action", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!;
+
+#display
+
+ #formatting
+ print "<PRE>";
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+my($domuser,$domsvc,$domuid)=(
+ $svc_acct_sm->domuser,
+ $svc_acct_sm->domsvc,
+ $svc_acct_sm->domuid,
+);
+
+#domuser
+print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
+
+#domsvc
+print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
+foreach $_ (keys %domain) {
+ print "<OPTION", $_ eq $domsvc ? " SELECTED" : "",
+ qq! VALUE="$_">$domain{$_}!;
+}
+print "</SELECT>";
+
+#uid
+print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
+foreach $_ (keys %username) {
+ print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "",
+ qq! VALUE="$_">$username{$_}!;
+}
+print "</SELECT>\@$mydomain mailbox.";
+
+ #formatting
+ print "</PRE>\n";
+
+print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
+++ /dev/null
-<!-- mason kludge -->
-<%
-
-# If it's stupid but it works, it's still stupid.
-# -Kristian
-
-
-use HTML::Widgets::SelectLayers;
-use Tie::IxHash;
-
-my( $svcnum, $pkgnum, $svcpart, $part_svc, $svc_broadband );
-if ( $cgi->param('error') ) {
- $svc_broadband = new FS::svc_broadband ( {
- map { $_, scalar($cgi->param($_)) } fields('svc_broadband')
- } );
- $svcnum = $svc_broadband->svcnum;
- $pkgnum = $cgi->param('pkgnum');
- $svcpart = $cgi->param('svcpart');
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-} else {
- my($query) = $cgi->keywords;
- if ( $query =~ /^(\d+)$/ ) { #editing
- $svcnum=$1;
- $svc_broadband=qsearchs('svc_broadband',{'svcnum'=>$svcnum})
- or die "Unknown (svc_broadband) svcnum!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- } else { #adding
-
- $svc_broadband = new FS::svc_broadband({});
-
- foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
- }
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $svc_broadband->setfield('svcpart', $svcpart);
-
- $svcnum='';
-
- #set fixed and default fields from part_svc
- foreach my $part_svc_column (
- grep { $_->columnflag } $part_svc->all_part_svc_column
- ) {
- $svc_broadband->setfield( $part_svc_column->columnname,
- $part_svc_column->columnvalue,
- );
- }
-
- }
-}
-my $action = $svc_broadband->svcnum ? 'Edit' : 'Add';
-
-if ($pkgnum) {
-
- #Nothing?
-
-} elsif ( $action eq 'Edit' ) {
-
- #Nothing?
-
-} else {
- die "\$action eq Add, but \$pkgnum is null!\n";
-}
-
-my $p1 = popurl(1);
-
-my ($ip_addr, $speed_up, $speed_down, $blocknum) =
- ($svc_broadband->ip_addr,
- $svc_broadband->speed_up,
- $svc_broadband->speed_down,
- $svc_broadband->blocknum);
-
-%>
-
-<%=header("Broadband Service $action", '')%>
-
-<% if ($cgi->param('error')) { %>
-<FONT SIZE="+1" COLOR="#ff0000">Error: <%=$cgi->param('error')%></FONT><BR>
-<% } %>
-
-Service #<B><%=$svcnum ? $svcnum : "(NEW)"%></B><BR><BR>
-
-<FORM ACTION="<%=${p1}%>process/svc_broadband.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="<%=$svcnum%>">
- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="<%=$pkgnum%>">
- <INPUT TYPE="hidden" NAME="svcpart" VALUE="<%=$svcpart%>">
-
- <%=&ntable("#cccccc",2)%>
- <TR>
- <TD ALIGN="right">IP Address</TD>
- <TD BGCOLOR="#ffffff">
-<% if ( $part_svc->part_svc_column('ip_addr')->columnflag eq 'F' ) { %>
- <INPUT TYPE="hidden" NAME="ip_addr" VALUE="<%=$ip_addr%>"><%=$ip_addr%>
-<% } else { %>
- <INPUT TYPE="text" NAME="ip_addr" VALUE="<%=$ip_addr%>">
-<% } %>
- </TD>
- </TR>
- <TR>
- <TD ALIGN="right">Download speed</TD>
- <TD BGCOLOR="#ffffff">
-<% if ( $part_svc->part_svc_column('speed_down')->columnflag eq 'F' ) { %>
- <INPUT TYPE="hidden" NAME="speed_down" VALUE="<%=$speed_down%>"><%=$speed_down%>Kbps
-<% } else { %>
- <INPUT TYPE="text" NAME="speed_down" SIZE=5 VALUE="<%=$speed_down%>">Kbps
-<% } %>
- </TD>
- </TR>
- <TR>
- <TD ALIGN="right">Upload speed</TD>
- <TD BGCOLOR="#ffffff">
-<% if ( $part_svc->part_svc_column('speed_up')->columnflag eq 'F' ) { %>
- <INPUT TYPE="hidden" NAME="speed_up" VALUE="<%=$speed_up%>"><%=$speed_up%>Kbps
-<% } else { %>
- <INPUT TYPE="text" NAME="speed_up" SIZE=5 VALUE="<%=$speed_up%>">Kbps
-<% } %>
- </TD>
- </TR>
-<% if ($action eq 'Add') { %>
- <TR>
- <TD ALIGN="right">Router/Block</TD>
- <TD BGCOLOR="#ffffff">
- <SELECT NAME="blocknum">
-<%
- foreach my $router ($svc_broadband->allowed_routers) {
- foreach my $addr_block ($router->addr_block) {
-%>
- <OPTION VALUE="<%=$addr_block->blocknum%>"<%=($addr_block->blocknum eq $blocknum) ? ' SELECTED' : ''%>>
- <%=$router->routername%>:<%=$addr_block->ip_gateway%>/<%=$addr_block->ip_netmask%></OPTION>
-<%
- }
- }
-%>
- </SELECT>
- </TD>
- </TR>
-<% } else { %>
-
- <TR>
- <TD ALIGN="right">Router/Block</TD>
- <TD BGCOLOR="#ffffff">
- <%=$svc_broadband->addr_block->router->routername%>:<%=$svc_broadband->addr_block->NetAddr%>
- <INPUT TYPE="hidden" NAME="blocknum" VALUE="<%=$svc_broadband->blocknum%>">
- </TD>
- </TR>
-
-<% } %>
-
-<%
-
- my @part_sb_field = qsearch('part_sb_field', { svcpart => $svcpart });
- my $sbf_hashref = $svc_broadband->sb_field_hashref($svcpart);
- foreach (sort { $a->name cmp $b->name } @part_sb_field) {
- %>
- <TR>
- <TD ALIGN="right"><%=$_->name%></TD>
- <TD><%
- if(my @opts = $_->list_values) {
- %>
- <SELECT NAME="sbf_<%=$_->sbfieldpart%>" SIZE=1> <%
- foreach $opt (@opts) { %>
- <OPTION VALUE="<%=$opt%>"<%=
- ($opt eq $sbf_hashref->{$_->name}) ? ' SELECTED' : ''%>>
- <%=$opt%></OPTION><%
- } %></SELECT>
- <% } else { %>
- <INPUT NAME="sbf_<%=$_->sbfieldpart%>"
- VALUE="<%=$sbf_hashref->{$_->name}%>"
- <%=$_->length ? 'SIZE="'.$_->length.'"' : ''%>>
- <% } %>
- </TD>
- </TR>
-<% } %>
- </TABLE>
- <BR>
- <INPUT TYPE="submit" NAME="submit" VALUE="Submit">
-</FORM>
-</BODY>
-</HTML>
-
<%
my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
my($svcnum, $pkgnum, $svcpart, $part_svc, $svc_forward);
if ( $cgi->param('error') ) {
+++ /dev/null
-<%
-
-#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
-my ($curmon,$curyear) = (localtime(time))[4,5];
-
-#find first month
-my $syear = $cgi->param('syear') || 1899+$curyear;
-my $smonth = $cgi->param('smonth') || $curmon+1;
-
-#find last month
-my $eyear = $cgi->param('eyear') || 1900+$curyear;
-my $emonth = $cgi->param('emonth') || $curmon+1;
-if ( $emonth++>12 ) { $emonth-=12; $eyear++; }
-
-my @labels;
-my %data;
-
-while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth ) ) {
- push @labels, "$smonth/$syear";
-
- my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
- if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
- my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
-
- my $where = "WHERE _date >= $speriod AND _date < $eperiod";
-
- # Invoiced
- my $charged_sql = "SELECT SUM(charged) FROM cust_bill $where";
- my $charged_sth = dbh->prepare($charged_sql) or die dbh->errstr;
- $charged_sth->execute or die $charged_sth->errstr;
- my $charged = $charged_sth->fetchrow_arrayref->[0] || 0;
-
- push @{$data{charged}}, $charged;
-
- #accounts receivable
-# my $ar_sql2 = "SELECT SUM(amount) FROM cust_credit $where";
- my $credited_sql = "SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill, cust_bill WHERE cust_bill.invnum = cust_credit_bill.invnum AND cust_bill._date >= $speriod AND cust_bill._date < $eperiod";
- my $credited_sth = dbh->prepare($credited_sql) or die dbh->errstr;
- $credited_sth->execute or die $credited_sth->errstr;
- my $credited = $credited_sth->fetchrow_arrayref->[0] || 0;
-
- #horrible local kludge
- my $expenses_sql = "SELECT SUM(cust_bill_pkg.setup) FROM cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill._date >= $speriod AND cust_bill._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'";
- my $expenses_sth = dbh->prepare($expenses_sql) or die dbh->errstr;
- $expenses_sth->execute or die $expenses_sth->errstr;
- my $expenses = $expenses_sth->fetchrow_arrayref->[0] || 0;
-
- push @{$data{ar}}, $charged-$credited-$expenses;
-
- #deferred revenue
-# push @{$data{defer}}, '0';
-
- #cashflow
- my $paid_sql = "SELECT SUM(paid) FROM cust_pay $where";
- my $paid_sth = dbh->prepare($paid_sql) or die dbh->errstr;
- $paid_sth->execute or die $paid_sth->errstr;
- my $paid = $paid_sth->fetchrow_arrayref->[0] || 0;
-
- my $refunded_sql = "SELECT SUM(refund) FROM cust_refund $where";
- my $refunded_sth = dbh->prepare($refunded_sql) or die dbh->errstr;
- $refunded_sth->execute or die $refunded_sth->errstr;
- my $refunded = $refunded_sth->fetchrow_arrayref->[0] || 0;
-
- #horrible local kludge that doesn't even really work right
- my $expenses_sql = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND 0 < ( select count(*) from cust_bill_pkg, cust_pkg, part_pkg WHERE cust_bill.invnum = cust_bill_pkg.invnum AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%' )";
-
-# my $expenses_sql = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'";
- my $expenses_sth = dbh->prepare($expenses_sql) or die dbh->errstr;
- $expenses_sth->execute or die $expenses_sth->errstr;
- my $expenses = $expenses_sth->fetchrow_arrayref->[0] || 0;
-
- push @{$data{cash}}, $paid-$refunded-$expenses;
-
-}
-
-#my $chart = Chart::LinesPoints->new(1024,480);
-my $chart = Chart::LinesPoints->new(768,480);
-
-$chart->set(
- #'min_val' => 0,
- 'legend' => 'bottom',
- 'legend_labels' => [ #'Invoiced (cust_bill)',
- 'Accounts receivable (invoices - applied credits)',
- #'Deferred revenue',
- 'Actual cashflow (payments - refunds)' ],
-);
-
-my @data = ( \@labels,
- #map $data{$_}, qw( ar defer cash )
- #map $data{$_}, qw( charged ar cash )
- map $data{$_}, qw( ar cash )
- );
-
-#my $gd = $chart->plot(\@data);
-#open (IMG, ">i_r_c.png");
-#print IMG $gd->png;
-#close IMG;
-
-#$chart->png("i_r_c.png", \@data);
-
-#$chart->cgi_png(\@data);
-
-http_header('Content-Type' => 'image/png' );
-$Response->{ContentType} = 'image/png';
-
-$chart->_set_colors();
-
-%><%= $chart->scalar_png(\@data) %>
+++ /dev/null
-<!-- mason kludge %>
-<%
-
-#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
-my ($curmon,$curyear) = (localtime(time))[4,5];
-
-#find first month
-my $syear = $cgi->param('syear') || 1899+$curyear;
-my $smonth = $cgi->param('smonth') || $curmon+1;
-
-#find last month
-my $eyear = $cgi->param('eyear') || 1900+$curyear;
-my $emonth = $cgi->param('emonth') || $curmon+1;
-
-%>
-
-<HTML>
- <HEAD>
- <TITLE>Graphing monetary values over time</TITLE>
- </HEAD>
-<BODY BGCOLOR="#e8e8e8">
-<IMG SRC="money_time-graph.cgi?<%= $cgi->query_string %>" WIDTH="768" HEIGHT="480">
-<BR>
-<FORM METHOD="POST">
-<INPUT TYPE="checkbox" NAME="ar">
- Accounts receivable (invoices - applied credits)<BR>
-<INPUT TYPE="checkbox" NAME="charged">
- Just Invoices<BR>
-<INPUT TYPE="checkbox" NAME="defer">
- Accounts receivable, with deferred revenue (invoices - applied credits, with charges for annual/semi-annual/quarterly/etc. services deferred over applicable time period) (there has got to be a shorter description for this)<BR>
-<INPUT TYPE="checkbox" NAME="cash">
- Cashflow (payments - refunds)<BR>
-<BR>
-From <SELECT NAME="smonth">
-<% my @m = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
- foreach my $m ( 1..12 ) { %>
-<OPTION VALUE="<%= $m %>"<%= $m == $smonth ? ' SELECTED' : '' %>><%= $m[$m-1] %>
-<% } %>
-</SELECT>
-<SELECT NAME="syear">
-<% foreach my $y ( 1999 .. 2010 ) { %>
-<OPTION VALUE="<%= $y %>"<%= $y == $syear ? ' SELECTED' : '' %>><%= $y %>
-<% } %>
-</SELECT>
- to <SELECT NAME="emonth">
-<% foreach my $m ( 1..12 ) { %>
-<OPTION VALUE="<%= $m %>"<%= $m == $emonth ? ' SELECTED' : '' %>><%= $m[$m-1] %>
-<% } %>
-</SELECT>
-<SELECT NAME="eyear">
-<% foreach my $y ( 1999 .. 2010 ) { %>
-<OPTION VALUE="<%= $y %>"<%= $y == $eyear ? ' SELECTED' : '' %>><%= $y %>
-<% } %>
-</SELECT>
-
-<INPUT TYPE="submit" VALUE="Graph">
-</FORM>
-</BODY>
-</HTML>
<FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="phone_on" VALUE="1">Phone # <INPUT TYPE="text" NAME="phone_text"><INPUT TYPE="submit" VALUE="Search"></FORM>
<BR><FORM ACTION="search/svc_acct.cgi" METHOD="POST">Username <INPUT TYPE="text" NAME="username"><SELECT NAME="username_type"><OPTION VALUE="All">(all)</OPTION><OPTION>Fuzzy</OPTION><OPTION>Substring</OPTION><OPTION SELECTED>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_acct.cgi?username">all accounts by username</A> or <A HREF="search/svc_acct.cgi?uid">uid</A></FORM>
<BR><FORM ACTION="search/svc_domain.cgi" METHOD="POST">Domain <INPUT TYPE="text" NAME="domain"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_domain.cgi?domain">all domains</A></FORM>
+<!-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>-->
<!-- <LI><A HREF="search/svc_forward.html">mail forwards (by ?)</A>-->
<BR>
</TD></TR>
<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>
- <A HREF="search/report_cust_pay.html">Payments</A>
- <BR><BR>Financial reports
+ Financial reports
<UL>
<LI> <A HREF="search/report_receivables.cgi">current receivables</A>
<LI> <A HREF="search/report_tax.html">tax reports</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>
- <A HREF="search/report_cust_pay.html">Payments</A>
- <BR><BR>Financial reports
+ 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="browse/svc_acct_pop.cgi">View/Edit Access Numbers</A>
- Points of Presence
<LI><A HREF="browse/part_bill_event.cgi">View/Edit invoice events</A> - Actions for overdue invoices
- <LI><A HREF="browse/msgcat.cgi">View/Edit message catalog</A> - Change error messages and other customizable labels.
- <LI><A HREF="browse/part_sb_field.cgi">View/Edit custom svc_broadband fields</A>
- - Custom broadband service fields for site-specific export/informational data.
- <LI><A HREF="browse/generic.cgi?part_router_field">View/Edit custom router fields</A>
- - Custom router fields for site-specific export data.
- <LI><A HREF="browse/router.cgi">View/Edit routers</A>
- - Broadband access routers
- <LI><A HREF="browse/addr_block.cgi">View/Edit address blocks</A>
- - Manage address blocks and block assignments to broadband routers.
+ <LI><A HREF="browse/msgcat.cgi">View/Edit message catalog</A> - Change error messages and other customizable labels.
</ul>
<BR>
</TD></TR>
}
# add an absence of a catchall
-$email{''} = "(none)";
+$email{0} = "(none)";
my $p1 = popurl(1);
print header("Domain Catchall Edit", '');
my %link_field = (
'svc_acct' => 'username',
'svc_domain' => 'domain',
+ 'svc_acct_sm' => '',
'svc_charge' => '',
'svc_wo' => '',
);
+++ /dev/null
-<!-- mason kludge -->
-<%= header('Import') %>
-<FORM ACTION="process/meta-import.cgi" METHOD="post" ENCTYPE="multipart/form-data">
-Import data from a DBI data source<BR><BR>
-
-<%
- #false laziness with edit/cust_main.cgi
- my @agents = qsearch( 'agent', {} );
- die "No agents created!" unless @agents;
- my $agentnum = $agents[0]->agentnum; #default to first
-
- if ( scalar(@agents) == 1 ) {
-%>
- <INPUT TYPE="hidden" NAME="agentnum" VALUE="<%= $agentnum %>">
-<% } else { %>
- <BR><BR>Agent <SELECT NAME="agentnum" SIZE="1">
- <% foreach my $agent (sort { $a->agent cmp $b->agent } @agents) { %>
- <OPTION VALUE="<%= $agent->agentnum %>" <%= " SELECTED"x($agent->agentnum==$agentnum) %>><%= $agent->agent %></OPTION>
- <% } %>
- </SELECT><BR><BR>
-<% } %>
-
-<%
- my @referrals = qsearch('part_referral',{});
- die "No advertising sources created!" unless @referrals;
- my $refnum = $referrals[0]->refnum; #default to first
-
- if ( scalar(@referrals) == 1 ) {
-%>
- <INPUT TYPE="hidden" NAME="refnum" VALUE="<%= $refnum %>">
-<% } else { %>
- <BR><BR>Advertising source <SELECT NAME="refnum" SIZE="1">
- <% foreach my $referral ( sort { $a->referral <=> $b->referral } @referrals) { %>
- <OPTION VALUE="<%= $referral->refnum %>" <%= " SELECTED"x($referral->refnum==$refnum) %>><%= $referral->refnum %>: <%= $referral->referral %></OPTION>
- <% } %>
- </SELECT><BR><BR>
-<% } %>
-
- First package: <SELECT NAME="pkgpart"><OPTION VALUE="">(none)</OPTION>
-<% foreach my $part_pkg ( qsearch('part_pkg',{'disabled'=>'' }) ) { %>
- <OPTION VALUE="<%= $part_pkg->pkgpart %>"><%= $part_pkg->pkg. ' - '. $part_pkg->comment %></OPTION>
-<% } %>
-</SELECT><BR><BR>
-
- <table>
- <tr>
- <td align="right">DBI data source: </td>
- <td><INPUT TYPE="text" NAME="data_source"></td>
- </tr>
- <tr>
- <td align="right">DBI username: </td>
- <td><INPUT TYPE="text" NAME="username"></td>
- </tr>
- <tr>
- <td align="right">DBI password: </td>
- <td><INPUT TYPE="text" NAME="password"></td>
- </tr>
- </table>
- <INPUT TYPE="submit" VALUE="Import">
-
- </FORM>
- </BODY>
-<HTML>
-
+++ /dev/null
-<!-- mason kludge -->
-<%= header('Map tables') %>
-
-<SCRIPT>
-var gSafeOnload = new Array();
-var gSafeOnsubmit = new Array();
-window.onload = SafeOnload;
-function SafeAddOnLoad(f) {
- gSafeOnload[gSafeOnload.length] = f;
-}
-function SafeOnload() {
- for (var i=0;i<gSafeOnload.length;i++)
- gSafeOnload[i]();
-}
-function SafeAddOnSubmit(f) {
- gSafeOnsubmit[gSafeOnsubmit.length] = f;
-}
-function SafeOnsubmit() {
- for (var i=0;i<gSafeOnsubmit.length;i++)
- gSafeOnsubmit[i]();
-}
-</SCRIPT>
-
-<FORM NAME="OneTrueForm" METHOD="POST" ACTION="meta-import.cgi">
-
-<%
- #use DBIx::DBSchema;
- my $schema = new_native DBIx::DBSchema
- map { $cgi->param($_) } qw( data_source username password );
- foreach my $field (qw( data_source username password )) { %>
- <INPUT TYPE="hidden" NAME=<%= $field %> VALUE="<%= $cgi->param($field) %>">
- <% }
-
- my %schema;
- use Tie::DxHash;
- tie %schema, 'Tie::DxHash';
- if ( $cgi->param('schema') ) {
- my $schema_string = $cgi->param('schema');
- %> <INPUT TYPE="hidden" NAME="schema" VALUE="<%=$schema_string%>"> <%
- %schema = map { /^\s*(\w+)\s*=>\s*(\w+)\s*$/
- or die "guru meditation #420: $_";
- ( $1 => $2 );
- }
- split( /\n/, $schema_string );
- }
-
- #first page
- unless ( $cgi->param('magic') ) { %>
-
- <INPUT TYPE="hidden" NAME="magic" VALUE="process">
- <%= hashmaker('schema', [ $schema->tables ],
- [ grep !/^h_/, dbdef->tables ], ) %>
- <br><INPUT TYPE="submit" VALUE="done">
- <%
-
- #second page
- } elsif ( $cgi->param('magic') eq 'process' ) { %>
-
- <INPUT TYPE="hidden" NAME="magic" VALUE="process2">
- <%
-
- my %unique;
- foreach my $table ( keys %schema ) {
-
- my @from_columns = $schema->table($table)->columns;
- my @fs_columns = dbdef->table($schema{$table})->columns;
-
- %>
- <%= hashmaker( $table.'__'.$unique{$table}++,
- \@from_columns => \@fs_columns,
- $table => $schema{$table}, ) %>
- <br><hr><br>
- <%
-
- }
-
- %>
- <br><INPUT TYPE="submit" VALUE="done">
- <%
-
- #third (results)
- } elsif ( $cgi->param('magic') eq 'process2' ) {
-
- print "<pre>\n";
-
- my %unique;
- foreach my $table ( keys %schema ) {
- ( my $spaces = $table ) =~ s/./ /g;
- print "'$table' => { 'table' => '$schema{$table}',\n".
- #(length($table) x ' '). " 'map' => {\n";
- "$spaces 'map' => {\n";
- my %map = map { /^\s*(\w+)\s*=>\s*(\w+)\s*$/
- or die "guru meditation #420: $_";
- ( $1 => $2 );
- }
- split( /\n/, $cgi->param($table.'__'.$unique{$table}++) );
- foreach ( keys %map ) {
- print "$spaces '$_' => '$map{$_}',\n";
- }
- print "$spaces },\n";
- print "$spaces },\n";
-
- }
- print "\n</pre>";
-
- } else {
- warn "unrecognized magic: ". $cgi->param('magic');
- }
-
- %>
-</FORM>
-</BODY>
-</HTML>
-
- <%
- #hashmaker widget
- sub hashmaker {
- my($name, $from, $to, $labelfrom, $labelto) = @_;
- $fromsize = scalar(@$from);
- $tosize = scalar(@$to);
- "<TABLE><TR><TH>$labelfrom</TH><TH>$labelto</TH></TR><TR><TD>".
- qq!<SELECT NAME="${name}_from" SIZE=$fromsize>\n!.
- join("\n", map { qq!<OPTION VALUE="$_">$_</OPTION>! } sort { $a cmp $b } @$from ).
- "</SELECT>\n<BR>".
- qq!<INPUT TYPE="button" VALUE="refill" onClick="repack_${name}_from()">!.
- '</TD><TD>'.
- qq!<SELECT NAME="${name}_to" SIZE=$tosize>\n!.
- join("\n", map { qq!<OPTION VALUE="$_">$_</OPTION>! } sort { $a cmp $b } @$to ).
- "</SELECT>\n<BR>".
- qq!<INPUT TYPE="button" VALUE="refill" onClick="repack_${name}_to()">!.
- '</TD></TR>'.
- '<TR><TD COLSPAN=2>'.
- qq!<INPUT TYPE="button" VALUE="map" onClick="toke_$name(this.form)">!.
- '</TD></TR><TR><TD COLSPAN=2>'.
- qq!<TEXTAREA NAME="$name" COLS=80 ROWS=8></TEXTAREA>!.
- '</TD></TR></TABLE>'.
- "<script>
- function toke_$name() {
- fromObject = document.OneTrueForm.${name}_from;
- for (var i=fromObject.options.length-1;i>-1;i--) {
- if (fromObject.options[i].selected)
- fromname = deleteOption_$name(fromObject,i);
- }
- toObject = document.OneTrueForm.${name}_to;
- for (var i=toObject.options.length-1;i>-1;i--) {
- if (toObject.options[i].selected)
- toname = deleteOption_$name(toObject,i);
- }
- document.OneTrueForm.$name.value = document.OneTrueForm.$name.value + fromname + ' => ' + toname + '\\n';
- }
- function deleteOption_$name(object,index) {
- value = object.options[index].value;
- object.options[index] = null;
- return value;
- }
- function repack_${name}_from() {
- var object = document.OneTrueForm.${name}_from;
- object.options.length = 0;
- ". join("\n",
- map { "addOption_$name(object, '$_');\n" }
- ( sort { $a cmp $b } @$from ) ). "
- }
- function repack_${name}_to() {
- var object = document.OneTrueForm.${name}_to;
- object.options.length = 0;
- ". join("\n",
- map { "addOption_$name(object, '$_');\n" }
- ( sort { $a cmp $b } @$to ) ). "
- }
- function addOption_$name(object,value) {
- var length = object.length;
- object.options[length] = new Option(value, value, false, false);
- }
- </script>".
- '';
- }
-
-%>
$card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n";
my($payinfo)=$1;
- [ qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'}),
- qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'DCRD'})
- ];
+ [ qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'}) ];
}
sub referralsearch {
<%
-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 ";
- }
-
- @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,
+$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,
'payby' => $payby } );
- $sortby = \*date_sort;
-
-}
+my $sortby = \*date_sort;
if (0) {
#if ( scalar(@cust_pay) == 1 ) {
%>
<!-- mason kludge -->
<%
- idiot("Payment not found.");
+ idiot("Check # not found.");
#exit;
} else {
my $total = scalar(@cust_pay);
%>
<!-- mason kludge -->
<%
- print header("Payment Search Results", menubar(
+ print header("Check # Search Results", menubar(
'Main Menu', popurl(2)
- )), "$total matching payment$s found<BR>", &table(), <<END;
+ )), "$total matching check$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, $payby, $payinfo, $amount, $date ) = (
+ my($paynum, $custnum, $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>$payment_info</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$payinfo</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})$/ ) {
<TH><FONT SIZE=-1>Setup</FONT></TH>
END
- print '<TH><FONT SIZE=-1>Last<BR>bill</FONT></TH>'
+ print '<TH><FONT SIZE=-1>Next<BR>bill</FONT></TH>'
if defined dbdef->table('cust_pkg')->column('last_bill');
print <<END;
<!-- mason kludge -->
<%
-my $user = getotaker;
+#my $user = getotaker;
+my $user = $FS::UID::user; #dumb 1.4 8-char workaround
$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
my $beginning = $1;
<!-- mason kludge -->
<%
-my $user = getotaker;
+#my $user = getotaker;
+my $user = $FS::UID::user; #dumb 1.4 8-char workaround
$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
my $beginning = $1;
<!-- mason kludge -->
<%
-my $user = getotaker;
+#my $user = getotaker;
+my $user = $FS::UID::user; #dumb 1.4 8-char workaround
print header('Current Receivables Report Results');
<!-- mason kludge -->
<%
-my $user = getotaker;
+#my $user = getotaker;
+my $user = $FS::UID::user; #dumb 1.4 8-char workaround
$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
my $beginning = $1;
<%
+my $mydomain = '';
+
my $conf = new FS::Conf;
my $maxrecords = $conf->config('maxsearchrecordsperpage');
$domain = "<A HREF=\"${p}view/svc_domain.cgi?". $svc_domain->svcnum.
"\">". $svc_domain->domain. "</A>";
} else {
- die "No svc_domain.svcnum record for svc_acct.domsvc: ".
- $svc_acct->domsvc;
+ unless ( $mydomain ) {
+ my $conf = new FS::Conf;
+ unless ( $mydomain = $conf->config('domain') ) {
+ die "No legacy domain config file and no svc_domain.svcnum record ".
+ "for svc_acct.domsvc: ". $svc_acct->domsvc;
+ }
+ }
+ $domain = "<i>$mydomain</i><FONT COLOR=\"#FF0000\">*</FONT>";
}
my($cust_pkg,$cust_main);
if ( $cust_svc->pkgnum ) {
}
- print "</TABLE>$pager<BR>".
- '</BODY></HTML>';
+ print "</TABLE>$pager<BR>";
+
+ if ( $mydomain ) {
+ print "<BR><FONT COLOR=\"#FF0000\">*</FONT> The <I>$mydomain</I> domain ".
+ "is contained in your legacy <CODE>domain</CODE> ".
+ "<A HREF=\"${p}docs/config.html#domain\">configuration file</A>. ".
+ "You should run the <CODE>bin/fs-migrate-svc_acct_sm</CODE> script ".
+ "to create a proper svc_domain record for this domain.";
+ }
+
+ print '</BODY></HTML>';
}
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
+my $domuser = $1;
+
+$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
+my $svc_domain = qsearchs('svc_domain',{'domain'=>$1})
+ or die "Unknown domain";
+my $domsvc = $svc_domain->svcnum;
+
+my @svc_acct_sm;
+if ($domuser) {
+ @svc_acct_sm=qsearch('svc_acct_sm',{
+ 'domuser' => $domuser,
+ 'domsvc' => $domsvc,
+ });
+} else {
+ @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
+}
+
+if ( scalar(@svc_acct_sm) == 1 ) {
+ my($svcnum)=$svc_acct_sm[0]->svcnum;
+ print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum");
+} elsif ( scalar(@svc_acct_sm) > 1 ) {
+%>
+<!-- mason kludge -->
+<%
+ print header('Mail Alias Search Results'), &table(), <<END;
+ <TR>
+ <TH>Mail to<BR><FONT SIZE=-1>(click to view mail alias)</FONT></TH>
+ <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ </TR>
+END
+
+ my($svc_acct_sm);
+ foreach $svc_acct_sm (@svc_acct_sm) {
+ my($svcnum,$domuser,$domuid,$domsvc)=(
+ $svc_acct_sm->svcnum,
+ $svc_acct_sm->domuser,
+ $svc_acct_sm->domuid,
+ $svc_acct_sm->domsvc,
+ );
+
+ my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } );
+ if ( $svc_domain ) {
+ my $domain = $svc_domain->domain;
+
+ print qq!<TR><TD><A HREF="!. popurl(2). qq!view/svc_acct_sm.cgi?$svcnum">!,
+ #print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
+ ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ),
+ qq!\@$domain</A> </TD>!,
+ ;
+ } else {
+ my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum";
+ warn $warning;
+ print "<TR><TD>WARNING: $warning</TD>";
+ }
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } );
+ if ( $svc_acct ) {
+ my $username = $svc_acct->username;
+ my $svc_acct_svcnum =$svc_acct->svcnum;
+ print qq!<TD><A HREF="!, popurl(2),
+ qq!view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A>!,
+ qq!</TD></TR>!
+ ;
+ } else {
+ my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!";
+ warn $warning;
+ print "<TD>WARNING: $warning</TD></TR>";
+ }
+
+ }
+
+ print '</TABLE></BODY></HTML>';
+
+} else { #error
+ idiot("Mail Alias not found");
+}
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Mail Alias Search</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Mail Alias Search</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
+ Search for <B>mail alias</B>:
+ <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
+ <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
<%
my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
my($query)=$cgi->keywords;
$query ||= ''; #to avoid use of unitialized value errors
$svc_domain->svcnum,
$svc_domain->domain,
);
+ #my($malias);
+ #if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) {
+ # $malias=(
+ # qq|<FORM ACTION="svc_acct_sm.cgi" METHOD="post">|.
+ # qq|<INPUT TYPE="hidden" NAME="domuser" VALUE="">|.
+ # qq|<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">|.
+ # qq|<INPUT TYPE="submit" VALUE="(mail aliases)">|.
+ # qq|</FORM>|
+ # );
+ #} else {
+ # $malias='';
+ #}
#don't display all accounts here
my $rowspan = 1;
'Main Menu' => popurl(2)
));
-print <<END;
-<STYLE TYPE="text/css">
-.package TH { font-size: medium }
-.package TR { font-size: smaller }
-.package .pkgnum { font-size: medium }
-.package .provision { font-weight: bold }
-</STYLE>
-END
-
die "No customer specified (bad URL)!" unless $cgi->keywords;
my($query) = $cgi->keywords; # needs parens with my, ->keywords returns array
$query =~ /^(\d+)$/;
'<TR><TD ALIGN="right">Billing type</TD><TD BGCOLOR="#ffffff">',
;
- if ( $cust_main->payby eq 'CARD' || $cust_main->payby eq 'DCRD' ) {
+ if ( $cust_main->payby eq 'CARD' ) {
my $payinfo = $cust_main->payinfo;
$payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
- print 'Credit card ',
- ( $cust_main->payby eq 'CARD' ? '(automatic)' : '(on-demand)' ),
- '</TD></TR>',
+ print 'Credit card</TD></TR>',
'<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">',
$payinfo, '</TD></TR>',
'<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
'<TR><TD ALIGN="right">Name on card</TD><TD BGCOLOR="#ffffff">',
$cust_main->payname, '</TD></TR>'
;
- } elsif ( $cust_main->payby eq 'CHEK' || $cust_main->payby eq 'DCHK') {
+ } elsif ( $cust_main->payby eq 'CHEK' ) {
my( $account, $aba ) = split('@', $cust_main->payinfo );
- print 'Electronic check',
- ( $cust_main->payby eq 'CHEK' ? '(automatic)' : '(on-demand)' ),
- '</TD></TR>',
+ print 'Electronic check</TD></TR>',
'<TR><TD ALIGN="right">Account number</TD><TD BGCOLOR="#ffffff">',
$account, '</TD></TR>',
'<TR><TD ALIGN="right">ABA/Routing code</TD><TD BGCOLOR="#ffffff">',
qq!( <A HREF="!, popurl(2), qq!edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> (preserves services) )!,
;
-#begin display packages
+#display packages
#get package info
+my @packages;
+if ( $conf->exists('hidecancelledpackages') ) {
+ @packages = sort { $a->pkgnum <=> $b->pkgnum } ($cust_main->ncancelled_pkgs);
+} else {
+ @packages = sort { $a->pkgnum <=> $b->pkgnum } ($cust_main->all_pkgs);
+}
-my $packages = get_packages($cust_main);
+if ( @packages ) {
+ #formatting
-if ( @$packages ) {
-%>
-<TABLE CLASS="package" BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">
-<TR>
- <TH COLSPAN=2>Package</TH>
- <TH>Status</TH>
- <TH COLSPAN=2>Services</TH>
-</TR>
-<%
-foreach my $pkg (sort pkgsort_pkgnum_cancel @$packages) {
- my $rowspan = 0;
+ my $colspan = $packages[0]->dbdef_table->column('last_bill') ? 6 : 5;
+
+ print &table(), "\n",
+ qq!<TR><TH COLSPAN=2 ROWSPAN=2>Package</TH><TH COLSPAN=$colspan>!,
+ qq!Dates</TH><TH COLSPAN=2 ROWSPAN=2>Services</TH></TR>\n<TR>!,
+ qq!<TH><FONT SIZE=-1>Setup</FONT></TH>!;
+
+ print qq!<TH><FONT SIZE=-1>Last bill</FONT></TH>!
+ if $packages[0]->dbdef_table->column('last_bill');
+
+ print qq!<TH><FONT SIZE=-1>Next bill</FONT></TH>!,
+ qq!<TH><FONT SIZE=-1>Susp.</FONT></TH>!,
+ qq!<TH><FONT SIZE=-1>Expire</FONT></TH>!,
+ qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
+ qq!</TR>\n!;
+}
- if ($pkg->{cancel}) {
- $rowspan = 0;
- } else {
- foreach my $svcpart (@{$pkg->{svcparts}}) {
- $rowspan += $svcpart->{count};
- $rowspan++ if ($svcpart->{count} < $svcpart->{quantity});
- }
- }
+my $n1 = '<TR>';
+foreach my $package (@packages) {
+ my $pkgnum = $package->pkgnum;
+ my $pkg = $package->part_pkg->pkg;
+ my $comment = $package->part_pkg->comment;
+ my $pkgview = popurl(2). "view/cust_pkg.cgi?$pkgnum";
-%>
-<!--pkgnum: <%=$pkg->{pkgnum}%>-->
-<TR>
- <TD ROWSPAN=<%=$rowspan%> CLASS="pkgnum"><%=$pkg->{pkgnum}%></TD>
- <TD ROWSPAN=<%=$rowspan%>>
- <%=$pkg->{pkg}%> - <%=$pkg->{comment}%> ( <%=pkg_details_link($pkg)%> )<BR>
-<% unless ($pkg->{cancel}) { %>
- ( <%=pkg_change_link($pkg)%> )
- ( <%=pkg_dates_link($pkg)%> | <%=pkg_customize_link($pkg)%> )
-<% } %>
- </TD>
-<%
- #foreach (qw(setup last_bill next_bill susp expire cancel)) {
- # print qq! <TD ROWSPAN=$rowspan>! . pkg_datestr($pkg,$_) . qq!</TD>\n!;
- #}
- print "<TD ROWSPAN=$rowspan>". &itable('');
-
- #move
- my %freq = (
- 1 => 'monthly',
- 2 => 'bi-monthly',
- 3 => 'quarterly',
- 6 => 'semi-annually',
- 12 => 'annually',
- 24 => 'bi-annually',
- 36 => 'tri-annually',
- );
-
- sub freq {
- my $freq = shift;
- exists $freq{$freq} ? $freq{$freq} : "every $freq months";
+ #my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } );
+ #my $rowspan = scalar(@cust_svc) || 1;
+ my @cust_svc = ();
+ my $rowspan = 0;
+ my %pkg_svc = ();
+ unless ( $package->getfield('cancel') ) {
+ foreach my $pkg_svc (
+ grep { $_->quantity }
+ qsearch('pkg_svc',{'pkgpart'=> $package->pkgpart })
+ ) {
+ $rowspan += ( $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity );
+ }
+ } else {
+ #@cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } );
+ @cust_svc = ();
+ $rowspan = scalar(@cust_svc) || 1;
}
+ $rowspan ||= 1;
+
+ my $button_cgi = new CGI;
+ $button_cgi->param('clone', $package->part_pkg->pkgpart);
+ $button_cgi->param('pkgnum', $package->pkgnum);
+ my $button_url = popurl(2). "edit/part_pkg.cgi?". $button_cgi->query_string;
+
+ #print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview">$pkgnum</A></TD>!,
+ print $n1, qq!<TD ROWSPAN=$rowspan>$pkgnum</TD>!,
+ qq!<TD ROWSPAN=$rowspan><FONT SIZE=-1>!,
+ #qq!<A HREF="$pkgview">$pkg - $comment</A>!,
+ qq!$pkg - $comment ( <a href="$pkgview">Details</a> )!;
+ # | !;
- #eomove
+ #false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
+ unless ( $package->getfield('cancel') ) {
- if ( $pkg->{cancel} ) { #status: cancelled
+ print qq! ( <A HREF="${p}misc/change_pkg.cgi?$pkgnum">!.
+ 'Change package</A> )';
- 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>';
+ print ' ( ';
+ if ( $package->getfield('susp') ) {
+ print qq!<A HREF="${p}misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>!;
} else {
- print "<TR><TD>Setup </TD><TD>".
- pkg_datestr($pkg, 'setup'). '</TD></TR>';
- print "<TR><TD>Last bill </TD><TD>".
- pkg_datestr($pkg, 'last_bill'). '</TD></TR>'
- if $pkg->{'last_bill'};
- print "<TR><TD>Suspended </TD><TD>".
- pkg_datestr($pkg, 'susp'). '</TD></TR>'
- if $pkg->{'susp'};
+ print qq!<A HREF="${p}misc/susp_pkg.cgi?$pkgnum">Suspend</A>!;
}
+ print ' | <A HREF="javascript:cust_pkg_areyousure(\''. popurl(2).
+ 'misc/cancel_pkg.cgi?'. $pkgnum. '\')">Cancel</A>';
+
+ print ' ) ';
- } else {
+ print ' ( <A HREF="'. popurl(2). 'edit/REAL_cust_pkg.cgi?'. $pkgnum.
+ '">Edit dates</A> | ';
+
+ print qq!<A HREF="$button_url">Customize</A> )!;
+
+ }
+ print '</FONT></TD>';
+
+ my @fields = qw( setup );
+ push @fields, qw( last_bill ) if $package->dbdef_table->column('last_bill');
+ push @fields, qw( bill susp expire cancel);
+
+ for ( @fields ) {
+ print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_)
+ ? time2str("%D</FONT><BR><FONT SIZE=-3>%l:%M:%S%P %z</FONT>",
+ $package->getfield($_) )
+ : ' '
+ ), '</FONT></TD>',
+ ;
+ }
- if ( $pkg->{susp} ) { #status: suspended
- print '<TR><TD><FONT COLOR="#FF9900"><B>Suspended</B> </FONT></TD>'.
- '<TD>'. pkg_datestr($pkg,'susp'). '</TD></TR>';
- unless ( $pkg->{setup} ) {
- print '<TR><TD COLSPAN=2>Never billed</TD></TR>';
+ my $n2 = '';
+ #false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
+ #foreach my $cust_svc ( @cust_svc ) {
+ foreach my $svcpart ( sort { $a<=>$b } keys %pkg_svc ) {
+ my $svc = qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
+ $svc =~ s/ / /g;
+ my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
+ 'svcpart'=>$svcpart,
+ });
+ for my $enum ( 1 .. $pkg_svc{$svcpart} ) {
+ my $cust_svc;
+ if ( $cust_svc = shift @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my($svcnum) = $cust_svc->svcnum;
+ my($sview) = popurl(2). "view";
+ print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
+ qq!<TD><FONT SIZE=-1><A HREF="$sview/$svcdb.cgi?$svcnum">$value</A><BR>( <A HREF="javascript:svc_areyousure('${p}misc/unprovision.cgi?$svcnum')">Unprovision</A> )</FONT></TD>!;
} else {
- print "<TR><TD>Setup </TD><TD>".
- pkg_datestr($pkg, 'setup'). '</TD></TR>';
- }
- print "<TR><TD>Last bill </TD><TD>".
- pkg_datestr($pkg, 'last_bill'). '</TD></TR>'
- if $pkg->{'last_bill'};
- # next bill ??
- print "<TR><TD>Expires </TD><TD>".
- pkg_datestr($pkg, 'expire'). '</TD></TR>'
- if $pkg->{'expire'};
- print '<TR><TD COLSPAN=2>( '. pkg_unsuspend_link($pkg).
- ' | '. pkg_cancel_link($pkg). ' )</TD></TR>';
-
- } else { #status: active
-
- unless ( $pkg->{setup} ) { #not setup
-
- print '<TR><TD COLSPAN=2>Not yet billed (';
- unless ( $pkg->{freq} ) {
- print 'one-time charge)</TD></TR>';
- print '<TR><TD COLSPAN=2>( '. pkg_cancel_link($pkg).
- ' )</TD</TR>';
- } else {
- print 'billed '. freq($pkg->{freq}). ')</TD></TR>';
- }
-
- } else { #setup
-
- unless ( $pkg->{freq} ) {
- print "<TR><TD COLSPAN=2>One-time charge</TD></TR>".
- '<TR><TD>Billed </TD><TD>'.
- pkg_datestr($pkg,'setup'). '</TD></TR>';
- } else {
- print '<TR><TD COLSPAN=2><FONT COLOR="#00CC00"><B>Active</B></FONT>'.
- ', billed '. freq($pkg->{freq}). '</TD></TR>'.
- '<TR><TD>Setup </TD><TD>'.
- pkg_datestr($pkg, 'setup'). '</TD></TR>';
- }
+ print $n2, qq!<TD COLSPAN=2><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart"><b><font size="+1" color="#ff0000">!.
+ qq!Provision $svc</A></b></font>!;
- }
+ print qq!<BR><A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">!.
+ qq!<b><font size="+1" color="#ff0000">Link to legacy $svc</A></b></font>!
+ if $conf->exists('legacy_link');
- print "<TR><TD>Last bill </TD><TD>".
- pkg_datestr($pkg, 'last_bill'). '</TD></TR>'
- if $pkg->{'last_bill'};
- print "<TR><TD>Next bill </TD><TD>".
- pkg_datestr($pkg, 'next_bill'). '</TD></TR>'
- if $pkg->{'next_bill'};
- print "<TR><TD>Expires </TD><TD>".
- pkg_datestr($pkg, 'expire'). '</TD></TR>'
- if $pkg->{'expire'};
- if ( $pkg->{freq} ) {
- print '<TR><TD COLSPAN=2>( '. pkg_suspend_link($pkg).
- ' | '. pkg_cancel_link($pkg). ' )</TD></TR>';
+ print '</TD>';
}
-
+ $n2="</TR><TR>";
}
-
}
- print "</TABLE></TD>\n";
-
- if ($rowspan == 0) { print qq!</TR>\n!; next; }
-
- my $cnt = 0;
- foreach my $svcpart (sort {$a->{svcpart} <=> $b->{svcpart}} @{$pkg->{svcparts}}) {
- foreach my $service (@{$svcpart->{services}}) {
- print '<TR>' if ($cnt > 0);
-%>
- <TD><%=svc_link($svcpart,$service)%></TD>
- <TD><%=svc_label_link($svcpart,$service)%><BR>( <%=svc_unprovision_link($service)%> )</TD>
-</TR>
-<%
- $cnt++;
- }
- if ($svcpart->{count} < $svcpart->{quantity}) {
- print qq!<TR>\n! if ($cnt > 0);
- print qq! <TD COLSPAN=2>!.svc_provision_link($pkg,$svcpart).qq!</TD>\n</TR>\n!;
- }
- }
-}
-print '</TABLE>'
-}
+ $n1="</TR><TR>";
+}
+print "</TR>";
-#end display packages
+#formatting
+print "</TABLE>";
print <<END;
sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0]; }
%>
-
-<%
-
-
-sub get_packages {
-
-my $cust_main = shift or return undef;
-
-my @packages = ();
-
-foreach my $cust_pkg (($conf->exists('hidecancelledpackages') ? ($cust_main->ncancelled_pkgs)
- : ($cust_main->all_pkgs))) {
-
- my $part_pkg = $cust_pkg->part_pkg;
-
- my %pkg = ();
- $pkg{pkgnum} = $cust_pkg->pkgnum;
- $pkg{pkg} = $part_pkg->pkg;
- $pkg{pkgpart} = $part_pkg->pkgpart;
- $pkg{comment} = $part_pkg->getfield('comment');
- $pkg{freq} = $part_pkg->freq;
- $pkg{setup} = $cust_pkg->getfield('setup');
- $pkg{last_bill} = $cust_pkg->getfield('last_bill');
- $pkg{next_bill} = $cust_pkg->getfield('bill');
- $pkg{susp} = $cust_pkg->getfield('susp');
- $pkg{expire} = $cust_pkg->getfield('expire');
- $pkg{cancel} = $cust_pkg->getfield('cancel');
-
- $pkg{svcparts} = [];
-
- foreach my $pkg_svc (qsearch('pkg_svc', { 'pkgpart' => $part_pkg->pkgpart })) {
-
- next if ($pkg_svc->quantity == 0);
-
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $pkg_svc->svcpart });
-
- my $svcpart = {};
- $svcpart->{svcpart} = $part_svc->svcpart;
- $svcpart->{svc} = $part_svc->svc;
- $svcpart->{svcdb} = $part_svc->svcdb;
- $svcpart->{quantity} = $pkg_svc->quantity;
- $svcpart->{count} = 0;
-
- $svcpart->{services} = [];
-
- foreach my $cust_svc (qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $part_svc->svcpart } )) {
-
- my $svc = {};
- $svc->{svcnum} = $cust_svc->svcnum;
- $svc->{label} = ($cust_svc->label)[1];
-
- push @{$svcpart->{services}}, $svc;
-
- $svcpart->{count}++;
-
- }
-
- push @{$pkg{svcparts}}, $svcpart;
-
- }
-
- push @packages, \%pkg;
-
-}
-
-return \@packages;
-
-}
-
-sub svc_link {
-
- my ($svcpart, $svc) = (shift,shift) or return '';
- return qq!<A HREF="${p}view/$svcpart->{svcdb}.cgi?$svc->{svcnum}">$svcpart->{svc}</A>!;
-
-}
-
-sub svc_label_link {
-
- my ($svcpart, $svc) = (shift,shift) or return '';
- return qq!<A HREF="${p}view/$svcpart->{svcdb}.cgi?$svc->{svcnum}">$svc->{label}</A>!;
-
-}
-
-sub svc_provision_link {
- my ($pkg, $svcpart) = (shift,shift) or return '';
- ( 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}">! .
- "Provision $svc_nbsp (".
- ($svcpart->{quantity} - $svcpart->{count}).
- ')</A>';
-}
-
-sub svc_unprovision_link {
- my $svc = shift or return '';
- return qq!<A HREF="javascript:svc_areyousure('${p}misc/unprovision.cgi?$svc->{svcnum}')">Unprovision</A>!;
-}
-
-# This should be generalized to use config options to determine order.
-sub pkgsort_pkgnum_cancel {
- if ($a->{cancel} and $b->{cancel}) {
- return ($a->{pkgnum} <=> $b->{pkgnum});
- } elsif ($a->{cancel} or $b->{cancel}) {
- return (-1) if ($b->{cancel});
- return (1) if ($a->{cancel});
- return (0);
- } else {
- return($a->{pkgnum} <=> $b->{pkgnum});
- }
-}
-
-sub pkg_datestr {
- my($pkg, $field) = @_ or return '';
- return ' ' unless $pkg->{$field};
- my $format = $conf->exists('pkg_showtimes')
- ? '<B>%D</B> <FONT SIZE=-3>%l:%M:%S%P %z</FONT>'
- : '<B>%b %o, %Y</B>';
- ( my $strip = time2str($format, $pkg->{$field}) ) =~ s/ (\d)/$1/g;
- $strip;
-}
-
-sub pkg_details_link {
- my $pkg = shift or return '';
- return qq!<a href="${p}view/cust_pkg.cgi?$pkg->{pkgnum}">Details</a>!;
-}
-
-sub pkg_change_link {
- my $pkg = shift or return '';
- return qq!<a href="${p}misc/change_pkg.cgi?$pkg->{pkgnum}">Change package</a>!;
-}
-
-sub pkg_suspend_link {
- my $pkg = shift or return '';
- return qq!<a href="${p}misc/susp_pkg.cgi?$pkg->{pkgnum}">Suspend</a>!;
-}
-
-sub pkg_unsuspend_link {
- my $pkg = shift or return '';
- return qq!<a href="${p}misc/unsusp_pkg.cgi?$pkg->{pkgnum}">Unsuspend</a>!;
-}
-
-sub pkg_cancel_link {
- my $pkg = shift or return '';
- return qq!<A HREF="javascript:cust_pkg_areyousure('${p}misc/cancel_pkg.cgi?$pkg->{pkgnum}')">Cancel</A>!;
-}
-
-sub pkg_dates_link {
- my $pkg = shift or return '';
- return qq!<A HREF="${p}edit/REAL_cust_pkg.cgi?$pkg->{pkgnum}">Edit dates</A>!;
-}
-
-sub pkg_customize_link {
- my $pkg = shift or return '';
- return qq!<A HREF="${p}edit/part_pkg.cgi?keywords=$custnum;clone=$pkg->{pkgpart};pkgnum=$pkg->{pkgnum}">Customize</A>!;
-}
-
-%>
-
( $setup ? time2str("%D",$setup) : "(Not setup)" ), '</TD></TR>';
print '<TR><TD ALIGN="right">Last bill date</TD><TD BGCOLOR="#ffffff">',
- ( $cust_pkg->get('last_bill') ? time2str("%D",$cust_pkg->get('last_bill')) : " " ),
+ ( $cust_pkg->last_bill ? time2str("%D",$cust_pkg->last_bill) : " " ),
'</TD></TR>'
if $cust_pkg->dbdef_table->column('last_bill');
<%
my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
my($query) = $cgi->keywords;
$query =~ /^(\d+)$/;
die "Unknown domain" unless $svc_domain;
$domain = $svc_domain->domain;
} else {
- die "No svc_domain.svcnum record for svc_acct.domsvc: ". $cust_svc->domsvc;
+ unless ( $mydomain ) {
+ die "No legacy domain config file and no svc_domain.svcnum record ".
+ "for svc_acct.domsvc: ". $cust_svc->domsvc;
+ }
+ $domain = $mydomain;
}
%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_acct_sm;
+
+my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+my $pkgnum = $cust_svc->getfield('pkgnum');
+my($cust_pkg, $custnum);
+if ($pkgnum) {
+ $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ $custnum=$cust_pkg->getfield('custnum');
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+
+my $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } )
+ or die "Unkonwn svcpart";
+
+print header('Mail Alias View', menubar(
+ ( ( $pkgnum || $custnum )
+ ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ( "Cancel this (unaudited) account" =>
+ "${p}misc/cancel-unaudited.cgi?$svcnum" )
+ ),
+ "Main menu" => $p,
+));
+
+my($domsvc,$domuid,$domuser) = (
+ $svc_acct_sm->domsvc,
+ $svc_acct_sm->domuid,
+ $svc_acct_sm->domuser,
+);
+my $svc = $part_svc->svc;
+my $svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc})
+ or die "Corrupted database: no svc_domain.svcnum matching domsvc $domsvc";
+my $domain = $svc_domain->domain;
+my $svc_acct = qsearchs('svc_acct',{'uid'=>$domuid})
+ or die "Corrupted database: no svc_acct.uid matching domuid $domuid";
+my $username = $svc_acct->username;
+
+print qq!<A HREF="${p}edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>!,
+ "<BR>Service #$svcnum",
+ "<BR>Service: <B>$svc</B>",
+ qq!<BR>Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!,
+ '</BODY></HTML>'
+;
+
+%>
+++ /dev/null
-<!-- mason kludge -->
-<%
-
-my($query) = $cgi->keywords;
-$query =~ /^(\d+)$/;
-my $svcnum = $1;
-my $svc_broadband = qsearchs( 'svc_broadband', { 'svcnum' => $svcnum } )
- or die "svc_broadband: Unknown svcnum $svcnum";
-
-#false laziness w/all svc_*.cgi
-my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $svcnum } );
-my $pkgnum = $cust_svc->getfield('pkgnum');
-my($cust_pkg, $custnum);
-if ($pkgnum) {
- $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $pkgnum } );
- $custnum = $cust_pkg->custnum;
-} else {
- $cust_pkg = '';
- $custnum = '';
-}
-#eofalse
-
-my $router = $svc_broadband->addr_block->router;
-
-if (not $router) { die "Could not lookup router for svc_broadband (svcnum $svcnum)" };
-
-my (
- $routername,
- $routernum,
- $speed_down,
- $speed_up,
- $ip_addr
- ) = (
- $router->getfield('routername'),
- $router->getfield('routernum'),
- $svc_broadband->getfield('speed_down'),
- $svc_broadband->getfield('speed_up'),
- $svc_broadband->getfield('ip_addr')
- );
-
-
-
-print header('Broadband Service View', menubar(
- ( ( $custnum )
- ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
- "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
- )
- : ( "Cancel this (unaudited) website" =>
- "${p}misc/cancel-unaudited.cgi?$svcnum" )
- ),
- "Main menu" => $p,
-)).
- qq!<A HREF="${p}edit/svc_broadband.cgi?$svcnum">Edit this information</A><BR>!.
- ntable("#cccccc"). '<TR><TD>'. ntable("#cccccc",2).
- qq!<TR><TD ALIGN="right">Service number</TD>!.
- qq!<TD BGCOLOR="#ffffff">$svcnum</TD></TR>!.
- qq!<TR><TD ALIGN="right">Router</TD>!.
- qq!<TD BGCOLOR="#ffffff">$routernum: $routername</TD></TR>!.
- qq!<TR><TD ALIGN="right">Download Speed</TD>!.
- qq!<TD BGCOLOR="#ffffff">$speed_down</TD></TR>!.
- qq!<TR><TD ALIGN="right">Upload Speed</TD>!.
- qq!<TD BGCOLOR="#ffffff">$speed_up</TD></TR>!.
- qq!<TR><TD ALIGN="right">IP Address</TD>!.
- qq!<TD BGCOLOR="#ffffff">$ip_addr</TD></TR>!.
- '</TD></TR><TR ROWSPAN="1"><TD></TD></TR>';
-
-
-# foreach my $sb_field
-# ( qsearch('sb_field', { svcnum => $svcnum }) ) {
-# my $part_sb_field = qsearchs('part_sb_field',
-# { sbfieldpart => $sb_field->sbfieldpart });
-# print q!<TR><TD ALIGN="right">! . $part_sb_field->name .
-# q!</TD><TD BGCOLOR="#ffffff">! . $sb_field->value .
-# q!</TD></TR>!;
-# }
-# print '</TABLE>';
-
-
- my $sb_field = $svc_broadband->sb_field_hashref;
- foreach (sort { $a cmp $b } keys(%{$sb_field})) {
- print q!<TR><TD ALIGN="right">! . $_ .
- q!</TD><TD BGCOLOR="#ffffff">! . $sb_field->{$_} .
- q!</TD></TR>!;
- }
- print '</TABLE>';
-
-
-print '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
- '</BODY></HTML>'
-;
-%>
projects / freeside.git / commitdiff