'freeside_1_3_0_pci_mods'.
+++ /dev/null
--domreg@domain.tld
+++ /dev/null
--192.168.1.1 ns1.domain.tld
--192.168.1.2 ns2.domain.tld
--192.168.1.3 ns3.domain.tld
+++ /dev/null
--[ URL ftp://rs.internic.net/templates/domain-template.txt ] [ 03/98 ]
--
--******* Please DO NOT REMOVE Version Number or Sections A-Q ********
--
--Domain Version Number: 4.0
--
--******* Email completed agreement to hostmaster@internic.net *******
--
-- NETWORK SOLUTIONS, INC.
--
-- DOMAIN NAME REGISTRATION AGREEMENT
--
--
--A. Introduction. This domain name registration agreement
--("Registration Agreement") is submitted to NETWORK SOLUTIONS, INC.
--("NSI") for the purpose of applying for and registering a domain name
--on the Internet. If this Registration Agreement is accepted by NSI,
--and a domain name is registered in NSI's domain name database and
--assigned to the Registrant, Registrant ("Registrant") agrees to be
--bound by the terms of this Registration Agreement and the terms of
--NSI's Domain Name Dispute Policy ("Dispute Policy") which is
--incorporated herein by reference and made a part of this Registration
--Agreement. This Registration Agreement shall be accepted at the
--offices of NSI.
--
--B. Fees and Payments.
--
--1) Registration or renewal (re-registration) date through March 31, 1998:
--Registrant agrees to pay a registration fee of One Hundred United States
--Dollars (US$100) as consideration for the registration of each new domain
--name or Fifty United States Dollars (US$50) to renew (re-register) an
--existing registration.
--2) Registration or renewal date on and after April 1, 1998: Registrant
--agrees to pay a registration fee of Seventy United States Dollars (US$70)
--as consideration for the registration of each new domain name or the
--applicable renewal (re-registration) fee (currently Thirty-Five United
--States Dollars (US$35)) at the time of renewal (re-registration).
--3) Period of Service: The non-refundable fee covers a period of two (2)
--years for each new registration, and one (1) year for each renewal,
--and includes any permitted modification(s) to the domain name record
--during the covered period.
--4) Payment: Payment is due to Network Solutions within thirty (30)
--days from the date of the invoice.
--
--C. Dispute Policy. Registrant agrees, as a condition to
--submitting this Registration Agreement, and if the Registration
--Agreement is accepted by NSI, that the Registrant shall be bound by
--NSI's current Dispute Policy. The current version of the Dispute
--Policy may be found at the InterNIC Registration Services web site:
--"http://www.netsol.com/rs/dispute-policy.html".
--
--D. Dispute Policy Changes or Modifications. Registrant agrees
--that NSI, in its sole discretion, may change or modify the Dispute
--Policy, incorporated by reference herein, at any time. Registrant
--agrees that Registrant's maintaining the registration of a domain name
--after changes or modifications to the Dispute Policy become effective
--constitutes Registrant's continued acceptance of these changes or
--modifications. Registrant agrees that if Registrant considers any such
--changes or modifications to be unacceptable, Registrant may request
--that the domain name be deleted from the domain name database.
--
--E. Disputes. Registrant agrees that, if the registration of its
--domain name is challenged by any third party, the Registrant will be
--subject to the provisions specified in the Dispute Policy.
--
--F. Agents. Registrant agrees that if this Registration Agreement
--is completed by an agent for the Registrant, such as an ISP or
--Administrative Contact/Agent, the Registrant is nonetheless bound as a
--principal by all terms and conditions herein, including the Dispute
--Policy.
--
--G. Limitation of Liability. Registrant agrees that NSI shall have
--no liability to the Registrant for any loss Registrant may incur in
--connection with NSI's processing of this Registration Agreement, in
--connection with NSI's processing of any authorized modification to the
--domain name's record during the covered period, as a result of the
--Registrant's ISP's failure to pay either the initial registration fee
--or renewal fee, or as a result of the application of the provisions of
--the Dispute Policy. Registrant agrees that in no event shall the
--maximum liability of NSI under this Agreement for any matter exceed
--Five Hundred United States Dollars (US$500).
--
--H. Indemnity. Registrant agrees, in the event the Registration
--Agreement is accepted by NSI and a subsequent dispute arises with any
--third party, to indemnify and hold NSI harmless pursuant to the terms
--and conditions contained in the Dispute Policy.
--
--I. Breach. Registrant agrees that failure to abide by any
--provision of this Registration Agreement or the Dispute Policy may be
--considered by NSI to be a material breach and that NSI may provide a
--written notice, describing the breach, to the Registrant. If, within
--thirty (30) days of the date of mailing such notice, the Registrant
--fails to provide evidence, which is reasonably satisfactory to NSI,
--that it has not breached its obligations, then NSI may delete
--Registrant's registration of the domain name. Any such breach by a
--Registrant shall not be deemed to be excused simply because NSI did
--not act earlier in response to that, or any other, breach by the
--Registrant.
--
--J. No Guaranty. Registrant agrees that, by registration of a
--domain name, such registration does not confer immunity from objection
--to either the registration or use of the domain name.
--
--K. Warranty. Registrant warrants by submitting this Registration
--Agreement that, to the best of Registrant's knowledge and belief, the
--information submitted herein is true and correct, and that any future
--changes to this information will be provided to NSI in a timely manner
--according to the domain name modification procedures in place at that
--time. Breach of this warranty will constitute a material breach.
--
--L. Revocation. Registrant agrees that NSI may delete a
--Registrant's domain name if this Registration Agreement, or subsequent
--modification(s) thereto, contains false or misleading information, or
--conceals or omits any information NSI would likely consider material
--to its decision to approve this Registration Agreement.
--
--M. Right of Refusal. NSI, in its sole discretion, reserves the
--right to refuse to approve the Registration Agreement for any
--Registrant. Registrant agrees that the submission of this Registration
--Agreement does not obligate NSI to accept this Registration Agreement.
--Registrant agrees that NSI shall not be liable for loss or damages
--that may result from NSI's refusal to accept this Registration
--Agreement.
--
--N. Severability. Registrant agrees that the terms of this
--Registration Agreement are severable. If any term or provision is
--declared invalid, it shall not affect the remaining terms or
--provisions which shall continue to be binding.
--
--O. Entirety. Registrant agrees that this Registration Agreement
--and the Dispute Policy is the complete and exclusive agreement between
--Registrant and NSI regarding the registration of Registrant's domain
--name. This Registration Agreement and the Dispute Policy supersede all
--prior agreements and understandings, whether established by custom,
--practice, policy, or precedent.
--
--P. Governing Law. Registrant agrees that this Registration
--Agreement shall be governed in all respects by and construed in
--accordance with the laws of the Commonwealth of Virginia, United
--States of America. By submitting this Registration Agreement,
--Registrant consents to the exclusive jurisdiction and venue of the
--United States District Court for the Eastern District of Virginia,
--Alexandria Division. If there is no jurisdiction in the United States
--District Court for the Eastern District of Virginia, Alexandria
--Division, then jurisdiction shall be in the Circuit Court of Fairfax
--County, Fairfax, Virginia.
--
--Q. This is Domain Name Registration Agreement Version
--Number 4.0. This Registration Agreement is only for registrations
--under top-level domains: COM, ORG, NET, and EDU. By completing
--and submitting this Registration Agreement for consideration and
--acceptance by NSI, the Registrant agrees that he/she has read and
--agrees to be bound by A through P above.
--
--
--Authorization
--0a. (N)ew (M)odify (D)elete....:###action###
--0b. Auth Scheme................:
--0c. Auth Info..................:
--
--1. Comments...................:###purpose###
--
--2. Complete Domain Name.......:###domain###
--
--Organization Using Domain Name
--
--3a. Organization Name..........:###company###
--###LOOP###
--3b. Street Address.............:###address###
--###ENDLOOP###
--3c. City.......................:###city###
--3d. State......................:###state###
--3e. Postal Code................:###zip###
--3f. Country....................:###country###
--
--Administrative Contact
--4a. NIC Handle (if known)......:
--4b. (I)ndividual (R)ole........:I
--4c. Name (Last, First).........:###last###, ###first###
--4d. Organization Name..........:###company###
--###LOOP###
--4e. Street Address.............:###address###
--###ENDLOOP###
--4f. City.......................:###city###
--4g. State......................:###state###
--4h. Postal Code................:###zip###
--4i. Country....................:###country###
--4j. Phone Number...............:###daytime###
--4k. Fax Number.................:###fax###
--4l. E-Mailbox..................:###email###
--
--Technical Contact
--5a. NIC Handle (if known)......:###tech_contact###
--5b. (I)ndividual (R)ole........:
--5c. Name (Last, First).........:
--5d. Organization Name..........:
--5e. Street Address.............:
--5f. City.......................:
--5g. State......................:
--5h. Postal Code................:
--5i. Country....................:
--5j. Phone Number...............:
--5k. Fax Number.................:
--5l. E-Mailbox..................:
--
--Billing Contact
--6a. NIC Handle (if known)......:
--6b. (I)ndividual (R)ole........:
--6c. Name (Last, First).........:
--6d. Organization Name..........:
--6e. Street Address.............:
--6f. City.......................:
--6g. State......................:
--6h. Postal Code................:
--6i. Country....................:
--6j. Phone Number...............:
--6k. Fax Number.................:
--6l. E-Mailbox..................:
--
--Prime Name Server
--7a. Primary Server Hostname....:###primary###
--7b. Primary Server Netaddress..:###primary_ip###
--
--Secondary Name Server(s)
--###LOOP###
--8a. Secondary Server Hostname..:###secondary###
--8b. Secondary Server Netaddress:###secondary_ip###
--###ENDLOOP###
--
--END OF AGREEMENT
--
+++ /dev/null
--hostmaster@internic.net
+++ /dev/null
--#!/usr/bin/perl -w
--
--# 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 FS::cust_svc;
- use FS::svc_acct;
- use FS::pkg_svc;
-use Date::Parse;
--
- my $user = shift or die &usage;
- adminsuidsetup $user;
-adminsuidsetup;
--
--# use these for the imported cust_main records (unless you have these in legacy
--# data)
--my($agentnum)=4;
--my($refnum)=5;
--
--# map from legacy billing data to pkgpart, maps imported field
--# LegacyBillingData to pkgpart. your names and pkgparts will be different
--my(%pkgpart)=(
-- 'Employee' => 10,
-- 'Business' => 11,
-- 'Individual' => 12,
-- 'Basic PPP' => 13,
-- 'Slave' => 14,
-- 'Co-Located Server' => 15,
-- 'Virtual Web' => 16,
-- 'Perk Mail' => 17,
-- 'Credit Hold' => 18,
--);
--
--my($file)="legacy_file";
--
--open(CLIENT,$file)
-- or die "Can't open $file: $!";
--
--# put a tab-separated header atop the file, or define @fields
--# (use these names or change them below)
--#
--# for cust_main
--# custnum - unique
--# last - (name)
--# first - (name)
--# company
--# address1
--# address2
--# city
--# state
--# zip
--# country
--# daytime - (phone)
--# night - (phone)
--# fax
--# payby - CARD, BILL or COMP
--# payinfo - Credit card #, P.O. # or COMP authorization
--# paydate - Expiration
--# tax - 'Y' for tax exempt
--# for cust_pkg
--# LegacyBillingData - maps via %pkgpart above to a pkgpart
--# for svc_acct
--# username
--
--my($header);
--$header=<CLIENT>;
--chop $header;
--my(@fields)=map { /^\s*(.*[^\s]+)\s*$/; $1 } split(/\t/,$header);
--#print join("\n",@fields);
--
--my($error);
--my($link,$line)=(0,0);
--while (<CLIENT>) {
-- chop;
-- next if /^[\s\t]*$/; #skip any blank lines
--
-- #define %svc hash for this record
-- my(@record)=split(/\t/);
-- my(%svc);
-- foreach (@fields) {
-- $svc{$_}=shift @record;
-- }
--
-- # might need to massage some data like this
-- $svc{'payby'} =~ s/^Credit Card$/CARD/io;
-- $svc{'payby'} =~ s/^Check$/BILL/io;
-- $svc{'payby'} =~ s/^Cash$/BILL/io;
-- $svc{'payby'} =~ s/^$/BILL/o;
-- $svc{'First'} =~ s/&/and/go;
-- $svc{'Zip'} =~ s/\s+$//go;
--
- my($cust_main) = new FS::cust_main ( {
- my($cust_main) = create FS::cust_main ( {
-- 'custnum' => $svc{'custnum'},
-- 'agentnum' => $agentnum,
-- 'last' => $svc{'last'},
-- 'first' => $svc{'first'},
-- 'company' => $svc{'company'},
-- 'address1' => $svc{'address1'},
-- 'address2' => $svc{'address2'},
-- 'city' => $svc{'city'},
-- 'state' => $svc{'state'},
-- 'zip' => $svc{'zip'},
-- 'country' => $svc{'country'},
-- 'daytime' => $svc{'daytime'},
-- 'night' => $svc{'night'},
-- 'fax' => $svc{'fax'},
-- 'payby' => $svc{'payby'},
-- 'payinfo' => $svc{'payinfo'},
-- 'paydate' => $svc{'paydate'},
-- 'payname' => $svc{'payname'},
-- 'tax' => $svc{'tax'},
-- 'refnum' => $refnum,
-- } );
--
-- $error=$cust_main->insert;
--
-- if ( $error ) {
-- warn $cust_main->_dump;
-- warn map "$_: ". $svc{$_}. "|\n", keys %svc;
-- die $error;
-- }
--
- my($cust_pkg)=new FS::cust_pkg ( {
- my($cust_pkg)=create FS::cust_pkg ( {
-- 'custnum' => $svc{'custnum'},
-- 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
-- 'setup' => '',
-- 'bill' => '',
-- 'susp' => '',
-- 'expire' => '',
-- 'cancel' => '',
-- } );
--
-- $error=$cust_pkg->insert;
-- if ( $error ) {
-- warn $svc{'LegacyBillingData'};
-- die $error;
-- }
--
-- unless ( $svc{'username'} ) {
-- warn "Empty login";
-- } else {
-- #find svc_acct record (imported with bin/svc_acct.import) for this username
-- my($svc_acct)=qsearchs('svc_acct',{'username'=>$svc{'username'}});
-- unless ( $svc_acct ) {
-- warn "username ", $svc{'username'}, " not found\n";
-- } else {
-- #link to the cust_pkg record we created above
--
-- #find cust_svc record for this svc_acct record
-- my($o_cust_svc)=qsearchs('cust_svc',{
-- 'svcnum' => $svc_acct->svcnum,
-- 'pkgnum' => '',
-- } );
-- unless ( $o_cust_svc ) {
-- warn "No unlinked cust_svc for svcnum ", $svc_acct->svcnum;
-- } else {
--
-- #make sure this svcpart is in pkgpart
-- my($pkg_svc)=qsearchs('pkg_svc',{
-- 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
-- 'svcpart' => $o_cust_svc->svcpart,
-- 'quantity' => 1,
-- });
-- unless ( $pkg_svc ) {
-- warn "login ", $svc{'username'}, ": No svcpart ", $o_cust_svc->svcpart,
-- " for pkgpart ", $pkgpart{$svc{'Acct. Type'}}, "\n" ;
-- } else {
--
-- #create new cust_svc record linked to cust_pkg record
- my($n_cust_svc) = new FS::cust_svc ({
- my($n_cust_svc) = create FS::cust_svc ({
-- 'svcnum' => $o_cust_svc->svcnum,
-- 'pkgnum' => $cust_pkg->pkgnum,
-- 'svcpart' => $pkg_svc->svcpart,
-- });
-- my($error) = $n_cust_svc->replace($o_cust_svc);
-- die $error if $error;
-- $link++;
-- }
-- }
-- }
-- }
--
-- $line++;
--
--}
--
--warn "\n$link of $line lines linked\n";
-
- # ---
--
- sub usage {
- die "Usage:\n\n cust_main.import user\n";
- }
+++ /dev/null
--#!/usr/bin/perl
--
--###
--# WHO WROTE THIS???
--###
--
--#require "perldb.pl";
--
--# Compute SLIP/PPP log times
--# Arguments -a Process entire file with totals
--# -t Process only totals
--# -f File to be processed if not current
--# -d processing start date (default is entire file)
--# -l to return all totals for dayuse
--# -w name of tmp work file for dayuse
--# user names
--
--require "time.pl";
--
--$space=' ';
--
--unless (@ARGV[0]) {
-- print "Missing Arguments\n";
-- print "-a - entire file\n";
-- print "-t - totals only\n";
-- print "-f - file name to be processed\n";
-- print "-d - processing start date (yymmdd)\n";
-- print "-l - return totals for dayuse\n";
-- print "-w - tmp work file for dayuse\n";
-- exit;
--} # end if test for missing arguments
--
--$infile = "/usr/annex/acp_logfile";
--$tmpfile = "/tmp/ppp";
--$n = $#ARGV;
--$start_yymmdd = "";
--for ($i = 0; $i <= $n; $i++) {
-- if ($ARGV[$i] eq "-a") {
-- $allflag = "true";
-- }
-- elsif ($ARGV[$i] eq "-t") {
-- $totalflag = "true";
-- }
-- elsif ($ARGV[$i] eq "-f") {
-- $i++;
-- $infile = $ARGV[$i];
-- }
-- elsif ($ARGV[$i] eq "-d") {
-- $i++;
-- $start_yymmdd = $ARGV[$i];
-- } #end start yymmdd
-- elsif ($ARGV[$i] eq "-l") {
-- $logflag = "true";
-- $totalflag = "true";
-- } # end log
-- elsif ($ARGV[$i] eq "-w") {
-- $i++;
-- $tmpfile = $ARGV[$i];
-- } # end tmp file
-- else {
-- ($arg_user,$arg_yymmdd) = split (/:/, $ARGV[$i]);
-- $ip_user_date {$arg_user} = $ARGV[$i];
-- $userflag = "true";
-- } # end else
-- } # end for 1 = 1 to n
--
--open (IN,$infile)
-- || die "Can't open acp_logfile";
--
--NEXTUSER: while (<IN>) {
-- chop;
-- ($add,$ether,$port,$date,$time,$type,$action,$user) = split(/:/);
--
-- if ($logflag) {
-- $start_yymmdd = '';
-- if ($ip_user_date{$user}) {
-- ($ip_user, $start_yymmdd) =
-- split (/:/, $ip_user_date{$user});
-- } # end get date
-- } # end log flag
-- if ($start_yymmdd) {
-- if ($date < $start_yymmdd) {
-- next NEXTUSER;
-- } #end date compare
-- } #end if date
-- if ($userflag){
-- if (!$ip_user_date{$user}) {
-- next NEXTUSER;
-- } # end user test
-- } # end by user or all
-- if (($totalflag) ||
-- ($allflag) ||
-- ($ip_user_date{$user})) {
-- if (($type eq 'ppp') || ($type eq 'slip')) {
--
-- if ($action eq 'login') {
-- $login{$user} = "$time:$date";
--
-- }
-- elsif ($action eq 'logout') {
-- if (!$login{$user}) {
-- $login{$user} = "010101:$date";
-- } #end pad user if carry over
-- ($stime,$sdate) = split(':',$login{$user});
-- $start = &annex2sec($stime);
-- $end = &annex2sec($time);
--
-- #If we went through midnight, add a day;
-- if ($end < $start) {$end += 86400;}
-- $timeon = $end - $start;
--
-- $elapsed{$user} += $timeon;
--
-- if (!$totalflag) {
-- print (&fmt_user($user),
-- ' ', &fmt_date($sdate), ' In: ',
-- &fmt_time($stime),' Out: ',
-- &fmt_time($time),
-- ' Elapsed: ', &fmt_sec($timeon), "\n");
-- } # end total test
-- } #end elsif action
-- } # type = ppp of slip
-- } # check arguments
--}
--close IN;
--
--if ($logflag) {
-- open (TMPPPP, ">$tmpfile")
-- || die "Can't open ppp tmp file";
-- foreach $user ( sort((keys(%elapsed))) ) {
-- $log_time = &fmt_sec($elapsed{$user});
-- $tmp = join (':',
-- $user,
-- $log_time);
-- print (TMPPPP "$tmp\n");
-- }
-- close (TMPPPP);
--}
-- else {
-- print "\n\nTotal Time On For Period:\n";
-- print "-------------------------\n";
--
-- foreach $user ( sort((keys(%elapsed))) ) {
-- print (&fmt_user($user), " ",&fmt_sec($elapsed{$user}), "\n");
-- }
-- }
--exit(0);
--
--#-------------------------------------------------------
--#--------------- Subroutines Start Here ----------------
--#-------------------------------------------------------
--
--sub annex2sec {
-- local($time) = @_;
-- return( &time2sec( &break_annex($time) ) );
--}
--
--sub fmt_date {
-- local($date) = @_;
--
-- return( substr($date,2,2).'/'.substr($date,4,2).'/'.substr($date,0,2) );
--}
--
--sub fmt_time {
-- local($time) = @_;
-- local($s,$m,$h) = &break_annex($time);
-- return ("$h:$m:$s");
--}
--
--
--sub break_annex {
-- local($time) = @_;
-- local($h,$m,$s);
--
-- $h=substr($time,0,2);
-- $m=substr($time,2,2);
-- $s=substr($time,4,2);
--
-- return ($s,$m,$h);
--}
--
--sub fmt_sec {
-- local(@t) = &sec2time(@_);
-- @t[2] += (@t[3]*24);
--
-- foreach $a (@t) {
-- if ($a < 10) {$a = "0$a";}
-- }
--
-- return ("@t[2]:@t[1]:@t[0]");
--}
--
--sub fmt_user {
-- local($user) = @_;
-- return( $user.substr($space,0,8 - length($user) ).' ' );
--}
--
+++ /dev/null
--AFGHANISTAN AF AFG 004
--ALBANIA AL ALB 008
--ALGERIA DZ DZA 012
--AMERICAN SAMOA AS ASM 016
--ANDORRA AD AND 020
--ANGOLA AO AGO 024
--ANGUILLA AI AIA 660
--ANTARCTICA AQ ATA 010
--ANTIGUA AND BARBUDA AG ATG 028
--ARGENTINA AR ARG 032
--ARMENIA AM ARM 051
--ARUBA AW ABW 533
--AUSTRALIA AU AUS 036
--AUSTRIA AT AUT 040
--AZERBAIJAN AZ AZE 031
--BAHAMAS BS BHS 044
--BAHRAIN BH BHR 048
--BANGLADESH BD BGD 050
--BARBADOS BB BRB 052
--BELARUS BY BLR 112
--BELGIUM BE BEL 056
--BELIZE BZ BLZ 084
--BENIN BJ BEN 204
--BERMUDA BM BMU 060
--BHUTAN BT BTN 064
--BOLIVIA BO BOL 068
--BOSNIA AND HERZEGOWINA BA BIH 070
--BOTSWANA BW BWA 072
--BOUVET ISLAND BV BVT 074
--BRAZIL BR BRA 076
--BRITISH INDIAN OCEAN TERRITORY IO IOT 086
--BRUNEI DARUSSALAM BN BRN 096
--BULGARIA BG BGR 100
--BURKINA FASO BF BFA 854
--BURUNDI BI BDI 108
--CAMBODIA KH KHM 116
--CAMEROON CM CMR 120
--CANADA CA CAN 124
--CAPE VERDE CV CPV 132
--CAYMAN ISLANDS KY CYM 136
--CENTRAL AFRICAN REPUBLIC CF CAF 140
--CHAD TD TCD 148
--CHILE CL CHL 152
--CHINA CN CHN 156
--CHRISTMAS ISLAND CX CXR 162
--COCOS (KEELING) ISLANDS CC CCK 166
--COLOMBIA CO COL 170
--COMOROS KM COM 174
--CONGO CG COG 178
--COOK ISLANDS CK COK 184
--COSTA RICA CR CRI 188
--COTE D'IVOIRE CI CIV 384
--CROATIA (local name: Hrvatska) HR HRV 191
--CUBA CU CUB 192
--CYPRUS CY CYP 196
--CZECH REPUBLIC CZ CZE 203
--DENMARK DK DNK 208
--DJIBOUTI DJ DJI 262
--DOMINICA DM DMA 212
--DOMINICAN REPUBLIC DO DOM 214
--EAST TIMOR TP TMP 626
--ECUADOR EC ECU 218
--EGYPT EG EGY 818
--EL SALVADOR SV SLV 222
--EQUATORIAL GUINEA GQ GNQ 226
--ERITREA ER ERI 232
--ESTONIA EE EST 233
--ETHIOPIA ET ETH 231
--FALKLAND ISLANDS (MALVINAS) FK FLK 238
--FAROE ISLANDS FO FRO 234
--FIJI FJ FJI 242
--FINLAND FI FIN 246
--FRANCE FR FRA 250
--FRANCE, METROPOLITAN FX FXX 249
--FRENCH GUIANA GF GUF 254
--FRENCH POLYNESIA PF PYF 258
--FRENCH SOUTHERN TERRITORIES TF ATF 260
--GABON GA GAB 266
--GAMBIA GM GMB 270
--GEORGIA GE GEO 268
--GERMANY DE DEU 276
--GHANA GH GHA 288
--GIBRALTAR GI GIB 292
--GREECE GR GRC 300
--GREENLAND GL GRL 304
--GRENADA GD GRD 308
--GUADELOUPE GP GLP 312
--GUAM GU GUM 316
--GUATEMALA GT GTM 320
--GUINEA GN GIN 324
--GUINEA-BISSAU GW GNB 624
--GUYANA GY GUY 328
--HAITI HT HTI 332
--HEARD AND MC DONALD ISLANDS HM HMD 334
--HONDURAS HN HND 340
--HONG KONG HK HKG 344
--HUNGARY HU HUN 348
--ICELAND IS ISL 352
--INDIA IN IND 356
--INDONESIA ID IDN 360
--IRAN (ISLAMIC REPUBLIC OF) IR IRN 364
--IRAQ IQ IRQ 368
--IRELAND IE IRL 372
--ISRAEL IL ISR 376
--ITALY IT ITA 380
--JAMAICA JM JAM 388
--JAPAN JP JPN 392
--JORDAN JO JOR 400
--KAZAKHSTAN KZ KAZ 398
--KENYA KE KEN 404
--KIRIBATI KI KIR 296
--KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF KP PRK 408
--KOREA, REPUBLIC OF KR KOR 410
--KUWAIT KW KWT 414
--KYRGYZSTAN KG KGZ 417
--LAO PEOPLE'S DEMOCRATIC REPUBLIC LA LAO 418
--LATVIA LV LVA 428
--LEBANON LB LBN 422
--LESOTHO LS LSO 426
--LIBERIA LR LBR 430
--LIBYAN ARAB JAMAHIRIYA LY LBY 434
--LIECHTENSTEIN LI LIE 438
--LITHUANIA LT LTU 440
--LUXEMBOURG LU LUX 442
--MACAU MO MAC 446
--MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF MK MKD 807
--MADAGASCAR MG MDG 450
--MALAWI MW MWI 454
--MALAYSIA MY MYS 458
--MALDIVES MV MDV 462
--MALI ML MLI 466
--MALTA MT MLT 470
--MARSHALL ISLANDS MH MHL 584
--MARTINIQUE MQ MTQ 474
--MAURITANIA MR MRT 478
--MAURITIUS MU MUS 480
--MAYOTTE YT MYT 175
--MEXICO MX MEX 484
--MICRONESIA, FEDERATED STATES OF FM FSM 583
--MOLDOVA, REPUBLIC OF MD MDA 498
--MONACO MC MCO 492
--MONGOLIA MN MNG 496
--MONTSERRAT MS MSR 500
--MOROCCO MA MAR 504
--MOZAMBIQUE MZ MOZ 508
--MYANMAR MM MMR 104
--NAMIBIA NA NAM 516
--NAURU NR NRU 520
--NEPAL NP NPL 524
--NETHERLANDS NL NLD 528
--NETHERLANDS ANTILLES AN ANT 530
--NEW CALEDONIA NC NCL 540
--NEW ZEALAND NZ NZL 554
--NICARAGUA NI NIC 558
--NIGER NE NER 562
--NIGERIA NG NGA 566
--NIUE NU NIU 570
--NORFOLK ISLAND NF NFK 574
--NORTHERN MARIANA ISLANDS MP MNP 580
--NORWAY NO NOR 578
--OMAN OM OMN 512
--PAKISTAN PK PAK 586
--PALAU PW PLW 585
--PANAMA PA PAN 591
--PAPUA NEW GUINEA PG PNG 598
--PARAGUAY PY PRY 600
--PERU PE PER 604
--PHILIPPINES PH PHL 608
--PITCAIRN PN PCN 612
--POLAND PL POL 616
--PORTUGAL PT PRT 620
--PUERTO RICO PR PRI 630
--QATAR QA QAT 634
--REUNION RE REU 638
--ROMANIA RO ROM 642
--RUSSIAN FEDERATION RU RUS 643
--RWANDA RW RWA 646
--SAINT KITTS AND NEVIS KN KNA 659
--SAINT LUCIA LC LCA 662
--SAINT VINCENT AND THE GRENADINES VC VCT 670
--SAMOA WS WSM 882
--SAN MARINO SM SMR 674
--SAO TOME AND PRINCIPE ST STP 678
--SAUDI ARABIA SA SAU 682
--SENEGAL SN SEN 686
--SEYCHELLES SC SYC 690
--SIERRA LEONE SL SLE 694
--SINGAPORE SG SGP 702
--SLOVAKIA (Slovak Republic) SK SVK 703
--SLOVENIA SI SVN 705
--SOLOMON ISLANDS SB SLB 090
--SOMALIA SO SOM 706
--SOUTH AFRICA ZA ZAF 710
--SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS GS SGS 239
--SPAIN ES ESP 724
--SRI LANKA LK LKA 144
--ST. HELENA SH SHN 654
--ST. PIERRE AND MIQUELON PM SPM 666
--SUDAN SD SDN 736
--SURINAME SR SUR 740
--SVALBARD AND JAN MAYEN ISLANDS SJ SJM 744
--SWAZILAND SZ SWZ 748
--SWEDEN SE SWE 752
--SWITZERLAND CH CHE 756
--SYRIAN ARAB REPUBLIC SY SYR 760
--TAIWAN, PROVINCE OF CHINA TW TWN 158
--TAJIKISTAN TJ TJK 762
--TANZANIA, UNITED REPUBLIC OF TZ TZA 834
--THAILAND TH THA 764
--TOGO TG TGO 768
--TOKELAU TK TKL 772
--TONGA TO TON 776
--TRINIDAD AND TOBAGO TT TTO 780
--TUNISIA TN TUN 788
--TURKEY TR TUR 792
--TURKMENISTAN TM TKM 795
--TURKS AND CAICOS ISLANDS TC TCA 796
--TUVALU TV TUV 798
--UGANDA UG UGA 800
--UKRAINE UA UKR 804
--UNITED ARAB EMIRATES AE ARE 784
--UNITED KINGDOM GB GBR 826
--UNITED STATES US USA 840
--UNITED STATES MINOR OUTLYING ISLANDS UM UMI 581
--URUGUAY UY URY 858
--UZBEKISTAN UZ UZB 860
--VANUATU VU VUT 548
--VATICAN CITY STATE (HOLY SEE) VA VAT 336
--VENEZUELA VE VEN 862
--VIET NAM VN VNM 704
--VIRGIN ISLANDS (BRITISH) VG VGB 092
--VIRGIN ISLANDS (U.S.) VI VIR 850
--WALLIS AND FUTUNA ISLANDS WF WLF 876
--WESTERN SAHARA EH ESH 732
--YEMEN YE YEM 887
--YUGOSLAVIA YU YUG 891
--ZAIRE ZR ZAR 180
--ZAMBIA ZM ZMB 894
--ZIMBABWE ZW ZWE 716
+++ /dev/null
--[ URL ftp://rs.internic.net/templates/domain-template.txt ] [ 03/98 ]
--
--******* Please DO NOT REMOVE Version Number or Sections A-Q ********
--
--Domain Version Number: 4.0
--
--******* Email completed agreement to hostmaster@internic.net *******
--
-- NETWORK SOLUTIONS, INC.
--
-- DOMAIN NAME REGISTRATION AGREEMENT
--
--
--A. Introduction. This domain name registration agreement
--("Registration Agreement") is submitted to NETWORK SOLUTIONS, INC.
--("NSI") for the purpose of applying for and registering a domain name
--on the Internet. If this Registration Agreement is accepted by NSI,
--and a domain name is registered in NSI's domain name database and
--assigned to the Registrant, Registrant ("Registrant") agrees to be
--bound by the terms of this Registration Agreement and the terms of
--NSI's Domain Name Dispute Policy ("Dispute Policy") which is
--incorporated herein by reference and made a part of this Registration
--Agreement. This Registration Agreement shall be accepted at the
--offices of NSI.
--
--B. Fees and Payments.
--
--1) Registration or renewal (re-registration) date through March 31, 1998:
--Registrant agrees to pay a registration fee of One Hundred United States
--Dollars (US$100) as consideration for the registration of each new domain
--name or Fifty United States Dollars (US$50) to renew (re-register) an
--existing registration.
--2) Registration or renewal date on and after April 1, 1998: Registrant
--agrees to pay a registration fee of Seventy United States Dollars (US$70)
--as consideration for the registration of each new domain name or the
--applicable renewal (re-registration) fee (currently Thirty-Five United
--States Dollars (US$35)) at the time of renewal (re-registration).
--3) Period of Service: The non-refundable fee covers a period of two (2)
--years for each new registration, and one (1) year for each renewal,
--and includes any permitted modification(s) to the domain name record
--during the covered period.
--4) Payment: Payment is due to Network Solutions within thirty (30)
--days from the date of the invoice.
--
--C. Dispute Policy. Registrant agrees, as a condition to
--submitting this Registration Agreement, and if the Registration
--Agreement is accepted by NSI, that the Registrant shall be bound by
--NSI's current Dispute Policy. The current version of the Dispute
--Policy may be found at the InterNIC Registration Services web site:
--"http://www.netsol.com/rs/dispute-policy.html".
--
--D. Dispute Policy Changes or Modifications. Registrant agrees
--that NSI, in its sole discretion, may change or modify the Dispute
--Policy, incorporated by reference herein, at any time. Registrant
--agrees that Registrant's maintaining the registration of a domain name
--after changes or modifications to the Dispute Policy become effective
--constitutes Registrant's continued acceptance of these changes or
--modifications. Registrant agrees that if Registrant considers any such
--changes or modifications to be unacceptable, Registrant may request
--that the domain name be deleted from the domain name database.
--
--E. Disputes. Registrant agrees that, if the registration of its
--domain name is challenged by any third party, the Registrant will be
--subject to the provisions specified in the Dispute Policy.
--
--F. Agents. Registrant agrees that if this Registration Agreement
--is completed by an agent for the Registrant, such as an ISP or
--Administrative Contact/Agent, the Registrant is nonetheless bound as a
--principal by all terms and conditions herein, including the Dispute
--Policy.
--
--G. Limitation of Liability. Registrant agrees that NSI shall have
--no liability to the Registrant for any loss Registrant may incur in
--connection with NSI's processing of this Registration Agreement, in
--connection with NSI's processing of any authorized modification to the
--domain name's record during the covered period, as a result of the
--Registrant's ISP's failure to pay either the initial registration fee
--or renewal fee, or as a result of the application of the provisions of
--the Dispute Policy. Registrant agrees that in no event shall the
--maximum liability of NSI under this Agreement for any matter exceed
--Five Hundred United States Dollars (US$500).
--
--H. Indemnity. Registrant agrees, in the event the Registration
--Agreement is accepted by NSI and a subsequent dispute arises with any
--third party, to indemnify and hold NSI harmless pursuant to the terms
--and conditions contained in the Dispute Policy.
--
--I. Breach. Registrant agrees that failure to abide by any
--provision of this Registration Agreement or the Dispute Policy may be
--considered by NSI to be a material breach and that NSI may provide a
--written notice, describing the breach, to the Registrant. If, within
--thirty (30) days of the date of mailing such notice, the Registrant
--fails to provide evidence, which is reasonably satisfactory to NSI,
--that it has not breached its obligations, then NSI may delete
--Registrant's registration of the domain name. Any such breach by a
--Registrant shall not be deemed to be excused simply because NSI did
--not act earlier in response to that, or any other, breach by the
--Registrant.
--
--J. No Guaranty. Registrant agrees that, by registration of a
--domain name, such registration does not confer immunity from objection
--to either the registration or use of the domain name.
--
--K. Warranty. Registrant warrants by submitting this Registration
--Agreement that, to the best of Registrant's knowledge and belief, the
--information submitted herein is true and correct, and that any future
--changes to this information will be provided to NSI in a timely manner
--according to the domain name modification procedures in place at that
--time. Breach of this warranty will constitute a material breach.
--
--L. Revocation. Registrant agrees that NSI may delete a
--Registrant's domain name if this Registration Agreement, or subsequent
--modification(s) thereto, contains false or misleading information, or
--conceals or omits any information NSI would likely consider material
--to its decision to approve this Registration Agreement.
--
--M. Right of Refusal. NSI, in its sole discretion, reserves the
--right to refuse to approve the Registration Agreement for any
--Registrant. Registrant agrees that the submission of this Registration
--Agreement does not obligate NSI to accept this Registration Agreement.
--Registrant agrees that NSI shall not be liable for loss or damages
--that may result from NSI's refusal to accept this Registration
--Agreement.
--
--N. Severability. Registrant agrees that the terms of this
--Registration Agreement are severable. If any term or provision is
--declared invalid, it shall not affect the remaining terms or
--provisions which shall continue to be binding.
--
--O. Entirety. Registrant agrees that this Registration Agreement
--and the Dispute Policy is the complete and exclusive agreement between
--Registrant and NSI regarding the registration of Registrant's domain
--name. This Registration Agreement and the Dispute Policy supersede all
--prior agreements and understandings, whether established by custom,
--practice, policy, or precedent.
--
--P. Governing Law. Registrant agrees that this Registration
--Agreement shall be governed in all respects by and construed in
--accordance with the laws of the Commonwealth of Virginia, United
--States of America. By submitting this Registration Agreement,
--Registrant consents to the exclusive jurisdiction and venue of the
--United States District Court for the Eastern District of Virginia,
--Alexandria Division. If there is no jurisdiction in the United States
--District Court for the Eastern District of Virginia, Alexandria
--Division, then jurisdiction shall be in the Circuit Court of Fairfax
--County, Fairfax, Virginia.
--
--Q. This is Domain Name Registration Agreement Version
--Number 4.0. This Registration Agreement is only for registrations
--under top-level domains: COM, ORG, NET, and EDU. By completing
--and submitting this Registration Agreement for consideration and
--acceptance by NSI, the Registrant agrees that he/she has read and
--agrees to be bound by A through P above.
--
--
--Authorization
--0a. (N)ew (M)odify (D)elete....:###action###
--0b. Auth Scheme................:
--0c. Auth Info..................:
--
--1. Comments...................:###purpose###
--
--2. Complete Domain Name.......:###domain###
--
--Organization Using Domain Name
--
--3a. Organization Name..........:###company###
--###LOOP###
--3b. Street Address.............:###address###
--###ENDLOOP###
--3c. City.......................:###city###
--3d. State......................:###state###
--3e. Postal Code................:###zip###
--3f. Country....................:###country###
--
--Administrative Contact
--4a. NIC Handle (if known)......:
--4b. (I)ndividual (R)ole........:I
--4c. Name (Last, First).........:###last###, ###first###
--4d. Organization Name..........:###company###
--###LOOP###
--4e. Street Address.............:###address###
--###ENDLOOP###
--4f. City.......................:###city###
--4g. State......................:###state###
--4h. Postal Code................:###zip###
--4i. Country....................:###country###
--4j. Phone Number...............:###daytime###
--4k. Fax Number.................:###fax###
--4l. E-Mailbox..................:###email###
--
--Technical Contact
--5a. NIC Handle (if known)......:###tech_contact###
--5b. (I)ndividual (R)ole........:
--5c. Name (Last, First).........:
--5d. Organization Name..........:
--5e. Street Address.............:
--5f. City.......................:
--5g. State......................:
--5h. Postal Code................:
--5i. Country....................:
--5j. Phone Number...............:
--5k. Fax Number.................:
--5l. E-Mailbox..................:
--
--Billing Contact
--6a. NIC Handle (if known)......:
--6b. (I)ndividual (R)ole........:
--6c. Name (Last, First).........:
--6d. Organization Name..........:
--6e. Street Address.............:
--6f. City.......................:
--6g. State......................:
--6h. Postal Code................:
--6i. Country....................:
--6j. Phone Number...............:
--6k. Fax Number.................:
--6l. E-Mailbox..................:
--
--Prime Name Server
--7a. Primary Server Hostname....:###primary###
--7b. Primary Server Netaddress..:###primary_ip###
--
--Secondary Name Server(s)
--###LOOP###
--8a. Secondary Server Hostname..:###secondary###
--8b. Secondary Server Netaddress:###secondary_ip###
--###ENDLOOP###
--
--END OF AGREEMENT
--
+++ /dev/null
--#!/usr/local/bin/perl
--
--###
--# THIS IS FROM CYBERCASH (is there a newer version?)
--###
--
--$paymentserverhost = 'localhost';
--$paymentserverport = 8000;
--$paymentserversecret = 'two-turntables';
--use CCLib qw(sendmserver);
--
--# first lets fake up some data
--# use time of day and pid to give me my pretend
--# order number
--# you obviously need to get real data from somewhere...
--
--$oid = "test$$"; #fake order number.
--$amount = 'usd 42.42';
--$ramount = 'usd 24.24';
--$pan = '4111111111111111';
--$name = 'John Q. Doe';
--$addr = '17 Richard Rd.';
--$city = 'Ivyland';
--$state = 'PA';
--$zip = '18974';
--$country = 'USA';
--$exp = '7/97';
--
--
--%result = &sendmserver('mauthcapture',
-- 'Order-ID', $oid,
-- 'Amount', $amount,
-- 'Card-Number', $pan,
-- 'Card-Name', $name,
-- 'Card-Address', $addr,
-- 'Card-City', $city,
-- 'Card-State', $state,
-- 'Card-Zip', $zip,
-- 'Card-Country', $country,
-- 'Card-Exp', $exp);
--
--#
--# just dump results to stdout.
--# you should process them...
--# to allow results to affect operation of your fulfillment...
--#
--foreach (keys(%result)) {
-- print " $_ ==> $result{$_}\n";
--}
--
--print "\n";
--
--exit;
--
--$trans=$result{'MTransactionNumber'};
--$code=$result{'MRetrievalCode'};
--
--%result = &sendmserver('return',
-- 'Order-ID', $oid,
-- 'Return-Amount',$ramount,
-- 'Amount',$amount,
-- );
--
--foreach (keys(%result)) {
-- print " $_ ==> $result{$_}\n";
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwd
--#
--# portions of this script are copied from the `passwd' script in the original
--# (perl 4) camel book, now archived at
--# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
--#
--# ivan@sisd.com 98-mar-8
--#
--# password lengths 0,255 instead of 6,8 - we'll let the server process
--# check the data ivan@sisd.com 98-jul-17
--
--use strict;
--use Getopt::Std;
--use Socket;
--use IO::Handle;
--use vars qw($opt_f $opt_s);
--
--my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
--my($freeside_uid)=scalar(getpwnam('freeside'));
--
--$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
--$ENV{'SHELL'} = '/bin/sh';
--$ENV{'IFS'} = " \t\n";
--$ENV{'CDPATH'} = '';
--$ENV{'ENV'} = '';
--$ENV{'BASH_ENV'} = '';
--
--$SIG{__DIE__}= sub { system '/bin/stty', 'echo'; };
--
--die "passwd program isn't running setuid to freeside\n" if $> != $freeside_uid;
--
--unshift @ARGV, "-f" if $0 =~ /chfn$/;
--unshift @ARGV, "-s" if $0 =~ /chsh$/;
--
--getopts('fs');
--
--my($me)='';
--if ( $_ = shift(@ARGV) ) {
-- /^(\w{2,8})$/;
-- $me = $1;
--}
--die "You can't change the password for $me." if $me && $<;
--$me = (getpwuid($<))[0] unless $me;
--
--my($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell)=
-- getpwnam $me;
--
--my($old_password,$new_password,$new_gecos,$new_shell);
--
--if ( $opt_f || $opt_s ) {
-- system '/bin/stty', '-echo';
-- print "Password:";
-- $old_password=<STDIN>;
-- system '/bin/stty', 'echo';
-- chop($old_password);
-- #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $old_password = $1;
--
-- $new_password = '';
--
-- if ( $opt_f ) {
-- print "\nChanging gecos for $me.\n";
-- print "Gecos [", $gcos, "]: ";
-- $new_gecos=<STDIN>;
-- chop($new_gecos);
-- $new_gecos ||= $gcos;
-- $new_gecos =~ /^(.{0,255})$/ or die "\nIllegal gecos.\n";
-- } else {
-- $new_gecos = '';
-- }
--
-- if ( $opt_s ) {
-- print "\nChanging shell for $me.\n";
-- print "Shell [", $shell, "]: ";
-- $new_shell=<STDIN>;
-- chop($new_shell);
-- $new_shell ||= $shell;
-- $new_shell =~ /^(.{0,255})$/ or die "\nIllegal shell.\n";
-- } else {
-- $new_shell = '';
-- }
--
--} else {
--
-- print "Changing password for $me.\n";
-- print "Old password:";
-- system '/bin/stty', '-echo';
-- $old_password=<STDIN>;
-- chop $old_password;
-- #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $old_password = $1;
-- print "\nEnter the new password (minimum of 6, maximum of 8 characters)\n";
-- print "Please use a combination of upper and lowercase letters and numbers.\n";
-- print "New password:";
-- $new_password=<STDIN>;
-- chop($new_password);
-- #$new_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
-- $new_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
-- $new_password = $1;
-- print "\nRe-enter new password:";
-- my($check_new_password);
-- $check_new_password=<STDIN>;
-- chop($check_new_password);
-- die "\nThey don't match; try again.\n" unless $check_new_password eq $new_password;
--
-- $new_gecos='';
-- $new_shell='';
--}
--print "\n";
--
--system '/bin/stty', 'echo';
--
--socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
--connect(SOCK, sockaddr_un($fs_passwdd_socket)) or die "connect: $!";
--print SOCK join("\n",$me,$old_password,$new_password,$new_gecos,$new_shell),"\n";
--SOCK->flush;
--my($error);
--$error = <SOCK>;
--chop $error;
--
--if ($error) {
-- print "\nUpdate error: $error\n";
--} else {
-- print "\nUpdate sucessful.\n";
--}
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwd_server
--#
--# portions of this script are copied from the `passwd' script in the original
--# (perl 4) camel book, now archived at
--# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
--#
--# ivan@sisd.com 98-mar-9
--#
--# crypt-aware, s/password/_password/; ivan@sisd.com 98-aug-23
--
--use strict;
--use IO::Handle;
- use Net::SSH qw(sshopen2);
-use FS::SSH qw(sshopen2);
--use FS::UID qw(adminsuidsetup);
--use FS::Record qw(qsearchs);
--use FS::svc_acct;
-
- my $user = shift or die &usage;
- adminsuidsetup $user;
--
- my($shellmachine)=shift or die &usage;
-$SIG{CHLD} = sub { wait() };
--
- #causing trouble for some folks
- #$SIG{CHLD} = sub { wait() };
-&adminsuidsetup;
--
--my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
-
-my($shellmachine)=shift;
-die "Usage: fs_passwd_server shellmachine\n" unless $shellmachine;
--
--while (1) {
-- my($reader,$writer)=(new IO::Handle, new IO::Handle);
-- $writer->autoflush(1);
-- sshopen2($shellmachine,$reader,$writer,$fs_passwdd);
-- while (1) {
-- my($username,$old_password,$new_password,$new_gecos,$new_shell);
-- defined($username=<$reader>) or last;
-- defined($old_password=<$reader>) or last;
-- defined($new_password=<$reader>) or last;
-- defined($new_gecos=<$reader>) or last;
-- defined($new_shell=<$reader>) or last;
-- chop($username);
-- chop($old_password);
-- chop($new_password);
-- chop($new_gecos);
-- chop($new_shell);
-- my($svc_acct);
--
-- #need to try both $old_password and encrypted $old_password
-- #maybe the crypt function in svc_acct.export needs to be a library?
-- my $salt = substr($old_password,0,2);
-- my $cold_password = crypt($old_password,$salt);
-- $svc_acct=qsearchs('svc_acct',{'username'=>$username,
-- '_password'=>$old_password,
-- } )
-- || qsearchs('svc_acct',{'username'=>$username,
-- '_password'=>$cold_password,
-- } );
-- unless ( $svc_acct ) { print $writer "Incorrect password.\n"; next; }
--
-- my(%hash)=$svc_acct->hash;
- my($new_svc_acct) = new FS::svc_acct ( \%hash );
- my($new_svc_acct) = create 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;
-- $new_svc_acct->setfield('shell',$new_shell) if $new_shell;
-- my($error)=$new_svc_acct->replace($svc_acct);
-- print $writer $error,"\n";
-- }
-- close $writer;
-- close $reader;
-- sleep 60;
-- warn "Connection to $shellmachine lost! Reconnecting...\n";
- }
-
- sub usage {
- die "Usage:\n\n fs_passwd_server user shellmachine\n";
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# fs_passwdd
--#
--# This is run REMOTELY over ssh by fs_passwd_server.
--#
--# ivan@sisd.com 98-mar-9
--
--use strict;
--use Socket;
--
--my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
--
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
-$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
--$ENV{'SHELL'} = '/bin/sh';
--$ENV{'IFS'} = " \t\n";
--$ENV{'CDPATH'} = '';
--$ENV{'ENV'} = '';
--$ENV{'BASH_ENV'} = '';
--
--$|=1;
--
--my $uaddr = sockaddr_un($fs_passwdd_socket);
--my $proto = getprotobyname('tcp');
--
--socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
--unlink($fs_passwdd_socket);
--bind(Server, $uaddr) or die "bind: $!";
--listen(Server,SOMAXCONN) or die "listen: $!";
--
--my($paddr);
--for ( ; $paddr = accept(Client,Server); close Client) {
-- my($me,$old_password,$new_password,$new_gecos,$new_shell);
--
-- $me=<Client>;
-- $old_password=<Client>;
-- $new_password=<Client>;
-- $new_gecos=<Client>;
-- $new_shell=<Client>;
--
-- print $me,$old_password,$new_password,$new_gecos,$new_shell;
-- my($error);
--
-- $error=<STDIN>;
--
-- print Client $error;
-- close Client;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
--# ivan@sisd.com 98-mar-23
--
--use strict;
--use Date::Parse; #but hopefully not
--
--$|=1;
--
--my($file,$pos)=@_;
--open(FILE,"<$file") or die "Can't open $file: $!";
--seek(FILE,$pos,0) or die "Can't seek: $!";
--
--my($datestr);
--my(%param);
--
--$SIG{'HUP'} = sub { print "EOF\n"; exit; };
--
--while (1) {
--
-- while (<FILE>) {
-- next if /^$/;
-- if ( /^\S/ ) {
-- chop($datestr=$_);
-- undef %param;
-- } else {
-- warn "Unexpected line: $_";
-- }
-- while (<FILE>) {
-- if ( /^$/ ) {
-- #if ( $param{'Acct-Status-Type'} eq 'Stop' ) {
-- print join("\t",
-- tell FILE,
-- %param,
-- ),"\n";
-- #}
-- last;
-- } elsif ( /^\s+([\w\-]+)\s\=\s\"?([\w\.\-]+)\"?\s*$/ ) {
-- $param{$1}=$2;
-- } else {
-- warn "Unexpected line: $_";
-- }
--
-- }
--
-- }
-- sleep 1;
-- seek(FILE,0,1);
--}
--
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: agent.cgi,v 1.13 1999-04-09 04:22:34 ivan Exp $
-# agent.cgi: browse agent
--#
--# ivan@sisd.com 97-dec-12
--#
--# changes to allow pages to load from a relative location in the web tree.
--# bmccane@maxbaud.net 98-mar-25
--#
--# changed 'type' to 'atype' because type is reserved word in Pg6.3
--# bmccane@maxbaud.net 98-apr-3
--#
--# 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 vars qw( $ui $cgi $p $agent );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
- 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
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($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'
-SendHeaders(); # one guess.
-print header('Agent Listing', menubar(
- 'Main Menu' => '../',
- 'Add new agent' => '../edit/agent.cgi'
--)), <<END;
- 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;
- <BR>
- Click on agent number to edit.
- <TABLE BORDER>
-- <TR>
- <TH COLSPAN=2>Agent</TH>
- <TH><FONT SIZE=-1>Agent #</FONT></TH>
- <TH>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($hashref)=$agent->hashref;
-- my($typenum)=$hashref->{typenum};
-- my($agent_type)=qsearchs('agent_type',{'typenum'=>$typenum});
-- my($atype)=$agent_type->getfield('atype');
-- print <<END;
-- <TR>
- <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}">
- <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}">
-- $hashref->{agentnum}</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->{agent}</TD>
- <TD><A HREF="../edit/agent_type.cgi?$typenum">$atype</A></TD>
-- <TD>$hashref->{freq}</TD>
-- <TD>$hashref->{prog}</TD>
-- </TR>
--END
--
--}
--
--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
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: agent_type.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
-# agent_type.cgi: browse agent_type
--#
--# ivan@sisd.com 97-dec-10
--#
--# Changes to allow page to work at a relative position in server
--# Changes to make "Packages" display 2-wide in table (old way was too vertical)
--# 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 vars qw( $cgi $p $agent_type );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar popurl table);
- use FS::agent_type;
- use FS::type_pkgs;
- use FS::part_pkg;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- $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;
-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>
-- <TR>
- <TH COLSPAN=2>Agent Type</TH>
- <TH COLSPAN="2">Packages</TH>
- <TH><FONT SIZE=-1>Type #</FONT></TH>
- <TH>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',{}) ) {
-- my($hashref)=$agent_type->hashref;
-- my(@type_pkgs)=qsearch('type_pkgs',{'typenum'=> $hashref->{typenum} });
-- my($rowspan)=scalar(@type_pkgs);
-- $rowspan = int($rowspan/2+0.5) ;
-- print <<END;
-- <TR>
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">
- <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}">
-- $hashref->{typenum}
-- </A></TD>
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">$hashref->{atype}</A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{atype}</TD>
--END
--
-- my($type_pkgs);
-- my($tdcount) = -1 ;
-- foreach $type_pkgs ( @type_pkgs ) {
-- my($pkgpart)=$type_pkgs->getfield('pkgpart');
-- my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart });
-- print qq!<TR>! if ($tdcount == 0) ;
-- $tdcount = 0 if ($tdcount == -1) ;
- print qq!<TD><A HREF="${p}edit/part_pkg.cgi?$pkgpart">!,
- print qq!<TD><A HREF="../edit/part_pkg.cgi?$pkgpart">!,
-- $part_pkg->getfield('pkg'),"</A></TD>";
-- $tdcount ++ ;
-- if ($tdcount == 2)
-- {
-- print qq!</TR>\n! ;
-- $tdcount = 0 ;
-- }
-- }
--
-- print "</TR>";
--}
--
--print <<END;
- <TR><TD COLSPAN=2><I><A HREF="${p}edit/agent_type.cgi">Add new agent type</A></I></TD></TR>
- </TABLE>
- </TR></TABLE>
- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main_county.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $
-# cust_main_county.cgi: browse cust_main_county
--#
--# ivan@sisd.com 97-dec-13
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $p $cust_main_county );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar popurl table);
- use FS::cust_main_county;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($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",
-SendHeaders(); # one guess.
-print header("Tax Rate Listing", menubar(
- 'Main Menu' => '../',
- 'Edit tax rates' => "../edit/cust_main_county.cgi",
--)),<<END;
- 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;
- <BR>Click on <u>expand</u> to specify tax rates by county.
- <P><TABLE BORDER>
-- <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->{country}</TD>
- <TD>$hashref->{state}</TD>
--END
- print "<TD>", $hashref->{state}
- ? $hashref->{state}
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
-- : qq!(ALL) <FONT SIZE=-1>!.
- qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
- qq!">expand country</A></FONT>!
- qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
- qq!">expand</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>
-- </TR>
--END
--
--}
--
--print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_pkg.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
-# part_svc.cgi: browse part_pkg
--#
--# ivan@sisd.com 97-dec-5,9
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $p $part_pkg );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar popurl table);
- use FS::part_pkg;
- use FS::pkg_svc;
- use FS::part_svc;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- $p = popurl(2);
-SendHeaders(); # one guess.
--
- 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;
-print header("Package Part Listing",menubar(
- 'Main Menu' => '../',
- 'Add new package' => "../edit/part_pkg.cgi",
-)), <<END;
- <BR>Click on package part number to edit.
-- <TABLE BORDER>
-- <TR>
- <TH COLSPAN=2>Package</TH>
- <TH><FONT SIZE=-1>Part #</FONT></TH>
- <TH>Package</TH>
-- <TH>Comment</TH>
-- <TH><FONT SIZE=-1>Setup Fee</FONT></TH>
-- <TH><FONT SIZE=-1>Freq.</FONT></TH>
-- <TH><FONT SIZE=-1>Recur. Fee</FONT></TH>
-- <TH>Service</TH>
-- <TH><FONT SIZE=-1>Quan.</FONT></TH>
-- </TR>
--END
--
-my($part_pkg);
--foreach $part_pkg ( sort {
-- $a->getfield('pkgpart') <=> $b->getfield('pkgpart')
--} qsearch('part_pkg',{}) ) {
-- my($hashref)=$part_pkg->hashref;
-- my(@pkg_svc)=grep $_->getfield('quantity'),
-- qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} });
-- my($rowspan)=scalar(@pkg_svc);
-- print <<END;
-- <TR>
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}">
-- $hashref->{pkgpart}
-- </A></TD>
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{recur}</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 $n,qq!<TD><A HREF="${p}edit/part_svc.cgi?$svcpart">!,
- print qq!<TD><A HREF="../edit/part_svc.cgi?$svcpart">!,
-- $part_svc->getfield('svc'),"</A></TD><TD>",
- $pkg_svc->getfield('quantity'),"</TD></TR>\n";
- $n="<TR>";
- $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n";
-- }
--
-- print "</TR>";
--}
--
--print <<END;
- <TR><TD COLSPAN=2><I><A HREF="${p}edit/part_pkg.cgi">Add new package</A></I></TD></TR>
- </TABLE>
- </TR></TABLE>
- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_referral.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $
-# part_referral.cgi: Browse part_referral
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $p $part_referral );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch);
- use FS::CGI qw(header menubar popurl table);
- use FS::part_referral;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
-
- $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;
-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>
-- <TR>
- <TH COLSPAN=2>Referral</TH>
- <TH><FONT SIZE=-1>Referral #</FONT></TH>
- <TH>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="${p}edit/part_referral.cgi?$hashref->{refnum}">
- <TD><A HREF="../edit/part_referral.cgi?$hashref->{refnum}">
-- $hashref->{refnum}</A></TD>
- <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}">
- $hashref->{referral}</A></TD>
- <TD>$hashref->{referral}</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>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_svc.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
-# part_svc.cgi: browse part_svc
--#
--# ivan@sisd.com 97-nov-14, 97-dec-9
--#
--# Changes to allow page to work at a relative position in server
--# 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 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);
-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);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
-
- $p = popurl(2);
--
- print $cgi->header( '-expires' => 'now' ), header('Service Part Listing', menubar(
- 'Main Menu' => $p,
-SendHeaders(); # one guess.
-print header('Service Part Listing', menubar(
- 'Main Menu' => '../',
- 'Add new service' => "../edit/part_svc.cgi",
--)),<<END;
- Services are items you offer to your customers.<BR><BR>
- END
- print &table(), <<END;
- <BR>Click on service part number to edit.
- <TABLE BORDER>
-- <TR>
- <TH COLSPAN=2>Service</TH>
- <TH>Part #</TH>
- <TH>Service</TH>
-- <TH>Table</TH>
-- <TH>Field</TH>
- <TH COLSPAN=2>Modifier</TH>
- <TH>Action</TH>
- <TH>Value</TH>
-- </TR>
--END
--
-my($part_svc);
--foreach $part_svc ( sort {
-- $a->getfield('svcpart') <=> $b->getfield('svcpart')
--} qsearch('part_svc',{}) ) {
-- my($hashref)=$part_svc->hashref;
-- my($svcdb)=$hashref->{svcdb};
-- my(@rows)=
-- grep $hashref->{${svcdb}.'__'.$_.'_flag'},
-- map { /^${svcdb}__(.*)$/; $1 }
-- grep ! /_flag$/,
-- grep /^${svcdb}__/,
-- fields('part_svc')
-- ;
- my($rowspan)=scalar(@rows) || 1;
- my($rowspan)=scalar(@rows);
-- print <<END;
-- <TR>
- <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><A HREF="../edit/part_svc.cgi?$hashref->{svcpart}">
- $hashref->{svcpart}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{svc}</TD>
-- <TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD>
--END
-
- my($n1)='';
-- my($row);
-- foreach $row ( @rows ) {
-- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print $n1,"<TD>$row</TD><TD>";
- print "<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>";
- $n1="</TR><TR>";
- print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD></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
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_pop.cgi,v 1.8 2000-01-28 22:56:13 ivan Exp $
-# svc_acct_pop.cgi: browse pops
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# 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 2000-01-28 22:56:13 ivan
- # track full phone number
- #
- # 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 vars qw( $cgi $p $svc_acct_pop );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base;
--use FS::UID qw(cgisuidsetup swapuid);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar table popurl);
- use FS::svc_acct_pop;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
-
- $p = popurl(2);
--
- print $cgi->header( '-expires' => 'now' ), header('POP Listing', menubar(
- 'Main Menu' => $p,
- )), "Points of Presence<BR><BR>", &table(), <<END;
-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>
-- <TR>
- <TH></TH>
- <TH><FONT SIZE=-1>POP #</FONT></TH>
-- <TH>City</TH>
-- <TH>State</TH>
-- <TH>Area code</TH>
-- <TH>Exchange</TH>
- <TH>Local</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="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
- <TD><A HREF="../edit/svc_acct_pop.cgi?$hashref->{popnum}">
-- $hashref->{popnum}</A></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>
- <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
- $hashref->{loc}</A></TD>
- <TD>$hashref->{city}</TD>
- <TD>$hashref->{state}</TD>
- <TD>$hashref->{ac}</TD>
- <TD>$hashref->{exch}</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>
--</HTML>
--END
--
+++ /dev/null
--<head>
-- <title>Administration</title>
--</head>
--<body>
-- <h1>Administration</h1>
- </body>
- <ul>
- <li>Open up the root of the Freeside document tree in your web
- browser. For example, if you created the Freeside document tree in
- /home/httpd/html/freeside, and your web browser's DocumentRoot is
- /home/httpd/html, open http://your_host/freeside/. Replace
- "your_host" with the name or network address of your web server.
-
- <li>Once in the Freeside web interface, you must first create a
- service. An example of a service would be a dial-up account or a
- hosted virtual domain.
-
- <li>After you create your first service or services, you must then
- create a package of that service or services which you will sell to
- your customer. To allow flexibility in changing your service
- offerings, Freeside requires that you bundle your services into a
- package before customers may purchase them. For instance, you could
- create a leased line package which would consist of a one-time
- charge for the customer premise equipment, the monthly service fee
- for the leased line, a backup dial-up account, and a support
- contract. You could also create a leased line package which omits
- the support contract simply by adding a new package that does not
- include the support contract.
-
- <li>After you create your first package, then you must define who is
- able to sell that package by creating an agent type. An example of
- an agent type would be an internal sales representitive which sells
- regular and promotional packages, as opposed to an external sales
- representitive which would only sell regular packages of services.
-
- <li>After creating a new agent type, you must create an agent, and
- assign the the agent type you just created to it.
-
- <li>If the service you created was of type svc_acct, you may have to
- create a POP from the main menu before you can create your first new
- customer.
-
- <li>If you are using Freeside to keep track of sales taxes, you must
- define tax information for your locale by clicking on the "View/Edit
- locales and tax rates" link on the Freeside main menu.
-
- <li>Finally, you may optionally set up a referral by clicking on the
- "View/Edit referrals" link in the Freeside main menu. Referrals
- will help you keep track of how effective your advertising is, by
- helping you keep track of where customers heard of your service
- offerings. You must create at least one referral. If you do not wish to
- use the referral functionality, simply create a single referral only.
-
- <li>You should now be ready to sign up your first customer by
- clicking on the "New Customer" link at the top of the Freeside main
- menu.
- </ul>
--</body>
- </html>
+++ /dev/null
--<head>
-- <title>Billing</title>
--</head>
--<body>
-- <h1>Billing</h1>
- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
-- <ul>
- <li>To enable billing, you <b>must</b> create an <a href="config.html#invoice_template">invoice_template</a> configuration file. An example file is available in the <i>conf/</i> directory of the distribution. You also need to create an <a href="config.html#lpr">lpr</a> configuration file to enable postal invoices.
- <ul>
- <li>Optional: Invoice template customization
- <ul>
- <li>See the <a href="http://search.cpan.org/doc/MJD/Text-Template-1.23/Template.pm">Text::Template</a> documentation for details on the substitution language.
- <li>You <b>must</b> call the invoice_lines() function at least once - pass it a number of lines, and it returns a list of array references, each of two elements: a service description column, and a price column.
- <li>In addition, the following variables are available:
- <ul>
- <li>$invnum - invoice number
- <li>$date - as a UNIX timestamp (see <a href="http://search.cpan.org/doc/GBARR/TimeDate-1.09/lib/Date/Format.pm">Date::Format</a> for conversion functions).
- <li>$page - current page
- <li>$total_pages - total pages
- <li>@address - A six-element array containing the customer name, company, and address.
- <li>$overdue - true if this invoice is overdue
- </ul>
- </ul>
- </ul>
- <li>You can bill individual customers by clicking on the <i>Bill now</i> link on the main customer view.
- <li> The <b>freeside-bill</b> script can be run daily to bill all customers. Usage:<pre>bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ] <i>user</i></pre>
- <ul>
- <li>-c: Turn on collecting (you probably want this).
- <li>-i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards.
- <li>-d: Pretend it is <i>date</i> (parsed by <a href="http://search.cpan.org/doc/GBARR/TimeDate-1.09/lib/Date/Parse.pm">Date::Parse</a>)
- <li>-b: N/A
- </ul>
- <br><br>Batch credit card processing
- <ul>
- <li>After this script is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
- <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
- <pre>use FS::cust_pay;
- <li>-c: Turn on collecting (you probably want this).
- <li>-i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. Not available without modifying site_perl/Bill.pm
- <li>-d: Pretend it is <i>date</i> (parsed by Date::Parse)
- <li>-b: N/A
- </ul>
- Printing should be configured on your freeside machine to print invoices.
- <br><br>Batch credit card processing
- <ul>
- <li>After this script is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
- <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
- <pre>use FS::cust_pay;
--
--# loop over all records in batch
--
--my $payment=create FS::cust_pay (
-- 'invnum' => $invnum,
-- 'paid' => $paid,
-- '_date' => $_date,
-- 'payby' => $payby,
-- 'payinfo' => $payinfo,
-- 'paybatch' => $paybatch,
--);
--
--my $error=$payment->insert;
--if ( $error ) {
-- #process error
--}
--
--# end loop
--</pre>
- All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.<br><br>
- <li>The <b>freeside-print-batch</b> script can print or email pending credit card batches for manual entry. Usage: freeside-print-batch [-v] [-p] [-e] [-a] [-d] <i>user</i>
- <ul>
- <li>-v: Verbose - Prints records to STDOUT.
- <li>-p: Print to printer lpr as found in the conf directory.
- <li>-e: Email output to user found in the Conf email file.
- <li>-a: Automatically pays all records in cust_pay_batch. Use -d with this option usually.
- <li>-d: Delete - Pays account and deletes record from cust_pay_batch.
- </ul>
- </ul>
-All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Configuration files</title>
--</head>
--<body>
-- <h1>Configuration files</h1>
- <ul>
- <li>Create the <b>/usr/local/etc/freeside</b> directory to hold your configuration.
- <li>Setting up <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache user authetication</a> is mandatory.
- <li>Create the <b>/usr/local/etc/freeside/mapsecrets</b> file, which maps Apache users to a secrets file which contains a DBI data source, username and password. Every
- line in <b>/usr/local/etc/freeside/mapsecrets</b> should contain a username and
- filename, separated by whitespace. Note that these are not local usernames -
- they are passed from Apache. <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">
- Apache user authetication</a> is mandatory. For example, if you had the Apache users admin,
- john, and sam,
- you mapsecrets file might look like:
- <pre>
- admin secretfile
- john secretfile
- sam secretfile
- </pre>
- <li>Next, the filename(s) referenced in <b>/usr/local/etc/freeside/mapsecrets</b> file should be created in the <b>/usr/local/etc/freeside/</b> directory. Each file contains three lines: <a href="http://search.cpan.org/doc/TIMB/DBI-1.15/DBI.pm">DBI data source</a> (for example,
- <tt>DBI:mysql:freeside</tt> or <tt>DBI:Pg:host=localhost;dbname=freeside</tt>), database username, and database password.
- These files should not be world readable. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.15/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD">manpage for your DBD</a> for the exact syntax of a DBI data source. In a normal installation such as the example above, a single file <b>/usr/local/etc/freeside/secretfile</b> would be created - for example:
- <pre>
- DBI:Pg:host=localhost;dbname=freeside
- dbusername
- dbpassword
- </pre>
- </ul>
- All further configuration files and directories are located in
- <tt>/usr/local/etc/freeside/conf.<i>datasource</i></tt>, for example,
- <tt>/usr/local/etc/freeside/conf.DBI:Pg:host=localhost;dbname=freeside</tt> (remember to backslash-escape the ; character when creating directories in the shell: <tt>mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=freeside</tt>).
-Configuration files and directories are located in `/var/spool/freeside/conf'.
--<ul>
- <li><a name="address">address</a> - This configuration file is no longer used. See <a href="#invoice_template">invoice_template</a> instead.
- <li><a name="apacheroot">apacheroot</a> - The directory containing Apache virtual hosts
- <li><a name="apachemachine">apachemachine</a> - A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home' configuration file, symlinks into user home directories.
- <li><a name="apachemachines">apachemachines</a> - Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf', which can be included in your Apache configuration via the <a href="http://www.apache.org/docs/mod/core.html#include">Include</a> directive.
- <li><a name="autocapnames">autocapnames</a> - The presence of this file will cause Freeside to use Javascript in /htdocs/edit/cust_main.cgi to automatically capitalize the first and last names of customers.
- <li><a name="bindprimary">bindprimary</a> - Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named
- <li><a name="bindsecondaries">bindsecondaries</a> - Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf
- <li><a name="bsdshellmachines">bsdshellmachines</a> - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
- <li><a name="countrydefault">countrydefault</a> - Default two-letter country code (if not supplied, the default is `US')
- <li><a name="cybercash2">cybercash2</a> - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
- <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>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
-- <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture'). CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.
- <li><a name="deletecustomers">deletecustomers</a> - The existance of this file will enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers' packages if they cancel service.
- <li><a name="domain">domain</a> - Your domain name.
- <li><a name="editreferrals">editreferrals</a> - The existance of this file will allow you to change the referral of existing customers.
- <li><a name="erpcdmachines">erpcdmachines</a> - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
- <li><a name="hidecancelledpackages">hidecancelledpackages</a> - The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database)
- <li><a name="hidecancelledcustomers">hidecancelledcustomers</a> - The existance of this file will prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)
- <li><a name="home">home</a> - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
- <li><a name="icradiusmachines">icradiusmachines</a> - Your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines, one per line. The existance of this file (even if empty) turns on radcheck table creation (in the freeside database - the radcheck table needs to be created manually). Machines listed in this file will have the radcheck table exported to them. Each line of this file should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "<CODE>radius.isp.tld radius_db radius_user passw0rd</CODE>". Note that to use ICRADIUS export you need to be using MySQL.
- <li><a name="icradius_mysqldest">icradius_mysqldest</a> - Destination directory for the MySQL databases, on the ICRADIUS machines. Defaults to "/usr/local/var/".
- <li><a name="icradius_mysqlsource">icradius_mysqlsource</a> - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".
- <li><a name="icradius_secrets">icradius_secrets</a> - Optionally specifies a MySQL database for ICRADIUS export, if you're not running MySQL for your Freeside database. The database should be on the Freeside machine and store data in the <a href="#icradius_mysqlsource">icradius_mysqlsource</a> directory. Three lines: DBI data source, username and password. This file should not be world readable.
- <li><a name="invoice_from">invoice_from</a> - Return address on email invoices.
- <li><a name="invoice_template">invoice_template</a> - Required template file for invoices. See the <a href="billing.html">section on billing</a> for details.
- <li><a name="lpr">lpr</a> - Print command for paper invoices, for example `lpr -h'.
- <li><a name="maildisablecatchall">maildisablecatchall</a> - The existance of this file will disable the requirement that each virtual domain have a catch-all mailbox.
- <li><a name="money_char">money_char</a> - Currency symbol - defaults to `$'.
- <li><a name="mxmachines">mxmachines</a> - MX entries for new domains, weight and machine, one per line, with trailing `.'
- <li><a name="nsmachines">nsmachines</a> - NS nameservers for new domains, one per line, with trailing `.'
- <li><a name="nismachines">nismachines</a> - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
- <li><a name="passwordmin">passwordmin</a> - Minimum password length (default 6);
- <li><a name="qmailmachines">qmailmachines</a> - 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><a name="radiusmachines">radiusmachines</a> - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
- <li><a name="referraldefault">referraldefault</a> - Default referral, specified by refnum.
- <li><a name="registries">registries</a> - Directory which contains domain registry information. Each registry is a directory.
- <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>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>radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
- <li>registries - Directory which contains domain registry information. Each registry is a directory.
-- <ul>
-- <li>registries/internic - Currently the only supported registry
-- <ul>
-- <li>registries/internic/from - Email address from which InterNIC domain registrations are sent.
-- <li>regestries/internic/nameservers - The nameservers for InterNIC domain registrations, one per line. Each line contains an IP address and hostname, separated by whitespace.
-- <li>registries/internic/tech_contact - Technical contact NIC handle for domain registrations.
-- <li>registries/internic/template - Template for InterNIC domain registrations with special markup. A suitable copy of the InterNIC domain template v4.0 is in `fs-x.y.z/etc/domain-template.txt'.
-- <li>registries/internic/to - Email address to which InterNIC domain registrations are sent.
-- </ul>
-- </ul>
- <li><a name="sendmailconfigpath">sendmailconfigpath</a> - Sendmail configuration file path - defaults to `/etc'. Many newer distributions use `/etc/mail'.
- <li><a name="sendmailmachines">sendmailmachines</a> - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'.
- <li><a name="sendmailrestart">sendmailrestart</a> - If defined, the command which is run on sendmail machines after files are copied.
- <li><a name="session-start">session-start</a> - If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
- <li><a name="session-stop">session-stop</a> - If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
- <li><a name="shellmachine">shellmachine</a> - 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>shellmachine-useradd - The command(s) to run on shellmachine when an account is created. If this file does not exist, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If the file exists but is empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.
- <li>shellmachine-userdel - The command(s) to run on shellmachine when an account is deleted. If this file does not exist, <code>userdel $username</code> is the default. If the file exists but is empty, <code>rm -rf $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.
- <li>shellmachine-usermod - The command(s) to run on shellmachine when an account is modified. If this file does not exist or is empty, <code>[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.
- <li><a name="shellmachines">shellmachines</a> - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files.
- <li><a name="shells">shells</a> - Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq' initially so that importing doesn't fail with `Illegal shell' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.
- <li><a name="showpasswords">showpasswords</a> - The existance of this file will allow unencrypted user passwords to be displayed.
- <li><a name="smtpmachine">smtpmachine</a> - SMTP relay for Freeside's outgoing mail.
- <li><a name="soadefaultttl">soadefaultttl</a> - SOA default TTL for new domains.
- <li><a name="soaemail">soaemail</a> - SOA email for new domains, in BIND form (`.' instead of `@'), with trailing `.'
- <li><a name="soaexpire">soaexpire</a> - SOA expire for new domains
- <li><a name="soamachine">soamachine</a> - SOA machine for new domains, with trailing `.'
- <li><a name="soarefresh">soarefresh</a> - SOA refresh for new domains
- <li><a name="soaretry">soaretry</a> - SOA retry for new domains
- <li><a name="statedefault">statedefault</a> - Default state or province (if not supplied, the default is `CA')
- <li><a name="textradiusprepend">textradiusprepend</a> - The contents of this file will be prepended to the first line of a user's RADIUS entry in text exports. If necessary, usually `Auth-Type = Local, '.
- <li><a name="usernamemin">usernamemin</a> - Minimum username length (default 2);
- <li><a name="usernamemax">usernamemax</a> - Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)
- <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.
- <li>shells - Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq' initially so that importing doesn't fail with `Illegal shell' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.
- <li>smtpmachine - SMTP relay for Freeside's outgoing mail.
--</ul>
--</body>
--
+++ /dev/null
--<head>
-- <title>File exporting</title>
--</head>
--<body>
-- <h1>File exporting</h1>
-- <ul>
- <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. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a> and <a href="ftp://ftp.cheapnet.net/pub/icradius/">ICRADIUS</a>) will authenticate directly out of an SQL database. In these cases,
- it is reccommended that you replicate the data to an external RADIUS machine rather than running the RADIUS server on your Freeside machine. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended:
- <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.
-- <ul>
- <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.
- <li>icradiusmachines - Local radcheck and radreply tables will be created. If any machines are specified, the remote MySQL database will be locked and the radcheck table will be copied to the those machines. You may also need to set the <a href="config.html#icradius_mysqlsource">icradius_mysqlsource</a> and/or <a href="config.html#icradius_mysqldest">icradius_mysqldest</a> configuration files. Currently you need to be running MySQL for your Freeside database to use this feature.
- <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.
-- </ul>
-- <li>site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
-- <ul>
- <li>Account creation - If the <b>username</b>, <b>uid</b> and <b>dir</b> fields are defined for a new user, the command(s) specified in the <a href="config.html#shellmachine-useradd">shellmachine-useradd</a> configuration file are executed on shellmachine via ssh. If this file does not exist, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If the file exists but is empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.
- <li>Account deletion - The command(s) specified in the <a href="config.html#shellmachine-userdel">shellmachine-userdel</a> configuration file are executed on shellmachine via ssh. If this file does not exist, <code>userdel $username</code> is the default. If the file exists but is empty, <code>rm -rf $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.
- <li>Account modification - If a user's home directory changes, the command(s) specified in the <a href="config.html#shellmachine-usermod">shellmachine-usermod</a> configuration file are execute on shellmachine via ssh. If this file does not exist or is empty, <code>[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.
- <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.
-- </ul>
- <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:
- <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.
-- <ul>
- <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>. If no errors occur, they are moved to <b>/etc/sendmail.cw</b> and <b>/etc/virtusertable</b> and the command specified in the <a href="config.html#sendmailrestart">sendmailrestart</a> configuration file is executed. (The path can be changed from the default <b>/etc</b> with the <a href="config.html#sendmailconfigpath">sendmailconfigpath</a> configuration file.)
- <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.
-- </ul>
- <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.
- <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated.
-- <ul>
- <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.
- <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.
-- </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>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.nyc.ny.us/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, you need to use a blank passphrase.
-- <li>Append the newly-created identity.pub file to root's authorized_keys on the remote machine(s).
-- </ul>
--
--</body>
--
+++ /dev/null
--<head>
-- <title>Documentation</title>
--</head>
- <body bgcolor="#ffffff">
-<body>
-- <h1>Documentation</h1>
- <img src="overview.png">
--<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.4</a>
- <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</a>
- <li><a href="upgrade4.html">Upgrading from 1.2.x to 1.2.2</a>
- <li><a href="upgrade5.html">Upgrading from 1.2.2 to 1.2.3</a>
- <li><a href="upgrade6.html">Upgrading from 1.2.3 to 1.3.0</a>
- <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.3</a>
-- <li><a href="config.html">Configuration files</a>
- <li><a href="admin.html">Administration</a>
--<!--
- <li><a href="../index.html#admin">Administration</a>
- <li><a href="admin.html">Administration</a>
--!-->
- <li><a href="../index.html#admin">Administration</a>
-- <li><a href="legacy.html">Importing legacy data</a>
-- <li><a href="export.html">File exporting and remote setup</a>
-- <li><a href="passwd.html">fs_passwd</a>
- <li><a href="signup.html">Signup server</a>
- <li><a href="session.html">Session monitor</a>
-- <li><a href="billing.html">Billing</a>
-- <li><a href="trouble.html">Troubleshooting</a>
-- <li><a href="schema.html">Schema reference</a>
- <li><a href="man/FS.html">Perl API</a>
- <li><a href="man/">Perl API</a>
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Installation</title>
--</head>
--<body>
--<h1>Installation</h1>
--Before installing, you need:
--<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="http://www.openssh.com//">SSH</a>
- <li><a href="http://www.perl.com/">Perl</a> Don't enable experimental features like threads or the PerlIO abstraction layer.
- <li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>. <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended. (see the <a href="postgresql.html">PostgreSQL notes</a>) <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. If you really want to use MySQL, you need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>.
- <li>Perl modules (<a href="http://theoryx5.uwinnipeg.ca/CPAN/perl/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
- <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>Perl modules
-- <ul>
- <li><a href="http://search.cpan.org/search?dist=Array-PrintCols">Array-PrintCols</a>
- <li><a href="http://search.cpan.org/search?dist=Term-Query">Term-Query</a> (make test broken; install manually)
- <li><a href="http://search.cpan.org/search?dist=MIME-Base64">MIME-Base64</a>
- <li><a href="http://search.cpan.org/search?dist=Digest-MD5">Digest-MD5</a>
- <li><a href="http://search.cpan.org/search?dist=URI">URI</a>
- <li><a href="http://search.cpan.org/search?dist=HTML-Parser">HTML-Parser</a>
- <li><a href="http://search.cpan.org/search?dist=libnet">libnet</a>
- <li><a href="http://search.cpan.org/search?dist=Locale-Codes">Locale-Codes</a>
- <li><a href="http://search.cpan.org/search?dist=Net-Whois">Net-Whois</a>
- <li><a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a>
- <li><a href="http://search.cpan.org/search?dist=Business-CreditCard">Business-CreditCard</a>
- <li><a href="http://search.cpan.org/search?dist=Data-ShowTable">Data-ShowTable</a>
- <li><a href="http://search.cpan.org/search?dist=MailTools">MailTools</a>
- <li><a href="http://search.cpan.org/search?dist=TimeDate">TimeDate</a>
- <li><a href="http://search.cpan.org/search?dist=DateManip">DateManip</a>
- <li><a href="http://search.cpan.org/search?dist=File-CounterFile">File-CounterFile</a>
- <li><a href="http://search.cpan.org/search?dist=FreezeThaw">FreezeThaw</a>
- <li><a href="http://search.cpan.org/search?dist=String-Approx">String-Approx</a>
- <li><a href="http://search.cpan.org/search?dist=Text-Template">Text-Template</a>
- <li><a href="http://search.cpan.org/search?dist=DBI">DBI
- <li><a href="http://search.cpan.org/search?mode=module&query=DBD">DBD for your database engine</a>
- <li><a href="http://search.cpan.org/search?dist=DBIx-DBSchema">DBIx-DBSchema</a>
- <li><a href="http://search.cpan.org/search?dist=Net-SSH">Net-SSH</a>
- <li><a href="http://search.cpan.org/search?dist=Net-SCP">Net-SCP</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/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/Time/">TimeDate</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/DBI/">DBI
- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
-- </ul>
--</ul>
--Install the Freeside distribution:
--<ul>
-- <li>Add the user `freeside' to your system.
- <li>Allow the freeside user full access to the freeside database.
- <ul>
- <li> with <a href="http://www.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege_system">MySQL</a>:<pre>$ mysqladmin -u root password '<i>set_a_root_database_password</i>'
- $ mysql -u root -p
- mysql> GRANT SELECT,INSERT,UPDATE,DELETE,INDEX,ALTER,CREATE,DROP on freeside.* TO freeside@localhost IDENTIFIED BY '<i>set_a_freeside_database_password</i>';</pre>
- <li> with <a href="http://postgresql.readysetnet.com/users-lounge/docs/7.1/postgres/user-manag.html#DATABASE-USERS">PostgreSQL</a>
- </ul>
- <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Reference.html#CREATE_DATABASE">MySQL</a>) (with <a href="http://postgresql.readysetnet.com/users-lounge/docs/7.1/postgres/managing-databases.html#MANAGE-AG-CREATEDB">PostgreSQL</a>)
- <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Syntax.html#Create database">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/manage-ag.htm#AEN854">PostgreSQL</a>)
- <li>Allow the freeside user full access to the freeside database. (with <a href="http://www.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege system">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/newuser.htm">PostgreSQL</a>)
-- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>
- <li>Build and install the Perl libraries:
- <pre>
- $ cd FS/
- $ perl Makefile.PL
- $ make
- $ su
- # make install UNINST=1</pre>
- <li>Copy or link fs-x.y.z/site_perl to FS in your site_perl directory. (try `<code>perl -V</code>' if unsure) <pre>mkdir /usr/local/lib/site_perl/FS
-cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS</pre> or <pre>ln -s /full/path/to/fs-x.y.z/site_perl /usr/local/lib/site_perl/FS</pre>
-- <li>Copy or link fs-x.y.z/htdocs to your web server's document space. <pre>mkdir /usr/local/apache/htdocs/freeside
--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://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache</a>)
- <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. 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.
- <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.
--<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>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.
- <li>Now proceed to the initial <a href="admin.html">administration</a> of your installation.
-<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.
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Importing legacy data</title>
--</head>
--<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="../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="http://rootwood.sisd.com/freeside/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>Some accounts might have entries in users only (Port-Limit 1)
-- <li>Some accounts might have entries in users only (Port-Limit >= 2)
-- <li>POP mail accounts have entries in passwd only, and have a particular shell.
-- <li>Everything else in passwd is a shell account.
-- </ul>
- <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="../browse/part_svc.cgi">services</a> as follows:
- <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> as follows:
-- <ul>
-- <li>Domain (table svc_acct)
-- <li>Mail alias (table svc_acct_sm)
-- </ul>
-- <li><a name="cust_main">Importing customer data</a>
-- <ul>
-- <li>Manually
-- <ul>
-- <li>Add a <a href="../edit/cust_main.cgi">new customer</a>
-- <li>Add one or more packages for this customer
-- <li>Enter a package by clicking on the package number
-- <li>Pick the `Link to existing' option
-- </ul>
-- <li>Batch - You will need to write a script to import your particular legacy data. You can use eg/TEMPLATE_cust_main.import as a starting point.
-- </ul>
--</ul>
--</body>
--
+++ /dev/null
--<head>
-- <title>fs_passwd</title>
--</head>
--<body>
-- <h1>fs_passwd</h1>
--You may use fs_passwd/fs_passwd as a "passwd", "chfn" and "chsh" replacement on your shell machine(s) to cause password, gecos and shell changes to update your freeside machine. This can pose a security risk if not configured correctly. <b>Do not use this feature unless you understand what you are doing!</b>
--<br><br>Currently it is assumed that the the crypt(3) function in the C library is the same on the Freeside machine as on the target machine.
--<ul>
-- <li>Create a freeside account on the shell machine(s).
-- <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the shell machine(s).
-- <li>Copy fs_passwd/fs_passwd to /usr/local/bin on the shell machine(s). (chown freeside, chmod 4755). You may link it to passwd, chfn and chsh as well.
-- <li>Copy fs_passwd/fs_passwdd to /usr/local/sbin on the shell machine(s). (chown freeside, chmod 500)
-- <li>Create /usr/local/freeside on the shell machine(s). (chown freeside, chmod 700)
-- <li>Run an iteration of "fs_passwd/fs_passwd_server shell.machine" as the freeside user for each shell machine (this is a daemon process).
--</ul>
--</body>
+++ /dev/null
--<head>
-- <title>Schema reference</title>
--</head>
--<body>
-- <h1>Schema reference</h1>
-- <ul>
-- <li><a name="agent">agent</a> - Agents are resellers of your service. Agents may be limited to a subset of your full offerings (via their agent type).
-- <ul>
-- <li>agentnum - primary key
-- <li>agent - name of this agent
-- <li>typenum - <a href="#agent_type">agent type</a>
-- <li>prog - (unimplemented)
-- <li>freq - (unimplemented)
-- </ul>
-- <li><a name="agent_type">agent_type</a> - Agent types define groups of packages that you can then assign to particular agents.
-- <ul>
-- <li>typenum - primary key
-- <li>atype - name of this agent type
-- </ul>
- <li><a name="cust_bill">cust_bill</a> - Invoices. Declarations that a customer owes you money. The specific charges are itemized in <a href="#cust_billl_pkg">cust_bill_pkg</a>.
- <li><a name="cust_bill">cust_bill</a> - Invoices
-- <ul>
-- <li>invnum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>_date
-- <li>charged - amount of this invoice
- <li>owed - amount still outstanding on this invoice
-- <li>printed - how many times this invoice has been printed automatically
-- </ul>
-- <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items
-- <ul>
-- <li>invnum - (multiple) key
- <li>pkgnum - <a href="#cust_pkg">package</a> or 0 for the special virtual sales tax package
- <li>pkgnum - <a href="#cust_pkg">package</a>
-- <li>setup - setup fee
-- <li>recur - recurring fee
-- <li>sdate - starting date
-- <li>edate - ending date
-- </ul>
- <li><a name="cust_credit">cust_credit</a> - Credits. The equivalent of a negative <a href="#cust_bill">cust_bill</a> record.
- <li><a name="cust_credit">cust_credit</a> - Credits
-- <ul>
-- <li>crednum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>amount - amount credited
- <li>credited - amount still outstanding (not yet refunded) on this credit
-- <li>_date
-- <li>otaker - order taker
-- <li>reason
-- </ul>
-- <li><a name="cust_main">cust_main</a> - Customers
-- <ul>
-- <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>address1
-- <li>address2
-- <li>city
-- <li>county
-- <li>state
-- <li>zip
-- <li>country
-- <li>daytime - phone
-- <li>night - phone
- <li>fax - phone
-- <li>payby - CARD, BILL, or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>paydate - expiration date
-- <li>payname - billing name (name on card)
-- <li>tax - 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. Money being transferred from a customer.
- <li><a name="cust_pay">cust_pay</a> - Payments
-- <ul>
-- <li>paynum - primary key
-- <li>invnum - <a href="#cust_bill">invoice</a>
-- <li>paid - amount
-- <li>_date
-- <li>payby - CARD, BILL, or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>paybatch - text field for tracking card processor batches
-- </ul>
-- <li><a name="cust_pay_batch">cust_pay_batch</a> - Pending batch
-- <ul>
-- <li>trancode - 77 for charges
-- <li>cardnum
-- <li>exp - card expiration
-- <li>amount
-- <li>invnum - <a href="#cust_bill">invoice</a>
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>payname - name on card
-- <li>first - name
-- <li>last - name
-- <li>address1
-- <li>address2
-- <li>city
-- <li>state
-- <li>zip
-- <li>country
-- </ul>
-- <li><a name="cust_pkg">cust_pkg</a> - Customer billing items
-- <ul>
-- <li>pkgnum - primary key
-- <li>custnum - <a href="#cust_main">customer</a>
-- <li>pkgpart - <a href="#part_pkg">Package definition</a>
-- <li>setup - date
-- <li>bill - next bill date
-- <li>susp - (past) suspension date
-- <li>expire - (future) cancellation date
-- <li>cancel - (past) cancellation date
-- <li>otaker - order taker
-- </ul>
- <li><a name="cust_refund">cust_refund</a> - Refunds. The transfer of money to a customer; equivalent to a negative <a href="#cust_pay">cust_pay</a> record.
- <li><a name="cust_refund">cust_refund</a> - Refunds
-- <ul>
-- <li>refundnum - primary key
-- <li>crednum - <a href="#cust_credit">credit</a>
-- <li>refund - amount
-- <li>_date
-- <li>payby - CARD, BILL or COMP
-- <li>payinfo - card number, P.O.#, or comp issuer
-- <li>otaker - order taker
-- </ul>
-- <li><a name="cust_svc">cust_svc</a> - Customer services
-- <ul>
-- <li>svcnum - primary key
-- <li>pkgnum - <a href="#cust_pkg">package</a>
-- <li>svcpart - <a href="#part_svc">Service definition</a>
- </ul>
- <li><a name="nas">nas</a> - Network Access Server (terminal server)
- <ul>
- <li>nasnum - primary key
- <li>nas - NAS name
- <li>nasip - NAS ip address
- <li>nasfqdn - NAS fully-qualified domain name
- <li>last - timestamp indicating the last instant the NAS was in a known state (used by the session monitoring).
-- </ul>
-- <li><a name="part_pkg">part_pkg</a> - Package definitions
-- <ul>
-- <li>pkgpart - primary key
-- <li>pkg - package name
-- <li>comment - non-customer visable package comment
-- <li>setup - setup fee
-- <li>freq - recurring frequency (months)
-- <li>recur - recurring fee
-- </ul>
-- <li><a name="part_referral">part_referral</a> - Referral listing
-- <ul>
- <li>refnum - primary key
- <li>referral - referral
- <li>refnum</li> - primary key
- <li>referral</li> - referral
-- </ul>
-- <li><a name="part_svc">part_svc</a> - Service definitions
-- <ul>
-- <li>svcpart - primary key
-- <li>svc - name of this service
-- <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_domain, svc_charge or svc_wo
-- <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>
-- <li>svcpart - <a href="#part_svc">Service definition</a>
-- <li>quantity - quantity of this service that this package includes
- </ul>
- <li><a name="port">port</a> - individual port on a <a href="#nas">nas</a>
- <ul>
- <li>portnum - primary key
- <li>ip - IP address of this port
- <li>nasport - port number on the NAS
- <li>nasnum - <a href="#nas">NAS</a>
- </ul>
- <li><a name="prepay_credit">prepay_credit</a>
- <ul>
- <li>prepaynum - primary key
- <li>identifier - text or numeric string used to receive this credit
- <li>amount - amount of credit
- </ul>
- <li><a name="session">session</a>
- <ul>
- <li>sessionnum - primary key
- <li>portnum - <a href="#port">Port</a>
- <li>svcnum - <a href="#svc_acct">Account</a>
- <li>login - timestamp indicating the beginning of this user session.
- <li>logout - timestamp indicating the end of this user session. May be null, which indicates a currently open session.
-- </ul>
-
-- <li><a name="svc_acct">svc_acct</a> - Accounts
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>username
-- <li>_password
-- <li>popnum - <a href="#svc_acct_pop">Point of Presence</a>
-- <li>uid
-- <li>gid
-- <li>finger - GECOS
-- <li>dir
-- <li>shell
-- <li>quota - (unimplementd)
-- <li>slipip - IP address
-- <li>radius_<i>Radius_Attribute</i> - Radius-Attribute
-- </ul>
-- <li><a name="svc_acct_pop">svc_acct_pop</a> - Points of Presence
-- <ul>
-- <li>popnum - primary key
-- <li>city
-- <li>state
-- <li>ac - area code
-- <li>exch - exchange
- <li>loc - rest of number
-- </ul>
-- <li><a name="svc_acct_sm">svc_acct_sm</a> - Domain mail aliases
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
-- <li>domuid - <a href="#svc_acct">Account</a> (by uid)
-- <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
-- </ul>
-- <li><a name="svc_domain">svc_domain</a> - Domains
-- <ul>
-- <li>svcnum - <a href="#cust_svc">primary key</a>
-- <li>domain
- </ul>
- <li><a name="domain_record">domain_record</a> - Domain zone detail
- <ul>
- <li>recnum - primary key
- <li>svcnum - <a href="#svc_domain">Domain</a> (by svcnum)
- <li>reczone - zone for this line
- <li>recaf - address family, usually <b>IN</b>
- <li>rectype - type for this record (<b>A</b>, <b>MX</b>, etc.)
- <li>recdata - data for this record
- </ul>
- <li><a name="svc_www">svc_www</a>
- <ul>
- <li>svcnum - <a href="#cust-svc">primary key</a>
- <li>recnum - <a href="#domain_record">host</a>
- <li>usersvc - <a href="#svc_acct">account</a>
-- </ul>
-- <li><a name="type_pkgs">type_pkgs</a>
-- <ul>
-- <li>typenum - <a href="#agent_type">agent type</a>
-- <li>pkgpart - <a href="#part_pkg">Package definition</a>
-- </ul>
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Troubleshooting</title>
--</head>
--<body>
-- <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.
-<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>,
-among others, should work fine.
-- <li>If bin/svc_acct.import fails with an "Out of memory!" error using MySQL, upgrede MySQL and recompile the Perl DBD. There was a memory leak in some older versions of MySQL.
-- <li>If you get tons of errors in your web server's error log like this:
--<pre>
--Ambiguous use of value => resolved to "value" =>
--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:
-<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.
-Bad header=HTTP/1.0 302 Moved Temporarily
-</pre>
- Then you forgot to apply this <a href="CGI-modules-2.76-patch.txt">patch</a> as mentioned in the <a href="install.html">New Installation</a> section of the documentation.
-- <li>If you get errors like this:
--<pre>
--UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied
--at <i>/your/path</i>/site_perl/FS/UID.pm line 26.
--BEGIN failed--compilation aborted at
--<i>/your/path</i>/edit/process/part_svc.cgi line 15.
--</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.
- 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>
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Upgrading to 1.1.x</title>
--</head>
--<body>
--<h1>Upgrading to 1.1.x</h1>
--<ul>
-- <li>Back up your data and current Freeside installation.
-- <li>Unpack a copy of the 1.0.0 distribution in a separate location.
-- <li>Diff your current installation against the 1.0.0 distribution.
-- <li>Apply all the diffs you found above, if applicable.
-- <li>Apply (at least) the following changes to your database:
--<pre>
--ALTER TABLE cust_main CHANGE ss ss char(11) NULL;
--ALTER TABLE cust_main CHANGE day daytime varchar(20) NULL;
--ALTER TABLE svc_acct CHANGE password _password varchar(25) NOT NULL;
--ALTER TABLE part_svc CHANGE svc_acct__password svc_acct___password varchar(25) NULL;
--ALTER TABLE part_svc CHANGE svc_acct__password_flag svc_acct___password_flag char(1) NULL;
--ALTER TABLE agent_type CHANGE type atype varchar(80) NOT NULL;
--</pre>
-- <li>Optionally change the field lengths and types to match a 1.1.x install; see `bin/fs-setup'.
-- <li>Create the necessary <a href="config.html">configuration files</a>,
-- <li>Copy or symlink htdocs and site_perl to the new 1.1.x copies.
-- <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
--</body>
+++ /dev/null
--<head>
- <title>Upgrading to 1.1.4</title>
- <title>Upgrading to 1.1.3</title>
--</head>
--<body>
- <h1>Upgrading to 1.1.4 from 1.1.x</h1>
-<h1>Upgrading to 1.1.3 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.
-- <li>If applicable, create the new <a href="config.html">configuration files</a>: lpr, cybercash2, cybercash3.2
-- <li>Copy or symlink htdocs and site_perl to the new copies.
--</body>
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $
-# agent.cgi: Add/Edit agent (output form)
--#
--# ivan@sisd.com 97-dec-12
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'type' to 'atype' because Pg6.3 reserves the type word
--# 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 vars qw ( $cgi $agent $action $hashref $p $agent_type );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(header menubar popurl);
- use FS::Record qw(qsearch qsearchs fields);
-use FS::Record qw(qsearch qsearchs);
--use FS::agent;
- use FS::agent_type;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- 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 } );
-SendHeaders(); # one guess.
-
-my($agent,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent=qsearchs('agent',{'agentnum'=>$1});
- $action='Edit';
--} else { #adding
- $agent = new FS::agent {};
- $agent=create FS::agent {};
- $action='Add';
--}
- $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',
- ));
-my($hashref)=$agent->hashref;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-print header("$action Agent", menubar(
- 'Main Menu' => '../',
- 'View all agents' => '../browse/agent.cgi',
-)), '<FORM ACTION="process/agent.cgi" METHOD=POST>';
--
- print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>',
- qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
-print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
-- "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
--
--print <<END;
--<PRE>
--Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}">
--Agent type <SELECT NAME="typenum" SIZE=1>
--END
--
-my($agent_type);
--foreach $agent_type (qsearch('agent_type',{})) {
- print "<OPTION VALUE=". $agent_type->typenum;
- print "<OPTION";
-- print " SELECTED"
- if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum );
- if $hashref->{typenum} == $agent_type->getfield('typenum');
-- print ">", $agent_type->getfield('typenum'), ": ",
-- $agent_type->getfield('atype'),"\n";
--}
--
--print <<END;
--</SELECT>
--Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
--Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{agentnum} ? "Apply changes" : "Add agent",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/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
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'type' to 'atype' because Pg6.3 reserves the type word
--# 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 vars qw( $cgi $agent_type $action $hashref $p $part_pkg );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::agent_type;
- use FS::CGI qw(header menubar popurl);
-use FS::Record qw(qsearch qsearchs);
--use FS::agent_type;
- use FS::part_pkg;
- use FS::type_pkgs;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- 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+)$/;
-SendHeaders(); # one guess.
-
-my($agent_type,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $agent_type=qsearchs('agent_type',{'typenum'=>$1});
- $action='Edit';
--} else { #adding
- $agent_type = new FS::agent_type {};
- $agent_type=create FS::agent_type {};
- $action='Add';
--}
- $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",
- ));
-my($hashref)=$agent_type->hashref;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-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 '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>',
- qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
-print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
-- "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
--
--print <<END;
- <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>
-<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>
--END
--
-my($part_pkg);
--foreach $part_pkg ( qsearch('part_pkg',{}) ) {
-- print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
-- $part_pkg->getfield('pkgpart'), qq!" !,
-- # ( 'CHECKED 'x scalar(
-- qsearchs('type_pkgs',{
-- 'typenum' => $agent_type->getfield('typenum'),
-- 'pkgpart' => $part_pkg->getfield('pkgpart'),
-- })
-- ? 'CHECKED '
-- : '',
- qq!VALUE="ON"> !,
- qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart,
- '">', $part_pkg->getfield('pkg'), '</A>',
- qq!"VALUE="ON"> !,$part_pkg->getfield('pkg')
-- ;
--}
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{typenum} ? "Apply changes" : "Add agent type",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $
-# cust_credit.cgi: Add a credit (output form)
--#
--# 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 96-dec-05
--#
--# paybatch field, differentiates between credits & credits+refunds by commandline
--# ivan@voicenet.com 96-dec-08
--#
--# added (but commented out) sprintf("%.2f" in amount field. Hmm.
--# ivan@voicenet.com 97-jan-3
--#
--# paybatch stuff thrown out - has checkbox now instead.
--# (well, sort of. still passed around for backward compatability and possible editing hook)
--# 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;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base qw(:DEFAULT :CGI); #CGI module
--use FS::UID qw(cgisuidsetup getotaker);
- use FS::CGI qw(header popurl);
- use FS::Record qw(fields);
- #use FS::cust_credit;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--cgisuidsetup($cgi);
-
- 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;
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
--
- $p1 = popurl(1);
-#untaint otaker
-my($otaker)=getotaker;
--
- print $cgi->header( '-expires' => 'now' ), header("Post Credit", '');
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-SendHeaders(); # one guess.
--print <<END;
- <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST>
- <PRE>
-<HTML>
- <HEAD>
- <TITLE>Post Credit</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Post Credit</H1>
- </CENTER>
- <FORM ACTION="process/cust_credit.cgi" METHOD=POST>
- <HR><PRE>
--END
--
- $crednum = "";
-#crednum
-my($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="">!;
--
- print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!;
-#date
-my($date)=time;
-print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
--
-#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="">!;
--
- #print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!;
-#refund?
-#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">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;
--</PRE>
--<BR>
--<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
--END
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main.cgi,v 1.28 2000-12-26 23:51:40 ivan Exp $
-# cust_main.cgi: Edit a customer (output form)
--#
--# 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.
--# ivan@voicenet.com 96-dec-16
--#
--# referral defaults to blank, to force people to pick something
--# ivan@voicenet.com 97-jun-4
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-28
--#
--# new customer is null, not '#'
--# otaker gotten from &getotaker instead of $ENV{REMOTE_USER}
--# ivan@sisd.com 97-nov-12
--#
--# cgisuidsetup($cgi);
--# no need for old_ fields.
--# now state+county is a select field (took out PA hack)
--# used autoloaded $cust_main->field methods
--# ivan@sisd.com 97-dec-17
--#
--# fixed quoting problems ivan@sisd.com 98-feb-23
--#
--# paydate sql update ivan@sisd.com 98-mar-5
--#
--# Changes to allow page to work at a relative position in server
--# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
--# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format
--# bmccane@maxbaud.net 98-apr-3
--#
--# fixed one missed day->daytime ivan@sisd.com 98-jul-13
- #
- # $Log: cust_main.cgi,v $
- # Revision 1.28 2000-12-26 23:51:40 ivan
- # statedefault & referraldefault config files
- #
- # Revision 1.27 2000/12/03 13:45:15 ivan
- # patch from Jason Spence <thalakan@frys.com>: admin.html doc, autocapgen
- #
- # Revision 1.26 2000/06/27 12:15:50 ivan
- # i18n
- #
- # Revision 1.25 2000/03/02 08:09:38 ivan
- # still need to allow blank expiration dates
- #
- # Revision 1.24 2000/01/30 06:54:50 ivan
- # credit card expiration dates not sticky bug fixed?
- #
- # Revision 1.23 2000/01/27 00:53:14 ivan
- # 5.004_04 workaround
- #
- # Revision 1.22 1999/12/17 02:33:23 ivan
- # argh
- #
- # Revision 1.21 1999/08/23 07:40:38 ivan
- # missing </TD> flag
- #
- # Revision 1.20 1999/08/23 07:08:11 ivan
- # no CGI::Switch for now
- #
- # Revision 1.19 1999/08/21 02:14:25 ivan
- # better error message for no agents
- #
- # Revision 1.18 1999/08/11 15:38:33 ivan
- # fix for perl 5.004_04
- #
- # Revision 1.17 1999/08/10 11:15:45 ivan
- # corrected a misleading comment
- #
- # Revision 1.15 1999/04/14 13:14:54 ivan
- # configuration option to edit referrals of existing customers
- #
- # 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 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;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup getotaker);
- #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::Record qw(qsearch qsearchs);
--use FS::cust_main;
- use FS::agent;
- use FS::part_referral;
- use FS::cust_main_county;
-
- #for misplaced logic below
- use FS::part_pkg;
-
- #for false laziness below
- use FS::svc_acct_pop;
--
- #for (other) false laziness below
- use FS::agent;
- use FS::type_pkgs;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
- $cgi = new CGI;
--cgisuidsetup($cgi);
--
- $conf = new FS::Conf;
-SendHeaders(); # one guess.
--
--#get record
-
- 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+)$/;
-my($custnum,$action,$cust_main);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $custnum=$1;
- $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
- $pkgpart = 0;
- $username = '';
- $password = '';
- $popnum = 0;
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
- $action='Edit';
--} else {
-- $custnum='';
- $cust_main = new FS::cust_main ( {} );
- $cust_main = create FS::cust_main ( {} );
-- $cust_main->setfield('otaker',&getotaker);
- $pkgpart = 0;
- $username = '';
- $password = '';
- $popnum = 0;
- $cust_main->setfield('country','US');
- $action='Add';
--}
- $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');
--
- # JRS: Javascript to set up the form for us
- if ( $conf->exists('autocapnames') ) {
- print <<END;
- <SCRIPT language="Javascript"><!--
-
- function capName(name) {
- var temp = new String();
- var n = name.toString();
-
- // Handle "Mc", "Mac", "Von", "Van", etc...
-
- if(n.substr(0,2).toLowerCase() == "mc") {
- temp += "Mc";
- temp += n.charAt(2).toUpperCase();
- temp += n.substr(3).toLowerCase();
- return temp;
- }
-
- if(n.substr(0,3).toLowerCase() == "mac") {
- temp += "Mac";
- temp += n.charAt(3).toUpperCase();
- temp += n.substr(4).toLowerCase();
- return temp;
- }
- if(n.substr(0,3).toLowerCase() == "von") {
- temp += "Von";
- temp += n.charAt(3).toUpperCase();
- temp += n.substr(4).toLowerCase();
- return temp;
- }
- if(n.substr(0,3).toLowerCase() == "van") {
- temp += "Van";
- temp += n.charAt(3).toUpperCase();
- temp += n.substr(4).toLowerCase();
- return temp;
- }
- temp += n.charAt(0).toUpperCase();
- temp += n.substr(1).toLowerCase();
- return temp;
- }
-
- //-->
- </SCRIPT>
-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!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1">!,
- qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
- qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ),
-
- ;
-
- # agent
--
- $r = qq!<font color="#ff0000">*</font>!;
-print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
- qq!Customer #<FONT SIZE="+1"><B>!;
-print $custnum ? $custnum : " (NEW)" , "</B></FONT>";
--
- @agents = qsearch( 'agent', {} );
- #die "No agents created!" unless @agents;
- die "You have not created any agents. You must create at least one agent before adding a customer. Go to ". popurl(2). "browse/agent.cgi and create one or more agents." 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>";
-#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";
--}
-print "</SELECT>";
--
--#referral
-
- $refnum = $cust_main->refnum || $conf->config('referraldefault') || 0;
- if ( $custnum && ! $conf->exists('editreferrals') ) {
- print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
- } else {
-#unless ($custnum) {
- my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error
-- my(@referrals) = qsearch('part_referral',{});
- 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> " unless $refnum;
- my($referral);
- foreach $referral (sort {
- $a->refnum <=> $b->refnum;
- } @referrals) {
- print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
- ">", $referral->refnum, ": ", $referral->referral;
- }
- print "</SELECT>";
- 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";
-- }
- }
-
-
- # contact info
- print "</SELECT>";
-#}
--
- ($last,$first,$ss,$company,$address1,$address2,$city,$zip)=(
-my($last,$first,$ss,$company,$address1,$address2,$city)=(
-- $cust_main->last,
-- $cust_main->first,
-- $cust_main->ss,
-- $cust_main->company,
-- $cust_main->address1,
-- $cust_main->address2,
-- $cust_main->city,
- $cust_main->zip,
--);
--
- print "<BR><BR>Contact information", &itable("#c0c0c0"), <<END;
- <TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3>
- END
-print <<END;
--
- if ( $conf->exists('autocapnames') ) {
- print <<END;
- <INPUT TYPE="text" NAME="last" VALUE="$last" onChange="updateUsername();">,
- <INPUT TYPE="text" NAME="first" VALUE="$first" onChange="updateUsername();">
- END
- } else {
- print <<END;
- <INPUT TYPE="text" NAME="last" VALUE="$last">,
- <INPUT TYPE="text" NAME="first" VALUE="$first">
- END
- }
--
- print <<END;
- </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"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1">
-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">
--END
--
- $cust_main->country( $conf->config('countrydefault') || 'US' )
- unless $cust_main->country;
- $cust_main->state( $conf->config('statedefault') || 'CA' )
- unless $cust_main->state;
--foreach ( qsearch('cust_main_county',{}) ) {
-- print "<OPTION";
-- print " SELECTED" if ( $cust_main->state eq $_->state
- && $cust_main->county eq $_->county
- && $cust_main->country eq $_->country
- );
- && $cust_main->county eq $_->county );
-- print ">",$_->state;
-- print " (",$_->county,")" if $_->county;
- print " / ", $_->country;
--}
- print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!;
-print "</SELECT>";
--
- ($daytime,$night,$fax)=(
-my($zip,$country,$daytime,$night,$fax)=(
- $cust_main->zip,
- $cust_main->country,
-- $cust_main->daytime,
-- $cust_main->night,
-- $cust_main->fax,
--);
--
--print <<END;
- <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
-
- print "</TABLE>$r required fields<BR>";
-
- # billing info
- 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">
--
- sub expselect {
- my $prefix = shift;
- my( $m, $y ) = (0, 0);
- if ( scalar(@_) ) {
- my $date = shift || '01-2000';
- if ( $date =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
- ( $m, $y ) = ( $2, $1 );
- } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- ( $m, $y ) = ( $1, $3 );
- } else {
- die "unrecognized expiration date format: $date";
- }
- }
-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>
--
- 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 ( 2001 .. 2037 ) {
- $return .= "<OPTION";
- $return .= " SELECTED" if $_ == $y;
- $return .= ">$_";
- }
- $return .= "</SELECT>";
-END
--
- $return;
-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{$_}!;
--}
-
- 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)=(
-my($payinfo,$payname,$otaker)=(
-- $cust_main->payinfo,
-- $cust_main->payname,
- $cust_main->otaker,
--);
--
- %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>!;
- }
-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='';
--}
--
- print "</TR></TABLE>$r required fields for each billing type";
-print <<END;
--
- unless ( $custnum ) {
- # pry the wrong place for this logic. also pretty expensive
- #use FS::part_pkg;
- Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19>
-END
--
- #false laziness, copied from FS::cust_pkg::order
- my $pkgpart;
- if ( scalar(@agents) == 1 ) {
- # $pkgpart->{PKGPART} is true iff $custnum may purchase $pkgpart
- my($agent)=qsearchs('agent',{'agentnum'=> $agentnum });
- $pkgpart = $agent->pkgpart_hashref;
- } else {
- #can't know (agent not chosen), so, allow all
- my %typenum;
- foreach my $agent ( @agents ) {
- next if $typenum{$agent->typenum}++;
- #fixed in 5.004_05 #$pkgpart->{$_}++ foreach keys %{ $agent->pkgpart_hashref }
- foreach ( keys %{ $agent->pkgpart_hashref } ) { $pkgpart->{$_}++; } #5.004_04 workaround
- }
- }
- #eslaf
-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!;
--
- my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
- qsearch( 'part_pkg', {} );
-print <<END;
--
- if ( @part_pkg ) {
--
- print "<BR><BR>First package", &itable("#c0c0c0"),
- qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!;
-Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
-</PRE>
-END
--
- print qq!<OPTION VALUE="">(none)!;
-print qq!<CENTER><INPUT TYPE="submit" VALUE="!,
- $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!;
--
- foreach my $part_pkg ( @part_pkg ) {
- print qq!<OPTION VALUE="!,
- # $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"';
- $part_pkg->pkgpart. "_". $part_pkg->svcpart, '"';
- print " SELECTED" if $pkgpart && ( $part_pkg->pkgpart == $pkgpart );
- print ">", $part_pkg->pkg, " - ", $part_pkg->comment;
- }
- print "</SELECT></TD></TR>";
-print <<END;
--
- #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>
- </FORM>
- </BODY>
-</HTML>
--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>";
- }
- }
-
- $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>",
- ;
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $
-# cust_main_county-expand.cgi: Expand a state into counties (output form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion );
- use CGI;
-use CGI::Base;
--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::cust_main_county;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
-
- 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 = '';
- }
--
- $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum});
- die "Can't expand entry!" if $cust_main_county->getfield('county');
-SendHeaders(); # one guess.
--
- $p1 = popurl(1);
- print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar(
- 'Main Menu' => popurl(2),
- ));
-$cgi->var('QUERY_STRING') =~ /^(\d+)$/
- or die "Illegal taxnum!";
-my($taxnum)=$1;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum});
-die "Can't expand entry!" if $cust_main_county->getfield('county');
--
- print <<END;
- <FORM ACTION="${p1}process/cust_main_county-expand.cgi" METHOD=POST>
-print header("Tax Rate (expand state)", menubar(
- 'Main Menu' => '../',
-)), <<END;
- <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST>
-- <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum">
- 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;
- 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.
-- <BR><INPUT TYPE="submit" VALUE="Submit">
- <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA>
- <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA>
-- </FORM>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
-# cust_main_county.cgi: Edit tax rates (output form)
--#
--# ivan@sisd.com 97-dec-13-16
--#
--# Changes to allow page to work at a relative position in server
--# Changed tax field to accept 6 chars (MO uses 6.1%)
--# 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 vars qw( $cgi $cust_main_county );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar popurl table);
- use FS::cust_main_county;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
-
- 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');
-SendHeaders(); # one guess.
--
- print qq!<FORM ACTION="!, popurl(1),
- qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END;
-print header("Edit tax rates", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <FORM ACTION="process/cust_main_county.cgi" METHOD=POST>
- <TABLE BORDER>
-- <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->{country}</TD>
- <TD>$hashref->{state}</TD>
--END
-
- print "<TD>", $hashref->{state}
- ? $hashref->{state}
- : '(ALL)'
- , "</TD>";
--
-- print "<TD>", $hashref->{county}
-- ? $hashref->{county}
-- : '(ALL)'
-- , "</TD>";
--
-- print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
-- qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!;
--END
--
--}
--
--print <<END;
-- </TABLE>
-- <INPUT TYPE="submit" VALUE="Apply changes">
-- </FORM>
-- </CENTER>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $
-# cust_pay.cgi: Add a payment (output form)
--#
--# 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;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(header popurl);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--cgisuidsetup($cgi);
-
- 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');
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
--
-SendHeaders(); # one guess.
--print <<END;
- <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST>
-<HTML>
- <HEAD>
- <TITLE>Enter payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Enter payment</H1>
- </CENTER>
- <FORM ACTION="process/cust_pay.cgi" METHOD=POST>
-- <HR><PRE>
--END
--
-#invnum
--print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!;
--
- print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!;
-#date
-my($date)=time;
-print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
--
- print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!;
-#paid
-print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" 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 qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
--
--print <<END;
--</PRE>
--<BR>
- <INPUT TYPE="submit" VALUE="Post payment">
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
--END
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pkg.cgi,v 1.8 1999-07-21 07:34:13 ivan Exp $
-# cust_pkg.cgi: Add/edit packages (output form)
--#
--# 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
--#
--# Rewrote for new API
--# ivan@voicenet.com 97-jul-7
--#
--# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
--#
--# Changes to allow page to work at a relative position in server
--# Changed to display packages 2-wide in a table
--# bmccane@maxbaud.net 98-apr-3
--#
--# 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.8 1999-07-21 07:34:13 ivan
- # links to package browse and agent type edit if there aren't any packages to
- # order. thanks to "Tech Account" <techy@orac.hq.org>
- #
- # 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 vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg
- $cust_main $agent $type_pkgs $count %remove_pkg $pkgparts );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
- use FS::UID qw(cgisuidsetup);
-use FS::UID qw(cgisuidsetup getotaker);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header popurl);
- use FS::part_pkg;
- use FS::type_pkgs;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
- %pkg = ();
- %comment = ();
-my(%pkg,%comment);
--foreach (qsearch('part_pkg', {})) {
-- $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
-- $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
- }
-
- 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;
--}
--
- $p1 = popurl(1);
- print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", '');
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-my($otaker)=&getotaker;
--
- print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
-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!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
-#custnum
-print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!;
--
- #current packages
- @cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
-#current packages (except cancelled packages)
-my(@cust_pkg) = grep ! $_->getfield('cancel'),
- qsearch('cust_pkg',{'custnum'=>$custnum});
--
--if (@cust_pkg) {
-- print <<END;
- Current packages - select to remove (services are moved to a new package below)
- <BR><BR>
-<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>
--END
--
-- my ($count) = 0 ;
- print qq!<TABLE>! ;
- print qq!<CENTER><TABLE>! ;
-- foreach (@cust_pkg) {
- print '<TR>' if $count == 0;
- print qq!<TR>! if ($count ==0) ;
-- my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
- 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!;
- 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!;
-- $count ++ ;
-- if ($count == 2)
-- {
-- $count = 0 ;
-- print qq!</TR>\n! ;
-- }
-- }
- print qq!</TABLE><BR><BR>!;
- print qq!</TABLE></CENTER>! ;
-
- print "<HR>";
--}
--
--print <<END;
- Order new packages<BR><BR>
-<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>
--END
--
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
- $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
--
- $count = 0;
- $pkgparts = 0;
- print qq!<TABLE>!;
-my($type_pkgs);
-my ($count) = 0 ;
-print qq!<CENTER><TABLE>! ;
--foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
- $pkgparts++;
-- my($pkgpart)=$type_pkgs->pkgpart;
- print qq!<TR>! if ( $count == 0 );
- my $value = $cgi->param("pkg$pkgpart") || 0;
- print qq!<TR>! if ($count == 0) ;
-- print <<END;
-- <TD>
- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2">
-- $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
--END
-- $count ++ ;
- if ( $count == 2 ) {
- if ($count == 2)
- {
-- print qq!</TR>\n! ;
- $count = 0;
- $count = 0 ;
-- }
--}
- print qq!</TABLE>!;
-print qq!</TABLE></CENTER>! ;
--
- unless ( $pkgparts ) {
- my $p2 = popurl(2);
- my $typenum = $agent->typenum;
- my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
- my $atype = $agent_type->atype;
- print <<END;
- (No <a href="${p2}browse/part_pkg.cgi">package definitions</a>, or agent type
- <a href="${p2}edit/agent_type.cgi?$typenum">$atype</a> not allowed to purchase
- any packages.)
- END
- }
-#otaker
-print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!;
--
--#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!;
-
--print <<END;
- <P><INPUT TYPE="submit" VALUE="Order">
-- </FORM>
-- </BODY>
--</HTML>
--END
+++ /dev/null
--#!/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
--#
--# Changes to allow page to work at a relative position in server
--# Changed to display services 2-wide in table
--# 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 vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
-use FS::Record qw(qsearch qsearchs);
--use FS::part_pkg;
- use FS::part_svc;
--use FS::pkg_svc;
- use FS::CGI qw(header menubar popurl);
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- 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', '');
- }
-SendHeaders(); # one guess.
--
- ($query) = $cgi->keywords;
- $action = '';
- $part_pkg = '';
- if ( $cgi->param('error') ) {
- $part_pkg = new FS::part_pkg ( {
- map { $_, scalar($cgi->param($_)) } fields('part_pkg')
- } );
- }
- 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 {};
-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';
--}
- $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 '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>';
-my($hashref)=$part_pkg->hashref;
--
- 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 header("$action Package Definition", menubar(
- 'Main Menu' => '../',
- 'View all packages' => '../browse/part_pkg.cgi',
-)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>';
--
--print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
-- "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
--
--print <<END;
--<PRE>
--Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}">
--Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}">
--Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}">
--Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}">
--Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
--
--</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
- }
--
- $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,
-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'),
-- 'svcpart' => $svcpart,
- } ) || new FS::pkg_svc ( {
- 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
- }) || create FS::pkg_svc({
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
-- 'svcpart' => $svcpart,
-- 'quantity' => 0,
-- });
- #? #next unless $pkg_svc;
- 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 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 ;
-- }
--}
-print qq!</TR>! if ($count != 0) ;
--
- unless ( $cgi->param('clone') ) {
- print qq!</TR>! if ($count != 0) ;
- print "</TABLE>";
- }
-print "</TABLE>";
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{pkgpart} ? "Apply changes" : "Add package",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $
-# agent.cgi: Add/Edit referral (output form)
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# 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 vars qw( $cgi $part_referral $action $hashref $p1 $query );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
-use FS::Record qw(qsearch qsearchs);
--use FS::part_referral;
- use FS::CGI qw(header menubar popurl);
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- 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 } );
-SendHeaders(); # one guess.
-
-my($part_referral,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_referral=qsearchs('part_referral',{'refnum'=>$1});
- $action='Edit';
--} else { #adding
- $part_referral = new FS::part_referral {};
- $part_referral=create FS::part_referral {};
- $action='Add';
--}
- $action = $part_referral->refnum ? 'Edit' : 'Add';
- $hashref = $part_referral->hashref;
-
- $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",
- ));
-my($hashref)=$part_referral->hashref;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-print header("$action Referral", menubar(
- 'Main Menu' => '../',
- 'View all referrals' => "../browse/part_referral.cgi",
-)), <<END;
- <FORM ACTION="process/part_referral.cgi" METHOD=POST>
-END
--
- print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!;
-#display
--
--print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
-- "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
--
--print <<END;
--<PRE>
--Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{refnum} ? "Apply changes" : "Add referral",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_svc.cgi,v 1.13 2000-06-15 11:10:31 ivan Exp $
-# part_svc.cgi: Add/Edit service (output form)
--#
--# ivan@sisd.com 97-nov-14
--#
--# Changes to allow page to work at a relative position in server
--# 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.13 2000-06-15 11:10:31 ivan
- # update to the inline documentation, hopefully will make things more clear
- #
- # 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 vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearchs fields);
- use FS::part_svc;
- use FS::CGI qw(header menubar popurl table);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--
--&cgisuidsetup($cgi);
--
- 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+)$/;
-SendHeaders(); # one guess.
-
-my($part_svc,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $part_svc=qsearchs('part_svc',{'svcpart'=>$1});
- $action='Edit';
--} else { #adding
- $part_svc = new FS::part_svc {};
- $part_svc=create FS::part_svc {};
- $action='Add';
--}
- $action = $part_svc->svcpart ? 'Edit' : 'Add';
- $hashref = $part_svc->hashref;
-my($hashref)=$part_svc->hashref;
--
- $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 header("$action Service Definition", menubar(
- 'Main Menu' => '../',
- 'View all services' => '../browse/part_svc.cgi',
-)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>';
--
- 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}">
- </PRE>
-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>
--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
- END
- # <LI>svc_charge - One-time charges (Partially unimplemented)
- # <LI>svc_wo - Work orders (Partially unimplemented)
- print <<END;
- <LI>svc_charge - One-time charges (Partially unimplemented)
- <LI>svc_wo - Work orders (Partially unimplemented)
--</UL>
- For the selected table, you can give fields default or fixed (unchangable)
-For the columns in the table selected above, you can set default or fixed
--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>
- 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>
-<TABLE BORDER CELLPADDING=4><TR><TH>Table</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
- %defs = (
-my(%defs)=(
-- 'svc_acct' => {
-- 'dir' => 'Home directory',
-- 'uid' => 'UID (set to fixed and blank for dial-only)',
- 'slipip' => 'IP address (set to fixed and blank to disable dialin)',
- 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
- 'slipip' => 'IP address',
- 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>',
-- 'username' => 'Username',
-- 'quota' => '(unimplemented)',
-- '_password' => 'Password',
-- 'gid' => 'GID (when blank, defaults to UID)',
- 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
- 'shell' => 'Shell',
-- 'finger' => 'GECOS',
-- },
-- 'svc_domain' => {
-- 'domain' => 'Domain',
-- },
-- 'svc_acct_sm' => {
-- 'domuser' => 'domuser@virtualdomain.com',
-- 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
-- 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
-- },
-- 'svc_charge' => {
-- 'amount' => 'amount',
-- },
-- 'svc_wo' => {
-- 'worker' => 'Worker',
-- '_date' => 'Date',
-- },
--);
--
- # svc_acct svc_domain svc_acct_sm svc_charge svc_wo
-my($svcdb);
--foreach $svcdb ( qw(
- svc_acct svc_domain svc_acct_sm
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
--) ) {
--
-- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
-- grep ! /_flag$/,
-- grep /^${svcdb}__/,
-- fields('part_svc');
-- my($rowspan)=scalar(@rows);
--
-- 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";
- print "- <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT>"
- if defined $defs{$svcdb}{$row};
- print "</TD>";
- 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>";
-- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
- ' CHECKED'x($flag eq ''). ">Off</TD>";
- ' CHECKED'x($flag eq ''). "><BR>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!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
- "</TD></TR>\n";
- print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
- "</TD></TR>";
-- $ptmp='';
-- }
--}
--print "</TABLE>";
--
- print qq!\n<BR><INPUT TYPE="submit" VALUE="!,
-print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{svcpart} ? "Apply changes" : "Add service",
- qq!">!;
- qq!"></CENTER>!;
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $
-# process/agent.cgi: Edit agent (process form)
--#
--# ivan@sisd.com 97-dec-12
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw ( $cgi $agentnum $old $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::agent;
- use FS::CGI qw(popurl);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent qw(fields);
-use FS::CGI qw(idiot);
--
- $cgi = new CGI;
-my($req)=new CGI::Request; # create form object
--
- &cgisuidsetup($cgi);
-&cgisuidsetup($req->cgi);
--
- $agentnum = $cgi->param('agentnum');
-my($agentnum)=$req->param('agentnum');
--
- $old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
-my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
--
- $new = new FS::agent ( {
-#unmunge typenum
-$req->param('typenum') =~ /^(\d+)(:.*)?$/;
-$req->param('typenum',$1);
-
-my($new)=create FS::agent ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->param($_);
-- } fields('agent')
--} );
--
-my($error);
--if ( $agentnum ) {
-- $error=$new->replace($old);
--} else {
-- $error=$new->insert;
-- $agentnum=$new->getfield('agentnum');
--}
--
--if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string );
- &idiot($error);
--} else {
- print $cgi->redirect(popurl(3). "browse/agent.cgi");
- #$req->cgi->redirect("../../view/agent.cgi?$agentnum");
- #$req->cgi->redirect("../../edit/agent.cgi?$agentnum");
- $req->cgi->redirect("../../browse/agent.cgi");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $
-# process/agent_type.cgi: Edit agent type (process form)
--#
--# ivan@sisd.com 97-dec-11
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw ( $cgi $typenum $old $new $error $part_pkg );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
- use FS::CGI qw( popurl);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::agent_type;
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type qw(fields);
--use FS::type_pkgs;
- use FS::part_pkg;
-use FS::CGI qw(idiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
--
- $typenum = $cgi->param('typenum');
- $old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
-my($typenum)=$req->param('typenum');
-my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
--
- $new = new FS::agent_type ( {
-my($new)=create FS::agent_type ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->param($_);
-- } fields('agent_type')
--} );
--
-my($error);
--if ( $typenum ) {
-- $error=$new->replace($old);
--} else {
-- $error=$new->insert;
-- $typenum=$new->getfield('typenum');
--}
--
--if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string );
- idiot($error);
-- exit;
--}
--
-my($part_pkg);
--foreach $part_pkg (qsearch('part_pkg',{})) {
-- my($pkgpart)=$part_pkg->getfield('pkgpart');
--
-- my($type_pkgs)=qsearchs('type_pkgs',{
-- 'typenum' => $typenum,
-- 'pkgpart' => $pkgpart,
-- });
- if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) {
- if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) {
-- my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
- $error=$d_type_pkgs->delete;
- die $error if $error;
- $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs,
- #so ->del not ->delete. hmm. hmm.
- if ( $error ) {
- idiot($error);
- exit;
- }
--
- } elsif ( $cgi->param("pkgpart$pkgpart")
- } elsif ( $req->param("pkgpart$pkgpart")
-- && ! $type_pkgs
-- ) {
-- #ok to clobber it now (but bad form nonetheless?)
- $type_pkgs=new FS::type_pkgs ({
- $type_pkgs=create FS::type_pkgs ({
-- 'typenum' => $typenum,
-- 'pkgpart' => $pkgpart,
-- });
-- $error= $type_pkgs->insert;
- die $error if $error;
- if ( $error ) {
- idiot($error);
- exit;
- }
-- }
--
--}
--
- print $cgi->redirect(popurl(3). "browse/agent_type.cgi");
-#$req->cgi->redirect("../../view/agent_type.cgi?$typenum");
-#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum");
-$req->cgi->redirect("../../browse/agent_type.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $
-# process/cust_credit.cgi: Add a credit (process form)
--#
--# 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
--# ivan@voicenet.com 96-dec-08
--#
--# refunds are no longer applied against a specific payment (paybatch)
--# paybatch field removed
--# ivan@voicenet.com 97-apr-22
--#
--# 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_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 vars qw( $cgi $custnum $new $error );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Request;
--use FS::UID qw(cgisuidsetup getotaker);
- use FS::CGI qw(popurl);
- use FS::Record qw(fields);
--use FS::cust_credit;
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
--
- $cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
- $custnum = $1;
-$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
-my($custnum)=$1;
--
- $cgi->param('otaker',getotaker);
-$req->param('otaker',getotaker);
--
- $new = new FS::cust_credit ( {
-my($new) = create FS::cust_credit ( {
-- map {
- $_, scalar($cgi->param($_));
- #} qw(custnum _date amount otaker reason)
- } fields('cust_credit')
- $_, $req->param($_);
- } qw(custnum _date amount otaker reason)
--} );
--
-my($error);
--$error=$new->insert;
-&idiot($error) if $error;
--
- 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");
- }
-#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
--
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main.cgi,v 1.11 1999-08-10 12:54:06 ivan Exp $
-# process/cust_main.cgi: Edit a customer (process form)
--#
--# 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
--# ivan@voicenet.com 97-jun-4
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-28
--#
--# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23
--#
--# 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.11 1999-08-10 12:54:06 ivan
- # use FS::cust_pkg::pkgpart_href
- #
- # 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 vars qw( $cgi $payby @invoicing_list $new $custnum $error );
- use vars qw( $cust_pkg $cust_svc $svc_acct );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
- use FS::UID qw(cgisuidsetup getotaker);
- use FS::CGI qw( popurl );
- use FS::Record qw( qsearch qsearchs fields );
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
--use FS::cust_main;
- use FS::type_pkgs;
- use FS::agent;
-
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-
- #unmunge stuff
--
- $cgi->param('tax','') unless defined($cgi->param('tax'));
-my($req)=new CGI::Request; # create form object
--
- $cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] );
-&cgisuidsetup($req->cgi);
--
- $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);
-#create new record object
--
- 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' ) );
- }
-#unmunge agentnum
-$req->param('agentnum',
- (split(/:/, ($req->param('agentnum'))[0] ))[0]
-);
--
- $cgi->param('otaker', &getotaker );
-#unmunge tax
-$req->param('tax','') unless defined($req->param('tax'));
--
- @invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
- push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
-#unmunge refnum
-$req->param('refnum',
- (split(/:/, ($req->param('refnum'))[0] ))[0]
-);
--
- #create new record object
-#unmunge state/county
-$req->param('state') =~ /^(\w+)( \((\w+)\))?$/;
-$req->param('state', $1);
-$req->param('county', $3 || '');
--
- $new = new FS::cust_main ( {
-my($new) = create FS::cust_main ( {
-- map {
- $_, 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')
- $_, $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)
--} );
-
- #perhaps the invocing_list magic should move to cust_main.pm?
- $error = $new->check_invoicing_list( \@invoicing_list );
--
- #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}++;
- #}
- # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart
- my $pkgpart_href = $agent->pkgpart_hashref;
- #eslaf
-
- # this should wind up in FS::cust_pkg!
- $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't".
- "purchase pkgpart ". $pkgpart
- #unless $part_pkg{ $pkgpart };
- unless $pkgpart_href->{ $pkgpart };
--
- $cust_pkg = new FS::cust_pkg ( {
- #later 'custnum' => $custnum,
- 'pkgpart' => $pkgpart,
- } );
- $error ||= $cust_pkg->check;
- my($error)=$new->insert;
- &idiot($error) if $error;
--
- #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } );
-} else { #create old record object
--
- #$error ||= $cust_svc->check;
- my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } );
- &idiot("Old record not found!") unless $old;
- my($error)=$new->replace($old);
- &idiot($error) if $error;
--
- $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'));
-my($custnum)=$new->custnum;
-$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main");
--
- $error ||= $svc_acct->check;
-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
--
- } elsif ( $cgi->param('username') ) { #good thing to catch
- $error = "Can't assign username without a package!";
- }
- exit;
--
- $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 } );
- $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");
- }
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main_county-expand.cgi,v 1.7 2000-12-21 05:22:30 ivan Exp $
-# process/cust_main_county-expand.cgi: Expand counties (process form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# Added import of datasrc from UID.pm for Pg6.3
--# Default tax to 0.0 if using Pg6.3
--# bmccane@maxbaud.net 98-apr-3
--#
--# 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
- #
- # $Log: cust_main_county-expand.cgi,v $
- # Revision 1.7 2000-12-21 05:22:30 ivan
- # perldoc -f split
- #
- # 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!
- #
-#ivan@sisd.com 98-sep-2
--
--use strict;
- use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion );
- use CGI;
-use CGI::Request;
--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::cust_main;
-use FS::CGI qw(eidiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
--
- $cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
- $taxnum = $1;
- $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
-&cgisuidsetup($req->cgi);
-
-$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
-my($taxnum)=$1;
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
-- or die ("Unknown taxnum!");
--
- if ( $cgi->param('delim') eq 'n' ) {
- @expansion=split(/\n/,$cgi->param('expansion'));
- } elsif ( $cgi->param('delim') eq 's' ) {
- @expansion=split(' ',$cgi->param('expansion'));
-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'));
--} else {
-- die "Illegal delim!";
--}
--
- @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;
- }
-@counties=map {
- /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county");
-- $1;
- } @expansion;
-} @counties;
--
- foreach ( @expansion) {
-my($county);
-foreach ( @counties) {
-- my(%hash)=$cust_main_county->hash;
- my($new)=new FS::cust_main_county \%hash;
- my($new)=create FS::cust_main_county \%hash;
-- $new->setfield('taxnum','');
- if ( ! $cust_main_county->state ) {
- $new->setfield('state',$_);
- } else {
- $new->setfield('county',$_);
- }
- $new->setfield('county',$_);
-- #if (datasrc =~ m/Pg/)
-- #{
-- # $new->setfield('tax',0.0);
-- #}
-- my($error)=$new->insert;
-- die $error if $error;
--}
--
--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;
--}
--
- print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi");
-$req->cgi->redirect("../../edit/cust_main_county.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $
-# process/agent.cgi: Edit cust_main_county (process form)
--#
--# ivan@sisd.com 97-dec-16
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi );
- use CGI;
-use CGI::Request;
--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);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
--
- foreach ( $cgi->param ) {
-&cgisuidsetup($req->cgi);
-
-foreach ( $req->params ) {
-- /^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 $cgi->param("tax$taxnum");
- next unless $old->getfield('tax') ne $req->param("tax$taxnum");
-- my(%hash)=$old->hash;
- $hash{tax}=$cgi->param("tax$taxnum");
- my($new)=new FS::cust_main_county \%hash;
- $hash{tax}=$req->param("tax$taxnum");
- my($new)=create FS::cust_main_county \%hash;
-- my($error)=$new->replace($old);
- if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string );
- exit;
- }
- eidiot($error) if $error;
--}
--
- print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
-$req->cgi->redirect("../../browse/cust_main_county.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $
-# process/cust_pay.cgi: Add a payment (process form)
--#
--# 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 vars qw( $cgi $invnum $new $error );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Request;
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl);
- use FS::Record qw(fields);
- use FS::cust_pay;
-use FS::cust_pay qw(fields);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
--
- $cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
- $invnum = $1;
-$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($invnum)=$1;
--
- $new = new FS::cust_pay ( {
-my($new) = create FS::cust_pay ( {
-- map {
- $_, scalar($cgi->param($_));
- #} qw(invnum paid _date payby payinfo paybatch)
- } fields('cust_pay')
- $_, $req->param($_);
- } qw(invnum paid _date payby payinfo paybatch)
--} );
--
-my($error);
--$error=$new->insert;
--
- 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");
-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");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $
-# process/cust_pkg.cgi: Add/edit packages (process form)
--#
--# 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
--# ivan@voicenet.com 97-jul-7 - 15
--#
--# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7
--#
--# 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 vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl);
--use FS::cust_pkg;
--
- $cgi = new CGI; # create form object
- &cgisuidsetup($cgi);
- $error = '';
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
--
--#untaint custnum
- $cgi->param('custnum') =~ /^(\d+)$/;
- $custnum = $1;
-$req->param('new_custnum') =~ /^(\d+)$/;
-my($custnum)=$1;
--
- @remove_pkgnums = map {
-my(@remove_pkgnums) = map {
-- /^(\d+)$/ or die "Illegal remove_pkg value!";
-- $1;
- } $cgi->param('remove_pkg');
-} $req->param('remove_pkg');
--
- 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(@pkgparts);
-my($pkgpart);
-foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) {
- my($num_pkgs)=$req->param("pkg$pkgpart");
- while ( $num_pkgs-- ) {
- push @pkgparts,$pkgpart;
-- }
--}
--
- $error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
-my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
--
--if ($error) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string );
- 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
--} else {
- print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
- $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg");
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
- #
- # $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $
--#
--# process/part_pkg.cgi: Edit package definitions (process form)
--#
--# ivan@sisd.com 97-dec-10
--#
--# don't update non-changing records in part_svc (causing harmless but annoying
--# "Records identical" errors). ivan@sisd.com 98-feb-19
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# 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.9 2001-04-09 23:05:16 ivan
- # Transactions Part I!!!
- #
- # 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 vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::part_pkg;
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg qw(fields);
--use FS::pkg_svc;
- use FS::cust_pkg;
-use FS::CGI qw(eidiot);
--
- $cgi = new CGI;
- $dbh = &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
--
- $pkgpart = $cgi->param('pkgpart');
-&cgisuidsetup($req->cgi);
--
- $old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-my($pkgpart)=$req->param('pkgpart');
--
- $new = new FS::part_pkg ( {
-my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-
-my($new)=create FS::part_pkg ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->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';
-
- local $FS::UID::AutoCommit = 0;
--
--if ( $pkgpart ) {
- $error = $new->replace($old);
- my($error)=$new->replace($old);
- eidiot($error) if $error;
--} else {
- $error = $new->insert;
- $pkgpart=$new->pkgpart;
- }
- if ( $error ) {
- $dbh->rollback;
- $cgi->param('error', $error );
- print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
- exit;
- my($error)=$new->insert;
- eidiot($error) if $error;
- $pkgpart=$new->getfield('pkgpart');
--}
--
-my($part_svc);
--foreach $part_svc (qsearch('part_svc',{})) {
- 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;
-# 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;
-- next unless $old_quantity != $quantity; #!here
- my $new_pkg_svc = new FS::pkg_svc( {
- my($new_pkg_svc)=create FS::pkg_svc({
-- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->svcpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')),
-- 'quantity' => $quantity,
- } );
- if ( $old_pkg_svc ) {
- my $myerror = $new_pkg_svc->replace($old_pkg_svc);
- if ( $myerror ) {
- $dbh->rollback;
- die $myerror;
- }
- });
- if ($old_pkg_svc) {
- my($error)=$new_pkg_svc->replace($old_pkg_svc);
- eidiot($error) if $error;
-- } else {
- my $myerror = $new_pkg_svc->insert;
- if ( $myerror ) {
- $dbh->rollback;
- die $myerror;
- }
- my($error)=$new_pkg_svc->insert;
- eidiot($error) if $error;
-- }
--}
-
- unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
- $dbh->commit or die $dbh->errstr;
- 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);
- if ( $myerror ) {
- $dbh->rollback;
- die "Error modifying cust_pkg record: $myerror\n";
- }
--
- $dbh->commit or die $dbh->errstr;
- print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
- }
-#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart");
-#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart");
-$req->cgi->redirect("../../browse/part_pkg.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $
-# process/part_referral.cgi: Edit referrals (process form)
--#
--# ivan@sisd.com 98-feb-23
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $refnum $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearchs fields);
- use FS::part_referral;
- use FS::CGI qw(popurl);
-use FS::Record qw(qsearchs);
-use FS::part_referral qw(fields);
-use FS::CGI qw(eidiot);
-use FS::CGI qw(eidiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
--
- $refnum = $cgi->param('refnum');
-&cgisuidsetup($req->cgi);
--
- $new = new FS::part_referral ( {
-my($refnum)=$req->param('refnum');
-
-my($new)=create FS::part_referral ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->param($_);
-- } fields('part_referral')
--} );
--
--if ( $refnum ) {
- my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } );
- die "(Old) Record not found!" unless $old;
- $error = $new->replace($old);
- my($old)=qsearchs('part_referral',{'refnum'=>$refnum});
- eidiot("(Old) Record not found!") unless $old;
- my($error)=$new->replace($old);
- eidiot($error) if $error;
--} else {
- $error = $new->insert;
- my($error)=$new->insert;
- eidiot($error) if $error;
--}
- $refnum=$new->refnum;
--
- 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");
- }
-$refnum=$new->getfield('refnum');
-$req->cgi->redirect("../../browse/part_referral.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $
-# process/part_svc.cgi: Edit service definitions (process form)
--#
--# ivan@sisd.com 97-nov-14
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw ( $cgi $svcpart $old $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearchs fields);
- use FS::part_svc;
- use FS::CGI qw(popurl);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(eidiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
--
- $svcpart = $cgi->param('svcpart');
-&cgisuidsetup($req->cgi);
--
- $old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-my($svcpart)=$req->param('svcpart');
--
- $new = new FS::part_svc ( {
-my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-
-my($new)=create FS::part_svc ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->param($_);
--# } qw(svcpart svc svcdb)
-- } fields('part_svc')
--} );
--
--if ( $svcpart ) {
- $error = $new->replace($old);
- my($error)=$new->replace($old);
- eidiot($error) if $error;
--} else {
- $error = $new->insert;
- my($error)=$new->insert;
- eidiot($error) if $error;
-- $svcpart=$new->getfield('svcpart');
--}
--
- 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");
- }
-#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart");
-#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart");
-$req->cgi->redirect("../../browse/part_svc.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct.cgi,v 1.7 1999-08-27 00:26:33 ivan Exp $
-# process/svc_acct.cgi: Add/edit a customer (process form)
--#
--# 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
--# ivan@voicenet.com 97-may-6
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-17 - 21
--#
--# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding
--# and editing ivan@sisd.com 98-mar-8
--#
--# 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.7 1999-08-27 00:26:33 ivan
- # better error messages
- #
- # 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 vars qw( $cgi $svcnum $old $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl);
- use FS::Record qw(qsearchs fields);
-use FS::Record qw(qsearchs);
--use FS::svc_acct;
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req) = new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
--
- $cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
- $svcnum = $1;
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
--
- if ( $svcnum ) {
- $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } )
- or die "fatal: can't find account (svcnum $svcnum)!";
- } else {
- $old = '';
- }
-my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
--
--#unmunge popnum
- $cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] );
-$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] );
--
--#unmunge passwd
- if ( $cgi->param('_password') eq '*HIDDEN*' ) {
- die "fatal: no previous account to recall hidden password from!" unless $old;
- $cgi->param('_password',$old->getfield('_password'));
-if ( $req->param('_password') eq '*HIDDEN*' ) {
- $req->param('_password',$old->getfield('_password'));
--}
--
- $new = new FS::svc_acct ( {
-my($new) = create FS::svc_acct ( {
-- map {
- $_, scalar($cgi->param($_));
- #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
- # shell quota slipip)
- } ( fields('svc_acct'), qw( pkgnum svcpart ) )
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
- shell quota slipip)
--} );
--
--if ( $svcnum ) {
- $error = $new->replace($old);
- my($error) = $new->replace($old);
- &idiot($error) if $error;
--} else {
- $error = $new->insert;
- $svcnum = $new->svcnum;
- my($error) = $new->insert;
- &idiot($error) if $error;
- $svcnum = $new->getfield('svcnum');
--}
--
- 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 );
-#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;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $
-# process/svc_acct_pop.cgi: Edit POP (process form)
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# 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 vars qw( $cgi $popnum $old $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::svc_acct_pop;
- use FS::CGI qw(popurl);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_pop qw(fields);
-use FS::CGI qw(eidiot);
--
- $cgi = new CGI; # create form object
-my($req)=new CGI::Request; # create form object
--
- &cgisuidsetup($cgi);
-&cgisuidsetup($req->cgi);
--
- $popnum = $cgi->param('popnum');
-my($popnum)=$req->param('popnum');
--
- $old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
-my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
--
- $new = new FS::svc_acct_pop ( {
-my($new)=create FS::svc_acct_pop ( {
-- map {
- $_, scalar($cgi->param($_));
- $_, $req->param($_);
-- } fields('svc_acct_pop')
--} );
--
--if ( $popnum ) {
- $error = $new->replace($old);
- my($error)=$new->replace($old);
- eidiot($error) if $error;
--} else {
- $error = $new->insert;
- my($error)=$new->insert;
- eidiot($error) if $error;
-- $popnum=$new->getfield('popnum');
- }
-
- 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");
--}
-$req->cgi->redirect("../../browse/svc_acct_pop.cgi");
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $
-# process/svc_acct_sm.cgi: Add/edit a mail alias (process form)
--#
--# 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
--#
--# enabled modifications
--#
--# ivan@voicenet.com 97-may-7
--#
--# fixed removal of cust_svc record on modifications!
--# ivan@voicenet.com 97-jun-5
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# 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 vars qw( $cgi $svcnum $old $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearchs fields);
-use FS::Record qw(qsearchs);
--use FS::svc_acct_sm;
- use FS::CGI qw(popurl);
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
--
- $cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
- $svcnum =$1;
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
--
- $old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
-my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
--
--#unmunge domsvc and domuid
- #$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] );
- #$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] );
-$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] );
-$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] );
--
- $new = new FS::svc_acct_sm ( {
-my($new) = create FS::svc_acct_sm ( {
-- map {
- ($_, scalar($cgi->param($_)));
- #} qw(svcnum pkgnum svcpart domuser domuid domsvc)
- } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) )
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
--} );
--
-my($error);
--if ( $svcnum ) {
-- $error = $new->replace($old);
--} else {
-- $error = $new->insert;
-- $svcnum = $new->getfield('svcnum');
--}
--
- if ($error) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string );
-unless ($error) {
- $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum");
--} else {
- print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum");
- 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
-
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_domain.cgi,v 1.7 2001-04-23 07:12:44 ivan Exp $
-# process/svc_domain.cgi: Add a domain (process form)
--#
--# 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
--#
--# kludged for new domain template 3.5
--# ivan@voicenet.com 97-jul-24
--#
--# moved internic bits to svc_domain.pm 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.7 2001-04-23 07:12:44 ivan
- # better error message (if kludgy) for no referral
- # remove outdated NSI foo from domain ordering. also, fuck NSI.
- #
- # 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 vars qw( $cgi $svcnum $new $error );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearchs fields);
-use FS::Record qw(qsearchs);
--use FS::svc_domain;
- use FS::CGI qw(popurl);
--
--#remove this to actually test the domains!
--$FS::svc_domain::whois_hack = 1;
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
--
- $cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
- $svcnum = $1;
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
--
- $new = new FS::svc_domain ( {
-my($new) = create FS::svc_domain ( {
-- map {
- $_, scalar($cgi->param($_));
- #} qw(svcnum pkgnum svcpart domain action purpose)
- } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) )
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart domain action purpose)
--} );
--
- if ($cgi->param('svcnum')) {
-my($error);
-if ($req->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')) {
-- $error="Can't modify a domain!";
--} else {
-- $error=$new->insert;
-- $svcnum=$new->svcnum;
--}
--
- if ($error) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string );
-unless ($error) {
- $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum");
--} else {
- print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
- 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
-
--}
-
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct.cgi,v 1.10 1999-04-14 11:27:06 ivan Exp $
-# svc_acct.cgi: Add/edit account (output form)
--#
--# 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
--#
--# 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
--#
--# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
- #
- # $Log: svc_acct.cgi,v $
- # Revision 1.10 1999-04-14 11:27:06 ivan
- # showpasswords config option to show passwords
- #
- # 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 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 CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup getotaker);
- use FS::CGI qw(header popurl);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::svc_acct;
- use FS::Conf;
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct qw(fields);
--
- $cgi = new CGI;
-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);
--
- $conf = new FS::Conf;
- @shells = $conf->config('shells');
-my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc);
--
- 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!";
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
- $svcnum=$1;
- $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct) 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;
--
- } else { #adding
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
--
- $svc_acct = new FS::svc_acct({});
- $action="Edit";
--
- 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;
-} else { #adding
--
- $svcnum='';
- $svc_acct=create FS::svc_acct({});
--
- #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')
- ) ;
- }
- 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;
--
- #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) );
- }
- }
- $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 = $svcnum ? 'Edit' : 'Add';
--
- $svc = $part_svc->getfield('svc');
- #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) );
- }
- }
--
- $otaker = getotaker;
- $action="Add";
--
- $username = $svc_acct->username;
- if ( $svc_acct->_password ) {
- if ( $conf->exists('showpasswords') ) {
- $password = $svc_acct->_password;
- } else {
- $password = "*HIDDEN*";
- }
- } else {
- $password = '';
--}
--
- $ulen = $svc_acct->dbdef_table->column('username')->length;
- $ulen2 = $ulen+2;
-my($svc)=$part_svc->getfield('svc');
--
- $p1 = popurl(1);
- print $cgi->header( '-expires' => 'now' ), header("$action $svc account");
-my($otaker)=getotaker;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-my($username,$password)=(
- $svc_acct->username,
- $svc_acct->_password ? "*HIDDEN*" : '',
-);
-
-my($ulen)=$svc_acct->dbdef_table->column('username')->length;
-my($ulen2)=$ulen+2;
--
-SendHeaders();
--print <<END;
- <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST>
-<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>
-- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
-- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
--Username:
--<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen>
--<BR>Password:
--<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
--(blank to generate)
--END
--
--#pop
- $popnum = $svc_acct->popnum || 0;
-my($popnum)=$svc_acct->popnum || 0;
--if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
--} else {
-- print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!;
-- my($svc_acct_pop);
-- foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
-- print "<OPTION", $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->ac, ")/",
-- $svc_acct_pop->exch, "\n"
-- ;
-- }
-- print "</SELECT>";
--}
--
- ($uid,$gid,$finger,$dir)=(
-my($uid,$gid,$finger,$dir)=(
-- $svc_acct->uid,
-- $svc_acct->gid,
-- $svc_acct->finger,
-- $svc_acct->dir,
--);
--
--print <<END;
--<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
--<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
--<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger">
--<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
--END
--
- $shell = $svc_acct->shell;
-my($shell)=$svc_acct->shell;
--if ( $part_svc->svc_acct__shell_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
--} else {
-- print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!;
-- my($etc_shell);
-- foreach $etc_shell (@shells) {
-- print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
-- $etc_shell, "\n";
-- }
-- print "</SELECT>";
--}
--
- ($quota,$slipip)=(
-my($quota,$slipip)=(
-- $svc_acct->quota,
-- $svc_acct->slipip,
--);
--
--print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
--
--if ( $part_svc->svc_acct__slipip_flag eq "F" ) {
-- print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
--} else {
-- print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!;
--}
--
--#submit
- print qq!<P><INPUT TYPE="submit" VALUE="Submit">!;
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_pop.cgi,v 1.9 2000-01-28 23:02:48 ivan Exp $
-# svc_acct_pop.cgi: Add/Edit pop (output form)
--#
--# ivan@sisd.com 98-mar-8
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
- #
- # $Log: svc_acct_pop.cgi,v $
- # Revision 1.9 2000-01-28 23:02:48 ivan
- # track full phone number
- #
- # 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 vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 );
- use CGI;
-use CGI::Base;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::CGI qw(header menubar popurl);
-use FS::Record qw(qsearch qsearchs);
--use FS::svc_acct_pop;
- $cgi = new CGI;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
--&cgisuidsetup($cgi);
--
- 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+)$/;
-SendHeaders(); # one guess.
-
-my($svc_acct_pop,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
-- $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
- $action='Edit';
--} else { #adding
- $svc_acct_pop = new FS::svc_acct_pop {};
- $svc_acct_pop=create FS::svc_acct_pop {};
- $action='Add';
--}
- $action = $svc_acct_pop->popnum ? 'Edit' : 'Add';
- $hashref = $svc_acct_pop->hashref;
-
- $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');
-my($hashref)=$svc_acct_pop->hashref;
--
- print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!;
-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
--
--#display
--
--print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
-- "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
--
--print <<END;
--<PRE>
--City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
- State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}">
-State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 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}">
- Local <INPUT TYPE="text" NAME="loc" SIZE=5 MAXLENGTH=4 VALUE="$hashref->{loc}">
--</PRE>
--END
--
--print qq!<BR><INPUT TYPE="submit" VALUE="!,
-- $hashref->{popnum} ? "Apply changes" : "Add POP",
-- qq!">!;
--
--print <<END;
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 ivan Exp $
-# svc_acct_sm.cgi: Add/edit a mail alias (output form)
--#
--# 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
--#
--# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum)
--#
--# ivan@voicenet.com 97-may-7
--#
--# fixed uid selection
--# ivan@voicenet.com 97-jun-4
--#
--# uid selection across _CUSTOMER_, not just _PACKAGE_
--#
--# ( i need to be rewritten with fast searches)
--#
--# ivan@voicenet.com 97-oct-3
--#
--# added fast searches in some of the places where it is sorely needed...
--# I see DBI::mysql in your future...
--# ivan@voicenet.com 97-oct-23
--#
--# 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 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 CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(header popurl);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::svc_acct_sm;
- use FS::Conf;
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_sm qw(fields);
--
- $cgi = new CGI;
-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);
--
- $conf = new FS::Conf;
- $mydomain = $conf->config('domain');
-SendHeaders(); # one guess.
--
- if ( $cgi->param('error') ) {
- $svc_acct_sm = new FS::svc_acct_sm ( {
- map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm')
- } );
- $svcnum = $svc_acct_sm->svcnum;
- $pkgnum = $cgi->param('pkgnum');
- $svcpart = $cgi->param('svcpart');
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
- } else {
- my($query) = $cgi->keywords;
- if ( $query =~ /^(\d+)$/ ) { #editing
- $svcnum=$1;
- $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct_sm) svcnum!";
-my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc);
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
- $svcnum=$1;
- $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct_sm) svcnum!";
--
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
--
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
--
- } else { #adding
- $action="Edit";
--
- $svc_acct_sm = new FS::svc_acct_sm({});
-} else { #adding
--
- foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
- }
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
- $svc_acct_sm=create FS::svc_acct_sm({});
--
- $svcnum='';
- 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;
--
- #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) );
- }
- }
- $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='Add';
-
--}
- $action = $svc_acct_sm->svcnum ? 'Edit' : 'Add';
--
-my(%username,%domain);
--if ($pkgnum) {
--
-- #find all possible uids (and usernames)
--
-- my($u_part_svc,@u_acct_svcparts);
-- foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
-- push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
-- }
--
-- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- my($custnum)=$cust_pkg->getfield('custnum');
-- my($i_cust_pkg);
-- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
-- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
-- my($acct_svcpart);
-- foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
-- #record(s) in cust_svc ( for this
-- #pkgnum ! )
-- my($i_cust_svc);
-- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
-- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
-- $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
-- }
-- }
-- }
--
-- #find all possible domains (and domsvc's)
--
-- my($d_part_svc,@d_acct_svcparts);
-- foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
-- push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
-- }
--
-- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
-- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
-- my($acct_svcpart);
-- foreach $acct_svcpart (@d_acct_svcparts) {
-- my($i_cust_svc);
-- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
-- my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
-- $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
-- }
-- }
-- }
--
--} elsif ( $action eq 'Edit' ) {
--
-- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
-- $username{$svc_acct_sm->uid} = $svc_acct->username;
--
-- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
-- $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
--
--} else {
-- die "\$action eq Add, but \$pkgnum is null!\n";
--}
-
- $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>!;
-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
--
--#display
--
-- #formatting
-- print "<PRE>";
--
--#svcnum
--print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
--print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
--
--#pkgnum
--print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
--
--#svcpart
--print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
--
- ($domuser,$domsvc,$domuid)=(
-my($domuser,$domsvc,$domuid)=(
-- $svc_acct_sm->domuser,
-- $svc_acct_sm->domsvc,
-- $svc_acct_sm->domuid,
--);
--
--#domuser
--print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
--
--#domsvc
--print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
--foreach $_ (keys %domain) {
- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "",
- qq! VALUE="$_">$domain{$_}!;
- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}";
--}
--print "</SELECT>";
--
--#uid
--print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
--foreach $_ (keys %username) {
- print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "",
- qq! VALUE="$_">$username{$_}!;
- print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}";
--}
--print "</SELECT>\@$mydomain mailbox.";
--
-- #formatting
-- print "</PRE>\n";
--
--print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
--
--print <<END;
--
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_domain.cgi,v 1.10 2001-04-23 07:12:44 ivan Exp $
-# svc_domain.cgi: Add domain (output form)
--#
--# 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
--# ivan@voicenet.com 97-jul-24
--#
--# rewrite ivan@sisd.com 98-mar-14
--#
--# no GOV in instructions ivan@sisd.com 98-jul-17
- #
- # $Log: svc_domain.cgi,v $
- # Revision 1.10 2001-04-23 07:12:44 ivan
- # better error message (if kludgy) for no referral
- # remove outdated NSI foo from domain ordering. also, fuck NSI.
- #
- # 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 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 CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup getotaker);
- use FS::CGI qw(header popurl);
- use FS::Record qw(qsearch qsearchs fields);
- use FS::svc_domain;
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_domain qw(fields);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
- 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!";
-my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc);
--
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
--
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
- $svcnum=$1;
- $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
- or die "Unknown (svc_domain) svcnum!";
--
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
- 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_domain = new FS::svc_domain({});
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_domain=create FS::svc_domain({});
--
- 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;
- 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='';
- $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';
--
- $svc = $part_svc->getfield('svc');
- $action="Add";
--
- $otaker = getotaker;
-}
--
- $domain = $svc_domain->domain;
-my($svc)=$part_svc->getfield('svc');
--
- $p1 = popurl(1);
- print $cgi->header( '-expires' => 'now' ), header("$action $svc", '');
-my($otaker)=getotaker;
--
- print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT>"
- if $cgi->param('error');
-my($domain)=(
- $svc_domain->domain,
-);
--
-SendHeaders();
--print <<END;
- <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST>
-<HTML>
- <HEAD>
- <TITLE>$action $svc</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>$action $svc</H1>
- </CENTER><HR>
- <FORM ACTION="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">
- 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!;
- <INPUT TYPE="radio" NAME="action" VALUE="N">New
- <BR><INPUT TYPE="radio" NAME="action" VALUE="M">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="$purpose" SIZE=64>
-<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64>
--<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
--<UL>
-- <LI>COM is for commercial, for-profit organziations
-- <LI>ORG is for miscellaneous, usually, non-profit organizations
-- <LI>NET is for network infrastructure machines and organizations
-- <LI>EDU is for 4-year, degree granting institutions
--<!-- <LI>GOV is for United States federal government agencies
--!-->
--</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>
--END
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>
-- Freeside Main Menu
-- </TITLE>
-- </HEAD>
-- <BODY BGCOLOR="#FFFFFF">
-- <table>
-- <tr><td>
-- <P ALIGN=CENTER>
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.png">
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.gif">
-- </td><td>
-- <center><font color="#ff0000" size=7>freeside main menu</font></center>
-- </td></tr>
-- </table>
-- <A HREF="http://www.sisd.com/freeside">
- Freeside home page
- Information
-- </A>
-- <BR><A HREF="docs/">
-- Documentation
-- </A>
-- </P>
-- <HR>
- <ul>
- <li><A HREF="edit/cust_main.cgi">New Customer</A>
- <li><A NAME="search">Search</A>
- <ul>
- <H3><A HREF="edit/cust_main.cgi">New Customer</A></H3>
- <A NAME="search"><H3>Search</H3></A>
- <MENU>
-- <LI><A HREF="search/cust_main.html">
-- customers (by last name and/or company)
-- </A>
-- <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
-- <LI><A HREF="search/svc_acct.html">accounts (by username)</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>
- </ul>
- <li><A NAME="browse">Browse</A>
- <ul>
- <LI>customers (<A HREF="search/cust_main.cgi?custnum">by customer number</A>) (<A HREF="search/cust_main.cgi?last">by last name</A>) (<A HREF="search/cust_main.cgi?company">by company</A>)
- <LI>invoices
- <UL>
- <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
- <LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
- <LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
- <LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
- <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>)
- <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
- </UL>
- <LI>packages
- <UL>
- <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
- </UL>
- <LI>services
- <UL>
- <LI>accounts (<A HREF="search/svc_acct.cgi?svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?username">by username</A>) (<A HREF="search/svc_acct.cgi?uid">by uid</A>)
- <LI>domains (<A HREF="search/svc_domain.cgi?svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?domain">by domain</A>)
- </UL>
- <LI>unlinked services
- <UL>
- <LI>unlinked accounts (<A HREF="search/svc_acct.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?UN_username">by username</A>) (<A HREF="search/svc_acct.cgi?UN_uid">by uid</A>)
- <LI>unlinked domains (<A HREF="search/svc_domain.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?UN_domain">by domain</A>)
- </UL>
- <LI><A HREF="browse/nas.cgi">NAS ports</A>
- </ul>
- <li><A NAME="admin">Administration</a>
- <ul>
- </MENU>
- <A NAME="browse"><H3>Browse</H3></A>
- <MENU>
- <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/cust_pkg.cgi?pkgnum">packages (by package number)</A>
- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
- <LI><A HREF="search/svc_acct.cgi?svcnum">accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?username">accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?uid">accounts (by uid)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_svcnum">unlinked accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_username">unlinked accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_uid">unlinked accounts (by uid)</A>
- <LI><A HREF="search/svc_domain.cgi?svcnum">domains (by service number)</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>
-- <LI><A HREF="browse/part_svc.cgi">
- View/Edit service definitions
- View/Edit services
-- </A>
-- - Services are items you offer to your customers.
-- <LI><A HREF="browse/part_pkg.cgi">
- View/Edit package definitions
- View/Edit packages
-- </A>
-- - One or more services are grouped together into a package and
-- given pricing information. Customers purchase packages, not
-- services.
-- <LI><A HREF="browse/agent_type.cgi">
-- View/Edit agent types
-- </A>
- - Agent types define groups of package definitions that you can
- then assign to particular agents.
- - Agent types define groups of packages 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 type).
- to a subset of your full offerings (via their agent type).
- <BR>
-- <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, or break down a country into states, or a state
- into counties and assign different tax rates to each.
- - Change tax rates by state, or break down a state into counties
- and assign different tax rates to each county.
- <BR>
-- <LI><A HREF="browse/svc_acct_pop.cgi">
-- View/Edit POPs
-- </A>
-- - Points of Presence
- </ul>
- </ul>
- </MENU>
- </FONT>
-- </BODY>
--</HTML>
+++ /dev/null
--#!/usr/bin/perl -Tw
- #
- # $Id: bill.cgi,v 1.5 1999-08-12 04:32:21 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.5 1999-08-12 04:32:21 ivan
- # hidecancelledcustomers
- #
- # 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 vars qw( $cgi $query $custnum $cust_main $error );
- use CGI;
-use CGI::Base qw(:DEFAULT :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_main;
-use FS::Bill;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint custnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d*)$/;
- $custnum = $1;
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
-$QUERY_STRING =~ /^(\d*)$/;
-my($custnum)=$1;
-my($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
-- );
- &eidiot($error) if $error;
-&idiot($error) if $error;
--
--$error = $cust_main->collect(
--# 'invoice-time'=>$time,
--# 'batch_card'=> 'yes',
-- 'batch_card'=> 'no',
-- 'report_badcard'=> 'yes',
-- );
- &eidiot($error) if $error;
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum");
-$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;
-
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cancel-unaudited.cgi,v 1.8 2001-04-09 23:05:16 ivan Exp $
-# cancel-unaudited.cgi: Cancel an unaudited account
--#
--# 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
--# ivan@voicenet.com 97-jul-21
--#
--# Search->Record, cgisuidsetup($cgi) ivan@sids.com 98-mar-19
--#
--# 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.8 2001-04-09 23:05:16 ivan
- # Transactions Part I!!!
- #
- # Revision 1.7 2000/06/15 12:30:37 ivan
- # bugfix from Jeff Finucane, thanks!
- #
- # 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 vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error $dbh );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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;
--
- $cgi = new CGI;
- $dbh = &cgisuidsetup($cgi);
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
--
--#untaint svcnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $svcnum = $1;
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
--
- $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
- die "Unknown svcnum!" unless $svc_acct;
-my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-&idiot("Unknown svcnum!") unless $svc_acct;
--
- $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') .
-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') .
-- qq!pkgnum"> package</A> instead.!)
- if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0';
- if $cust_svc->getfield('pkgnum') ne '';
--
--local $SIG{HUP} = 'IGNORE';
--local $SIG{INT} = 'IGNORE';
--local $SIG{QUIT} = 'IGNORE';
--local $SIG{TERM} = 'IGNORE';
--local $SIG{TSTP} = 'IGNORE';
--
- local $FS::UID::AutoCommit = 0;
-my($error);
--
-bless($svc_acct,"FS::svc_acct");
--$error = $svc_acct->cancel;
- &myeidiot($error) if $error;
-&idiot($error) if $error;
--$error = $svc_acct->delete;
- &myeidiot($error) if $error;
-&idiot($error) if $error;
--
-bless($cust_svc,"FS::cust_svc");
--$error = $cust_svc->delete;
- &myeidiot($error) if $error;
-
- $dbh->commit or die $dbh->errstr;
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2));
-$cgi->redirect("../");
--
- sub myeidiot {
- $dbh->rollback;
- &eidiot(@_);
-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;
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
-# cancel_pkg.cgi: Cancel a package
--#
--# 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.
--#
--# ivan@voicenet.com 97-jan-2
--#
--# still kludgy, but now runs /dbin/cancel $pkgnum
--# ivan@voicenet.com 97-feb-27
--#
--# doesn't run if pkgnum doesn't match regex
--# ivan@voicenet.com 97-mar-6
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# 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 vars qw ( $cgi $query $pkgnum $cust_pkg $error );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/ || die "Illegal pkgnum";
- $pkgnum = $1;
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
--
- $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
- $error = $cust_pkg->cancel;
- eidiot($error) if $error;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->cancel;
-idiot($error) if $error;
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $
-# expire_pkg.cgi: Expire a package
--#
--# 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
--#
--# ivan@sisd.com 98-mar-17 FS::Search->FS::Record
--#
--# 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;
-use CGI::Request;
--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;
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
--
--#untaint date & pkgnum
--
- if ( $cgi->param('date') ) {
- str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
-my($date);
-if ( $req->param('date') ) {
- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
-- $date=$1;
--} else {
-- $date='';
--}
--
- $cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
- $pkgnum = $1;
-$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
-my($pkgnum)=$1;
--
- $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- %hash = $cust_pkg->hash;
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my(%hash)=$cust_pkg->hash;
--$hash{expire}=$date;
- $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace($cust_pkg);
- &eidiot($error) if $error;
-my($new)=create FS::cust_pkg ( \%hash );
-my($error) = $new->replace($cust_pkg);
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-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;
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $
-# link: instead of adding a new account, link to an existing. (output form)
-#
-# Note: Should be run setuid freeside as user nobody
--#
--# 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 vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb
- $link_field );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl header);
--use FS::Record qw(qsearchs);
--
- %link_field = (
-my(%link_field)=(
-- 'svc_acct' => 'username',
-- 'svc_domain' => 'domain',
-- 'svc_acct_sm' => '',
-- 'svc_charge' => '',
-- 'svc_wo' => '',
--);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--cgisuidsetup($cgi);
--
- ($query) = $cgi->keywords;
- foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
-my($pkgnum,$svcpart);
-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});
- $svc = $part_svc->getfield('svc');
- $svcdb = $part_svc->getfield('svcdb');
- $link_field = $link_field{$svcdb};
-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};
--
- print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"),
- qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
-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
--
--if ( $link_field ) {
-- print <<END;
-- <INPUT TYPE="hidden" NAME="svcnum" VALUE="">
-- <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
-- $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
--END
--} else {
-- print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
--}
--
--print <<END;
--<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
--<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
--<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
-- </FORM>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/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 vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI);
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl);
--use FS::Record qw(qsearchs);
- use FS::cust_bill;
-use FS::Invoice;
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($lpr) = "|lpr -h";
--
- $conf = new FS::Conf;
- $lpr = $conf->config('lpr');
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
--
--#untaint invnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d*)$/;
- $invnum = $1;
- $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
-$QUERY_STRING =~ /^(\d*)$/;
-my($invnum)=$1;
-my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum});
--die "Can't find invoice!\n" unless $cust_bill;
--
- open(LPR,"|$lpr") or die "Can't open $lpr: $!";
- bless($cust_bill,"FS::Invoice");
- 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";
--
- $custnum = $cust_bill->getfield('custnum');
-my($custnum)=$cust_bill->getfield('custnum');
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
-$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;
-
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: link.cgi,v 1.6 2000-07-17 17:59:33 ivan Exp $
-# process/link.cgi: link to existing customer (process form)
--#
--# ivan@voicenet.com 97-feb-5
--#
--# rewrite ivan@sisd.com 98-mar-18
--#
--# Changes to allow page to work at a relative position in server
--# 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.6 2000-07-17 17:59:33 ivan
- # oops
- #
- # Revision 1.5 1999/04/15 14:09:17 ivan
- # get rid of top-level my() variables
- #
- # 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 vars qw ( $cgi $old $new $error $pkgnum $svcpart $svcnum );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
- use FS::CGI qw(popurl idiot eidiot);
-use FS::CGI qw(idiot);
--use FS::UID qw(cgisuidsetup);
--use FS::cust_svc;
--use FS::Record qw(qsearchs);
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
--
- $cgi->param('pkgnum') =~ /^(\d+)$/;
- $pkgnum = $1;
- $cgi->param('svcpart') =~ /^(\d+)$/;
- $svcpart = $1;
- $cgi->param('svcnum') =~ /^(\d*)$/;
- $svcnum = $1;
-#$req->import_names('R'); #import CGI variables into package 'R';
-
-$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
-$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
--
-$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
--unless ( $svcnum ) {
-- my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
-- my($svcdb) = $part_svc->getfield('svcdb');
- $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;
- $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;
-- $svcnum=$svc_acct->svcnum;
--}
--
- $old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
--die "svcnum not found!" unless $old;
- $new = new FS::cust_svc ({
-my($new)=create 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.
- print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum");
- $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum");
--} else {
- idiot($error);
- 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
-
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
-# susp_pkg.cgi: Suspend a package
--#
--# 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
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
--#
--# 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 vars qw( $cgi $query $pkgnum $cust_pkg $error );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/ || die "Illegal pkgnum";
- $pkgnum = $1;
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
--
- $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
- $error = $cust_pkg->suspend;
- &eidiot($error) if $error;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->suspend;
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-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;
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $
-# susp_pkg.cgi: Unsuspend a package
--#
--# 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
--#
--# now redirects to enter comments
--# ivan@voicenet.com 97-may-8
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-21
--#
--# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
--#
--# 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 vars qw( $cgi $query $pkgnum $cust_pkg $error );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint pkgnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/ || die "Illegal pkgnum";
- $pkgnum = $1;
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
--
- $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--
- $error = $cust_pkg->unsuspend;
- &eidiot($error) if $error;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->unsuspend;
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-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;
-}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_bill.cgi,v 1.6 2001-04-22 01:38:39 ivan Exp $
-# cust_bill.cgi: Search for invoices (process form)
--#
--# 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.6 2001-04-22 01:38:39 ivan
- # svc_domain needs to import dbh sub from Record
- # view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field
- # search/cust_bill.cgi redirect error when there's only one invoice
- #
- # Revision 1.5 2000/07/17 16:45:41 ivan
- # first shot at invoice browsing and some other cleanups
- #
- # 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 vars qw ( $cgi $invnum $query $sortby @cust_bill );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
- use Date::Format;
-use CGI::Request;
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl header menubar eidiot table );
- use FS::Record qw(qsearch qsearchs);
- use FS::cust_bill;
- use FS::cust_main;
-
- $cgi = new CGI;
- cgisuidsetup($cgi);
-
- if ( $cgi->keywords ) {
- my($query) = $cgi->keywords;
- if ( $query eq 'invnum' ) {
- $sortby = \*invnum_sort;
- @cust_bill = qsearch('cust_bill', {} );
- } elsif ( $query eq 'date' ) {
- $sortby = \*date_sort;
- @cust_bill = qsearch('cust_bill', {} );
- } elsif ( $query eq 'custnum' ) {
- $sortby = \*custnum_sort;
- @cust_bill = qsearch('cust_bill', {} );
- } elsif ( $query eq 'OPEN_invnum' ) {
- $sortby = \*invnum_sort;
- @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
- } elsif ( $query eq 'OPEN_date' ) {
- $sortby = \*date_sort;
- @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
- } elsif ( $query eq 'OPEN_custnum' ) {
- $sortby = \*custnum_sort;
- @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
- } elsif ( $query =~ /^OPEN(\d+)_invnum$/ ) {
- my $open = $1 * 86400;
- $sortby = \*invnum_sort;
- @cust_bill =
- grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
- } elsif ( $query =~ /^OPEN(\d+)_date$/ ) {
- my $open = $1 * 86400;
- $sortby = \*date_sort;
- @cust_bill =
- grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
- } elsif ( $query =~ /^OPEN(\d+)_custnum$/ ) {
- my $open = $1 * 86400;
- $sortby = \*custnum_sort;
- @cust_bill =
- grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
- } else {
- die "unknown query string $query";
- }
- } else {
- $cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
- $invnum = $2;
- @cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum } );
- $sortby = \*invnum_sort;
- }
-
- if ( scalar(@cust_bill) == 1 ) {
- my $invnum = $cust_bill[0]->invnum;
- print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect
- } elsif ( scalar(@cust_bill) == 0 ) {
- eidiot("Invoice not found.");
- } else {
- my $total = scalar(@cust_bill);
- print $cgi->header( '-expires' => 'now' ),
- &header("Invoice Search Results", menubar(
- 'Main Menu', popurl(2)
- )), "$total matching invoices found<BR>", &table(), <<END;
- <TR>
- <TH></TH>
- <TH>Balance</TH>
- <TH>Amount</TH>
- <TH>Date</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
- END
-
- my(%saw, $cust_bill);
- foreach $cust_bill (
- sort $sortby grep(!$saw{$_->invnum}++, @cust_bill)
- ) {
- my($invnum, $owed, $charged, $date ) = (
- $cust_bill->invnum,
- $cust_bill->owed,
- $cust_bill->charged,
- $cust_bill->_date,
- );
- my $pdate = time2str("%b %d %Y", $date);
-
- my $rowspan = 1;
-use FS::Record qw(qsearchs);
--
- my $view = popurl(2). "view/cust_bill.cgi?$invnum";
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$invnum</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>\$$owed</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>\$$charged</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$pdate</FONT></A></TD>
- END
- my $custnum = $cust_bill->custnum;
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
- if ( $cust_main ) {
- my $cview = popurl(2). "view/cust_main.cgi?". $cust_main->custnum;
- my ( $name, $company ) = (
- $cust_main->last. ', '. $cust_main->first,
- $cust_main->company,
- );
- print <<END;
- <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$name</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$company</FONT></A></TD>
- END
- } else {
- print <<END
- <TD ROWSPAN=$rowspan COLSPAN=2>WARNING: couldn't find cust_main.custnum $custnum (cust_bill.invnum $invnum)</TD>
- END
- }
-my($req)=new CGI::Request;
-cgisuidsetup($req->cgi);
--
- print "</TR>";
- }
-$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
-my($invnum)=$2;
--
-if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
- $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect
-} else { #error
- CGI::Base::SendHeaders(); # one guess
-- print <<END;
- </TABLE>
-<HTML>
- <HEAD>
- <TITLE>Invoice Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Invoice Search Error</H3>
- <HR>
- Invoice not found.
- </CENTER>
-- </BODY>
--</HTML>
--END
-
- }
-
- #
-
- sub invnum_sort {
- $a->invnum <=> $b->invnum;
- }
--
- sub custnum_sort {
- $a->custnum <=> $b->custnum || $a->invnum <=> $b->invnum;
--}
--
- sub date_sort {
- $a->_date <=> $b->_date || $a->invnum <=> $b->invnum;
- }
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Invoice Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Invoice Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="cust_bill.cgi" METHOD="post">
-- Search for <B>invoice #</B>:
-- <INPUT TYPE="text" NAME="invnum">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Customer Search</TITLE>
-- </HEAD>
- <BODY BGCOLOR="#ffffff">
- <FONT COLOR="#ff0000" SIZE=7>
- Customer Search
- </FONT>
- <BR>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
-- <FORM ACTION="cust_main.cgi" METHOD="post">
-- Search for <B>Credit card #</B>:
-- <INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
-- <INPUT TYPE="text" NAME="card">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main.cgi,v 1.16 2001-02-07 19:45:45 ivan Exp $
-# process/cust_main.cgi: Search for customers (process form)
--#
--# 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
--#
--# now does browsing too ivan@sisd.com 98-mar-6
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# display total, use FS::CGI ivan@sisd.com 98-jul-17
- #
- # $Log: cust_main.cgi,v $
- # Revision 1.16 2001-02-07 19:45:45 ivan
- # tyop
- #
- # Revision 1.15 2000/07/17 16:45:41 ivan
- # first shot at invoice browsing and some other cleanups
- #
- # Revision 1.14 1999/08/12 04:45:21 ivan
- # typo - missed a paren
- #
- # Revision 1.13 1999/08/12 04:32:21 ivan
- # hidecancelledcustomers
- #
- # Revision 1.12 1999/07/17 10:38:52 ivan
- # scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
- # gave me a great bugreport at the last rhythmethod
- #
- # 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 vars qw( $conf %ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby );
- use vars qw( $conf %all_pkgs $cgi @cust_main $sortby );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use IO::Handle;
- use String::Approx qw(amatch);
-use IPC::Open2;
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header menubar eidiot popurl table);
- use FS::cust_main;
-use FS::CGI qw(header idiot);
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep
- #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!)
--
- $conf = new FS::Conf;
-my($req)=new CGI::Request;
-&cgisuidsetup($req->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 {
- die "unknown query string $query";
- }
- } else {
- @cust_main=();
- &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') );
- }
-my(@cust_main);
-my($sortby);
--
- @cust_main = grep { $_->ncancelled_pkgs || ! $_->all_pkgs } @cust_main
- if $conf->exists('hidecancelledcustomers');
- if ( $conf->exists('hidecancelledpackages' ) ) {
- %all_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main;
-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',{});
--} else {
- %all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main;
- &cardsearch if ($req->param('card_on') );
- &lastsearch if ($req->param('last_on') );
- &companysearch if ($req->param('company_on') );
--}
--
--if ( scalar(@cust_main) == 1 ) {
- print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum);
- $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum);
-- exit;
--} elsif ( scalar(@cust_main) == 0 ) {
- eidiot "No matching customers found!\n";
- idiot "No matching customers found!\n";
- exit;
--} else {
--
-- my($total)=scalar(@cust_main);
- print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar(
- 'Main Menu', popurl(2)
- )), "$total matching customers found<BR>", &table(), <<END;
- CGI::Base::SendHeaders(); # one guess
- print header("Customer Search Results",''), <<END;
-
- $total matching customers found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
- <TH></TH>
- <TH>Cust. #</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)
-- ) {
-- my($custnum,$last,$first,$company)=(
-- $cust_main->custnum,
-- $cust_main->getfield('last'),
-- $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 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>
- <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
-
- 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>";
- 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>
-END
-- }
- print "</TR>";
-- }
--
-- print <<END;
-- </TABLE>
- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
--#
--
--sub last_sort {
-- $a->getfield('last') cmp $b->getfield('last');
--}
--
--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 custnum_sort {
-- $a->getfield('custnum') <=> $b->getfield('custnum');
--}
--
--sub cardsearch {
--
- my($card)=$cgi->param('card');
- my($card)=$req->param('card');
-- $card =~ s/\D//g;
- $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n";
- $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; };
-- my($payinfo)=$1;
--
-- push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
--
--}
--
--sub lastsearch {
-- my(%last_type);
- foreach ( $cgi->param('last_type') ) {
- foreach ( $req->param('last_type') ) {
-- $last_type{$_}++;
-- }
--
- $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/
- or eidiot "Illegal last name";
- $req->param('last_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal last name"; exit; };
-- my($last)=$1;
--
-- if ( $last_type{'Exact'}
-- && ! $last_type{'Fuzzy'}
-- # && ! $last_type{'Sound-alike'}
-- ) {
--
-- push @cust_main, qsearch('cust_main',{'last'=>$last});
--
-- } else {
--
-- my(%last);
--
-- my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
-- if ($last_type{'Fuzzy'}) {
- foreach ( amatch($last, [ qw(i) ], @all_last) ) {
- $last{$_}++;
- }
- 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;
-- }
--
-- #if ($last_type{'Sound-alike'}) {
-- #}
--
-- foreach ( keys %last ) {
-- push @cust_main, qsearch('cust_main',{'last'=>$_});
-- }
--
-- }
-- $sortby=\*last_sort;
--}
--
--sub companysearch {
--
-- my(%company_type);
- foreach ( $cgi->param('company_type') ) {
- foreach ( $req->param('company_type') ) {
-- $company_type{$_}++
-- };
--
- $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or eidiot "Illegal company";
- $req->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal company"; exit; };
-- my($company)=$1;
--
-- if ( $company_type{'Exact'}
-- && ! $company_type{'Fuzzy'}
-- # && ! $company_type{'Sound-alike'}
-- ) {
--
-- push @cust_main, qsearch('cust_main',{'company'=>$company});
--
-- } else {
--
-- my(%company);
-- my(@all_company)=map $_->company, qsearch('cust_main',{});
--
-- if ($company_type{'Fuzzy'}) {
- foreach ( amatch($company, [ qw(i) ], @all_company ) ) {
- 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;
-- $company{$_}++;
-- }
- close $reader;
-- }
--
-- #if ($company_type{'Sound-alike'}) {
-- #}
--
-- foreach ( keys %company ) {
-- push @cust_main, qsearch('cust_main',{'company'=>$_});
-- }
--
-- }
-- $sortby=\*company_sort;
--
--}
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Customer Search</TITLE>
-- </HEAD>
- <BODY BGCOLOR="#ffffff">
- <FONT COLOR="#ff0000" SIZE=7>
- Customer Search
- </FONT>
- <BR>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
-- <FORM ACTION="cust_main.cgi" METHOD="post">
- <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
-- <INPUT TYPE="text" NAME="last_text">
- using search method: <SELECT NAME="last_type">
- using search method(s): <SELECT NAME="last_type" MULTIPLE>
-- <OPTION SELECTED>Fuzzy
-- <OPTION>Exact
-- </SELECT>
--
- <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
-- <INPUT TYPE="text" NAME="company_text">
- using search methods: <SELECT NAME="company_type">
- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
-- <OPTION SELECTED>Fuzzy
-- <OPTION>Exact
-- </SELECT>
--
-- <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
--
-- </FORM>
--
-- <HR>Explanation of search methods:
-- <UL>
-- <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
-- <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
-- </UL>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pkg.cgi,v 1.11 2000-07-17 16:45:41 ivan Exp $
-# cust_pkg.cgi: search/browse for packages
--#
--# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
- #
- # $Log: cust_pkg.cgi,v $
- # Revision 1.11 2000-07-17 16:45:41 ivan
- # first shot at invoice browsing and some other cleanups
- #
- # Revision 1.10 2000/07/17 12:49:29 ivan
- # better error message if a package isn't linked to a customer (that shouldn't happen)
- #
- # Revision 1.9 1999/07/17 10:38:52 ivan
- # scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
- # gave me a great bugreport at the last rhythmethod
- #
- # 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 vars qw ( $cgi @cust_pkg $sortby $query );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header eidiot popurl);
- use FS::cust_pkg;
- use FS::pkg_svc;
- use FS::cust_svc;
- use FS::cust_main;
-use FS::CGI qw(header idiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
--
- ($query) = $cgi->keywords;
-my(@cust_pkg,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
--#this tree is a little bit redundant
--if ( $query eq 'pkgnum' ) {
-- $sortby=\*pkgnum_sort;
-- @cust_pkg=qsearch('cust_pkg',{});
--} elsif ( $query eq 'APKG_pkgnum' ) {
-- $sortby=\*pkgnum_sort;
- @cust_pkg=();
-
-- #perhaps this should go in cust_pkg as a qsearch-like constructor?
-- my($cust_pkg);
-- foreach $cust_pkg (qsearch('cust_pkg',{})) {
-- my($flag)=0;
-- my($pkg_svc);
-- PKG_SVC:
-- foreach $pkg_svc (qsearch('pkg_svc',{ 'pkgpart' => $cust_pkg->pkgpart })) {
-- if ( $pkg_svc->quantity
-- > scalar(qsearch('cust_svc',{
-- 'pkgnum' => $cust_pkg->pkgnum,
-- 'svcpart' => $pkg_svc->svcpart,
-- }))
-- )
-- {
-- $flag=1;
-- last PKG_SVC;
-- }
-- }
-- push @cust_pkg, $cust_pkg if $flag;
-- }
--} else {
-- die "Empty QUERY_STRING!";
--}
--
--if ( scalar(@cust_pkg) == 1 ) {
-- my($pkgnum)=$cust_pkg[0]->pkgnum;
- print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum");
- $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum");
-- exit;
--} elsif ( scalar(@cust_pkg) == 0 ) { #error
- eidiot("No packages found");
- &idiot("No packages found");
- exit;
--} else {
-- my($total)=scalar(@cust_pkg);
- print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END;
- CGI::Base::SendHeaders(); # one guess
- print header('Package Search Results',''), <<END;
-- $total matching packages found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Package #</TH>
-- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>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)
-- ) {
-- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
-- my($pkgnum,$custnum,$name,$company)=(
-- $cust_pkg->pkgnum,
- $cust_pkg->custnum,
- $cust_main ? $cust_main->last. ', '. $cust_main->first : '',
- $cust_main ? $cust_main->company : '',
- $cust_main->custnum,
- $cust_main->last. ', '. $cust_main->first,
- $cust_main->company,
-- );
- my $p = popurl(2);
-- print <<END;
-- <TR>
- <TD><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
- END
- if ( $cust_main ) {
- print <<END;
- <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>
- <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>
-- </TR>
--END
- } else {
- print <<END;
- <TD COLSPAN=3>WARNING: couldn't find cust_main.custnum $custnum (cust_pkg.pkgnum $pkgnum)</TD>
- 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
-- exit;
--
--}
--
--sub pkgnum_sort {
-- $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
--}
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct.cgi,v 1.11 1999-04-14 11:25:33 ivan Exp $
-# svc_acct.cgi: Search for customers (process form)
--#
--# Usage: post form to:
--# http://server.name/path/svc_acct.cgi
--#
--# Note: Should be run setuid freeside as user nobody.
--#
--# loosely (sp?) based on search/cust_main.cgi
--#
--# ivan@voicenet.com 96-jan-3 -> 96-jan-4
--#
--# rewrite (now does browsing too) ivan@sisd.com 98-mar-9
--#
--# Changes to allow page to work at a relative position in server
--# bmccane@maxbaud.net 98-apr-3
--#
--# show unlinked accounts ivan@sisd.com 98-jun-22
--#
--# 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.11 1999-04-14 11:25:33 ivan
- # *** empty log message ***
- #
- # Revision 1.10 1999/04/14 11:20:21 ivan
- # visual fix
- #
- # 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 vars qw( $cgi @svc_acct $sortby $query );
- use CGI;
-use CGI::Request; # form processing module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header eidiot popurl table);
- use FS::svc_acct;
- use FS::cust_main;
-use FS::CGI qw(header idiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
--
- ($query)=$cgi->keywords;
- $query ||= ''; #to avoid use of unitialized value errors
-my(@svc_acct,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
--#this tree is a little bit redundant
--if ( $query eq 'svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_acct=qsearch('svc_acct',{});
--} elsif ( $query eq 'username' ) {
-- $sortby=\*username_sort;
-- @svc_acct=qsearch('svc_acct',{});
--} elsif ( $query eq 'uid' ) {
-- $sortby=\*uid_sort;
-- @svc_acct=grep $_->uid ne '', qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_username' ) {
-- $sortby=\*username_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} elsif ( $query eq 'UN_uid' ) {
-- $sortby=\*uid_sort;
-- @svc_acct = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_acct',{});
--} else {
- $sortby=\*uid_sort;
-- &usernamesearch;
--}
--
--if ( scalar(@svc_acct) == 1 ) {
-- my($svcnum)=$svc_acct[0]->svcnum;
- print $cgi->redirect(popurl(2). "view/svc_acct.cgi?$svcnum"); #redirect
- $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect
-- exit;
--} elsif ( scalar(@svc_acct) == 0 ) { #error
- eidiot("Account not found");
- idiot("Account not found");
- exit;
--} else {
-- my($total)=scalar(@svc_acct);
- print $cgi->header( '-expires' => 'now' ),
- header("Account Search Results",''),
- "$total matching accounts found",
- &table(), <<END;
- CGI::Base::SendHeaders(); # one guess
- print header("Account Search Results",''), <<END;
- $total matching accounts found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
- <TH><FONT SIZE=-1>Service #</FONT></TH>
- <TH><FONT SIZE=-1>Username</FONT></TH>
- <TH><FONT SIZE=-1>UID</FONT></TH>
- <TH><FONT SIZE=-1>Service</FONT></TH>
- <TH><FONT SIZE=-1>Customer #</FONT></TH>
- <TH><FONT SIZE=-1>Contact name</FONT></TH>
- <TH><FONT SIZE=-1>Company</FONT></TH>
- <TH>Service #</TH>
- <TH>Username</TH>
- <TH>UID</TH>
- <TH>Service</TH>
- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
-- </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)
-- ) {
-- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct->svcnum })
-- or die "No cust_svc record for svcnum ". $svc_acct->svcnum;
-- my $part_svc = qsearchs('part_svc', { 'svcpart' => $cust_svc->svcpart })
-- or die "No part_svc record for svcpart ". $cust_svc->svcpart;
-- my($cust_pkg,$cust_main);
-- if ( $cust_svc->pkgnum ) {
-- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc->pkgnum })
-- or die "No cust_pkg record for pkgnum ". $cust_svc->pkgnum;
-- $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg->custnum })
-- or die "No cust_main record for custnum ". $cust_pkg->custnum;
-- }
-- my($svcnum,$username,$uid,$svc,$custnum,$last,$first,$company)=(
-- $svc_acct->svcnum,
-- $svc_acct->getfield('username'),
-- $svc_acct->getfield('uid'),
-- $part_svc->svc,
-- $cust_svc->pkgnum ? $cust_main->custnum : '',
-- $cust_svc->pkgnum ? $cust_main->getfield('last') : '',
-- $cust_svc->pkgnum ? $cust_main->getfield('first') : '',
-- $cust_svc->pkgnum ? $cust_main->company : '',
-- );
-- my($pcustnum) = $custnum
- ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
- ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
-- : "<I>(unlinked)</I>"
-- ;
- 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>" : '';
- my($pname) = $custnum ? "$last, $first" : '';
-- print <<END;
-- <TR>
- <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
- <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$username</FONT></A></TD>
- <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$uid</FONT></A></TD>
- <TD><A HREF="../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>$pcompany</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>
- </TR>
-END
- }
-- }
--
-- print <<END;
-- </TABLE>
-- </CENTER>
-- </BODY>
--</HTML>
--END
-- exit;
--
--}
--
--sub svcnum_sort {
-- $a->getfield('svcnum') <=> $b->getfield('svcnum');
--}
--
--sub username_sort {
-- $a->getfield('username') cmp $b->getfield('username');
--}
--
--sub uid_sort {
-- $a->getfield('uid') <=> $b->getfield('uid');
--}
--
--sub usernamesearch {
--
- $cgi->param('username') =~ /^([\w\d\-]+)$/; #untaint username_text
- $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text
-- my($username)=$1;
--
-- @svc_acct=qsearch('svc_acct',{'username'=>$username});
--
--}
--
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Account Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Account Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_acct.cgi" METHOD="post">
-- Search for <B>username</B>:
-- <INPUT TYPE="text" NAME="username">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_sm.cgi,v 1.10 1999-07-20 06:03:36 ivan Exp $
-# svc_acct_sm.cgi: Search for domains (process form)
--#
--# 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
--#
--# ivan@voicenet.com
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# 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.10 1999-07-20 06:03:36 ivan
- # s/CGI::Request/CGI/; (how'd i miss that before?)
- #
- # 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;
-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;
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-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;
--
- $conf = new FS::Conf;
- $mydomain = $conf->config('domain');
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
--
- $cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
- $domuser = $1;
-$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
-my($domuser)=$1;
--
- $cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
- $svc_domain = qsearchs('svc_domain',{'domain'=>$1})
-$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
-my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
-- or die "Unknown domain";
- $domsvc = $svc_domain->svcnum;
-my($domsvc)=$svc_domain->svcnum;
--
-my(@svc_acct_sm);
--if ($domuser) {
-- @svc_acct_sm=qsearch('svc_acct_sm',{
-- 'domuser' => $domuser,
-- 'domsvc' => $domsvc,
-- });
--} else {
-- @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
--}
--
--if ( scalar(@svc_acct_sm) == 1 ) {
-- my($svcnum)=$svc_acct_sm[0]->svcnum;
- print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum");
- $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect
--} elsif ( scalar(@svc_acct_sm) > 1 ) {
- print $cgi->header( '-expires' => 'now' ),
- header('Mail Alias Search Results'),
- &table(), <<END;
- 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>
-- <TR>
- <TH>Mail to<BR><FONT SIZE=-1>(click to view mail alias)</FONT></TH>
- <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
- <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>
-- </TR>
--END
--
-- my($svc_acct_sm);
-- foreach $svc_acct_sm (@svc_acct_sm) {
-- my($svcnum,$domuser,$domuid,$domsvc)=(
-- $svc_acct_sm->svcnum,
-- $svc_acct_sm->domuser,
-- $svc_acct_sm->domuid,
-- $svc_acct_sm->domsvc,
-- );
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
- 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;
--
- my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } );
- if ( $svc_domain ) {
- my $domain = $svc_domain->domain;
- print <<END;
-<TR>\n <TD> <A HREF="../view/svc_acct_sm.cgi?$svcnum">
-END
--
- 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>";
- }
- print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
--
- 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;
-\@$domain</A> </TD>\n
-<TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n </TR>\n
-END
--
-- }
--
- print '</TABLE></BODY></HTML>';
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
--
--} else { #error
- idiot("Mail Alias not found");
- 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
-
--}
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Mail Alias Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Mail Alias Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
-- Search for <B>mail alias</B>:
-- <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
-- <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
--
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_domain.cgi,v 1.11 2000-03-03 18:22:44 ivan Exp $
-# svc_domain.cgi: Search for domains (process form)
--#
--# 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
--#
--# Changes to allow page to work at a relative position in server
--# 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.11 2000-03-03 18:22:44 ivan
- # changes from 1.2.3 release, fixes from webdemo
- #
- # Revision 1.10 1999/07/17 10:38:52 ivan
- # scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
- # gave me a great bugreport at the last rhythmethod
- #
- # Revision 1.9 1999/04/15 13:39:16 ivan
- # $cgi->header( '-expires' => 'now' )
- #
- # 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 vars qw ( $cgi @svc_domain $sortby $query $conf $mydomain );
- use CGI;
-use CGI::Request;
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
--use FS::Record qw(qsearch qsearchs);
- use FS::CGI qw(header eidiot popurl);
- use FS::svc_domain;
- use FS::cust_svc;
- use FS::svc_acct_sm;
- use FS::svc_acct;
-use FS::CGI qw(header idiot);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
--
- $conf = new FS::Conf;
- $mydomain = $conf->config('domain');
-my(@svc_domain);
-my($sortby);
--
- ($query)=$cgi->keywords;
- $query ||= ''; #to avoid use of unitialized value errors
-my($query)=$req->cgi->var('QUERY_STRING');
--if ( $query eq 'svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_domain=qsearch('svc_domain',{});
--} elsif ( $query eq 'domain' ) {
-- $sortby=\*domain_sort;
-- @svc_domain=qsearch('svc_domain',{});
--} elsif ( $query eq 'UN_svcnum' ) {
-- $sortby=\*svcnum_sort;
-- @svc_domain = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_domain',{});
--} elsif ( $query eq 'UN_domain' ) {
-- $sortby=\*domain_sort;
-- @svc_domain = grep qsearchs('cust_svc',{
-- 'svcnum' => $_->svcnum,
-- 'pkgnum' => '',
-- }), qsearch('svc_domain',{});
--} else {
- $cgi->param('domain') =~ /^([\w\-\.]+)$/;
- $req->param('domain') =~ /^([\w\-\.]+)$/;
-- my($domain)=$1;
- #push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
- @svc_domain = qsearchs('svc_domain',{'domain'=>$domain});
- push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
--}
--
--if ( scalar(@svc_domain) == 1 ) {
- print $cgi->redirect(popurl(2). "view/svc_domain.cgi?". $svc_domain[0]->svcnum);
- $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum);
-- exit;
--} elsif ( scalar(@svc_domain) == 0 ) {
- eidiot "No matching domains found!\n";
- idiot "No matching domains found!\n";
- exit;
--} else {
- CGI::Base::SendHeaders(); # one guess
--
-- my($total)=scalar(@svc_domain);
- print $cgi->header( '-expires' => 'now' ),
- header("Domain Search Results",''), <<END;
- CGI::Base::SendHeaders(); # one guess
- print header("Domain Search Results",''), <<END;
--
-- $total matching domains found
-- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
-- <TR>
-- <TH>Service #</TH>
-- <TH>Domain</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>
- <TH></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)
-- ) {
-- my($svcnum,$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 @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $svcnum});
- my $rowspan = scalar(@svc_acct_sm) || 1;
-
- 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='';
- }
-- print <<END;
-- <TR>
- <TD ROWSPAN=$rowspan><A HREF="${p}view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
- <TD ROWSPAN=$rowspan>$domain</TD>
- <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
-
- 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>";
- 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>
-END
-- }
- #end of false laziness
- print "</TR>";
-
-- }
--
-- print <<END;
-- </TABLE>
- </CENTER>
-- </BODY>
--</HTML>
--END
--
--}
--
--sub svcnum_sort {
-- $a->getfield('svcnum') <=> $b->getfield('svcnum');
--}
--
--sub domain_sort {
-- $a->getfield('domain') cmp $b->getfield('doimain');
--}
--
--
+++ /dev/null
--<HTML>
-- <HEAD>
-- <TITLE>Domain Search</TITLE>
-- </HEAD>
-- <BODY>
-- <CENTER>
-- <H1>Domain Search</H1>
-- </CENTER>
-- <HR>
-- <FORM ACTION="svc_domain.cgi" METHOD="post">
-- Search for <B>domain</B>:
-- <INPUT TYPE="text" NAME="domain">
--
-- <P><INPUT TYPE="submit" VALUE="Search">
--
-- </FORM>
--
-- <HR>
--
-- </BODY>
--</HTML>
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_bill.cgi,v 1.8 1999-02-28 00:03:58 ivan Exp $
-# Usage: cust_bill.cgi invnum
-# http://server.name/path/cust_bill.cgi?invnum
-#
-# Note: Should be run setuid freeside as user nobody.
--#
--# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
--#
--# ivan@voicenet.com 96-dec-05
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# now uses Invoice.pm
--# ivan@voicenet.com 97-jun-30
--#
--# what to do if cust_bill search errors?
--# ivan@voicenet.com 97-jul-7
--#
--# s/FS::Search/FS::Record/; $cgisuidsetup($cgi); ivan@sisd.com 98-mar-14
--#
--# Changes to allow page to work at a relative position in server
--# 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;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--use CGI::Carp qw(fatalsToBrowser);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(header popurl menubar);
--use FS::Record qw(qsearchs);
- use FS::cust_bill;
-use FS::Invoice;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
--
--#untaint invnum
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $invnum = $1;
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
--
- $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
-my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum});
--die "Invoice #$invnum not found!" unless $cust_bill;
- $custnum = $cust_bill->getfield('custnum');
-my($custnum) = $cust_bill->getfield('custnum');
--
- $printed = $cust_bill->printed;
-my($printed) = $cust_bill->printed;
--
- $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>
-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>
-- <BR><BR>(Printed $printed times)
- <PRE>
- </CENTER>
- <FONT SIZE=-1><PRE>
--END
--
-bless($cust_bill,"FS::Invoice");
--print $cust_bill->print_text;
--
-- #formatting
-- print <<END;
-- </PRE></FONT>
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_main.cgi,v 1.19 2001-04-22 01:38:39 ivan Exp $
-# cust_main.cgi: View a customer
--#
--# 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
--#
--# added navigation bar (go to main menu ;)
--# ivan@voicenet.com 97-jan-30
--#
--# changes to the way credits/payments are applied (the links are here).
--# ivan@voicenet.com 97-apr-21
--#
--# added debugging code to diagnose CPU sucking problem.
--# ivan@voicenet.com 97-may-19
--#
--# CPU sucking problem was in comment code? fixed?
--# ivan@voicenet.com 97-may-22
--#
--# rewrote for new API
--# ivan@voicenet.com 97-jul-22
--#
--# 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
--#
--# lose background, FS::CGI ivan@sisd.com 98-sep-2
- #
- # $Log: cust_main.cgi,v $
- # Revision 1.19 2001-04-22 01:38:39 ivan
- # svc_domain needs to import dbh sub from Record
- # view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field
- # search/cust_bill.cgi redirect error when there's only one invoice
- #
- # Revision 1.18 1999/08/12 04:16:01 ivan
- # hidecancelledpackages config option
- #
- # Revision 1.17 1999/04/15 16:44:36 ivan
- # delete customers
- #
- # 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 vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral
- @packages $package @history @bills $bill @credits $credit
- $balance $item @agents @referrals @invoicing_list $n1 $conf );
- use CGI;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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 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;
-use FS::CGI qw(header menubar);
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--&cgisuidsetup($cgi);
-
- $conf = new FS::Conf;
--
- print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar(
- 'Main Menu' => popurl(2)
- ));
-SendHeaders(); # one guess.
-print header("Customer View", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <BASEFONT SIZE=3>
-END
--
- 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});
-#untaint custnum & get customer record
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
--die "Customer not found!" unless $cust_main;
- $hashref = $cust_main->hashref;
-my($hashref)=$cust_main->hashref;
--
- print &itable(), '<TR><TD><A NAME="cust_main"></A>';
-#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 qq!<A HREF="!, popurl(2),
- qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!;
- print qq! | <A HREF="!, popurl(2),
- qq!misc/delete-customer.cgi?$custnum"> Delete this customer</A>!
- if $conf->exists('deletecustomers');
- print &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
- '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
- $custnum, '</TD></TR>',
- ;
-#bill now linke
-print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!,
- qq!Bill this customer now</A></CENTER>!;
--
- @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>';
-#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>!;
--
- print '</TABLE></TD></TR></TABLE>';
-#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>";
--
- print '</TD><TD ROWSPAN=2>';
-#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>";
--
- 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>"
- ;
-#last, first
-print "<P><B>", $hashref->{'last'}, ", ", $hashref->{first}, "</B>";
--
- print '</TD></TR><TR><TD>';
-#ss
-print " (SS# <B>", $hashref->{ss}, "</B>)" if $hashref->{ss};
--
- @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">',
- ;
-#company
-print "<BR><B>", $hashref->{company}, "</B>" if $hashref->{company};
--
- 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>',
- ;
-#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}, "!";
--}
--
- print "</TABLE></TD></TR></TABLE></TD></TR></TABLE>";
-#tax
-print "<BR>(Tax exempt)" if $hashref->{tax};
--
- 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> )!,
- ;
-#otaker
-print "<P>Order taken by <B>", $hashref->{otaker}, "</B>";
-
-#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>!;
--
--#display packages
--
--#formatting
- 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!,
-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!,
-- 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!</FONT></TH>!,
-- qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
-- qq!</TR>\n!;
--
--#get package info
- if ( $conf->exists('hidecancelledpackages') ) {
- @packages = $cust_main->ncancelled_pkgs;
- } else {
- @packages = $cust_main->all_pkgs;
- }
-
- $n1 = '<TR>';
-my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum});
-my($package);
--foreach $package (@packages) {
- my $pkgnum = $package->pkgnum;
- my $pkg = $package->part_pkg->pkg;
- my $comment = $package->part_pkg->comment;
- my $pkgview = popurl(2). "view/cust_pkg.cgi?$pkgnum";
- 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>";
- 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>";
-}
--
--#formatting
- print "</TABLE>";
-print "</TABLE></CENTER>";
--
--#formatting
- 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> )!;
-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>!;
--
--#get payment history
--#
--# major problem: this whole thing is way too sloppy.
--# minor problem: the description lines need better formatting.
--
- @history = (); #needed for mod_perl :)
-my(@history);
--
- @bills = qsearch('cust_bill',{'custnum'=>$custnum});
-my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum});
-my($bill);
--foreach $bill (@bills) {
-- my($bref)=$bill->hashref;
-- push @history,
- $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! .
- $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! .
-- $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
- qq! (Balance \$! . $bill->owed . qq!)</A>\t! .
- 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'),
-- $payment->getfield('payinfo'),
-- $payment->getfield('paid'),
-- );
-- push @history,
-- "$date\tPayment, Invoice #$invnum ($payby $payinfo)\t\t$paid\t\t";
-- }
--}
--
- @credits = qsearch('cust_credit',{'custnum'=>$custnum});
-my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum});
-my($credit);
--foreach $credit (@credits) {
-- my($cref)=$credit->hashref;
-- push @history,
-- $cref->{_date} . "\tCredit #" . $cref->{crednum} . ", (Balance \$" .
-- $cref->{credited} . ") by " . $cref->{otaker} . " - " .
-- $cref->{reason} . "\t\t\t" . $cref->{amount} . "\t";
--
-- my(@refunds)=qsearch('cust_refund',{'crednum'=> $cref->{crednum} } );
-- my($refund);
-- foreach $refund (@refunds) {
-- my($rref)=$refund->hashref;
-- push @history,
-- $rref->{_date} . "\tRefund, Credit #" . $rref->{crednum} . " (" .
-- $rref->{payby} . " " . $rref->{payinfo} . ") by " .
-- $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
-- $rref->{refund};
-- }
--}
--
-- #formatting
- print &table(), <<END;
- print <<END;
-<CENTER><TABLE BORDER=4>
--<TR>
-- <TH>Date</TH>
-- <TH>Description</TH>
-- <TH><FONT SIZE=-1>Charge</FONT></TH>
-- <TH><FONT SIZE=-1>Payment</FONT></TH>
-- <TH><FONT SIZE=-1>In-house<BR>Credit</FONT></TH>
-- <TH><FONT SIZE=-1>Refund</FONT></TH>
-- <TH><FONT SIZE=-1>Balance</FONT></TH>
--</TR>
--END
--
--#display payment history
--
- $balance = 0;
-my($balance)=0;
-my($item);
--foreach $item (sort keyfield_numerically @history) {
-- my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item);
-- $charge ||= 0;
-- $payment ||= 0;
-- $credit ||= 0;
-- $refund ||= 0;
-- $balance += $charge - $payment;
-- $balance -= $credit - $refund;
--
-- print "<TR><TD><FONT SIZE=-1>",time2str("%D",$date),"</FONT></TD>",
-- "<TD><FONT SIZE=-1>$desc</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>",
-- ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
-- "</FONT></TD>",
-- "<TD><FONT SIZE=-1>\$" . sprintf("%.2f",$balance),
-- "</FONT></TD>",
-- "\n";
--}
--
--#formatting
- print "</TABLE>";
-print "</TABLE></CENTER>";
--
--#end
--
--#formatting
--print <<END;
--
-- </BODY>
--</HTML>
--END
--
--#subroutiens
--sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0] ; }
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: cust_pkg.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
-# cust_pkg.cgi: View a package
--#
--# 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
--# entries in cust_pkg!
--# ivan@voicenet.com 96-dec-31
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# changed and fixed up suspension and cancel stuff, now you can't add
--# services to a cancelled package
--# ivan@voicenet.com 97-feb-27
--#
--# rewrote for new API, still needs to be cleaned up!
--# 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;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
--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;
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
--
-my(%uiview,%uiadd);
-my($part_svc);
--foreach $part_svc ( qsearch('part_svc',{}) ) {
- $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi";
- $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi";
- $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi";
- $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi";
--}
--
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $pkgnum = $1;
-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;
--
--#get package record
- $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
--die "No package!" unless $cust_pkg;
- $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
-my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
--
- $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)
- ));
-#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>!;
--
--#print info
- ($susp,$cancel,$expire)=(
-my($susp,$cancel,$expire)=(
-- $cust_pkg->getfield('susp'),
-- $cust_pkg->getfield('cancel'),
-- $cust_pkg->getfield('expire'),
--);
- ($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 "<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!;
--
- 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;
-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>";
--
- 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>'
- ;
-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>";
--
- # 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 ($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>";
--
--unless ($cancel) {
--
-- #services
- print '<BR>Service Information', &table();
- 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
--
-- #list of services this pkgpart includes
- my $pkg_svc;
- my %pkg_svc = ();
- my($pkg_svc,%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)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
-- 'svcpart'=>$svcpart,
-- });
--
-- my($enum);
-- for $enum ( 1 .. $pkg_svc{$svcpart} ) {
--
-- 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: $value<A></TD></TR>
-<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR>
--END
-- } else {
-- print <<END;
--<TR>
-- <TD><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart">
-- (Add) $svc</A>
-- or <A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">
-- (Link to existing) $svc</A>
-- </TD>
--</TR>
--END
-- }
--
-- }
-- warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
-- }
--
- 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>"
- ;
- print "</TABLE></CENTER>";
-
--}
--
--#formatting
--print <<END;
-- </BODY>
--</HTML>
--END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct.cgi,v 1.12 2001-01-31 07:21:00 ivan Exp $
-# View svc_acct records
--#
--# 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
--# ivan@voicenet.com 97-jan-4
--#
--# added navigation bar and ability to change username, etc.
--# ivan@voicenet.com 97-jan-30
--#
--# activate 800 service
--# ivan@voicenet.com 97-feb-10
--#
--# modified navbar code (should be a subroutine?), added link to cancel account (only if not audited)
--# ivan@voicenet.com 97-apr-16
--#
--# INCOMPLETELY rewrote some things for new API
--# ivan@voicenet.com 97-jul-29
--#
--# FS::Search became FS::Record, use strict, etc. ivan@sisd.com 98-mar-9
--#
--# 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
--#
--# /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.12 2001-01-31 07:21:00 ivan
- # fix tyops
- #
- # Revision 1.11 2000/12/03 20:25:20 ivan
- # session monitor updates
- #
- # Revision 1.10 1999/04/14 11:27:06 ivan
- # showpasswords config option to show passwords
- #
- # 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 vars qw( $conf $cgi $mydomain $query $svcnum $svc_acct $cust_svc $pkgnum
- $cust_pkg $custnum $part_svc $p $svc_acct_pop $password );
- 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;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs fields);
--
- $cgi = new CGI;
- &cgisuidsetup($cgi);
-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>;
--
- $conf = new FS::Conf;
- $mydomain = $conf->config('domain');
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
--
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $svcnum = $1;
- $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
- die "Unknown svcnum" unless $svc_acct;
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum});
-die "Unkonwn svcnum" unless $svc_acct;
--
- $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $pkgnum = $cust_svc->getfield('pkgnum');
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
- } else {
- $cust_pkg = '';
- $custnum = '';
--}
--
- $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
- die "Unknown svcpart" unless $part_svc;
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
--
- $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,
- ));
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Account View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Account View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-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
-}
-
-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>!;
--
- 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>"
- ;
-#formatting
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="general">General</A></FONT></CENTER>!;
--
- print "<BR>Password: ";
- $password = $svc_acct->_password;
- if ( $password =~ /^\*\w+\* (.*)$/ ) {
- $password = $1;
- print "<I>(login disabled)</I> ";
- }
- if ( $conf->exists('showpasswords') ) {
- print "<B>$password</B>";
-#svc
-print "Service: <B>", $part_svc->svc, "</B>";
-
-#username
-print "<BR>Username: <B>", $svc_acct->username, "</B>";
-
-#password
-if (substr($svc_acct->_password,0,1) eq "*") {
- print "<BR>Password: <I>(Login disabled)</I><BR>";
--} else {
- print "<I>(hidden)</I>";
- print "<BR>Password: <I>(hidden)</I><BR>";
--}
- $password = '';
--
- $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>"
-# 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->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 "<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>"
- ;
- 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>";
--} else {
- print "<BR><BR>(No shell account)";
- print "No shell account.</A></FONT></CENTER>";
--}
--
-# SLIP/PPP
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="slip">!;
--if ($svc_acct->slipip) {
- 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>";
- 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>";
-- my($attribute);
-- foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
-- #warn $attribute;
-- $attribute =~ /^radius_(.*)$/;
-- my($pattribute) = ($1);
-- $pattribute =~ s/_/-/g;
-- print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
-- }
--} else {
- print "<BR><BR>(No SLIP/PPP account)";
- print "No SLIP/PPP account</A></FONT></CENTER>"
--}
--
- print "</BODY></HTML>";
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_acct_sm.cgi,v 1.11 2000-07-17 10:58:42 ivan Exp $
-# View svc_acct_sm records
--#
--# 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
--#
--# added navigation bar
--# ivan@voicenet.com 97-jan-30
--#
--# rewrite ivan@sisd.com 98-mar-15
--#
--# Changes to allow page to work at a relative position in server
--# 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.11 2000-07-17 10:58:42 ivan
- # better error messages if svc_acct or svc_domain records are missing
- #
- # 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 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 CGI::Base qw(:DEFAULT :CGI);
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(header popurl menubar );
--use FS::Record qw(qsearchs);
- 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);
-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;
--
- $conf = new FS::Conf;
- $mydomain = $conf->config('domain');
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
--
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $svcnum = $1;
- $svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
--die "Unknown svcnum" unless $svc_acct_sm;
--
- $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $pkgnum = $cust_svc->getfield('pkgnum');
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
- } else {
- $cust_pkg = '';
- $custnum = '';
--}
--
- $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } )
- or die "Unkonwn svcpart";
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
--
- $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,
- ));
-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
-}
--
- ($domsvc,$domuid,$domuser) = (
-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
-
-my($domsvc,$domuid,$domuser)=(
-- $svc_acct_sm->domsvc,
-- $svc_acct_sm->domuid,
-- $svc_acct_sm->domuser,
--);
- $svc = $part_svc->svc;
- $svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc})
- or die "Corrupted database: no svc_domain.svcnum matching domsvc $domsvc";
- $domain = $svc_domain->domain;
- $svc_acct = qsearchs('svc_acct',{'uid'=>$domuid})
- or die "Corrupted database: no svc_acct.uid matching domuid $domuid";
- $username = $svc_acct->username;
-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;
--
- 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>'
- ;
-#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
--
+++ /dev/null
--#!/usr/bin/perl -Tw
--#
- # $Id: svc_domain.cgi,v 1.11 2000-12-03 15:14:00 ivan Exp $
-# View svc_domain records
--#
--# 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.11 2000-12-03 15:14:00 ivan
- # bugfixes from Jeff Finucane <jeff@cmh.net>, thanks!
- #
- # Revision 1.10 1999/08/27 22:18:44 ivan
- # point to patrick instead of internic!
- #
- # 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 vars qw( $cgi $query $svcnum $svc_domain $domain $cust_svc $pkgnum
- $cust_pkg $custnum $part_svc $p );
- use CGI;
-use CGI::Base qw(:DEFAULT :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;
--
- $cgi = new CGI;
-my($cgi) = new CGI::Base;
-$cgi->get;
--cgisuidsetup($cgi);
--
- ($query) = $cgi->keywords;
- $query =~ /^(\d+)$/;
- $svcnum = $1;
- $svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum});
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum});
--die "Unknown svcnum" unless $svc_domain;
-my($domain)=$svc_domain->domain;
--
- $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $pkgnum = $cust_svc->getfield('pkgnum');
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
--if ($pkgnum) {
-- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-- $custnum=$cust_pkg->getfield('custnum');
- } else {
- $cust_pkg = '';
- $custnum = '';
--}
--
- $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
--die "Unkonwn svcpart" unless $part_svc;
--
- $domain = $svc_domain->domain;
-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
--
- $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://www.geektools.com/cgi-bin/proxy.cgi?query=$domain;targetnic=auto">View whois information.</A>!,
- '</BODY></HTML>',
- ;
-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
-
projects / freeside.git / commitdiff