'FREESIDE_1_4_BRANCH'.
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
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',
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'});
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
- if ( driver_name eq 'Pg' ) {
+ if ( driver_name =~ /^Pg$/i ) {
qq-( $column IS NULL OR $column = '' )-;
} else {
qq-( $column IS NULL OR $column = "" )-;
}
} elsif ( $op eq '!=' ) {
- if ( driver_name eq 'Pg' ) {
+ if ( driver_name =~ /^Pg$/i ) {
qq-( $column IS NOT NULL AND $column != '' )-;
} else {
qq-( $column IS NOT NULL AND $column != "" )-;
}
} else {
- if ( driver_name eq 'Pg' ) {
+ if ( driver_name =~ /^Pg$/i ) {
qq-( $column $op '' )-;
} else {
qq-( $column $op "" )-;
=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.
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 ) {
=cut
sub getotaker {
- $user;
+ #$user;
+ #stupid kludge until schema otaker fields are not 8 chars
+ substr($user,0,8);
}
=item cgisetotaker
=head1 VERSION
-$Id: UID.pm,v 1.21 2002-09-27 12:14:12 ivan Exp $
+$Id: UID.pm,v 1.19 2002-08-29 06:02:52 ivan Exp $
=head1 BUGS
+++ /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 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 @used = map { $_->NetAddr->addr }
- ($self,
- qsearch('svc_broadband', { blocknum => $self->blocknum }) );
-
- 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.
-
-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 );
( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', '');
@ach_options = ();
- if ( $conf->exists('business-onlinepayment') ) {
+ 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,
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 = ($invoice_from) unless @invoicing_list;
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(
'invnum' => $self->invnum,
'paid' => $amount,
'_date' => '',
- 'payby' => method2payby{$method},
+ 'payby' => $method2payby{$method},
'payinfo' => $cust_main->payinfo,
'paybatch' => "$processor:". $transaction->authorization,
} );
}
+=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
Adds a payment for this invoice to the pending credit card batch (see
}
#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
- my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc')
- ? ( $cust_bill_pkg->itemdesc || 'Tax' )
- : 'Tax';
- push @buf, [ $itemdesc,
- $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]
- if $cust_bill_pkg->setup != 0;
+ } 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.20 2003-01-10 07:42:39 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;
-
=item comments - comments (optional)
-=item referral_custnum - referring customer number
-
=back
=head1 METHODS
if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ &&
grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) {
- # card/check info has changed, want to retry realtime_card invoice events
+ # card info has changed, want to retry realtime_card invoice events
#false laziness w/collect
foreach my $cust_bill_event (
grep {
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;
}
=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
=head1 VERSION
-$Id: cust_pay.pm,v 1.23 2002-11-19 09:51:58 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::cust_svc;
# 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;
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
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
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::domain_record;
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->reczone;
- } 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');
or return "Illegal data for PTR record: ". $self->recdata;
$self->recdata($1);
} elsif ( $self->rectype eq 'CNAME' ) {
- $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/i
or return "Illegal data for CNAME record: ". $self->recdata;
$self->recdata($1);
} elsif ( $self->rectype eq '_mstr' ) {
=head1 VERSION
-$Id: domain_record.pm,v 1.12 2003-03-20 03:41:03 ivan Exp $
+$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $
=head1 BUGS
;
tie my %www_shellcommands_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
+ 'user' => { lable=>'Remote username', default=>'root' },
'useradd' => { label=>'Insert command',
default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone',
},
},
;
-tie my %apache_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'httpd_conf' => { label=>'httpd.conf snippet location',
- default=>'/etc/apache/httpd-freeside.conf', },
- 'template' => {
- label => 'Template',
- type => 'textarea',
- default => <<'END',
-<VirtualHost $domain> #generic
-#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html
-DocumentRoot /var/www/$zone
-ServerName $zone
-ServerAlias *.$zone
-#BandWidthModule On
-#LargeFileLimit 4096 12288
-</VirtualHost>
-
-END
- },
-;
-
tie my %domain_shellcommands_options, 'Tie::IxHash',
'user' => { lable=>'Remote username', default=>'root' },
'useradd' => { label=>'Insert command',
},
+ 'svc_acct_sm' => {},
+
'svc_forward' => {
'sqlmail' => {
'desc' => 'Real-time export to SQL-backed mail server',
'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.',
},
- 'apache' => {
- 'desc' => 'Export an Apache httpd.conf file snippet.',
- 'options' => \%apache_options,
- 'notes' => 'Batch export of an httpd.conf snippet from a template. Typically used with something like <code>Include /etc/apache/httpd-freeside.conf</code> in httpd.conf. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/apache.export to export the files.',
- },
- },
-
- 'svc_broadband' => {
},
);
+++ /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
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 } );
unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
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>).
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
--- /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;
-
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-queued
bin/freeside-addoutsource
bin/freeside-addoutsourceuser
-bin/freeside-deloutsource
-bin/freeside-deloutsourceuser
bin/freeside-apply-credits
bin/freeside-adduser
-bin/freeside-deluser
bin/freeside-setup
bin/freeside-setinvoice
bin/freeside-overdue
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/export_svc.pm
FS/part_export.pm
FS/part_export_option.pm
-FS/part_export/apache.pm
FS/part_export/bind.pm
FS/part_export/bind_slave.pm
FS/part_export/bsdshell.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/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
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
=head1 VERSION
-$Id: freeside-expiration-alerter,v 1.4 2002-09-16 09:27:14 ivan Exp $
+$Id: freeside-expiration-alerter,v 1.3.4.1 2002-09-16 09:27:12 ivan Exp $
=head1 BUGS
=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);
'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,
'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,
'susp', @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', 'char', '', 5,
- #'recdata', 'varchar', '', $char_d,
- 'recdata', 'varchar', '', 255,
+ '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', 'int', '', '',
- 'routernum', 'int', '', '',
- 'ip_gateway', 'varchar', '', 15,
- 'ip_netmask', 'int', '', '',
- ],
- 'primary_key' => 'blocknum',
- 'unique' => [ [ 'blocknum', 'routernum' ] ],
- 'index' => [],
- },
-
- 'part_sb_field' => {
- 'columns' => [
- 'sbfieldpart', 'int', '', '',
- '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";
ASP_GLOBAL = /usr/local/etc/freeside/asp-global
-#deb, others?
FREESIDE_DOCUMENT_ROOT = /var/www/freeside
-#freebsd
-#FREESIDE_DOCUMENT_ROOT = /usr/local/www/data/freeside
-#deb, others?
INIT_FILE = /etc/init.d/freeside
-#freebsd
-#INIT_FILE = /usr/local/etc/rc.d/011.freeside.sh
-#deb, others?
HTTPD_RESTART = /etc/init.d/apache restart
-#freebsd
-#HTTPD_RESTART = /usr/local/etc/rc.d/apache.sh stop; sleep 1; /usr/local/etc/rc.d/apache.sh start
+FREESIDE_RESTART = /etc/init.d/freeside restart
-FREESIDE_RESTART = ${INIT_FILE} restart
-
-#deb, others?
INSTALLGROUP = root
-#freebsd
-#INSTALLGROUP = wheel
#edit the stuff below to have the daemons start
-QUEUED_USER=fs_queue
+QUEUED_USER=ivan
#eventually this shouldn't be needed
FREESIDE_PATH = `pwd`
#not changable yet
FREESIDE_CONF = /usr/local/etc/freeside
-VERSION=1.5.0pre1
-TAG=freeside_1_5_0pre1
+VERSION=1.4.1beta7
+TAG=freeside_1_4_1beta7
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
- cd /home/ivan/freeside
+release: upload-docs update-webdemo
+ 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 )'
Freeside
-Copyright (C) 2000,2001,2002 Ivan Kohler
+Copyright (C) 2000,2001 Ivan Kohler
Copyright (C) 1999 Silicon Interactive Software Design
All rights reserved
+++ /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 $zonepath = $export->option('zonepath');
$zonepath =~ s/\/$//;
- my @svc_domain = $export->svc_x;
+ #false laziness with freeside-sqlradius-reset and shell.export
+ my @svc_domain =
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
foreach my $svc_domain ( @svc_domain ) {
my $domain = $svc_domain->domain;
chmod 0644, "$prefix/passwd";
chmod 0600, "$prefix/master.passwd";
- my @svc_acct = $export->svc_x;
+ #false laziness with freeside-sqlradius-reset and bind.export
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
next unless @svc_acct;
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
+#
+# $Id: fs-setup,v 1.96.4.6 2002-12-24 22:41:21 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'] ],
+ },
+
+ '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;
+
+}
+
chmod 0644, "$prefix/passwd";
chmod 0600, "$prefix/shadow";
- my @svc_acct = $export->svc_x;
+ #false laziness with freeside-sqlradius-reset and bind.export
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
next unless @svc_acct;
}
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
-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;
-}
-
#!/usr/bin/perl -Tw
#
-# $Id: signup.cgi,v 1.35 2002-12-24 23:03:27 ivan Exp $
+# $Id: signup.cgi,v 1.29.2.5 2002-12-24 23:03:25 ivan Exp $
use strict;
use vars qw( @payby $cgi $locales $packages $pops $init_data $error
#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 = ();
- foreach (@$pops) {
- push @{ $pop{ $_->{state} }->{ $_->{ac} } }, $_;
- }
+ push @{ $pop{$_->{state}} }, $_ foreach @$pops;
my $text = <<END;
<SCRIPT>
var length = what.length;
what.options[length] = optionName;
}
-
- function acstate_changed(what) {
+
+ function popstate_changed(what) {
state = what.options[what.selectedIndex].text;
- for (var i = what.form.popac.length;i > 0;i--)
- what.form.popac.options[i] = null;
- what.form.popac.options[0] = new Option("Area code", "-1", false, true);
+ for (var i = what.form.popnum.length;i > 0;i--)
+ what.form.popnum.options[i] = null;
+ what.form.popnum.options[0] = new Option("", "", false, true);
END
- foreach my $state ( sort { $a cmp $b } keys %pop ) {
- $text .= "\nif ( state == \"$state\" ) {\n";
+ foreach my $popstate ( sort { $a cmp $b } keys %pop ) {
+ $text .= "\nif ( state == \"$popstate\" ) {\n";
- 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";
- }
- }
- $text .= "}\n";
- }
- $text .= "popac_changed(what.form.popac)}\n";
-
- $text .= <<END;
- function popac_changed(what) {
- ac = what.options[what.selectedIndex].text;
- for (var i = what.form.popnum.length;i > 0;i--)
- what.form.popnum.options[i] = null;
- what.form.popnum.options[0] = new Option("City", "-1", false, true);
-
-END
+ foreach my $pop ( @{$pop{$popstate}}) {
+ my $o_popnum = $pop->{popnum};
+ my $poptext = $pop->{city}. ', '. $pop->{state}.
+ ' ('. $pop->{ac}. ')/'. $pop->{exch};
- foreach my $state ( keys %pop ) {
- foreach my $popac ( keys %{ $pop{$state} } ) {
- $text .= "\nif ( ac == \"$popac\" ) {\n";
-
- foreach my $pop ( @{$pop{$state}->{$popac}}) {
- my $o_popnum = $pop->{popnum};
- my $poptext = $pop->{city}. ', '. $pop->{state}.
- ' ('. $pop->{ac}. ')/'. $pop->{exch};
-
- $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 .= "}\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 } keys %pop;
- $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD>';
+ 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="popac" SIZE=1 onChange="popac_changed(this)">!.
- qq!<OPTION>Area code</SELECT></TR><TR VALIGN="top">!;
-
- $text .= qq!<TR><TD><SELECT NAME="popnum" SIZE=1 STYLE="width: 20em"><OPTION>City!;
-
- #comment this block to disable initial list polulation
- foreach my $pop ( sort { $a->{state} cmp $b->{state} } @$pops ) {
+ $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !;
+ foreach my $pop ( @$pops ) {
$text .= qq!<OPTION VALUE="!. $pop->{popnum}. '"'.
( ( $popnum && $pop->{popnum} == $popnum ) ? ' SELECTED' : '' ). ">".
$pop->{city}. ', '. $pop->{state}.
' ('. $pop->{ac}. ')/'. $pop->{exch};
}
-
- $text .= qq!</SELECT></TD></TR></TABLE>!;
+ $text .= '</SELECT>';
$text;
-
}
sub expselect {
-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;
+ $$ref = $cgi->header( @FS::CGI::header ) . $$ref;
if ( dbh->can('sprintProfile') ) {
- if ( lc($Response->{ContentType}) eq 'text/html' ) {
- $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i
- or warn "can't remove";
+
+ $$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') ) {
-
- #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="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>
<ul>
<li> with <a href="http://www.postgresql.org/users-lounge/docs/7.1/postgres/user-manag.html#DATABASE-USERS">PostgreSQL</a>:
<pre>
-$ su postgres (pgsql on some distributions)
+$ su postgres
$ createuser -P freeside
Enter password for user "freeside":
Enter it again:
<!-- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>-->
<li>Edit the top-level Makefile:
<ul>
- <li>Set <tt>DATASOURCE</tt> to your <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI data source</a>, for example, <tt>DBI:Pg:dbname=freeside</tt> for PostgresSQL<!-- or <tt>DBI:mysql:freeside</tt> for MySQL-->. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">manpage for your DBD</a> for the exact syntax of your DBI data source.
+ <li>Set <tt>DATASOURCE</tt> to your <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI data source</a>, for example, <tt>DBI:Pg:
host=localhost;dbname=freeside</tt> for PostgresSQL<!-- or <tt>DBI:mysql:freeside</tt> for MySQL-->. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">manpage for your DBD</a> for the exact syntax of your DBI data source.
<li>Set <tt>DB_PASSWORD</tt> to the freeside database user's password.
</ul>
<li>Add the freeside database to your database engine:
<li>Restrict access to this web interface - see the <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache documentation on user authentication</a>. For example, to configure user authentication with <a href="http://httpd.apache.org/docs/mod/mod_auth.html">mod_auth</a> (flat files):
<pre>
<Directory /usr/local/apache/htdocs/freeside-asp>
+PerlSetVar Global /usr/local/etc/freeside/asp-global/
AuthName Freeside
AuthType Basic
AuthUserFile /usr/local/etc/freeside/htpasswd
$ <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
-$ cd <b>/path/to/freeside/</b>
+$ cd <b>/path/to/freeside-1.4.0/</b>
$ bin/populate-msgcat <b>username</b>
</pre>
<li><tt>freeside-queued</tt> was installed with the Perl modules. Start it now and ensure that is run upon system startup (Do this manually, or edit the top-level Makefile, replacing INIT_FILE with the appropriate location on your systemand QUEUED_USER with the username of a Freeside user you created above, and run <tt>make install-init</tt>)
<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>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>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>
<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
-this is very incomplete
-
-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 );
-
--- /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>
<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},
'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", '');
-
-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="redirect_ok"
- VALUE="<%=$p1%>part_router_field.cgi">
-<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");
-}
-%>
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 $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') : $p2."view/$table.cgi");
-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 . '?' .$pkey_val);
-}
-%>
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;
-}
-
-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). "edit/router.cgi?$routernum");
-
-%>
--- /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}%>">
-<%=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%>">
- <INPUT TYPE="hidden" NAME="ip_addr" VALUE="<%=$ip_addr%>">
-
- <%=&ntable("#cccccc",2)%>
-
- <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><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>
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 = ();
- 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">
- <%
-
- foreach my $table ( keys %schema ) {
-
- my @from_columns = $schema->table($table)->columns;
- my @fs_columns = dbdef->table($schema{$table})->columns;
-
- %>
- <%= hashmaker($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";
-
- 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) );
- 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".
- '</TD><TD>'.
- qq!<SELECT NAME="${name}_to" SIZE=$tosize>\n!.
- join("\n", map { qq!<OPTION VALUE="$_">$_</OPTION>! } sort { $a cmp $b } @$to ).
- "</SELECT>\n".
- '</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;
- }
- </script>".
- '';
- }
-
-%>
<!-- 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;
<%
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