Thanks to Matt Simerson <matt@michweb.net> of MichWeb Inc. for documentation
-and pre-release testing. Without his help the documentation in the first
+and pre-release testing. Without his help the documentation in 1.0.0
release would have consisted of a single screenfull of text.
+(To clear up some misunderstanding, Matt did not write the current
+documentation.)
-# Steve Cleff <cleff@yahoo.com> did the default background image and is also
-# the creator of Freeside's mascot, Snakeman.
+Steve Cleff <cleff@yahoo.com> did the default background image in 1.0.x and
+is also the creator of Freeside's elusive mascot, Snakeman, who we hope will
+make an appearance in a later 1.2.x version.
-Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic.
+Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic used in
+1.0.x and most of 1.1.x.
+
+Mark Norris of Urban Design, Inc. <http://www.urban.com/> did the red "S"
+logo for later 1.1.x versions and 1.2.x
Brian McCane? <bmccane@maxbaud.net> contributed PostgreSQL support, HTML
style enhancements and many, many bugfixes.
+Cerkit <cerkit@alfheim.net> contributed rsync support and desynced hosts.
+His changes will hopefully be included in a later 1.2.x version.
+
+CompleteHOST, Inc. (http://www.completehost.com) funded the development of the
+following Freeside features by contracting me for a custom billing system
+based on Freeside:
+ - Multiple, separate databases and configurations on one box.
+ - Per-customer pricing (custom packages)
+ - Internationalization wrt addresses (cust_main, cust_main_county)
+Thanks!
+
+Mark Williamson <mark.williamson@ebbs.com.au> and Roger Mangraviti
+<rem@atu.com.au> contributed state/provence listings for Australia.
+
+Peter Wemm <peter@netplex.com.au> sent in a bunch of bugfixes for the 1.2
+release.
+
Everything else is my (Ivan Kohler <ivan@sisd.com>) fault.
-Freeside, (pre) 1.1.4
+Freeside, 1.2.0
-Copyright (C) 1998 Silicon Interactive Software Design. All rights reserved.
+Copyright (C) 1999 Ivan Kohler
+Copyright (C) 1999 Silicon Interactive Software Design
+All rights reserved
This program is free software; you can redistribute it and/or modify
it under the terms of either:
Commercial support is available from Ivan Kohler <ivan@sisd.com>. Please
subscribe to the the mailing list to request free support!
-Ivan Kohler
-ivan@sisd.com
-
+Ivan Kohler <ivan@sisd.com>
+20 4,16 * * * saytime
+$Id: TODO,v 1.28 1999-04-14 08:58:59 ivan Exp $
+
If you are interested in helping with any of these, please join the mailing
list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid
duplication of effort.
--- 1.1.x --
+---
-postgres can't deal with NULL!
+hmm... maybe svc_acct__shell should check off the legal shells list if
+applicable? yeah... cool.
-svc_acct.import should recognize "UNIX" in the RADIUS password file as null.
+payinfo field should me much larger than 16
-radius logfile parsing and perl expression check.
+default (and ordering) state/county/country config file
-mailing list archive, faq, cvs
+[Mon Apr 12 20:31:21 1999] [error] [Mon Apr 12 20:31:21 1999] null: Error closing true: Broken pipe at /usr/local/lib/site_perl/FS/cust_main.pm line 615.
-(test cust_main.pm with cybercash v2 and v3)
+configuration option to show passwords
-Fix in cust_bill BUGS:
-There is an off-by-one error in print_text which causes a visual error (Page 1
-of 2 printed on some single-page invoices).
+javascript (yuck!) "are you sure?" confirmation on cancelations, etc.
+(view/cust_pkg and view/svc_*)
-FIX It doesn't properly inherit/override FS::Record yet, so no more replace vs
-rep silliness!
+get rid of time2str("%D") which formats dates in a non-y2k-safe looking fashion
+(all the actual date handling uses UNIX timestamps and is fine)
-fields should be a method against a FS::Record or derived object, as well as
-being something you can call as FS::Record::fields('tablename'). Might
-even be able to handle both in the same routine (that would be neato).
-Get rid of hfields and other assorted silliness.
-Clean up hfields/sfields/fields crap. yuck.
+uncomment expire in view/cust_pkg.cgi and find the expire cron from fsold
+
+(Test this)
+one-time/per-customer/? changes in rates and descriptions ('remembered
+invoices'): implement by creating a new package on the fly... but it isn't
+associated with any agent types so it won't show up for other customers to buy.
+(but also... make sure they go away when the customer does! - need this? :
+ one-off package edits! : need a cust_pkgs or cust_part_pkgs or something table,
+ with custnum and partpkg (like type_pkgs)
+(what happens if you hit "custom pricing" but the pricing is already custom?)
+
+Lay out any remaining ugly forms better.
+
+remove "records identical" warning? gets in the way of more important stuff.
+or fix logic which tries to update identical records??
+1.2 should be quiet enough that the error log is useful, hopefully.
-$lpr in cust_main.pm (from Bill.pm) should become /var/spool/freeside/conf/lpr
+Postgres has a maximum column length of 31 characters (but see NAMEDATALEN in
+postgres_ext.h). part_svc has columns like: svc_acct__radius_Attribute_flag
+(22 characters!) It seems that stuff over the limit is silently ignored,
+so we get 4 characters back. So, Radius_Attributes are max 13 characters with
+stock Postgres. see rfc2138 for what's affected
+What's a good fix? (besides recompiling postgres with NAMEDATALEN 64)
+(mysql has a 64 character max column length. others?)
-Override FS::Record new, add, rep and del (create, insert, replace and
-delete) in all derived classes.
-IE create, insert, delete and replace from derived classes should override new,
-add, del and rep (respectively) from FS::Record. Depriciate old names.
+[Mon Mar 29 06:57:56 1999] -e: Use of uninitialized value at /usr/lib/perl5/Date/Format.pm line 333.
+(when sending mail in cust_main.pm::bill or svc_domain.pm)
+
+look at DBIx::Recordset! (and Tie::DBI, and...)
+
+undefined conf/lpr gives this uninfomative error:
+[Fri Feb 26 16:42:36 1999] bill.cgi: Can't do bidirectional pipe at
+/usr/lib/per
+l5/site_perl/FS/cust_main.pm line 629.
+[Fri Feb 26 16:42:38 1999] bill.cgi: Error closing : Broken pipe at
+/usr/lib/per
+l5/site_perl/FS/cust_main.pm line 631.
+So give a meaningful error!
+
+password and slipip stuff in svc_acct.pm store need to be split into two fields or something, so the silliness in svc_acct.pm and svc_acct.export with looking at the data to decide what to do with it can be fixed
+
+i10n: Apache::Language
+
+Apache::Session? Other useful Apache::* ?
+
+email invoices are only sent for the BILL payby. If setup, should statements
+(since they're not invoices) be sent for COMP and CARD as well?
+
+$cgi->keywords is causing the (hard to trace) error:
+ Use of uninitialized value at (eval 5) line 5
+
+edit/cust_main.cgi gives an uninformative error message:
+> Can't call method "agentnum" without a package or object reference at
+> /usr/local/apache-ssl/htdocs/freeside/edit/cust_main.cgi line 116.
+if there are no agents.
+
+(is this missing on any web screens? (easy with $cust_svc->label)
+Add the ability for services to filter information up to the package level
+for web screens, so you can select a particlar package based
+on username or domain name, etc.
Allow a cancelled/suspended/active status from packages to bubble up to
the customer lists. Put active, then suspended, then cancelled accounts.
Similar ordering on the package listing inside a single customer.
-Add the ability for services to filter information up to the package level
-for invoices and web screens, so you can select a particlar package based
-on username or domain name, etc.
+false laziness: edit/cust_main.cgi got some parts copied from edit/svc_acct.cgi
+the web interface in general needs to be redone in a more abstract way.
+
+false laziness: some of search/svc_acct_sm.cgi was copied to search/svc_domain.cgi. but web interface in general needs to be rewritten in a mucho cleaner way.
+
+Portability: in FS::Record, $sth->execute does not return a number of rows for all DBD's. see man DBI
+
+subroutine the where clause (eventually all SQL) as OO perhaps (has anyone done this?)
+
+add a select method to FS::Record?
+
+one-time/per-customer/? changes in rates and descriptions ('remembered
+invoices'): implement by creating a new package on the fly... but it isn't
+associated with any agent types so it won't show up for other customers to buy.
+(but also... make sure they go away when the customer does! - need this? :
+ one-off package edits! : need a cust_pkgs or cust_part_pkgs or something table,
+ with custnum and partpkg (like type_pkgs)
+(what happens if you hit "custom pricing" but the pricing is already custom?)
You can't delete the stuff under administration yet. Add this,
_including_ making sure the thing you are deleting is not in use!
+add links on view/cust_main.cgi to setup services, like view/cust_pkg.cgi
+
+FS::cust_pkg _require_'s FS::$svc, but this won't work with %FS::UID::callback
+loading of configuration. (pry need same idea, but will run immediately if
+context allows). Looks like error is masked by 'use FS::cust_svc' which in
+turn 'use's FS::{svc_acct, svc_acct_sm, svc_domain}' which is now explicit
+w/comments in source
+
+Allow a cancelled/suspended/active status from packages to bubble up to
+the customer lists. Put active, then suspended, then cancelled accounts.
+Similar ordering on the package listing inside a single customer.
+
+svc_domain.pm mail sending uses Date::Format which doesn't seem to pick up
+correct timezone.
+
+view/svc_domain.cgi needs to know the domain might be unaudited (cosmetic)
+
+remove whois_hack set to 1 for svc_domain.pm? add all known registries and
+whois accordingly.
+.us domains and others!
+site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them...
+
+turn on the depriciation warnings for [e]idiot in FS::CGI. Stop using [e]idiot
+the last places it is (htdocs/search/ htdocs/misc/ htdocs/misc/process)
+
+(test cust_main.pm with cybercash v2 and v3, especially with the callback
+ stuff AND with mod_perl w/cybercash v2 kludge in package main)
+(callback stuff should be eliminated by now)
+
+bah, table/itable/*table in FS::CGI is silly.
+
+doc Apache::AuthDBI as well
+..
+Provide sample httpd.conf files.
+
+hey look: Tie::DBI! Check that out. Override its commit with something that
+does perl-side caching for ? a performance improvement and as an emulation
+layer to plug in f.ex mysql's atomic transactions
+..
+Record.pm uses does some non-portable DBI things. MySQL and Pg seem fine.
+Fix it anyway unless we migrate to Tie::DBI.
+
+faq
+
+cust_bill.pm uses '==' comparison on dates because they're currently ints
+
+config file for allowed card types
+
+write instructions for adding new services w/svc_Common.pm. Get rid of all
+places where svc_* tables are hardcoded (rename svc_acct_pop to part_pop so
+we can do that)
+
+test and document libapache-dbi-logger (woo!)
+
+radius logfile parsing and perl expression check.
+
+Fix in cust_bill BUGS:
+There is an off-by-one error in print_text which causes a visual error (Page 1
+of 2 printed on some single-page invoices).
+
+fields should be a method against a FS::Record or derived object, as well as
+being something you can call as FS::Record::fields('tablename'). Might
+even be able to handle both in the same routine (that would be neato).
+
Immediate removal of incorrectly entered check payments (can't take too
long to do this, or accounting is fubared).
move all phone number logic out of Freeside - let HylaFAX or whatever
handle it.
-soundex searches for customer name and company? where are free soundex tools? (standard Text::Soundex duh)
+soundex searches for customer name and company? where are free soundex tools? (standard Text::Soundex duh) - I could have sworn I saw Text::Soundex on CPAN?!
-should be able to link on (username, domain name, some field in email alias) instead of svcnum only. (username done, what else?)
+should be able to link on some field in email alias (right now you can link
+on username or domain with a fallback to svcnum)
-(done but clean up) change svc_domain.pm mail sending from a pipe to "/usr/lib/sendmail" to Mail::Mailer or Net::SMTP or something. also is the complete text of the registration agreement needed in there (it used to be)?
-
-generalize and make configurable new invoice printing scheme in FS::Bill::collect (past due)
+generalize and make configurable new invoice printing scheme in FS::cust_main::collect (past due)
deleting an svc_domain should delete all associated svc_acct_sm records.
same with a svc_acct.
...
Allow for a future setup date on accounts.
-one-time/per-customer/? changes in rates and descriptions ('remembered
-invoices'): implement by creating a new package on the fly... but it isn't
-associated with any agent types so it won't show up for other customers to buy.
-
-if CGI::Base will not have redirect fixed (cgifix.html), should migrate to
-CGI.pm insetead? It is >1 year newer.
-
-library repetitve stuff from Bill.pm Invoice.pm and friends (calculating
-previous balances etc etc)
-
-
sub AUTOLOAD in FS::Record should warn? die? if used with a non-existant column
name?
edit (not just import, export and allow default/fixed) arbitrary radius stuff
in svc_acct
-
edit/svc_acct.cgi and edit/process/svc_acct.cgi should deal with arbitrary radius stuff
radius import should take DEFAULT entry and put it in /var/spool/freeside/conf/radius-default ; svc_acct.export should use it (and doc)
-FS::Invoice and FS::Bill should merge with the classes they're derived from
-
in UI, s/State/State\/Provence/go and s/County/County\/Locality/go
-.us domains and others!
-
-what else (besides l10n) for i18n?
+what else (besides l10n) for i18n? (money!)
audit htdocs/* for things that should be libraried and things that should be
new methods on the objects (need to do this before implementing a new UI)
Decide based on whether or not the "error" should show up in logs.
all .cgi's should use standard header/footer and idiot() subroutines. maybe HTML:: perl modules
-for HTML creation. CGI.pm instead.
-
-library the conf reading stuff; bin/svc_acct.export version with missing-filename checking is good
-library conf stuff -> check all the conf stuff to make sure they close filehandles.
+for HTML creation. Maybe Embperl or something along those lines. ?
When running bin/bill, Fix this (Annoying but harmless):
Use of uninitialized value at /usr/local/lib/site_perl/FS/cust_pkg.pm line 99, <ADDRESS> chunk 4.
store the other information? Maybe you could ask any FS::Record object for a
tied hash?
-change all htdocs/edit/process/* loops to look like: (library this sort of thing!!!!)
-
-my($new) = create FS::svc_acct_sm ( {
- map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
-} );
-
-to avoid form errors causing too much silliness
-
-add this code to all svc_*.pm (already in acct and acct_sm and domain): (library!)
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
change all file access from regular open(FILE,) stuff to OO, because of
problems scoping and passing filehandles like that.
-svc_domain.pm mail sending uses Date::Format which doesn't seem to pick up
-correct timezone.
-
-view/svc_domain.cgi needs to know the domain might be unaudited (cosmetic)
-
-Check everything into CVS.
-
---- 1.1.x or 1.2 or later
-
the web interface should create a new object and use it instead of a blank
form for new records. the create method of svc_ objects should set defaults
(from part_svc).
Auto-increment expired cards one year, and try again?
-Lay out the forms a bit better.
-
More non-US stuff - zip codes, country codes, foreign currencies, etc.
cust_refund.{cgi.pm} need to do cards xaxtions. (now we only have cust_credit)
Nice postscript paper invoices, rather than current ASCII invoices.
-
think about race-condititions in FS::Record and derived ->check ->insert
and so on, uid and username checks in svc_acct, etc.
people use/
More CC processors/methods.
-In FS::Record, the counter dir should have .datasrc appended to it like the
-dbdef does, which should place all the (most of) the DB metadata in unique
-files and let me run concurrent .datasrc's. Maybe do something similar for
-user, password and datasrc itself? (or something to get the out of the source
-files) and then we're set. (secrets file also needs .datasrc appended, or maybe
-"/var/spool/freeside".datasrc
-
you should be able to fiddle the setup date in cust_pkg. (at least initially)
-cych v3 and v2 support
-
delete options in administration section
write a generic batch senders and batch parsers.
-need a way to override svc_acct export on a per-machine basis; just use config files based on machine name i suppose; document that.
+need a way to override svc_acct export on a per-machine basis; just use config files based on machine name i suppose; document that. (no, import desync_hosts
+type stuff from cerkit)
+...
+add a table with column of export services (passwd, shadow, master.passwd, .qmail file update, dns update, etc.) and rows machine groups and whether or not to export that (and any necessary parameters). wasn't matt (vunderkid, not matt@michweb) working on this? find him? each machine goes in a group of its own as well as a group based on function. add a table with only svcpart and machine group. now, when you import from each machine, it can get its own accounts with one svcpart and universal accounts with another svcpart. (though that does make the username duplicate checking more interesting)
you should be able to get column types as a method against an FS::Record object
as well as dbdef->table($table)->column($column)->type
move to perl module for fuzzy and soundex searching.
-make fs-setup option to add sample data so you can click on "New Customer" right away? so people understand what this stuff is?
-
package view needs to list extraneous services; we need to prevent the
creation of them so this never happens (and mark it as such in the source)
(the creation problem should be fixed - though they will still happen if people
export a debian-style (also redhat and?) /etc/group file aswell!
-seems to be an off-by-one error in the ascii invoice formatting which is saying
-"1 of 2" pages when there is only one.
-
-get rid of agrep? needs the (non-free) glimpse distribution. agrep used to
-be free? what else can do fuzzy searching?
-
-site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them...
-
svc_acct_sm.import qmail import should pull in recipientmap people too.
.pm's like svc_acct.pm which need to do time-consuming things like ssh remotely
Put the GPL notice in all files.
--- 1.2 or later --
+integrate w/IDEA's signup server
$cust_bill->owed database field to be eliminated, replaced by a method call
that calculates on the fly. make sure to grep for ->(get|set)field('owed')
edit/process/svc_wo.cgi
Call tracking and trouble tickets.
-use mod_perl and Apache::AuthDBI instead of mod_auth_mysql when we do local
-users
More accoutability for complimentary accounts: approval, expiration, term
(no more than x months in advance) and notification.
Flag particular users (or all users, for that matter) as having their
employees they can't trust. Right now you're "stuck" with setting up
.htaccess stuff yourself. This should really just be integrated.
-update site_perl/table_template* (pry out of date)
-
-/var/spool/freeside/conf (and whatever else /var/spool/freeside we can)
-in database (except secrets), then web interface,
-make /var/spool/freeside a configurable directory (probably as part of
-some automated installation process?)
-
-add a table with column of export services (passwd, shadow, master.passwd, .qmail file update, dns update, etc.) and rows machine groups and whether or not to export that (and any necessary parameters). wasn't matt (vunderkid, not matt@michweb) working on this? find him? each machine goes in a group of its own as well as a group based on function. add a table with only svcpart and machine group. now, when you import from each machine, it can get its own accounts with one svcpart and universal accounts with another svcpart. (though that does make the username duplicate checking more interesting)
-
-password and slipip stuff in svc_acct.pm store need to be split into two fields or something, so the silliness in svc_acct.pm and svc_acct.export with looking at the data to decide what to do with it can be fixed (1.2)
+configuration/setup should get web interface
+...
+/usr/local/etc/freeside should be configurable
+...
+(probably as part of some automated installation process?)
This requires some serious magic in FS::Record:
ok, if date_type in fs-setup is to be something besides int,
rollback and/or atomic updates and get rid of the work-arounds? The /rdb
interface had this kludge on top of it but is a technical dead-end in most
other ways, unless it can gain an SQL parser and DBD interface.
+...
+if i'm really bored, find the /rdb interface in fsold and port it to NoSQL,
+and while I'm add it add interfaces for AnyDBM_File tied hash.. hmm. Shouldn't
+an FS::Record have something to do with a tied hash? But we don't want
+performance to go gaga... maybe something with commit to help out here?
+...
+Ok: FS::Record gives you a tied hash, and you get methods for commit, etc.
Better automated comparison of our CC records with processors (CyberCash,
at least, has not always had 100% accuracy, though recent versions are
-#!/usr/local/bin/perl -Tw
-#
-# bill: Bill customer(s)
-#
-# Usage: bill [ -c [ i ] ] [ -d 'date' ] [ -b ]
-#
-# Bills all customers.
-#
-# Adds record to /dbin/cust_bill and /dbin/cust_pay (if payment made -
-# CARD & COMP), prints invoice / charges card etc.
-#
-# -c: Turn on collecting (you probably want this).
-#
-# -i: real-time billing (as opposed to batch billing). only relevant
-# for credit cards.
-#
-# -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with,
-# but be careful.
-#
-# ## n/a ## -b: send batch when done billing
-#
-# ivan@voicenet.com sep/oct 96
-#
-# separated billing and collections, cleaned up code.
-# ivan@voicenet.com 96-nov-11
-#
-# added -d option
-# ivan@voicenet.com 96-nov-13
-#
-# added -v option and started to implement it, added 'd:' to getopts call
-# (oops!)
-# ivan@voicenet.com 97-jan-2
-#
-# added more debug messages, moved some searches to fssearch.pl library (for
-# speed)
-# rewrote "all customer" finder to know about bill dates, for speed.
-# ivan@voicenet.com 97-jan-8
-#
-# thought about it a while, and removed passing of the -d option to collect...?
-# ivan@voicenet.com 97-jan-14
-#
-# make all -v stuff STDERR
-# ivan@voicenet.com 97-feb-4
-#
-# added pkgnum as argument to program from /db/part_pkg, with kludge for the
-# "/bin/echo XX" 's already there.
-# ivan@voicenet.com 97-feb-23
-#
-# - general cleanup
-# - customers who are suspended can still be billed for the setup fee
-# - cust_pkg record is re-read after the package setup fee program is run.
-# this way,
-# that program can modify the record (for example, to start accounts off
-# suspended)
-# (best to think four or five times before modifying anything else!)
-# ivan@voicenet.com 97-feb-26
-#
-# don't bill recurring fee if its not time! (was removed)
-# ivan@voicenet.com 97-mar-6
-#
-# added -b option, send batch when done billing.
-# ivan@voicenet.com 97-apr-4
-#
-#insecure dependency on line 179ish below needs to be fixed before bill is
-#used setuid
-# ivan@voicenet.com 97-jun-2
-#
-# removed running of setup program (depriciated)
-# ivan@voicenet.com 97-jul-21
-#
-# rewrote for new API, removed option to specify custnums (use FS::Bill
-# instead), removed -v option (?)
-# ivan@voicenet.com 97-jul-22 - 23 - 25 -28
-# (need to add back in email stuff, look in /home/ivan/old/dbin/collect)
-#
-# s/suidsetup/adminsuidsetup/, s/FS::Search/FS::Record/, added some batch
-# exporting stuff (which still needs to be generalized) and removed &idiot
-# ivan@sisd.com 98-may-27
-
-# setup
+#!/usr/bin/perl -Tw
use strict;
use Fcntl qw(:flock);
use Getopt::Std;
use FS::UID qw(adminsuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::Bill;
-
-my($batchfile)="/var/spool/freeside/batch";
-my($batchlock)="/var/spool/freeside/batch.lock";
-
-adminsuidsetup;
+use FS::cust_main;
&untaint_argv; #what it sounds like (eww)
use vars qw($opt_b $opt_c $opt_i $opt_d);
getopts("bcid:"); #switches
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
#we're at now now (and later).
my($time)= $main::opt_d ? str2time($main::opt_d) : $^T;
} else {
();
}
- } qsearch('cust_pkg',{'cancel'=>''})
+ } ( qsearch('cust_pkg', { 'cancel' => '' }),
+ qsearch('cust_pkg', { 'cancel' => 0 }),
+ )
) {
# and bill them
print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
- bless($cust_main,"FS::Bill");
-
my($error);
$error=$cust_main->bill('time'=>$time);
}
-#if ($main::opt_b) {
-#
-# die "Batch still waiting for reply? ($batchlock exists)\n" if -e $batchlock;
-# open(BATCHLOCK,"+>>$batchlock") or die "Can't open $batchlock: $!";
-# select(BATCHLOCK); $|=1; select(STDOUT);
-# unless ( flock(BATCHLOCK,,LOCK_EX|LOCK_NB) ) {
-# seek(BATCHLOCK,0,0);
-# my($pid)=<BATCHLOCK>;
-# chop($pid);
-# die "Is a batch running? (pid $pid)\n";
-# }
-# seek(BATCHLOCK,0,0);
-# print BATCHLOCK $$,"\n";
-#
-# ( open(BATCH,">$batchfile")
-# and flock(BATCH,LOCK_EX|LOCK_NB)
-# ) or die "Can't open $batchfile: $!";
-#
-# my($cust_pay_batch);
-# foreach $cust_pay_batch (qsearch('cust_pay_batch',{})) {
-# print BATCH join(':',
-# $_->getfield('cardnum'),
-# $_->getfield('exp'),
-# $_->getfield('amount'),
-# $_->getfield('payname')
-# || $_->getfield('first'). ' '. $_->getfield('last'),
-# "Description",
-# $_->getfield('zip'),
-# ),"\n";
-# }
-#
-# flock(BATCH,LOCK_UN);
-# close BATCH;
-#
-# flock(BATCHLOCK,LOCK_UN);
-# close BATCHLOCK;
-#}
-
# subroutines
sub untaint_argv {
}
}
+sub usage {
+ die "Usage:\n\n bill [ -c [ i ] ] [ -d 'date' ] [ -b ] user\n";
+}
+
+=head1 NAME
+
+bill - Command line (crontab, script) interface to customer billing.
+
+=head1 SYNOPSIS
+
+ bill [ -c [ i ] ] [ -d 'date' ] user
+
+=head1 DESCRIPTION
+
+Bills all customers. Searches for customers who are due for billing and calls
+the bill and collect methods of a cust_main object. See L<FS::cust_main>.
+
+-c: Turn on collecting (you probably want this).
+
+-i: real-time billing (as opposed to batch billing). only relevant
+ for credit cards.
+
+-d: Pretent it's 'date'. Date is in any format Date::Parse is happy with,
+ but be careful.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: bill,v 1.6 1998-11-15 02:53:00 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 HISTORY
+
+ivan@voicenet.com sep/oct 96
+
+separated billing and collections, cleaned up code.
+ivan@voicenet.com 96-nov-11
+
+added -d option
+ivan@voicenet.com 96-nov-13
+
+added -v option and started to implement it, added 'd:' to getopts call
+ (oops!)
+ivan@voicenet.com 97-jan-2
+
+added more debug messages, moved some searches to fssearch.pl library (for
+speed)
+rewrote "all customer" finder to know about bill dates, for speed.
+ivan@voicenet.com 97-jan-8
+
+thought about it a while, and removed passing of the -d option to collect...?
+ivan@voicenet.com 97-jan-14
+
+make all -v stuff STDERR
+ivan@voicenet.com 97-feb-4
+
+added pkgnum as argument to program from /db/part_pkg, with kludge for the
+"/bin/echo XX" 's already there.
+ivan@voicenet.com 97-feb-23
+
+- general cleanup
+- customers who are suspended can still be billed for the setup fee
+- cust_pkg record is re-read after the package setup fee program is run.
+ this way,
+ that program can modify the record (for example, to start accounts off
+ suspended)
+ (best to think four or five times before modifying anything else!)
+ivan@voicenet.com 97-feb-26
+
+don't bill recurring fee if its not time! (was removed)
+ivan@voicenet.com 97-mar-6
+
+added -b option, send batch when done billing.
+ivan@voicenet.com 97-apr-4
+
+insecure dependency on line 179ish below needs to be fixed before bill is
+used setuid
+ivan@voicenet.com 97-jun-2
+
+removed running of setup program (depriciated)
+ivan@voicenet.com 97-jul-21
+
+rewrote for new API, removed option to specify custnums (use FS::Bill
+instead), removed -v option (?)
+ivan@voicenet.com 97-jul-22 - 23 - 25 -28
+(need to add back in email stuff, look in /home/ivan/old/dbin/collect)
+
+s/suidsetup/adminsuidsetup/, s/FS::Search/FS::Record/, added some batch
+exporting stuff (which still needs to be generalized) and removed &idiot
+ivan@sisd.com 98-may-27
+
+$Log: bill,v $
+Revision 1.6 1998-11-15 02:53:00 ivan
+afterthought
+
+Revision 1.4 1998/11/07 08:21:26 ivan
+missing use
+
+=cut
+
+
#!/usr/bin/perl -Tw
#
+# $Id: dbdef-create,v 1.2 1998-11-19 11:17:44 ivan Exp $
+#
# create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
# not in Pg) based on fs-setup
#
# ivan@sisd.com 98-jun-2
+#
+# $Log: dbdef-create,v $
+# Revision 1.2 1998-11-19 11:17:44 ivan
+# adminsuidsetup requires argument
+#
use strict;
use DBI;
use FS::dbdef;
use FS::UID qw(adminsuidsetup datasrc);
-#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
+my $user = shift or die &usage;
-my($dbh)=adminsuidsetup;
+my($dbh)=adminsuidsetup $user;
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
my($tables_sth)=$dbh->prepare("SHOW TABLES");
my($tables_rv)=$tables_sth->execute;
#important
$dbdef->save($dbdef_file);
+sub usage {
+ die "Usage:\n dbdef-create user\n";
+}
#!/usr/bin/perl -Tw
#
-# create database and necessary tables, etc. DBI version.
+# $Id: fs-setup,v 1.17 1999-04-14 07:58:39 ivan Exp $
#
# ivan@sisd.com 97-nov-8,9
#
# ivan@sisd.com 98-sep-4
#
# fix radius attributes ivan@sisd.com 98-sep-27
+#
+# $Log: fs-setup,v $
+# Revision 1.17 1999-04-14 07:58:39 ivan
+# export getsecrets from FS::UID instead of calling it explicitly
+#
+# Revision 1.16 1999/02/28 19:44:16 ivan
+# constructors s/create/new/ pointed out by "Bao C. Ha" <bao@hacom.net>
+#
+# Revision 1.15 1999/02/27 21:06:21 ivan
+# cust_main.paydate should be varchar(10), not @date_type ; problem reported
+# by Ben Leibig <leibig@colorado.edu>
+#
+# Revision 1.14 1999/02/07 09:59:14 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.13 1999/02/04 06:09:23 ivan
+# add AU provences
+#
+# Revision 1.12 1999/02/03 10:42:27 ivan
+# *** empty log message ***
+#
+# Revision 1.11 1999/01/17 03:11:52 ivan
+# remove preliminary completehost changes
+#
+# Revision 1.10 1998/12/16 06:05:38 ivan
+# add table cust_main_invoice
+#
+# Revision 1.9 1998/12/15 04:36:29 ivan
+# s/croak/die/; #oops
+#
+# Revision 1.8 1998/12/15 04:33:27 ivan
+# dies if it isn't running as the freeside user
+#
+# Revision 1.7 1998/11/18 09:01:31 ivan
+# i18n! i18n!
+#
+# Revision 1.6 1998/11/15 13:18:02 ivan
+# remove debugging
+#
+# Revision 1.5 1998/11/15 09:43:03 ivan
+# update for new config file syntax, new adminsuidsetup
+#
+# Revision 1.4 1998/10/22 15:51:23 ivan
+# also varchar with no length specified - postgresql fix broke mysql.
+#
+# Revision 1.3 1998/10/22 15:46:28 ivan
+# now smallint is illegal, so remove that too.
+#
#to delay loading dbdef until we're ready
BEGIN { $FS::Record::setup_hack = 1; }
use strict;
use DBI;
use FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
use FS::Record;
use FS::cust_main_county;
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+getsecrets($user);
+
#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
###
#my(@date_type) = ( 'timestamp', '', '' );
my(@date_type) = ( 'int', 'NULL', '' );
-my(@perl_type) = ( 'long varchar', 'NULL', '' );
+my(@perl_type) = ( 'varchar', 'NULL', 255 );
my(@money_type);
if (datasrc =~ m/Pg/) { #Pg can't do decimal(10,2)
@money_type = ( 'money', '', '' );
#important
$dbdef->save($dbdef_file);
-FS::Record::reload_dbdef;
+&FS::Record::reload_dbdef($dbdef_file);
###
# create 'em
###
-my($dbh)=adminsuidsetup;
+my($dbh)=adminsuidsetup $user;
#create tables
$|=1;
#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 TT UT VT VI VA WA WV WI WY AE AA AP
) ) {
- my($cust_main_county)=create FS::cust_main_county({
+ 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;
$dbh->disconnect or die $dbh->errstr;
+sub usage {
+ die "Usage:\n fs-setup user\n";
+}
+
###
# Now it becomes an object. much better.
###
'agentnum', 'int', '', '',
'agent', 'varchar', '', $char_d,
'typenum', 'int', '', '',
- 'freq', 'smallint', 'NULL', '',
+ 'freq', 'int', 'NULL', '',
'prog', @perl_type,
],
'primary_key' => 'agentnum',
'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,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
'county', 'varchar', 'NULL', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', 'NULL', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
'daytime', 'varchar', 'NULL', 20,
'fax', 'varchar', 'NULL', 12,
'payby', 'char', '', 4,
'payinfo', 'varchar', 'NULL', 16,
- 'paydate', @date_type,
+ #'paydate', @date_type,
+ 'paydate', 'varchar', 'NULL', 10,
'payname', 'varchar', 'NULL', $char_d,
'tax', 'char', 'NULL', 1,
'otaker', 'varchar', '', 8,
'index' => [ ['last'], ],
},
- 'cust_main_county' => { #county+state are checked off the cust_main_county
- #table for validation and to provide a tax rate.
- #add country?
+ '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', 'char', '', 2, #two letters max in US... elsewhere?
- 'county', 'varchar', '', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'country', 'char', '', 2,
'tax', 'real', '', '', #tax %
],
'primary_key' => 'taxnum',
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
- 'trancode', 'TINYINT', '', '',
+ 'trancode', 'int', '', '',
'cardnum', 'varchar', '', 16,
'exp', @date_type,
'payname', 'varchar', 'NULL', $char_d,
'pkg', 'varchar', '', $char_d,
'comment', 'varchar', '', $char_d,
'setup', @perl_type,
- 'freq', 'smallint', '', '', #billing frequency (months)
+ 'freq', 'int', '', '', #billing frequency (months)
'recur', @perl_type,
],
'primary_key' => 'pkgpart',
'index' => [ [] ],
},
+# 'part_title' => {
+# 'columns' => [
+# 'titlenum', 'int', '', '',
+# 'title', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'titlenum',
+# 'unique' => [ [] ],
+# 'index' => [ [] ],
+# },
+
'pkg_svc' => {
'columns' => [
'pkgpart', 'int', '', '',
'columns' => [
'popnum', 'int', '', '',
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'ac', 'char', '', 3,
'exch', 'char', '', 3,
#rest o' number?
'username', 'varchar', '', $username_len, #unique (& remove dup code)
'_password', 'varchar', '', 25, #13 for encryped pw's plus ' *SUSPENDED*
'popnum', 'int', 'NULL', '',
- 'uid', 'bigint', 'NULL', '',
- 'gid', 'bigint', 'NULL', '',
+ 'uid', 'int', 'NULL', '',
+ 'gid', 'int', 'NULL', '',
'finger', 'varchar', 'NULL', $char_d,
'dir', 'varchar', 'NULL', $char_d,
'shell', 'varchar', 'NULL', $char_d,
'columns' => [
'svcnum', 'int', '', '',
'domsvc', 'int', '', '',
- 'domuid', 'bigint', '', '',
+ 'domuid', 'int', '', '',
'domuser', 'varchar', '', $char_d,
],
'primary_key' => 'svcnum',
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct.export,v 1.2 1998-12-10 07:23:15 ivan Exp $
+#
# Create and export password files: passwd, passwd.adjunct, shadow,
# acp_passwd, acp_userinfo, acp_dialup, users
#
#
# OOPS! added arbitrary radius fields (pry 98-aug-16) but forgot to say so.
# ivan@sisd.com 98-sep-18
+#
+# $Log: svc_acct.export,v $
+# Revision 1.2 1998-12-10 07:23:15 ivan
+# use FS::Conf, need user (for datasrc)
+#
use strict;
+use vars qw($conf);
use Fcntl qw(:flock);
+use FS::Conf;
use FS::SSH qw(scp ssh);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch fields);
+use FS::svc_acct;
-my($fshellmachines)="/var/spool/freeside/conf/shellmachines";
-my(@shellmachines);
-if ( -e $fshellmachines ) {
- open(SHELLMACHINES,$fshellmachines);
- @shellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/shellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SHELLMACHINES>;
- close SHELLMACHINES;
-}
+my $user = shift or die &usage;
+adminsuidsetup $user;
-my($fbsdshellmachines)="/var/spool/freeside/conf/bsdshellmachines";
-my(@bsdshellmachines);
-if ( -e $fbsdshellmachines ) {
- open(BSDSHELLMACHINES,$fbsdshellmachines);
- @bsdshellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/bsdshellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <BSDSHELLMACHINES>;
- close BSDSHELLMACHINES;
-}
+$conf = new FS::Conf;
-my($fnismachines)="/var/spool/freeside/conf/nismachines";
-my(@nismachines);
-if ( -e $fnismachines ) {
- open(NISMACHINES,$fnismachines);
- @nismachines=map {
- /^(.*)$/ or die "Illegal line in conf/nismachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <NISMACHINES>;
- close NISMACHINES;
-}
+my @shellmachines = $conf->config('shellmachines')
+ if $conf->exists('shellmachines');
-my($ferpcdmachines)="/var/spool/freeside/conf/erpcdmachines";
-my(@erpcdmachines);
-if ( -e $ferpcdmachines ) {
- open(ERPCDMACHINES,$ferpcdmachines);
- @erpcdmachines=map {
- /^(.*)$/ or die "Illegal line in conf/erpcdmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <ERPCDMACHINES>;
- close ERPCDMACHINES;
-}
+my @bsdshellmachines = $conf->config('bsdshellmachines')
+ if $conf->exists('bsdshellmachines');
-my($fradiusmachines)="/var/spool/freeside/conf/radiusmachines";
-my(@radiusmachines);
-if ( -e $fradiusmachines ) {
- open(RADIUSMACHINES,$fradiusmachines);
- @radiusmachines=map {
- /^(.*)$/ or die "Illegal line in conf/radiusmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <RADIUSMACHINES>;
- close RADIUSMACHINES;
-}
+my @nismachines = $conf->config('nismachines')
+ if $conf->exists('nismachines');
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct.export.lock";
+my @erpcdmachines = $conf->config('erpcdmachines')
+ if $conf->exists('erpcdmachines');
-adminsuidsetup;
+my @radiusmachines = $conf->config('radiusmachines')
+ if $conf->exists('radiusmachines');
my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-srand(time|$$);
+require 5.004; #srand(time|$$);
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct.export.lock.". datasrc;
open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
select(EXPORT); $|=1; select(STDOUT);
flock(EXPORT,LOCK_UN);
close EXPORT;
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct.import,v 1.5 1999-03-25 08:42:19 ivan Exp $
+#
# ivan@sisd.com 98-mar-9
#
# changed 'password' field to '_password' because PgSQL 6.3 reserves this word
# arbitrary radius attributes ivan@sisd.com 98-aug-9
#
# don't import /var/spool/freeside/conf/shells! ivan@sisd.com 98-aug-13
+#
+# $Log: svc_acct.import,v $
+# Revision 1.5 1999-03-25 08:42:19 ivan
+# import stuff uses Term::Query and spits out (some kinds of) nonsensical input
+#
+# Revision 1.4 1999/03/24 00:43:38 ivan
+# die if no relevant services
+#
+# Revision 1.3 1998/12/10 07:23:16 ivan
+# use FS::Conf, need user (for datasrc)
+#
+# Revision 1.2 1998/10/13 12:07:51 ivan
+# Assigns password from the shadow file for RADIUS password "UNIX"
+#
use strict;
use vars qw(%part_svc);
use Date::Parse;
+use Term::Query qw(query);
use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch);
use FS::svc_acct;
+use FS::part_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix/";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
$FS::svc_acct::nossh_hack = 1;
%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
print "\n\n", &menu_svc, "\n", <<END;
Most accounts probably have entries in passwd and users (with Port-Limit
nonexistant or 1).
print "\n\n", &menu_svc, "\n", <<END;
POP mail accounts have entries in passwd only, and have a particular shell.
END
-print "Enter that shell: ";
-my($pop_shell)=&getvalue;
+my($pop_shell)=&getvalue("Enter that shell:");
my($popmail_svcpart)=&getpart;
print "\n\n", &menu_svc, "\n", <<END;
Enter the location and name of your _user_ passwd file, for example
"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
END
-print ":";
-my($loc_passwd)=&getvalue;
+my($loc_passwd)=&getvalue(":");
iscp("root\@$loc_passwd", "$spooldir/passwd.import");
print "\n\n", <<END;
Enter the location and name of your _user_ shadow file, for example
"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
END
-print ":";
-my($loc_shadow)=&getvalue;
+my($loc_shadow)=&getvalue(":");
iscp("root\@$loc_shadow", "$spooldir/shadow.import");
print "\n\n", <<END;
Enter the location and name of your radius "users" file, for example
"radius.isp.com:/etc/raddb/users"
END
-print ":";
-my($loc_users)=&getvalue;
+my($loc_users)=&getvalue(":");
iscp("root\@$loc_users", "$spooldir/users.import");
sub menu_svc {
( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
}
sub getpart {
- print "Enter part number, or 0 for none: ";
- &getvalue;
+ $^W=0; # Term::Query isn't -w-safe
+ query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ query $prompt, '';
+ $^W=1;
}
print "\n\n";
or die "1Unexpected line in users.import: $_";
my($password,$expiration);
($username,$password,$expiration)=(lc($1),$2,$4);
+ $password = '' if $password eq 'UNIX';
$upassword{$username}=$password;
undef %param;
} else {
$svcpart = $shell_svcpart;
}
- my($svc_acct) = create FS::svc_acct ({
+ my($svc_acct) = new FS::svc_acct ({
'svcpart' => $svcpart,
'username' => $username,
'password' => $password,
die "Illegal Port-Limit in users!\n";
}
- my($svc_acct) = create FS::svc_acct ({
+ my($svc_acct) = new FS::svc_acct ({
'svcpart' => $svcpart,
'username' => $username,
'password' => $password,
delete $upassword{$username};
}
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
-# Create and export VoiceNet_quasar.m4
+# $Id: svc_acct_sm.export,v 1.2 1998-12-10 07:23:17 ivan Exp $
+#
+# Create and export config files for sendmail, qmail
+#
+# (used to) Create and export VoiceNet_quasar.m4
#
# ivan@voicenet.com late oct 96
#
# put example $my_domain declaration in ivan@sisd.com 98-mar-23
#
# /var/spool/freeside/conf and sendmail updates ivan@sisd.com 98-aug-14
+#
+# $Log: svc_acct_sm.export,v $
+# Revision 1.2 1998-12-10 07:23:17 ivan
+# use FS::Conf, need user (for datasrc)
+#
use strict;
+use vars qw($conf);
use Fcntl qw(:flock);
use FS::SSH qw(ssh scp);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$conf = new FS::Conf;
-my($conf_shellm)="/var/spool/freeside/conf/shellmachine";
-my($fqmailmachines)="/var/spool/freeside/conf/qmailmachines";
my($shellmachine);
my(@qmailmachines);
-if ( -e $fqmailmachines ) {
- open(SHELLMACHINE,$conf_shellm) or die "Can't open $conf_shellm: $!";
- <SHELLMACHINE> =~ /^([\w\.\-]+)$/ or die "Illegal $conf_shellm";
- $shellmachine = $1;
- close SHELLMACHINE;
- open(QMAILMACHINES,$fqmailmachines);
- @qmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/qmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <QMAILMACHINES>;
- close QMAILMACHINES;
+if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine');
+ @qmailmachines = $conf->config('qmailmachines');
}
-my($fsendmailmachines)="/var/spool/freeside/conf/sendmailmachines";
-my(@sendmailmachines);
-if ( -e $fsendmailmachines ) {
- open(SENDMAILMACHINES,$fsendmailmachines);
- @sendmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/sendmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SENDMAILMACHINES>;
- close SENDMAILMACHINES;
-}
+my @sendmailmachines = $conf->config('sendmailmachines')
+ if $conf->exists('sendmailmachines');
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
+my $mydomain = $conf->config('domain');
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct_sm.export.lock";
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct_sm.export.lock.". datasrc;
-adminsuidsetup;
umask 066;
open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
flock(EXPORT,LOCK_UN);
close EXPORT;
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct_sm.import,v 1.4 1999-03-25 08:42:20 ivan Exp $
+#
# ivan@sisd.com 98-mar-9
#
# generalized svcparts ivan@sisd.com 98-mar-23
# has an (untested) section for sendmail, s/warn/die/g and generates a program
# to run on your mail machine _later_ instead of ssh'ing for each user
# ivan@sisd.com 98-jul-13
+#
+# $Log: svc_acct_sm.import,v $
+# Revision 1.4 1999-03-25 08:42:20 ivan
+# import stuff uses Term::Query and spits out (some kinds of) nonsensical input
+#
+# Revision 1.3 1999/03/24 00:51:55 ivan
+# die if no relevant services... cvspain
+#
+# Revision 1.2 1998/12/10 07:23:18 ivan
+# use FS::Conf, need user (for datasrc)
+#
use strict;
use vars qw(%d_part_svc %m_part_svc);
+use Term::Query qw(query);
use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch qsearchs);
use FS::svc_acct_sm;
use FS::svc_domain;
+use FS::svc_acct;
+use FS::part_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
my(%mta) = (
1 => "qmail",
%m_part_svc =
map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'});
+die "No services with svcdb svc_domain!\n" unless %d_part_svc;
+die "No services with svcdb svc_svc_acct_sm!\n" unless %m_part_svc;
+
print "\n\n",
( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
- "\n\nEnter part number for domains: ";
-my($domain_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
print "\n\n",
( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ),
- "\n\nEnter part number for mail aliases: ";
-my($mailalias_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mailalias_svcpart =
+ query "Enter part number for mail aliases: ", 'irk', [ keys %m_part_svc ];
+$^W=1;
print "\n\n", <<END;
Select your MTA from the following list.
END
print join "\n", map "$_: $mta{$_}", sort keys %mta;
-print "\n\n:";
-my($mta)=&getvalue;
+print "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mta = query ":", 'irk', [ keys %mta ];
+$^W=1;
if ( $mta{$mta} eq "qmail" ) {
Enter the location and name of your qmail control directory, for example
"mail.isp.com:/var/qmail/control"
END
- print ":";
- my($control)=&getvalue;
+ my($control)=&getvalue(":");
iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
Enter the location and name of your sendmail virtual user table, for example
"mail.isp.com:/etc/virtusertable"
END
- print ":";
- my($virtusertable)=&getvalue;
+ my($virtusertable)=&getvalue(":");
iscp("root\@$virtusertable","$spooldir/virtusertable.import");
print "\n\n", <<END;
Enter the location and name of your sendmail.cw file, for example
"mail.isp.com:/etc/sendmail.cw"
END
- print ":";
- my($sendmail_cw)=&getvalue;
+ my($sendmail_cw)=&getvalue(":");
iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
} else {
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; #Term::Query isn't -w-safe
+ query $prompt, '';
+ $^W=1;
}
print "\n\n";
my $domain = $1;
my($svc_domain);
unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) {
- $svc_domain = create FS::svc_domain ({
+ $svc_domain = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
}
unless ( exists $svcnum{$domain} ) {
- my($svc_domain) = create FS::svc_domain ({
+ my($svc_domain) = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
$svcnum{$domain}=$svc_domain->svcnum;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => '*',
die "Unknown user $username in virtusertable";
next;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => $domuser || '*',
$spooldir/virtualdomains !
END
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct_sm.export user\n";
+}
+
Silicon Interactive Software Design
-119 Signal Hill Road
-Holland, PA 18966-2924
+15 Skyview Way
+Newtown, PA 18940
# Template for importing legacy customer data
#
+# $Id: TEMPLATE_cust_main.import,v 1.3 1999-03-26 13:15:56 ivan Exp $
+#
# ivan@sisd.com 98-aug-17 - 20
+#
+# $Log: TEMPLATE_cust_main.import,v $
+# Revision 1.3 1999-03-26 13:15:56 ivan
+# s/create/new/, use all necessary FS::table_names to avoid warnings
+#
+# Revision 1.2 1998/12/16 05:29:45 ivan
+# adminsuidsetup now need user
+#
use strict;
+use Date::Parse;
use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(fields qsearch qsearchs);
use FS::cust_main;
use FS::cust_pkg;
-use Date::Parse;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::pkg_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
# use these for the imported cust_main records (unless you have these in legacy
# data)
$svc{'First'} =~ s/&/and/go;
$svc{'Zip'} =~ s/\s+$//go;
- my($cust_main) = create FS::cust_main ( {
+ my($cust_main) = new FS::cust_main ( {
'custnum' => $svc{'custnum'},
'agentnum' => $agentnum,
'last' => $svc{'last'},
die $error;
}
- my($cust_pkg)=create FS::cust_pkg ( {
+ my($cust_pkg)=new FS::cust_pkg ( {
'custnum' => $svc{'custnum'},
'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
'setup' => '',
} else {
#create new cust_svc record linked to cust_pkg record
- my($n_cust_svc) = create FS::cust_svc ({
+ my($n_cust_svc) = new FS::cust_svc ({
'svcnum' => $o_cust_svc->svcnum,
'pkgnum' => $cust_pkg->pkgnum,
'svcpart' => $pkg_svc->svcpart,
warn "\n$link of $line lines linked\n";
+# ---
+
+sub usage {
+ die "Usage:\n\n cust_main.import user\n";
+}
--- /dev/null
+From http://epoch.cs.berkeley.edu:8000/sequoia/dba/montage/FAQ/SQL.html
+ by Jean Anderson (jta@postgres.berkeley.edu)
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT_LENGTH, BOTH, CASCADE, CASCADED, CASE, CAST, CATALOG,
+ CHAR_LENGTH, CHARACTER_LENGTH, COALESCE, COLLATE, COLLATION, COLUMN,
+ CONNECT, CONNECTION, CONSTRAINT, CONSTRAINTS, CONVERT, CORRESPONDING,
+ CROSS, CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP, CURRENT_USER,
+ DATE, DAY, DEALLOCATE, DEFERRABLE, DEFERRED, DESCRIBE, DESCRIPTOR,
+ DIAGNOSTICS, DISCONNECT, DOMAIN, DROP, ELSE, END-EXEC, EXCEPT,
+ EXCEPTION, EXECUTE, EXTERNAL, EXTRACT, FALSE, FIRST, FULL, GET,
+ GLOBAL, HOUR, IDENTITY, IMMEDIATE, INITIALLY, INNER, INPUT,
+ INSENSITIVE, INTERSECT, INTERVAL, ISOLATION, JOIN, LAST, LEADING,
+ LEFT, LEVEL, LOCAL, LOWER, MATCH, MINUTE, MONTH, NAMES, NATIONAL,
+ NATURAL, NCHAR, NEXT, NO, NULLIF, OCTET_LENGTH, ONLY, OUTER, OUTPUT,
+ OVERLAPS, PAD, PARTIAL, POSITION, PREPARE, PRESERVE, PRIOR, READ,
+ RELATIVE, RESTRICT, REVOKE, RIGHT, ROWS, SCROLL, SECOND, SESSION,
+ SESSION_USER, SIZE, SPACE, SQLSTATE, SUBSTRING, SYSTEM_USER,
+ TEMPORARY, THEN, TIME, TIMESTAMP, TIMEZONE_HOUR, TIMEZONE_MINUTE,
+ TRAILING, TRANSACTION, TRANSLATE, TRANSLATION, TRIM, TRUE, UNKNOWN,
+ UPPER, USAGE, USING, VALUE, VARCHAR, VARYING, WHEN, WRITE, YEAR, ZONE
+
+ From sql3part2.txt (Annex E)
+
+ ACTION, ACTOR, AFTER, ALIAS, ASYNC, ATTRIBUTES, BEFORE, BOOLEAN,
+ BREADTH, COMPLETION, CURRENT_PATH, CYCLE, DATA, DEPTH, DESTROY,
+ DICTIONARY, EACH, ELEMENT, ELSEIF, EQUALS, FACTOR, GENERAL, HOLD,
+ IGNORE, INSTEAD, LESS, LIMIT, LIST, MODIFY, NEW, NEW_TABLE, NO,
+ NONE, OFF, OID, OLD, OLD_TABLE, OPERATION, OPERATOR, OPERATORS,
+ PARAMETERS, PATH, PENDANT, POSTFIX, PREFIX, PREORDER, PRIVATE,
+ PROTECTED, RECURSIVE, REFERENCING, REPLACE, ROLE, ROUTINE, ROW,
+ SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SESSION, SIMILAR, SPACE,
+ SQLEXCEPTION, SQLWARNING, START, STATE, STRUCTURE, SYMBOL, TERM,
+ TEST, THERE, TRIGGER, TYPE, UNDER, VARIABLE, VIRTUAL, VISIBLE,
+ WAIT, WITHOUT
+
+ sql3part4.txt (ANNEX E):
+
+ CALL, DO, ELSEIF, EXCEPTION, IF, LEAVE, LOOP, OTHERS, RESIGNAL,
+ RETURN, RETURNS, SIGNAL, TUPLE, WHILE
use FS::Record qw(qsearchs);
use FS::svc_acct;
-$SIG{CHLD} = sub { wait() };
+my $user = shift or die &usage;
+adminsuidsetup $user;
-&adminsuidsetup;
+my($shellmachine)=shift or die &usage;
-my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
+$SIG{CHLD} = sub { wait() };
-my($shellmachine)=shift;
-die "Usage: fs_passwd_server shellmachine\n" unless $shellmachine;
+my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
while (1) {
my($reader,$writer)=(new IO::Handle, new IO::Handle);
unless ( $svc_acct ) { print $writer "Incorrect password.\n"; next; }
my(%hash)=$svc_acct->hash;
- my($new_svc_acct) = create FS::svc_acct ( \%hash );
+ my($new_svc_acct) = new FS::svc_acct ( \%hash );
$new_svc_acct->setfield('_password',$new_password)
if $new_password && $new_password ne $old_password;
$new_svc_acct->setfield('finger',$new_gecos) if $new_gecos;
warn "Connection to $shellmachine lost! Reconnecting...\n";
}
+sub usage {
+ die "Usage:\n\n fs_passwd_server user shellmachine\n";
+}
+
--- /dev/null
+AuthName Freeside
+AuthType Basic
+require valid-user
#!/usr/bin/perl -Tw
#
-# agent.cgi: browse agent
+# $Id: agent.cgi,v 1.13 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-dec-12
#
# agent type was linking to wrong cgi ivan@sisd.com 98-jul-18
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent.cgi,v $
+# Revision 1.13 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.12 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.11 1999/01/20 09:43:16 ivan
+# comment out future UI code (but look at it, it's neat!)
+#
+# Revision 1.10 1999/01/19 05:13:24 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.9 1999/01/18 09:41:14 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.8 1999/01/18 09:22:26 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.7 1998/12/17 05:25:16 ivan
+# fix visual and other bugs
+#
+# Revision 1.6 1998/11/23 05:29:46 ivan
+# use CGI::Carp
+#
+# Revision 1.5 1998/11/23 05:27:31 ivan
+# to eliminate warnings
+#
+# Revision 1.4 1998/11/20 08:50:36 ivan
+# s/CGI::Base/CGI.pm, visual fixes
+#
+# Revision 1.3 1998/11/08 10:11:02 ivan
+# CGI.pm
+#
+# Revision 1.2 1998/11/07 10:24:22 ivan
+# don't use depriciated FS::Bill and FS::Invoice, other miscellania
+#
use strict;
-use CGI::Base;
+use vars qw( $ui $cgi $p $agent );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar table popurl);
+use FS::agent;
+use FS::agent_type;
+
+#Begin silliness
+#
+#use FS::UI::CGI;
+#use FS::UI::agent;
+#
+#$ui = new FS::UI::agent;
+#$ui->browse;
+#exit;
+#__END__
+#End silliness
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header('Agent Listing', menubar(
- 'Main Menu' => '../',
- 'Add new agent' => '../edit/agent.cgi'
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('Agent Listing', menubar(
+ 'Main Menu' => $p,
+ 'Agent Types' => $p. 'browse/agent_type.cgi',
+# 'Add new agent' => '../edit/agent.cgi'
)), <<END;
- <BR>
- Click on agent number to edit.
- <TABLE BORDER>
+Agents are resellers of your service. Agents may be limited to a subset of your
+full offerings (via their type).<BR><BR>
+END
+print &table(), <<END;
<TR>
- <TH><FONT SIZE=-1>Agent #</FONT></TH>
- <TH>Agent</TH>
+ <TH COLSPAN=2>Agent</TH>
<TH>Type</TH>
<TH><FONT SIZE=-1>Freq. (unimp.)</FONT></TH>
<TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH>
</TR>
END
+# <TH><FONT SIZE=-1>Agent #</FONT></TH>
+# <TH>Agent</TH>
-my($agent);
foreach $agent ( sort {
$a->getfield('agentnum') <=> $b->getfield('agentnum')
} qsearch('agent',{}) ) {
my($atype)=$agent_type->getfield('atype');
print <<END;
<TR>
- <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}">
+ <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}">
$hashref->{agentnum}</A></TD>
- <TD>$hashref->{agent}</TD>
- <TD><A HREF="../edit/agent_type.cgi?$typenum">$atype</A></TD>
+ <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}">
+ $hashref->{agent}</A></TD>
+ <TD><A HREF="${p}edit/agent_type.cgi?$typenum">$atype</A></TD>
<TD>$hashref->{freq}</TD>
<TD>$hashref->{prog}</TD>
</TR>
}
print <<END;
+ <TR>
+ <TD COLSPAN=2><A HREF="${p}edit/agent.cgi"><I>Add new agent</I></A></TD>
+ <TD><A HREF="${p}edit/agent_type.cgi"><I>Add new agent type</I></A></TD>
+ </TR>
</TABLE>
- </CENTER>
+
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# agent_type.cgi: browse agent_type
+# $Id: agent_type.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-dec-10
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/04/07 11:10:46 ivan
+# harmless typo
+#
+# Revision 1.5 1999/01/19 05:13:25 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:15 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:17 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/11/21 07:39:52 ivan
+# visual
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $p $agent_type );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl table);
+use FS::agent_type;
+use FS::type_pkgs;
+use FS::part_pkg;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-print header("Agent Type Listing", menubar(
- 'Main Menu' => '../',
- 'Add new agent type' => "../edit/agent_type.cgi",
-)), <<END;
- <BR>Click on agent type number to edit.
- <TABLE BORDER>
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("Agent Type Listing", menubar(
+ 'Main Menu' => $p,
+)), "Agent types define groups of packages that you can then assign to".
+ " particular agents.<BR><BR>", &table(), <<END;
<TR>
- <TH><FONT SIZE=-1>Type #</FONT></TH>
- <TH>Type</TH>
- <TH colspan="2">Packages</TH>
+ <TH COLSPAN=2>Agent Type</TH>
+ <TH COLSPAN="2">Packages</TH>
</TR>
END
-my($agent_type);
foreach $agent_type ( sort {
$a->getfield('typenum') <=> $b->getfield('typenum')
} qsearch('agent_type',{}) ) {
$rowspan = int($rowspan/2+0.5) ;
print <<END;
<TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}">
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">
$hashref->{typenum}
</A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{atype}</TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">$hashref->{atype}</A></TD>
END
my($type_pkgs);
my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart });
print qq!<TR>! if ($tdcount == 0) ;
$tdcount = 0 if ($tdcount == -1) ;
- print qq!<TD><A HREF="../edit/part_pkg.cgi?$pkgpart">!,
+ print qq!<TD><A HREF="${p}edit/part_pkg.cgi?$pkgpart">!,
$part_pkg->getfield('pkg'),"</A></TD>";
$tdcount ++ ;
if ($tdcount == 2)
}
print <<END;
- </TR></TABLE>
- </CENTER>
+ <TR><TD COLSPAN=2><I><A HREF="${p}edit/agent_type.cgi">Add new agent type</A></I></TD></TR>
+ </TABLE>
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# cust_main_county.cgi: browse cust_main_county
+# $Id: cust_main_county.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-dec-13
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.7 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.6 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.5 1999/01/19 05:13:26 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:16 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:18 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/11/18 09:01:34 ivan
+# i18n! i18n!
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $p $cust_main_county );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl table);
+use FS::cust_main_county;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header("Tax Rate Listing", menubar(
- 'Main Menu' => '../',
- 'Edit tax rates' => "../edit/cust_main_county.cgi",
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("Tax Rate Listing", menubar(
+ 'Main Menu' => $p,
+ 'Edit tax rates' => $p. "edit/cust_main_county.cgi",
)),<<END;
- <BR>Click on <u>expand</u> to specify tax rates by county.
- <P><TABLE BORDER>
+ Click on <u>expand country</u> to specify a country's tax rates by state.
+ <BR>Click on <u>expand state</u> to specify a state's tax rates by county.
+ <BR><BR>
+END
+print &table(), <<END;
<TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
<TH><FONT SIZE=-1>State</FONT></TH>
<TH>County</TH>
<TH><FONT SIZE=-1>Tax</FONT></TH>
</TR>
END
-my($cust_main_county);
foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
my($hashref)=$cust_main_county->hashref;
print <<END;
<TR>
- <TD>$hashref->{state}</TD>
+ <TD>$hashref->{country}</TD>
END
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
+ print "<TD>", $hashref->{state}
+ ? $hashref->{state}
: qq!(ALL) <FONT SIZE=-1>!.
- qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
- qq!">expand</A></FONT>!
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
+ qq!">expand country</A></FONT>!
, "</TD>";
+ print "<TD>";
+ if ( $hashref->{county} ) {
+ print $hashref->{county};
+ } else {
+ print "(ALL)";
+ if ( $hashref->{state} ) {
+ print qq!<FONT SIZE=-1>!.
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
+ qq!">expand state</A></FONT>!;
+ }
+ }
+ print "</TD>";
print <<END;
<TD>$hashref->{tax}%</TD>
#!/usr/bin/perl -Tw
#
-# part_svc.cgi: browse part_pkg
+# $Id: part_pkg.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-dec-5,9
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/01/19 05:13:27 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:17 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/17 05:25:19 ivan
+# fix visual and other bugs
+#
+# Revision 1.3 1998/11/21 07:23:45 ivan
+# visual
+#
+# Revision 1.2 1998/11/21 07:00:32 ivan
+# visual
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $p $part_pkg );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl table);
+use FS::part_pkg;
+use FS::pkg_svc;
+use FS::part_svc;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
+$p = popurl(2);
-print header("Package Part Listing",menubar(
- 'Main Menu' => '../',
- 'Add new package' => "../edit/part_pkg.cgi",
-)), <<END;
- <BR>Click on package part number to edit.
+print $cgi->header( '-expires' => 'now' ), header("Package Part Listing",menubar(
+ 'Main Menu' => $p,
+)), "One or more services are grouped together into a package and given",
+ " pricing information. Customers purchase packages, not services.<BR><BR>",
+ &table(), <<END;
<TABLE BORDER>
<TR>
- <TH><FONT SIZE=-1>Part #</FONT></TH>
- <TH>Package</TH>
+ <TH COLSPAN=2>Package</TH>
<TH>Comment</TH>
<TH><FONT SIZE=-1>Setup Fee</FONT></TH>
<TH><FONT SIZE=-1>Freq.</FONT></TH>
</TR>
END
-my($part_pkg);
foreach $part_pkg ( sort {
$a->getfield('pkgpart') <=> $b->getfield('pkgpart')
} qsearch('part_pkg',{}) ) {
my($rowspan)=scalar(@pkg_svc);
print <<END;
<TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}">
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">
$hashref->{pkgpart}
</A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD>
<TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
<TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
<TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
END
my($pkg_svc);
+ my($n)="";
foreach $pkg_svc ( @pkg_svc ) {
my($svcpart)=$pkg_svc->getfield('svcpart');
my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart });
- print qq!<TD><A HREF="../edit/part_svc.cgi?$svcpart">!,
+ print $n,qq!<TD><A HREF="${p}edit/part_svc.cgi?$svcpart">!,
$part_svc->getfield('svc'),"</A></TD><TD>",
- $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n";
+ $pkg_svc->getfield('quantity'),"</TD></TR>\n";
+ $n="<TR>";
}
print "</TR>";
}
print <<END;
- </TR></TABLE>
- </CENTER>
+ <TR><TD COLSPAN=2><I><A HREF="${p}edit/part_pkg.cgi">Add new package</A></I></TD></TR>
+ </TABLE>
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# part_referral.cgi: Browse part_referral
+# $Id: part_referral.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 98-feb-23
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.9 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.8 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.7 1999/01/19 05:13:28 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:18 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/17 05:25:20 ivan
+# fix visual and other bugs
+#
+# Revision 1.4 1998/12/17 04:32:55 ivan
+# print $cgi->header
+#
+# Revision 1.3 1998/12/17 04:31:36 ivan
+# use CGI::Carp
+#
+# Revision 1.2 1998/12/17 04:26:04 ivan
+# use CGI; no relative URLs
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $p $part_referral );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl table);
+use FS::part_referral;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header("Referral Listing", menubar(
- 'Main Menu' => '../',
- 'Add new referral' => "../edit/part_referral.cgi",
-)), <<END;
- <BR>Click on referral number to edit.
- <TABLE BORDER>
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("Referral Listing", menubar(
+ 'Main Menu' => $p,
+# 'Add new referral' => "../edit/part_referral.cgi",
+)), "Where a customer heard about your service. Tracked for informational purposes.<BR><BR>", &table(), <<END;
<TR>
- <TH><FONT SIZE=-1>Referral #</FONT></TH>
- <TH>Referral</TH>
+ <TH COLSPAN=2>Referral</TH>
</TR>
END
-my($part_referral);
foreach $part_referral ( sort {
$a->getfield('refnum') <=> $b->getfield('refnum')
} qsearch('part_referral',{}) ) {
my($hashref)=$part_referral->hashref;
print <<END;
<TR>
- <TD><A HREF="../edit/part_referral.cgi?$hashref->{refnum}">
+ <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}">
$hashref->{refnum}</A></TD>
- <TD>$hashref->{referral}</TD>
+ <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}">
+ $hashref->{referral}</A></TD>
</TR>
END
}
print <<END;
+ <TR>
+ <TD COLSPAN=2><A HREF="${p}edit/part_referral.cgi"><I>Add new referral</I></A></TD>
+ </TR>
</TABLE>
</CENTER>
</BODY>
#!/usr/bin/perl -Tw
#
-# part_svc.cgi: browse part_svc
+# $Id: part_svc.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-nov-14, 97-dec-9
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.11 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/01/19 05:13:29 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.8 1999/01/18 09:41:19 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.7 1998/12/30 23:06:22 ivan
+# typo
+#
+# Revision 1.6 1998/12/30 23:03:20 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.5 1998/12/17 05:25:21 ivan
+# fix visual and other bugs
+#
+# Revision 1.4 1998/11/21 02:26:22 ivan
+# visual
+#
+# Revision 1.3 1998/11/20 23:10:57 ivan
+# visual
+#
+# Revision 1.2 1998/11/20 08:50:37 ivan
+# s/CGI::Base/CGI.pm, visual fixes
+#
use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch);
-use FS::part_svc qw(fields);
-use FS::CGI qw(header menubar);
+use vars qw( $cgi $p $part_svc );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch fields);
+use FS::part_svc;
+use FS::CGI qw(header menubar popurl table);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header('Service Part Listing', menubar(
- 'Main Menu' => '../',
- 'Add new service' => "../edit/part_svc.cgi",
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('Service Part Listing', menubar(
+ 'Main Menu' => $p,
)),<<END;
- <BR>Click on service part number to edit.
- <TABLE BORDER>
+ Services are items you offer to your customers.<BR><BR>
+END
+print &table(), <<END;
<TR>
- <TH>Part #</TH>
- <TH>Service</TH>
+ <TH COLSPAN=2>Service</TH>
<TH>Table</TH>
<TH>Field</TH>
- <TH>Action</TH>
- <TH>Value</TH>
+ <TH COLSPAN=2>Modifier</TH>
</TR>
END
-my($part_svc);
foreach $part_svc ( sort {
$a->getfield('svcpart') <=> $b->getfield('svcpart')
} qsearch('part_svc',{}) ) {
grep /^${svcdb}__/,
fields('part_svc')
;
- my($rowspan)=scalar(@rows);
+ my($rowspan)=scalar(@rows) || 1;
print <<END;
<TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_svc.cgi?$hashref->{svcpart}">
- $hashref->{svcpart}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{svc}</TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}">
+ $hashref->{svcpart}</A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}"> $hashref->{svc}</A></TD>
<TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD>
END
+
+ my($n1)='';
my($row);
foreach $row ( @rows ) {
my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<TD>$row</TD><TD>";
+ print $n1,"<TD>$row</TD><TD>";
if ( $flag eq "D" ) { print "Default"; }
elsif ( $flag eq "F" ) { print "Fixed"; }
else { print "(Unknown!)"; }
- print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD></TR><TR>";
+ print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD>";
+ $n1="</TR><TR>";
}
print "</TR>";
}
print <<END;
+ <TR>
+ <TD COLSPAN=2><A HREF="${p}edit/part_svc.cgi"><I>Add new service</I></A></TD>
+ </TR>
</TABLE>
- </CENTER>
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# svc_acct_pop.cgi: browse pops
+# $Id: svc_acct_pop.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 98-mar-8
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.7 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.6 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.5 1999/01/19 05:13:30 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:20 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:22 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/12/17 04:36:59 ivan
+# use CGI;, use CGI::Carp, visual changes, relative URLs
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $p $svc_acct_pop );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup swapuid);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar table popurl);
+use FS::svc_acct_pop;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header('POP Listing', menubar(
- 'Main Menu' => '../',
- 'Add new POP' => "../edit/svc_acct_pop.cgi",
-)), <<END;
- <BR>Click on pop number to edit.
- <TABLE BORDER>
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('POP Listing', menubar(
+ 'Main Menu' => $p,
+)), "Points of Presence<BR><BR>", &table(), <<END;
<TR>
- <TH><FONT SIZE=-1>POP #</FONT></TH>
+ <TH></TH>
<TH>City</TH>
<TH>State</TH>
<TH>Area code</TH>
</TR>
END
-my($svc_acct_pop);
foreach $svc_acct_pop ( sort {
$a->getfield('popnum') <=> $b->getfield('popnum')
} qsearch('svc_acct_pop',{}) ) {
my($hashref)=$svc_acct_pop->hashref;
print <<END;
<TR>
- <TD><A HREF="../edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
$hashref->{popnum}</A></TD>
- <TD>$hashref->{city}</TD>
- <TD>$hashref->{state}</TD>
- <TD>$hashref->{ac}</TD>
- <TD>$hashref->{exch}</TD>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{city}</A></TD>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{state}</A></TD>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{ac}</A></TD>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{exch}</A></TD>
</TR>
END
}
print <<END;
+ <TR>
+ <TD COLSPAN=5><A HREF="${p}edit/svc_acct_pop.cgi"><I>Add new POP</I></A></TD>
+ </TR>
</TABLE>
</CENTER>
</BODY>
+++ /dev/null
-ivan@rootwood:~/src/CGI-modules-2.76/CGI$ diff -c Base.pm Base.pm.orig
-*** Base.pm Sat Jul 18 00:33:21 1998
---- Base.pm.orig Sat Jul 18 00:06:12 1998
-***************
-*** 938,945 ****
- my $orig_uri = $self->get_uri;
- $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri")
- if $Debug;
-! my $msg = ($perm) ? StatusHdr(301,"Moved Permanently")
-! : StatusHdr(302,"Moved Temporarily");
- my $hdrs = SendHeaders($msg, LocationHdr($to_uri));
- $self->log($hdrs);
- }
---- 938,945 ----
- my $orig_uri = $self->get_uri;
- $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri")
- if $Debug;
-! my $msg = ($perm) ? ServerHdr(301,"Moved Permanently")
-! : ServerHdr(302,"Moved Temporarily");
- my $hdrs = SendHeaders($msg, LocationHdr($to_uri));
- $self->log($hdrs);
- }
-
</head>
<body>
<h1>Configuration files</h1>
-Configuration files and directories are located in `/var/spool/freeside/conf'.
+Configuration file layout has changed in 1.2.x.
+<ul>
+ <li>First, the file `/usr/local/etc/freeside/mapsecrets' is read. Each line
+in this file contains a username and filename, separated by whitespace. Note
+that these are not local usernames - they are passed from Apache (you _did_
+setup <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">
+user authetication</a>, correct?). Filenames are located in
+`/usr/local/etc/freeside/'. The specified filename is parsed exactly
+the same as the pre-1.2.x `secrets' file:
+ <li>Three lines: Database engine datasource (for example,
+ `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password.
+ This file should not be world readable. See the DBI manpage and the manpage
+ for your DBD for the exact syntax.
+</ul>
+All further configuration files and directories are located in
+`/usr/local/etc/freeside/conf.<i>datasource</i>', for example,
+`/usr/local/etc/freeside/conf.DBI:Pg:dbname=freeside'
<ul>
<li>address - Your company name and address, four lines.
<li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
<li>domain - Your domain name.
<li>erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
<li>home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
+ <li>invoice_from - Return address on email invoices.
<li>lpr - Print command for paper invoices, for example `lpr -h'.
<li>nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
<li>qmailmachines - Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains', `/var/qmail/control/recipientmap', and `/var/qmail/control/rcpthosts'. The existance of this file (even if empty) also turns on user `.qmail-extension' file maintenance in conjunction with `shellmachine'.
<li>registries/internic/to - Email address to which InterNIC domain registrations are sent.
</ul>
</ul>
- <li>secrets - Three lines: Database engine datasource (for example, `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password. This file should not be world readable.
<li>sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'.
<li>shellmachine - A single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines', it also enables `.qmail-extension' file maintenance.
<li>shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files.
<body>
<h1>File exporting</h1>
<ul>
- <li>bin/svc_acct.export will create UNIX `passwd', `shadow' and `master.passwd' files, ERPCD `acp_passwd' and `acp_dialup' files and a RADIUS `users' file in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below.
+ <li>bin/svc_acct.export will create UNIX <b>passwd</b>, <b>shadow</b> and <b>master.passwd</b> files, ERPCD <b>acp_passwd</b> and <b>acp_dialup</b> files and a RADIUS <b>users</b> file in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a>) will authenticate directly out of an SQL database. In these cases,
+it is reccommended that you copy the svc_acct table to an external RADIUS machine rather than run the RADIUS server on your Freeside machine.
<ul>
- <li>shellmachines - passwd and shadow are copied to the remote machine as /etc/passwd.new and /etc/shadow.net and then moved to /etc/passwd and /etc/shadow if no errors occur.
- <li>bsdshellmachines - passwd and master.passwd are copied to the remote machine as /etc/passwd.new and /etc/master.passwd.new and moved to /etc/passwd and /etc/master.passwd if no errors occur.
- <li>nismachines - passwd and shadow are copied to the `/etc/global' directory on the remote machine. If no errors occur, the command `( cd /var/yp; make; )' is executed on the remote machine.
- <li>erpcdmachines - acp_passwd and acp_dialup are copied to the `/usr/annex' directory on the remote machine. If no errors occur, the command `( kill -USR1 `cat /usr/annex/erpcd.pid` )' is executed on the remote machine.
- <li>radiusmachines - users is copied to the `/etc/raddb' directory on the remote machine. If no errors occur, the command `( builddbm )' is executed on the remote machine.
+ <li>shellmachines - <b>passwd</b> and <b>shadow</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/shadow.new</b> and then moved to <b>/etc/passwd</b> and <b>/etc/shadow</b> if no errors occur.
+ <li>bsdshellmachines - <b>passwd</b> and <b>master.passwd</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/master.passwd.new</b> and moved to <b>/etc/passwd</b> and <b>/etc/master.passwd</b> if no errors occur.
+ <li>nismachines - <b>passwd</b> and <b>shadow</b> are copied to the <b>/etc/global</b> directory on the remote machine. If no errors occur, the command <b>( cd /var/yp; make; )</b> is executed on the remote machine.
+ <li>erpcdmachines - <b>acp_passwd</b> and <b>acp_dialup</b> are copied to the <b>/usr/annex</b> directory on the remote machine. If no errors occur, the command <b>( kill -USR1 `cat /usr/annex/erpcd.pid` )</b> is executed on the remote machine.
+ <li>radiusmachines - <b>users</b> is copied to the <b>/etc/raddb</b> directory on the remote machine. If no errors occur, the command <b>( builddbm )</b> is executed on the remote machine.
</ul>
<li>site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
<ul>
- <li>The command `useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i>' is executed when a user is added.
- <li>The command `userdel <i>username</i>' is executed with a user is deleted.
- <li>If a user's home directory changes, the command `[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )' is executed.
+ <li>The command <b>useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i></b> is executed when a user is added.
+ <li>The command <b>userdel <i>username</i></b> is executed with a user is deleted.
+ <li>If a user's home directory changes, the command <b>[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )</b> is executed.
</ul>
- <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a>
`rcpthosts', `recipientmap' and `virtualdomains' files and <a href="http://www.sendmail.org">Sendmail</a> `virtusertable' and `sendmail.cw' files in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded; see below.
+ <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a>
<b>rcpthosts</b>, <b>recipientmap</b> and <b>virtualdomains</b> files and <a href="http://www.sendmail.org">Sendmail</a> <b>virtusertable</b> and <b>sendmail.cw</b> files in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded; see below.
<ul>
- <li>qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the `/var/qmail/control' directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated `/var/spool/freeside/export/virtualdomains.FIX' on a machine with your user home directories before exporting qmail configuration files.
- <li>shellmachine - The command `[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }' will be run on this machine for users in the virtualdomains file.
- <li>sendmailmachines - sendmail.cw and virtusertable are copied to the remote machine as /etc/sendmail.cw.new and /etc/virtusertable.new and moved to /etc/sendmail.cw and /etc/virtusertable if no errors occur.
+ <li>qmailmachines - <b>recipientmap</b>, <b>virtualdomains</b> and <b>rcpthosts</b> are copied to the <b>/var/qmail/control</b> directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated <b>/usr/local/etc/freeside/export.<i>datasrc</i>/virtualdomains.FIX</b> on a machine with your user home directories before exporting qmail configuration files.
+ <li>shellmachine - The command <b>[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }</b> will be run on this machine for users in the virtualdomains file.
+ <li>sendmailmachines - <b>sendmail.cw</b> and <b>virtusertable</b> are copied to the remote machine as <b>/etc/sendmail.cw.new</b> and <b>/etc/virtusertable.new</b> and moved to <b>/etc/sendmail.cw</b> and <b>/etc/virtusertable</b> if no errors occur.
</ul>
- <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated.
+ <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user <b>.qmail-</b> files can be updated.
<ul>
- <li>The command `[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }' is run.
+ <li>The command <b>[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }</b> is run.
</ul>
</ul>
<br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b>
<ul>
<li><a href="install.html">New Installation</a>
<li><a href="upgrade.html">Upgrading from 1.0.x to 1.1.x</a>
- <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.3</a>
+ <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.4</a>
+ <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</a>
<li><a href="config.html">Configuration files</a>
<!--
<li><a href="admin.html">Administration</a>
<ul>
<li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a>
<li><a href="ftp://ftp.cs.hut.fi/pub/ssh/">SSH</a>
- <li>agrep from the <a href="http://glimpse.cs.arizona.edu">Glimpse</a> distribution, if you want fuzzy searching capability
- <li><a href="http://www.perl.com/CPANl/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04)
- <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a>
+ <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04)
+ <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a> (see the <a href="postgresql.html">PostgreSQL notes</a>)
<li>Perl modules
<ul>
+ <li><a href="http://www.perl.com/CPAN/modules/by-module/Array/">Array-PrintCols</a>
+ <li><a href="http://www.perl.com/CPAN/modules/by-module/Term/">Term-Query</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/MIME/">MIME-Base64</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/Data">Data-Dumper</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/MD5">MD5</a>
+ <li><a href="http://www.perl.com/CPAN/modules/by-module/URI">URI</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/Net">libnet</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/LWP/">libwww-perl</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/CGI/">CGI-modules</a> (<b>NOT</b> CGI.pm) with this <a href="CGI-modules-2.76-patch.txt">patch</a> applied
<li><a href="http://www.perl.com/CPAN/modules/by-module/Business/">Business-CreditCard</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/Data/">Data-ShowTable</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/Mail/">MailTools</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/Date/">DateManip</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/File/">File-CounterFile</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/FreezeThaw/">FreezeThaw</a>
+ <li><a href="http://www.perl.com/CPAN/modules/by-module/String/">String-Approx</a>
<li><a href="http://www.perl.com/CPAN/modules/by-module/DBI/">DBI
<li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
</ul>
cp -r fs-x.y.z/htdocs/* /usr/local/apache/htdocs/freeside</pre> or <pre>ln -s /full/path/to/fs-x.y.z/htdocs /usr/local/apache/htdocs/freeside</pre>
<li>Restrict access to this web interface. (with <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache</a>)
<li>Enable CGI execution for files with the `.cgi' extension. (with <a href="http://www.apache.org/docs/mod/mod_mime.html#addhandler">Apache</a>)
- <li>Set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
+ <li>Set ownership and permissions for the web interface. The web interface needs to run as the freeside user - there are several ways to do this.
+ <ul>
+ <li>Use Perl's setuid emulation: see the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">Security Bugs</a> section of the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html">perlsec</a> manpage.
<pre>cd /usr/local/apache/htdocs/freeside
chown -R freeside .
chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
-<li>Create the base Freeside directory `/var/spool/freeside', and the subdirectories `conf', `counters', and `export'. <pre>mkdir /var/spool/freeside
-mkdir /var/spool/freeside/conf
-mkdir /var/spool/freeside/counters
-mkdir /var/spool/freeside/export
-chown -R freeside /var/spool/freeside</pre>
- <li>Create the necessary <a href="config.html">configuration files</a>.
- <li>Run bin/fs-setup to create the database tables.
+ <li>Use Apache's <a href="http://www.apache.org/docs/suexec.html">suEXEC</a>.
+<pre>cd /usr/local/apache/htdocs/freeside
+chown -R freeside .
+chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ <li>Use <a href="http://perl.apache.org/">mod_perl</a>. You should run a separate iteration of Apache[-SSL] as the freeside user. (Warning: The redirect method of CGI.pm 2.36 [as distributed with Perl 5.004_04] is broken under mod_perl. Downlaod the current version from <a href="http://www.perl.com/CPAN/modules/by-module/CGI">CPAN</a>. Apache 1.3.6 is also highly recommended because of signal handling problems in earlier versions.)
+<pre>cd /usr/local/apache/htdocs/freeside
+chown -R root .
+chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ </ul>
+<li>Create the necessary <a href="config.html">configuration files</a>.
+<li>Create the `/usr/local/etc/freeside/counters.<i>datasrc</i>', and
+ `/usr/local/etc/freeside/export.<i>datasrc</i>' directories for each <i>datasrc</i> (owned by the freeside user).
+ <li>As the freeside user, run bin/fs-setup to create the database tables.
</ul>
</body>
<body>
<h1>Importing legacy data</h1>
<ul>
- <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> (with table svc_acct) as follows:
+ <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="../browse/part_svc.cgi">services</a> (with table svc_acct) as follows:
<ul>
<li>Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1)
<li>Some accounts have entries in passwd and users, but with Port-Limit 2 (or more)
<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="http://rootwood.sisd.com/freeside/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)
FS::CGI - Subroutines for the web interface
SYNOPSIS
- use FS::CGI qw(header menubar idiot eidiot);
+ use FS::CGI qw(header menubar idiot eidiot popurl);
print header( 'Title', '' );
print header( 'Title', menubar('item', 'URL', ... ) );
idiot "error message";
eidiot "error message";
+ $url = popurl; #returns current url
+ $url = popurl(3); #three levels up
+
DESCRIPTION
Provides a few common subroutines for the web interface.
Returns an HTML menubar.
idiot ERROR
+ This is depriciated. Don't use it.
+
Sends headers and an HTML error message.
eidiot ERROR
+ This is depriciated. Don't use it.
+
Sends headers and an HTML error message, then exits.
+ popurl LEVEL
+ Returns current URL with LEVEL levels of path removed from
+ the end (default 0).
+
+ table
+ Returns HTML tag for beginning a table.
+
+ itable
+ Returns HTML tag for beginning an (invisible) table.
+
+ ntable
+ This is getting silly.
+
BUGS
Not OO.
Not complete.
- Uses CGI-modules instead of CGI.pm
-
SEE ALSO
- the CGI::Base manpage
+ the CGI manpage, the CGI::Base manpage
HISTORY
subroutines for the HTML/CGI GUI, not properly OO. :(
pod ivan@sisd.com 98-sep-12
+ $Log: CGI.txt,v $
+ Revision 1.4 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.17 1999/02/07 09:59:43 ivan more
+ mod_perl fixes, and bugfixes Peter Wemm sent via email
+
+ Revision 1.16 1999/01/25 12:26:05 ivan yet more mod_perl stuff
+
+ Revision 1.15 1999/01/18 09:41:48 ivan all $cgi->header calls
+ now include ( '-expires' => 'now' ) for mod_perl (good idea
+ anyway)
+
+ Revision 1.14 1999/01/18 09:22:37 ivan changes to track email
+ addresses for email invoicing
+
+ Revision 1.12 1998/12/23 02:23:16 ivan popurl always has
+ trailing slash
+
+ Revision 1.11 1998/11/12 07:43:54 ivan *** empty log message ***
+
+ Revision 1.10 1998/11/12 01:53:47 ivan added table command
+
+ Revision 1.9 1998/11/09 08:51:49 ivan bug squash
+
+ Revision 1.7 1998/11/09 06:10:59 ivan added sub url
+
+ Revision 1.6 1998/11/09 05:44:20 ivan *** empty log message ***
+
+ Revision 1.4 1998/11/09 04:55:42 ivan support depriciated
+ CGI::Base as well as CGI.pm (for now)
+
+ Revision 1.3 1998/11/08 10:50:19 ivan s/CGI::Base/CGI/; etc.
+
SYNOPSIS
use FS::Conf;
+ $conf = new FS::Conf "/config/directory";
+
+ $FS::Conf::default_dir = "/config/directory";
$conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
$dir = $conf->dir;
METHODS
new [ DIRECTORY ]
- Create a new configuration object. Optionally, a non-default
- directory may be specified.
+ Create a new configuration object. A directory arguement is
+ required if $FS::Conf::default_dir has not been set.
dir Returns the directory.
corresponding value is undefined.
BUGS
- The option to specify a non-default directory should probably be
- removed.
-
Write access (with locking) should be implemented.
SEE ALSO
HISTORY
Ivan Kohler <ivan@sisd.com> 98-sep-6
+ sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27
+
+ $Log: Conf.txt,v $
+ Revision 1.5 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/03/29 01:29:33 ivan die
+ unless the configuration directory exists
+
+ Revision 1.2 1998/11/13 04:08:44 ivan no default default_dir
+ (ironic)
+
FS::Invoice - Legacy stub
SYNOPSIS
- The functioanlity of FS::invoice has been integrated in
+ The functionality of FS::Invoice has been integrated in
FS::cust_bill.
HISTORY
=< 0 return address comes from /var/spool/freeside/conf/address
ivan@sisd.com 98-jul-2
+ pod ivan@sisd.com 98-sep-20something
+
+ s/ISA/@ISA/ in use vars ivan@sisd.com 98-sep-27
+
SYNOPSIS
use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
+ use FS::Record qw(dbh fields qsearch qsearchs dbdef);
$record = new FS::Record 'table', \%hash;
$record = new FS::Record 'table', { 'column' => 'value', ... };
$hashref = $record->hashref;
- $error = $record->add;
+ $error = $record->insert;
+ #$error = $record->add; #depriciated
- $error = $record->del;
+ $error = $record->delete;
+ #$error = $record->del; #depriciated
- $error = $new_record->rep($old_record);
+ $error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #depriciated
$value = $record->unique('column');
$fields = hfields('table');
if ( $fields->{Field} ) { # etc.
- @fields = fields 'table';
+ @fields = fields 'table'; #as a subroutine
+ @fields = $record->fields; #as a method call
DESCRIPTION
(Mostly) object-oriented interface to database records. Records
as a base class for table-specific classes to inherit from, i.e.
FS::cust_main.
-METHODS
- new TABLE, HASHREF
+CONSTRUCTORS
+ new [ TABLE, ] HASHREF
Creates a new record. It doesn't store it in the database,
- though. See the section on "add" for that.
+ though. See the section on "insert" for that.
Note that the object stores this hash reference, not a
distinct copy of the hash it points to. You can ask the
object for a copy with the *hash* method.
+ TABLE can only be omitted when a dervived class overrides
+ the table method.
+
qsearch TABLE, HASHREF
Searches the database for all records matching (at least)
the key/value pairs in HASHREF. Returns all the records
- found as FS::Record objects.
+ found as `FS::TABLE' objects if that module is loaded (i.e.
+ via `use FS::cust_main;'), otherwise returns FS::Record
+ objects.
qsearchs TABLE, HASHREF
- Searches the database for a record matching (at least) the
- key/value pairs in HASHREF, and returns the record found as
- an FS::Record object. If more than one record matches, it
- carps but returns the first. If this happens, you either
- made a logic error in asking for a single item, or your data
- is corrupted.
+ Same as qsearch, except that if more than one record
+ matches, it carps but returns the first. If this happens,
+ you either made a logic error in asking for a single item,
+ or your data is corrupted.
+METHODS
table
Returns the table name.
hashref
Returns a reference to the column/value hash.
- add Adds this record to the database. If there is an error, returns
- the error, otherwise returns false.
+ insert
+ Inserts this record to the database. If there is an error,
+ returns the error, otherwise returns false.
+
+ add Depriciated (use insert instead).
- del Delete this record from the database. If there is an error,
+ delete
+ Delete this record from the database. If there is an error,
returns the error, otherwise returns false.
- rep OLD_RECORD
+ del Depriciated (use delete instead).
+
+ replace OLD_RECORD
Replace the OLD_RECORD with this one in the database. If
there is an error, returns the error, otherwise returns
false.
+ rep Depriciated (use replace instead).
+
+ check
+ Not yet implemented, croaks. Derived classes should provide
+ a check method.
+
unique COLUMN
Replaces COLUMN in record with a unique number. Called by
the add method on primary keys and single-field unique
ut_anything COLUMN
Untaints arbitrary data. Be careful.
+ fields [ TABLE ]
+ This can be used as both a subroutine and a method call. It
+ returns a list of the columns in this record's table, or an
+ explicitly specified table. (See the dbdef_table manpage).
+
SUBROUTINES
reload_dbdef([FILENAME])
Load a database definition (see the FS::dbdef manpage),
It returns a hash-type list with the fields of this
record's table set true.
- fields TABLE
- This returns a list of the columns in this record's
- table (See the dbdef_table manpage).
+VERSION
+ $Id: Record.txt,v 1.5 1999-04-08 13:39:31 ivan Exp $
BUGS
This module should probably be renamed, since much of the
ut_sqltype (like ut_varchar) should all be defined
- A fallback check method should be provided with uses the
+ A fallback check method should be provided whith uses the
dbdef.
The ut_money method assumes money has two decimal digits.
All the subroutines probably should be methods, here or
elsewhere.
+ Probably should borrow/use some dbdef methods where
+ appropriate (like sub fields)
+
SEE ALSO
the FS::dbdef manpage, the FS::UID manpage, the DBI manpage
added pod documentation ivan@sisd.com 98-sep-6
+ ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
+
+ $Log: Record.txt,v $
+ Revision 1.5 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.15 1999/04/08 12:08:59 ivan
+ fix up PostgreSQL money fields so you can actually use them
+ as numbers. bah.
+
+ Revision 1.14 1999/04/07 14:58:31 ivan more kludges to get
+ around different null/empty handling in Perl vs. MySQL vs.
+ PostgreSQL etc.
+
+ Revision 1.13 1999/03/29 11:55:43 ivan eliminate warnings in
+ ut_money
+
+ Revision 1.12 1999/01/25 12:26:06 ivan yet more mod_perl
+ stuff
+
+ Revision 1.11 1999/01/18 09:22:38 ivan changes to track
+ email addresses for email invoicing
+
+ Revision 1.10 1998/12/29 11:59:33 ivan mostly properly OO,
+ some work still to be done with svc_ stuff
+
+ Revision 1.9 1998/11/21 07:26:45 ivan "Records identical"
+ carp tells us it is just a warning.
+
+ Revision 1.8 1998/11/15 11:02:04 ivan bugsquash
+
+ Revision 1.7 1998/11/15 10:56:31 ivan qsearch gets sames "IS
+ NULL" semantics as other WHERE clauses
+
+ Revision 1.6 1998/11/15 05:31:03 ivan bugfix for new config
+ layout
+
+ Revision 1.5 1998/11/13 09:56:51 ivan change configuration
+ file layout to support multiple distinct databases (with own
+ set of config files, export, etc.)
+
+ Revision 1.4 1998/11/10 07:45:25 ivan doc clarification
+
+ Revision 1.2 1998/11/07 05:17:18 ivan In sub new, Pg wrapper
+ for money fields from dbdef (FS::Record::fields $table), not
+ keys of supplied hashref.
+
use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
checkeuid checkruid swapuid);
- adminsuidsetup;
+ adminsuidsetup $user;
- $cgi = new CGI::Base;
- $cgi->get;
+ $cgi = new CGI;
$dbh = cgisuidsetup($cgi);
$dbh = dbh;
Provides a hodgepodge of subroutines.
SUBROUTINES
- adminsuidsetup
- Cleans the environment. Make sure the script is running as
- freeside, or setuid freeside. Opens a connection to the
- database. Swaps real and effective UIDs. Returns the DBI
+ adminsuidsetup USER
+ Sets the user to USER (see config.html from the base
+ documentation). Cleans the environment. Make sure the script
+ is running as freeside, or setuid freeside. Opens a
+ connection to the database. Swaps real and effective UIDs.
+ Runs any defined callbacks (see below). Returns the DBI
database handle (usually you don't need this).
+ cgisuidsetup CGI_object
+ Stores the CGI (see the CGI manpage) object for later use.
+ (CGI::Base is depriciated) Runs adminsuidsetup.
+
+ cgi Returns the CGI (see the CGI manpage) object.
+
dbh Returns the DBI database handle.
datasrc
Returns the DBI data source.
getotaker
- Returns the current Freeside user. Currently that means the
- CGI REMOTE_USER, or 'freeside'.
+ Returns the current Freeside user.
+
+ cgisetotaker
+ Sets and returns the CGI REMOTE_USER. $cgi should be defined
+ as a CGI.pm object. Support for CGI::Base and derived
+ classes is depriciated.
checkeuid
Returns true if effective UID is that of the freeside user.
swapuid
Swaps real and effective UIDs.
+ getsecrets [ USER ]
+ Sets the user to USER, if supplied. Sets and returns the DBI
+ datasource, username and password for this user from the
+ `/usr/local/etc/freeside/mapsecrets' file.
+
+CALLBACKS
+ Warning: this interface is likely to change in future releases.
+
+ A package can install a callback to be run in adminsuidsetup by
+ putting a coderef into the hash %FS::UID::callback :
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ $FS::UID::callback{'Package::Name'};
+
+VERSION
+ $Id: UID.txt,v 1.4 1999-04-08 13:39:31 ivan Exp $
+
BUGS
+ Too many package-global variables.
+
Not OO.
No capabilities yet. When mod_perl and Authen::DBI are
implemented, cgisuidsetup will go away as well.
+ Goes through contortions to support non-OO syntax with multiple
+ datasrc's.
+
+ Callbacks are inelegant.
+
SEE ALSO
- the FS::Record manpage, the CGI::Base manpage, the DBI manpage
+ the FS::Record manpage, the CGI manpage, the DBI manpage,
+ config.html from the base documentation.
HISTORY
ivan@voicenet.com 97-jun-4 - 9 untaint otaker ivan@voicenet.com
pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
inlined suidsetup ivan@sisd.com 98-sep-12
+ $Log: UID.txt,v $
+ Revision 1.4 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.8 1999/02/23 07:23:23 ivan oops,
+ don't comment out &swapuid in &adminsuidsetup!
+
+ Revision 1.7 1999/01/18 09:22:40 ivan changes to track email
+ addresses for email invoicing
+
+ Revision 1.6 1998/11/15 05:27:48 ivan bugfix for new
+ configuration layout
+
+ Revision 1.5 1998/11/15 00:51:51 ivan eliminated some warnings
+ on certain fatal errors (well, it is less confusing)
+
+ Revision 1.4 1998/11/13 09:56:52 ivan change configuration file
+ layout to support multiple distinct databases (with own set of
+ config files, export, etc.)
+
+ Revision 1.3 1998/11/08 10:45:42 ivan got sub cgi for FS::CGI
+
+ Revision 1.2 1998/11/08 09:38:43 ivan cgisuidsetup complains if
+ you pass it a isa CGI::Base instead of an isa CGI (first step in
+ migrating from CGI-modules to CGI.pm)
+
SYNOPSIS
use FS::agent;
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
+ $record = new FS::agent \%hash;
+ $record = new FS::agent { 'column' => 'value' };
$error = $record->insert;
prog - For future use.
freq - For future use.
METHODS
- create HASHREF
+ new HASHREF
Creates a new agent. To add the agent to the database, see
the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: agent.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $
+BUGS
SEE ALSO
the FS::Record manpage, the FS::agent_type manpage, the
FS::cust_main manpage, schema.html from the base documentation.
SYNOPSIS
use FS::agent_type;
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
+ $record = new FS::agent_type \%hash;
+ $record = new FS::agent_type { 'column' => 'value' };
$error = $record->insert;
typenum - primary key (assigned automatically for new agent types)
atype - Text name of this agent type
METHODS
- create HASHREF
+ new HASHREF
Creates a new agent type. To add the agent type to the
database, see the section on "insert".
If there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: agent_type.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $
+BUGS
SEE ALSO
the FS::Record manpage, the FS::agent manpage, the FS::type_pkgs
manpage, the FS::cust_main manpage, the FS::part_pkg manpage,
pod, added check in delete ivan@sisd.com 98-sep-21
+ $Log: agent_type.txt,v $
+ Revision 1.3 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.2 1998/12/29 11:59:35 ivan
+ mostly properly OO, some work still to be done with svc_ stuff
+
SYNOPSIS
use FS::cust_bill;
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
+ $record = new FS::cust_bill \%hash;
+ $record = new FS::cust_bill { 'column' => 'value' };
$error = $record->insert;
printed - how many times this invoice has been printed automatically
(see the section on "collect" in the FS::cust_main manpage).
METHODS
- create HASHREF
+ new HASHREF
Creates a new invoice. To add the invoice to the database,
see the section on "insert". Invoices are normally created
by calling the bill method of a customer object (see the
manpage. Also see the Time::Local manpage and the
Date::Parse manpage for conversion functions.
+VERSION
+ $Id: cust_bill.txt,v 1.4 1999-04-08 13:39:31 ivan Exp $
+
BUGS
The delete method.
- It doesn't properly override FS::Record yet.
-
- print_text formatting (and some logic :/) is in source as a
- format declaration, which needs to be slurped in from a file.
- the fork is rather kludgy as well. It could be cleaned with
- swrite from man perlform, and the picture could be put in a
- /var/spool/freeside/conf file. Also number of lines ($=).
+ print_text formatting (and some logic :/) is in source, but
+ needs to be slurped in from a file. Also number of lines ($=).
missing print_ps for a nice postscript copy (maybe HylaFAX-
cover-page-style or something similar so the look can be
completely customized?)
- There is an off-by-one error in print_text which causes a visual
- error: "Page 1 of 2" printed on some single-page invoices?
-
SEE ALSO
the FS::Record manpage, the FS::cust_main manpage, the
FS::cust_pay manpage, the FS::cust_bill_pkg manpage, the
pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
+ $Log: cust_bill.txt,v $
+ Revision 1.4 1999-04-08 13:39:31 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.7 1999/02/09 09:55:05 ivan
+ invoices show line items for each service in a package (see the
+ label method of FS::cust_svc)
+
+ Revision 1.6 1999/01/25 12:26:07 ivan yet more mod_perl stuff
+
+ Revision 1.5 1999/01/18 21:58:03 ivan esthetic: eq and ne were
+ used in a few places instead of == and !=
+
+ Revision 1.4 1998/12/29 11:59:36 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
+ Revision 1.3 1998/11/13 09:56:53 ivan change configuration file
+ layout to support multiple distinct databases (with own set of
+ config files, export, etc.)
+
+ Revision 1.2 1998/11/07 10:24:24 ivan don't use depriciated
+ FS::Bill and FS::Invoice, other miscellania
+
SYNOPSIS
use FS::cust_bill_pkg;
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
+ $record = new FS::cust_bill_pkg \%hash;
+ $record = new FS::cust_bill_pkg { 'column' => 'value' };
$error = $record->insert;
functions.
METHODS
- create HASHREF
+ new HASHREF
Creates a new line item. To add the line item to the
database, see the section on "insert". Line items are
normally created by calling the bill method of a customer
there is an error, returns the error, otherwise returns
false. Called by the insert method.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: cust_bill_pkg.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $
+BUGS
SEE ALSO
the FS::Record manpage, the FS::cust_bill manpage, the
FS::cust_pkg manpage, the FS::cust_main manpage, schema.html
SYNOPSIS
use FS::cust_credit;
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
+ $record = new FS::cust_credit \%hash;
+ $record = new FS::cust_credit { 'column' => 'value' };
$error = $record->insert;
otaker - order taker (assigned automatically, see the FS::UID manpage)
reason - text
METHODS
- create HASHREF
+ new HASHREF
Creates a new credit. To add the credit to the database, see
the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
+VERSION
+ $Id: cust_credit.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+
BUGS
The delete method.
- It doesn't properly override FS::Record yet.
-
SEE ALSO
the FS::Record manpage, the FS::cust_refund manpage, the
FS::cust_bill manpage, schema.html from the base documentation.
pod, otaker from FS::UID ivan@sisd.com 98-sep-21
+ $Log: cust_credit.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.4 1999/01/25 12:26:08 ivan
+ yet more mod_perl stuff
+
+ Revision 1.3 1999/01/18 21:58:04 ivan esthetic: eq and ne were
+ used in a few places instead of == and !=
+
+ Revision 1.2 1998/12/29 11:59:38 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
SYNOPSIS
use FS::cust_main;
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
+ $record = new FS::cust_main \%hash;
+ $record = new FS::cust_main { 'column' => 'value' };
$error = $record->insert;
tax - tax exempt, empty or `Y'
otaker - order taker (assigned automatically, see the FS::UID manpage)
METHODS
- create HASHREF
+ new HASHREF
Creates a new customer. To add the customer to the database,
see the section on "insert".
Returns the balance for this customer (total owed minus
total credited).
-BUGS
- The delete method.
+ invoicing_list [ ARRAYREF ]
+ If an arguement is given, sets these email addresses as
+ invoice recipients (see the FS::cust_main_invoice manpage).
+ Errors are not fatal and are not reported (except as
+ warnings), so use check_invoicing_list first.
+
+ Returns a list of email addresses (with svcnum entries
+ expanded).
+
+ Note: You can clear the invoicing list by passing an empty
+ ARRAYREF. You can check it without disturbing anything by
+ passing nothing.
- It doesn't properly override FS::Record yet.
+ This interface may change in the future.
- hfields should be removed.
+ check_invoicing_list ARRAYREF
+ Checks these arguements as valid input for the
+ invoicing_list method. If there is an error, returns the
+ error, otherwise returns false.
+
+VERSION
+ $Id: cust_main.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $
+
+BUGS
+ The delete method.
Bill and collect options should probably be passed as references
instead of a list.
CyberCash v2 forces us to define some variables in package main.
+ There should probably be a configuration file with a list of
+ allowed credit card types.
+
+ CyberCash is the only processor.
+
+ No multiple currency support (probably a larger project than
+ just this module).
+
SEE ALSO
the FS::Record manpage, the FS::cust_pkg manpage, the
FS::cust_bill manpage, the FS::cust_credit manpage the
FS::cust_pay_batch manpage, the FS::agent manpage, the
FS::part_referral manpage, the FS::cust_main_county manpage, the
- FS::UID manpage, schema.html from the base documentation.
+ FS::cust_main_invoice manpage, the FS::UID manpage, schema.html
+ from the base documentation.
HISTORY
ivan@voicenet.com 97-jul-28
cybercash v3 support, don't need to import
FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
+ $Log: cust_main.txt,v $
+ Revision 1.4 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.16 1999/04/07 14:32:19 ivan
+ more &invoicing_list logic to skip searches when there is no
+ custnum
+
+ Revision 1.15 1999/04/07 13:41:54 ivan in &invoicing_list, don't
+ search if there's no custnum yet
+
+ Revision 1.14 1999/03/29 12:06:15 ivan buglet in email invoices
+ fixed
+
+ Revision 1.13 1999/02/28 20:09:03 ivan allow spaces in zip
+ codes, for (at least) canada. pointed out by Clayton Gray
+ <clgray@bcgroup.net>
+
+ Revision 1.12 1999/02/27 21:24:22 ivan parse paydate correctly
+ for cybercash
+
+ Revision 1.11 1999/02/23 08:09:27 ivan beginnings of one-screen
+ new customer entry and some other miscellania
+
+ Revision 1.10 1999/01/25 12:26:09 ivan yet more mod_perl stuff
+
+ Revision 1.9 1999/01/18 09:22:41 ivan changes to track email
+ addresses for email invoicing
+
+ Revision 1.8 1998/12/29 11:59:39 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
+ Revision 1.7 1998/12/16 09:58:52 ivan library support for
+ editing email invoice destinations (not in sub collect yet)
+
+ Revision 1.6 1998/11/18 09:01:42 ivan i18n! i18n!
+
+ Revision 1.5 1998/11/15 11:23:14 ivan use FS::table_name for all
+ searches to eliminate warnings, emit state/county when they
+ don't match
+
+ Revision 1.4 1998/11/15 05:30:48 ivan bugfix for new config
+ layout
+
+ Revision 1.3 1998/11/13 09:56:54 ivan change configuration file
+ layout to support multiple distinct databases (with own set of
+ config files, export, etc.)
+
+ Revision 1.2 1998/11/07 10:24:25 ivan don't use depriciated
+ FS::Bill and FS::Invoice, other miscellania
+
SYNOPSIS
use FS::cust_main_county;
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
+ $record = new FS::cust_main_county \%hash;
+ $record = new FS::cust_main_county { 'column' => 'value' };
$error = $record->insert;
taxnum - primary key (assigned automatically for new tax rates)
state
county
+ country
tax - percentage
METHODS
- create HASHREF
+ new HASHREF
Creates a new tax rate. To add the tax rate to the database,
see the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
-
- A country field (and possibly a currency field) should be added.
+VERSION
+ $Id: cust_main_county.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
SEE ALSO
the FS::Record manpage, the FS::cust_main manpage, the
FS::cust_bill manpage, schema.html from the base documentation.
pod ivan@sisd.com 98-sep-21
+ $Log: cust_main_county.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1998/12/29 11:59:41
+ ivan mostly properly OO, some work still to be done with svc_
+ stuff
+
+ Revision 1.2 1998/11/18 09:01:43 ivan i18n! i18n!
+
--- /dev/null
+NAME
+ FS::cust_main_invoice - Object methods for cust_main_invoice
+ records
+
+SYNOPSIS
+ use FS::cust_main_invoice;
+
+ $record = new FS::cust_main_invoice \%hash;
+ $record = new FS::cust_main_invoice { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $email_address = $record->address;
+
+DESCRIPTION
+ An FS::cust_main_invoice object represents an invoice
+ destination. FS::cust_main_invoice inherits from FS::Record. The
+ following fields are currently supported:
+
+ destnum - primary key
+ custnum - customer (see the FS::cust_main manpage)
+ dest - Invoice destination: If numeric, a <a href="#svc_acct">svcnum</a>, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
+METHODS
+ new HASHREF
+ Creates a new invoice destination. To add the invoice
+ destination to the database, see the section on "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 *hash* method.
+
+ insert
+ Adds this record to the database. If there is an error,
+ returns the error, otherwise returns false.
+
+ delete
+ Delete this record from the database.
+
+ replace OLD_RECORD
+ Replaces the OLD_RECORD with this one in the database. If
+ there is an error, returns the error, otherwise returns
+ false.
+
+ check
+ Checks all fields to make sure this is a valid invoice
+ destination. If there is an error, returns the error,
+ otherwise returns false. Called by the insert and repalce
+ methods.
+
+ checkdest
+ Checks the dest field only.
+
+ address
+ Returns the literal email address for this record (or
+ `POST').
+
+VERSION
+ $Id: cust_main_invoice.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $
+
+BUGS
+SEE ALSO
+ the FS::Record manpage, the FS::cust_main manpage
+
+HISTORY
+ ivan@voicenet.com 97-jul-1
+
+ added hfields ivan@sisd.com 97-nov-13
+
+ $Log: cust_main_invoice.txt,v $
+ Revision 1.1 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.6 1999/01/25 12:26:10
+ ivan yet more mod_perl stuff
+
+ Revision 1.5 1999/01/18 21:58:05 ivan esthetic: eq and ne were
+ used in a few places instead of == and !=
+
+ Revision 1.4 1999/01/18 09:22:42 ivan changes to track email
+ addresses for email invoicing
+
+ Revision 1.3 1998/12/29 11:59:42 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
+ Revision 1.2 1998/12/16 09:58:53 ivan library support for
+ editing email invoice destinations (not in sub collect yet)
+
+ Revision 1.1 1998/12/16 07:40:02 ivan new table
+
+ Revision 1.3 1998/11/15 04:33:00 ivan updates for newest versoin
+
+ Revision 1.2 1998/11/15 03:48:49 ivan update for current version
+
SYNOPSIS
use FS::cust_pay;
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
+ $record = new FS::cust_pay \%hash;
+ $record = new FS::cust_pay { 'column' => 'value' };
$error = $record->insert;
payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
paybatch - text field for tracking card processing
METHODS
- create HASHREF
+ new HASHREF
Creates a new payment. To add the payment to the databse,
see the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert method.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: cust_pay.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
Delete and replace methods.
SEE ALSO
pod ivan@sisd.com 98-sep-21
+ $Log: cust_pay.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/01/25 12:26:11 ivan yet
+ more mod_perl stuff
+
+ Revision 1.2 1998/12/29 11:59:43 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
--- /dev/null
+NAME
+ FS::cust_pay_batch - Object methods for batch cards
+
+SYNOPSIS
+ use FS::cust_pay_batch;
+
+ $record = new FS::cust_pay_batch \%hash;
+ $record = new FS::cust_pay_batch { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+DESCRIPTION
+ An FS::cust_pay_batch object represents a credit card
+ transaction ready to be batched (sent to a processor).
+ FS::cust_pay_batch inherits from FS::Record. Typically called by
+ the collect method of an FS::cust_main object. The following
+ fields are currently supported:
+
+ trancode - 77 for charges
+ cardnum
+ exp - card expiration
+ amount
+ invnum - invoice
+ custnum - customer
+ payname - name on card
+ first - name
+ last - name
+ address1
+ address2
+ city
+ state
+ zip
+ country
+METHODS
+ new HASHREF
+ Creates a new record. To add the record to the database, see
+ the section on "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 *hash* method.
+
+ insert
+ Adds this record to the database. If there is an error,
+ returns the error, otherwise returns false.
+
+ delete
+ Delete this record from the database. If there is an error,
+ returns the error, otherwise returns false.
+
+ replace OLD_RECORD
+ #inactive # #Replaces the OLD_RECORD with this one in the
+ database. If there is an error, #returns the error,
+ otherwise returns false.
+
+ check
+ Checks all fields to make sure this is a valid transaction.
+ If there is an error, returns the error, otherwise returns
+ false. Called by the insert and repalce methods.
+
+VERSION
+ $Id: cust_pay_batch.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $
+
+BUGS
+ There should probably be a configuration file with a list of
+ allowed credit card types.
+
+SEE ALSO
+ the FS::cust_main manpage, the FS::Record manpage
+
+HISTORY
+ ivan@voicenet.com 97-jul-1
+
+ added hfields ivan@sisd.com 97-nov-13
+
+ $Log: cust_pay_batch.txt,v $
+ Revision 1.1 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1998/12/29 11:59:44
+ ivan mostly properly OO, some work still to be done with svc_
+ stuff
+
+ Revision 1.2 1998/11/18 09:01:44 ivan i18n! i18n!
+
+ Revision 1.1 1998/11/15 05:19:58 ivan long overdue
+
+ Revision 1.3 1998/11/15 04:33:00 ivan updates for newest versoin
+
+ Revision 1.2 1998/11/15 03:48:49 ivan update for current version
+
SYNOPSIS
use FS::cust_pkg;
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
+ $record = new FS::cust_pkg \%hash;
+ $record = new FS::cust_pkg { 'column' => 'value' };
$error = $record->insert;
$error = $record->unsuspend;
+ $part_pkg = $record->part_pkg;
+
+ @labels = $record->labels;
+
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
conversion functions.
METHODS
- create HASHREF
+ new HASHREF
Create a new billing item. To add the item to the database,
see the section on "insert".
If there is an error, returns the error, otherwise returns
false.
+ sub insert { my $self = shift;
+
+ # custnum might not have have been defined in sub check (for one-shot new
+ # customers), so check it here instead
+
+ my $error = $self->ut_number('custnum');
+ return $error if $error
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->SUPER::insert;
+
+ }
+
delete
Currently unimplemented. You don't want to delete billing
items, because there would then be no record the customer
ever purchased the item. Instead, see the cancel method.
- sub delete { return "Can't delete cust_pkg records!"; }
-
replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If
there is an error, returns the error, otherwise returns
Currently, custnum, setup, bill, susp, expire, and cancel
may be changed.
- pkgpart may not be changed, but see the order subroutine.
+ Changing pkgpart may have disasterous effects. See the order
+ subroutine.
setup and bill are normally updated by calling the bill
method of a customer object (see the FS::cust_main manpage).
If there is an error, returns the error, otherwise returns
false.
+ part_pkg
+ Returns the definition for this billing item, as an
+ FS::part_pkg object (see L<FS::part_pkg).
+
+ labels
+ Returns a list of lists, calling the label method for all
+ services (see the FS::cust_svc manpage) of this billing
+ item.
+
SUBROUTINES
order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
CUSTNUM is a customer (see the FS::cust_main manpage)
items. An error is returned if this is not possible (see the
FS::pkg_svc manpage).
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: cust_pkg.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $
+BUGS
sub order is not OO. Perhaps it should be moved to FS::cust_main
and made so?
defines a standard method to pass dates to the recur_prog
expression, it should do so.
+ 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.
+
SEE ALSO
the FS::Record manpage, the FS::cust_main manpage, the
FS::part_pkg manpage, the FS::cust_svc manpage , the FS::pkg_svc
pod ivan@sisd.com 98-sep-21
+ $Log: cust_pkg.txt,v $
+ Revision 1.4 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.9 1999/03/29 01:11:51 ivan use
+ FS::type_pkgs
+
+ Revision 1.8 1999/03/25 13:48:14 ivan allow empty custnum in sub
+ check (but call that an error in sub insert), for one-screen new
+ customer entry
+
+ Revision 1.7 1999/02/09 09:55:06 ivan invoices show line items
+ for each service in a package (see the label method of
+ FS::cust_svc)
+
+ Revision 1.6 1999/01/25 12:26:12 ivan yet more mod_perl stuff
+
+ Revision 1.5 1999/01/18 21:58:07 ivan esthetic: eq and ne were
+ used in a few places instead of == and !=
+
+ Revision 1.4 1998/12/29 11:59:45 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
+ Revision 1.3 1998/11/15 13:01:35 ivan allow pkgpart changing
+ (for per-customer custom pricing). warn about it in doc
+
+ Revision 1.2 1998/11/12 03:42:45 ivan added label method
+
SYNOPSIS
use FS::cust_refund;
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
+ $record = new FS::cust_refund \%hash;
+ $record = new FS::cust_refund { 'column' => 'value' };
$error = $record->insert;
payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
otaker - order taker (assigned automatically, see the FS::UID manpage)
METHODS
- create HASHREF
+ new HASHREF
Creates a new refund. To add the refund to the database, see
the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert method.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: cust_refund.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
Delete and replace methods.
SEE ALSO
pod and finish up ivan@sisd.com 98-sep-21
+ $Log: cust_refund.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/01/25 12:26:13 ivan
+ yet more mod_perl stuff
+
+ Revision 1.2 1998/12/29 11:59:46 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
SYNOPSIS
use FS::cust_svc;
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
+ $record = new FS::cust_svc \%hash
+ $record = new FS::cust_svc { 'column' => 'value' };
$error = $record->insert;
$error = $record->check;
+ ($label, $value) = $record->label;
+
DESCRIPTION
An FS::cust_svc represents a service. FS::cust_svc inherits from
FS::Record. The following fields are currently supported:
pkgnum - Package (see the FS::cust_pkg manpage)
svcpart - Service definition (see the FS::part_svc manpage)
METHODS
- create HASHREF
+ new HASHREF
Creates a new service. To add the refund to the database,
see the section on "insert". Services are normally created
by creating FS::svc_ objects (see the FS::svc_acct manpage,
there is an error, returns the error, otehrwise returns
false. Called by the insert and replace methods.
+ label
+ Returns a list consisting of: - The name of this service
+ (from part_svc) - A meaningful identifier (username, domain,
+ or mail alias) - The table name (i.e. svc_domain) for this
+ service
+
+VERSION
+ $Id: cust_svc.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $
+
BUGS
Behaviour of changing the svcpart of cust_svc records is
undefined and should possibly be prohibited, and pkg_svc records
are not checked.
- pkg_svc records are not checket in general (here).
+ pkg_svc records are not checked in general (here).
+
+ Deleting this record doesn't check or delete the svc_* record
+ associated with this record.
SEE ALSO
the FS::Record manpage, the FS::cust_pkg manpage, the
pod ivan@sisd.com 98-sep-21
+ $Log: cust_svc.txt,v $
+ Revision 1.4 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.5 1998/12/29 11:59:47 ivan
+ mostly properly OO, some work still to be done with svc_ stuff
+
+ Revision 1.4 1998/11/12 07:58:15 ivan added svcdb to label
+
+ Revision 1.3 1998/11/12 03:45:38 ivan use FS::table_name for all
+ tables qsearch()'ed
+
+ Revision 1.2 1998/11/12 03:32:46 ivan added label method
+
line [ $datasrc ]
Returns an SQL column definition.
- If passed a DBI $datasrc specifying the DBD::mysql manpage,
- will use MySQL-specific syntax. Non-standard syntax for
- other engines (if applicable) may also be supported in the
- future.
+ If passed a DBI $datasrc specifying the DBD::mysql manpage
+ or the DBD::Pg manpage, will use engine-specific syntax.
BUGS
SEE ALSO
the FS::dbdef_table manpage, the FS::dbdef manpage, the DBI
manpage
+VERSION
+ $Id: dbdef_column.txt,v 1.5 1999-04-08 13:39:32 ivan Exp $
+
HISTORY
class for dealing with column definitions
mySQL-specific hack for null (what should be default?)
ivan@sisd.com 98-jun-2
+ $Log: dbdef_column.txt,v $
+ Revision 1.5 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1998/10/13 13:04:17 ivan
+ fixed doc to indicate Pg specific syntax too
+
+ Revision 1.2 1998/10/12 23:40:28 ivan added Pg-specific
+ behaviour in sub line
+
FS::dbdef_index manpage, the FS::dbdef_unique manpage, the DBI
manpage
+VERSION
+ $Id: dbdef_table.txt,v 1.5 1999-04-08 13:39:32 ivan Exp $
+
HISTORY
class for dealing with table definitions
pod ivan@sisd.com 98-sep-24
+ $Log: dbdef_table.txt,v $
+ Revision 1.5 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.2 1998/10/14 07:05:06 ivan
+ 1.1.4 release, fix postgresql
+
<li><a href="cust_credit.txt">FS::cust_credit</a>
<li><a href="cust_main.txt">FS::cust_main</a>
<li><a href="cust_main_county.txt">FS::cust_main_county</a>
+<li><a href="cust_main_invoice.txt">FS::cust_main_invoice</a>
<li><a href="cust_pay.txt">FS::cust_pay</a>
+<li><a href="cust_pay_batch.txt">FS::cust_pay_batch</a>
<li><a href="cust_pkg.txt">FS::cust_pkg</a>
<li><a href="cust_refund.txt">FS::cust_refund</a>
<li><a href="cust_svc.txt">FS::cust_svc</a>
<li><a href="part_referral.txt">FS::part_referral</a>
<li><a href="part_svc.txt">FS::part_svc</a>
<li><a href="pkg_svc.txt">FS::pkg_svc</a>
+<li><a href="svc_Common.txt">FS::svc_Common</a>
<li><a href="svc_acct.txt">FS::svc_acct</a>
<li><a href="svc_acct_pop.txt">FS::svc_acct_pop</a>
<li><a href="svc_acct_sm.txt">FS::svc_acct_sm</a>
SYNOPSIS
use FS::part_pkg;
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
+ $record = new FS::part_pkg \%hash
+ $record = new FS::part_pkg { 'column' => 'value' };
+
+ $custom_record = $template_record->clone;
$error = $record->insert;
$error = $record->check;
DESCRIPTION
- An FS::part_pkg represents a billing item definition.
+ An FS::part_pkg object represents a billing item definition.
FS::part_pkg inherits from FS::Record. The following fields are
currently supported:
are not yet defined.
METHODS
- create HASHREF
+ new HASHREF
Creates a new billing item definition. To add the billing
item definition to the database, see the section on
"insert".
+ clone
+ An alternate constructor. Creates a new billing item
+ definition by duplicating an existing definition. A new
+ pkgpart is assigned and `(CUSTOM) ' is prepended to the
+ comment field. To add the billing item definition to the
+ database, see the section on "insert".
+
insert
Adds this billing item definition to the database. If there
is an error, returns the error, otherwise returns false.
otherwise returns false. Called by the insert and replace
methods.
+VERSION
+ $Id: part_pkg.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+
BUGS
It doesn't properly override FS::Record yet.
pod ivan@sisd.com 98-sep-21
+ $Log: part_pkg.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.5 1998/12/31 01:04:16 ivan doc
+
+ Revision 1.3 1998/11/15 13:00:15 ivan bugfix in clone method,
+ clone method doc clarification
+
SYNOPSIS
use FS::part_referral;
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };
$error = $record->insert;
refnum - primary key (assigned automatically for new referrals)
referral - Text name of this referral
METHODS
- create HASHREF
+ new HASHREF
Creates a new referral. To add the referral to the database,
see the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: part_referral.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
The delete method is unimplemented.
SEE ALSO
pod ivan@sisd.com 98-sep-21
+ $Log: part_referral.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.2 1998/12/29 11:59:49 ivan
+ mostly properly OO, some work still to be done with svc_ stuff
+
SYNOPSIS
use FS::part_svc;
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };
$error = $record->insert;
*svcdb*__*field* - Default or fixed value for *field* in *svcdb*.
*svcdb*__*field*_flag - defines *svcdb*__*field* action: null, `D' for default, or `F' for fixed
METHODS
- create HASHREF
+ new HASHREF
Creates a new service definition. To add the service
definition to the database, see the section on "insert".
otherwise returns false. Called by the insert and replace
methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: part_svc.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
Delete is unimplemented.
+ The list of svc_* tables is hardcoded. When svc_acct_pop is
+ renamed, this should be fixed.
+
SEE ALSO
the FS::Record manpage, the FS::part_pkg manpage, the
FS::pkg_svc manpage, the FS::cust_svc manpage, the FS::svc_acct
pod ivan@sisd.com 98-sep-21
+ $Log: part_svc.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/02/07 09:59:44 ivan more
+ mod_perl fixes, and bugfixes Peter Wemm sent via email
+
+ Revision 1.2 1998/12/29 11:59:50 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
SYNOPSIS
use FS::pkg_svc;
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
+ $record = new FS::pkg_svc \%hash;
+ $record = new FS::pkg_svc { 'column' => 'value' };
$error = $record->insert;
quantity - Quantity of this service definition that this billing item
definition includes
METHODS
- create HASHREF
+ new HASHREF
Create a new record. To add the record to the database, see
the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: pkg_svc.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
SEE ALSO
the FS::Record manpage, the FS::part_pkg manpage, the
FS::part_svc manpage, schema.html from the base documentation.
pod ivan@sisd.com 98-sep-22
+ $Log: pkg_svc.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/01/18 21:58:08 ivan
+ esthetic: eq and ne were used in a few places instead of == and
+ !=
+
+ Revision 1.2 1998/12/29 11:59:51 ivan mostly properly OO, some
+ work still to be done with svc_ stuff
+
--- /dev/null
+NAME
+ FS::svc_Common - Object method for all svc_ records
+
+SYNOPSIS
+ use FS::svc_Common;
+
+ @ISA = qw( FS::svc_Common );
+
+DESCRIPTION
+ FS::svc_Common is intended as a base class for table-specific
+ classes to inherit from, i.e. FS::svc_acct. FS::svc_Common
+ inherits from FS::Record.
+
+METHODS
+ 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 the
+ FS::cust_svc manpage) should be defined. An FS::cust_svc
+ record will be created and inserted.
+
+ delete
+ Deletes this account 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.
+
+ setfixed
+ Sets any fixed fields for this service (see the FS::part_svc
+ manpage). If there is an error, returns the error, otherwise
+ returns the FS::part_svc object (use ref() to test the
+ return). Usually called by the check method.
+
+ setdefault
+ Sets all fields to their defaults (see the FS::part_svc
+ manpage), overriding their current values. If there is an
+ error, returns the error, otherwise returns the FS::part_svc
+ object (use ref() to test the return).
+
+ suspend
+ unsuspend
+ cancel
+ Stubs - return false (no error) so derived classes don't
+ need to define these methods. Called by the cancel method of
+ FS::cust_pkg (see the FS::cust_pkg manpage).
+
+VERSION
+ $Id: svc_Common.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $
+
+BUGS
+ The setfixed method return value.
+
+ The new method should set defaults from part_svc (like the check
+ method sets fixed values)?
+
+SEE ALSO
+ the FS::Record manpage, the FS::cust_svc manpage, the
+ FS::part_svc manpage, the FS::cust_pkg manpage, schema.html from
+ the base documentation.
+
+HISTORY
+ $Log: svc_Common.txt,v $
+ Revision 1.1 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.3 1999/03/25 13:31:29 ivan
+ added setdefault method (generalized setfixed method to setx
+ method)
+
+ Revision 1.2 1999/01/25 12:26:14 ivan yet more mod_perl stuff
+
+ Revision 1.1 1998/12/30 00:30:45 ivan svc_ stuff is more
+ properly OO - has a common superclass FS::svc_Common
+
SYNOPSIS
use FS::svc_acct;
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
+ $record = new FS::svc_acct \%hash;
+ $record = new FS::svc_acct { 'column' => 'value' };
$error = $record->insert;
DESCRIPTION
An FS::svc_acct object represents an account. FS::svc_acct
- inherits from FS::Record. The following fields are currently
+ inherits from FS::svc_Common. The following fields are currently
supported:
svcnum - primary key (assigned automatcially for new accounts)
slipip - IP address
radius_*Radius_Attribute* - *Radius-Attribute*
METHODS
- create HASHREF
+ new HASHREF
Creates a new account. To add the account to the database,
see the section on "insert".
Sets any fixed values; see the FS::part_svc manpage.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: svc_acct.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $
+BUGS
The remote commands should be configurable.
- The create method should set defaults from part_svc (like the
- check method sets fixed values).
+ The bits which ssh should fork before doing so.
+
+ The $recref stuff in sub check should be cleaned up.
SEE ALSO
- the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
- manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
- FS::SSH manpage, the ssh manpage, the FS::svc_acct_pop manpage,
- schema.html from the base documentation.
+ the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf
+ manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the
+ FS::cust_pkg manpage, the FS::SSH manpage, the ssh manpage, the
+ FS::svc_acct_pop manpage, schema.html from the base
+ documentation.
HISTORY
ivan@voicenet.com 97-jul-16 - 21
pod and FS::conf ivan@sisd.com 98-sep-22
+ $Log: svc_acct.txt,v $
+ Revision 1.4 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.7 1999/04/07 14:37:37 ivan use
+ FS::part_svc and FS::svc_acct_pop to avoid warnings
+
+ Revision 1.6 1999/01/25 12:26:15 ivan yet more mod_perl stuff
+
+ Revision 1.5 1999/01/18 21:58:09 ivan esthetic: eq and ne were
+ used in a few places instead of == and !=
+
+ Revision 1.4 1998/12/30 00:30:45 ivan svc_ stuff is more
+ properly OO - has a common superclass FS::svc_Common
+
+ Revision 1.2 1998/11/13 09:56:55 ivan change configuration file
+ layout to support multiple distinct databases (with own set of
+ config files, export, etc.)
+
SYNOPSIS
use FS::svc_acct_pop;
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
+ $record = new FS::svc_acct_pop \%hash;
+ $record = new FS::svc_acct_pop { 'column' => 'value' };
$error = $record->insert;
ac - area code
exch - exchange
METHODS
- create HASHREF
+ new HASHREF
Creates a new point of presence (if only it were that
easy!). To add the point of presence to the database, see
the section on "insert".
insert
- Adds this point of presence to the databaes. If there is an
+ Adds this point of presence to the database. If there is an
error, returns the error, otherwise returns false.
delete
- Currently unimplemented.
+ Removes this point of presence from the database.
replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there
presence. If there is an error, returns the error, otherwise
returns false. Called by the insert and replace methods.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: svc_acct_pop.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
It should be renamed to part_pop.
SEE ALSO
pod ivan@sisd.com 98-sep-23
+ $Log: svc_acct_pop.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.2 1998/12/29 11:59:53 ivan
+ mostly properly OO, some work still to be done with svc_ stuff
+
SYNOPSIS
use FS::svc_acct_sm;
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
+ $record = new FS::svc_acct_sm \%hash;
+ $record = new FS::svc_acct_sm { 'column' => 'value' };
$error = $record->insert;
domuid - uid of the target account (see the FS::svc_acct manpage)
domuser - virtual username
METHODS
- create HASHREF
+ new HASHREF
Creates a new virtual mail alias. To add the virtual mail
alias to the database, see the section on "insert".
Sets any fixed values; see the FS::part_svc manpage.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: svc_acct_sm.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+BUGS
The remote commands should be configurable.
+ The $recref stuff in sub check should be cleaned up.
+
SEE ALSO
the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
SYNOPSIS
use FS::svc_domain;
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
+ $record = new FS::svc_domain \%hash;
+ $record = new FS::svc_domain { 'column' => 'value' };
$error = $record->insert;
DESCRIPTION
An FS::svc_domain object represents a domain. FS::svc_domain
- inherits from FS::Record. The following fields are currently
+ inherits from FS::svc_Common. The following fields are currently
supported:
svcnum - primary key (assigned automatically for new accounts)
domain
METHODS
- create HASHREF
+ new HASHREF
Creates a new domain. To add the domain to the database, see
the section on "insert".
A registration or transfer email will be submitted unless
$FS::svc_domain::whois_hack is true.
+ The additional field *email* can be used to manually set the
+ admin contact email address on this email. Otherwise, the
+ svc_acct records for this package (see the FS::cust_pkg
+ manpage) are searched. If there is exactly one svc_acct
+ record in the same package, it is automatically used.
+ Otherwise an error is returned.
+
delete
Deletes this domain from the database. If there is an error,
returns the error, otherwise returns false.
submit_internic
Submits a registration email for this domain.
-BUGS
- It doesn't properly override FS::Record yet.
+VERSION
+ $Id: svc_domain.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $
+BUGS
All BIND/DNS fields should be included (and exported).
- All registries should be supported.
+ Delete doesn't send a registration template.
- Not all configuration access is through FS::Conf!
+ All registries should be supported.
Should change action to a real field.
+ The $recref stuff in sub check should be cleaned up.
+
SEE ALSO
- the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
- manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
- FS::SSH manpage, the ssh manpage, the dot-qmail manpage,
- schema.html from the base documentation, config.html from the
- base documentation.
+ the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf
+ manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the
+ FS::cust_pkg manpage, the FS::SSH manpage, the ssh manpage, the
+ dot-qmail manpage, schema.html from the base documentation,
+ config.html from the base documentation.
HISTORY
ivan@voicenet.com 97-jul-21
pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
+ $Log: svc_domain.txt,v $
+ Revision 1.4 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.7 1999/04/07 14:40:15 ivan
+ use all stuff that's qsearch'ed to avoid warnings
+
+ Revision 1.6 1999/01/25 12:26:17 ivan yet more mod_perl stuff
+
+ Revision 1.5 1998/12/30 00:30:47 ivan svc_ stuff is more
+ properly OO - has a common superclass FS::svc_Common
+
+ Revision 1.3 1998/11/13 09:56:57 ivan change configuration file
+ layout to support multiple distinct databases (with own set of
+ config files, export, etc.)
+
+ Revision 1.2 1998/10/14 08:18:21 ivan More informative error
+ messages and better doc for admin contact email stuff
+
SYNOPSIS
use FS::type_pkgs;
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
+ $record = new FS::type_pkgs \%hash;
+ $record = new FS::type_pkgs { 'column' => 'value' };
$error = $record->insert;
typenum - Agent type, see the FS::agent_type manpage
pkgpart - Billing item definition, see the FS::part_pkg manpage
METHODS
- create HASHREF
+ new HASHREF
Create a new record. To add the record to the database, see
the section on "insert".
there is an error, returns the error, otherwise returns
false. Called by the insert and replace methods.
+VERSION
+ $Id: type_pkgs.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $
+
+BUGS
+SEE ALSO
+ the FS::Record manpage, the FS::agent_type manpage, the
+ FS::part_pkgs manpage, schema.html from the base documentation.
+
HISTORY
Defines the relation between agent types and pkgparts (Which
pkgparts can the different [types of] agents sell?)
change to ut_ FS::Record, fixed bugs ivan@sisd.com 97-dec-10
+ $Log: type_pkgs.txt,v $
+ Revision 1.3 1999-04-08 13:39:32 ivan
+ convert from pod for 1.2.0 release
+ Revision 1.2 1998/12/29 11:59:58 ivan
+ mostly properly OO, some work still to be done with svc_ stuff
+
--- /dev/null
+<head>
+ <title>PostgreSQL notes</title>
+</head>
+<body>
+ <h1>PostgreSQL notes</h1>
+<p>
+PostgreSQL ships by default with a maximum of 31 character column names. If
+you use arbitrary RADIUS attributes longer than 9 characters, fs-setup will
+fail with `duplicate column' errors (in the part_svc table).
+Solution: use a different database
+engine, or recompile PostgreSQL with 64 character column names.
+</p>
+Future versions of Freeside will keep all column names under 31 characters to
+avoid this problem.
+</p>
+<p>
+( I've personally been unable to get PostgreSQL working with larger column names,
+though the process does look like it should be straightforward. If anyone is
+interested in assisting me with this, please get in touch.
+ -Ivan <a href="mailto:ivan@sisd.com"><ivan@sisd.com</a>> )
+</p>
+</body>
+
<li>custnum - primary key
<li>agentnum - <a href="#agent">agent</a>
<li>refnum - <a href="#part_referral">referral</a>
+ <li>titlenum - <a href="#part_title">title</a>
<li>first - name
+ <li>middle - name
<li>last - name
<li>ss - social security number
<li>company
<li>tax - tax exempt, Y or null
<li>otaker - order taker
</ul>
+ <li><a name="cust_main_invoice">cust_main_invoice</a> - Invoice destinations for email invoices
+ <ul>
+ <li>destnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>dest - Invoice destination: If numeric, a <a href="#svc_acct">svcnum</a>, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
+ </ul>
<li><a name="cust_main_county">cust_main_county</a> - Tax rates
<ul>
<li>taxnum - primary key
<li>state
<li>county
+ <li>country
<li>tax - % rate
</ul>
<li><a name="cust_pay">cust_pay</a> - Payments
<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
</ul>
+ <li><a name="part_title">part_title</a> - Personal titles
+ <ul>
+ <li>titlenum - primary key
+ <li>title - personal title (`Dr.' or `Mr.')
+ </ul>
<li><a name="pkg_svc">pkg_svc</a>
<ul>
<li>pkgpart - <a href="#part_pkg">Package definition</a>
<h1>Troubleshooting</h1>
<ul>
<li>When troubleshooting the web interface, helpful information is often in your web server's error log.
- <li>Internet Explorer will not work with Freeside's HTML interface.
+ <li>Internet Explorer will not work with Freeside's HTML interface. <b>This may be fixed in >1.2, please report your experiences!</b>
<a HREF="http://www.netscape.com">Netscape</a>,
<a HREF="http://lynx.browser.org">Lynx</a>, and
<a HREF="http://www.cs.indiana.edu/elisp/w3/docs.html">Emacs/W3</a>,
at /usr/lib/perl5/site_perl/File/CounterFile.pm line 132.
</pre>
This clutters up your log files but is otherwise harmless. Upgrade to the latest File::CounterFile.
- <li>If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log:
+ <li><b>(No longer applicable in >1.2!)</b> If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log:
<pre>
access to <i>/your/path</i>/edit/process/<i>some_table</i>.cgi failed for
<i>machine.domain.tld</i>, reason: malformed header from script.
BEGIN failed--compilation aborted at
<i>/your/path</i>/edit/process/part_svc.cgi line 15.
</pre>
- Then the scripts are not running setuid freeside. If you were editing
-the files, it is possible you inadvertantly removed the setuid bit.
-As mentioned in the <a href="install.html">New Installation</a> section of the documentation, set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
-<pre>cd /usr/local/apache/htdocs/freeside
-chown -R freeside .
-chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ Then the scripts are not running as the freeside freeside user. See
+the <a href="install.html">New Installation</a> section of the documentation.
+ <li>If you receive `can not connect to server' errors using MySQL on a system that doesn't support native threading, you may need to specify the full hostname in your DBI datasource. See the <a href="http://www.mysql.com/Manual_chapter/manual_Problems.html#Can_not_connect_to_server">MySQL documentation</a>, DBI manpage and the DBD::mysql manpage for details.
</ul>
</body>
<head>
- <title>Upgrading to 1.1.3</title>
+ <title>Upgrading to 1.1.4</title>
</head>
<body>
-<h1>Upgrading to 1.1.3 from 1.1.x</h1>
+<h1>Upgrading to 1.1.4 from 1.1.x</h1>
<ul>
<li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
<li>Back up your data and current Freeside installation.
--- /dev/null
+<head>
+ <title>Upgrading to 1.2.x</title>
+</head>
+<body>
+<h1>Upgrading to 1.1.x 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>Back up your data and current Freeside installation.
+ <li>Install the Perl module <a href="http://www.perl.com/CPAN/modules/by-module/String/">String-Approx</a>
+ <li><a href="config.html">Configuration file</a> location has changed!
+ <li>Move /var/spool/freeside/dbdef.<i>datasrc</i> to /usr/local/etc/freeside/dbdef.<i>datasrc</i>.
+ <li>Move /var/spool/freeside/counters to /usr/local/etc/freeside/counters.<i>datasrc</i>.
+ <li>Move /var/spool/freeside/export to /usr/local/etc/freeside/export.<i>datasrc</i>.
+ <li>Apply the following changes to your database:
+<pre>
+<!-- ALTER TABLE cust_main ADD middle varchar(80) NULL;
+ALTER TABLE cust_main ADD titlenum int NULL;
+-->ALTER TABLE cust_main CHANGE state state varchar(80) NULL;
+ALTER TABLE cust_main_county CHANGE state state varchar(80) NULL;
+ALTER TABLE cust_main_county ADD country char(2);
+ALTER TABLE cust_main CHANGE paydate paydate varchar(10);
+UPDATE cust_main SET country = "US" where country IS NULL OR country = '';
+UPDATE cust_main_county SET country = "US" where country IS NULL OR country = "";
+<!--CREATE TABLE part_title (
+ titlenum int NOT NULL,
+ title varchar(80) NOT NULL,
+ PRIMARY KEY (titlenum)
+);
+-->CREATE TABLE cust_main_invoice (
+ destnum int NOT NULL,
+ custnum int NOT NULL,
+ dest varchar(80) NOT NULL,
+ PRIMARY KEY (destnum),
+ INDEX ( custnum )
+);
+</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.
+ <li>Copy or symlink htdocs and site_perl to the new copies.
+</body>
#!/usr/bin/perl -Tw
#
-# agent.cgi: Add/Edit agent (output form)
+# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $
#
# ivan@sisd.com 97-dec-12
#
# bmccane@maxbaud.net 98-apr-3
#
# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: agent.cgi,v $
+# Revision 1.7 1999-04-07 11:27:50 ivan
+# avoid perl's silly arguement not numeric error
+#
+# Revision 1.6 1999/01/25 12:09:50 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:31 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:21 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:16:57 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/23 07:52:08 ivan
+# *** empty log message ***
+#
use strict;
-use CGI::Base;
+use vars qw ( $cgi $agent $action $hashref $p $agent_type );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl);
+use FS::Record qw(qsearch qsearchs fields);
use FS::agent;
-use FS::CGI qw(header menubar);
+use FS::agent_type;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-my($agent,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent=qsearchs('agent',{'agentnum'=>$1});
- $action='Edit';
+if ( $cgi->param('error') ) {
+ $agent = new FS::agent ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $agent = qsearchs( 'agent', { 'agentnum' => $1 } );
} else { #adding
- $agent=create FS::agent {};
- $action='Add';
+ $agent = new FS::agent {};
}
-my($hashref)=$agent->hashref;
+$action = $agent->agentnum ? 'Edit' : 'Add';
+$hashref = $agent->hashref;
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("$action Agent", menubar(
+ 'Main Menu' => $p,
+ 'View all agents' => $p. 'browse/agent.cgi',
+));
-print header("$action Agent", menubar(
- 'Main Menu' => '../',
- 'View all agents' => '../browse/agent.cgi',
-)), '<FORM ACTION="process/agent.cgi" METHOD=POST>';
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
+print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
"Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
print <<END;
Agent type <SELECT NAME="typenum" SIZE=1>
END
-my($agent_type);
foreach $agent_type (qsearch('agent_type',{})) {
- print "<OPTION";
+ print "<OPTION VALUE=". $agent_type->typenum;
print " SELECTED"
- if $hashref->{typenum} == $agent_type->getfield('typenum');
+ if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum );
print ">", $agent_type->getfield('typenum'), ": ",
$agent_type->getfield('atype'),"\n";
}
#!/usr/bin/perl -Tw
#
+# $Id: agent_type.cgi,v 1.11 1999-04-07 11:19:21 ivan Exp $
+#
# agent_type.cgi: Add/Edit agent type (output form)
#
# ivan@sisd.com 97-dec-10
# bmccane@maxbaud.net 98-apr-3
#
# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.11 1999-04-07 11:19:21 ivan
+# silly HTML typo
+#
+# Revision 1.10 1999/01/25 12:09:51 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.9 1999/01/19 05:13:32 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.8 1999/01/18 09:41:22 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.7 1999/01/18 09:22:29 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.6 1998/12/17 06:16:58 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.5 1998/11/21 07:58:27 ivan
+# package names link to them
+#
+# Revision 1.4 1998/11/21 07:45:19 ivan
+# visual, use FS::table_name when doing qsearch('table_name')
+#
+# Revision 1.3 1998/11/15 11:20:12 ivan
+# s/CGI-Base/CGI.pm/ causes s/QUERY_STRING/keywords/;
+#
+# Revision 1.2 1998/11/13 09:56:46 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $agent_type $action $hashref $p $part_pkg );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearch qsearchs fields);
use FS::agent_type;
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl);
+use FS::agent_type;
+use FS::part_pkg;
+use FS::type_pkgs;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-my($agent_type,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
+if ( $cgi->param('error') ) {
+ $agent_type = new FS::agent_type ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my( $query ) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
$agent_type=qsearchs('agent_type',{'typenum'=>$1});
- $action='Edit';
} else { #adding
- $agent_type=create FS::agent_type {};
- $action='Add';
+ $agent_type = new FS::agent_type {};
}
-my($hashref)=$agent_type->hashref;
+$action = $agent_type->typenum ? 'Edit' : 'Add';
+$hashref = $agent_type->hashref;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("$action Agent Type", menubar(
+ 'Main Menu' => "$p",
+ 'View all agent types' => "${p}browse/agent_type.cgi",
+));
-print header("$action Agent Type", menubar(
- 'Main Menu' => '../',
- 'View all agent types' => '../browse/agent_type.cgi',
-)), '<FORM ACTION="process/agent_type.cgi" METHOD=POST>';
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
+print '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
"Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
print <<END;
-<BR>Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
-<P>Select which packages agents of this type may sell to customers</P>
+<BR><BR>Agent Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
+<BR><BR>Select which packages agents of this type may sell to customers<BR>
END
-my($part_pkg);
foreach $part_pkg ( qsearch('part_pkg',{}) ) {
print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
$part_pkg->getfield('pkgpart'), qq!" !,
})
? 'CHECKED '
: '',
- qq!"VALUE="ON"> !,$part_pkg->getfield('pkg')
+ qq!VALUE="ON"> !,
+ qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart,
+ '">', $part_pkg->getfield('pkg'), '</A>',
;
}
#!/usr/bin/perl -Tw
#
-# cust_credit.cgi: Add a credit (output form)
+# $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $
#
# Usage: cust_credit.cgi custnum [ -paybatch ]
# http://server.name/path/cust_credit?custnum [ -paybatch ]
#
-# Note: Should be run setuid root as user nobody.
-#
# some hooks in here for modifications as well as additions, but needs (lots) more work.
# also see process/cust_credit.cgi, the script that processes the form.
#
# ivan@voicenet.com 97-apr-21
#
# rewrite ivan@sisd.com 98-mar-16
+#
+# $Log: cust_credit.cgi,v $
+# Revision 1.7 1999-02-28 00:03:33 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:09:52 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:33 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:23 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/23 02:26:06 ivan
+# *** empty log message ***
+#
+# Revision 1.2 1998/12/17 06:16:59 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
+use vars qw( $cgi $query $custnum $otaker $p1 $crednum $_date $amount $reason );
use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); #CGI module
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(header popurl);
+use FS::Record qw(fields);
+#use FS::cust_credit;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-#untaint otaker
-my($otaker)=getotaker;
-
-SendHeaders(); # one guess.
+if ( $cgi->param('error') ) {
+ #$cust_credit = new FS::cust_credit ( {
+ # map { $_, scalar($cgi->param($_)) } fields('cust_credit')
+ #} );
+ $custnum = $cgi->param('custnum');
+ $amount = $cgi->param('amount');
+ #$refund = $cgi->param('refund');
+ $reason = $cgi->param('reason');
+} else {
+ ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum = $1;
+ $amount = '';
+ #$refund = 'yes';
+ $reason = '';
+}
+$_date = time;
+
+$otaker = getotaker;
+
+$p1 = popurl(1);
+
+print $cgi->header( '-expires' => 'now' ), header("Post Credit", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
print <<END;
-<HTML>
- <HEAD>
- <TITLE>Post Credit</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Post Credit</H1>
- </CENTER>
- <FORM ACTION="process/cust_credit.cgi" METHOD=POST>
- <HR><PRE>
+ <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST>
+ <PRE>
END
-#crednum
-my($crednum)="";
+$crednum = "";
print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!;
-#custnum
print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
-#paybatch
print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
-#date
-my($date)=time;
-print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
+print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!;
-#amount
-my($amount)='';
print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
+print qq!<INPUT TYPE="hidden" NAME="credited" VALUE="">!;
-#refund?
-#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!;
+#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!;
-#otaker (hidden)
print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!;
-#reason
-my($reason)='';
print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!;
print <<END;
#!/usr/bin/perl -Tw
#
-# cust_main.cgi: Edit a customer (output form)
+# $Id: cust_main.cgi,v 1.14 1999-04-14 07:47:53 ivan Exp $
#
# Usage: cust_main.cgi custnum
# http://server.name/path/cust_main.cgi?custnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 96-nov-29 -> 96-dec-04
#
# Blank custnum for new customer.
# bmccane@maxbaud.net 98-apr-3
#
# fixed one missed day->daytime ivan@sisd.com 98-jul-13
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.14 1999-04-14 07:47:53 ivan
+# i18n fixes
+#
+# Revision 1.13 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.12 1999/04/06 11:16:16 ivan
+# give a meaningful error message if you try to create a customer before you've
+# created an agent
+#
+# Revision 1.11 1999/03/25 13:55:10 ivan
+# one-screen new customer entry (including package and service) for simple
+# packages with one svc_acct service
+#
+# Revision 1.10 1999/02/28 00:03:34 ivan
+# removed misleading comments
+#
+# Revision 1.9 1999/02/23 08:09:20 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.8 1999/01/25 12:09:53 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.7 1999/01/19 05:13:34 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:24 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1999/01/18 09:22:30 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.4 1998/12/23 08:08:15 ivan
+# fix typo
+#
+# Revision 1.3 1998/12/17 06:17:00 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $custnum $action $cust_main $p1 @agents $agentnum
+ $last $first $ss $company $address1 $address2 $city $zip
+ $daytime $night $fax @invoicing_list $invoicing_list $payinfo
+ $payname %payby %paybychecked $refnum $otaker $r );
+use vars qw ( $conf $pkgpart $username $password $popnum $ulen $ulen2 );
+use CGI::Switch;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
+#use FS::Record qw(qsearch qsearchs fields);
+use FS::Record qw(qsearch qsearchs fields dbdef);
+use FS::CGI qw(header popurl itable table);
use FS::cust_main;
+use FS::agent;
+use FS::part_referral;
+use FS::cust_main_county;
-my($cgi) = new CGI::Base;
-$cgi->get;
+ #for misplaced logic below
+ use FS::pkg_svc;
+ use FS::part_svc;
+ use FS::part_pkg;
-cgisuidsetup($cgi);
+ #for false laziness below
+ use FS::svc_acct_pop;
-SendHeaders(); # one guess.
+ #for (other) false laziness below
+ use FS::agent;
+ use FS::type_pkgs;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
#get record
-my($custnum,$action,$cust_main);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
+
+if ( $cgi->param('error') ) {
+ $cust_main = new FS::cust_main ( {
+ map { $_, scalar($cgi->param($_)) } fields('cust_main')
+ } );
+ $custnum = $cust_main->custnum;
+ $pkgpart = $cgi->param('pkgpart_svcpart') || '';
+ if ( $pkgpart =~ /^(\d+)_/ ) {
+ $pkgpart = $1;
+ } else {
+ $pkgpart = '';
+ }
+ $username = $cgi->param('username');
+ $password = $cgi->param('_password');
+ $popnum = $cgi->param('popnum');
+} elsif ( $cgi->keywords ) { #editing
+ my( $query ) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
$custnum=$1;
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
- $action='Edit';
+ $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
+ $pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
} else {
$custnum='';
- $cust_main = create FS::cust_main ( {} );
+ $cust_main = new FS::cust_main ( {} );
$cust_main->setfield('otaker',&getotaker);
- $cust_main->setfield('country','US');
- $action='Add';
+ $pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
}
-
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Customer $action</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer $action</H1>
- </CENTER>
- <FORM ACTION="process/cust_main.cgi" METHOD=POST>
- <PRE>
-END
-
-print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
- qq!Customer #<FONT SIZE="+1"><B>!;
-print $custnum ? $custnum : " (NEW)" , "</B></FONT>";
-
-#agentnum
-my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default
-my(@agents) = qsearch('agent',{});
-print qq!\n\nAgent # <SELECT NAME="agentnum" SIZE="1">!;
-my($agent);
-foreach $agent (sort {
- $a->agent cmp $b->agent;
-} @agents) {
- print "<OPTION" . " SELECTED"x($agent->agentnum==$agentnum),
- ">", $agent->agentnum,": ", $agent->agent, "\n";
+$action = $custnum ? 'Edit' : 'Add';
+
+# top
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Customer $action", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST>!,
+ qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
+ qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ),
+
+;
+
+# agent
+
+$r = qq!<font color="#ff0000">*</font>!;
+
+@agents = qsearch( 'agent', {} );
+die "No agents created!" unless @agents;
+$agentnum = $cust_main->agentnum || $agents[0]->agentnum; #default to first
+if ( scalar(@agents) == 1 ) {
+ print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$agentnum">!;
+} else {
+ print qq!<BR><BR>${r}Agent <SELECT NAME="agentnum" SIZE="1">!;
+ my $agent;
+ foreach $agent (sort {
+ $a->agent cmp $b->agent;
+ } @agents) {
+ print '<OPTION VALUE="', $agent->agentnum, '"',
+ " SELECTED"x($agent->agentnum==$agentnum),
+ ">", $agent->agentnum,": ", $agent->agent;
+ }
+ print "</SELECT>";
}
-print "</SELECT>";
#referral
-#unless ($custnum) {
- my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error
+
+$refnum = $cust_main->refnum || 0;
+if ( $custnum ) {
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+} else {
my(@referrals) = qsearch('part_referral',{});
- print qq!\nReferral <SELECT NAME="refnum" SIZE="1">!;
- print "<OPTION> \n";
- my($referral);
- foreach $referral (sort {
- $a->refnum <=> $b->refnum;
- } @referrals) {
- print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
- ">", $referral->refnum, ": ", $referral->referral,"\n";
+ if ( scalar(@referrals) == 1 ) {
+ $refnum ||= $referrals[0]->refnum;
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+ } else {
+ print qq!<BR><BR>${r}Referral <SELECT NAME="refnum" SIZE="1">!;
+ print "<OPTION> ";
+ my($referral);
+ foreach $referral (sort {
+ $a->refnum <=> $b->refnum;
+ } @referrals) {
+ print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
+ ">", $referral->refnum, ": ", $referral->referral;
+ }
+ print "</SELECT>";
}
- print "</SELECT>";
-#}
+}
-my($last,$first,$ss,$company,$address1,$address2,$city)=(
+
+# contact info
+
+($last,$first,$ss,$company,$address1,$address2,$city,$zip)=(
$cust_main->last,
$cust_main->first,
$cust_main->ss,
$cust_main->address1,
$cust_main->address2,
$cust_main->city,
+ $cust_main->zip,
);
-print <<END;
-
-
-Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11>
-Company <INPUT TYPE="text" NAME="company" VALUE="$company">
-Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40>
- <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40>
-City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1">
+print "<BR><BR>Contact information", &itable("#c0c0c0"), <<END;
+<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3><INPUT TYPE="text" NAME="last" VALUE="$last">, <INPUT TYPE="text" NAME="first" VALUE="$first"></TD><TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD></TR>
+<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR>
+<TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1">
END
+$cust_main->country('US') unless $cust_main->country; #eww
foreach ( qsearch('cust_main_county',{}) ) {
print "<OPTION";
print " SELECTED" if ( $cust_main->state eq $_->state
- && $cust_main->county eq $_->county );
+ && $cust_main->county eq $_->county
+ && $cust_main->country eq $_->country
+ );
print ">",$_->state;
print " (",$_->county,")" if $_->county;
+ print " / ", $_->country;
}
-print "</SELECT>";
+print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!;
-my($zip,$country,$daytime,$night,$fax)=(
- $cust_main->zip,
- $cust_main->country,
+($daytime,$night,$fax)=(
$cust_main->daytime,
$cust_main->night,
$cust_main->fax,
);
print <<END;
- Zip <INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10 MAXLENGTH=10>
-Country: <FONT SIZE="+1"><B>$country</B></FONT><INPUT TYPE="hidden" NAME="country" VALUE="$country">
+<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR>
+END
-Phone (daytime)<INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18 MAXLENGTH=20> (night)<INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18 MAXLENGTH=20> (fax)<INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12 MAXLENGTH=12>
+print "</TABLE>$r required fields<BR>";
-END
+# billing info
-my(%payby)=(
- 'CARD' => "Credit card ",
- 'BILL' => "Billing ",
- 'COMP' => "Complimentary",
-);
-for (qw(CARD BILL COMP)) {
- print qq!<INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
- print qq! CHECKED! if ($cust_main->payby eq "$_");
- print qq!>$payby{$_}!;
-}
+sub expselect {
+ my $prefix = shift;
+ my $date = shift || '';
+ my( $m, $y ) = ( 0, 0 );
+ if ( $date =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #PostgreSQL date format
+ ( $m, $y ) = ( $2, $1 );
+ } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
+ ( $m, $y ) = ( $1, $3 );
+ }
+ my $return = qq!<SELECT NAME="$prefix!. qq!_month" SIZE="1">!;
+ for ( 1 .. 12 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $m;
+ $return .= ">$_";
+ }
+ $return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!;
+ for ( 1999 .. 2037 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $y;
+ $return .= ">$_";
+ }
+ $return .= "</SELECT>";
+ $return;
+}
-my($payinfo,$payname,$otaker)=(
+print "<BR>Billing information", &itable("#c0c0c0"),
+ qq!<TR><TD><INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
+print qq! CHECKED! if $cust_main->tax eq "Y";
+print qq!>Tax Exempt</TD></TR>!;
+print qq!<TR><TD><INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!;
+@invoicing_list = $cust_main->invoicing_list;
+print qq! CHECKED!
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+print qq!>Postal mail invoice</TD></TR>!;
+$invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list );
+print qq!<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD></TR>!;
+
+print "<TR><TD>Billing type</TD></TR>",
+ "</TABLE>",
+ &table("#c0c0c0"), "<TR>";
+
+($payinfo, $payname)=(
$cust_main->payinfo,
$cust_main->payname,
- $cust_main->otaker,
);
-my($paydate);
-if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) {
- $paydate="$2/$1"
-} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) {
- $paydate="$1/$2"
-}
-else {
- $paydate='';
+%payby = (
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
+ 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR>${r}Exp !. expselect("BILL", "12-2037"). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
+);
+%paybychecked = (
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
+ 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("BILL", $cust_main->paydate). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate),
+);
+for (qw(CARD BILL COMP)) {
+ print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($cust_main->payby eq "$_") {
+ print qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ print qq!> $payby{$_}</TD>!;
+ }
}
-print <<END;
-
- Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19>
-END
-
-print qq!Exp. date (MM/YY or MM/YYYY)<INPUT TYPE="text" NAME="paydate" VALUE="$paydate" SIZE=8 MAXLENGTH=7> Billing name <INPUT TYPE="text" NAME="payname" VALUE="$payname">\n<INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
-print qq! CHECKED! if $cust_main->tax eq "Y";
-print qq!> Tax Exempt!;
-
-print <<END;
+print "</TR></TABLE>$r required fields for each billing type";
+
+unless ( $custnum ) {
+ # pry the wrong place for this logic. also pretty expensive
+ #use FS::pkg_svc;
+ #use FS::part_svc;
+ #use FS::part_pkg;
+
+ #false laziness, copied from FS::cust_pkg::order
+ my %part_pkg;
+ if ( scalar(@agents) == 1 ) {
+ # generate %part_pkg
+ # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
+ #my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
+ #my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
+ my($agent)=qsearchs('agent',{'agentnum'=> $agentnum });
+
+ my($type_pkgs);
+ foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ my($pkgpart)=$type_pkgs->pkgpart;
+ $part_pkg{$pkgpart}++;
+ }
+ } else {
+ #can't know (agent not chosen), so, allow all
+ my %typenum;
+ foreach my $agent ( @agents ) {
+ next if $typenum{$agent->typenum}++;
+ foreach my $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ my($pkgpart)=$type_pkgs->pkgpart;
+ $part_pkg{$pkgpart}++;
+ }
+ }
+ }
+ #eslaf
+
+ my %pkgpart;
+ #foreach ( @pkg_svc ) {
+ foreach ( qsearch( 'pkg_svc', {} ) ) {
+ my $part_svc = qsearchs ( 'part_svc', { 'svcpart' => $_->svcpart } );
+ $pkgpart{ $_->pkgpart } = -1 # never will == 1 below
+ if ( $part_svc->svcdb ne 'svc_acct' );
+ if ( $pkgpart{ $_->pkgpart } ) {
+ $pkgpart{ $_->pkgpart } = '-1';
+ } else {
+ $pkgpart{ $_->pkgpart } = $_->svcpart;
+ }
+ }
-Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
-</PRE>
+ my @part_pkg =
+ #grep { $pkgpart{ $_->pkgpart } == 1 } qsearch( 'part_pkg', {} );
+ grep {
+ #( $pkgpart{ $_->pkgpart } || 0 ) == 1
+ $pkgpart{ $_->pkgpart }
+ && $pkgpart{ $_->pkgpart } != -1
+ && $part_pkg{ $_->pkgpart }
+ ;
+ } qsearch( 'part_pkg', {} );
+
+ if ( @part_pkg ) {
+
+ print "<BR><BR>First package", &itable("#c0c0c0"),
+ qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!;
+
+ print qq!<OPTION VALUE="">(none)!;
+
+ foreach my $part_pkg ( @part_pkg ) {
+ print qq!<OPTION VALUE="!,
+ $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"';
+ print " SELECTED" if $pkgpart && ( $part_pkg->pkgpart == $pkgpart );
+ print ">", $part_pkg->pkg, " - ", $part_pkg->comment;
+ }
+ print "</SELECT></TD></TR>";
+
+ #false laziness: (mostly) copied from edit/svc_acct.cgi
+ #$ulen = $svc_acct->dbdef_table->column('username')->length;
+ $ulen = dbdef->table('svc_acct')->column('username')->length;
+ $ulen2 = $ulen+2;
+ print <<END;
+<TR><TD ALIGN="right">Username</TD>
+<TD><INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen></TD></TR>
+<TR><TD ALIGN="right">Password</TD>
+<TD><INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
+(blank to generate)</TD></TR>
END
+ print qq!<TR><TD ALIGN="right">POP</TD><TD><SELECT NAME="popnum" SIZE=1><OPTION> !;
+ my($svc_acct_pop);
+ foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
+ print qq!<OPTION VALUE="!, $svc_acct_pop->popnum, '"',
+ ( $popnum && $svc_acct_pop->popnum == $popnum ) ? ' SELECTED' : '', ">",
+ $svc_acct_pop->popnum, ": ",
+ $svc_acct_pop->city, ", ",
+ $svc_acct_pop->state,
+ " (", $svc_acct_pop->ac, ")/",
+ $svc_acct_pop->exch, "\n"
+ ;
+ }
+ print "</SELECT></TD></TR></TABLE>";
+ }
+}
-print qq!<CENTER><INPUT TYPE="submit" VALUE="!,
- $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
+$otaker = $cust_main->otaker;
+print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!,
+ qq!<BR><BR><INPUT TYPE="submit" VALUE="!,
+ $custnum ? "Apply Changes" : "Add Customer", qq!">!,
+ "</FORM></BODY></HTML>",
+;
#!/usr/bin/perl -Tw
#
-# cust_main_county-expand.cgi: Expand a state into counties (output form)
+# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $
#
# ivan@sisd.com 97-dec-16
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county-expand.cgi,v $
+# Revision 1.6 1999-01-25 12:09:54 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:35 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:25 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:17:01 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/18 09:01:38 ivan
+# i18n! i18n!
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl);
+use FS::cust_main_county;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-$cgi->var('QUERY_STRING') =~ /^(\d+)$/
- or die "Illegal taxnum!";
-my($taxnum)=$1;
+if ( $cgi->param('error') ) {
+ $taxnum = $cgi->param('taxnum');
+ $delim = $cgi->param('delim');
+ $expansion = $cgi->param('expansion');
+} else {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/
+ or die "Illegal taxnum!";
+ $taxnum = $1;
+ $delim = 'n';
+ $expansion = '';
+}
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum});
+$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum});
die "Can't expand entry!" if $cust_main_county->getfield('county');
-print header("Tax Rate (expand state)", menubar(
- 'Main Menu' => '../',
-)), <<END;
- <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST>
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar(
+ 'Main Menu' => popurl(2),
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print <<END;
+ <FORM ACTION="${p1}process/cust_main_county-expand.cgi" METHOD=POST>
<INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum">
- Separate counties by
- <INPUT TYPE="radio" NAME="delim" VALUE="n" CHECKED>line
- (rumor has it broken on some browsers) or
- <INPUT TYPE="radio" NAME="delim" VALUE="s">whitespace.
+ Separate by
+END
+print '<INPUT TYPE="radio" NAME="delim" VALUE="n"';
+print ' CHECKED' if $delim eq 'n';
+print '>line (rumor has it broken on some browsers) or',
+ '<INPUT TYPE="radio" NAME="delim" VALUE="s"';
+print ' CHECKED' if $delim eq 's';
+print '>whitespace.';
+print <<END;
<BR><INPUT TYPE="submit" VALUE="Submit">
- <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA>
+ <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA>
</FORM>
</CENTER>
</BODY>
#!/usr/bin/perl -Tw
#
-# cust_main_county.cgi: Edit tax rates (output form)
+# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-dec-13-16
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/01/25 12:09:55 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:36 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:26 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:17:02 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/18 09:01:39 ivan
+# i18n! i18n!
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $cust_main_county );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl table);
+use FS::cust_main_county;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
+print $cgi->header( '-expires' => 'now' ), header("Edit tax rates", menubar(
+ 'Main Menu' => popurl(2),
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-print header("Edit tax rates", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <FORM ACTION="process/cust_main_county.cgi" METHOD=POST>
- <TABLE BORDER>
+print qq!<FORM ACTION="!, popurl(1),
+ qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END;
<TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
<TH><FONT SIZE=-1>State</FONT></TH>
<TH>County</TH>
<TH><FONT SIZE=-1>Tax</FONT></TH>
</TR>
END
-my($cust_main_county);
foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
my($hashref)=$cust_main_county->hashref;
print <<END;
<TR>
- <TD>$hashref->{state}</TD>
+ <TD>$hashref->{country}</TD>
END
+ print "<TD>", $hashref->{state}
+ ? $hashref->{state}
+ : '(ALL)'
+ , "</TD>";
+
print "<TD>", $hashref->{county}
? $hashref->{county}
: '(ALL)'
#!/usr/bin/perl -Tw
#
-# cust_pay.cgi: Add a payment (output form)
+# $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $
#
# Usage: cust_pay.cgi invnum
# http://server.name/path/cust_pay.cgi?invnum
#
-# Note: Should be run setuid as user nobody.
-#
# some hooks for modifications as well as additions, but needs work.
#
# ivan@voicenet.com 96-dec-11
#
# rewrite ivan@sisd.com 98-mar-16
+#
+# $Log: cust_pay.cgi,v $
+# Revision 1.6 1999-02-28 00:03:35 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/25 12:09:56 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.4 1999/01/19 05:13:37 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:27 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:03 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
+use vars qw( $cgi $invnum $p1 $_date $payby $payinfo $paid );
use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI);
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
+if ( $cgi->param('error') ) {
+ $invnum = $cgi->param('invnum');
+ $paid = $cgi->param('paid');
+ $payby = $cgi->param('payby');
+ $payinfo = $cgi->param('payinfo');
+} else {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $invnum = $1;
+ $paid = '';
+ $payby = "BILL";
+ $payinfo = "";
+}
+$_date = time;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Enter payment", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-SendHeaders(); # one guess.
print <<END;
-<HTML>
- <HEAD>
- <TITLE>Enter payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Enter payment</H1>
- </CENTER>
- <FORM ACTION="process/cust_pay.cgi" METHOD=POST>
+ <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST>
<HR><PRE>
END
-#invnum
print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!;
-#date
-my($date)=time;
-print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
+print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!;
-#paid
-print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!;
+print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!;
-#payby
-my($payby)="BILL";
print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
-my($payinfo)="";
print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!;
#paybatch
print <<END;
</PRE>
<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
+<INPUT TYPE="submit" VALUE="Post payment">
END
print <<END;
#!/usr/bin/perl -Tw
#
-# cust_pkg.cgi: Add/edit packages (output form)
+# $Id: cust_pkg.cgi,v 1.7 1999-04-14 01:03:01 ivan Exp $
#
# this is for changing packages around, not editing things within the package
#
# Usage: cust_pkg.cgi custnum
# http://server.name/path/cust_pkg.cgi?custnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# started with /sales/add/cust_pkg.cgi, which added packages
# ivan@voicenet.com 97-jan-5, 97-mar-21
#
#
# fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
# 98-jun-1
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.7 1999-04-14 01:03:01 ivan
+# oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup,
+# bug is hidden by mod_perl persistance
+#
+# Revision 1.6 1999/02/28 00:03:36 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:18 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:38 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:28 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:04 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg
+ $cust_main $agent $type_pkgs $count %remove_pkg );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup getotaker);
+use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header popurl);
+use FS::part_pkg;
+use FS::type_pkgs;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-my(%pkg,%comment);
+%pkg = ();
+%comment = ();
foreach (qsearch('part_pkg', {})) {
$pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
$comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
}
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
+if ( $cgi->param('error') ) {
+ $custnum = $cgi->param('custnum');
+ %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum = $1;
+ undef %remove_pkg;
+}
-my($otaker)=&getotaker;
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", '');
-SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Add/Edit Packages</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Add/Edit Packages</H1>
- </CENTER>
- <FORM ACTION="process/cust_pkg.cgi" METHOD=POST>
- <HR>
-END
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-#custnum
-print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!;
+print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
-#current packages (except cancelled packages)
-my(@cust_pkg) = grep ! $_->getfield('cancel'),
- qsearch('cust_pkg',{'custnum'=>$custnum});
+print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
+
+#current packages
+@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
if (@cust_pkg) {
print <<END;
-<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER>
-These are packages the customer currently has. Select those packages you
-wish to remove (if any).<BR><BR>
+Current packages - select to remove (services are moved to a new package below)
+<BR><BR>
END
my ($count) = 0 ;
- print qq!<CENTER><TABLE>! ;
+ print qq!<TABLE>! ;
foreach (@cust_pkg) {
- print qq!<TR>! if ($count ==0) ;
+ print '<TR>' if $count == 0;
my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
- print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!,
- #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!,
- #now you've got to admit this bug was pretty cool
- qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
+ print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!;
+ print " CHECKED" if $remove_pkg{$pkgnum};
+ print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
$count ++ ;
if ($count == 2)
{
print qq!</TR>\n! ;
}
}
- print qq!</TABLE></CENTER>! ;
-
- print "<HR>";
+ print qq!</TABLE><BR><BR>!;
}
print <<END;
-<CENTER><FONT SIZE="+2">New packages</FONT></CENTER>
-These are packages the customer can purchase. Specify the quantity to add
-of each package.<BR><BR>
+Order new packages<BR><BR>
END
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-my($type_pkgs);
-my ($count) = 0 ;
-print qq!<CENTER><TABLE>! ;
+$count = 0 ;
+print qq!<TABLE>! ;
foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
my($pkgpart)=$type_pkgs->pkgpart;
print qq!<TR>! if ($count == 0) ;
+ my $value = $cgi->param("pkg$pkgpart") || 0;
print <<END;
<TD>
- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2">
+ <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
$pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
END
$count ++ ;
$count = 0 ;
}
}
-print qq!</TABLE></CENTER>! ;
-
-#otaker
-print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!;
+print qq!</TABLE>! ;
#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!;
+print qq!<P><INPUT TYPE="submit" VALUE="Order">\n!;
print <<END;
</FORM>
#!/usr/bin/perl -Tw
#
+# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $
+#
# part_pkg.cgi: Add/Edit package (output form)
#
# ivan@sisd.com 97-dec-10
# bmccane@maxbaud.net 98-apr-3
#
# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.9 1999-02-07 09:59:19 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.8 1999/01/19 05:13:39 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.7 1999/01/18 09:41:29 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.6 1998/12/17 06:17:05 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.5 1998/11/21 07:12:26 ivan
+# *** empty log message ***
+#
+# Revision 1.4 1998/11/21 07:11:08 ivan
+# *** empty log message ***
+#
+# Revision 1.3 1998/11/21 07:07:40 ivan
+# popurl, bugfix
+#
+# Revision 1.2 1998/11/15 13:14:55 ivan
+# first pass as per-user custom pricing
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearch qsearchs fields);
use FS::part_pkg;
+use FS::part_svc;
use FS::pkg_svc;
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
+if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {
+ $cgi->param('clone', $1);
+} else {
+ $cgi->param('clone', '');
+}
+if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
+ $cgi->param('pkgnum', $1);
+} else {
+ $cgi->param('pkgnum', '');
+}
-my($part_pkg,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1});
- $action='Edit';
-} else { #adding
- $part_pkg=create FS::part_pkg {};
- $action='Add';
+($query) = $cgi->keywords;
+$action = '';
+$part_pkg = '';
+if ( $cgi->param('error') ) {
+ $part_pkg = new FS::part_pkg ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_pkg')
+ } );
}
-my($hashref)=$part_pkg->hashref;
+if ( $cgi->param('clone') ) {
+ $action='Custom Pricing';
+ my $old_part_pkg =
+ qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } );
+ $part_pkg ||= $old_part_pkg->clone;
+} elsif ( $query && $query =~ /^(\d+)$/ ) {
+ $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1});
+} else {
+ $part_pkg ||= new FS::part_pkg {};
+}
+$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add';
+$hashref = $part_pkg->hashref;
+
+print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all packages' => popurl(2). 'browse/part_pkg.cgi',
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-print header("$action Package Definition", menubar(
- 'Main Menu' => '../',
- 'View all packages' => '../browse/part_pkg.cgi',
-)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>';
+print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>';
+
+if ( $cgi->param('clone') ) {
+ print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!;
+}
+if ( $cgi->param('pkgnum') ) {
+ print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="!, $cgi->param('pkgnum'), qq!">!;
+}
print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
"Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
</PRE>
+END
+
+unless ( $cgi->param('clone') ) {
+ print <<END;
Enter the quantity of each service this package includes.<BR><BR>
<TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH>
<TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR>
END
+}
-my($part_svc);
-my($count) = 0 ;
-foreach $part_svc ( qsearch('part_svc',{}) ) {
-
- my($svcpart)=$part_svc->getfield('svcpart');
- my($pkg_svc)=qsearchs('pkg_svc',{
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
+$count = 0;
+foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) {
+ my $svcpart = $part_svc->svcpart;
+ my $pkg_svc = qsearchs( 'pkg_svc', {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
'svcpart' => $svcpart,
- }) || create FS::pkg_svc({
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
+ } ) || new FS::pkg_svc ( {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
'svcpart' => $svcpart,
'quantity' => 0,
});
- next unless $pkg_svc;
-
- print qq!<TR>! if $count == 0 ;
- print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!,
- $pkg_svc->getfield('quantity') || 0,qq!"></TD>!,
- qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'),
- qq!">!, $part_svc->getfield('svc'), "</A></TD>";
- $count ++ ;
- if ($count == 2)
- {
- print qq!</TR>! ;
- $count = 0 ;
+ #? #next unless $pkg_svc;
+
+ unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) {
+ print '<TR>' if $count == 0 ;
+ print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!,
+ $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0,
+ qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart,
+ qq!">!, $part_svc->getfield('svc'), "</A></TD>";
+ $count++;
+ if ($count == 2)
+ {
+ print '</TR>';
+ $count = 0;
+ }
+ } else {
+ print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!,
+ $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!;
}
}
-print qq!</TR>! if ($count != 0) ;
-print "</TABLE>";
+unless ( $cgi->param('clone') ) {
+ print qq!</TR>! if ($count != 0) ;
+ print "</TABLE>";
+}
print qq!<BR><INPUT TYPE="submit" VALUE="!,
$hashref->{pkgpart} ? "Apply changes" : "Add package",
#!/usr/bin/perl -Tw
#
-# agent.cgi: Add/Edit referral (output form)
+# $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $
#
# ivan@sisd.com 98-feb-23
#
# confisuing typo on submit button ivan@sisd.com 98-jun-14
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.6 1999-04-07 11:43:23 ivan
+# pick up errors right away, leave input
+#
+# Revision 1.5 1999/02/07 09:59:20 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:41 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:30 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:06 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $part_referral $action $hashref $p1 $query );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearch qsearchs fields);
use FS::part_referral;
-use FS::CGI qw(header menubar);
+use FS::CGI qw(header menubar popurl);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-my($part_referral,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_referral=qsearchs('part_referral',{'refnum'=>$1});
- $action='Edit';
+if ( $cgi->param('error') ) {
+ $part_referral = new FS::part_referral ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_referral')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } );
} else { #adding
- $part_referral=create FS::part_referral {};
- $action='Add';
+ $part_referral = new FS::part_referral {};
}
-my($hashref)=$part_referral->hashref;
+$action = $part_referral->refnum ? 'Edit' : 'Add';
+$hashref = $part_referral->hashref;
-print header("$action Referral", menubar(
- 'Main Menu' => '../',
- 'View all referrals' => "../browse/part_referral.cgi",
-)), <<END;
- <FORM ACTION="process/part_referral.cgi" METHOD=POST>
-END
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all referrals' => popurl(2). "browse/part_referral.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-#display
+print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!;
print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
"Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
#!/usr/bin/perl -Tw
#
-# part_svc.cgi: Add/Edit service (output form)
+# $Id: part_svc.cgi,v 1.12 1999-04-09 04:22:34 ivan Exp $
#
# ivan@sisd.com 97-nov-14
#
# bmccane@maxbaud.net 98-apr-3
#
# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.12 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.11 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.10 1999/04/08 13:01:50 ivan
+# [ AND DOCUMENT! ] all svc_acct services should have a default
+# or fixed shell
+#
+# Revision 1.9 1999/02/23 08:09:21 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.8 1999/02/07 09:59:21 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:42 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:31 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:21 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/17 06:17:07 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.3 1998/11/21 06:43:26 ivan
+# visual
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(header menubar);
+use FS::Record qw(qsearchs fields);
+use FS::part_svc;
+use FS::CGI qw(header menubar popurl table);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-my($part_svc,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
+if ( $cgi->param('error') ) {
+ $part_svc = new FS::part_svc ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_svc')
+ } );
+} elsif ( $cgi->keywords ) {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
$part_svc=qsearchs('part_svc',{'svcpart'=>$1});
- $action='Edit';
} else { #adding
- $part_svc=create FS::part_svc {};
- $action='Add';
+ $part_svc = new FS::part_svc {};
}
-my($hashref)=$part_svc->hashref;
+$action = $part_svc->svcpart ? 'Edit' : 'Add';
+$hashref = $part_svc->hashref;
-print header("$action Service Definition", menubar(
- 'Main Menu' => '../',
- 'View all services' => '../browse/part_svc.cgi',
-)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>';
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar(
+ 'Main Menu' => $p,
+ 'View all services' => "${p}browse/part_svc.cgi",
+));
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+print '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>';
print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!,
"Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)";
print <<END;
<PRE>
Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}">
-Table <SELECT NAME="svcdb" SIZE=1>
-END
-
-print map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw(
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
-);
-
-print <<END;
-</SELECT></PRE>
+</PRE>
Services are items you offer to your customers.
<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
<LI>svc_domain - Virtual domains
<LI>svc_acct_sm - Virtual domain mail aliasing
- <LI>svc_charge - One-time charges (Partially unimplemented)
- <LI>svc_wo - Work orders (Partially unimplemented)
+END
+# <LI>svc_charge - One-time charges (Partially unimplemented)
+# <LI>svc_wo - Work orders (Partially unimplemented)
+print <<END;
</UL>
-For the columns in the table selected above, you can set default or fixed
+For the selected table, you can give fields default or fixed (unchangable)
values. For example, a SLIP/PPP account may have a default (or perhaps fixed)
<B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed
blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or
<B>/usr/bin/passwd</B>.
<BR><BR>
-<TABLE BORDER CELLPADDING=4><TR><TH>Table</TH><TH>Field</TH>
+END
+print &table(), '<TR><TH>Table<SELECT NAME="svcdb" SIZE=1>',
+ map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw(
+ svc_acct svc_domain svc_acct_sm
+ );
+ print "</SELECT>";
+# svc_acct svc_domain svc_acct_sm svc_charge svc_wo
+
+print <<END;
+</TH><TH>Field</TH>
<TH COLSPAN=2>Modifier</TH></TR>
END
#these might belong somewhere else for other user interfaces
#pry need to eventually create stuff that's shared amount UIs
-my(%defs)=(
+%defs = (
'svc_acct' => {
'dir' => 'Home directory',
'uid' => 'UID (set to fixed and blank for dial-only)',
'slipip' => 'IP address',
- 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>',
+ 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
'username' => 'Username',
'quota' => '(unimplemented)',
'_password' => 'Password',
'gid' => 'GID (when blank, defaults to UID)',
- 'shell' => 'Shell',
+ 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
'finger' => 'GECOS',
},
'svc_domain' => {
},
);
-my($svcdb);
+# svc_acct svc_domain svc_acct_sm svc_charge svc_wo
foreach $svcdb ( qw(
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
+ svc_acct svc_domain svc_acct_sm
) ) {
my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>";
my($row);
foreach $row (@rows) {
- my($value)=$part_svc->getfield($svcdb.'__'.$row);
- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>";
+ my $value = $part_svc->getfield($svcdb. '__'. $row);
+ my $flag = $part_svc->getfield($svcdb. '__'. $row. '_flag');
+ print "<TR>$ptmp<TD>$row";
+ print "- <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT>"
+ if defined $defs{$svcdb}{$row};
+ print "</TD>";
print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
- ' CHECKED'x($flag eq ''). "><BR>Off</TD>";
+ ' CHECKED'x($flag eq ''). ">Off</TD>";
print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!.
' CHECKED'x($flag eq 'D'). ">Default ";
print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!.
' CHECKED'x($flag eq 'F'). ">Fixed ";
- print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
- "</TD></TR>";
+ print qq!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
+ "</TD></TR>\n";
$ptmp='';
}
}
print "</TABLE>";
-print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!,
+print qq!\n<BR><INPUT TYPE="submit" VALUE="!,
$hashref->{svcpart} ? "Apply changes" : "Add service",
- qq!"></CENTER>!;
+ qq!">!;
print <<END;
#!/usr/bin/perl -Tw
#
-# process/agent.cgi: Edit agent (process form)
+# $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $
#
# ivan@sisd.com 97-dec-12
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent.cgi,v $
+# Revision 1.7 1999-01-25 12:09:57 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:13:47 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:49 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:26 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:16 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/23 07:52:29 ivan
+# *** empty log message ***
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $agentnum $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent qw(fields);
-use FS::CGI qw(idiot);
-
-my($req)=new CGI::Request; # create form object
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent;
+use FS::CGI qw(popurl);
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
-my($agentnum)=$req->param('agentnum');
+&cgisuidsetup($cgi);
-my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
+$agentnum = $cgi->param('agentnum');
-#unmunge typenum
-$req->param('typenum') =~ /^(\d+)(:.*)?$/;
-$req->param('typenum',$1);
+$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
-my($new)=create FS::agent ( {
+$new = new FS::agent ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
} fields('agent')
} );
-my($error);
if ( $agentnum ) {
$error=$new->replace($old);
} else {
}
if ( $error ) {
- &idiot($error);
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string );
} else {
- #$req->cgi->redirect("../../view/agent.cgi?$agentnum");
- #$req->cgi->redirect("../../edit/agent.cgi?$agentnum");
- $req->cgi->redirect("../../browse/agent.cgi");
+ print $cgi->redirect(popurl(3). "browse/agent.cgi");
}
#!/usr/bin/perl -Tw
#
-# process/agent_type.cgi: Edit agent type (process form)
+# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $
#
# ivan@sisd.com 97-dec-11
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.7 1999-01-25 12:09:58 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:13:48 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:50 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:27 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:17 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/21 07:49:20 ivan
+# s/CGI::Request/CGI.pm/
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $typenum $old $new $error $part_pkg );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
+use FS::CGI qw( popurl);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type qw(fields);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent_type;
use FS::type_pkgs;
-use FS::CGI qw(idiot);
+use FS::part_pkg;
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my($typenum)=$req->param('typenum');
-my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
+$typenum = $cgi->param('typenum');
+$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
-my($new)=create FS::agent_type ( {
+$new = new FS::agent_type ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
} fields('agent_type')
} );
-my($error);
if ( $typenum ) {
$error=$new->replace($old);
} else {
}
if ( $error ) {
- idiot($error);
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string );
exit;
}
-my($part_pkg);
foreach $part_pkg (qsearch('part_pkg',{})) {
my($pkgpart)=$part_pkg->getfield('pkgpart');
'typenum' => $typenum,
'pkgpart' => $pkgpart,
});
- if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) {
+ if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) {
my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
- $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs,
- #so ->del not ->delete. hmm. hmm.
- if ( $error ) {
- idiot($error);
- exit;
- }
+ $error=$d_type_pkgs->delete;
+ die $error if $error;
- } elsif ( $req->param("pkgpart$pkgpart")
+ } elsif ( $cgi->param("pkgpart$pkgpart")
&& ! $type_pkgs
) {
#ok to clobber it now (but bad form nonetheless?)
- $type_pkgs=create FS::type_pkgs ({
+ $type_pkgs=new FS::type_pkgs ({
'typenum' => $typenum,
'pkgpart' => $pkgpart,
});
$error= $type_pkgs->insert;
- if ( $error ) {
- idiot($error);
- exit;
- }
+ die $error if $error;
}
}
-#$req->cgi->redirect("../../view/agent_type.cgi?$typenum");
-#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum");
-$req->cgi->redirect("../../browse/agent_type.cgi");
+print $cgi->redirect(popurl(3). "browse/agent_type.cgi");
#!/usr/bin/perl -Tw
#
-# process/cust_credit.cgi: Add a credit (process form)
+# $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/cust_credit.cgi
#
-# Note: Should be run setuid root as user nobody.
-#
# ivan@voicenet.com 96-dec-05 -> 96-dec-08
#
# post a refund if $new_paybatch
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_credit.cgi,v $
+# Revision 1.7 1999-04-07 15:23:05 ivan
+# don't use anchor in redirect
+#
+# Revision 1.6 1999/02/28 00:03:41 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/25 12:09:59 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.4 1999/01/19 05:13:49 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:47:51 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:18 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $custnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(popurl);
+use FS::Record qw(fields);
use FS::cust_credit;
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
+$cgi = new CGI;
+cgisuidsetup($cgi);
-$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
-my($custnum)=$1;
+$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
+$custnum = $1;
-$req->param('otaker',getotaker);
+$cgi->param('otaker',getotaker);
-my($new) = create FS::cust_credit ( {
+$new = new FS::cust_credit ( {
map {
- $_, $req->param($_);
- } qw(custnum _date amount otaker reason)
+ $_, scalar($cgi->param($_));
+ #} qw(custnum _date amount otaker reason)
+ } fields('cust_credit')
} );
-my($error);
$error=$new->insert;
-&idiot($error) if $error;
-
-#no errors, no refund, so view our credit.
-$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error posting credit/refund</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error posting credit/refund</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
- </BODY>
-</HTML>
-END
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
}
+
#!/usr/bin/perl -Tw
#
-# process/cust_main.cgi: Edit a customer (process form)
+# $Id: cust_main.cgi,v 1.10 1999-04-14 07:47:53 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/cust_main.cgi
#
-# Note: Should be run setuid root as user nobody.
-#
# ivan@voicenet.com 96-dec-04
#
# added referral check
# Changes to allow page to work at a relative position in server
# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.10 1999-04-14 07:47:53 ivan
+# i18n fixes
+#
+# Revision 1.9 1999/04/07 15:22:19 ivan
+# don't use anchor in redirect
+#
+# Revision 1.8 1999/03/25 13:55:10 ivan
+# one-screen new customer entry (including package and service) for simple
+# packages with one svc_acct service
+#
+# Revision 1.7 1999/02/28 00:03:42 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:10:00 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:50 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:22:32 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/17 08:40:19 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 08:57:36 ivan
+# i18n, s/CGI-modules/CGI.pm/, FS::CGI::idiot instead of inline, FS::CGI::popurl
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $payby @invoicing_list $new $custnum $error );
+use vars qw( $cust_pkg $cust_svc $svc_acct );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
+use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw( popurl );
+use FS::Record qw( qsearch qsearchs fields );
use FS::cust_main;
+use FS::type_pkgs;
+use FS::agent;
-my($req)=new CGI::Request; # create form object
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-&cgisuidsetup($req->cgi);
+#unmunge stuff
-#create new record object
+$cgi->param('tax','') unless defined($cgi->param('tax'));
-#unmunge agentnum
-$req->param('agentnum',
- (split(/:/, ($req->param('agentnum'))[0] ))[0]
-);
+$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] );
-#unmunge tax
-$req->param('tax','') unless defined($req->param('tax'));
+$cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/
+ or die "Oops, illegal \"state\" param: ". $cgi->param('state');
+$cgi->param('state', $1);
+$cgi->param('county', $3 || '');
+$cgi->param('country', $4);
-#unmunge refnum
-$req->param('refnum',
- (split(/:/, ($req->param('refnum'))[0] ))[0]
-);
+if ( $payby = $cgi->param('payby') ) {
+ $cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) );
+ $cgi->param('paydate',
+ $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ) );
+ $cgi->param('payname', $cgi->param( $payby. '_payname' ) );
+}
+
+$cgi->param('otaker', &getotaker );
+
+@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
+push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
-#unmunge state/county
-$req->param('state') =~ /^(\w+)( \((\w+)\))?$/;
-$req->param('state', $1);
-$req->param('county', $3 || '');
+#create new record object
-my($new) = create FS::cust_main ( {
+$new = new FS::cust_main ( {
map {
- $_, $req->param("$_") || ''
- } qw(custnum agentnum last first ss company address1 address2 city county
- state zip country daytime night fax payby payinfo paydate payname tax
- otaker refnum)
+ $_, scalar($cgi->param($_))
+# } qw(custnum agentnum last first ss company address1 address2 city county
+# state zip daytime night fax payby payinfo paydate payname tax
+# otaker refnum)
+ } fields('cust_main')
} );
-if ( $new->custnum eq '' ) {
+#perhaps the invocing_list magic should move to cust_main.pm?
+$error = $new->check_invoicing_list( \@invoicing_list );
- my($error)=$new->insert;
- &idiot($error) if $error;
+#perhaps this stuff should go to cust_main.pm as well
+$cust_pkg = '';
+$svc_acct = '';
+if ( $new->custnum eq '' ) {
+ if ( $cgi->param('pkgpart_svcpart') ) {
+ my $x = $cgi->param('pkgpart_svcpart');
+ $x =~ /^(\d+)_(\d+)$/;
+ my($pkgpart, $svcpart) = ($1, $2);
+ #false laziness: copied from FS::cust_pkg::order (which should become a
+ #FS::cust_main method)
+ my(%part_pkg);
+ # generate %part_pkg
+ # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
+ my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum });
+ my($type_pkgs);
+ foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ my($pkgpart)=$type_pkgs->pkgpart;
+ $part_pkg{$pkgpart}++;
+ }
+ #eslaf
+
+ $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't".
+ "purchase pkgpart ". $pkgpart
+ unless $part_pkg{ $pkgpart };
+
+ $cust_pkg = new FS::cust_pkg ( {
+ #later 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ } );
+ $error ||= $cust_pkg->check;
+
+ #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } );
+
+ #$error ||= $cust_svc->check;
+
+ $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ 'username' => $cgi->param('username'),
+ '_password' => $cgi->param('_password'),
+ 'popnum' => $cgi->param('popnum'),
+ } );
+
+ 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->svcpart($svcpart);
+ $svc_acct->username($cgi->param('username'));
+ $svc_acct->_password($cgi->param('_password'));
+ $svc_acct->popnum($cgi->param('popnum'));
+
+ $error ||= $svc_acct->check;
+
+ } elsif ( $cgi->param('username') ) { #good thing to catch
+ $error = "Can't assign username without a package!";
+ }
+
+ $error ||= $new->insert;
+ if ( $cust_pkg && ! $error ) {
+ $cust_pkg->custnum( $new->custnum );
+ $error ||= $cust_pkg->insert;
+ warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
+ $svc_acct->pkgnum( $cust_pkg->pkgnum );
+ $error ||= $svc_acct->insert;
+ warn "WARNING: $error on pre-checked svc_acct record!" if $error;
+ }
} else { #create old record object
-
- my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } );
- &idiot("Old record not found!") unless $old;
- my($error)=$new->replace($old);
- &idiot($error) if $error;
-
-}
-
-my($custnum)=$new->custnum;
-$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error updating customer information</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error updating customer information</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
- exit;
-
+ my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } );
+ $error ||= "Old record not found!" unless $old;
+ $error ||= $new->replace($old);
}
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string );
+} else {
+ $new->invoicing_list( \@invoicing_list );
+ $custnum = $new->custnum;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
#!/usr/bin/perl -Tw
#
-# process/cust_main_county-expand.cgi: Expand counties (process form)
+# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:19:07 ivan Exp $
#
# ivan@sisd.com 97-dec-16
#
# lose background, FS::CGI
# undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record
# for that state
-#ivan@sisd.com 98-sep-2
+# ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county-expand.cgi,v $
+# Revision 1.6 1999-01-25 12:19:07 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:51 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:52 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/17 08:40:20 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 09:01:40 ivan
+# i18n! i18n!
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup datasrc);
use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(popurl);
use FS::cust_main_county;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
+use FS::cust_main;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
-my($taxnum)=$1;
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
+$taxnum = $1;
+$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
or die ("Unknown taxnum!");
-my(@counties);
-if ( $req->param('delim') eq 'n' ) {
- @counties=split(/\n/,$req->param('counties'));
-} elsif ( $req->param('delim') eq 's' ) {
- @counties=split(/\s+/,$req->param('counties'));
+if ( $cgi->param('delim') eq 'n' ) {
+ @expansion=split(/\n/,$cgi->param('expansion'));
+} elsif ( $cgi->param('delim') eq 's' ) {
+ @expansion=split(/\s+/,$cgi->param('expansion'));
} else {
die "Illegal delim!";
}
-@counties=map {
- /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county");
+@expansion=map {
+ unless ( /^\s*([\w\- ]+)\s*$/ ) {
+ $cgi->param('error', "Illegal item in expansion");
+ print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string );
+ exit;
+ }
$1;
-} @counties;
+} @expansion;
-my($county);
-foreach ( @counties) {
+foreach ( @expansion) {
my(%hash)=$cust_main_county->hash;
- my($new)=create FS::cust_main_county \%hash;
+ my($new)=new FS::cust_main_county \%hash;
$new->setfield('taxnum','');
- $new->setfield('county',$_);
+ if ( ! $cust_main_county->state ) {
+ $new->setfield('state',$_);
+ } else {
+ $new->setfield('county',$_);
+ }
#if (datasrc =~ m/Pg/)
#{
# $new->setfield('tax',0.0);
unless ( qsearch('cust_main',{
'state' => $cust_main_county->getfield('state'),
'county' => $cust_main_county->getfield('county'),
+ 'country' => $cust_main_county->getfield('country'),
} ) ) {
my($error)=($cust_main_county->delete);
die $error if $error;
}
-$req->cgi->redirect("../../edit/cust_main_county.cgi");
+print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi");
#!/usr/bin/perl -Tw
#
-# process/agent.cgi: Edit cust_main_county (process form)
+# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $
#
# ivan@sisd.com 97-dec-16
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.6 1999-01-25 12:19:08 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:52 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:53 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/17 08:40:21 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 09:01:41 ivan
+# i18n! i18n!
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
use FS::Record qw(qsearch qsearchs);
use FS::cust_main_county;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-foreach ( $req->params ) {
+foreach ( $cgi->param ) {
/^tax(\d+)$/ or die "Illegal form $_!";
my($taxnum)=$1;
my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
or die "Couldn't find taxnum $taxnum!";
- next unless $old->getfield('tax') ne $req->param("tax$taxnum");
+ next unless $old->getfield('tax') ne $cgi->param("tax$taxnum");
my(%hash)=$old->hash;
- $hash{tax}=$req->param("tax$taxnum");
- my($new)=create FS::cust_main_county \%hash;
+ $hash{tax}=$cgi->param("tax$taxnum");
+ my($new)=new FS::cust_main_county \%hash;
my($error)=$new->replace($old);
- eidiot($error) if $error;
+ if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string );
+ exit;
+ }
}
-$req->cgi->redirect("../../browse/cust_main_county.cgi");
+print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
#!/usr/bin/perl -Tw
#
-# process/cust_pay.cgi: Add a payment (process form)
+# $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/cust_pay.cgi
#
-# Note: Should be run setuid root as user nobody.
-#
# ivan@voicenet.com 96-dec-11
#
# rewrite ivan@sisd.com 98-mar-16
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_pay.cgi,v $
+# Revision 1.7 1999-02-28 00:03:43 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:19:09 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:53 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:54 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:28 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:22 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $invnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::cust_pay qw(fields);
+use FS::CGI qw(popurl);
+use FS::Record qw(fields);
+use FS::cust_pay;
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($invnum)=$1;
+$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$invnum = $1;
-my($new) = create FS::cust_pay ( {
+$new = new FS::cust_pay ( {
map {
- $_, $req->param($_);
- } qw(invnum paid _date payby payinfo paybatch)
+ $_, scalar($cgi->param($_));
+ #} qw(invnum paid _date payby payinfo paybatch)
+ } fields('cust_pay')
} );
-my($error);
$error=$new->insert;
-if ($error) { #error!
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error posting payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error posting payment</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
- </BODY>
-</HTML>
-END
-} else { #no errors!
- $req->cgi->redirect("../../view/cust_bill.cgi?$invnum");
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string );
+ exit;
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$invnum");
}
#!/usr/bin/perl -Tw
#
-# process/cust_pkg.cgi: Add/edit packages (process form)
+# $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $
#
# this is for changing packages around, not for editing things within the
# package
# Usage: post form to:
# http://server.name/path/cust_pkg.cgi
#
-# Note: Should be run setuid root as user nobody.
-#
# ivan@voicenet.com 97-mar-21 - 97-mar-24
#
# rewrote for new API
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.7 1999-04-07 15:24:06 ivan
+# don't use anchor in redirect
+#
+# Revision 1.6 1999/02/28 00:03:44 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:26 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.3 1999/01/19 05:13:54 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 08:40:23 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
use FS::cust_pkg;
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
+$cgi = new CGI; # create form object
+&cgisuidsetup($cgi);
+$error = '';
#untaint custnum
-$req->param('new_custnum') =~ /^(\d+)$/;
-my($custnum)=$1;
+$cgi->param('custnum') =~ /^(\d+)$/;
+$custnum = $1;
-my(@remove_pkgnums) = map {
+@remove_pkgnums = map {
/^(\d+)$/ or die "Illegal remove_pkg value!";
$1;
-} $req->param('remove_pkg');
+} $cgi->param('remove_pkg');
-my(@pkgparts);
-my($pkgpart);
-foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) {
- my($num_pkgs)=$req->param("pkg$pkgpart");
- while ( $num_pkgs-- ) {
- push @pkgparts,$pkgpart;
+foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) {
+ if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) {
+ my $num_pkgs = $1;
+ while ( $num_pkgs-- ) {
+ push @pkgparts,$pkgpart;
+ }
+ } else {
+ $error = "Illegal quantity";
+ last;
}
}
-my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
+$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
if ($error) {
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error updating packages</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error updating packages</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string );
} else {
- $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg");
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
}
#!/usr/bin/perl -Tw
#
+# $Id: part_pkg.cgi,v 1.8 1999-02-07 09:59:27 ivan Exp $
+#
# process/part_pkg.cgi: Edit package definitions (process form)
#
# ivan@sisd.com 97-dec-10
# Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.8 1999-02-07 09:59:27 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:55 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 22:47:56 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.5 1998/12/30 23:03:29 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/17 08:40:24 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.3 1998/11/21 07:17:58 ivan
+# bugfix to work for regular aswell as custom pricing
+#
+# Revision 1.2 1998/11/15 13:16:15 ivan
+# first pass as per-user custom pricing
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $pkgpart $old $new $part_svc $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg qw(fields);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::part_pkg;
use FS::pkg_svc;
-use FS::CGI qw(eidiot);
+use FS::cust_pkg;
-my($req)=new CGI::Request; # create form object
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-&cgisuidsetup($req->cgi);
+$pkgpart = $cgi->param('pkgpart');
-my($pkgpart)=$req->param('pkgpart');
+$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-
-my($new)=create FS::part_pkg ( {
+$new = new FS::part_pkg ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
} fields('part_pkg')
} );
+#most of the stuff below should move to part_pkg.pm
+
+foreach $part_svc ( qsearch('part_svc', {} ) ) {
+ my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
+ unless ( $quantity =~ /^(\d+)$/ ) {
+ $cgi->param('error', "Illegal quantity" );
+ print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
+ exit;
+ }
+}
+
+local $SIG{HUP} = 'IGNORE';
+local $SIG{INT} = 'IGNORE';
+local $SIG{QUIT} = 'IGNORE';
+local $SIG{TERM} = 'IGNORE';
+local $SIG{TSTP} = 'IGNORE';
+local $SIG{PIPE} = 'IGNORE';
+
if ( $pkgpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
+ $error = $new->replace($old);
} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $pkgpart=$new->getfield('pkgpart');
+ $error = $new->insert;
+ $pkgpart=$new->pkgpart;
+}
+if ( $error ) {
+ $cgi->param('error', $error );
+ print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
+ exit;
}
-my($part_svc);
foreach $part_svc (qsearch('part_svc',{})) {
-# don't update non-changing records in part_svc (causing harmless but annoying
-# "Records identical" errors). ivan@sisd.com 98-jan-19
- #my($quantity)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')),
- my($quantity)=$req->param('pkg_svc'. $part_svc->svcpart) || 0,
- my($old_pkg_svc)=qsearchs('pkg_svc',{
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- });
- my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0;
+ my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
+ my $old_pkg_svc = qsearchs('pkg_svc', {
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ } );
+ my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
next unless $old_quantity != $quantity; #!here
- my($new_pkg_svc)=create FS::pkg_svc({
+ my $new_pkg_svc = new FS::pkg_svc( {
'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')),
+ 'svcpart' => $part_svc->svcpart,
'quantity' => $quantity,
- });
- if ($old_pkg_svc) {
- my($error)=$new_pkg_svc->replace($old_pkg_svc);
- eidiot($error) if $error;
+ } );
+ if ( $old_pkg_svc ) {
+ my $myerror = $new_pkg_svc->replace($old_pkg_svc);
+ die $myerror if $myerror;
} else {
- my($error)=$new_pkg_svc->insert;
- eidiot($error) if $error;
+ my $myerror = $new_pkg_svc->insert;
+ die $myerror if $myerror;
}
}
-#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart");
-#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart");
-$req->cgi->redirect("../../browse/part_pkg.cgi");
+unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
+ print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
+} else {
+ my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
+ my %hash = $old_cust_pkg->hash;
+ $hash{'pkgpart'} = $pkgpart;
+ my($new_cust_pkg) = new FS::cust_pkg \%hash;
+ my $myerror = $new_cust_pkg->replace($old_cust_pkg);
+ die "Error modifying cust_pkg record: $myerror\n" if $myerror;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
+}
+
#!/usr/bin/perl -Tw
#
-# process/part_referral.cgi: Edit referrals (process form)
+# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $
#
# ivan@sisd.com 98-feb-23
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.6 1999-02-07 09:59:28 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.5 1999/01/19 05:13:56 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:57 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:30 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:25 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $refnum $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_referral qw(fields);
-use FS::CGI qw(eidiot);
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
+use FS::Record qw(qsearchs fields);
+use FS::part_referral;
+use FS::CGI qw(popurl);
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my($refnum)=$req->param('refnum');
+$refnum = $cgi->param('refnum');
-my($new)=create FS::part_referral ( {
+$new = new FS::part_referral ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
} fields('part_referral')
} );
if ( $refnum ) {
- my($old)=qsearchs('part_referral',{'refnum'=>$refnum});
- eidiot("(Old) Record not found!") unless $old;
- my($error)=$new->replace($old);
- eidiot($error) if $error;
+ my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } );
+ die "(Old) Record not found!" unless $old;
+ $error = $new->replace($old);
} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
+ $error = $new->insert;
}
+$refnum=$new->refnum;
-$refnum=$new->getfield('refnum');
-$req->cgi->redirect("../../browse/part_referral.cgi");
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/part_referral.cgi");
+}
#!/usr/bin/perl -Tw
#
-# process/part_svc.cgi: Edit service definitions (process form)
+# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $
#
# ivan@sisd.com 97-nov-14
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.7 1999-02-07 09:59:29 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:57 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:58 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:31 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:26 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/21 06:43:08 ivan
+# s/CGI::Request/CGI.pm/
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $svcpart $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
+use FS::Record qw(qsearchs fields);
+use FS::part_svc;
+use FS::CGI qw(popurl);
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my($svcpart)=$req->param('svcpart');
+$svcpart = $cgi->param('svcpart');
-my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
+$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-my($new)=create FS::part_svc ( {
+$new = new FS::part_svc ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
# } qw(svcpart svc svcdb)
} fields('part_svc')
} );
if ( $svcpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
+ $error = $new->replace($old);
} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
+ $error = $new->insert;
$svcpart=$new->getfield('svcpart');
}
-#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart");
-#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart");
-$req->cgi->redirect("../../browse/part_svc.cgi");
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3)."browse/part_svc.cgi");
+}
#!/usr/bin/perl -Tw
#
-# process/svc_acct.cgi: Add/edit a customer (process form)
+# $Id: svc_acct.cgi,v 1.6 1999-02-28 00:03:45 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_acct.cgi
#
-# Note: Should br run setuid root as user nobody.
-#
# ivan@voicenet.com 96-dec-18
#
# Changed /u to /u2
# Changes to allow page to work at a relative position in server
# Changed 'password' to '_password' because Pg6.3 reserves the password word
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.6 1999-02-28 00:03:45 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:30 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:58 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:47:59 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:27 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $svcnum $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearchs fields);
use FS::svc_acct;
-my($req) = new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum = $1;
-my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
+$old = qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
#unmunge popnum
-$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] );
+$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] );
#unmunge passwd
-if ( $req->param('_password') eq '*HIDDEN*' ) {
- $req->param('_password',$old->getfield('_password'));
+if ( $cgi->param('_password') eq '*HIDDEN*' ) {
+ $cgi->param('_password',$old->getfield('_password'));
}
-my($new) = create FS::svc_acct ( {
+$new = new FS::svc_acct ( {
map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
- shell quota slipip)
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
+ # shell quota slipip)
+ } ( fields('svc_acct'), qw( pkgnum svcpart ) )
} );
if ( $svcnum ) {
- my($error) = $new->replace($old);
- &idiot($error) if $error;
+ $error = $new->replace($old);
} else {
- my($error) = $new->insert;
- &idiot($error) if $error;
- $svcnum = $new->getfield('svcnum');
+ $error = $new->insert;
+ $svcnum = $new->svcnum;
}
-#no errors, view account
-$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum );
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding/updating account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding/updating account</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
- exit;
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum );
}
#!/usr/bin/perl -Tw
#
-# process/svc_acct_pop.cgi: Edit POP (process form)
+# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $
#
# ivan@sisd.com 98-mar-8
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.6 1999-02-07 09:59:31 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.5 1999/01/19 05:13:59 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:48:00 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:32 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:28 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $popnum $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_pop qw(fields);
-use FS::CGI qw(eidiot);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct_pop;
+use FS::CGI qw(popurl);
-my($req)=new CGI::Request; # create form object
+$cgi = new CGI; # create form object
-&cgisuidsetup($req->cgi);
+&cgisuidsetup($cgi);
-my($popnum)=$req->param('popnum');
+$popnum = $cgi->param('popnum');
-my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
+$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
-my($new)=create FS::svc_acct_pop ( {
+$new = new FS::svc_acct_pop ( {
map {
- $_, $req->param($_);
+ $_, scalar($cgi->param($_));
} fields('svc_acct_pop')
} );
if ( $popnum ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
+ $error = $new->replace($old);
} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
+ $error = $new->insert;
$popnum=$new->getfield('popnum');
}
-$req->cgi->redirect("../../browse/svc_acct_pop.cgi");
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi");
+}
#!/usr/bin/perl -Tw
#
-# process/svc_acct_sm.cgi: Add/edit a mail alias (process form)
+# $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_acct_sm.cgi
#
-# Note: Should br run setuid root as user nobody.
-#
# lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled.
#
# ivan@voicenet.com 97-jan-6
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.6 1999-02-28 00:03:46 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:32 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:00 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:48:01 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:29 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $svcnum $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
+use FS::Record qw(qsearchs fields);
use FS::svc_acct_sm;
+use FS::CGI qw(popurl);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
+$cgi = new CGI;
+cgisuidsetup($cgi);
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum =$1;
-my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
+$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
#unmunge domsvc and domuid
-$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] );
-$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] );
+#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] );
+#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] );
-my($new) = create FS::svc_acct_sm ( {
+$new = new FS::svc_acct_sm ( {
map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
+ ($_, 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 {
$svcnum = $new->getfield('svcnum');
}
-unless ($error) {
- $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum");
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string );
} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding/editing mail alias</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding/editing mail alias</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
+ print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum");
}
#!/usr/bin/perl -Tw
#
-# process/svc_domain.cgi: Add a domain (process form)
+# $Id: svc_domain.cgi,v 1.6 1999-02-28 00:03:47 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_domain.cgi
#
-# Note: Should br run setuid root as user nobody.
-#
# lots of yucky stuff in this one... bleachlkjhui!
#
# ivan@voicenet.com 97-jan-6
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.6 1999-02-28 00:03:47 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:33 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:01 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:48:02 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:30 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
use strict;
-use CGI::Request;
+use vars qw( $cgi $svcnum $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
+use FS::Record qw(qsearchs fields);
use FS::svc_domain;
+use FS::CGI qw(popurl);
#remove this to actually test the domains!
$FS::svc_domain::whois_hack = 1;
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum = $1;
-my($new) = create FS::svc_domain ( {
+$new = new FS::svc_domain ( {
map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart domain action purpose)
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart domain action purpose)
+ } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) )
} );
-my($error);
-if ($req->param('legal') ne "Yes") {
+if ($cgi->param('legal') ne "Yes") {
$error = "Customer did not agree to be bound by NSI's ".
qq!<A HREF="http://rs.internic.net/help/agreement.txt">!.
"Domain Name Resgistration Agreement</A>";
-} elsif ($req->param('svcnum')) {
+} elsif ($cgi->param('svcnum')) {
$error="Can't modify a domain!";
} else {
$error=$new->insert;
$svcnum=$new->svcnum;
}
-unless ($error) {
- $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum");
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string );
} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding domain</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding domain</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
+ print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
}
-
#!/usr/bin/perl -Tw
#
-# svc_acct.cgi: Add/edit account (output form)
+# $Id: svc_acct.cgi,v 1.9 1999-02-28 00:03:37 ivan Exp $
#
# Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
# http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
#
-# Note: Should be run setuid freeside as user nobody
-#
# ivan@voicenet.com 96-dec-18
#
# rewrite ivan@sisd.com 98-mar-8
# bmccane@maxbaud.net 98-apr-3
#
# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.9 1999-02-28 00:03:37 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/23 08:09:22 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.7 1999/02/07 09:59:22 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:43 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:32 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 23:03:22 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 06:17:08 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart
+ $part_svc $svc $otaker $username $password $ulen $ulen2 $p1
+ $popnum $uid $gid $finger $dir $shell $quota $slipip );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct qw(fields);
-
-my($shells)="/var/spool/freeside/conf/shells";
-open(SHELLS,$shells) or die "Can't open $shells: $!";
-my(@shells)=map {
- /^([\/\w]*)$/ or die "Illegal shell in conf/shells!";
- $1;
-} grep $_ !~ /^#/, <SHELLS>;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc);
-
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct) svcnum!";
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct;
+use FS::Conf;
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
+$cgi = new CGI;
+&cgisuidsetup($cgi);
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
+$conf = new FS::Conf;
+@shells = $conf->config('shells');
+if ( $cgi->param('error') ) {
+ $svc_acct = new FS::svc_acct ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct')
+ } );
+ $svcnum = $svc_acct->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=qsearchs('svc_acct',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct) svcnum!";
- $action="Edit";
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
-} else { #adding
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
- $svc_acct=create FS::svc_acct({});
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
- foreach $_ (split(/-/,$QUERY_STRING)) {
- $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;
-
- $svcnum='';
+ } else { #adding
- #set gecos
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- if ($cust_pkg) {
- my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
- $svc_acct->setfield('finger',
- $cust_main->getfield('first') . " " . $cust_main->getfield('last')
- ) ;
- }
+ $svc_acct = new FS::svc_acct({});
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
- $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
+ foreach $_ (split(/-/,$query)) {
+ $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;
+
+ $svcnum='';
+
+ #set gecos
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ if ($cust_pkg) {
+ my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
+ $svc_acct->setfield('finger',
+ $cust_main->getfield('first') . " " . $cust_main->getfield('last')
+ ) ;
}
- }
- $action="Add";
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_acct') ) {
+ if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
+ $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
+ }
+ }
+ }
}
+$action = $svcnum ? 'Edit' : 'Add';
-my($svc)=$part_svc->getfield('svc');
+$svc = $part_svc->getfield('svc');
-my($otaker)=getotaker;
+$otaker = getotaker;
-my($username,$password)=(
+($username,$password)=(
$svc_acct->username,
$svc_acct->_password ? "*HIDDEN*" : '',
);
-my($ulen)=$svc_acct->dbdef_table->column('username')->length;
-my($ulen2)=$ulen+2;
+$ulen = $svc_acct->dbdef_table->column('username')->length;
+$ulen2 = $ulen+2;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action $svc account");
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-SendHeaders();
print <<END;
-<HTML>
- <HEAD>
- <TITLE>$action $svc account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>$action $svc account</H1>
- </CENTER><HR>
- <FORM ACTION="process/svc_acct.cgi" METHOD=POST>
+ <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST>
<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
END
#pop
-my($popnum)=$svc_acct->popnum || 0;
+$popnum = $svc_acct->popnum || 0;
if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
} else {
$svc_acct_pop->popnum, ": ",
$svc_acct_pop->city, ", ",
$svc_acct_pop->state,
- "(", $svc_acct_pop->ac, ")/",
+ " (", $svc_acct_pop->ac, ")/",
$svc_acct_pop->exch, "\n"
;
}
print "</SELECT>";
}
-my($uid,$gid,$finger,$dir)=(
+($uid,$gid,$finger,$dir)=(
$svc_acct->uid,
$svc_acct->gid,
$svc_acct->finger,
<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
END
-my($shell)=$svc_acct->shell;
+$shell = $svc_acct->shell;
if ( $part_svc->svc_acct__shell_flag eq "F" ) {
print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
} else {
print "</SELECT>";
}
-my($quota,$slipip)=(
+($quota,$slipip)=(
$svc_acct->quota,
$svc_acct->slipip,
);
#!/usr/bin/perl -Tw
#
-# svc_acct_pop.cgi: Add/Edit pop (output form)
+# $Id: svc_acct_pop.cgi,v 1.8 1999-02-23 08:09:23 ivan Exp $
#
# ivan@sisd.com 98-mar-8
#
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.8 1999-02-23 08:09:23 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.7 1999/02/07 09:59:23 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:44 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:33 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 02:57:45 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:10 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/13 09:56:47 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
use strict;
-use CGI::Base;
+use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::CGI qw(header menubar popurl);
use FS::svc_acct_pop;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-
-my($svc_acct_pop,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
+if ( $cgi->param('error') ) {
+ $svc_acct_pop = new FS::svc_acct_pop ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my($query)=$cgi->keywords;
+ $query =~ /^(\d+)$/;
$svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
- $action='Edit';
} else { #adding
- $svc_acct_pop=create FS::svc_acct_pop {};
- $action='Add';
+ $svc_acct_pop = new FS::svc_acct_pop {};
}
-my($hashref)=$svc_acct_pop->hashref;
+$action = $svc_acct_pop->popnum ? 'Edit' : 'Add';
+$hashref = $svc_acct_pop->hashref;
-print header("$action POP", menubar(
- 'Main Menu' => '../',
- 'View all POPs' => "../browse/svc_acct_pop.cgi",
-)), <<END;
- <FORM ACTION="process/svc_acct_pop.cgi" METHOD=POST>
-END
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!;
#display
print <<END;
<PRE>
City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
-State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 VALUE="$hashref->{state}">
+State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}">
Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}">
Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}">
</PRE>
#!/usr/bin/perl -Tw
#
-# svc_acct_sm.cgi: Add/edit a mail alias (output form)
+# $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 ivan Exp $
#
# Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
# http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
#
# use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add
#
-# Note: Should be run setuid freeside as user nobody.
-#
# should error out in a more CGI-friendly way, and should have more error checking (sigh).
#
# ivan@voicenet.com 97-jan-5
# rewrite ivan@sisd.com 98-mar-15
#
# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.9 1999-02-28 00:03:38 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:24 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:45 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:34 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:24 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/23 02:58:45 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:11 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/12/16 05:19:15 ivan
+# use FS::Conf
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $conf $cgi $mydomain $action $svcnum $svc_acct_sm $pkgnum $svcpart
+ $part_svc $query %username %domain $p1 $domuser $domsvc $domuid );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_sm qw(fields);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct_sm;
+use FS::Conf;
-my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc);
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct_sm) svcnum!";
+$cgi = new CGI;
+&cgisuidsetup($cgi);
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
+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!";
- $action="Edit";
-
-} else { #adding
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
- $svc_acct_sm=create FS::svc_acct_sm({});
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
- foreach $_ (split(/-/,$QUERY_STRING)) { #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;
+ } else { #adding
- $svcnum='';
+ $svc_acct_sm = new FS::svc_acct_sm({});
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct_sm') ) {
- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) {
- $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
+ 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;
- $action='Add';
+ $svcnum='';
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_acct_sm') ) {
+ if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) {
+ $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
+ }
+ }
+
+ }
}
+$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add';
-my(%username,%domain);
if ($pkgnum) {
#find all possible uids (and usernames)
die "\$action eq Add, but \$pkgnum is null!\n";
}
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias $action</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Mail Alias $action</H1>
- </CENTER>
- <FORM ACTION="process/svc_acct_sm.cgi" METHOD=POST>
-END
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), 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
#svcpart
print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
-my($domuser,$domsvc,$domuid)=(
+($domuser,$domsvc,$domuid)=(
$svc_acct_sm->domuser,
$svc_acct_sm->domsvc,
$svc_acct_sm->domuid,
#domsvc
print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
foreach $_ (keys %domain) {
- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $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" : "", ">$_: $username{$_}";
+ print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "",
+ qq! VALUE="$_">$username{$_}!;
}
print "</SELECT>\@$mydomain mailbox.";
#!/usr/bin/perl -Tw
#
-# svc_domain.cgi: Add domain (output form)
+# $Id: svc_domain.cgi,v 1.9 1999-02-28 00:03:39 ivan Exp $
#
# Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart}
# http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart}
#
-# Note: Should be run setuid freeside as user nobody
-#
# ivan@voicenet.com 97-jan-5 -> 97-jan-6
#
# changes for domain template 3.5
# rewrite ivan@sisd.com 98-mar-14
#
# no GOV in instructions ivan@sisd.com 98-jul-17
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.9 1999-02-28 00:03:39 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:25 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:46 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:35 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:25 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/23 03:00:16 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:12 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/13 09:56:48 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc
+ $svc $otaker $domain $p1 $kludge_action $purpose );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_domain qw(fields);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_domain;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
-my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc);
-
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
- or die "Unknown (svc_domain) svcnum!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
+if ( $cgi->param('error') ) {
+ $svc_domain = new FS::svc_domain ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_domain')
+ } );
+ $svcnum = $svc_domain->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ $kludge_action = $cgi->param('action');
+ $purpose = $cgi->param('purpose');
+ $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ die "No part_svc entry!" unless $part_svc;
+} else {
+ $kludge_action = '';
+ $purpose = '';
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_domain) svcnum!";
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
- $action="Edit";
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
-} else { #adding
+ } else { #adding
- $svc_domain=create FS::svc_domain({});
+ $svc_domain = new FS::svc_domain({});
- foreach $_ (split(/-/,$QUERY_STRING)) {
- $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;
+ foreach $_ (split(/-/,$query)) {
+ $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;
- $svcnum='';
+ $svcnum='';
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_domain') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
- $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_domain') ) {
+ if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
+ $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
+ }
}
+
}
+}
+$action = $svcnum ? 'Edit' : 'Add';
- $action="Add";
+$svc = $part_svc->getfield('svc');
-}
+$otaker = getotaker;
-my($svc)=$part_svc->getfield('svc');
+$domain = $svc_domain->domain;
-my($otaker)=getotaker;
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action $svc", '');
-my($domain)=(
- $svc_domain->domain,
-);
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-SendHeaders();
print <<END;
-<HTML>
- <HEAD>
- <TITLE>$action $svc</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>$action $svc</H1>
- </CENTER><HR>
- <FORM ACTION="process/svc_domain.cgi" METHOD=POST>
+ <FORM ACTION="${p1}process/svc_domain.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="radio" NAME="action" VALUE="N">New
- <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer
+END
+print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!;
+print ' CHECKED' if $kludge_action eq 'N';
+print qq!>New!;
+print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!;
+print ' CHECKED' if $kludge_action eq 'M';
+print qq!>Transfer!;
+
+print <<END;
<P>Customer agrees to be bound by NSI's
<A HREF="http://rs.internic.net/help/agreement.txt">
Domain Name Registration Agreement</A>
<SELECT NAME="legal" SIZE=1><OPTION SELECTED>No<OPTION>Yes</SELECT>
<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26>
-<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64>
+<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64>
<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
<UL>
<LI>COM is for commercial, for-profit organziations
</UL>
US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain
and registration procedures.
-<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
+<!-- <P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
+!-->
</FORM>
</BODY>
</HTML>
</td></tr>
</table>
<A HREF="http://www.sisd.com/freeside">
- Information
+ Freeside home page
</A>
<BR><A HREF="docs/">
Documentation
</A>
</P>
<HR>
- <H3><A HREF="edit/cust_main.cgi">New Customer</A></H3>
- <A NAME="search"><H3>Search</H3></A>
- <MENU>
+ <ul>
+ <li><A HREF="edit/cust_main.cgi">New Customer</A>
+ <li><A NAME="search">Search</A>
+ <ul>
<LI><A HREF="search/cust_main.html">
customers (by last name and/or company)
</A>
<LI><A HREF="search/svc_domain.html">domains (by domain)</A>
<LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>
<LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A>
- </MENU>
- <A NAME="browse"><H3>Browse</H3></A>
- <MENU>
+ </ul>
+ <li><A NAME="browse">Browse</A>
+ <ul>
<LI><A HREF="search/cust_main.cgi?custnum">customers (by customer number)</A>
<LI><A HREF="search/cust_main.cgi?last">customers (by last name)</A>
<LI><A HREF="search/cust_main.cgi?company">customers (by company)</A>
<LI><A HREF="search/svc_domain.cgi?domain">domains (by domain)</A>
<LI><A HREF="search/svc_domain.cgi?UN_svcnum">unlinked domains (by service number)</A>
<LI><A HREF="search/svc_domain.cgi?UN_domain">unlinked domains (by domain)</A>
- </MENU>
- <A NAME="admin"><H3>Administration</H3></a>
- <MENU>
+ </ul>
+ <li><A NAME="admin">Administration</a>
+ <ul>
<LI><A HREF="browse/part_svc.cgi">
- View/Edit services
+ View/Edit service definitions
</A>
- Services are items you offer to your customers.
<LI><A HREF="browse/part_pkg.cgi">
- View/Edit packages
+ View/Edit package definitions
</A>
- One or more services are grouped together into a package and
given pricing information. Customers purchase packages, not
<LI><A HREF="browse/agent_type.cgi">
View/Edit agent types
</A>
- - Agent types define groups of packages that you can then assign
- to particular agents.
+ - Agent types define groups of package definitions that you can
+ then assign to particular agents.
<LI><A HREF="browse/agent.cgi">
View/Edit agents
</A>
- Agents are resellers of your service. Agents may be limited
- to a subset of your full offerings (via their agent type).
- <BR>
+ to a subset of your full offerings (via their type).
<LI><A HREF="browse/part_referral.cgi">
View/Edit referrals
</A>
- Where a customer heard about your service. Tracked for
informational purposes.
- <BR>
<LI><A HREF="browse/cust_main_county.cgi">
View/Edit locales and tax rates
</A>
- - Change tax rates by state, or break down a state into counties
- and assign different tax rates to each county.
- <BR>
+ - Change tax rates, or break down a country into states, or a state
+ into counties and assign different tax rates to each.
<LI><A HREF="browse/svc_acct_pop.cgi">
View/Edit POPs
</A>
- Points of Presence
- </MENU>
- </FONT>
+ </ul>
+ </ul>
</BODY>
</HTML>
#!/usr/bin/perl -Tw
#
+# $Id: bill.cgi,v 1.4 1999-01-19 05:14:02 ivan Exp $
+#
# s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: bill.cgi,v $
+# Revision 1.4 1999-01-19 05:14:02 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:01:13 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:41 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $cgi $query $custnum $cust_main $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
-use FS::Bill;
+use FS::cust_main;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint custnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$custnum = $1;
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
die "Can't find customer!\n" unless $cust_main;
-# ?
-bless($cust_main,"FS::Bill");
-
-my($error);
-
$error = $cust_main->bill(
# 'time'=>$time
);
-&idiot($error) if $error;
+&eidiot($error) if $error;
$error = $cust_main->collect(
# 'invoice-time'=>$time,
'batch_card'=> 'no',
'report_badcard'=> 'yes',
);
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error billing customer</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error billing customer</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
+&eidiot($error) if $error;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
#!/usr/bin/perl -Tw
#
-# cancel-unaudited.cgi: Cancel an unaudited account
+# $Id: cancel-unaudited.cgi,v 1.6 1999-02-28 00:03:48 ivan Exp $
#
# Usage: cancel-unaudited.cgi svcnum
# http://server.name/path/cancel-unaudited.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# ivan@voicenet.com 97-apr-23
#
# rewrote for new API
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cancel-unaudited.cgi,v $
+# Revision 1.6 1999-02-28 00:03:48 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:34 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:03 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:05 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:42 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_svc;
use FS::svc_acct;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
-my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-&idiot("Unknown svcnum!") unless $svc_acct;
+$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum!" unless $svc_acct;
-my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum});
-&idiot(qq!This account has already been audited. Cancel the
- <A HREF="../view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+&eidiot(qq!This account has already been audited. Cancel the
+ <A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
qq!pkgnum"> package</A> instead.!)
if $cust_svc->getfield('pkgnum') ne '';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
-my($error);
-
-bless($svc_acct,"FS::svc_acct");
$error = $svc_acct->cancel;
-&idiot($error) if $error;
+&eidiot($error) if $error;
$error = $svc_acct->delete;
-&idiot($error) if $error;
+&eidiot($error) if $error;
-bless($cust_svc,"FS::cust_svc");
$error = $cust_svc->delete;
-&idiot($error) if $error;
-
-$cgi->redirect("../");
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error cancelling account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error cancelling account</H1>
- </CENTER>
- <HR>
- There has been an error cancelling this acocunt: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2));
#!/usr/bin/perl -Tw
#
-# cancel_pkg.cgi: Cancel a package
+# $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
#
# Usage: cancel_pkg.cgi pkgnum
# http://server.name/path/cancel_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!!
#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cancel_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:49 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:04 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:54 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:43 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw ( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(eidiot popurl);
use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
use FS::cust_pkg;
-use FS::CGI qw(idiot);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->cancel;
-idiot($error) if $error;
+$error = $cust_pkg->cancel;
+eidiot($error) if $error;
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
#!/usr/bin/perl -Tw
#
-# expire_pkg.cgi: Expire a package
+# $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/expire_pkg.cgi
#
-# Note: Should be run setuid freeside as user nobody
-#
# based on susp_pkg
# ivan@voicenet.com 97-jul-29
#
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: expire_pkg.cgi,v $
+# Revision 1.4 1999-02-28 00:03:50 ivan
+# removed misleading comments
+#
+# Revision 1.3 1999/01/19 05:14:05 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:12:44 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
+use vars qw ( $cgi $date $pkgnum $cust_pkg %hash $new $error );
use Date::Parse;
-use CGI::Request;
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_pkg;
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
#untaint date & pkgnum
-my($date);
-if ( $req->param('date') ) {
- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
+if ( $cgi->param('date') ) {
+ str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
$date=$1;
} else {
$date='';
}
-$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
-my($pkgnum)=$1;
+$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
+$pkgnum = $1;
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my(%hash)=$cust_pkg->hash;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+%hash = $cust_pkg->hash;
$hash{expire}=$date;
-my($new)=create FS::cust_pkg ( \%hash );
-my($error) = $new->replace($cust_pkg);
-&idiot($error) if $error;
-
-$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$new = new FS::cust_pkg ( \%hash );
+$error = $new->replace($cust_pkg);
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error expiring package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error expiring package</H1>
- </CENTER>
- <HR>
- There has been an error expiring this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
#!/usr/bin/perl -Tw
#
-# link: instead of adding a new account, link to an existing. (output form)
-#
-# Note: Should be run setuid freeside as user nobody
+# $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $
#
# ivan@voicenet.com 97-feb-5
#
# rewrite ivan@sisd.com 98-mar-17
#
# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
+#
+# $Log: link.cgi,v $
+# Revision 1.7 1999-04-08 11:31:40 ivan
+# *** empty log message ***
+#
+# Revision 1.6 1999/02/28 00:03:51 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/19 05:14:06 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:36 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/23 03:03:39 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:45 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb
+ $link_field );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header);
use FS::Record qw(qsearchs);
-my(%link_field)=(
+%link_field = (
'svc_acct' => 'username',
'svc_domain' => 'domain',
'svc_acct_sm' => '',
'svc_wo' => '',
);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-my($pkgnum,$svcpart);
-foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
+($query) = $cgi->keywords;
+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});
-my($svc) = $part_svc->getfield('svc');
-my($svcdb) = $part_svc->getfield('svcdb');
-my($link_field) = $link_field{$svcdb};
+$part_svc = qsearchs('part_svc',{'svcpart'=>$svcpart});
+$svc = $part_svc->getfield('svc');
+$svcdb = $part_svc->getfield('svcdb');
+$link_field = $link_field{$svcdb};
-CGI::Base::SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Link to existing $svc account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Link to existing $svc account</H1>
- </CENTER><HR>
- <FORM ACTION="process/link.cgi" METHOD=POST>
-END
+print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"),
+ qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
if ( $link_field ) {
print <<END;
#!/usr/bin/perl -Tw
#
+# $Id: print-invoice.cgi,v 1.4 1999-01-19 05:14:07 ivan Exp $
+#
# just a kludge for now, since this duplicates in a way it shouldn't stuff from
# Bill.pm (like $lpr) ivan@sisd.com 98-jun-16
+#
+# $Log: print-invoice.cgi,v $
+# Revision 1.4 1999-01-19 05:14:07 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:24 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:47 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($lpr) = "|lpr -h";
+use FS::cust_bill;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
+$conf = new FS::Conf;
+$lpr = $conf->config('lpr');
+
#untaint invnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($invnum)=$1;
-my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$invnum = $1;
+$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
die "Can't find invoice!\n" unless $cust_bill;
- bless($cust_bill,"FS::Invoice");
- open(LPR,$lpr) or die "Can't open $lpr: $!";
+ open(LPR,"|$lpr") or die "Can't open $lpr: $!";
print LPR $cust_bill->print_text; #( date )
close LPR
or die $! ? "Error closing $lpr: $!"
: "Exit status $? from $lpr";
-my($custnum)=$cust_bill->getfield('custnum');
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error printing invoice</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error printing invoice</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
-
-}
+$custnum = $cust_bill->getfield('custnum');
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
#!/usr/bin/perl -Tw
#
-# process/link.cgi: link to existing customer (process form)
+# $Id: link.cgi,v 1.4 1999-02-07 09:59:35 ivan Exp $
#
# ivan@voicenet.com 97-feb-5
#
# bmccane@maxbaud.net 98-apr-3
#
# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
+#
+# $Log: link.cgi,v $
+# Revision 1.4 1999-02-07 09:59:35 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.3 1999/01/19 05:14:10 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:15:00 ivan
+# s/CGI::Request/CGI.pm/;
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $old $new $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
-use FS::CGI qw(idiot);
+use FS::CGI qw(popurl idiot);
use FS::UID qw(cgisuidsetup);
use FS::cust_svc;
use FS::Record qw(qsearchs);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-#$req->import_names('R'); #import CGI variables into package 'R';
+$cgi = new CGI;
+cgisuidsetup($cgi);
-$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
-$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
+$cgi->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
+$cgi->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
-$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
+$cgi->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
unless ( $svcnum ) {
my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
my($svcdb) = $part_svc->getfield('svcdb');
- $req->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
- my($svc_acct)=qsearchs($svcdb,{$link_field => $req->param('link_value') });
- idiot("$link_field not found!") unless $svc_acct;
+ $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
+ my($svc_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') });
+ eidiot("$link_field not found!") unless $svc_acct;
$svcnum=$svc_acct->svcnum;
}
-my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
die "svcnum not found!" unless $old;
-my($new)=create FS::cust_svc ({
+$new = new FS::cust_svc ({
'svcnum' => $svcnum,
'pkgnum' => $pkgnum,
'svcpart' => $svcpart,
});
-my($error);
$error = $new->replace($old);
unless ($error) {
#no errors, so let's view this customer.
- $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum");
+ print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum");
} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
+ idiot($error);
}
#!/usr/bin/perl -Tw
#
-# susp_pkg.cgi: Suspend a package
+# $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
#
# Usage: susp_pkg.cgi pkgnum
# http://server.name/path/susp_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
#
# ivan@voicenet.com 97-feb-27
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: susp_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:52 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:08 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:56 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:48 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
use FS::cust_pkg;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->suspend;
-&idiot($error) if $error;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$error = $cust_pkg->suspend;
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error suspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error suspending package</H1>
- </CENTER>
- <HR>
- There has been an error suspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
#!/usr/bin/perl -Tw
#
-# susp_pkg.cgi: Unsuspend a package
+# $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $
#
# Usage: susp_pkg.cgi pkgnum
# http://server.name/path/susp_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
#
# ivan@voicenet.com 97-feb-27
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: unsusp_pkg.cgi,v $
+# Revision 1.5 1999-02-28 00:03:53 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:09 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:05:25 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:49 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_pkg;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->unsuspend;
-&idiot($error) if $error;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$error = $cust_pkg->unsuspend;
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error unsuspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error unsuspending package</H1>
- </CENTER>
- <HR>
- There has been an error unsuspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
#!/usr/bin/perl -Tw
#
-# cust_bill.cgi: Search for invoices (process form)
+# $Id: cust_bill.cgi,v 1.4 1999-02-28 00:03:54 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/cust_bill.cgi
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 97-apr-4
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_bill.cgi,v $
+# Revision 1.4 1999-02-28 00:03:54 ivan
+# removed misleading comments
+#
+# Revision 1.3 1999/01/19 05:14:11 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:41:07 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $invnum );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl idiot);
use FS::Record qw(qsearchs);
-my($req)=new CGI::Request;
-cgisuidsetup($req->cgi);
+$cgi = new CGI;
+cgisuidsetup($cgi);
-$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
-my($invnum)=$2;
+$cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
+$invnum = $2;
if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
- $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect
+ print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect
} else { #error
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Invoice Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Invoice Search Error</H3>
- <HR>
- Invoice not found.
- </CENTER>
- </BODY>
-</HTML>
-END
-
+ idiot("Invoice not found.");
}
<HEAD>
<TITLE>Customer Search</TITLE>
</HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
+ <BODY BGCOLOR="#ffffff">
+ <FONT COLOR="#ff0000" SIZE=7>
+ Customer Search
+ </FONT>
+ <BR>
<FORM ACTION="cust_main.cgi" METHOD="post">
Search for <B>Credit card #</B>:
<INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
<P><INPUT TYPE="submit" VALUE="Search">
</FORM>
- <HR>
</BODY>
</HTML>
#!/usr/bin/perl -Tw
#
-# process/cust_main.cgi: Search for customers (process form)
+# $Id: cust_main.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/cust_main.cgi
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 96-dec-12
#
# rewrite ivan@sisd.com 98-mar-4
# bmccane@maxbaud.net 98-apr-3
#
# display total, use FS::CGI ivan@sisd.com 98-jul-17
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.11 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/02/28 00:03:55 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:36 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/25 12:19:11 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:14:12 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:37 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 00:57:50 ivan
+# bug
+#
+# Revision 1.3 1998/12/17 09:41:08 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/12 08:10:22 ivan
+# CGI.pm instead of CGI-modules
+# relative URLs using popurl
+# got rid of lots of little tables
+# s/agrep/String::Approx/;
+# bubble up packages and services and link (slow)
+#
use strict;
-use CGI::Request;
+use vars qw(%ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use IO::Handle;
-use IPC::Open2;
+use String::Approx qw(amatch);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep
- #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!)
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my(@cust_main);
-my($sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-if ( $query eq 'custnum' ) {
- $sortby=\*custnum_sort;
- @cust_main=qsearch('cust_main',{});
-} elsif ( $query eq 'last' ) {
- $sortby=\*last_sort;
- @cust_main=qsearch('cust_main',{});
-} elsif ( $query eq 'company' ) {
- $sortby=\*company_sort;
- @cust_main=qsearch('cust_main',{});
+use FS::CGI qw(header menubar eidiot popurl table);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+if ( $cgi->keywords ) {
+ my($query)=$cgi->keywords;
+ if ( $query eq 'custnum' ) {
+ $sortby=\*custnum_sort;
+ @cust_main=qsearch('cust_main',{});
+ } elsif ( $query eq 'last' ) {
+ $sortby=\*last_sort;
+ @cust_main=qsearch('cust_main',{});
+ } elsif ( $query eq 'company' ) {
+ $sortby=\*company_sort;
+ @cust_main=qsearch('cust_main',{});
+ }
} else {
- &cardsearch if ($req->param('card_on') );
- &lastsearch if ($req->param('last_on') );
- &companysearch if ($req->param('company_on') );
+ &cardsearch if ( $cgi->param('card_on') && $cgi->param('card') );
+ &lastsearch if ( $cgi->param('last_on') && $cgi->param('last_text') );
+ &companysearch if ( $cgi->param('company_on') && $cgi->param('company_text') );
}
+#%ncancelled_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main;
+%all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main;
+
if ( scalar(@cust_main) == 1 ) {
- $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum);
+ print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum);
exit;
} elsif ( scalar(@cust_main) == 0 ) {
- idiot "No matching customers found!\n";
- exit;
+ eidiot "No matching customers found!\n";
} else {
my($total)=scalar(@cust_main);
- CGI::Base::SendHeaders(); # one guess
- print header("Customer Search Results",''), <<END;
-
- $total matching customers found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
+ print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar(
+ 'Main Menu', popurl(2)
+ )), "$total matching customers found<BR>", &table(), <<END;
<TR>
- <TH>Cust. #</TH>
+ <TH></TH>
<TH>Contact name</TH>
<TH>Company</TH>
+ <TH>Packages</TH>
+ <TH COLSPAN=2>Services</TH>
</TR>
END
- my($lines)=16;
- my($lcount)=$lines;
my(%saw,$cust_main);
foreach $cust_main (
sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
$cust_main->getfield('first'),
$cust_main->company,
);
+
+ my(@lol_cust_svc);
+ my($rowspan)=0;#scalar( @{$all_pkgs{$custnum}} );
+ foreach ( @{$all_pkgs{$custnum}} ) {
+ my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
+ push @lol_cust_svc, \@cust_svc;
+ $rowspan += scalar(@cust_svc) || 1;
+ }
+
+ #my($rowspan) = scalar(@{$all_pkgs{$custnum}});
+ my($view) = popurl(2). "view/cust_main.cgi?$custnum";
print <<END;
<TR>
- <TD><A HREF="../view/cust_main.cgi?$custnum"><FONT SIZE=-1>$custnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$last, $first</FONT></TD>
- <TD><FONT SIZE=-1>$company</FONT></TD>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Cust. #</TH>
- <TH>Contact name</TH>
- <TH>Company<TH>
- </TR>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$custnum</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$last, $first</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD>
END
+
+ my($n1)='';
+ foreach ( @{$all_pkgs{$custnum}} ) {
+ my($pkgnum) = ($_->pkgnum);
+ my($pkg) = $_->part_pkg->pkg;
+ my $comment = $_->part_pkg->comment;
+ my($pkgview) = popurl(2). "/view/cust_pkg.cgi?$pkgnum";
+ #my(@cust_svc) = shift @lol_cust_svc;
+ my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
+ my($rowspan) = scalar(@cust_svc) || 1;
+
+ print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview"><FONT SIZE=-1>$pkg - $comment</FONT></A></TD>!;
+ my($n2)='';
+ foreach my $cust_svc ( @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my($svcnum) = $cust_svc->svcnum;
+ my($sview) = popurl(2). "/view";
+ print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
+ qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!;
+ $n2="</TR><TR>";
+ }
+ #print qq!</TR><TR>\n!;
+ $n1="</TR><TR>";
}
+ print "<\TR>";
}
print <<END;
</TABLE>
- </CENTER>
</BODY>
</HTML>
END
}
sub company_sort {
+ return -1 if $a->company && ! $b->company;
+ return 1 if ! $a->company && $b->company;
$a->getfield('company') cmp $b->getfield('company');
}
sub cardsearch {
- my($card)=$req->param('card');
+ my($card)=$cgi->param('card');
$card =~ s/\D//g;
- $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; };
+ $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n";
my($payinfo)=$1;
push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
sub lastsearch {
my(%last_type);
- foreach ( $req->param('last_type') ) {
+ foreach ( $cgi->param('last_type') ) {
$last_type{$_}++;
}
- $req->param('last_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal last name"; exit; };
+ $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/
+ or eidiot "Illegal last name";
my($last)=$1;
if ( $last_type{'Exact'}
my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
if ($last_type{'Fuzzy'}) {
- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
- substr($last,0,30));
- print $writer join("\n",@all_last),"\n";
- close $writer;
- while (<$reader>) {
- chop;
- $last{$_}++;
- }
- close $reader;
+ foreach ( amatch($last, [ qw(i) ], @all_last) ) {
+ $last{$_}++;
+ }
}
#if ($last_type{'Sound-alike'}) {
sub companysearch {
my(%company_type);
- foreach ( $req->param('company_type') ) {
+ foreach ( $cgi->param('company_type') ) {
$company_type{$_}++
};
- $req->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal company"; exit; };
+ $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/
+ or eidiot "Illegal company";
my($company)=$1;
if ( $company_type{'Exact'}
my(@all_company)=map $_->company, qsearch('cust_main',{});
if ($company_type{'Fuzzy'}) {
- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
- substr($company,0,30));
- print $writer join("\n",@all_company),"\n";
- close $writer;
- while (<$reader>) {
- chop;
+ foreach ( amatch($company, [ qw(i) ], @all_company ) ) {
$company{$_}++;
}
- close $reader;
}
#if ($company_type{'Sound-alike'}) {
<HEAD>
<TITLE>Customer Search</TITLE>
</HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
+ <BODY BGCOLOR="#ffffff">
+ <FONT COLOR="#ff0000" SIZE=7>
+ Customer Search
+ </FONT>
+ <BR>
<FORM ACTION="cust_main.cgi" METHOD="post">
- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
+ <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
<INPUT TYPE="text" NAME="last_text">
- using search method(s): <SELECT NAME="last_type" MULTIPLE>
+ using search method: <SELECT NAME="last_type">
<OPTION SELECTED>Fuzzy
<OPTION>Exact
</SELECT>
- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
+ <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
<INPUT TYPE="text" NAME="company_text">
- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
+ using search methods: <SELECT NAME="company_type">
<OPTION SELECTED>Fuzzy
<OPTION>Exact
</SELECT>
#!/usr/bin/perl -Tw
#
-# cust_pkg.cgi: search/browse for packages
+# $Id: cust_pkg.cgi,v 1.8 1999-02-09 09:22:57 ivan Exp $
#
# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.8 1999-02-09 09:22:57 ivan
+# visual and bugfixes
+#
+# Revision 1.7 1999/02/07 09:59:37 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:13 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:38 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1999/01/18 09:22:33 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/23 03:05:59 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:09 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi @cust_pkg $sortby $query );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
+use FS::CGI qw(header eidiot popurl);
+use FS::cust_pkg;
+use FS::pkg_svc;
+use FS::cust_svc;
+use FS::cust_main;
-my(@cust_pkg,$sortby);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my($query)=$req->cgi->var('QUERY_STRING');
+($query) = $cgi->keywords;
#this tree is a little bit redundant
if ( $query eq 'pkgnum' ) {
$sortby=\*pkgnum_sort;
if ( scalar(@cust_pkg) == 1 ) {
my($pkgnum)=$cust_pkg[0]->pkgnum;
- $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum");
+ print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum");
exit;
} elsif ( scalar(@cust_pkg) == 0 ) { #error
- &idiot("No packages found");
- exit;
+ eidiot("No packages found");
} else {
my($total)=scalar(@cust_pkg);
- CGI::Base::SendHeaders(); # one guess
- print header('Package Search Results',''), <<END;
+ print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END;
$total matching packages found
<TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
<TR>
<TH>Package #</TH>
<TH>Customer #</TH>
- <TH>Name</TH>
+ <TH>Contact name</TH>
<TH>Company</TH>
</TR>
END
- my($lines)=16;
- my($lcount)=$lines;
my(%saw,$cust_pkg);
foreach $cust_pkg (
sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
$cust_main->last. ', '. $cust_main->first,
$cust_main->company,
);
+ my $p = popurl(2);
print <<END;
<TR>
- <TD><A HREF="../view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$custnum</FONT></TD>
- <TD><FONT SIZE=-1>$name</FONT></TD>
- <TD><FONT SIZE=-1>$company</FONT></TD>
+ <TD><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$custnum</A></FONT></TD>
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$name</A></FONT></TD>
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$company</A></FONT></TD>
</TR>
END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Package #</TH>
- <TH>Customer #</TH>
- <TH>Name</TH>
- <TH>Company</TH>
- <TH>
- </TR>
-END
- }
+
}
print <<END;
</TABLE>
- </CENTER>
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# svc_acct.cgi: Search for customers (process form)
+# $Id: svc_acct.cgi,v 1.9 1999-04-10 01:53:18 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_acct.cgi
# use FS::CGI, show total ivan@sisd.com 98-jul-17
#
# give service and customer info too ivan@sisd.com 98-aug-16
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.9 1999-04-10 01:53:18 ivan
+# oops, search usernames limited to 8 chars
+#
+# Revision 1.8 1999/04/09 23:43:29 ivan
+# just in case
+#
+# Revision 1.7 1999/02/07 09:59:38 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:14 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:39 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1999/01/18 09:22:34 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/23 03:06:28 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:10 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
-use CGI::Request; # form processing module
+use vars qw( $cgi @svc_acct $sortby $query );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
+use FS::CGI qw(header eidiot popurl);
+use FS::svc_acct;
+use FS::cust_main;
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my(@svc_acct,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
+($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
#this tree is a little bit redundant
if ( $query eq 'svcnum' ) {
$sortby=\*svcnum_sort;
'pkgnum' => '',
}), qsearch('svc_acct',{});
} else {
+ $sortby=\*uid_sort;
&usernamesearch;
}
if ( scalar(@svc_acct) == 1 ) {
my($svcnum)=$svc_acct[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect
+ print $cgi->redirect(popurl(2). "view/svc_acct.cgi?$svcnum"); #redirect
exit;
} elsif ( scalar(@svc_acct) == 0 ) { #error
- idiot("Account not found");
- exit;
+ eidiot("Account not found");
} else {
my($total)=scalar(@svc_acct);
- CGI::Base::SendHeaders(); # one guess
- print header("Account Search Results",''), <<END;
+ print $cgi->header( '-expires' => 'now' ), header("Account Search Results",''), <<END;
$total matching accounts found
<TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
<TR>
</TR>
END
- my($lines)=16;
- my($lcount)=$lines;
my(%saw,$svc_acct);
+ my $p = popurl(2);
foreach $svc_acct (
sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct)
) {
$cust_svc->pkgnum ? $cust_main->company : '',
);
my($pcustnum) = $custnum
- ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
+ ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
: "<I>(unlinked)</I>"
;
- my($pname) = $custnum ? "$last, $first" : '';
+ my($pname) = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$last, $first</A>" : '';
+ my $pcompany = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$company</A>" : '';
print <<END;
<TR>
- <TD><A HREF="../view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
+ <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
<TD><FONT SIZE=-1>$username</FONT></TD>
<TD><FONT SIZE=-1>$uid</FONT></TD>
<TD><FONT SIZE=-1>$svc</FONT></TH>
<TD><FONT SIZE=-1>$pcustnum</FONT></TH>
<TD><FONT SIZE=-1>$pname<FONT></TH>
- <TD><FONT SIZE=-1>$company</FONT></TH>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Userame</TH>
- <TH>UID</TH>
- <TH>Service</TH>
- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
+ <TD><FONT SIZE=-1>$pcompany</FONT></TH>
</TR>
END
- }
+
}
print <<END;
sub usernamesearch {
- $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text
+ $cgi->param('username') =~ /^([\w\d\-]+)$/; #untaint username_text
my($username)=$1;
@svc_acct=qsearch('svc_acct',{'username'=>$username});
#!/usr/bin/perl -Tw
#
-# svc_acct_sm.cgi: Search for domains (process form)
+# $Id: svc_acct_sm.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_domain.cgi
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 96-mar-5
#
# need to look at table in results to make it more readable
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.9 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.8 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.7 1999/02/28 00:03:56 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/02/09 09:22:58 ivan
+# visual and bugfixes
+#
+# Revision 1.5 1999/01/19 05:14:16 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:40 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 09:41:11 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
+use vars qw( $conf $cgi $mydomain $domuser $svc_domain $domsvc @svc_acct_sm );
use CGI::Request;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl idiot header table);
use FS::Record qw(qsearch qsearchs);
+use FS::Conf;
+use FS::svc_domain;
+use FS::svc_acct_sm;
+use FS::svc_acct;
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
-$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
-my($domuser)=$1;
+$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
+$domuser = $1;
-$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
-my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
+$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
+$svc_domain = qsearchs('svc_domain',{'domain'=>$1})
or die "Unknown domain";
-my($domsvc)=$svc_domain->svcnum;
+$domsvc = $svc_domain->svcnum;
-my(@svc_acct_sm);
if ($domuser) {
@svc_acct_sm=qsearch('svc_acct_sm',{
'domuser' => $domuser,
if ( scalar(@svc_acct_sm) == 1 ) {
my($svcnum)=$svc_acct_sm[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect
+ print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum");
} elsif ( scalar(@svc_acct_sm) > 1 ) {
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search Results</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Mail Alias Search Results</H4>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
+ print $cgi->header( '-expires' => 'now' ),
+ header('Mail Alias Search Results'),
+ &table(), <<END;
<TR>
- <TH>Mail to<BR><FONT SIZE=-2>(click here to view mail alias)</FONT></TH>
- <TH>Forwards to<BR><FONT SIZE=-2>(click here to view account)</FONT></TH>
+ <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
$svc_acct_sm->domuid,
$svc_acct_sm->domsvc,
);
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
- my($domain)=$svc_domain->domain;
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
- my($username)=$svc_acct->username;
- my($svc_acct_svcnum)=$svc_acct->svcnum;
-
- print <<END;
-<TR>\n <TD> <A HREF="../view/svc_acct_sm.cgi?$svcnum">
-END
-
- print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
- print <<END;
-\@$domain</A> </TD>\n
-<TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n </TR>\n
-END
+ 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 <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
+ print '</TABLE></BODY></HTML>';
} else { #error
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Mail Alias Search Error</H3>
- <HR>
- Mail Alias not found.
- </CENTER>
- </BODY>
-</HTML>
-END
-
+ idiot("Mail Alias not found");
}
#!/usr/bin/perl -Tw
#
-# svc_domain.cgi: Search for domains (process form)
+# $Id: svc_domain.cgi,v 1.8 1999-02-28 00:03:57 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/svc_domain.cgi
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 97-mar-5
#
# rewrite ivan@sisd.com 98-mar-14
# bmccane@maxbaud.net 98-apr-3
#
# display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.8 1999-02-28 00:03:57 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/02/23 08:09:24 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.6 1999/02/09 09:22:59 ivan
+# visual and bugfixes
+#
+# Revision 1.5 1999/02/07 09:59:39 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:17 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:06:50 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:12 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi @svc_domain $sortby $query $conf $mydomain );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
+use FS::CGI qw(header eidiot popurl);
+use FS::svc_domain;
+use FS::cust_svc;
+use FS::svc_acct_sm;
+use FS::svc_acct;
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
-my(@svc_domain);
-my($sortby);
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
-my($query)=$req->cgi->var('QUERY_STRING');
+($query)=$cgi->keywords;
if ( $query eq 'svcnum' ) {
$sortby=\*svcnum_sort;
@svc_domain=qsearch('svc_domain',{});
'pkgnum' => '',
}), qsearch('svc_domain',{});
} else {
- $req->param('domain') =~ /^([\w\-\.]+)$/;
+ $cgi->param('domain') =~ /^([\w\-\.]+)$/;
my($domain)=$1;
push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
}
if ( scalar(@svc_domain) == 1 ) {
- $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum);
+ print $cgi->redirect(popurl(2). "view/svc_domain.cgi?". $svc_domain[0]->svcnum);
exit;
} elsif ( scalar(@svc_domain) == 0 ) {
- idiot "No matching domains found!\n";
- exit;
+ eidiot "No matching domains found!\n";
} else {
- CGI::Base::SendHeaders(); # one guess
my($total)=scalar(@svc_domain);
- CGI::Base::SendHeaders(); # one guess
- print header("Domain Search Results",''), <<END;
+ print $cgi->header, header("Domain Search Results",''), <<END;
$total matching domains found
<TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
<TR>
<TH>Service #</TH>
<TH>Domain</TH>
- <TH></TH>
+ <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($lines)=16;
- my($lcount)=$lines;
my(%saw,$svc_domain);
+ my $p = popurl(2);
foreach $svc_domain (
sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain)
) {
$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='';
- }
+ #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='';
+ #}
+
+ my @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $svcnum});
+ my $rowspan = scalar(@svc_acct_sm) || 1;
+
print <<END;
<TR>
- <TD><A HREF="../view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$domain</FONT></TD>
- <TD><FONT SIZE=-1>$malias</FONT></TD>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Domain</TH>
- <TH></TH>
- </TR>
+ <TD ROWSPAN=$rowspan><A HREF="${p}view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
+ <TD ROWSPAN=$rowspan>$domain</TD>
END
+
+ my $n1 = '';
+ # false laziness: this was stolen from search/svc_acct_sm.cgi. but the
+ # web interface in general needs to be rewritten in a mucho cleaner way
+ 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!$n1<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 "$n1<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>";
+ }
+ $n1 = "</TR><TR>";
}
+ #end of false laziness
+ print "</TR>";
+
}
print <<END;
</TABLE>
- </CENTER>
</BODY>
</HTML>
END
#!/usr/bin/perl -Tw
#
-# Usage: cust_bill.cgi invnum
-# http://server.name/path/cust_bill.cgi?invnum
-#
-# Note: Should be run setuid freeside as user nobody.
+# $Id: cust_bill.cgi,v 1.8 1999-02-28 00:03:58 ivan Exp $
#
# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
#
# bmccane@maxbaud.net 98-apr-3
#
# also print 'printed' field ivan@sisd.com 98-jul-10
+#
+# $Log: cust_bill.cgi,v $
+# Revision 1.8 1999-02-28 00:03:58 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/25 12:26:03 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:14:18 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:42 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 23:03:33 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/23 03:07:49 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:57:20 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
use strict;
+use vars qw ( $cgi $query $invnum $cust_bill $custnum $printed $p );
use IO::File;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl menubar);
use FS::Record qw(qsearchs);
-use FS::Invoice;
+use FS::cust_bill;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$invnum = $1;
-my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum});
+$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
die "Invoice #$invnum not found!" unless $cust_bill;
-my($custnum) = $cust_bill->getfield('custnum');
+$custnum = $cust_bill->getfield('custnum');
-my($printed) = $cust_bill->printed;
+$printed = $cust_bill->printed;
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Invoice View</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Invoice View</H1>
- <A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | <A HREF="../">Main menu</A>
- </CENTER><HR>
- <BASEFONT SIZE=3>
- <CENTER>
- <A HREF="../edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A>
- <BR><A HREF="../misc/print-invoice.cgi?$invnum">Reprint this invoice</A>
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Invoice View', menubar(
+ "Main Menu" => $p,
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+)), <<END;
+ <A HREF="${p}edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A>
+ <BR><A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A>
<BR><BR>(Printed $printed times)
- </CENTER>
- <FONT SIZE=-1><PRE>
+ <PRE>
END
-bless($cust_bill,"FS::Invoice");
print $cust_bill->print_text;
#formatting
#!/usr/bin/perl -Tw
#
-# cust_main.cgi: View a customer
+# $Id: cust_main.cgi,v 1.16 1999-04-09 04:22:34 ivan Exp $
#
# Usage: cust_main.cgi custnum
# http://server.name/path/cust_main.cgi?custnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# the payment history section could use some work, see below
#
# ivan@voicenet.com 96-nov-29 -> 96-dec-11
# bmccane@maxbaud.net 98-apr-3
#
# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.16 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.15 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.14 1999/04/08 04:04:37 ivan
+# eliminate double // in links
+#
+# Revision 1.13 1999/02/28 00:04:00 ivan
+# removed misleading comments
+#
+# Revision 1.12 1999/02/07 09:59:40 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.11 1999/01/25 12:26:04 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.10 1999/01/19 05:14:19 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.9 1999/01/18 09:41:43 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.8 1999/01/18 09:22:35 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.7 1998/12/30 23:03:34 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.6 1998/12/23 02:42:33 ivan
+# remove double '/' in link urls
+#
+# Revision 1.5 1998/12/23 02:36:28 ivan
+# use FS::cust_refund; to eliminate warning
+#
+# Revision 1.4 1998/12/17 09:57:21 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.3 1998/11/15 13:14:20 ivan
+# first pass as per-customer custom pricing
+#
+# Revision 1.2 1998/11/13 11:28:08 ivan
+# s/CGI-modules/CGI.pm/;, relative URL's with popurl
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral
+ @packages $package @history @bills $bill @credits $credit
+ $balance $item @agents @referrals @invoicing_list $n1 );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Date::Format;
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearchs qsearch);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
+use FS::CGI qw(header menubar popurl table itable ntable);
+use FS::cust_credit;
+use FS::cust_pay;
+use FS::cust_bill;
+use FS::part_pkg;
+use FS::cust_pkg;
+use FS::part_referral;
+use FS::agent;
+use FS::cust_main;
+use FS::cust_refund;
+
+$cgi = new CGI;
&cgisuidsetup($cgi);
-SendHeaders(); # one guess.
-print header("Customer View", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <BASEFONT SIZE=3>
-END
+print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar(
+ 'Main Menu' => popurl(2)
+));
-#untaint custnum & get customer record
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
+die "No customer specified (bad URL)!" unless $cgi->keywords;
+($query) = $cgi->keywords; # needs parens with my, ->keywords returns array
+$query =~ /^(\d+)$/;
+$custnum = $1;
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
die "Customer not found!" unless $cust_main;
-my($hashref)=$cust_main->hashref;
+$hashref = $cust_main->hashref;
-#custnum
-print "<FONT SIZE=+1><CENTER>Customer #<B>$custnum</B></CENTER></FONT>",
- qq!<CENTER><A HREF="#cust_main">Customer Information</A> | !,
- qq!<A HREF="#cust_comments">Comments</A> | !,
- qq!<A HREF="#cust_pkg">Packages</A> | !,
- qq!<A HREF="#history">Payment History</A> </CENTER>!;
+print &itable(), '<TR><TD><A NAME="cust_main"></A>';
-#bill now linke
-print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!,
- qq!Bill this customer now</A></CENTER>!;
+print qq!<A HREF="!, popurl(2),
+ qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!,
+ &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
+ $custnum, '</TD></TR>',
+;
-#formatting
-print qq!<HR><A NAME="cust_main"><CENTER><FONT SIZE=+1>Customer Information!,
- qq!</FONT>!,
- qq!<BR><A HREF="../edit/cust_main.cgi?$custnum!,
- qq!">Edit this information</A></CENTER><FONT SIZE=-1>!;
-
-#agentnum
-my($agent)=qsearchs('agent',{
- 'agentnum' => $cust_main->getfield('agentnum')
-} );
-die "Agent not found!" unless $agent;
-print "<BR>Agent #<B>" , $agent->getfield('agentnum') , ": " ,
- $agent->getfield('agent') , "</B>";
-
-#refnum
-my($referral)=qsearchs('part_referral',{'refnum' => $cust_main->refnum});
-die "Referral not found!" unless $referral;
-print "<BR>Referral #<B>", $referral->refnum, ": ",
- $referral->referral, "<\B>";
-
-#last, first
-print "<P><B>", $hashref->{'last'}, ", ", $hashref->{first}, "</B>";
-
-#ss
-print " (SS# <B>", $hashref->{ss}, "</B>)" if $hashref->{ss};
-
-#company
-print "<BR><B>", $hashref->{company}, "</B>" if $hashref->{company};
-
-#address1
-print "<BR><B>", $hashref->{address1}, "</B>";
-
-#address2
-print "<BR><B>", $hashref->{address2}, "</B>" if $hashref->{address2};
-
-#city
-print "<BR><B>", $hashref->{city}, "</B>";
-
-#county
-print " (<B>", $hashref->{county}, "</B> county)" if $hashref->{county};
-
-#state
-print ",<B>", $hashref->{state}, "</B>";
-
-#zip
-print " <B>", $hashref->{zip}, "</B>";
-
-#country
-print "<BR><B>", $hashref->{country}, "</B>"
- unless $hashref->{country} eq "US";
-
-#daytime
-print "<P><B>", $hashref->{daytime}, "</B>" if $hashref->{daytime};
-print " (Day)" if $hashref->{daytime} && $hashref->{night};
-
-#night
-print "<BR><B>", $hashref->{night}, "</B>" if $hashref->{night};
-print " (Night)" if $hashref->{daytime} && $hashref->{night};
-
-#fax
-print "<BR><B>", $hashref->{fax}, "</B> (Fax)" if $hashref->{fax};
-
-#payby/payinfo/paydate/payname
-if ($hashref->{payby} eq "CARD") {
- print "<P>Card #<B>", $hashref->{payinfo}, "</B> Exp. <B>",
- $hashref->{paydate}, "</B>";
- print " (<B>", $hashref->{payname}, "</B>)" if $hashref->{payname};
-} elsif ($hashref->{payby} eq "BILL") {
- print "<P>Bill";
- print " on P.O. #<B>", $hashref->{payinfo}, "</B>"
- if $hashref->{payinfo};
- print " until <B>", $hashref->{paydate}, "</B>"
- if $hashref->{paydate};
- print " to <B>", $hashref->{payname}, "</B> at above address"
- if $hashref->{payname};
-} elsif ($hashref->{payby} eq "COMP") {
- print "<P>Access complimentary";
- print " courtesy of <B>", $hashref->{payinfo}, "</B>"
- if $hashref->{payinfo};
- print " until <B>", $hashref->{paydate}, "</B>"
- if $hashref->{paydate};
-} else {
- print "Unknown payment type ", $hashref->{payby}, "!";
+@agents = qsearch( 'agent', {} );
+unless ( scalar(@agents) == 1 ) {
+ $agent = qsearchs('agent',{
+ 'agentnum' => $cust_main->agentnum
+ } );
+ print '<TR><TD ALIGN="right">Agent</TD><TD BGCOLOR="#ffffff">',
+ $agent->agentnum, ": ", $agent->agent, '</TD></TR>';
+}
+@referrals = qsearch( 'part_referral', {} );
+unless ( scalar(@referrals) == 1 ) {
+ my $referral = qsearchs('part_referral', {
+ 'refnum' => $cust_main->refnum
+ } );
+ print '<TR><TD ALIGN="right">Referral</TD><TD BGCOLOR="#ffffff">',
+ $referral->refnum, ": ", $referral->referral, '</TD></TR>';
+}
+print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->otaker, '</TD></TR>';
+
+print '</TABLE></TD></TR></TABLE>';
+
+print '</TD><TD ROWSPAN=2>';
+
+print "Contact information", &ntable("#c0c0c0"), "<TR><TD>",
+ &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Contact name<BR>(last, first)</TD>',
+ '<TD COLSPAN=3 BGCOLOR="#ffffff">',
+ $cust_main->last, ', ', $cust_main->first,
+ '</TD><TD ALIGN="right">SS#</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->ss || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->company,
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Address</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->address1,
+ '</TD></TR>',
+;
+print '<TR><TD ALIGN="right"> </TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->address2, '</TD></TR>'
+ if $cust_main->address2;
+print '<TR><TD ALIGN="right">City</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->city,
+ '</TD><TD ALIGN="right">State</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->state,
+ '</TD><TD ALIGN="right">Zip</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->zip, '</TD></TR>',
+ '<TR><TD ALIGN="right">Country</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->country,
+ '</TD></TR>',
+;
+print '<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->daytime || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->night || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->fax || ' ', '</TD></TR>',
+ '</TABLE>', "</TD></TR></TABLE>"
+;
+
+print '</TD></TR><TR><TD>';
+
+@invoicing_list = $cust_main->invoicing_list;
+print "Billing information (",
+ qq!<A HREF="!, popurl(2), qq!/misc/bill.cgi?$custnum">!, "Bill now</A>)",
+ &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Tax exempt</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->tax ? 'yes' : 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Postal invoices</TD><TD BGCOLOR="#ffffff">',
+ ( grep { $_ eq 'POST' } @invoicing_list ) ? 'yes' : 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Email invoices</TD><TD BGCOLOR="#ffffff">',
+ join(', ', grep { $_ ne 'POST' } @invoicing_list ) || 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Billing type</TD><TD BGCOLOR="#ffffff">',
+;
+
+if ( $cust_main->payby eq 'CARD' ) {
+ print 'Credit card</TD></TR>',
+ '<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ '<TR><TD ALIGN="right">Name on card</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payname, '</TD></TR>'
+ ;
+} elsif ( $cust_main->payby eq 'BILL' ) {
+ print 'Billing</TD></TR>';
+ print '<TR><TD ALIGN="right">P.O. </TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ if $cust_main->payinfo;
+ print '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ '<TR><TD ALIGN="right">Attention</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payname, '</TD></TR>',
+ ;
+} elsif ( $cust_main->payby eq 'COMP' ) {
+ print 'Complimentary</TD></TR>',
+ '<TR><TD ALIGN="right">Authorized by</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ ;
}
-#tax
-print "<BR>(Tax exempt)" if $hashref->{tax};
-
-#otaker
-print "<P>Order taken by <B>", $hashref->{otaker}, "</B>";
+print "</TABLE></TD></TR></TABLE></TD></TR></TABLE>";
-#formatting
-print qq!<HR><FONT SIZE=+1><A NAME="cust_pkg"><CENTER>Packages</A></FONT>!,
- qq!<BR>Click on package number to view/edit package.!,
- qq!<BR><A HREF="../edit/cust_pkg.cgi?$custnum">Add/Edit packages</A>!,
- qq!</CENTER><BR>!;
+print qq!<BR><BR><A NAME="cust_pkg">Packages</A> !,
+# qq!<BR>Click on package number to view/edit package.!,
+ qq!( <A HREF="!, popurl(2), qq!edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> )!,
+;
#display packages
#formatting
-print qq!<CENTER><TABLE BORDER=4>\n!,
- qq!<TR><TH ROWSPAN=2>#</TH><TH ROWSPAN=2>Package</TH><TH COLSPAN=5>!,
- qq!Dates</TH></TR>\n!,
+print qq!!, &table(), "\n",
+ qq!<TR><TH COLSPAN=2 ROWSPAN=2>Package</TH><TH COLSPAN=5>!,
+ qq!Dates</TH><TH COLSPAN=2 ROWSPAN=2>Services</TH></TR>\n!,
qq!<TR><TH><FONT SIZE=-1>Setup</FONT></TH><TH>!,
qq!<FONT SIZE=-1>Next bill</FONT>!,
qq!</TH><TH><FONT SIZE=-1>Susp.</FONT></TH><TH><FONT SIZE=-1>Expire!,
qq!</TR>\n!;
#get package info
-my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum});
-my($package);
+@packages = $cust_main->all_pkgs;
+#@packages = $cust_main->ncancelled_pkgs;
+
+$n1 = '<TR>';
foreach $package (@packages) {
- my($pref)=$package->hashref;
- my($part_pkg)=qsearchs('part_pkg',{
- 'pkgpart' => $pref->{pkgpart}
- } );
- print qq!<TR><TD><FONT SIZE=-1><A HREF="../view/cust_pkg.cgi?!,
- $pref->{pkgnum}, qq!">!,
- $pref->{pkgnum}, qq!</A></FONT></TD>!,
- "<TD><FONT SIZE=-1>", $part_pkg->getfield('pkg'), " - ",
- $part_pkg->getfield('comment'), "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{setup} ? time2str("%D",$pref->{setup} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{bill} ? time2str("%D",$pref->{bill} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{susp} ? time2str("%D",$pref->{susp} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{expire} ? time2str("%D",$pref->{expire} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{cancel} ? time2str("%D",$pref->{cancel} ) : "" ,
- "</FONT></TD>",
- "</TR>";
-}
+ my $pkgnum = $package->pkgnum;
+ my $pkg = $package->part_pkg->pkg;
+ my $comment = $package->part_pkg->comment;
+ my $pkgview = popurl(2). "view/cust_pkg.cgi?$pkgnum";
+ my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } );
+ my $rowspan = scalar(@cust_svc) || 1;
+
+ my $button_cgi = new CGI;
+ $button_cgi->param('clone', $package->part_pkg->pkgpart);
+ $button_cgi->param('pkgnum', $package->pkgnum);
+ my $button_url = popurl(2). "edit/part_pkg.cgi?". $button_cgi->query_string;
+
+ #print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview">$pkgnum</A></TD>!,
+ print $n1, qq!<TD ROWSPAN=$rowspan>$pkgnum</TD>!,
+ qq!<TD ROWSPAN=$rowspan><FONT SIZE=-1>!,
+ #qq!<A HREF="$pkgview">$pkg - $comment</A>!,
+ qq!$pkg - $comment!,
+ qq! ( <A HREF="$pkgview">Edit</A> | <A HREF="$button_url">Customize pricing</A> )</FONT></TD>!,
+ ;
+ for ( qw( setup bill susp expire cancel ) ) {
+ print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_)
+ ? time2str("%D", $package->getfield($_) )
+ : ' '
+ ), '</FONT></TD>',
+ ;
+ }
+
+ my $n2 = '';
+ foreach my $cust_svc ( @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my($svcnum) = $cust_svc->svcnum;
+ my($sview) = popurl(2). "view";
+ print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
+ qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!;
+ $n2="</TR><TR>";
+ }
+ $n1="</TR><TR>";
+}
+print "</TR>";
#formatting
-print "</TABLE></CENTER>";
+print "</TABLE>";
#formatting
-print qq!<CENTER><HR><A NAME="history"><FONT SIZE=+1>Payment History!,
- qq!</FONT></A><BR>!,
- qq!Click on invoice to view invoice/enter payment.<BR>!,
- qq!<A HREF="../edit/cust_credit.cgi?$custnum">!,
- qq!Post Credit / Refund</A></CENTER><BR>!;
+print qq!<BR><BR><A NAME="history">Payment History!,
+ qq!</A>!,
+ qq! ( Click on invoice to view invoice/enter payment. | !,
+ qq!<A HREF="!, popurl(2), qq!edit/cust_credit.cgi?$custnum">!,
+ qq!Post credit / refund</A> )!;
#get payment history
#
# major problem: this whole thing is way too sloppy.
# minor problem: the description lines need better formatting.
-my(@history);
+@history = (); #needed for mod_perl :)
-my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum});
-my($bill);
+@bills = qsearch('cust_bill',{'custnum'=>$custnum});
foreach $bill (@bills) {
my($bref)=$bill->hashref;
push @history,
- $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! .
+ $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! .
$bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
qq! (Balance \$! . $bref->{owed} . qq!)</A>\t! .
$bref->{charged} . qq!\t\t\t!;
my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
my($payment);
foreach $payment (@payments) {
-# my($pref)=$payment->hashref;
my($date,$invnum,$payby,$payinfo,$paid)=($payment->getfield('_date'),
$payment->getfield('invnum'),
$payment->getfield('payby'),
}
}
-my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum});
-my($credit);
+@credits = qsearch('cust_credit',{'custnum'=>$custnum});
foreach $credit (@credits) {
my($cref)=$credit->hashref;
push @history,
}
#formatting
- print <<END;
-<CENTER><TABLE BORDER=4>
+ print &table(), <<END;
<TR>
<TH>Date</TH>
<TH>Description</TH>
#display payment history
-my($balance)=0;
-my($item);
+$balance = 0;
foreach $item (sort keyfield_numerically @history) {
my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item);
$charge ||= 0;
}
#formatting
-print "</TABLE></CENTER>";
+print "</TABLE>";
#end
#!/usr/bin/perl -Tw
#
-# cust_pkg.cgi: View a package
+# $Id: cust_pkg.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
#
# Usage: cust_pkg.cgi pkgnum
# http://server.name/path/cust_pkg.cgi?pkgnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 96-dec-15
#
# services section needs to be cleaned up, needs to display extraneous
# ivan@voicenet.com 97-jul-29
#
# no FS::Search ivan@sisd.com 98-mar-7
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.11 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/04/08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:01 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/19 05:14:20 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:44 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/23 03:11:40 ivan
+# *** empty log message ***
+#
+# Revision 1.3 1998/12/17 09:57:22 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/13 09:56:49 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
use strict;
+use vars qw ( $cgi %uiview %uiadd $part_svc $query $pkgnum $cust_pkg $part_pkg
+ $custnum $susp $cancel $expire $pkg $comment $setup $bill
+ $otaker );
use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header menubar ntable table);
use FS::Record qw(qsearch qsearchs);
+use FS::part_svc;
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::pkg_svc;
+use FS::cust_svc;
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
+$cgi = new CGI;
+cgisuidsetup($cgi);
-my(%uiview,%uiadd);
-my($part_svc);
foreach $part_svc ( qsearch('part_svc',{}) ) {
- $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi";
- $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi";
+ $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi";
+ $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi";
}
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Package View</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Package View</H1>
- </CENTER>
- <BASEFONT SIZE=3>
-END
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($pkgnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$pkgnum = $1;
#get package record
-my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
die "No package!" unless $cust_pkg;
-my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
+$part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
-#nav bar
-my($custnum)=$cust_pkg->getfield('custnum');
-print qq!<CENTER><A HREF="../view/cust_main.cgi?$custnum">View this customer!,
- qq! (#$custnum)</A> | <A HREF="../">Main menu</A></CENTER><BR>!;
+$custnum = $cust_pkg->getfield('custnum');
+print $cgi->header( '-expires' => 'now' ), header('Package View', menubar(
+ "View this customer (#$custnum)" => popurl(2). "view/cust_main.cgi?$custnum",
+ 'Main Menu' => popurl(2)
+));
#print info
-my($susp,$cancel,$expire)=(
+($susp,$cancel,$expire)=(
$cust_pkg->getfield('susp'),
$cust_pkg->getfield('cancel'),
$cust_pkg->getfield('expire'),
);
-print "<FONT SIZE=+1><CENTER>Package #<B>$pkgnum</B></FONT>";
-print qq!<BR><A HREF="#package">Package Information</A>!;
-print qq! | <A HREF="#services">Service Information</A>! unless $cancel;
-print qq!</CENTER><HR>\n!;
-
-my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
-print qq!<A NAME="package"><CENTER><FONT SIZE=+1>Package Information!,
- qq!</FONT></A>!;
-print qq!<BR><A HREF="../unimp.html">Edit this information</A></CENTER>!;
-print "<P>Package: <B>$pkg - $comment</B>";
-
-my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
-print "<BR>Setup: <B>", $setup ? time2str("%D",$setup) : "(Not setup)" ,"</B>";
-print "<BR>Next bill: <B>", $bill ? time2str("%D",$bill) : "" ,"</B>";
-
-if ($susp) {
- print "<BR>Suspended: <B>", time2str("%D",$susp), "</B>";
- print qq! <A HREF="../misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>! unless $cancel;
-} else {
- print qq!<BR><A HREF="../misc/susp_pkg.cgi?$pkgnum">Suspend</A>! unless $cancel;
-}
-
-if ($expire) {
- print "<BR>Expire: <B>", time2str("%D",$expire), "</B>";
-}
- print <<END;
-<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post">
-<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" >
-<INPUT TYPE="submit" VALUE="Cancel later">
-END
-
-if ($cancel) {
- print "<BR>Cancelled: <B>", time2str("%D",$cancel), "</B>";
-} else {
- print qq!<BR><A HREF="../misc/cancel_pkg.cgi?$pkgnum">Cancel now</A>!;
-}
-
-#otaker
-my($otaker)=$cust_pkg->getfield('otaker');
-print "<P>Order taken by <B>$otaker</B>";
+($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
+($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
+$otaker = $cust_pkg->getfield('otaker');
+
+print "Package information";
+print ' (<A HREF="'. popurl(2). 'misc/unsusp_pkg.cgi?'. $pkgnum.
+ '">unsuspend</A>)' if ( $susp && ! $cancel );
+print ' (<A HREF="'. popurl(2). 'misc/susp_pkg.cgi?'. $pkgnum.
+ '">suspend</A>)' unless ( $susp || $cancel );
+print ' (<A HREF="'. popurl(2). 'misc/cancel_pkg.cgi?'. $pkgnum.
+ '">cancel</A>)' unless $cancel;
+
+print &ntable("#c0c0c0"), '<TR><TD>', &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Package number</TD><TD BGCOLOR="#ffffff">',
+ $pkgnum, '</TD></TR>',
+ '<TR><TD ALIGN="right">Package</TD><TD BGCOLOR="#ffffff">',
+ $pkg, '</TD></TR>',
+ '<TR><TD ALIGN="right">Comment</TD><TD BGCOLOR="#ffffff">',
+ $comment, '</TD></TR>',
+ '<TR><TD ALIGN="right">Setup date</TD><TD BGCOLOR="#ffffff">',
+ ( $setup ? time2str("%D",$setup) : "(Not setup)" ), '</TD></TR>',
+ '<TR><TD ALIGN="right">Next bill date</TD><TD BGCOLOR="#ffffff">',
+ ( $bill ? time2str("%D",$bill) : " " ), '</TD></TR>',
+;
+print '<TR><TD ALIGN="right">Suspension date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$susp), '</TD></TR>' if $susp;
+print '<TR><TD ALIGN="right">Expiration date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$expire), '</TD></TR>' if $expire;
+print '<TR><TD ALIGN="right">Cancellation date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$cancel), '</TD></TR>' if $cancel;
+print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">',
+ $otaker, '</TD></TR>',
+ '</TABLE></TD></TR></TABLE>'
+;
+
+# print <<END;
+#<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post">
+#<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+#Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" >
+#<INPUT TYPE="submit" VALUE="Cancel later">
+#END
unless ($cancel) {
#services
- print <<END;
-<HR><A NAME="services"><CENTER><FONT SIZE=+1>Service Information</FONT></A>
-<BR>Click on service to view/edit/add service.</CENTER><BR>
-<CENTER><B>Do NOT pick the "Link to existing" option unless you are auditing!!!</B></CENTER>
-<CENTER><TABLE BORDER=4>
-<TR><TH>Service</TH>
-END
+ print '<BR>Service Information', &table();
#list of services this pkgpart includes
- my($pkg_svc,%pkg_svc);
+ my $pkg_svc;
+ my %pkg_svc = ();
foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $cust_pkg->pkgpart }) ) {
$pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
}
#list of records from cust_svc
- my($svcpart);
+ my $svcpart;
foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) {
my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
my($cust_svc);
if ( $cust_svc=shift @cust_svc ) {
my($svcnum)=$cust_svc->svcnum;
+ my($label, $value, $svcdb) = $cust_svc->label;
print <<END;
-<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR>
+<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc
: $value<A></TD></TR>
END
} else {
print <<END;
warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
}
- print "</TABLE></CENTER>";
-
+ print "</TABLE><FONT SIZE=-1>",
+ "Choose (View) to view or edit an existing service<BR>",
+ "Choose (Add) to setup a new service<BR>",
+ "Choose (Link to existing) to link to a legacy (pre-Freeside) service",
+ "</FONT>"
+ ;
}
#formatting
#!/usr/bin/perl -Tw
#
-# View svc_acct records
+# $Id: svc_acct.cgi,v 1.9 1999-04-08 12:00:19 ivan Exp $
#
# Usage: svc_acct.cgi svcnum
# http://server.name/path/svc_acct.cgi?svcnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 96-dec-17
#
# added link to send info
# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
#
# displays arbitrary radius attributes ivan@sisd.com 98-aug-16
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.9 1999-04-08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:02 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/19 05:14:21 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:45 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1999/01/18 09:22:36 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.4 1998/12/23 03:09:19 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:23 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/12/16 05:24:29 ivan
+# use FS::Conf;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs fields);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
+use vars qw( $conf $cgi $mydomain $query $svcnum $svc_acct $cust_svc $pkgnum
+ $cust_pkg $custnum $part_svc $p $svc_acct_pop );
+use CGI;
+use CGI::Carp qw( fatalsToBrowser );
+use FS::UID qw( cgisuidsetup );
+use FS::CGI qw( header popurl menubar);
+use FS::Record qw( qsearchs fields );
+use FS::Conf;
+use FS::svc_acct;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
+use FS::svc_acct_pop;
+
+$cgi = new CGI;
&cgisuidsetup($cgi);
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum});
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
die "Unkonwn svcnum" unless $svc_acct;
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
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 } );
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
die "Unkonwn svcpart" unless $part_svc;
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Account View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Account View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-END
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Account 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,
+));
-if ($pkgnum || $custnum) {
- print <<END;
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-END
-} else {
- print <<END;
-<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
-END
-}
-
-print <<END;
-<A HREF="../">Main menu</A></CENTER><BR>
-<FONT SIZE=+1>Service #$svcnum</FONT>
-END
-
-print qq!<BR><A HREF="../edit/svc_acct.cgi?$svcnum">Edit this information</A>!;
#print qq!<BR><A HREF="../misc/sendconfig.cgi?$svcnum">Send account information</A>!;
-print qq!<BR><BR><A HREF="#general">General</A> | <A HREF="#shell">Shell account</A> | !;
-print qq!<A HREF="#slip">SLIP/PPP account</A></CENTER>!;
-
-#formatting
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="general">General</A></FONT></CENTER>!;
-
-#svc
-print "Service: <B>", $part_svc->svc, "</B>";
-
-#username
-print "<BR>Username: <B>", $svc_acct->username, "</B>";
-#password
+print qq!<A HREF="${p}edit/svc_acct.cgi?$svcnum">Edit this information</A>!,
+ "<BR>Service #$svcnum",
+ "<BR>Service: <B>", $part_svc->svc, "</B>",
+ "<BR><BR>Username: <B>", $svc_acct->username, "</B>"
+;
if (substr($svc_acct->_password,0,1) eq "*") {
- print "<BR>Password: <I>(Login disabled)</I><BR>";
+ print "<BR>Password: <I>(Login disabled)</I>";
} else {
- print "<BR>Password: <I>(hidden)</I><BR>";
+ print "<BR>Password: <I>(hidden)</I>";
}
-# popnum -> svc_acct_pop record
-my($svc_acct_pop)=qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
-
-#pop
-print "POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state,
+$svc_acct_pop = qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
+print "<BR>POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state,
" (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "<\B>"
if $svc_acct_pop;
-#shell account
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="shell">!;
if ($svc_acct->uid ne '') {
- print "Shell account";
- print "</A></FONT></CENTER>";
- print "Uid: <B>", $svc_acct->uid, "</B>";
- print "<BR>Gid: <B>", $svc_acct->gid, "</B>";
-
- print qq!<BR>Finger name: <B>!, $svc_acct->finger, qq!</B><BR>!;
-
- print "Home directory: <B>", $svc_acct->dir, "</B><BR>";
-
- print "Shell: <B>", $svc_acct->shell, "</B><BR>";
-
- print "Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>";
+ print "<BR><BR>Uid: <B>", $svc_acct->uid, "</B>",
+ "<BR>Gid: <B>", $svc_acct->gid, "</B>",
+ "<BR>Finger name: <B>", $svc_acct->finger, "</B>",
+ "<BR>Home directory: <B>", $svc_acct->dir, "</B>",
+ "<BR>Shell: <B>", $svc_acct->shell, "</B>",
+ "<BR>Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>"
+ ;
} else {
- print "No shell account.</A></FONT></CENTER>";
+ print "<BR><BR>(No shell account)";
}
-# SLIP/PPP
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="slip">!;
if ($svc_acct->slipip) {
- print "SLIP/PPP account</A></FONT></CENTER>";
- print "IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>";
+ print "<BR><BR>IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>";
my($attribute);
foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
#warn $attribute;
print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
}
} else {
- print "No SLIP/PPP account</A></FONT></CENTER>"
+ print "<BR><BR>(No SLIP/PPP account)";
}
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
+print "</BODY></HTML>";
#!/usr/bin/perl -Tw
#
-# View svc_acct_sm records
+# $Id: svc_acct_sm.cgi,v 1.10 1999-04-08 12:00:19 ivan Exp $
#
# Usage: svc_acct_sm.cgi svcnum
# http://server.name/path/svc_acct_sm.cgi?svcnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# based on view/svc_acct.cgi
#
# ivan@voicenet.com 97-jan-5
# bmccane@maxbaud.net 98-apr-3
#
# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.10 1999-04-08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.9 1999/02/28 00:04:03 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/09 09:23:00 ivan
+# visual and bugfixes
+#
+# Revision 1.7 1999/02/07 09:59:42 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:22 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:46 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 03:09:52 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:24 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/12/16 05:24:30 ivan
+# use FS::Conf;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc
+ $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser
+ $svc $svc_domain $domain $svc_acct $username );
+use CGI;
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl menubar );
use FS::Record qw(qsearchs);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
+use FS::Conf;
+use FS::svc_acct_sm;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
+use FS::svc_domain;
+use FS::svc_acct;
+
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$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);
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
if ($pkgnum) {
$cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
$custnum=$cust_pkg->getfield('custnum');
-}
-
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Mail Alias View</H1>
-END
-if ($pkgnum || $custnum) {
- print <<END;
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-END
} else {
- print <<END;
-<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
-END
+ $cust_pkg = '';
+ $custnum = '';
}
-print <<END;
- <A HREF="../">Main menu</A></CENTER><BR<
- <FONT SIZE=+1>Service #$svcnum</FONT>
- <P><A HREF="../edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>
- <BASEFONT SIZE=3>
-END
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
+die "Unkonwn svcpart" unless $part_svc;
-my($domsvc,$domuid,$domuser)=(
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), 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,
+));
+
+($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});
-my($domain)=$svc_domain->domain;
-my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
-my($username)=$svc_acct->username;
-
-#formatting
-print qq!<HR>!;
-
-#svc
-print "Service: <B>$svc</B>";
-
-print "<HR>";
-
-print qq!Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!;
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
+$svc = $part_svc->svc;
+$svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc});
+$domain = $svc_domain->domain;
+$svc_acct = qsearchs('svc_acct',{'uid'=>$domuid});
+$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>'
+;
#!/usr/bin/perl -Tw
#
-# View svc_domain records
+# $Id: svc_domain.cgi,v 1.9 1999-04-08 12:00:19 ivan Exp $
#
# Usage: svc_domain svcnum
# http://server.name/path/svc_domain.cgi?svcnum
#
-# Note: Should be run setuid freeside as user nobody.
-#
# ivan@voicenet.com 97-jan-6
#
# rewrite ivan@sisd.com 98-mar-14
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.9 1999-04-08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:04 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/02/23 08:09:25 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.6 1999/01/19 05:14:23 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:47 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 03:10:19 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:25 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/13 09:56:50 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $cgi $query $svcnum $svc_domain $domain $cust_svc $pkgnum
+ $cust_pkg $custnum $part_svc $p );
+use CGI;
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header menubar popurl menubar);
use FS::Record qw(qsearchs);
+use FS::svc_domain;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum});
die "Unknown svcnum" unless $svc_domain;
-my($domain)=$svc_domain->domain;
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
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 } );
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
die "Unkonwn svcpart" unless $part_svc;
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Domain View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Domain View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-<A HREF="../">Main menu</A></CENTER><BR>
- <FONT SIZE=+1>Service #$svcnum</FONT>
- </CENTER>
-END
-
-print "<HR>";
-print "Service: <B>", $part_svc->svc, "</B>";
-print "<HR>";
-
-print qq!Domain name <B>$domain</B>.!;
-print qq!<P><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!;
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
+$domain = $svc_domain->domain;
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Domain 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,
+)),
+ "Service #$svcnum",
+ "<BR>Service: <B>", $part_svc->svc, "</B>",
+ "<BR>Domain name: <B>$domain</B>.",
+ qq!<BR><BR><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!,
+ '</BODY></HTML>',
+;
use strict;
use vars qw(@EXPORT_OK @ISA);
use Exporter;
-use CGI::Base;
+use CGI;
+use URI::URL;
use CGI::Carp qw(fatalsToBrowser);
+use FS::UID;
@ISA = qw(Exporter);
-@EXPORT_OK = qw(header menubar idiot eidiot);
+@EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable);
=head1 NAME
=head1 SYNOPSIS
- use FS::CGI qw(header menubar idiot eidiot);
+ use FS::CGI qw(header menubar idiot eidiot popurl);
print header( 'Title', '' );
print header( 'Title', menubar('item', 'URL', ... ) );
idiot "error message";
eidiot "error message";
+ $url = popurl; #returns current url
+ $url = popurl(3); #three levels up
+
=head1 DESCRIPTION
Provides a few common subroutines for the web interface.
sub header {
my($title,$menubar)=@_;
- <<END;
+ my $x = <<END;
<HTML>
<HEAD>
<TITLE>
$title
</TITLE>
</HEAD>
- <BODY>
- <CENTER>
- <H1>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
$title
- </H1>
- $menubar
- </CENTER>
- <HR>
+ </FONT>
+ <BR><BR>
END
+ $x .= $menubar. "<BR><BR>" if $menubar;
+ $x;
}
=item menubar ITEM, URL, ...
=item idiot ERROR
+This is depriciated. Don't use it.
+
Sends headers and an HTML error message.
=cut
sub idiot {
+ #warn "idiot depriciated";
my($error)=@_;
- CGI::Base::SendHeaders();
+ my($cgi)=FS::UID::cgi;
+ if ( $cgi->isa('CGI::Base') ) {
+ no strict 'subs';
+ &CGI::Base::SendHeaders;
+ } else {
+ print $cgi->header( '-expires' => 'now' );
+ }
print <<END;
<HTML>
<HEAD>
</CENTER>
Your request could not be processed because of the following error:
<P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and try again.
</BODY>
</HTML>
END
=item eidiot ERROR
+This is depriciated. Don't use it.
+
Sends headers and an HTML error message, then exits.
=cut
sub eidiot {
+ #warn "eidiot depriciated";
idiot(@_);
exit;
}
+=item popurl LEVEL
+
+Returns current URL with LEVEL levels of path removed from the end (default 0).
+
+=cut
+
+sub popurl {
+ my($up)=@_;
+ my($cgi)=&FS::UID::cgi;
+ my($url)=new URI::URL $cgi->url;
+ my(@path)=$url->path_components;
+ splice @path, 0-$up;
+ $url->path_components(@path);
+ my $x = $url->as_string;
+ $x .= '/' unless $x =~ /\/$/;
+ $x;
+}
+
+=item table
+
+Returns HTML tag for beginning a table.
+
+=cut
+
+sub table {
+ my $col = shift;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%">!;
+ } else {
+ "<TABLE BORDER=1>";
+ }
+}
+
+=item itable
+
+Returns HTML tag for beginning an (invisible) table.
+
+=cut
+
+sub itable {
+ my $col = shift;
+ my $cellspacing = shift || 0;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+ } else {
+ qq!<TABLE BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+ }
+}
+
+=item ntable
+
+This is getting silly.
+
+=cut
+
+sub ntable {
+ my $col = shift;
+ my $cellspacing = shift || 0;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!;
+ } else {
+ "<TABLE BORDER>";
+ }
+
+}
+
=back
=head1 BUGS
Not complete.
-Uses CGI-modules instead of CGI.pm
-
=head1 SEE ALSO
-L<CGI::Base>
+L<CGI>, L<CGI::Base>
=head1 HISTORY
pod ivan@sisd.com 98-sep-12
+$Log: CGI.pm,v $
+Revision 1.17 1999-02-07 09:59:43 ivan
+more mod_perl fixes, and bugfixes Peter Wemm sent via email
+
+Revision 1.16 1999/01/25 12:26:05 ivan
+yet more mod_perl stuff
+
+Revision 1.15 1999/01/18 09:41:48 ivan
+all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+(good idea anyway)
+
+Revision 1.14 1999/01/18 09:22:37 ivan
+changes to track email addresses for email invoicing
+
+Revision 1.12 1998/12/23 02:23:16 ivan
+popurl always has trailing slash
+
+Revision 1.11 1998/11/12 07:43:54 ivan
+*** empty log message ***
+
+Revision 1.10 1998/11/12 01:53:47 ivan
+added table command
+
+Revision 1.9 1998/11/09 08:51:49 ivan
+bug squash
+
+Revision 1.7 1998/11/09 06:10:59 ivan
+added sub url
+
+Revision 1.6 1998/11/09 05:44:20 ivan
+*** empty log message ***
+
+Revision 1.4 1998/11/09 04:55:42 ivan
+support depriciated CGI::Base as well as CGI.pm (for now)
+
+Revision 1.3 1998/11/08 10:50:19 ivan
+s/CGI::Base/CGI/; etc.
+
+
=cut
1;
use vars qw($default_dir);
use IO::File;
-$default_dir='/var/spool/freeside/conf';
-
=head1 NAME
FS::Conf - Read access to Freeside configuration values
use FS::Conf;
+ $conf = new FS::Conf "/config/directory";
+
+ $FS::Conf::default_dir = "/config/directory";
$conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
$dir = $conf->dir;
=item new [ DIRECTORY ]
-Create a new configuration object. Optionally, a non-default directory may
-be specified.
+Create a new configuration object. A directory arguement is required if
+$FS::Conf::default_dir has not been set.
=cut
sub dir {
my($self) = @_;
- $self->{dir};
+ my $dir = $self->{dir};
+ -e $dir or die "FATAL: $dir doesn't exist!";
+ -d $dir or die "FATAL: $dir isn't a directory!";
+ -r $dir or die "FATAL: Can't read $dir!";
+ -x $dir or die "FATAL: $dir not searchable (executable)!";
+ $dir;
}
=item config
=head1 BUGS
-The option to specify a non-default directory should probably be removed.
-
Write access (with locking) should be implemented.
=head1 SEE ALSO
sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27
+$Log: Conf.pm,v $
+Revision 1.3 1999-03-29 01:29:33 ivan
+die unless the configuration directory exists
+
+Revision 1.2 1998/11/13 04:08:44 ivan
+no default default_dir (ironic)
+
+
=cut
1;
@ISA = qw(FS::cust_bill);
-#warn "FS::Invoice depriciated\n";
+warn "FS::Invoice depriciated\n";
=head1 NAME
=head1 SYNOPSIS
-The functioanlity of FS::invoice has been integrated in FS::cust_bill.
+The functionality of FS::Invoice has been integrated in FS::cust_bill.
=head1 HISTORY
use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK);
use subs qw(reload_dbdef);
use Exporter;
-use Carp;
+use Carp qw(carp cluck croak confess);
use File::CounterFile;
use FS::UID qw(dbh checkruid swapuid getotaker datasrc);
use FS::dbdef;
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
-$File::CounterFile::DEFAULT_DIR = "/var/spool/freeside/counters" ;
-
-$dbdef_file = "/var/spool/freeside/dbdef.". datasrc;
-
-reload_dbdef unless $setup_hack;
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::Record'} = sub {
+ $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
+ $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
+ &reload_dbdef unless $setup_hack; #$setup_hack needed now?
+};
=head1 NAME
=head1 SYNOPSIS
use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
+ use FS::Record qw(dbh fields qsearch qsearchs dbdef);
$record = new FS::Record 'table', \%hash;
$record = new FS::Record 'table', { 'column' => 'value', ... };
$hashref = $record->hashref;
- $error = $record->add;
+ $error = $record->insert;
+ #$error = $record->add; #depriciated
- $error = $record->del;
+ $error = $record->delete;
+ #$error = $record->del; #depriciated
- $error = $new_record->rep($old_record);
+ $error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #depriciated
$value = $record->unique('column');
$fields = hfields('table');
if ( $fields->{Field} ) { # etc.
- @fields = fields 'table';
+ @fields = fields 'table'; #as a subroutine
+ @fields = $record->fields; #as a method call
=head1 DESCRIPTION
implemented on top of DBI. FS::Record is intended as a base class for
table-specific classes to inherit from, i.e. FS::cust_main.
-=head1 METHODS
+=head1 CONSTRUCTORS
=over 4
-=item new TABLE, HASHREF
+=item new [ TABLE, ] HASHREF
Creates a new record. It doesn't store it in the database, though. See
-L<"add"> for that.
+L<"insert"> for that.
Note that the object stores this 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.
+TABLE can only be omitted when a dervived class overrides the table method.
+
=cut
sub new {
- my($proto,$table,$hashref) = @_;
- confess "Second arguement to FS::Record->new is not a HASH ref: ",
- ref($hashref), " ", $hashref, "\n"
- unless ref($hashref) eq 'HASH'; #bad practice?
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
- #check to make sure $table exists? (ask dbdef)
+ $self->{'Table'} = shift unless defined ( $self->table );
- foreach my $field ( FS::Record::fields $table ) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
+ my $hashref = $self->{'Hash'} = shift;
- # mySQL must rtrim the inbound text strings or store them z-terminated
- # I simulate this for Postgres below
- # Turned off in favor of ChopBlanks in UID.pm (see man DBI)
- #if (datasrc =~ m/Pg/)
- #{
- # foreach my $index (keys %$hashref)
- # {
- # $$hashref{$index} = unpack("A255", $$hashref{$index})
- # if ($$hashref{$index} =~ m/ $/) ;
- # }
- #}
-
- foreach my $column (keys %{$hashref}) {
- #trim the '$' from money fields for Pg (beong HERE?)
+ foreach my $field ( $self->fields ) {
+ $hashref->{$field}='' unless defined $hashref->{$field};
+ #trim the '$' and ',' from money fields for Pg (belong HERE?)
#(what about Pg i18n?)
if ( datasrc =~ m/Pg/
- && $dbdef->table($table)->column($column)->type eq 'money' ) {
- ${$hashref}{$column} =~ s/^\$//;
+ && $self->dbdef_table->column($field)->type eq 'money' ) {
+ ${$hashref}{$field} =~ s/^\$//;
+ ${$hashref}{$field} =~ s/\,//;
}
- #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) {
- # ${$hashref}{$column} =~ s/^\$//;
- #}
}
- my $class = ref($proto) || $proto;
- my $self = { 'Table' => $table,
- 'Hash' => $hashref,
- };
+ $self;
+}
+sub create {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
bless ($self, $class);
-
+ if ( defined $self->table ) {
+ cluck "create constructor is depriciated, use new!";
+ $self->new(@_);
+ } else {
+ croak "FS::Record::create called (not from a subclass)!";
+ }
}
=item qsearch TABLE, HASHREF
Searches the database for all records matching (at least) the key/value pairs
-in HASHREF. Returns all the records found as FS::Record objects.
+in HASHREF. Returns all the records found as `FS::TABLE' objects if that
+module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
+objects.
=cut
-# Usage: @records = &FS::Search::qsearch($table,\%hash);
-# Each element of @records is a FS::Record object.
sub qsearch {
my($table,$record) = @_;
my($dbh) = dbh;
my($sth);
my($statement) = "SELECT * FROM $table". ( @fields
? " WHERE ". join(' AND ',
- map("$_ = ". _quote($record->{$_},$table,$_), @fields)
- )
- : ''
+ map {
+ $record->{$_} eq ''
+ ? ( datasrc =~ m/Pg/
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($record->{$_},$table,$_)
+ } @fields
+ ) : ''
);
$sth=$dbh->prepare($statement)
or croak $dbh->errstr; #is that a little too harsh? hmm.
+ #warn $statement #if $debug # or some such;
- map {
- new FS::Record ($table,$sth->fetchrow_hashref);
- } ( 1 .. $sth->execute );
+ if ( eval ' scalar(@FS::'. $table. '::ISA);' ) {
+ map {
+ eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );';
+ } ( 1 .. $sth->execute );
+ } else {
+ cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects";
+ map {
+ new FS::Record ($table,$sth->fetchrow_hashref);
+ } ( 1 .. $sth->execute );
+ }
}
=item qsearchs TABLE, HASHREF
-Searches the database for a record matching (at least) the key/value pairs
-in HASHREF, and returns the record found as an FS::Record object. If more than
-one record matches, it B<carp>s but returns the first. If this happens, you
-either made a logic error in asking for a single item, or your data is
-corrupted.
+Same as qsearch, except that if more than one record matches, it B<carp>s but
+returns the first. If this happens, you either made a logic error in asking
+for a single item, or your data is corrupted.
=cut
sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
my(@result) = qsearch(@_);
- carp "Multiple records in scalar search!" if scalar(@result) > 1;
+ carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
#should warn more vehemently if the search was on a primary key?
$result[0];
}
+=back
+
+=head1 METHODS
+
+=over 4
+
=item table
Returns the table name.
=cut
sub table {
- my($self) = @_;
+# cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+ my $self = shift;
$self -> {'Table'};
}
}
}
sub getfield {
- get(@_);
+ my $self = shift;
+ $self->get(@_);
}
=item set, setfield COLUMN, VALUE
$self->{'Hash'}->{$field} = $value;
}
sub setfield {
- set(@_);
+ my $self = shift;
+ $self->set(@_);
}
=item AUTLOADED METHODS
$self->{'Hash'};
}
-=item add
+=item insert
-Adds this record to the database. If there is an error, returns the error,
+Inserts this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
-sub add {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
#single-field unique keys are given a value if false
#(like MySQL's AUTO_INCREMENT)
- foreach ( $dbdef->table($table)->unique->singles ) {
+ foreach ( $self->dbdef_table->unique->singles ) {
$self->unique($_) unless $self->getfield($_);
}
#and also the primary key
- my($primary_key)=$dbdef->table($table)->primary_key;
+ my $primary_key = $self->dbdef_table->primary_key;
$self->unique($primary_key)
if $primary_key && ! $self->getfield($primary_key);
- my (@fields) =
+ my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- fields($table)
+ $self->fields
;
- my($sth);
- my($statement)="INSERT INTO $table ( ".
+ my $statement = "INSERT INTO ". $self->table. " ( ".
join(', ',@fields ).
") VALUES (".
- join(', ',map(_quote($self->getfield($_),$table,$_), @fields)).
+ join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
")"
;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
'';
}
-=item del
+=item add
+
+Depriciated (use insert instead).
+
+=cut
+
+sub add {
+ cluck "warning: FS::Record::add depriciated!";
+ insert @_; #call method in this scope
+}
+
+=item delete
Delete this record from the database. If there is an error, returns the error,
otherwise returns false.
=cut
-sub del {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
+sub delete {
+ my $self = shift;
- my($sth);
- my($statement)="DELETE FROM $table WHERE ". join(' AND ',
+ my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
map {
$self->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($self->getfield($_),$table,$_)
- } ( $dbdef->table($table)->primary_key )
- ? ($dbdef->table($table)->primary_key)
- : fields($table)
+ #? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( datasrc =~ m/Pg/
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($self->getfield($_),$self->table,$_)
+ } ( $self->dbdef_table->primary_key )
+ ? ( $self->dbdef_table->primary_key)
+ : $self->fields
);
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
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($rc);
- $rc=$sth->execute or return $sth->errstr;
+ my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
undef $self; #no need to keep object!
'';
}
-=item rep OLD_RECORD
+=item del
+
+Depriciated (use delete instead).
+
+=cut
+
+sub del {
+ cluck "warning: FS::Record::del depriciated!";
+ &delete(@_); #call method in this scope
+}
+
+=item replace OLD_RECORD
Replace the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
-sub rep {
- my($new,$old)=@_;
- my($dbh)=dbh;
- my($table)=$old->table;
- my(@fields)=fields($table);
- my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields;
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
- if ( scalar(@diff) == 0 ) {
- carp "Records identical";
+ my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ unless ( @diff ) {
+ carp "warning: records identical";
return '';
}
- return "Records not in same table!" unless $new->table eq $table;
+ return "Records not in same table!" unless $new->table eq $old->table;
- my($sth);
- my($statement)="UPDATE $table SET ". join(', ',
+ my $primary_key = $old->dbdef_table->primary_key;
+ return "Can't change $primary_key"
+ if $primary_key
+ && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
+
+ my $error = $new->check;
+ return $error if $error;
+
+ my $statement = "UPDATE ". $old->table. " SET ". join(', ',
map {
- "$_ = ". _quote($new->getfield($_),$table,$_)
+ "$_ = ". _quote($new->getfield($_),$old->table,$_)
} @diff
). ' WHERE '.
join(' AND ',
map {
$old->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($old->getfield($_),$table,$_)
-# } @fields
-# } ( primary_key($table) ? (primary_key($table)) : @fields )
- } ( $dbdef->table($table)->primary_key
- ? ($dbdef->table($table)->primary_key)
- : @fields
- )
+ #? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( datasrc =~ m/Pg/
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($old->getfield($_),$old->table,$_)
+ } ( $primary_key ? ( $primary_key ) : $old->fields )
)
;
- #warn $statement;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
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($rc);
- $rc=$sth->execute or return $sth->errstr;
+ my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
'';
}
+=item rep
+
+Depriciated (use replace instead).
+
+=cut
+
+sub rep {
+ cluck "warning: FS::Record::rep depriciated!";
+ replace @_; #call method in this scope
+}
+
+=item check
+
+Not yet implemented, croaks. Derived classes should provide a check method.
+
+=cut
+
+sub check {
+ croak "FS::Record::check not implemented; supply one in subclass!";
+}
+
=item unique COLUMN
Replaces COLUMN in record with a unique number. Called by the B<add> method
$self->getfield($field) =~ /^(\d+)$/ ||
$self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
$self->getfield($field) =~ /^(\d+e\d+)$/)
- or return "Illegal or empty (float) $field!";
+ or return "Illegal or empty (float) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_number {
my($self,$field)=@_;
$self->getfield($field) =~ /^(\d+)$/
- or return "Illegal or empty (numeric) $field!";
+ or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_numbern {
my($self,$field)=@_;
$self->getfield($field) =~ /^(\d*)$/
- or return "Illegal (numeric) $field!";
+ or return "Illegal (numeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_money {
my($self,$field)=@_;
+ $self->setfield($field, 0) if $self->getfield($field) eq '';
$self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
- or return "Illegal (money) $field!";
- $self->setfield($field,"$1$2$3" || 0);
+ or return "Illegal (money) $field: ". $self->getfield($field);
+ #$self->setfield($field, "$1$2$3" || 0);
+ $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
'';
}
sub ut_text {
my($self,$field)=@_;
$self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
- or return "Illegal or empty (text) $field";
+ or return "Illegal or empty (text) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_textn {
my($self,$field)=@_;
$self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
- or return "Illegal (text) $field";
+ or return "Illegal (text) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_alpha {
my($self,$field)=@_;
$self->getfield($field) =~ /^(\w+)$/
- or return "Illegal or empty (alphanumeric) $field!";
+ or return "Illegal or empty (alphanumeric) $field: ".
+ $self->getfield($field);
$self->setfield($field,$1);
'';
}
sub ut_alphan {
my($self,$field)=@_;
$self->getfield($field) =~ /^(\w*)$/
- or return "Illegal (alphanumeric) $field!";
+ or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
} else {
$phonen =~ s/\D//g;
$phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
- or return "Illegal (phone) $field!";
+ or return "Illegal (phone) $field: ". $self->getfield($field);
$phonen = "$1-$2-$3";
$phonen .= " x$4" if $4;
$self->setfield($field,$phonen);
sub ut_anything {
my($self,$field)=@_;
- $self->getfield($field) =~ /^(.*)$/ or return "Illegal $field!";
+ $self->getfield($field) =~ /^(.*)$/
+ or return "Illegal $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
+=item fields [ TABLE ]
+
+This can be used as both a subroutine and a method call. It returns a list
+of the columns in this record's table, or an explicitly specified table.
+(See L<dbdef_table>).
+
+=cut
+
+# Usage: @fields = fields($table);
+# @fields = $record->fields;
+sub fields {
+ my $something = shift;
+ my $table;
+ if ( ref($something) ) {
+ $table = $something->table;
+ } else {
+ $table = $something;
+ }
+ #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table;
+ my($table_obj) = $dbdef->table($table);
+ croak "Unknown table $table" unless $table_obj;
+ $table_obj->columns;
+}
=head1 SUBROUTINES
=cut
sub hfields {
- carp "hfields is depriciated";
+ carp "warning: hfields is depriciated";
my($table)=@_;
my(%hash);
foreach (fields($table)) {
\%hash;
}
-=item fields TABLE
-
-This returns a list of the columns in this record's table
-(See L<dbdef_table>).
-
-=cut
-
-# Usage: @fields = fields($table);
-sub fields {
- my($table) = @_;
- #my(@fields) = $dbdef->table($table)->columns;
- croak "Usage: \@fields = fields(\$table)" unless $table;
- my($table_obj) = $dbdef->table($table);
- croak "Unknown table $table" unless $table_obj;
- $table_obj->columns;
-}
-
#sub _dump {
# my($self)=@_;
# join("\n", map {
=back
+=head1 VERSION
+
+$Id: Record.pm,v 1.16 1999-04-10 07:03:38 ivan Exp $
+
=head1 BUGS
This module should probably be renamed, since much of the functionality is
ut_sqltype (like ut_varchar) should all be defined
-A fallback check method should be provided with uses the dbdef.
+A fallback check method should be provided whith uses the dbdef.
The ut_money method assumes money has two decimal digits.
All the subroutines probably should be methods, here or elsewhere.
+Probably should borrow/use some dbdef methods where appropriate (like sub
+fields)
+
=head1 SEE ALSO
L<FS::dbdef>, L<FS::UID>, L<DBI>
ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
+$Log: Record.pm,v $
+Revision 1.16 1999-04-10 07:03:38 ivan
+return the value with ut_* error messages, to assist in debugging
+
+Revision 1.15 1999/04/08 12:08:59 ivan
+fix up PostgreSQL money fields so you can actually use them as numbers. bah.
+
+Revision 1.14 1999/04/07 14:58:31 ivan
+more kludges to get around different null/empty handling in Perl vs. MySQL vs.
+PostgreSQL etc.
+
+Revision 1.13 1999/03/29 11:55:43 ivan
+eliminate warnings in ut_money
+
+Revision 1.12 1999/01/25 12:26:06 ivan
+yet more mod_perl stuff
+
+Revision 1.11 1999/01/18 09:22:38 ivan
+changes to track email addresses for email invoicing
+
+Revision 1.10 1998/12/29 11:59:33 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.9 1998/11/21 07:26:45 ivan
+"Records identical" carp tells us it is just a warning.
+
+Revision 1.8 1998/11/15 11:02:04 ivan
+bugsquash
+
+Revision 1.7 1998/11/15 10:56:31 ivan
+qsearch gets sames "IS NULL" semantics as other WHERE clauses
+
+Revision 1.6 1998/11/15 05:31:03 ivan
+bugfix for new config layout
+
+Revision 1.5 1998/11/13 09:56:51 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+Revision 1.4 1998/11/10 07:45:25 ivan
+doc clarification
+
+Revision 1.2 1998/11/07 05:17:18 ivan
+In sub new, Pg wrapper for money fields from dbdef (FS::Record::fields $table),
+not keys of supplied hashref.
+
+
=cut
1;
--- /dev/null
+package FS::UI::Base;
+
+use strict;
+use vars qw ( @ISA );
+use FS::Record qw( fields qsearch );
+
+@ISA = ( $FS::UI::Base::_lock );
+
+=head1 NAME
+
+FS::UI::Base - Base class for all user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::SomeInterface;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::Base object represents a user interface object. FS::UI::Base
+is intended as a base class for table-specfic classes to inherit from, i.e.
+FS::UI::cust_main. The simplest case, which will provide a default UI for your
+new table, is as follows:
+
+ package FS::UI::table_name;
+ use vars qw ( @ISA );
+ use FS::UI::Base;
+ @ISA = qw( FS::UI::Base );
+ sub db_table { 'table_name'; }
+
+Currently available interfaces are:
+ FS::UI::Gtk, an X-Windows UI implemented using the Gtk+ toolkit
+ FS::UI::CGI, a web interface implemented using CGI.pm, etc.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+=item browse
+
+=cut
+
+sub browse {
+ my $self = shift;
+
+ my @fields = $self->list_fields;
+
+ #begin browse-specific stuff
+
+ $self->title( "Browse ". $self->db_names ) unless $self->title;
+ my @records = qsearch ( $self->db_table, {} );
+
+ #end browse-specific stuff
+
+ $self->addwidget ( new FS::UI::_Text ( $self->db_description ) );
+
+ my @header = $self->list_header;
+ my @headerspan = $self->list_headerspan;
+ my %callback = $self->db_callback;
+
+ my $columns;
+
+ my $table = new FS::UI::_Tableborder (
+ 'rows' => 1 + scalar(@records),
+ 'columns' => $columns || scalar(@fields),
+ );
+
+ my $c = 0;
+ foreach my $header ( @header ) {
+ my $headerspan = shift(@headerspan) || 1;
+ $table->attach(
+ 0, $c, new FS::UI::_Text ( $header ), 1, $headerspan
+ );
+ $c += $headerspan;
+ }
+
+ my $r = 1;
+
+ foreach my $record ( @records ) {
+ $c = 0;
+ foreach my $field ( @fields ) {
+ my $value = $record->getfield($field);
+ my $widget;
+ if ( $callback{$field} ) {
+ $widget = &{ $callback{$field} }( $value, $record );
+ } else {
+ $widget = new FS::UI::_Text ( $value );
+ }
+ $table->attach( $r, $c++, $widget, 1, 1 );
+ }
+ $r++;
+ }
+
+ $self->addwidget( $table );
+
+ $self->activate;
+
+}
+
+=item title
+
+=cut
+
+sub title {
+ my $self = shift;
+ my $value = shift;
+ if ( defined($value) ) {
+ $self->{'title'} = $value;
+ } else {
+ $self->{'title'};
+ }
+}
+
+=item addwidget
+
+=cut
+
+sub addwidget {
+ my $self = shift;
+ my $widget = shift;
+ push @{ $self->{'Widgets'} }, $widget;
+}
+
+#fallback methods
+
+sub db_description {}
+
+sub db_name {}
+
+sub db_names {
+ my $self = shift;
+ $self->db_name. 's';
+}
+
+sub list_fields {
+ my $self = shift;
+ fields( $self->db_table );
+}
+
+sub list_header {
+ my $self = shift;
+ $self->list_fields
+}
+
+sub list_headerspan {
+ my $self = shift;
+ map 1, $self->list_header;
+}
+
+sub db_callback {}
+
+=back
+
+=head1 VERSION
+
+$Id: Base.pm,v 1.1 1999-01-20 09:30:36 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+There should be some sort of per-(freeside)-user preferences and the ability
+for specific FS::UI:: modules to put their own values there as well.
+
+=head1 SEE ALSO
+
+L<FS::UI::Gtk>, L<FS::UI::CGI>
+
+=head1 HISTORY
+
+$Log: Base.pm,v $
+Revision 1.1 1999-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::CGI;
+
+use strict;
+use CGI;
+#use CGI::Switch; #when FS::UID user and preference callback stuff is fixed
+use CGI::Carp qw(fatalsToBrowser);
+use HTML::Table;
+use FS::UID qw(adminsuidsetup);
+#use FS::Record qw( qsearch fields );
+
+die "Can't initialize CGI interface; $FS::UI::Base::_lock used"
+ if $FS::UI::Base::_lock;
+$FS::UI::Base::_lock = "FS::UI::CGI";
+
+=head1 NAME
+
+FS::UI::CGI - Base class for CGI user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::CGI;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::CGI object represents a CGI interface object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+
+ $self->{'_cgi'} = new CGI;
+ $self->{'_user'} = $self->{'_cgi'}->remote_user;
+ $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
+
+ bless ( $self, $class);
+}
+
+sub activate {
+ my $self = shift;
+ print $self->_header,
+ join ( "<BR>", map $_->sprint, @{ $self->{'Widgets'} } ),
+ $self->_footer,
+ ;
+}
+
+=item _header
+
+=cut
+
+sub _header {
+ my $self = shift;
+ my $cgi = $self->{'_cgi'};
+
+ $cgi->header( '-expires' => 'now' ), '<HTML>',
+ '<HEAD><TITLE>', $self->title, '</TITLE></HEAD>',
+ '<BODY BGCOLOR="#ffffff">',
+ '<FONT COLOR="#ff0000" SIZE=7>', $self->title, '</FONT><BR><BR>',
+ ;
+}
+
+=item _footer
+
+=cut
+
+sub _footer {
+ "</BODY></HTML>";
+}
+
+=item interface
+
+Returns the string `CGI'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+
+=cut
+
+sub interface { 'CGI'; }
+
+=back
+
+=cut
+
+package FS::UI::_Widget;
+
+use vars qw( $AUTOLOAD );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $value = shift;
+ my($field)=$AUTOLOAD;
+ $field =~ s/.*://;
+ if ( defined($value) ) {
+ $self->{$field} = $value;
+ } else {
+ $self->{$field};
+ }
+}
+
+package FS::UI::_Text;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ $self->{'_text'} = shift;
+ bless ( $self, $class );
+}
+
+sub sprint {
+ my $self = shift;
+ $self->{'_text'};
+}
+
+package FS::UI::_Link;
+
+use vars qw ( @ISA $BASE_URL );
+
+@ISA = qw ( FS::UI::_Widget);
+$BASE_URL = "http://rootwood.sisd.com/freeside";
+
+sub sprint {
+ my $self = shift;
+ my $table = $self->{'table'};
+ my $method = $self->{'method'};
+
+ # i will be cleaned up when we're done moving from the old webinterface!
+ my @arg = @{$self->{'arg'}};
+ my $yuck = join( "&", @arg);
+ qq(<A HREF="$BASE_URL/$method/$table.cgi?$yuck">). $self->{'text'}. "<\A>";
+}
+
+package FS::UI::_Table;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class eq $proto ? { @_ } : $proto;
+ bless ( $self, $class );
+ $self->{'_table'} = new HTML::Table ( $self->rows, $self->columns );
+ $self;
+}
+
+sub attach {
+ my $self = shift;
+ my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
+ $self->{"_table"}->setCell( $row+1, $column+1, $widget->sprint );
+ $self->{"_table"}->setCellRowSpan( $row+1, $column+1, $rowspan ) if $rowspan;
+ $self->{"_table"}->setCellColSpan( $row+1, $column+1, $colspan ) if $colspan;
+}
+
+sub sprint {
+ my $self = shift;
+ $self->{'_table'}->getTable;
+}
+
+package FS::UI::_Tableborder;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Table );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class eq $proto ? { @_ } : $proto;
+ bless ( $self, $class );
+ $self->SUPER::new(@_);
+ $self->{'_table'}->setBorder;
+ $self;
+}
+
+=head1 VERSION
+
+$Id: CGI.pm,v 1.1 1999-01-20 09:30:36 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+In _Tableborder, headers should be links that sort on their fields.
+
+_Link uses a constant $BASE_URL
+
+_Link passes the arguments as a manually-constructed GET string instead
+of POSTing, for compatability while the web interface is upgraded. Once
+this is done it should pass arguements properly (i.e. as a POST, 8-bit clean)
+
+Still some small bits of widget code same as FS::UI::Gtk.
+
+=head1 SEE ALSO
+
+L<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: CGI.pm,v $
+Revision 1.1 1999-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::Gtk;
+
+use strict;
+use Gtk;
+use FS::UID qw(adminsuidsetup);
+
+die "Can't initialize Gtk interface; $FS::UI::Base::_lock used"
+ if $FS::UI::Base::_lock;
+$FS::UI::Base::_lock = "FS::UI::Gtk";
+
+=head1 NAME
+
+FS::UI::Gtk - Base class for Gtk user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::Gtk;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::Gtk object represents a Gtk user interface object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+
+ bless ( $self, $class );
+
+ $self->{'_user'} = 'ivan'; #Pop up login window?
+ $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
+
+
+
+ $self;
+}
+
+sub activate {
+ my $self = shift;
+
+ my $vbox = new Gtk::VBox ( 0, 4 );
+
+ foreach my $widget ( @{ $self->{'Widgets'} } ) {
+ $widget->_gtk->show;
+ $vbox->pack_start ( $widget->_gtk, 1, 1, 4 );
+ }
+ $vbox->show;
+
+ my $window = new Gtk::Window "toplevel";
+ $self->{'_gtk'} = $window;
+ $window->set_title( $self->title );
+ $window->add ( $vbox );
+ $window->show;
+ main Gtk;
+}
+
+=item interface
+
+Returns the string `Gtk'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+
+=cut
+
+sub interface { 'Gtk'; }
+
+=back
+
+=cut
+
+package FS::UI::_Widget;
+
+use vars qw( $AUTOLOAD );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+}
+
+sub _gtk {
+ my $self = shift;
+ $self->{'_gtk'};
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $value = shift;
+ my($field)=$AUTOLOAD;
+ $field =~ s/.*://;
+ if ( defined($value) ) {
+ $self->{$field} = $value;
+ } else {
+ $self->{$field};
+ }
+}
+
+package FS::UI::_Text;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ $self->{'_gtk'} = new Gtk::Label ( shift );
+ bless ( $self, $class );
+}
+
+package FS::UI::_Link;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ $self->{'_gtk'} = new_with_label Gtk::Button ( $self->{'text'} );
+ $self->{'_gtk'}->signal_connect( 'clicked', sub {
+ print "STUB: (Gtk) FS::UI::_Link";
+ }, "hi", "there" );
+ bless ( $self, $class );
+}
+
+
+package FS::UI::_Table;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+
+ $self->{'_gtk'} = new Gtk::Table (
+ $self->rows,
+ $self->columns,
+ 0, #homogeneous
+ );
+
+ $self;
+}
+
+sub attach {
+ my $self = shift;
+ my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
+ $rowspan ||= 1;
+ $colspan ||= 1;
+ $self->_gtk->attach_defaults(
+ $widget->_gtk,
+ $column,
+ $column + $colspan,
+ $row,
+ $row + $rowspan,
+ );
+ $widget->_gtk->show;
+}
+
+package FS::UI::_Tableborder;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Table );
+
+=head1 VERSION
+
+$Id: Gtk.pm,v 1.1 1999-01-20 09:30:36 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+_Tableborder is just a _Table now. _Tableborders should scroll (but not the
+headers) and need and need more decoration. (data in white section ala gtksql
+and sliding field widths) headers should be buttons that callback to sort on
+their fields.
+
+There should be a persistant, per-(freeside)-user store for window positions
+and sizes and sort fields etc (see L<FS::UI::CGI/BUGS>.
+
+Still some small bits of widget code same as FS::UI::CGI.
+
+=head1 SEE ALSO
+
+L<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: Gtk.pm,v $
+Revision 1.1 1999-01-20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::agent;
+
+use strict;
+use vars qw ( @ISA );
+use FS::UI::Base;
+use FS::Record qw( qsearchs );
+use FS::agent;
+use FS::agent_type;
+
+@ISA = qw ( FS::UI::Base );
+
+sub db_table { 'agent' };
+
+sub db_name { 'Agent' };
+
+sub db_description { <<END;
+Agents are resellers of your service. Agents may be limited to a subset of your
+full offerings (via their type).
+END
+}
+
+sub list_fields {
+ 'agentnum',
+ 'typenum',
+# 'freq',
+# 'prog',
+; }
+
+sub list_header {
+ 'Agent',
+ 'Type',
+# 'Freq (n/a)',
+# 'Prog (n/a)',
+; }
+
+sub db_callback {
+ 'agentnum' =>
+ sub {
+ my ( $agentnum, $record ) = @_;
+ my $agent = $record->agent;
+ new FS::UI::_Link (
+ 'table' => 'agent',
+ 'method' => 'edit',
+ 'arg' => [ $agentnum ],
+ 'text' => "$agentnum: $agent",
+ );
+ },
+ 'typenum' =>
+ sub {
+ my $typenum = shift;
+ my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
+ my $atype = $agent_type->atype;
+ new FS::UI::_Link (
+ 'table' => 'agent_type',
+ 'method' => 'edit',
+ 'arg' => [ $typenum ],
+ 'text' => "$typenum: $atype"
+ );
+ },
+}
+
+1;
use strict;
use vars qw(
- @ISA @EXPORT_OK $cgi $dbh $freeside_uid $conf $datasrc $db_user $db_pass
+ @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
+ $conf_dir $secrets $datasrc $db_user $db_pass %callback
+);
+use subs qw(
+ getsecrets cgisetotaker
);
use Exporter;
use Carp;
@ISA = qw(Exporter);
@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
- adminsuidsetup getotaker dbh datasrc);
+ adminsuidsetup getotaker dbh datasrc getsecrets );
$freeside_uid = scalar(getpwnam('freeside'));
-my $conf = new FS::Conf;
-($datasrc, $db_user, $db_pass) = $conf->config('secrets')
- or die "Can't get secrets: $!";
+$conf_dir = "/usr/local/etc/freeside/";
=head1 NAME
use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
checkeuid checkruid swapuid);
- adminsuidsetup;
+ adminsuidsetup $user;
- $cgi = new CGI::Base;
- $cgi->get;
+ $cgi = new CGI;
$dbh = cgisuidsetup($cgi);
$dbh = dbh;
=over 4
-=item adminsuidsetup
+=item adminsuidsetup USER
+Sets the user to USER (see config.html from the base documentation).
Cleans the environment.
Make sure the script is running as freeside, or setuid freeside.
Opens a connection to the database.
Swaps real and effective UIDs.
+Runs any defined callbacks (see below).
Returns the DBI database handle (usually you don't need this).
=cut
sub adminsuidsetup {
+ $user = shift;
+ croak "fatal: adminsuidsetup called without arguements" unless $user;
+
$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'BASH_ENV'} = '';
croak "Not running uid freeside!" unless checkeuid();
+ getsecrets;
$dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- # hack for web demo
- # my($user)=getotaker();
- # $dbh = DBI->connect("$datasrc:$user",$db_user,$db_pass, {
'AutoCommit' => 'true',
'ChopBlanks' => 'true',
- } ) or die "DBI->connect error: $DBI::errstr\n";;
+ } ) or die "DBI->connect error: $DBI::errstr\n";
swapuid(); #go to non-privledged user if running setuid freeside
+ foreach ( keys %callback ) {
+ &{$callback{$_}};
+ }
+
$dbh;
}
-=item cgisuidsetup CGI::Base_OBJECT
-Stores the CGI::Base_OBJECT for later use.
+=item cgisuidsetup CGI_object
+
+Stores the CGI (see L<CGI>) object for later use. (CGI::Base is depriciated)
Runs adminsuidsetup.
=cut
sub cgisuidsetup {
- $cgi=$_[0];
- adminsuidsetup;
+ $cgi=shift;
+ if ( $cgi->isa('CGI::Base') ) {
+ carp "Use of CGI::Base is depriciated";
+ } elsif ( ! $cgi->isa('CGI') ) {
+ croak "Pass a CGI object to cgisuidsetup!";
+ }
+ cgisetotaker;
+ adminsuidsetup($user);
+}
+
+=item cgi
+
+Returns the CGI (see L<CGI>) object.
+
+=cut
+
+sub cgi {
+ $cgi;
}
=item dbh
=item getotaker
-Returns the current Freeside user. Currently that means the CGI REMOTE_USER,
-or 'freeside'.
+Returns the current Freeside user.
=cut
sub getotaker {
- if ($cgi && defined $cgi->var('REMOTE_USER')) {
- return $cgi->var('REMOTE_USER'); #for now
+ $user;
+}
+
+=item cgisetotaker
+
+Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
+object. Support for CGI::Base and derived classes is depriciated.
+
+=cut
+
+sub cgisetotaker {
+ if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
+ carp "Use of CGI::Base is depriciated";
+ $user = lc ( $cgi->var('REMOTE_USER') );
+ } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
+ $user = lc ( $cgi->remote_user );
} else {
- 'freeside';
+ die "fatal: Can't get REMOTE_USER!";
}
+ $user;
}
=item checkeuid
=cut
sub swapuid {
- ($<,$>) = ($>,$<);
+ ($<,$>) = ($>,$<) if $< != $>;
+}
+
+=item getsecrets [ USER ]
+
+Sets the user to USER, if supplied.
+Sets and returns the DBI datasource, username and password for this user from
+the `/usr/local/etc/freeside/mapsecrets' file.
+
+=cut
+
+sub getsecrets {
+ my($setuser) = shift;
+ $user = $setuser if $setuser;
+ die "No user!" unless $user;
+ my($conf) = new FS::Conf $conf_dir;
+ my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
+ die "User not found in mapsecrets!" unless $line;
+ $line =~ /^\s*$user\s+(.*)$/;
+ $secrets = $1;
+ die "Illegal mapsecrets line for user?!" unless $secrets;
+ ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
+ or die "Can't get secrets: $!";
+ $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
+ ($datasrc, $db_user, $db_pass);
}
=back
+=head1 CALLBACKS
+
+Warning: this interface is likely to change in future releases.
+
+A package can install a callback to be run in adminsuidsetup by putting a
+coderef into the hash %FS::UID::callback :
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ $FS::UID::callback{'Package::Name'};
+
+=head1 VERSION
+
+$Id: UID.pm,v 1.11 1999-04-14 07:58:39 ivan Exp $
+
=head1 BUGS
+Too many package-global variables.
+
Not OO.
No capabilities yet. When mod_perl and Authen::DBI are implemented,
cgisuidsetup will go away as well.
+Goes through contortions to support non-OO syntax with multiple datasrc's.
+
+Callbacks are inelegant.
+
=head1 SEE ALSO
-L<FS::Record>, L<CGI::Base>, L<DBI>
+L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
=head1 HISTORY
inlined suidsetup
ivan@sisd.com 98-sep-12
+$Log: UID.pm,v $
+Revision 1.11 1999-04-14 07:58:39 ivan
+export getsecrets from FS::UID instead of calling it explicitly
+
+Revision 1.10 1999/04/12 22:41:09 ivan
+bugfix; $user is a global (yuck)
+
+Revision 1.9 1999/04/12 21:09:39 ivan
+force username to lowercase
+
+Revision 1.8 1999/02/23 07:23:23 ivan
+oops, don't comment out &swapuid in &adminsuidsetup!
+
+Revision 1.7 1999/01/18 09:22:40 ivan
+changes to track email addresses for email invoicing
+
+Revision 1.6 1998/11/15 05:27:48 ivan
+bugfix for new configuration layout
+
+Revision 1.5 1998/11/15 00:51:51 ivan
+eliminated some warnings on certain fatal errors (well, it is less confusing)
+
+Revision 1.4 1998/11/13 09:56:52 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+Revision 1.3 1998/11/08 10:45:42 ivan
+got sub cgi for FS::CGI
+
+Revision 1.2 1998/11/08 09:38:43 ivan
+cgisuidsetup complains if you pass it a isa CGI::Base instead of an isa CGI
+(first step in migrating from CGI-modules to CGI.pm)
+
+
=cut
1;
package FS::agent;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::agent_type;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::agent;
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
+ $record = new FS::agent \%hash;
+ $record = new FS::agent { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new agent. To add the agent to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent',$hashref);
-}
+sub table { 'agent'; }
=item insert
Adds this agent to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this agent from the database. Only agents with no customers can be
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
+
return "Can't delete an agent with customers!"
- if qsearch('cust_main',{'agentnum' => $self->agentnum});
- $self->del;
+ if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } );
+
+ $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.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an agent record!" unless $old->table eq "agent";
- return "Can't change agentnum!"
- unless $old->getfield('agentnum') eq $new->getfield('agentnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid agent. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a agent record!" unless $self->table eq "agent";
+ my $self = shift;
- my($error)=
+ my $error =
$self->ut_numbern('agentnum')
- or $self->ut_text('agent')
- or $self->ut_number('typenum')
- or $self->ut_numbern('freq')
- or $self->ut_textn('prog')
+ || $self->ut_text('agent')
+ || $self->ut_number('typenum')
+ || $self->ut_numbern('freq')
+ || $self->ut_textn('prog')
;
return $error if $error;
return "Unknown typenum!"
- unless qsearchs('agent_type',{'typenum'=> $self->getfield('typenum') });
+ unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
'';
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: agent.pm,v 1.4 1998-12-30 00:30:44 ivan Exp $
+
+=head1 BUGS
=head1 SEE ALSO
package FS::agent_type;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(qsearch fields);
+use vars qw( @ISA );
+use FS::Record qw( qsearch );
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::agent_type;
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
+ $record = new FS::agent_type \%hash;
+ $record = new FS::agent_type { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new agent type. To add the agent type to the database, see
L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent_type')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent_type',$hashref);
-
-}
+sub table { 'agent_type'; }
=item insert
Adds this agent type to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this agent type from the database. Only agent types with no agents
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
+
return "Can't delete an agent_type with agents!"
- if qsearch('agent',{'typenum' => $self->typenum});
- $self->del;
+ if qsearch( 'agent', { 'typenum' => $self->typenum } );
+
+ $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.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a agent_type record!" unless $old->table eq "agent_type";
- return "Can't change typenum!"
- unless $old->getfield('typenum') eq $new->getfield('typenum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid agent type. If there is an
=cut
sub check {
- my($self)=@_;
- return "Not a agent_type record!" unless $self->table eq "agent_type";
+ my $self = shift;
$self->ut_numbern('typenum')
or $self->ut_text('atype');
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: agent_type.pm,v 1.2 1998-12-29 11:59:35 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
=head1 SEE ALSO
pod, added check in delete ivan@sisd.com 98-sep-21
+$Log: agent_type.pm,v $
+Revision 1.2 1998-12-29 11:59:35 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::cust_bill;
use strict;
-use vars qw(@ISA $conf $add1 $add2 $add3 $add4);
-use Exporter;
+use vars qw( @ISA $conf $add1 $add2 $add3 $add4 );
use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::cust_bill_pkg;
+use FS::cust_credit;
+use FS::cust_pay;
+use FS::cust_pkg;
-@ISA = qw(FS::Record Exporter);
+@ISA = qw( FS::Record );
-$conf = new FS::Conf;
-
-($add1,$add2,$add3,$add4) = $conf->config('address');
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_bill'} = sub {
+ $conf = new FS::Conf;
+ ( $add1, $add2, $add3, $add4 ) = ( $conf->config('address'), '', '', '', '' );
+};
=head1 NAME
use FS::cust_bill;
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
+ $record = new FS::cust_bill \%hash;
+ $record = new FS::cust_bill { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new invoice. To add the invoice to the database, see L<"insert">.
Invoices are normally created by calling the bill method of a customer object
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill',$hashref);
-}
+sub table { 'cust_bill'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- $self->setfield('owed',$self->charged) if $self->owed eq '';
+ $self->owed( $self->charged ) if $self->owed eq '';
return "owed != charged!"
unless $self->owed == $self->charged;
- $self->check or
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't remove invoice!"
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_bill record!" unless $old->table eq "cust_bill";
- return "Can't change invnum!"
- unless $old->getfield('invnum') eq $new->getfield('invnum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change _date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change charged!"
- unless $old->getfield('charged') eq $new->getfield('charged');
- return "(New) owed can't be > (new) charged!"
- if $new->getfield('owed') > $new->getfield('charged');
-
- $new->check or
- $new->rep($old);
+ my( $new, $old ) = ( shift, shift );
+ return "Can't change custnum!" unless $old->custnum == $new->custnum;
+ #return "Can't change _date!" unless $old->_date eq $new->_date;
+ return "Can't change _date!" unless $old->_date == $new->_date;
+ return "Can't change charged!" unless $old->charged == $new->charged;
+ return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged;
+
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_bill record!" unless $self->table eq "cust_bill";
- my($recref) = $self->hashref;
-
- $recref->{invnum} =~ /^(\d*)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('charged')
+ || $self->ut_money('owed')
+ || $self->ut_numbern('printed')
+ ;
+ return $error if $error;
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- #$recref->{charged} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} = $1;
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- $recref->{owed} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal owed";
- $recref->{owed} = $1;
+ $self->_date(time) unless $self->_date;
- $recref->{printed} =~ /^(\d*)$/ or return "Illegal printed";
- $recref->{printed} = $1 || '0';
+ $self->printed(0) if $self->printed eq '';
''; #no error
}
=cut
sub previous {
- my($self)=@_;
- my($total)=0;
- my(@cust_bill) = sort { $a->_date <=> $b->_date }
+ my $self = shift;
+ my $total = 0;
+ my @cust_bill = sort { $a->_date <=> $b->_date }
grep { $_->owed != 0 && $_->_date < $self->_date }
- qsearch('cust_bill',{ 'custnum' => $self->custnum } )
+ qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
;
- foreach (@cust_bill) { $total += $_->owed; }
+ foreach ( @cust_bill ) { $total += $_->owed; }
$total, @cust_bill;
}
=cut
sub cust_bill_pkg {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
}
=cut
sub cust_credit {
- my($self)=@_;
- my($total)=0;
- my(@cust_credit) = sort { $a->_date <=> $b->date }
+ my $self = shift;
+ my $total = 0;
+ my @cust_credit = sort { $a->_date <=> $b->date }
grep { $_->credited != 0 && $_->_date < $self->_date }
qsearch('cust_credit', { 'custnum' => $self->custnum } )
;
=cut
sub cust_pay {
- my($self)=@_;
+ my $self = shift;
sort { $a->_date <=> $b->date }
qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
;
sub print_text {
- my($self,$today)=@_;
+ my( $self, $today ) = ( shift, shift );
$today ||= time;
- my($invnum)=$self->invnum;
- my($cust_main) = qsearchs('cust_main',
- { 'custnum', $self->custnum } );
- $cust_main->setfield('payname',
- $cust_main->first. ' '. $cust_main->getfield('last')
- ) unless $cust_main->payname;
+ my $invnum = $self->invnum;
+ my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } );
+ $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
+ unless $cust_main->payname;
- my($pr_total,@pr_cust_bill) = $self->previous; #previous balance
- my($cr_total,@cr_cust_credit) = $self->cust_credit; #credits
- my($balance_due) = $self->owed + $pr_total - $cr_total;
+ my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
+ my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
+ my $balance_due = $self->owed + $pr_total - $cr_total;
#overdue?
- my($overdue) = (
+ my $overdue = (
$balance_due > 0
&& $today > $self->_date
&& $self->printed > 1
);
- #printing bits here
-
- local($SIG{CHLD}) = sub { wait() };
- $|=1;
- my($pid)=open(CHILD,"-|");
- die "Can't fork: $!" unless defined($pid);
-
- if ($pid) { #parent
- my(@collect)=<CHILD>;
- close CHILD;
- return @collect;
- } else { #child
-
- my($description,$amount);
- my(@buf);
-
- #define format stuff
- $%=0;
- $= = 35;
- local($^L) = <<END;
-
-
-
-
+ #printing bits here (yuck!)
+ my @collect = ();
+ my($description,$amount);
+ my(@buf);
-END
+ #format address
+ my($l,@address)=(0,'','','','','','','');
+ $address[$l++] =
+ $cust_main->payname.
+ ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo
+ ? " (P.O. #". $cust_main->payinfo. ")"
+ : ''
+ )
+ ;
+ $address[$l++]=$cust_main->company if $cust_main->company;
+ $address[$l++]=$cust_main->address1;
+ $address[$l++]=$cust_main->address2 if $cust_main->address2;
+ $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ".
+ $cust_main->zip;
+ $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
+
+ #previous balance
+ foreach ( @pr_cust_bill ) {
+ push @buf, (
+ "Previous Balance, Invoice #". $_->invnum.
+ " (". time2str("%x",$_->_date). ")",
+ '$'. sprintf("%10.2f",$_->owed)
+ );
+ }
+ if (@pr_cust_bill) {
+ push @buf,('','-----------');
+ push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
+ push @buf,('','');
+ }
- #format address
- my($l,@address)=(0,'','','','','');
- $address[$l++]=$cust_main->company if $cust_main->company;
- $address[$l++]=$cust_main->address1;
- $address[$l++]=$cust_main->address2 if $cust_main->address2;
- $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ".
- $cust_main->zip;
- $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
-
- #previous balance
- foreach ( @pr_cust_bill ) {
- push @buf, (
- "Previous Balance, Invoice #". $_->invnum.
- " (". time2str("%x",$_->_date). ")",
- '$'. sprintf("%10.2f",$_->owed)
- );
- }
- if (@pr_cust_bill) {
- push @buf,('','-----------');
- push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
- push @buf,('','');
- }
+ #new charges
+ foreach ( $self->cust_bill_pkg ) {
- #new charges
- foreach ( $self->cust_bill_pkg ) {
+ if ( $_->pkgnum ) {
- if ( $_->pkgnum ) {
+ my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->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 ( $_->setup != 0 ) {
+ push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) );
+ push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
+ }
- push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
+ if ( $_->recur != 0 ) {
push @buf, (
"$pkg (" . time2str("%x",$_->sdate) . " - " .
time2str("%x",$_->edate) . ")",
'$' . sprintf("%10.2f",$_->recur)
- ) if $_->recur != 0;
-
- } else { #pkgnum Tax
- push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
+ );
+ push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
}
- }
-
- push @buf,('','-----------');
- push @buf,('Total New Charges',
- '$' . sprintf("%10.2f",$self->charged) );
- push @buf,('','');
- push @buf,('','-----------');
- push @buf,('Total Charges',
- '$' . sprintf("%10.2f",$self->charged + $pr_total) );
- push @buf,('','');
-
- #credits
- foreach ( @cr_cust_credit ) {
- push @buf,(
- "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
- '$' . sprintf("%10.2f",$_->credited)
- );
+ } else { #pkgnum Tax
+ push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
+ if $_->setup != 0;
}
-
- #get & print payments
- foreach ( $self->cust_pay ) {
- push @buf,(
- "Payment received ". time2str("%x",$_->_date ),
- '$' . sprintf("%10.2f",$_->paid )
- );
- }
-
- #balance due
- push @buf,('','-----------');
- push @buf,('Balance Due','$' .
- sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
-
- #now print
-
- my($tot_pages)=int(scalar(@buf)/30); #15 lines, 2 values per line
- $tot_pages++ if scalar(@buf) % 30;
-
- while (@buf) {
+ }
+
+ push @buf,('','-----------');
+ push @buf,('Total New Charges',
+ '$' . sprintf("%10.2f",$self->charged) );
+ push @buf,('','');
+
+ push @buf,('','-----------');
+ push @buf,('Total Charges',
+ '$' . sprintf("%10.2f",$self->charged + $pr_total) );
+ push @buf,('','');
+
+ #credits
+ foreach ( @cr_cust_credit ) {
+ push @buf,(
+ "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
+ '$' . sprintf("%10.2f",$_->credited)
+ );
+ }
+
+ #get & print payments
+ foreach ( $self->cust_pay ) {
+ push @buf,(
+ "Payment received ". time2str("%x",$_->_date ),
+ '$' . sprintf("%10.2f",$_->paid )
+ );
+ }
+
+ #balance due
+ push @buf,('','-----------');
+ push @buf,('Balance Due','$' .
+ sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
+
+ #now print
+
+ my $tot_lines = 50; #should be configurable
+ #header is 17 lines
+ my $tot_pages = int( scalar(@buf) / ( 2 * ( $tot_lines - 17 ) ) );
+ $tot_pages++ if scalar(@buf) % ( 2 * ( $tot_lines - 17 ) );
+
+ my $page = 1;
+ my $lines;
+ while (@buf) {
+ $lines = $tot_lines;
+ my @header = &header(
+ $page, $tot_pages, $self->_date, $self->invnum, @address
+ );
+ push @collect, @header;
+ $lines -= scalar(@header);
+
+ while ( $lines-- && @buf ) {
$description=shift(@buf);
$amount=shift(@buf);
- write;
+ push @collect, myswrite($description, $amount);
}
- ($description,$amount)=('','');
- write while ( $- );
- print $^L;
-
- exit; #kid
-
- format STDOUT_TOP =
-
- @|||||||||||||||||||
- "Invoice"
- @||||||||||||||||||| @<<<<<<< @<<<<<<<<<<<
-{
- ( $tot_pages != 1 ) ? "Page $% of $tot_pages" : '',
- time2str("%x",( $self->_date )), "FS-$invnum"
-}
-
-
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add1
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add2
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add3
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add4
-
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-{ $cust_main->payname,
- ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo )
- ? "P.O. #". $cust_main->payinfo : ''
-}
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[0],''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[1],$overdue ? "* This invoice is now PAST DUE! *" : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[2],$overdue ? " Please forward payment promptly " : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[3],$overdue ? "to avoid interruption of service." : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[4],''
-
-
-
-.
-
- format STDOUT =
+ $page++;
+ }
+ while ( $lines-- ) {
+ push @collect, myswrite('', '');
+ }
+
+ return @collect;
+
+ sub header { #17 lines
+ my ( $page, $tot_pages, $date, $invnum, @address ) = @_ ;
+ push @address, '', '', '', '';
+
+ my @return = ();
+ my $i = ' 'x32;
+ push @return,
+ '',
+ $i. 'Invoice',
+ $i. substr("Page $page of $tot_pages".' 'x10, 0, 20).
+ time2str("%x", $date ). " FS-". $invnum,
+ '',
+ '',
+ $add1,
+ $add2,
+ $add3,
+ $add4,
+ '',
+ splice @address, 0, 7;
+ ;
+ return map $_. "\n", @return;
+ }
+
+ sub myswrite {
+ my $format = <<END;
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
- $description,$amount
-.
-
- } #endchild
+END
+ $^A = '';
+ formline( $format, @_ );
+ return $^A;
+ }
}
=back
+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.7 1999-02-09 09:55:05 ivan Exp $
+
=head1 BUGS
The delete method.
-It doesn't properly override FS::Record yet.
-
-print_text formatting (and some logic :/) is in source as a format declaration,
-which needs to be slurped in from a file. the fork is rather kludgy as well.
-It could be cleaned with swrite from man perlform, and the picture could be
-put in a /var/spool/freeside/conf file. Also number of lines ($=).
+print_text formatting (and some logic :/) is in source, but needs to be
+slurped in from a file. Also number of lines ($=).
missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
or something similar so the look can be completely customized?)
-There is an off-by-one error in print_text which causes a visual error: "Page 1
-of 2" printed on some single-page invoices?
-
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_main>, L<FS::cust_pay>, L<FS::cust_bill_pkg>,
pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
+$Log: cust_bill.pm,v $
+Revision 1.7 1999-02-09 09:55:05 ivan
+invoices show line items for each service in a package (see the label method
+of FS::cust_svc)
+
+Revision 1.6 1999/01/25 12:26:07 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1999/01/18 21:58:03 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.4 1998/12/29 11:59:36 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.3 1998/11/13 09:56:53 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+Revision 1.2 1998/11/07 10:24:24 ivan
+don't use depriciated FS::Bill and FS::Invoice, other miscellania
+
+
=cut
1;
package FS::cust_bill_pkg;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::cust_pkg;
+use FS::cust_bill;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw(FS::Record );
=head1 NAME
use FS::cust_bill_pkg;
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
+ $record = new FS::cust_bill_pkg \%hash;
+ $record = new FS::cust_bill_pkg { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new line item. To add the line item to the database, see
L<"insert">. Line items are normally created by calling the bill method of a
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill_pkg',$hashref);
-
-}
+sub table { 'cust_bill_pkg'; }
=item insert
Adds this line item to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented. I don't remove line items because there would then be
sub delete {
return "Can't delete cust_bill_pkg records!";
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
sub replace {
return "Can't modify cust_bill_pkg records!";
- #my($new,$old)=@_;
- #return "(Old) Not a cust_bill_pkg record!"
- # unless $old->table eq "cust_bill_pkg";
- #
- #$new->check or
- #$new->rep($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_bill_pkg record!" unless $self->table eq "cust_bill_pkg";
+ my $self = shift;
- my($error)=
+ my $error =
$self->ut_number('pkgnum')
- or $self->ut_number('invnum')
- or $self->ut_money('setup')
- or $self->ut_money('recur')
- or $self->ut_numbern('sdate')
- or $self->ut_numbern('edate')
+ || $self->ut_number('invnum')
+ || $self->ut_money('setup')
+ || $self->ut_money('recur')
+ || $self->ut_numbern('sdate')
+ || $self->ut_numbern('edate')
;
return $error if $error;
if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
- return "Unknown pkgnum ".$self->pkgnum
- unless qsearchs('cust_pkg',{'pkgnum'=> $self->pkgnum });
+ return "Unknown pkgnum ". $self->pkgnum
+ unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
}
return "Unknown invnum"
- unless qsearchs('cust_bill',{'invnum'=> $self->invnum });
+ unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
''; #no error
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: cust_bill_pkg.pm,v 1.2 1998-12-29 11:59:37 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
=head1 SEE ALSO
package FS::cust_credit;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearchs);
+use vars qw( @ISA );
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearchs );
+use FS::cust_main;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_credit;
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
+ $record = new FS::cust_credit \%hash;
+ $record = new FS::cust_credit { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new credit. To add the credit to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_credit')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_credit',$hashref);
-}
+sub table { 'cust_credit'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
+
+ my $error;
+ return $error if $error = $self->ut_money('credited')
+ || $self->ut_money('amount');
- $self->setfield('credited',$self->amount) if $self->credited eq '';
+ $self->credited($self->amount) if $self->credited == 0
+ || $self->credited eq '';
return "credited != amount!"
unless $self->credited == $self->amount;
- $self->check or
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't remove credit!"
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit";
- return "Can't change crednum!"
- unless $old->getfield('crednum') eq $new->getfield('crednum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change amount!"
- unless $old->getfield('amount') eq $new->getfield('amount');
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change custnum!" unless $old->custnum == $new->custnum;
+ #return "Can't change date!" unless $old->_date eq $new->_date;
+ return "Can't change date!" unless $old->_date == $new->_date;
+ return "Can't change amount!" unless $old->amount == $new->amount;
return "(New) credited can't be > (new) amount!"
- if $new->getfield('credited') > $new->getfield('amount');
+ if $new->credited > $new->amount;
- $new->check or
- $new->rep($old);
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_credit record!" unless $self->table eq "cust_credit";
- my($recref) = $self->hashref;
-
- $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum";
- $recref->{crednum} = $1;
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('crednum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('amount')
+ || $self->ut_money('credited')
+ || $self->ut_textn('reason');
+ ;
+ return $error if $error;
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount";
- $recref->{amount} = $1;
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited";
- $recref->{credited} = $1;
+ $self->_date(time) unless $self->_date;
- #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker";
- #$recref->{otaker} = $1;
$self->otaker(getotaker);
- $self->ut_textn('reason');
-
+ ''; #no error
}
=back
+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.4 1999-01-25 12:26:08 ivan Exp $
+
=head1 BUGS
The delete method.
-It doesn't properly override FS::Record yet.
-
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
pod, otaker from FS::UID ivan@sisd.com 98-sep-21
+$Log: cust_credit.pm,v $
+Revision 1.4 1999-01-25 12:26:08 ivan
+yet more mod_perl stuff
+
+Revision 1.3 1999/01/18 21:58:04 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.2 1998/12/29 11:59:38 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::cust_main;
use strict;
-use vars qw(@ISA @EXPORT_OK $conf $lpr $processor $xaction $E_NoErr);
+use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
+ $smtpmachine );
use Safe;
-use Exporter;
use Carp;
use Time::Local;
use Date::Format;
use Date::Manip;
+use Mail::Internet;
+use Mail::Header;
use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearchs qsearch);
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearchs qsearch );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_pay;
-#use FS::cust_pay_batch;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-$conf = new FS::Conf;
-$lpr = $conf->config('lpr');
-
-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"
+use FS::cust_credit;
+use FS::cust_pay_batch;
+use FS::part_referral;
+use FS::cust_main_county;
+use FS::agent;
+use FS::cust_main_invoice;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main'} = sub {
+ $conf = new FS::Conf;
+ $lpr = $conf->config('lpr');
+ $invoice_from = $conf->config('invoice_from');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ 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";
}
- my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
- die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
+ $processor='cybercash3.2';
+ } elsif ( $conf->exists('cybercash2') ) {
+ require CCLib;
+ #qw(sendmserver);
+ ( $main::paymentserverhost,
+ $main::paymentserverport,
+ $main::paymentserversecret,
+ $xaction,
+ ) = $conf->config('cybercash2');
+ $processor='cybercash2';
}
- $processor='cybercash3.2';
-} elsif ( $conf->exists('cybercash2') ) {
- require CCLib;
- #qw(sendmserver);
- ( $main::paymentserverhost,
- $main::paymentserverport,
- $main::paymentserversecret,
- $xaction,
- ) = $conf->config('cybercash2');
- $processor='cybercash2';
-}
+};
=head1 NAME
use FS::cust_main;
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
+ $record = new FS::cust_main \%hash;
+ $record = new FS::cust_main { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new customer. To add the customer to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my $field;
- #foreach $field (fields('cust_main')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main',$hashref);
-}
+sub table { 'cust_main'; }
=item insert
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- #no callbacks in check, only data checks
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented. Maybe cancel all of this customer's
=cut
-# Usage: $error = $record -> delete;
sub delete {
return "Can't (yet?) delete customers.";
-# my($self)=@_;
-#
-# $self->del;
}
=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
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main record!" unless $old->table eq "cust_main";
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid customer record. If there is
=cut
sub check {
- my($self)=@_;
-
- return "Not a cust_main record!" unless $self->table eq "cust_main";
+ my $self = shift;
my $error =
- $self->ut_number('agentnum')
+ $self->ut_numbern('custnum')
+ || $self->ut_number('agentnum')
|| $self->ut_number('refnum')
|| $self->ut_textn('company')
|| $self->ut_text('address1')
|| $self->ut_textn('address2')
|| $self->ut_text('city')
|| $self->ut_textn('county')
- || $self->ut_text('state')
+ || $self->ut_textn('state')
|| $self->ut_phonen('daytime')
|| $self->ut_phonen('night')
|| $self->ut_phonen('fax')
return $error if $error;
return "Unknown agent"
- unless qsearchs('agent',{'agentnum'=>$self->agentnum});
+ unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
return "Unknown referral"
- unless qsearchs('part_referral',{'refnum'=>$self->refnum});
+ unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
+ $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal last name: ". $self->getfield('last');
$self->setfield('last',$1);
- $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
+ $self->first =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal first name: ". $self->first;
$self->first($1);
if ( $self->ss eq '' ) {
my $ss = $self->ss;
$ss =~ s/\D//g;
$ss =~ /^(\d{3})(\d{2})(\d{4})$/
- or return "Illegal social security number";
+ or return "Illegal social security number: ". $self->ss;
$self->ss("$1-$2-$3");
}
- return "Unknown state/county/country"
- unless qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- } );
+ $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
+ $self->country($1);
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ }
- #int'l zips?
- $self->zip =~ /^(\d{5}(-\d{4})?)$/ or return "Illegal zip";
+ $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
+ or return "Illegal zip: ". $self->zip;
$self->zip($1);
- #int'l countries!
- $self->country =~ /^(US)$/ or return "Illegal country";
- $self->country($1);
-
- $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby =~ /^(CARD|BILL|COMP)$/
+ or return "Illegal payby: ". $self->payby;
$self->payby($1);
if ( $self->payby eq 'CARD' ) {
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
$payinfo =~ /^(\d{13,16})$/
- or return "Illegal credit card number";
+ or return "Illegal credit card number: ". $self->payinfo;
$payinfo = $1;
$self->payinfo($payinfo);
- validate($payinfo) or return "Illegal credit card number";
- my $type = cardtype($payinfo);
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ validate($payinfo)
+ or return "Illegal credit card number: ". $self->payinfo;
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} elsif ( $self->payby eq 'BILL' ) {
- $self->payinfo =~ /^([\w \-]*)$/ or return "Illegal P.O. number";
- $self->payinfo($1);
+ $error = $self->ut_textn('payinfo');
+ return "Illegal P.O. number: ". $self->payinfo if $error;
} elsif ( $self->payby eq 'COMP' ) {
- $self->payinfo =~ /^(\w{2,8})$/ or return "Illegal comp account issuer";
- $self->payinfo($1);
+ $error = $self->ut_textn('payinfo');
+ return "Illegal comp account issuer: ". $self->payinfo if $error;
}
$self->paydate('');
} else {
$self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
- or return "Illegal expiration date";
+ or return "Illegal expiration date: ". $self->paydate;
if ( length($2) == 4 ) {
$self->paydate("$2-$1-01");
} elsif ( $2 > 97 ) { #should pry change to check for "this year"
$self->payname( $self->first. " ". $self->getfield('last') );
} else {
$self->payname =~ /^([\w \,\.\-\']+)$/
- or return "Illegal billing name";
+ or return "Illegal billing name: ". $self->payname;
$self->payname($1);
}
- $self->tax =~ /^(Y?)$/ or return "Illegal tax";
+ $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
$self->tax($1);
$self->otaker(getotaker);
=cut
sub all_pkgs {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
}
=cut
sub ncancelled_pkgs {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_pkg', {
'custnum' => $self->custnum,
'cancel' => '',
=cut
sub bill {
- my($self,%options)=@_;
- my($time) = $options{'time'} || $^T;
+ my( $self, %options ) = @_;
+ my $time = $options{'time'} || time;
- my($error);
+ my $error;
#put below somehow?
local $SIG{HUP} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
- my($total_setup,$total_recur)=(0,0);
+ my( $total_setup, $total_recur ) = ( 0, 0 );
+ my @cust_bill_pkg;
- my(@cust_bill_pkg);
-
- my($cust_pkg);
- foreach $cust_pkg (
+ foreach my $cust_pkg (
qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
) {
- bless($cust_pkg,"FS::cust_pkg");
-
- next if ( $cust_pkg->getfield('cancel') );
+ next if $cust_pkg->getfield('cancel');
#? to avoid use of uninitialized value errors... ?
$cust_pkg->setfield('bill', '')
unless defined($cust_pkg->bill);
- my($part_pkg)=
- qsearchs('part_pkg',{'pkgpart'=> $cust_pkg->pkgpart } );
+ my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
#so we don't modify cust_pkg record unnecessarily
- my($cust_pkg_mod_flag)=0;
- my(%hash)=$cust_pkg->hash;
- my($old_cust_pkg)=create FS::cust_pkg(\%hash);
+ my $cust_pkg_mod_flag = 0;
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
# bill setup
- my($setup)=0;
+ my $setup = 0;
unless ( $cust_pkg->setup ) {
- my($setup_prog)=$part_pkg->getfield('setup');
- my($cpt) = new Safe;
+ my $setup_prog = $part_pkg->getfield('setup');
+ my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
$setup = $cpt->reval($setup_prog);
unless ( defined($setup) ) {
warn "Error reval-ing part_pkg->setup pkgpart ",
}
#bill recurring fee
- my($recur)=0;
- my($sdate);
+ my $recur = 0;
+ my $sdate;
if ( $part_pkg->getfield('freq') > 0 &&
! $cust_pkg->getfield('susp') &&
( $cust_pkg->getfield('bill') || 0 ) < $time
) {
- my($recur_prog)=$part_pkg->getfield('recur');
- my($cpt) = new Safe;
+ my $recur_prog = $part_pkg->getfield('recur');
+ my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
$recur = $cpt->reval($recur_prog);
unless ( defined($recur) ) {
warn "Error reval-ing part_pkg->recur pkgpart ",
#change this bit to use Date::Manip?
#$sdate=$cust_pkg->bill || time;
#$sdate=$cust_pkg->bill || $time;
- $sdate=$cust_pkg->bill || $cust_pkg->setup || $time;
- my($sec,$min,$hour,$mday,$mon,$year)=
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ my ($sec,$min,$hour,$mday,$mon,$year) =
(localtime($sdate) )[0,1,2,3,4,5];
$mon += $part_pkg->getfield('freq');
until ( $mon < 12 ) { $mon -= 12; $year++; }
- $cust_pkg->setfield('bill',timelocal($sec,$min,$hour,$mday,$mon,$year));
- $cust_pkg_mod_flag=1;
+ $cust_pkg->setfield('bill',
+ timelocal($sec,$min,$hour,$mday,$mon,$year));
+ $cust_pkg_mod_flag = 1;
}
}
warn "recur is undefinded" unless defined($recur);
warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
- if ($cust_pkg_mod_flag) {
+ if ( $cust_pkg_mod_flag ) {
$error=$cust_pkg->replace($old_cust_pkg);
- if ( $error ) {
+ if ( $error ) { #just in case
warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
} else {
- #just in case
- $setup=sprintf("%.2f",$setup);
- $recur=sprintf("%.2f",$recur);
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
'pkgnum' => $cust_pkg->pkgnum,
'setup' => $setup,
'recur' => $recur,
}
- my($charged)=sprintf("%.2f",$total_setup + $total_recur);
+ my $charged = sprintf( "%.2f", $total_setup + $total_recur );
return '' if scalar(@cust_bill_pkg) == 0;
- unless ( $self->getfield('tax') eq 'Y' ||
- $self->getfield('tax') eq 'y' ||
- $self->getfield('payby') eq 'COMP'
+ unless ( $self->getfield('tax') =~ /Y/i
+ || $self->getfield('payby') eq 'COMP'
) {
- my($cust_main_county) = qsearchs('cust_main_county',{
- 'county' => $self->getfield('county'),
- 'state' => $self->getfield('state'),
+ my $cust_main_county = qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
} );
- my($tax) = sprintf("%.2f",
+ my $tax = sprintf( "%.2f",
$charged * ( $cust_main_county->getfield('tax') / 100 )
);
- $charged = sprintf("%.2f",$charged+$tax);
+ $charged = sprintf( "%.2f", $charged+$tax );
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
'pkgnum' => 0,
'setup' => $tax,
'recur' => 0,
push @cust_bill_pkg, $cust_bill_pkg;
}
- my($cust_bill) = create FS::cust_bill ( {
+ my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->getfield('custnum'),
'_date' => $time,
'charged' => $charged,
} );
- $error=$cust_bill->insert;
+ $error = $cust_bill->insert;
#shouldn't happen, but how else to handle this? (wrap me in eval, to catch
# fatal errors)
die "Error creating cust_bill record: $error!\n",
"Check updated but unbilled packages for customer", $self->custnum, "\n"
if $error;
- my($invnum)=$cust_bill->invnum;
- my($cust_bill_pkg);
+ my $invnum = $cust_bill->invnum;
+ my $cust_bill_pkg;
foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->setfield('invnum',$invnum);
- $error=$cust_bill_pkg->insert;
+ $cust_bill_pkg->setfield( 'invnum', $invnum );
+ $error = $cust_bill_pkg->insert;
#shouldn't happen, but how else tohandle this?
die "Error creating cust_bill_pkg record: $error!\n",
"Check incomplete invoice ", $invnum, "\n"
=cut
sub collect {
- my($self,%options)=@_;
- my($invoice_time) = $options{'invoice_time'} || $^T;
+ my( $self, %options ) = @_;
+ my $invoice_time = $options{'invoice_time'} || time;
- my($total_owed) = $self->balance;
+ my $total_owed = $self->balance;
return '' unless $total_owed > 0; #redundant?????
#put below somehow?
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
+ foreach my $cust_bill (
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
#this has to be before next's
- my($amount) = sprintf("%.2f", $total_owed < $cust_bill->owed
+ my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
? $total_owed
: $cust_bill->owed
);
- $total_owed = sprintf("%.2f",$total_owed-$amount);
+ $total_owed = sprintf( "%.2f", $total_owed - $amount );
next unless $cust_bill->owed > 0;
- next if qsearchs('cust_pay_batch',{'invnum'=> $cust_bill->invnum });
+ next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
#warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)";
next unless $amount > 0;
- if ( $self->getfield('payby') eq 'BILL' ) {
+ if ( $self->payby eq 'BILL' ) {
#30 days 2592000
- my($since)=$invoice_time - ( $cust_bill->_date || 0 );
+ my $since = $invoice_time - ( $cust_bill->_date || 0 );
#warn "$invoice_time ", $cust_bill->_date, " $since";
if ( $since >= 0 #don't print future invoices
&& ( $cust_bill->printed * 2592000 ) <= $since
) {
- open(LPR,$lpr) or die "Can't open $lpr: $!";
- print LPR $cust_bill->print_text; #( date )
- close LPR
- or die $! ? "Error closing $lpr: $!"
- : "Exit status $? from $lpr";
+ #my @print_text = $cust_bill->print_text; #( date )
+ my @invoicing_list = $self->invoicing_list;
+ if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+ $ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Invoice",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $cust_bill->print_text ], #( date)
+ );
+ $message->smtpsend or die "Can't send invoice email!"; #die? warn?
+
+ } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+ open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
+ print LPR $cust_bill->print_text; #( date )
+ close LPR
+ or die $! ? "Error closing $lpr: $!"
+ : "Exit status $? from $lpr";
+ }
- my(%hash)=$cust_bill->hash;
+ my %hash = $cust_bill->hash;
$hash{'printed'}++;
- my($new_cust_bill)=create FS::cust_bill(\%hash);
- my($error)=$new_cust_bill->replace($cust_bill);
- if ( $error ) {
- warn "Error updating $cust_bill->printed: $error";
- }
+ my $new_cust_bill = new FS::cust_bill(\%hash);
+ my $error = $new_cust_bill->replace($cust_bill);
+ warn "Error updating $cust_bill->printed: $error" if $error;
}
- } elsif ( $self->getfield('payby') eq 'COMP' ) {
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
+ } elsif ( $self->payby eq 'COMP' ) {
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
'paid' => $amount,
'_date' => '',
'payby' => 'COMP',
- 'payinfo' => $self->getfield('payinfo'),
+ 'payinfo' => $self->payinfo,
'paybatch' => ''
} );
- my($error)=$cust_pay->insert;
- return 'Error COMPing invnum #' . $cust_bill->getfield('invnum') .
+ my $error = $cust_pay->insert;
+ return 'Error COMPing invnum #' . $cust_bill->invnum .
':' . $error if $error;
- } elsif ( $self->getfield('payby') eq 'CARD' ) {
+
+ } elsif ( $self->payby eq 'CARD' ) {
if ( $options{'batch_card'} ne 'yes' ) {
return "Real time card processing not enabled!" unless $processor;
- if ( $processor =~ /cybercash/ ) {
+ if ( $processor =~ /^cybercash/ ) {
#fix exp. date for cybercash
- $self->getfield('paydate') =~ /^(\d+)\/\d*(\d{2})$/;
- my($exp)="$1/$2";
+ #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
- my($paybatch)= $cust_bill->getfield('invnum') .
- '-' . time2str("%y%m%d%H%M%S",time);
+ my $paybatch = $cust_bill->invnum.
+ '-' . time2str("%y%m%d%H%M%S", time);
- my($payname)= $self->getfield('payname') ||
- $self->getfield('first') . ' ' .$self->getfield('last');
+ my $payname = $self->payname ||
+ $self->getfield('first'). ' '. $self->getfield('last');
- my($address)= $self->getfield('address1');
- $address .= ", " . $self->getfield('address2')
- if $self->getfield('address2');
+ my $address = $self->address1;
+ $address .= ", ". $self->address2 if $self->address2;
- my($country) = $self->getfield('country') eq 'US' ?
- 'USA' : $self->getfield('country');
+ my $country = 'USA' if $self->country eq 'US';
- my(@full_xaction)=($xaction,
+ my @full_xaction = ( $xaction,
'Order-ID' => $paybatch,
'Amount' => "usd $amount",
'Card-Number' => $self->getfield('payinfo'),
'Card-Exp' => $exp,
);
- my(%result);
+ my %result;
if ( $processor eq 'cybercash2' ) {
$^W=0; #CCLib isn't -w safe, ugh!
%result = &CCLib::sendmserver(@full_xaction);
#if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
#if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
'paid' => $amount,
'_date' => '',
'payby' => 'CARD',
- 'payinfo' => $self->getfield('payinfo'),
+ 'payinfo' => $self->payinfo,
'paybatch' => "$processor:$paybatch",
} );
- my($error)=$cust_pay->insert;
+ my $error = $cust_pay->insert;
return 'Error applying payment, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $error if $error;
+ $cust_bill->invnum. ':'. $error if $error;
} elsif ( $result{'Mstatus'} ne 'failure-bad-money'
|| $options{'report_badcard'} ) {
return 'Cybercash error, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $result{'MErrMsg'};
+ $cust_bill->invnum. ':'. $result{'MErrMsg'};
} else {
return '';
}
} else { #batch card
-# my($cust_pay_batch) = create FS::cust_pay_batch ( {
- my($cust_pay_batch) = new FS::Record ('cust_pay_batch', {
+ my $cust_pay_batch = new FS::Record ('cust_pay_batch', {
'invnum' => $cust_bill->getfield('invnum'),
'custnum' => $self->getfield('custnum'),
'last' => $self->getfield('last'),
'payname' => $self->getfield('payname'),
'amount' => $amount,
} );
-# my($error)=$cust_pay_batch->insert;
- my($error)=$cust_pay_batch->add;
+ my $error = $cust_pay_batch->insert;
return "Error adding to cust_pay_batch: $error" if $error;
}
} else {
- return "Unknown payment type ".$self->getfield('payby');
+ return "Unknown payment type ". $self->payby;
}
+
+
+
+
}
'';
=cut
sub total_owed {
- my($self) = @_;
- my($total_bill) = 0;
- my($cust_bill);
- foreach $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
+ my $self = shift;
+ my $total_bill = 0;
+ foreach my $cust_bill ( qsearch('cust_bill', {
+ 'custnum' => $self->custnum,
} ) ) {
- $total_bill += $cust_bill->getfield('owed');
+ $total_bill += $cust_bill->owed;
}
- sprintf("%.2f",$total_bill);
+ sprintf( "%.2f", $total_bill );
}
=item total_credited
=cut
sub total_credited {
- my($self) = @_;
- my($total_credit) = 0;
- my($cust_credit);
- foreach $cust_credit ( qsearch('cust_credit', {
- 'custnum' => $self->getfield('custnum'),
+ my $self = shift;
+ my $total_credit = 0;
+ foreach my $cust_credit ( qsearch('cust_credit', {
+ 'custnum' => $self->custnum,
} ) ) {
- $total_credit += $cust_credit->getfield('credited');
+ $total_credit += $cust_credit->credited;
}
- sprintf("%.2f",$total_credit);
+ sprintf( "%.2f", $total_credit );
}
=item balance
=cut
sub balance {
- my($self) = @_;
- sprintf("%.2f",$self->total_bill - $self->total_credit);
+ my $self = shift;
+ sprintf( "%.2f", $self->total_owed - $self->total_credited );
+}
+
+=item invoicing_list [ ARRAYREF ]
+
+If an arguement is given, sets these email addresses as invoice recipients
+(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
+(except as warnings), so use check_invoicing_list first.
+
+Returns a list of email addresses (with svcnum entries expanded).
+
+Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
+check it without disturbing anything by passing nothing.
+
+This interface may change in the future.
+
+=cut
+
+sub invoicing_list {
+ my( $self, $arrayref ) = @_;
+ if ( $arrayref ) {
+ my @cust_main_invoice;
+ if ( $self->custnum ) {
+ @cust_main_invoice =
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ @cust_main_invoice = ();
+ }
+ foreach my $cust_main_invoice ( @cust_main_invoice ) {
+ #warn $cust_main_invoice->destnum;
+ unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
+ #warn $cust_main_invoice->destnum;
+ my $error = $cust_main_invoice->delete;
+ warn $error if $error;
+ }
+ }
+ if ( $self->custnum ) {
+ @cust_main_invoice =
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ @cust_main_invoice = ();
+ }
+ foreach my $address ( @{$arrayref} ) {
+ unless ( grep { $address eq $_->address } @cust_main_invoice ) {
+ my $cust_main_invoice = new FS::cust_main_invoice ( {
+ 'custnum' => $self->custnum,
+ 'dest' => $address,
+ } );
+ my $error = $cust_main_invoice->insert;
+ warn $error if $error;
+ }
+ }
+ }
+ if ( $self->custnum ) {
+ map { $_->address }
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ ();
+ }
+}
+
+=item check_invoicing_list ARRAYREF
+
+Checks these arguements as valid input for the invoicing_list method. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub check_invoicing_list {
+ my( $self, $arrayref ) = @_;
+ foreach my $address ( @{$arrayref} ) {
+ my $cust_main_invoice = new FS::cust_main_invoice ( {
+ 'custnum' => $self->custnum,
+ 'dest' => $address,
+ } );
+ my $error = $self->custnum
+ ? $cust_main_invoice->check
+ : $cust_main_invoice->checkdest
+ ;
+ return $error if $error;
+ }
+ '';
}
=back
-=head1 BUGS
+=head1 VERSION
-The delete method.
+$Id: cust_main.pm,v 1.21 1999-04-14 07:47:53 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
-hfields should be removed.
+The delete method.
Bill and collect options should probably be passed as references instead of a
list.
CyberCash v2 forces us to define some variables in package main.
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+CyberCash is the only processor.
+
+No multiple currency support (probably a larger project than just this module).
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
-L<FS::cust_main_county>, L<FS::UID>, schema.html from the base documentation.
+L<FS::cust_main_county>, L<FS::cust_main_invoice>,
+L<FS::UID>, schema.html from the base documentation.
=head1 HISTORY
enable cybercash, cybercash v3 support, don't need to import
FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
+$Log: cust_main.pm,v $
+Revision 1.21 1999-04-14 07:47:53 ivan
+i18n fixes
+
+Revision 1.20 1999/04/10 08:35:14 ivan
+say what the unknown state/county/country are!
+
+Revision 1.19 1999/04/10 07:38:06 ivan
+_all_ check stuff with illegal data return the bad data too, to help debugging
+
+Revision 1.18 1999/04/10 06:54:11 ivan
+ditto
+
+Revision 1.17 1999/04/10 05:27:38 ivan
+display an illegal payby, to assist importing
+
+Revision 1.16 1999/04/07 14:32:19 ivan
+more &invoicing_list logic to skip searches when there is no custnum
+
+Revision 1.15 1999/04/07 13:41:54 ivan
+in &invoicing_list, don't search if there's no custnum yet
+
+Revision 1.14 1999/03/29 12:06:15 ivan
+buglet in email invoices fixed
+
+Revision 1.13 1999/02/28 20:09:03 ivan
+allow spaces in zip codes, for (at least) canada. pointed out by
+Clayton Gray <clgray@bcgroup.net>
+
+Revision 1.12 1999/02/27 21:24:22 ivan
+parse paydate correctly for cybercash
+
+Revision 1.11 1999/02/23 08:09:27 ivan
+beginnings of one-screen new customer entry and some other miscellania
+
+Revision 1.10 1999/01/25 12:26:09 ivan
+yet more mod_perl stuff
+
+Revision 1.9 1999/01/18 09:22:41 ivan
+changes to track email addresses for email invoicing
+
+Revision 1.8 1998/12/29 11:59:39 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.7 1998/12/16 09:58:52 ivan
+library support for editing email invoice destinations (not in sub collect yet)
+
+Revision 1.6 1998/11/18 09:01:42 ivan
+i18n! i18n!
+
+Revision 1.5 1998/11/15 11:23:14 ivan
+use FS::table_name for all searches to eliminate warnings,
+emit state/county when they don't match
+
+Revision 1.4 1998/11/15 05:30:48 ivan
+bugfix for new config layout
+
+Revision 1.3 1998/11/13 09:56:54 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+Revision 1.2 1998/11/07 10:24:25 ivan
+don't use depriciated FS::Bill and FS::Invoice, other miscellania
+
+
=cut
1;
package FS::cust_main_county;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearch qsearchs);
+use vars qw( @ISA );
+use FS::Record;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_main_county;
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
+ $record = new FS::cust_main_county \%hash;
+ $record = new FS::cust_main_county { 'column' => 'value' };
$error = $record->insert;
=item county
+=item country
+
=item tax - percentage
=back
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_main_county')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main_county',$hashref);
-}
+sub table { 'cust_main_county'; }
=item insert
Adds this tax rate to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this tax rate from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=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
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main_county record!"
- unless $old->table eq "cust_main_county";
- return "Can't change taxnum!"
- unless $old->getfield('taxnum') eq $new->getfield('taxnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid tax rate. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a cust_main_county record!"
- unless $self->table eq "cust_main_county";
- my($recref) = $self->hashref;
+ my $self = shift;
$self->ut_numbern('taxnum')
- or $self->ut_text('state')
- or $self->ut_textn('county')
- or $self->ut_float('tax')
+ || $self->ut_textn('state')
+ || $self->ut_textn('county')
+ || $self->ut_float('tax')
;
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: cust_main_county.pm,v 1.3 1998-12-29 11:59:41 ivan Exp $
-A country field (and possibly a currency field) should be added.
+=head1 BUGS
=head1 SEE ALSO
pod ivan@sisd.com 98-sep-21
+$Log: cust_main_county.pm,v $
+Revision 1.3 1998-12-29 11:59:41 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.2 1998/11/18 09:01:43 ivan
+i18n! i18n!
+
+
=cut
1;
--- /dev/null
+package FS::cust_main_invoice;
+
+use strict;
+use vars qw(@ISA $conf $mydomain);
+use Exporter;
+use FS::Record qw( qsearchs );
+use FS::Conf;
+use FS::cust_main;
+use FS::svc_acct;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main_invoice'} = sub {
+ $conf = new FS::Conf;
+ $mydomain = $conf->config('domain');
+};
+
+=head1 NAME
+
+FS::cust_main_invoice - Object methods for cust_main_invoice records
+
+=head1 SYNOPSIS
+
+ use FS::cust_main_invoice;
+
+ $record = new FS::cust_main_invoice \%hash;
+ $record = new FS::cust_main_invoice { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $email_address = $record->address;
+
+=head1 DESCRIPTION
+
+An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item destnum - primary key
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item dest - Invoice destination: If numeric, a <a href="#svc_acct">svcnum</a>, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new invoice destination. To add the invoice destination 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
+
+sub table { 'cust_main_invoice'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=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
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change custnum!" unless $old->custnum == $new->custnum;
+
+ $new->SUPER::replace;
+}
+
+
+=item check
+
+Checks all fields to make sure this is a valid invoice destination. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error = $self->ut_numbern('destnum')
+ || $self->ut_number('custnum')
+ || $self->checkdest;
+ ;
+ return $error if $error;
+
+ return "Unknown customer"
+ unless qsearchs('cust_main',{ 'custnum' => $self->custnum });
+
+ ''; #noerror
+}
+
+=item checkdest
+
+Checks the dest field only.
+
+=cut
+
+sub checkdest {
+ my $self = shift;
+
+ my $error = $self->ut_text('dest');
+ return $error if $error;
+
+ if ( $self->dest eq 'POST' ) {
+ #contemplate our navel
+ } elsif ( $self->dest =~ /^(\d+)$/ ) {
+ return "Unknown local account (specified by svcnum)"
+ 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 (specified literally)" unless $svc_acct;
+ $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!";
+ $self->dest($1);
+ }
+ } else {
+ return "Illegal destination!";
+ }
+
+ ''; #no error
+}
+
+=item address
+
+Returns the literal email address for this record (or `POST').
+
+=cut
+
+sub address {
+ my $self = shift;
+ if ( $self->dest =~ /(\d+)$/ ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } );
+ $svc_acct->username . '@' . $mydomain;
+ } else {
+ $self->dest;
+ }
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_main_invoice.pm,v 1.6 1999-01-25 12:26:10 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>
+
+=head1 HISTORY
+
+ivan@voicenet.com 97-jul-1
+
+added hfields
+ivan@sisd.com 97-nov-13
+
+$Log: cust_main_invoice.pm,v $
+Revision 1.6 1999-01-25 12:26:10 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1999/01/18 21:58:05 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.4 1999/01/18 09:22:42 ivan
+changes to track email addresses for email invoicing
+
+Revision 1.3 1998/12/29 11:59:42 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.2 1998/12/16 09:58:53 ivan
+library support for editing email invoice destinations (not in sub collect yet)
+
+Revision 1.1 1998/12/16 07:40:02 ivan
+new table
+
+Revision 1.3 1998/11/15 04:33:00 ivan
+updates for newest versoin
+
+Revision 1.2 1998/11/15 03:48:49 ivan
+update for current version
+
+
+=cut
+
+1;
+
package FS::cust_pay;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );
use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );
use FS::cust_bill;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_pay;
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
+ $record = new FS::cust_pay \%hash;
+ $record = new FS::cust_pay { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new payment. To add the payment to the databse, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pay')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pay',$hashref);
-
-}
+sub table { 'cust_pay'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- my($error);
+ my $error;
- $error=$self->check;
+ $error = $self->check;
return $error if $error;
- my($old_cust_bill) = qsearchs('cust_bill', {
- 'invnum' => $self->getfield('invnum')
- } );
+ my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
return "Unknown invnum" unless $old_cust_bill;
- my(%hash)=$old_cust_bill->hash;
- $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') );
- my($new_cust_bill) = create FS::cust_bill ( \%hash );
+ my %hash = $old_cust_bill->hash;
+ $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid );
+ my $new_cust_bill = new FS::cust_bill ( \%hash );
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=$new_cust_bill -> replace($old_cust_bill);
+ $error = $new_cust_bill->replace($old_cust_bill);
return "Error modifying cust_bill: $error" if $error;
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't (yet?) delete cust_pay records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
}
=item replace OLD_RECORD
sub replace {
return "Can't (yet?) modify cust_pay records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_pay record!" unless $old->table eq "cust_pay";
-#
-# $new->check or
-# $new->rep($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_pay record!" unless $self->table eq "cust_pay";
- my($recref) = $self->hashref;
-
- $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum";
- $recref->{paynum} = $1;
+ my $self = shift;
- $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
+ my $error;
- $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid";
- $recref->{paid} = $1;
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
+ $error =
+ $self->ut_numbern('paynum')
+ || $self->ut_number('invnum')
+ || $self->ut_money('paid')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
+ $self->_date(time) unless $self->_date;
- if ( $recref->{payby} eq 'CARD' ) {
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $self->payinfo($payinfo =~ s/\D//g);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal credit card number";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} else {
- $recref->{payinfo}='N/A';
+ $self->payinfo('N/A');
}
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
}
- $recref->{paybatch} =~ /^([\w\-\:]*)$/
- or return "Illegal paybatch";
- $recref->{paybatch} = $1;
+ $error = $self->ut_textn('paybatch');
+ return $error if $error;
''; #no error
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: cust_pay.pm,v 1.3 1999-01-25 12:26:11 ivan Exp $
+
+=head1 BUGS
Delete and replace methods.
pod ivan@sisd.com 98-sep-21
+$Log: cust_pay.pm,v $
+Revision 1.3 1999-01-25 12:26:11 ivan
+yet more mod_perl stuff
+
+Revision 1.2 1998/12/29 11:59:43 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
--- /dev/null
+package FS::cust_pay_batch;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record;
+use Business::CreditCard;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_pay_batch - Object methods for batch cards
+
+=head1 SYNOPSIS
+
+ use FS::cust_pay_batch;
+
+ $record = new FS::cust_pay_batch \%hash;
+ $record = new FS::cust_pay_batch { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_pay_batch object represents a credit card transaction ready to be
+batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record.
+Typically called by the collect method of an FS::cust_main object. The
+following fields are currently supported:
+
+=over 4
+
+=item trancode - 77 for charges
+
+=item cardnum
+
+=item exp - card expiration
+
+=item amount
+
+=item invnum - invoice
+
+=item custnum - customer
+
+=item payname - name on card
+
+=item first - name
+
+=item last - name
+
+=item address1
+
+=item address2
+
+=item city
+
+=item state
+
+=item zip
+
+=item country
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record 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
+
+sub table { 'cust_pay_batch'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item replace OLD_RECORD
+
+#inactive
+#
+#Replaces the OLD_RECORD with this one in the database. If there is an error,
+#returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ return "Can't (yet?) replace batched transactions!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid transaction. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('trancode')
+ || $self->ut_number('cardnum')
+ || $self->ut_money('amount')
+ || $self->ut_number('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_text('address1')
+ || $self->ut_textn('address2')
+ || $self->ut_text('city')
+ || $self->ut_text('state')
+ ;
+
+ return $error if $error;
+
+ $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
+ $self->setfield('last',$1);
+
+ $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
+ $self->first($1);
+
+ my $cardnum = $self->cardnum;
+ $cardnum =~ s/\D//g;
+ $cardnum =~ /^(\d{13,16})$/
+ or return "Illegal credit card number";
+ $cardnum = $1;
+ $self->cardnum($cardnum);
+ validate($cardnum) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
+
+ if ( $self->exp eq '' ) {
+ return "Expriation date required";
+ $self->exp('');
+ } else {
+ $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
+ or return "Illegal expiration date";
+ if ( length($2) == 4 ) {
+ $self->exp("$2-$1-01");
+ } elsif ( $2 > 98 ) { #should pry change to check for "this year"
+ $self->exp("19$2-$1-01");
+ } else {
+ $self->exp("20$2-$1-01");
+ }
+ }
+
+ if ( $self->payname eq '' ) {
+ $self->payname( $self->first. " ". $self->getfield('last') );
+ } else {
+ $self->payname =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal billing name";
+ $self->payname($1);
+ }
+
+ $self->zip =~ /^([\w\-]{10})$/ or return "Illegal zip";
+ $self->zip($1);
+
+ $self->country =~ /^(\w\w)$/ or return "Illegal \w\wy";
+ $self->country($1);
+
+ #check invnum, custnum, ?
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay_batch.pm,v 1.3 1998-12-29 11:59:44 ivan Exp $
+
+=head1 BUGS
+
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, L<FS::Record>
+
+=head1 HISTORY
+
+ivan@voicenet.com 97-jul-1
+
+added hfields
+ivan@sisd.com 97-nov-13
+
+$Log: cust_pay_batch.pm,v $
+Revision 1.3 1998-12-29 11:59:44 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.2 1998/11/18 09:01:44 ivan
+i18n! i18n!
+
+Revision 1.1 1998/11/15 05:19:58 ivan
+long overdue
+
+Revision 1.3 1998/11/15 04:33:00 ivan
+updates for newest versoin
+
+Revision 1.2 1998/11/15 03:48:49 ivan
+update for current version
+
+
+=cut
+
+1;
+
use strict;
use vars qw(@ISA);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearch qsearchs);
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearch qsearchs );
use FS::cust_svc;
+use FS::part_pkg;
+use FS::cust_main;
+use FS::type_pkgs;
-@ISA = qw(FS::Record Exporter);
+# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
+# 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;
+
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_pkg;
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
+ $record = new FS::cust_pkg \%hash;
+ $record = new FS::cust_pkg { 'column' => 'value' };
$error = $record->insert;
$error = $record->unsuspend;
+ $part_pkg = $record->part_pkg;
+
+ @labels = $record->labels;
+
$error = FS::cust_pkg::order( $custnum, \@pkgparts );
$error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new billing item. To add the item to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pkg',$hashref);
-}
+sub table { 'cust_pkg'; }
=item insert
Adds this billing item to the database ("Orders" the item). If there is an
error, returns the error, otherwise returns false.
-=cut
-
sub insert {
- my($self)=@_;
+ my $self = shift;
+
+ # custnum might not have have been defined in sub check (for one-shot new
+ # customers), so check it here instead
+
+ my $error = $self->ut_number('custnum');
+ return $error if $error
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->SUPER::insert;
- $self->check or
- $self->add;
}
=item delete
would then be no record the customer ever purchased the item. Instead, see
the cancel method.
+=cut
+
sub delete {
return "Can't delete cust_pkg records!";
}
Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
-pkgpart may not be changed, but see the order subroutine.
+Changing pkgpart may have disasterous effects. See the order subroutine.
setup and bill are normally updated by calling the bill method of a customer
object (see L<FS::cust_main>).
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
- return "Can't change pkgnum!"
- if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
- return "Can't (yet?) change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change otaker!"
- if $old->getfield('otaker') ne $new->getfield('otaker');
+ my( $new, $old ) = ( shift, shift );
+
+ #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
+ return "Can't change otaker!" if $old->otaker ne $new->otaker;
return "Can't change setup once it exists!"
if $old->getfield('setup') &&
$old->getfield('setup') != $new->getfield('setup');
#some logic for bill, susp, cancel?
- $new->check or
- $new->rep($old);
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
- my($recref) = $self->hashref;
-
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum}=$1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('pkgnum')
+ || $self->ut_numbern('custnum')
+ || $self->ut_number('pkgpart')
+ || $self->ut_numbern('setup')
+ || $self->ut_numbern('bill')
+ || $self->ut_numbern('susp')
+ || $self->ut_numbern('cancel')
+ ;
+ return $error if $error;
+
+ if ( $self->custnum ) {
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ }
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart}=$1;
return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- $recref->{otaker} ||= &getotaker;
- $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
- $recref->{otaker}=$1;
-
- $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
- $recref->{setup}=$1;
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
- $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
- $recref->{bill}=$1;
-
- $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
- $recref->{susp}=$1;
-
- $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
- $recref->{cancel}=$1;
+ $self->otaker(getotaker) unless $self->otaker;
+ $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
+ $self->otaker($1);
''; #no error
}
=cut
sub cancel {
- my($self)=@_;
- my($error);
+ 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';
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
+ $part_svc->svcdb =~ /^([\w\-]+)$/
or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->cancel;
return "Error cancelling service: $error" if $error;
$error = $svc->delete;
return "Error deleting service: $error" if $error;
}
- bless($cust_svc,"FS::cust_svc");
$error = $cust_svc->delete;
return "Error deleting cust_svc: $error" if $error;
}
unless ( $self->getfield('cancel') ) {
- my(%hash) = $self->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
+ my %hash = $self->hash;
+ $hash{'cancel'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
return $error if $error;
}
=cut
sub suspend {
- my($self)=@_;
- my($error);
+ 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';
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
+ $part_svc->svcdb =~ /^([\w\-]+)$/
or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->suspend;
return $error if $error;
}
}
unless ( $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
+ my %hash = $self->hash;
+ $hash{'susp'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
return $error if $error;
}
=cut
sub unsuspend {
- my($self)=@_;
+ my $self = shift;
my($error);
local $SIG{HUP} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
+ foreach my $cust_svc (
+ qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
+ $part_svc->svcdb =~ /^([\w\-]+)$/
or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->unsuspend;
return $error if $error;
}
}
unless ( ! $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}='';
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
+ my %hash = $self->hash;
+ $hash{'susp'} = '';
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
return $error if $error;
}
''; #no errors
}
+=item part_pkg
+
+Returns the definition for this billing item, as an FS::part_pkg object (see
+L<FS::part_pkg).
+
+=cut
+
+sub part_pkg {
+ my $self = shift;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item labels
+
+Returns a list of lists, calling the label method for all services
+(see L<FS::cust_svc>) of this billing item.
+
+=cut
+
+sub labels {
+ my $self = shift;
+ map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+}
+
=back
=head1 SUBROUTINES
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
#first cancel old packages
# my($pkgnum);
foreach $pkgnum ( @{$remove_pkgnums} ) {
my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- return "Package $pkgnum not found to remove!" unless $old;
+ die "Package $pkgnum not found to remove!" unless $old;
my(%hash) = $old->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
+ $hash{'cancel'}=time;
+ my($new) = new FS::cust_pkg ( \%hash );
my($error)=$new->replace($old);
- return $error if $error;
+ die "Couldn't update package $pkgnum: $error" if $error;
}
#now add new packages, changing cust_svc records if necessary
# my($pkgpart);
while ($pkgpart=shift @{$pkgparts} ) {
- my($new) = create FS::cust_pkg ( {
+ my($new) = new FS::cust_pkg ( {
'custnum' => $custnum,
'pkgpart' => $pkgpart,
} );
my($error) = $new->insert;
- return $error if $error;
+ die "Couldn't insert new cust_pkg record: $error" if $error;
my($pkgnum)=$new->getfield('pkgnum');
my($cust_svc);
foreach $cust_svc ( @{ shift @cust_svc } ) {
my(%hash) = $cust_svc->hash;
$hash{'pkgnum'}=$pkgnum;
- my($new) = create FS::cust_svc ( \%hash );
+ my($new) = new FS::cust_svc ( \%hash );
my($error)=$new->replace($cust_svc);
- return $error if $error;
+ die "Couldn't link old service to new package: $error" if $error;
}
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: cust_pkg.pm,v 1.9 1999-03-29 01:11:51 ivan Exp $
+
+=head1 BUGS
sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
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_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.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
pod ivan@sisd.com 98-sep-21
+$Log: cust_pkg.pm,v $
+Revision 1.9 1999-03-29 01:11:51 ivan
+use FS::type_pkgs
+
+Revision 1.8 1999/03/25 13:48:14 ivan
+allow empty custnum in sub check (but call that an error in sub insert),
+for one-screen new customer entry
+
+Revision 1.7 1999/02/09 09:55:06 ivan
+invoices show line items for each service in a package (see the label method
+of FS::cust_svc)
+
+Revision 1.6 1999/01/25 12:26:12 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1999/01/18 21:58:07 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.4 1998/12/29 11:59:45 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.3 1998/11/15 13:01:35 ivan
+allow pkgpart changing (for per-customer custom pricing). warn about it in doc
+
+Revision 1.2 1998/11/12 03:42:45 ivan
+added label method
+
+
=cut
1;
package FS::cust_refund;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );
use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );
use FS::UID qw(getotaker);
use FS::cust_credit;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_refund;
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
+ $record = new FS::cust_refund \%hash;
+ $record = new FS::cust_refund { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new refund. To add the refund to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_refund')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_refund',$hashref);
-
-}
+sub table { 'cust_refund'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- my($error);
+ my $error;
$error=$self->check;
return $error if $error;
- my($old_cust_credit) = qsearchs('cust_credit', {
- 'crednum' => $self->getfield('crednum')
- } );
+ my $old_cust_credit =
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
return "Unknown crednum" unless $old_cust_credit;
- my(%hash)=$old_cust_credit->hash;
- $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') );
- my($new_cust_credit) = create FS::cust_credit ( \%hash );
+ my %hash = $old_cust_credit->hash;
+ $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund );
+ my($new_cust_credit) = new FS::cust_credit ( \%hash );
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=$new_cust_credit -> replace($old_cust_credit);
+ $error = $new_cust_credit->replace($old_cust_credit);
return "Error modifying cust_credit: $error" if $error;
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't (yet?) delete cust_refund records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
}
=item replace OLD_RECORD
sub replace {
return "Can't (yet?) modify cust_refund records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_refund record!" unless $old->table eq "cust_refund";
-#
-# $new->check or
-# $new->rep($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_refund record!" unless $self->table eq "cust_refund";
+ my $self = shift;
+
+ my $error;
- my $error =
+ $error =
$self->ut_number('refundnum')
|| $self->ut_number('crednum')
|| $self->ut_money('amount')
;
return $error if $error;
- my($recref) = $self->hashref;
+ $self->_date(time) unless $self->_date;
- $recref->{_date} ||= time;
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
-
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $self->payinfo($payinfo =~ s/\D//g);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal (checksum) credit card number (payinfo)";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} else {
- $recref->{payinfo}='N/A';
+ $self->payinfo('N/A');
}
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
}
$self->otaker(getotaker);
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: cust_refund.pm,v 1.3 1999-01-25 12:26:13 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
Delete and replace methods.
pod and finish up ivan@sisd.com 98-sep-21
+$Log: cust_refund.pm,v $
+Revision 1.3 1999-01-25 12:26:13 ivan
+yet more mod_perl stuff
+
+Revision 1.2 1998/12/29 11:59:46 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::cust_svc;
use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
+use vars qw( @ISA );
+use Carp qw( cluck );
+use FS::Record qw( qsearchs );
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::part_svc;
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+
+@ISA = qw( FS::Record );
=head1 NAME
use FS::cust_svc;
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
+ $record = new FS::cust_svc \%hash
+ $record = new FS::cust_svc { 'column' => 'value' };
$error = $record->insert;
$error = $record->check;
+ ($label, $value) = $record->label;
+
=head1 DESCRIPTION
An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new service. To add the refund to the database, see L<"insert">.
Services are normally created by creating FS::svc_ objects (see
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_svc',$hashref);
-}
+sub table { 'cust_svc'; }
=item insert
Adds this service to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this service from the database. If there is an error, returns the
Called by the cancel method of the package (see L<FS::cust_pkg>).
-=cut
-
-sub delete {
- my($self)=@_;
- # anything else here?
- $self->del;
-}
-
=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
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid service. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a cust_svc record!" unless $self->table eq "cust_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum}=$1;
+ my $error =
+ $self->ut_numbern('svcnum')
+ || $self->ut_numbern('pkgnum')
+ || $self->ut_number('svcpart')
+ ;
+ return $error if $error;
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
- return "Unknown pkgnum" unless
- ! $recref->{pkgnum} ||
- qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}});
+ return "Unknown pkgnum"
+ unless ! $self->pkgnum
+ || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart";
- $recref->{svcpart}=$1;
return "Unknown svcpart" unless
- qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
+ qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
''; #no error
}
+=item label
+
+Returns a list consisting of:
+- The name of this service (from part_svc)
+- A meaningful identifier (username, domain, or mail alias)
+- The table name (i.e. svc_domain) for this service
+
+=cut
+
+sub label {
+ my $self = shift;
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+ my $svcdb = $part_svc->svcdb;
+ my $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
+ my $svc = $part_svc->svc;
+ my $tag;
+ if ( $svcdb eq 'svc_acct' ) {
+ $tag = $svc_x->getfield('username');
+ } 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_domain' ) {
+ $tag = $svc_x->getfield('domain');
+ } else {
+ cluck "warning: asked for label of unsupported svcdb; using svcnum";
+ $tag = $svc_x->getfield('svcnum');
+ }
+ $svc, $tag, $svcdb;
+}
+
=back
+=head1 VERSION
+
+$Id: cust_svc.pm,v 1.5 1998-12-29 11:59:47 ivan Exp $
+
=head1 BUGS
Behaviour of changing the svcpart of cust_svc records is undefined and should
possibly be prohibited, and pkg_svc records are not checked.
-pkg_svc records are not checket in general (here).
+pkg_svc records are not checked in general (here).
+
+Deleting this record doesn't check or delete the svc_* record associated
+with this record.
=head1 SEE ALSO
pod ivan@sisd.com 98-sep-21
+$Log: cust_svc.pm,v $
+Revision 1.5 1998-12-29 11:59:47 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.4 1998/11/12 07:58:15 ivan
+added svcdb to label
+
+Revision 1.3 1998/11/12 03:45:38 ivan
+use FS::table_name for all tables qsearch()'ed
+
+Revision 1.2 1998/11/12 03:32:46 ivan
+added label method
+
+
=cut
1;
Returns an SQL column definition.
-If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
-syntax. Non-standard syntax for other engines (if applicable) may also be
-supported in the future.
+If passed a DBI $datasrc specifying L<DBD::mysql> or L<DBD::Pg>, will use
+engine-specific syntax.
=cut
sub line {
my($self,$datasrc)=@_;
my($null)=$self->null;
- $null ||= "NOT NULL" if $datasrc =~ /mysql/; #yucky mysql hack
+ if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
+ $null ||= "NOT NULL"
+ }
+ if ( $datasrc =~ /Pg/ ) { #yucky Pg hack
+ $null ||= "NOT NULL";
+ $null =~ s/^NULL$//;
+ }
join(' ',
$self->name,
$self->type. ( $self->length ? '('.$self->length.')' : '' ),
L<FS::dbdef_table>, L<FS::dbdef>, L<DBI>
+=head1 VERSION
+
+$Id: dbdef_column.pm,v 1.3 1998-10-13 13:04:17 ivan Exp $
+
=head1 HISTORY
class for dealing with column definitions
mySQL-specific hack for null (what should be default?) ivan@sisd.com 98-jun-2
+$Log: dbdef_column.pm,v $
+Revision 1.3 1998-10-13 13:04:17 ivan
+fixed doc to indicate Pg specific syntax too
+
+Revision 1.2 1998/10/12 23:40:28 ivan
+added Pg-specific behaviour in sub line
+
+
=cut
1;
"CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
( map {
- my($index) = $_ . "_index";
+ my($index) = $self->name. "__". $_ . "_index";
$index =~ s/,\s*/_/g;
"CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
} $self->unique->sql_list ),
( map {
- my($index) = $_ . "_index";
+ my($index) = $self->name. "__". $_ . "_index";
$index =~ s/,\s*/_/g;
"CREATE INDEX $index ON ". $self->name. " ($_)"
} $self->index->sql_list ),
L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
L<DBI>
+=head1 VERSION
+
+$Id: dbdef_table.pm,v 1.2 1998-10-14 07:05:06 ivan Exp $
+
=head1 HISTORY
class for dealing with table definitions
pod ivan@sisd.com 98-sep-24
+$Log: dbdef_table.pm,v $
+Revision 1.2 1998-10-14 07:05:06 ivan
+1.1.4 release, fix postgresql
+
+
=cut
1;
package FS::part_pkg;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
+use vars qw( @ISA );
+use FS::Record;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::part_pkg;
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
+ $record = new FS::part_pkg \%hash
+ $record = new FS::part_pkg { 'column' => 'value' };
+
+ $custom_record = $template_record->clone;
$error = $record->insert;
=head1 DESCRIPTION
-An FS::part_pkg represents a billing item definition. FS::part_pkg inherits
-from FS::Record. The following fields are currently supported:
+An FS::part_pkg object represents a billing item definition. FS::part_pkg
+inherits from FS::Record. The following fields are currently supported:
=over 4
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new billing item definition. To add the billing item definition to
the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
+sub table { 'part_pkg'; }
+
+=item clone
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
+An alternate constructor. Creates a new billing item definition by duplicating
+an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended
+to the comment field. To add the billing item definition to the database, see
+L<"insert">.
- $proto->new('part_pkg',$hashref);
+=cut
+
+sub clone {
+ my $self = shift;
+ my $class = ref($self);
+ my %hash = $self->hash;
+ $hash{'pkgpart'} = '';
+ $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
+ unless $hash{'comment'} =~ /^\(CUSTOM\) /;
+ #new FS::part_pkg ( \%hash ); # ?
+ new $class ( \%hash ); # ?
}
=item insert
Adds this billing item definition to the database. If there is an error,
returns the error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented.
sub delete {
return "Can't (yet?) delete package definitions.";
-# maybe check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
-# my($self)=@_;
-#
-# $self->del;
+# check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
}
=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)=@_;
- return "(Old) Not a part_pkg record!" unless $old->table eq "part_pkg";
- return "Can't change pkgpart!"
- unless $old->getfield('pkgpart') eq $new->getfield('pkgpart');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid billing item definition. If
=cut
sub check {
- my($self)=@_;
- return "Not a part_pkg record!" unless $self->table eq "part_pkg";
+ my $self = shift;
$self->ut_numbern('pkgpart')
- or $self->ut_text('pkg')
- or $self->ut_text('comment')
- or $self->ut_anything('setup')
- or $self->ut_number('freq')
- or $self->ut_anything('recur')
+ || $self->ut_text('pkg')
+ || $self->ut_text('comment')
+ || $self->ut_anything('setup')
+ || $self->ut_number('freq')
+ || $self->ut_anything('recur')
;
-
}
=back
+=head1 VERSION
+
+$Id: part_pkg.pm,v 1.5 1998-12-31 01:04:16 ivan Exp $
+
=head1 BUGS
It doesn't properly override FS::Record yet.
pod ivan@sisd.com 98-sep-21
+$Log: part_pkg.pm,v $
+Revision 1.5 1998-12-31 01:04:16 ivan
+doc
+
+Revision 1.3 1998/11/15 13:00:15 ivan
+bugfix in clone method, clone method doc clarification
+
+
=cut
1;
package FS::part_referral;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
+use vars qw( @ISA );
+use FS::Record;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::part_referral;
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new referral. To add the referral to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_referral')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_referral',$hashref);
-}
+sub table { 'part_referral'; }
=item insert
Adds this referral to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented.
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
return "Can't (yet?) delete part_referral records";
- #$self->del;
+ #need to make sure no customers have this referral!
}
=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)=@_;
- return "(Old) Not an part_referral record!"
- unless $old->table eq "part_referral";
- return "Can't change refnum!"
- unless $old->getfield('refnum') eq $new->getfield('refnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid referral. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a part_referral record!" unless $self->table eq "part_referral";
+ my $self = shift;
- my($error)=
- $self->ut_numbern('refnum')
- or $self->ut_text('referral')
+ $self->ut_numbern('refnum')
+ || $self->ut_text('referral')
;
- return $error if $error;
-
- '';
-
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: part_referral.pm,v 1.2 1998-12-29 11:59:49 ivan Exp $
+
+=head1 BUGS
The delete method is unimplemented.
pod ivan@sisd.com 98-sep-21
+$Log: part_referral.pm,v $
+Revision 1.2 1998-12-29 11:59:49 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::part_svc;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
+use vars qw( @ISA );
+use FS::Record qw( fields );
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
+@ISA = qw(FS::Record);
=head1 NAME
use FS::part_svc;
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new service definition. To add the service definition to the
database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_svc',$hashref);
-}
+sub table { 'part_svc'; }
=item insert
Adds this service definition to the database. If there is an error, returns
the error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented.
sub delete {
return "Can't (yet?) delete service definitions.";
-# maybe check & make sure the svcpart isn't in cust_svc or (in any packages)?
-# my($self)=@_;
-#
-# $self->del;
+# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
}
=item replace OLD_RECORD
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_svc record!" unless $old->table eq "part_svc";
- return "Can't change svcpart!"
- unless $old->getfield('svcpart') eq $new->getfield('svcpart');
+ my ( $new, $old ) = ( shift, shift );
+
return "Can't change svcdb!"
- unless $old->getfield('svcdb') eq $new->getfield('svcdb');
- $new->check or
- $new->rep($old);
+ unless $old->svcdb eq $new->svcdb;
+
+ $new->SUPER::replace( $old );
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a part_svc record!" unless $self->table eq "part_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
+ my $recref = $self->hashref;
- my($error);
- return $error if $error=
+ my $error;
+ $error=
$self->ut_numbern('svcpart')
|| $self->ut_text('svc')
|| $self->ut_alpha('svcdb')
;
+ return $error if $error;
- my(@fields) = eval { fields($recref->{svcdb}) }; #might die
+ my @fields = eval { fields( $recref->{svcdb} ) }; #might die
return "Unknown svcdb!" unless @fields;
- my($svcdb);
+ my $svcdb;
foreach $svcdb ( qw(
- svc_acct svc_acct_sm svc_charge svc_domain svc_wo
+ svc_acct svc_acct_sm svc_domain
) ) {
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
+ my @rows = map { /^${svcdb}__(.*)$/; $1 }
grep ! /_flag$/,
grep /^${svcdb}__/,
fields('part_svc');
- my($row);
- foreach $row (@rows) {
+ foreach my $row (@rows) {
unless ( $svcdb eq $recref->{svcdb} ) {
$recref->{$svcdb.'__'.$row}='';
$recref->{$svcdb.'__'.$row.'_flag'}='';
or return "Illegal flag for $svcdb $row";
$recref->{$svcdb.'__'.$row.'_flag'} = $1;
-# $recref->{$svcdb.'__'.$row} =~ /^(.*)$/ #not restrictive enough?
-# or return "Illegal value for $svcdb $row";
-# $recref->{$svcdb.'__'.$row} = $1;
- my($error);
- return $error if $error=$self->ut_anything($svcdb.'__'.$row);
+ my $error = $self->ut_anything($svcdb.'__'.$row);
+ return $error if $error;
}
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: part_svc.pm,v 1.3 1999-02-07 09:59:44 ivan Exp $
+
+=head1 BUGS
Delete is unimplemented.
+The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
+should be fixed.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
pod ivan@sisd.com 98-sep-21
+$Log: part_svc.pm,v $
+Revision 1.3 1999-02-07 09:59:44 ivan
+more mod_perl fixes, and bugfixes Peter Wemm sent via email
+
+Revision 1.2 1998/12/29 11:59:50 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::pkg_svc;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::pkg_svc;
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
+ $record = new FS::pkg_svc \%hash;
+ $record = new FS::pkg_svc { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new record. To add the record to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('pkg_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('pkg_svc',$hashref);
-
-}
+sub table { 'pkg_svc'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this record from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a pkg_svc record!" unless $old->table eq "pkg_svc";
- return "Can't change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change svcpart!"
- if $old->getfield('svcpart') ne $new->getfield('svcpart');
-
- $new->check or
- $new->rep($old);
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart;
+ return "Can't change svcpart!" if $old->svcpart != $new->svcpart;
+
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a pkg_svc record!" unless $self->table eq "pkg_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
- my($error);
- return $error if $error =
+ my $error;
+ $error =
$self->ut_number('pkgpart')
|| $self->ut_number('svcpart')
|| $self->ut_number('quantity')
;
+ return $error if $error;
return "Unknown pkgpart!"
- unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')});
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
return "Unknown svcpart!"
- unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')});
+ unless qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
''; #no error
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: pkg_svc.pm,v 1.3 1999-01-18 21:58:08 ivan Exp $
+
+=head1 BUGS
=head1 SEE ALSO
pod ivan@sisd.com 98-sep-22
+$Log: pkg_svc.pm,v $
+Revision 1.3 1999-01-18 21:58:08 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.2 1998/12/29 11:59:51 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
--- /dev/null
+package FS::svc_Common;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs fields );
+use FS::cust_svc;
+use FS::part_svc;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::svc_Common - Object method for all svc_ records
+
+=head1 SYNOPSIS
+
+use FS::svc_Common;
+
+@ISA = qw( FS::svc_Common );
+
+=head1 DESCRIPTION
+
+FS::svc_Common is intended as a base class for table-specific classes to
+inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
+
+=head1 METHODS
+
+=over 4
+
+=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 L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+=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;
+
+ my $svcnum = $self->svcnum;
+ my $cust_svc;
+ unless ( $svcnum ) {
+ $cust_svc = new FS::cust_svc ( {
+ 'svcnum' => $svcnum,
+ 'pkgnum' => $self->pkgnum,
+ 'svcpart' => $self->svcpart,
+ } );
+ $error = $cust_svc->insert;
+ return $error if $error;
+ $svcnum = $self->svcnum($cust_svc->svcnum);
+ }
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $cust_svc->delete if $cust_svc;
+ return $error;
+ }
+
+ '';
+}
+
+=item delete
+
+Deletes this account 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.
+
+=cut
+
+sub delete {
+ 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';
+
+ my $svcnum = $self->svcnum;
+
+ $error = $self->SUPER::delete;
+ return $error if $error;
+
+ my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } );
+ $error = $cust_svc->delete;
+ return $error if $error;
+
+ '';
+}
+
+=item setfixed
+
+Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
+error, returns the error, otherwise returns the FS::part_svc object (use ref()
+to test the return). Usually called by the check method.
+
+=cut
+
+sub setfixed {
+ my $self = shift;
+ $self->setx('F');
+}
+
+=item setdefault
+
+Sets all fields to their defaults (see L<FS::part_svc>), overriding their
+current values. If there is an error, returns the error, otherwise returns
+the FS::part_svc object (use ref() to test the return).
+
+=cut
+
+sub setdefault {
+ my $self = shift;
+ $self->setx('D');
+}
+
+sub setx {
+ my $self = shift;
+ my $x = shift;
+
+ my $error;
+
+ $error =
+ $self->ut_numbern('svcnum')
+ ;
+ return $error if $error;
+
+ #get part_svc
+ my $svcpart;
+ if ( $self->svcnum ) {
+ my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
+ return "Unknown svcnum" unless $cust_svc;
+ $svcpart = $cust_svc->svcpart;
+ } else {
+ $svcpart = $self->getfield('svcpart');
+ }
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
+ return "Unkonwn svcpart" unless $part_svc;
+
+ #set default/fixed/whatever fields from part_svc
+ foreach my $field ( fields('svc_acct') ) {
+ if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq $x ) {
+ $self->setfield( $field, $part_svc->getfield('svc_acct__'. $field) );
+ }
+ }
+
+ $part_svc;
+
+}
+
+=item suspend
+
+=item unsuspend
+
+=item cancel
+
+Stubs - return false (no error) so derived classes don't need to define these
+methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=cut
+
+sub suspend { ''; }
+sub unsuspend { ''; }
+sub cancel { ''; }
+
+=back
+
+=head1 VERSION
+
+$Id: svc_Common.pm,v 1.3 1999-03-25 13:31:29 ivan Exp $
+
+=head1 BUGS
+
+The setfixed method return value.
+
+The new method should set defaults from part_svc (like the check method
+sets fixed values)?
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
+from the base documentation.
+
+=head1 HISTORY
+
+$Log: svc_Common.pm,v $
+Revision 1.3 1999-03-25 13:31:29 ivan
+added setdefault method (generalized setfixed method to setx method)
+
+Revision 1.2 1999/01/25 12:26:14 ivan
+yet more mod_perl stuff
+
+Revision 1.1 1998/12/30 00:30:45 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+
+=cut
+
+1;
+
package FS::svc_acct;
use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells
+use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells
$shellmachine @saltset @pw_set);
-use Exporter;
use FS::Conf;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs fields );
+use FS::svc_Common;
use FS::SSH qw(ssh);
-use FS::cust_svc;
+use FS::part_svc;
+use FS::svc_acct_pop;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::svc_Common );
-$conf = new FS::Conf;
-$dir_prefix = $conf->config('home');
-@shells = $conf->config('shells');
-$shellmachine = $conf->config('shellmachine');
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::svc_acct'} = sub {
+ $conf = new FS::Conf;
+ $dir_prefix = $conf->config('home');
+ @shells = $conf->config('shells');
+ $shellmachine = $conf->config('shellmachine');
+};
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
use FS::svc_acct;
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
+ $record = new FS::svc_acct \%hash;
+ $record = new FS::svc_acct { 'column' => 'value' };
$error = $record->insert;
=head1 DESCRIPTION
An FS::svc_acct object represents an account. FS::svc_acct inherits from
-FS::Record. The following fields are currently supported:
+FS::svc_Common. The following fields are currently supported:
=over 4
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new account. To add the account to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct',$hashref);
-
-}
+sub table { 'svc_acct'; }
=item insert
=cut
sub insert {
- my($self)=@_;
- my($error);
+ 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;
+ $error = $self->check;
return $error if $error;
return "Username ". $self->username. " in use"
- if qsearchs('svc_acct',{'username'=> $self->username } );
+ if qsearchs( 'svc_acct', { 'username' => $self->username } );
- my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart });
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
return "Unkonwn svcpart" unless $part_svc;
return "uid in use"
if $part_svc->svc_acct__uid_flag ne 'F'
- && qsearchs('svc_acct',{'uid'=> $self->uid } )
+ && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
&& $self->username !~ /^(hyla)?fax$/
;
- my($svcnum)=$self->svcnum;
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->pkgnum,
- 'svcpart' => $self->svcpart,
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->svcnum($cust_svc->svcnum);
- }
-
- $error = $self->add;
- if ($error) {
- #$cust_svc->del if $cust_svc;
- $cust_svc->delete if $cust_svc;
- return $error;
- }
+ $error = $self->SUPER::insert;
+ return $error if $error;
- my($username,$uid,$dir,$shell) = (
+ my ( $username, $uid, $dir, $shell ) = (
$self->username,
$self->uid,
$self->dir,
=cut
sub delete {
- my($self)=@_;
- my($error);
+ 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';
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
+ $error = $self->SUPER::delete;
return $error if $error;
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- my($username) = $self->getfield('username');
+ my $username = $self->username;
if ( $username && $shellmachine && ! $nossh_hack ) {
ssh("root\@$shellmachine","userdel $username");
}
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
return "Username in use"
- if $old->getfield('username') ne $new->getfield('username') &&
- qsearchs('svc_acct',{'username'=> $new->getfield('username') } );
+ if $old->username ne $new->username &&
+ qsearchs( 'svc_acct', { 'username' => $new->username } );
- return "Can't change uid!"
- if $old->getfield('uid') ne $new->getfield('uid');
+ return "Can't change uid!" if $old->uid != $new->uid;
#change homdir when we change username
- if ( $old->getfield('username') ne $new->getfield('username') ) {
- $new->setfield('dir','');
- }
-
- $error=$new->check;
- return $error if $error;
+ $new->setfield('dir', '') if $old->username ne $new->username;
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 = $new->rep($old);
+ $error = $new->SUPER::replace($old);
return $error if $error;
- my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') );
- my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') );
+ my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') );
+ my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') );
if ( $old_dir
&& $new_dir
&& $old_dir ne $new_dir
=cut
sub suspend {
- my($old) = @_;
- my(%hash) = $old->hash;
+ my $self = shift;
+ my %hash = $self->hash;
unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
$hash{_password} = '*SUSPENDED* '.$hash{_password};
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
} else {
''; #no error (already suspended)
}
-
}
=item unsuspend
=cut
sub unsuspend {
- my($old) = @_;
- my(%hash) = $old->hash;
+ my $self = shift;
+ my %hash = $self->hash;
if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
$hash{_password} = $1;
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
} else {
''; #no error (already unsuspended)
}
Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #stub (no error) - taken care of in delete
-}
-
=item check
Checks all fields to make sure this is a valid service. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a svc_acct record!" unless $self->table eq "svc_acct";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
+ my $self = shift;
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
+ my($recref) = $self->hashref;
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
- my($ulen)=$self->dbdef_table->column('username')->length;
+ my $ulen =$self->dbdef_table->column('username')->length;
$recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
or return "Illegal username";
$recref->{username} = $1;
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: svc_acct.pm,v 1.7 1999-04-07 14:37:37 ivan Exp $
+
+=head1 BUGS
The remote commands should be configurable.
-The create method should set defaults from part_svc (like the check method
-sets fixed values).
+The bits which ssh should fork before doing so.
+
+The $recref stuff in sub check should be cleaned up.
=head1 SEE ALSO
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base
-documentation.
+L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>,
+schema.html from the base documentation.
=head1 HISTORY
pod and FS::conf ivan@sisd.com 98-sep-22
+$Log: svc_acct.pm,v $
+Revision 1.7 1999-04-07 14:37:37 ivan
+use FS::part_svc and FS::svc_acct_pop to avoid warnings
+
+Revision 1.6 1999/01/25 12:26:15 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1999/01/18 21:58:09 ivan
+esthetic: eq and ne were used in a few places instead of == and !=
+
+Revision 1.4 1998/12/30 00:30:45 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+Revision 1.2 1998/11/13 09:56:55 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+
=cut
1;
package FS::svc_acct_pop;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::svc_acct_pop;
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
+ $record = new FS::svc_acct_pop \%hash;
+ $record = new FS::svc_acct_pop { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new point of presence (if only it were that easy!). To add the
point of presence to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_pop')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_pop',$hashref);
-}
+sub table { 'svc_acct_pop'; }
=item insert
-Adds this point of presence to the databaes. If there is an error, returns the
+Adds this point of presence to the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet) delete POPs!";
- #$self->del;
-}
+Removes this point of presence from the database.
=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)=@_;
- return "(Old) Not an svc_acct_pop record!"
- unless $old->table eq "svc_acct_pop";
- return "Can't change popnum!"
- unless $old->getfield('popnum') eq $new->getfield('popnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid point of presence. If there is
=cut
sub check {
- my($self)=@_;
- return "Not a svc_acct_pop record!" unless $self->table eq "svc_acct_pop";
+ my $self = shift;
- my($error)=
$self->ut_numbern('popnum')
or $self->ut_text('city')
or $self->ut_text('state')
or $self->ut_number('ac')
or $self->ut_number('exch')
;
- return $error if $error;
-
- '';
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: svc_acct_pop.pm,v 1.2 1998-12-29 11:59:53 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
It should be renamed to part_pop.
pod ivan@sisd.com 98-sep-23
+$Log: svc_acct_pop.pm,v $
+Revision 1.2 1998-12-29 11:59:53 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
package FS::svc_acct_sm;
use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $shellmachine @qmailmachines);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
+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 FS::SSH qw(ssh);
use FS::Conf;
+use FS::svc_acct;
+use FS::svc_domain;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::svc_Common );
-$conf = new FS::Conf;
-
-$shellmachine = $conf->exists('qmailmachines')
- ? $conf->config('shellmachine')
- : '';
+#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
use FS::svc_acct_sm;
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
+ $record = new FS::svc_acct_sm \%hash;
+ $record = new FS::svc_acct_sm { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new virtual mail alias. To add the virtual mail alias to the
database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_sm')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_sm',$hashref);
-
-}
+sub table { 'svc_acct_sm'; }
=item insert
=cut
sub insert {
- my($self)=@_;
- my($error);
+ 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;
if $self->domuser ne '*' &&
! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } );
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
+ $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->getfield('uid'),
- $svc_acct->getfield('gid'),
- $svc_acct->getfield('dir'),
- $svc_domain->getfield('domain')
+ 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;
+ 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 '*' );
The corresponding FS::cust_svc record will be deleted as well.
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct_sm record!" unless $old->table eq "svc_acct_sm";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ 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 ne $new->domsvc
+ || $old->domsvc != $new->domsvc
) && qsearchs('svc_acct_sm',{
'domuser'=> $new->domuser,
'domsvc' => $new->domsvc,
} )
;
- $error=$new->check;
- return $error if $error;
-
- $error = $new->rep($old);
- return $error if $error;
+ $new->SUPER::replace($old);
- ''; #no error
}
=item suspend
Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
=item unsuspend
Just returns false (no error) for now.
Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
=item cancel
Just returns false (no error) for now.
Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
=item check
Checks all fields to make sure this is a valid virtual mail alias. If there is
=cut
sub check {
- my($self)=@_;
- return "Not a svc_acct_sm record!" unless $self->table eq "svc_acct_sm";
- my($recref) = $self->hashref;
+ my $self = shift;
+ my $error;
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct_sm') ) {
- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
- }
- }
+ 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)";
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: svc_acct_sm.pm,v 1.7 1999-04-07 14:40:15 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::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
package FS::svc_domain;
use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine);
-use Exporter;
+use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine
+ $tech_contact $from $to @nameservers @nameserver_ips @template
+);
use Carp;
use Mail::Internet;
use Mail::Header;
use Date::Format;
use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
use FS::Conf;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$mydomain = $conf->config('domain');
-$smtpmachine = $conf->config('smtpmachine');
-
-my($internic)="/var/spool/freeside/conf/registries/internic";
-my($conf_tech)="$internic/tech_contact";
-my($conf_from)="$internic/from";
-my($conf_to)="$internic/to";
-my($nameservers)="$internic/nameservers";
-my($template)="$internic/template";
-
-open(TECH_CONTACT,$conf_tech) or die "Can't open $conf_tech: $!";
-my($tech_contact)=map {
- /^(.*)$/ or die "Illegal line in $conf_tech!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TECH_CONTACT>;
-close TECH_CONTACT;
-
-open(FROM,$conf_from) or die "Can't open $conf_from: $!";
-my($from)=map {
- /^(.*)$/ or die "Illegal line in $conf_from!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <FROM>;
-close FROM;
-
-open(TO,$conf_to) or die "Can't open $conf_to: $!";
-my($to)=map {
- /^(.*)$/ or die "Illegal line in $conf_to!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TO>;
-close TO;
-
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameservers)=map {
- /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameserver_ips)=map {
- /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-
-open(TEMPLATE,$template) or die "Can't open $template: $!";
-my(@template)=map {
- /^(.*)$/ or die "Illegal line in $to!"; #yes, we trust the file
- $1. "\n";
-} <TEMPLATE>;
-close TEMPLATE;
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::cust_pkg;
+use FS::cust_main;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::domain'} = sub {
+ $conf = new FS::Conf;
+
+ $mydomain = $conf->config('domain');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ my($internic)="/registries/internic";
+ $tech_contact = $conf->config("$internic/tech_contact");
+ $from = $conf->config("$internic/from");
+ $to = $conf->config("$internic/to");
+ my(@ns) = $conf->config("$internic/nameservers");
+ @nameservers=map {
+ /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers";
+ $1;
+ } @ns;
+ @nameserver_ips=map {
+ /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers!";
+ $1;
+ } @ns;
+ @template = map { $_. "\n" } $conf->config("$internic/template");
+
+};
=head1 NAME
use FS::svc_domain;
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
+ $record = new FS::svc_domain \%hash;
+ $record = new FS::svc_domain { 'column' => 'value' };
$error = $record->insert;
=head1 DESCRIPTION
An FS::svc_domain object represents a domain. FS::svc_domain inherits from
-FS::Record. The following fields are currently supported:
+FS::svc_Common. The following fields are currently supported:
=over 4
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new domain. To add the domain to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_domain')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_domain',$hashref);
-
-}
+sub table { 'svc_domain'; }
=item insert
A registration or transfer email will be submitted unless
$FS::svc_domain::whois_hack is true.
+The additional field I<email> can be used to manually set the admin contact
+email address on this email. Otherwise, the svc_acct records for this package
+(see L<FS::cust_pkg>) are searched. If there is exactly one svc_acct record
+in the same package, it is automatically used. Otherwise an error is returned.
+
=cut
sub insert {
- my($self)=@_;
- my($error);
+ 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;
+ $error = $self->check;
return $error if $error;
return "Domain in use (here)"
- if qsearchs('svc_domain',{'domain'=> $self->domain } );
+ if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
- my($whois)=(($self->_whois)[0]);
+ my $whois = ($self->_whois)[0];
return "Domain in use (see whois)"
if ( $self->action eq "N" && $whois !~ /^No match for/ );
return "Domain not found (see whois)"
if ( $self->action eq "M" && $whois =~ /^No match for/ );
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
+ $error = $self->SUPER::insert;
+ return $error if $error;
$self->submit_internic unless $whois_hack;
The corresponding FS::cust_svc record will be deleted as well.
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- '';
+ $new->SUPER::replace($old);
}
Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
=item unsuspend
Just returns false (no error) for now.
Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
=item cancel
Just returns false (no error) for now.
Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
=item check
Checks all fields to make sure this is a valid domain. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a svc_domain record!" unless $self->table eq "svc_domain";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc (and pkgnum)
- my($svcpart,$pkgnum);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- $pkgnum=$cust_svc->pkgnum;
+ my $self = shift;
+ my $error;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
+
+ #hmm
+ my $pkgnum;
+ if ( $self->svcnum ) {
+ my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
+ $pkgnum = $cust_svc->pkgnum;
} else {
- $svcpart=$self->svcpart;
- $pkgnum=$self->pkgnum;
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
+ $pkgnum = $self->pkgnum;
}
+ my($recref) = $self->hashref;
+
unless ( $whois_hack ) {
unless ( $self->email ) { #find out an email address
- my(@svc_acct);
- foreach ( qsearch('cust_svc',{'pkgnum'=>$pkgnum}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$_->svcnum});
+ my @svc_acct;
+ foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } );
push @svc_acct, $svc_acct if $svc_acct;
}
if ( scalar(@svc_acct) == 0 ) {
- return "Must order an account first";
+ return "Must order an account in package ". $pkgnum. " first";
} elsif ( scalar(@svc_acct) > 1 ) {
return "More than one account in package ". $pkgnum. ": specify admin contact email";
} else {
=cut
sub _whois {
- my($self)=@_;
- my($domain)=$self->domain;
+ my $self = shift;
+ my $domain = $self->domain;
return ( "No match for domain \"$domain\"." ) if $whois_hack;
- open(WHOIS,"whois do $domain |");
+ open(WHOIS, "whois do $domain |");
return <WHOIS>;
}
=cut
sub submit_internic {
- my($self)=@_;
+ my $self = shift;
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum});
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
return unless $cust_pkg;
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
+ my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } );
return unless $cust_main;
- my(%subs)=(
+ my %subs = (
'action' => $self->action,
'purpose' => $self->purpose,
'domain' => $self->domain,
);
#yuck
- my(@xtemplate)=@template;
- my(@body);
- my($line);
- OLOOP: while ( defined($line = shift @xtemplate) ) {
+ my @xtemplate = @template;
+ my @body;
+ my $line;
+ OLOOP: while ( defined( $line = shift @xtemplate ) ) {
if ( $line =~ /^###LOOP###$/ ) {
my(@buffer);
- LOADBUF: while ( defined($line = shift @xtemplate) ) {
+ LOADBUF: while ( defined( $line = shift @xtemplate ) ) {
last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
push @buffer, $line;
}
- my(%lubs)=(
+ my %lubs = (
'address' => $cust_main->address2
? [ $cust_main->address1, $cust_main->address2 ]
: [ $cust_main->address1 ]
'secondary_ip' => [ @nameserver_ips ],
);
LOOP: while (1) {
- my(@xbuffer)=@buffer;
- SUBLOOP: while ( defined($line = shift @xbuffer) ) {
+ my @xbuffer = @buffer;
+ SUBLOOP: while ( defined( $line = shift @xbuffer ) ) {
if ( $line =~ /###(\w+)###/ ) {
#last LOOP unless my($lub)=shift@{$lubs{$1}};
next OLOOP unless my $lub = shift @{$lubs{$1}};
} #OLOOP
- my($subject);
+ my $subject;
if ( $self->action eq "M" ) {
$subject = "MODIFY DOMAIN ". $self->domain;
- } elsif ($self->action eq "N" ) {
+ } elsif ( $self->action eq "N" ) {
$subject = "NEW DOMAIN ". $self->domain;
} else {
croak "submit_internic called with action ". $self->action;
}
- $ENV{SMTPHOSTS}=$smtpmachine;
- $ENV{MAILADDRESS}=$from;
- my($header)=Mail::Header->new( [
+ $ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $from;
+ my $header = Mail::Header->new( [
"From: $from",
"To: $to",
"Sender: $from",
"Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z",time),
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
"Subject: $subject",
] );
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: svc_domain.pm,v 1.7 1999-04-07 14:40:15 ivan Exp $
+
+=head1 BUGS
All BIND/DNS fields should be included (and exported).
-All registries should be supported.
+Delete doesn't send a registration template.
-Not all configuration access is through FS::Conf!
+All registries should be supported.
Should change action to a real field.
+The $recref stuff in sub check should be cleaned up.
+
=head1 SEE ALSO
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation,
-config.html from the base documentation.
+L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation, config.html from the base documentation.
=head1 HISTORY
pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
+$Log: svc_domain.pm,v $
+Revision 1.7 1999-04-07 14:40:15 ivan
+use all stuff that's qsearch'ed to avoid warnings
+
+Revision 1.6 1999/01/25 12:26:17 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1998/12/30 00:30:47 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+Revision 1.3 1998/11/13 09:56:57 ivan
+change configuration file layout to support multiple distinct databases (with
+own set of config files, export, etc.)
+
+Revision 1.2 1998/10/14 08:18:21 ivan
+More informative error messages and better doc for admin contact email stuff
+
+
=cut
1;
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-21
-
package FS::svc_table;
use strict;
-use Exporter;
-use FS::Record qw(fields qsearchs);
+use vars qw(@ISA);
+#use FS::Record qw( qsearch qsearchs );
+use FS::svc_Common;
+use FS::cust_svc;
-@FS::svc_table::ISA = qw(FS::Record Exporter);
+@ISA = qw(svc_Common);
-# Usage: $record = create FS::svc_table ( \%hash );
-# $record = create FS::svc_table ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
+=head1 NAME
- my($field);
- foreach $field (fields('svc_table')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
+FS::table_name - Object methods for table_name records
- $proto->new('svc_table',$hashref);
+=head1 SYNOPSIS
-}
+ use FS::table_name;
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
- my($error);
+ $record = new FS::table_name \%hash;
+ $record = new FS::table_name { 'column' => 'value' };
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
+ $error = $record->insert;
- $error=$self->check;
- return $error if $error;
+ $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::table_name object represents an example. FS::table_name inherits from
+FS::svc_Common. The following fields are currently supported:
+
+=over 4
+
+=item field - description
+
+=back
+
+=head1 METHODS
- $error = $self->add;
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example 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
+
+sub table { 'table_name'; }
+
+=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 L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ $error = $self->SUPER::insert;
return $error if $error;
- ''; #no error
+ '';
}
-# Usage: $error = $record -> delete;
+=item delete
+
+Delete this record from the database.
+
+=cut
+
sub delete {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
- $error = $self->del;
+ $error = $self->SUPER::delete;
return $error if $error;
+ '';
}
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- my($error);
- return "(Old) Not a svc_table record!" unless $old->table eq "svc_table";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+=item replace OLD_RECORD
- $error=$new->check;
- return $error if $error;
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
- $error = $new->rep($old);
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ $error = $new->SUPER::replace($old);
return $error if $error;
- ''; #no error
+ '';
}
-# Usage: $error = $record -> suspend;
-sub suspend {
- ''; #no error (stub)
-}
+=item suspend
-# Usage: $error = $record -> unsuspend;
-sub unsuspend {
- ''; #no error (stub)
-}
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #no error (stub)
-}
+=item unsuspend
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+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 example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
-# Usage: $error = $record -> check;
sub check {
- my($self)=@_;
- return "Not a svc_table record!" unless $self->table eq "svc_table";
- my($recref) = $self->hashref;
+ my $self = shift;
- $recref->{svcnum} =~ /^(\d+)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
- return "Unknown svcnum" unless
- qsearchs('cust_svc',{'svcnum'=> $recref->{svcnum} } );
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
- #DATA CHECKS GO HERE!
''; #no error
}
+=back
+
+=head1 VERSION
+
+$Id: table_template-svc.pm,v 1.4 1998-12-30 00:30:48 ivan Exp $
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
+L<FS::cust_pkg>, schema.html from the base documentation.
+
+=head1 HISTORY
+
+ivan@voicenet.com 97-jul-21
+
+$Log: table_template-svc.pm,v $
+Revision 1.4 1998-12-30 00:30:48 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+Revision 1.2 1998/11/15 04:33:01 ivan
+updates for newest versoin
+
+
+=cut
+
1;
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
-package FS::table_name;
-
-use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearch qsearchs);
-
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
-
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('table_name',$hashref);
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
- return "Can't change keyfield!"
- unless $old->getfield('keyfield') eq $new->getfield('keyfield');
- $new->check or
- $new->rep($old);
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
-
- ''; #no error
-}
-
-1;
-
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
package FS::table_name;
use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(hfields qsearch qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
+@ISA = qw(FS::Record);
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
+=head1 NAME
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
+FS::table_name - Object methods for table_name records
- $proto->new('table_name',$hashref);
+=head1 SYNOPSIS
-}
+ use FS::table_name;
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
+ $record = new FS::table_name \%hash;
+ $record = new FS::table_name { 'column' => 'value' };
- $self->check or
- $self->add;
-}
+ $error = $record->insert;
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
+ $error = $new_record->replace($old_record);
- $self->del;
-}
+ $error = $record->delete;
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
+ $error = $record->check;
- $new->check or
- $new->rep($old);
-}
+=head1 DESCRIPTION
+
+An FS::table_name object represents an example. FS::table_name inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item field - description
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example 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 { 'table_name'; }
+
+=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 example. 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
-# Usage: $error = $record -> check;
sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
+ my $self = shift;
''; #no error
}
+=back
+
+=head1 VERSION
+
+$Id: table_template.pm,v 1.4 1998-12-29 11:59:57 ivan Exp $
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=head1 HISTORY
+
+ivan@voicenet.com 97-jul-1
+
+added hfields
+ivan@sisd.com 97-nov-13
+
+$Log: table_template.pm,v $
+Revision 1.4 1998-12-29 11:59:57 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+Revision 1.3 1998/11/15 04:33:00 ivan
+updates for newest versoin
+
+Revision 1.2 1998/11/15 03:48:49 ivan
+update for current version
+
+
+=cut
+
1;
package FS::type_pkgs;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::agent_type;
+use FS::part_pkg;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
use FS::type_pkgs;
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
+ $record = new FS::type_pkgs \%hash;
+ $record = new FS::type_pkgs { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new record. To add the record to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('type_pkgs')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('type_pkgs',$hashref);
-
-}
+sub table { 'type_pkgs'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this record from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=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)=@_;
- return "(Old) Not a type_pkgs record!" unless $old->table eq "type_pkgs";
-
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid record. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a type_pkgs record!" unless $self->table eq "type_pkgs";
- my($recref) = $self->hashref;
+ my $self = shift;
+
+ my $error =
+ $self->ut_number('typenum')
+ || $self->ut_number('pkgpart')
+ ;
+ return $error if $error;
- $recref->{typenum} =~ /^(\d+)$/ or return "Illegal typenum";
- $recref->{typenum} = $1;
return "Unknown typenum"
- unless qsearchs('agent_type',{'typenum'=>$recref->{typenum}});
+ unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart} = $1;
return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
''; #no error
}
=back
+=head1 VERSION
+
+$Id: type_pkgs.pm,v 1.2 1998-12-29 11:59:58 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::agent_type>, L<FS::part_pkgs>, schema.html from the base
+documentation.
+
=head1 HISTORY
Defines the relation between agent types and pkgparts
change to ut_ FS::Record, fixed bugs
ivan@sisd.com 97-dec-10
+$Log: type_pkgs.pm,v $
+Revision 1.2 1998-12-29 11:59:58 ivan
+mostly properly OO, some work still to be done with svc_ stuff
+
+
=cut
1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cgi-test,v 1.1 1999-04-08 13:05:40 ivan Exp $
+#
+# This is the beginning of a test suite for the web interface.
+# It's also excellent for populating your database with some meaningful test
+# data. (a derivative is used by the web demo)
+# It only works on an empty database (probably need empty counters too, and
+# no arbirary RADIUS attributes).
+# Usage: cgi-test http://base.freeside.url/with/path/ username password
+# (Yes, if you were properly paranoid and are using SSL, you'll need to get
+# libwww-perl working with SSL to use this.)
+#
+# $Log: cgi-test,v $
+# Revision 1.1 1999-04-08 13:05:40 ivan
+# web interface tester / sample data creator
+#
+
+use strict;
+#use diagnostics;
+use subs qw( big_ugly_data_structure );
+use CGI;
+use LWP::UserAgent;
+
+my ( $base_url, $username, $password ) = ( shift, shift, shift );
+
+my @data = &big_ugly_data_structure;
+
+my $ua = new LWP::UserAgent;
+{
+ local $^W = 0;
+ eval '
+ sub LWP::UserAgent::get_basic_credentials {
+ #my $self = shift;
+ ( $username, $password );
+ }
+ ';
+}
+
+my $data;
+while ( $data = shift @data ) {
+ my $cgi = new CGI ( $data->{'params'} );
+ my $full_url = $base_url. $data->{'url'}. '?'. $cgi->query_string;
+ #my $request = new HTTP::Request( 'POST', $full_url );
+ my $request = new HTTP::Request( 'GET', $full_url );
+ my $response = $ua->request( $request );
+ if ( $response->is_redirect ) {
+ die "Unexpected redirect!\n".
+ "URL: $full_url\n".
+ "To: ". $response->base. "\n"
+ ;
+ } elsif ( $response->is_success ) {
+ my $location = $response->base;
+ my $expected_location = $data->{'location'};
+ #if ( $location =~ /^$base_url$expected_location$/ ) {
+ if ( $location eq $base_url. $expected_location ) {
+ #warn "cool, got expected response $location from $full_url\n";
+ } else {
+ die "Strange, regular response, but unexpected base!\n".
+ "URL: $full_url\n".
+ "Base : ". $response->base. "\n".
+ "Expected: $base_url$expected_location\n".
+ "Output: ". $response->content. "\n"
+ ;
+ }
+ } elsif ( $response->is_error ) {
+ die "Strange, I got an error\n".
+ "URL: $full_url\n".
+ "Error: ". $response->error_as_HTML. "\n".
+ "Output: ". $response->content. "\n"
+ ;
+ } elsif ( $response->is_info ) {
+ die "Strange, I got an info reponse\n".
+ "URL: $full_url\n".
+ "Output: ". $response->content. "\n"
+ ;
+ } else {
+ die "Really strange, got an unrecognized response from LWP::UserAgent!\n";
+ }
+}
+
+#---
+
+sub big_ugly_data_structure {
+
+ (
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Shell',
+ 'svcdb' => 'svc_acct',
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'F',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'D',
+ 'svc_acct__shell' => '/bin/sh',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'SLIP/PPP',
+ 'svcdb' => 'svc_acct',
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'D',
+ 'svc_acct__slipip' => '0.0.0.0',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'D',
+ 'svc_acct__shell' => '/bin/sh',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'POP Mailbox',
+ 'svcdb' => 'svc_acct',,
+ 'svc_acct__popnum_flag' => 'F',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'F',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'F',
+ 'svc_acct__shell' => '/bin/passwd',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Domain',
+ 'svcdb' => 'svc_domain',,
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => '',
+ 'svc_acct__quota' => '',
+ 'svc_acct__slipip_flag' => '',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => '',
+ 'svc_acct__shell' => '',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Domain email alias',
+ 'svcdb' => 'svc_acct_sm',,
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => '',
+ 'svc_acct__quota' => '',
+ 'svc_acct__slipip_flag' => '',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => '',
+ 'svc_acct__shell' => '',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal SLIP/PPP',
+ 'comment' => '$30/setup, $19.99/month',
+ 'setup' => '30',
+ 'recur' => '19.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal SLIP/PPP',
+ 'comment' => '$0/setup, $179.88/year',
+ 'setup' => '0',
+ 'recur' => '179.88',
+ 'freq' => '12',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal POP mailbox',
+ 'comment' => '$10/setup, $5/month',
+ 'setup' => '10',
+ 'recur' => '5',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '1',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business SLIP/PPP',
+ 'comment' => '$30/setup, $29.99/month',
+ 'setup' => '30',
+ 'recur' => '29.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business SLIP/PPP',
+ 'comment' => '$0/setup, $299.88/year',
+ 'setup' => '0',
+ 'recur' => '299.88',
+ 'freq' => '12',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business POP mailbox',
+ 'comment' => '$10/setup, $5/month',
+ 'setup' => '10',
+ 'recur' => '5',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '1',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'UNIX shell',
+ 'comment' => '$20/setup, $9.99/month',
+ 'setup' => '20',
+ 'recur' => '9.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '1',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Point-to-point T1',
+ 'comment' => '$1000/setup, $1000/month',
+ 'setup' => '1000',
+ 'recur' => '1000',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '5',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '5',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Cisco 2501 Router',
+ 'comment' => '$2500',
+ 'setup' => '2500',
+ 'recur' => '0',
+ 'freq' => '0',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+
+ { 'url' => 'edit/process/agent_type.cgi',
+ 'params' => {
+ 'typenum' => '',
+ 'atype' => 'Internal Sales',
+ 'pkgpart1' => 'ON',
+ 'pkgpart2' => 'ON',
+ 'pkgpart3' => 'ON',
+ 'pkgpart4' => 'ON',
+ 'pkgpart5' => 'ON',
+ 'pkgpart6' => 'ON',
+ 'pkgpart7' => 'ON',
+ 'pkgpart8' => 'ON',
+ 'pkgpart9' => 'ON',
+ },
+ 'location' => 'browse/agent_type.cgi',
+ },
+
+ { 'url' => 'edit/process/agent.cgi',
+ 'params' => {
+ 'agentnum' => '',
+ 'agent' => 'Internal Sales',
+ 'typenum' => '1',
+ 'freq' => '',
+ 'prog' => '',
+ },
+ 'location' => 'browse/agent.cgi',
+ },
+
+ { 'url' => 'edit/process/part_referral.cgi',
+ 'params' => {
+ 'refnum' => '',
+ 'referral' => 'Another customer',
+ },
+ 'location' => 'browse/part_referral.cgi',
+ },
+ { 'url' => 'edit/process/part_referral.cgi',
+ 'params' => {
+ 'refnum' => '',
+ 'referral' => 'Newspaper ad',
+ },
+ 'location' => 'browse/part_referral.cgi',
+ },
+
+ { 'url' => 'edit/process/svc_acct_pop.cgi',
+ 'params' => {
+ 'popnum' => '',
+ 'city' => 'Line Lexington',
+ 'state' => 'PA',
+ 'ac' => '215',
+ 'exch' => '996',
+ },
+ 'location' => 'browse/svc_acct_pop.cgi',
+ },
+ { 'url' => 'edit/process/svc_acct_pop.cgi',
+ 'params' => {
+ 'popnum' => '',
+ 'city' => 'Oakland',
+ 'state' => 'CA',
+ 'ac' => '510',
+ 'exch' => '208',
+ },
+ 'location' => 'browse/svc_acct_pop.cgi',
+ },
+
+ { 'url' => 'edit/process/cust_main.cgi',
+ 'params' => {
+ 'custnum' => '',
+ 'agentnum' => '1',
+ 'refnum' => '1',
+ 'last' => 'Hogan',
+ 'first' => 'Shawn D.',
+ 'ss' => '',
+ 'company' => 'Digital Point Solutions',
+ 'address1' => '3570 Tony Drive',
+ 'address2' => '',
+ 'city' => 'San Diego',
+ 'state' => 'CA / US',
+ 'zip' => '92122-2307',
+ 'daytime' => '',
+ 'night' => '',
+ 'fax' => '',
+ 'tax' => '',
+ 'invoicing_list_POST' => '',
+ 'invoicing_list' => '',
+ 'payby' => 'BILL',
+ 'CARD_payinfo' => '',
+ 'CARD_month' => '1',
+ 'CARD_year' => '1999',
+ 'CARD_payname' => '',
+ 'BILL_payinfo' => '',
+ 'BILL_month' => '12',
+ 'BILL_year' => '2037',
+ 'BILL_payname' => 'Accounts Payable',
+ 'COMP_payinfo' => '',
+ 'COMP_month' => '1',
+ 'COMP_year' => '1999',
+ 'pkgpart_svcpart' => '1_2',
+ 'username' => 'cyborg',
+ '_password' => '',
+ 'popnum' => '1',
+ 'otaker' => 'example',
+ },
+ 'location' => 'view/cust_main.cgi?1',
+ },
+ { 'url' => 'edit/process/cust_main.cgi',
+ 'params' => {
+ 'custnum' => '',
+ 'agentnum' => '1',
+ 'refnum' => '2',
+ 'last' => 'Ford',
+ 'first' => 'Bill',
+ 'ss' => '',
+ 'company' => 'Boardtown Corporation',
+ 'address1' => '116 East Main Street',
+ 'address2' => '',
+ 'city' => 'Starkville',
+ 'state' => 'MS / US',
+ 'zip' => '39759',
+ 'daytime' => '',
+ 'night' => '',
+ 'fax' => '',
+ 'tax' => '',
+ 'invoicing_list_POST' => '',
+ 'invoicing_list' => '',
+ 'payby' => 'BILL',
+ 'CARD_payinfo' => '',
+ 'CARD_month' => '1',
+ 'CARD_year' => '1999',
+ 'CARD_payname' => '',
+ 'BILL_payinfo' => '',
+ 'BILL_month' => '12',
+ 'BILL_year' => '2037',
+ 'BILL_payname' => 'Accounts Payable',
+ 'COMP_payinfo' => '',
+ 'COMP_month' => '1',
+ 'COMP_year' => '1999',
+ 'pkgpart_svcpart' => '3_3',
+ 'username' => 'billf',
+ '_password' => '',
+ 'popnum' => '',
+ 'otaker' => 'example',
+ },
+ 'location' => 'view/cust_main.cgi?2',
+ },
+
+
+ );
+}
+
projects / freeside.git / commitdiff
