'freeside_1_2_3_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 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() };
-
-&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>
+++ /dev/null
--<head>
-- <title>Billing</title>
--</head>
--<body>
-- <h1>Billing</h1>
- The freeside-bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
-- <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. 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.
-- </ul>
--</body>
+++ /dev/null
--<head>
-- <title>Configuration files</title>
--</head>
--<body>
-- <h1>Configuration files</h1>
- Configuration file layout has changed in 1.2.x.
- <ul>
- <li>First, the file `/usr/local/etc/freeside/mapsecrets' is read. Each line
- in this file contains a username and filename, separated by whitespace. Note
- that these are not local usernames - they are passed from Apache (you _did_
- setup <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">
- user authetication</a>, correct?). Filenames are located in
- `/usr/local/etc/freeside/'. The specified filename is parsed exactly
- the same as the pre-1.2.x `secrets' file:
- <li>Three lines: Database engine datasource (for example,
- `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password.
- This file should not be world readable. See the DBI manpage and the manpage
- for your DBD for the exact syntax.
- </ul>
- All further configuration files and directories are located in
- `/usr/local/etc/freeside/conf.<i>datasource</i>', for example,
- `/usr/local/etc/freeside/conf.DBI:Pg:dbname=freeside'
-Configuration files and directories are located in `/var/spool/freeside/conf'.
--<ul>
-- <li>address - Your company name and address, four lines.
-- <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
-- <li>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>deletecustomers - 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>domain - Your domain name.
- <li>editreferrals - The existance of this file will allow you to change the referral of existing customers.
-- <li>erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
- <li>hidecancelledpackages - The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database)
- <li>hidecancelledcustomers - 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>home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
- <li>invoice_from - Return address on email invoices.
-- <li>lpr - Print command for paper invoices, for example `lpr -h'.
-- <li>nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
- <li>passwordmin - Minimum password length (default 6);
-- <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>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>showpasswords - The existance of this file will allow unencrypted user passwords to be displayed.
-- <li>smtpmachine - SMTP relay for Freeside's outgoing mail.
- <li>usernamemin - Minimum username length (default 2);
- <li>usernamemax - Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)
--</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. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a>) will authenticate directly out of an SQL database. In these cases,
- it is reccommended that you copy the svc_acct table to an external RADIUS machine rather than run the RADIUS server on your Freeside machine.
- <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>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>The command <b>useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i></b> is executed when a user is added.
- <li>The command <b>userdel <i>username</i></b> is executed with a user is deleted.
- <li>If a user's home directory changes, the command <b>[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )</b> is executed.
- <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; see below.
- <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> and moved to <b>/etc/sendmail.cw</b> and <b>/etc/virtusertable</b> if no errors occur.
- <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>
-- <h1>Documentation</h1>
--<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.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="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="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="ftp://ftp.cs.hut.fi/pub/ssh/">SSH</a>
- <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series. Don't enable experimental features like threads or the PerlIO abstraction layer.)
- <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> (verstion 6.5 or higher) (see the <a href="postgresql.html">PostgreSQL notes</a>)
- <li>Perl modules (<a href="http://www.perl.com/CPAN/doc/manual/html/lib/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
- <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://www.perl.com/CPAN/modules/by-module/Array/">Array-PrintCols</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Term/">Term-Query</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/MIME/">MIME-Base64</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/Data">Data-Dumper</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/MD5">Digest-MD5</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/URI">URI</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/HTTP">HTML-Parser</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/Locale">Locale-Codes</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Net">Net-Whois</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/String/">String-Approx</a>
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBI/">DBI
-- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
-- </ul>
--</ul>
--Install the Freeside distribution:
--<ul>
-- <li>Add the user `freeside' to your system.
- <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>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</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://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>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
-- <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>
-- <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
-- <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
-- <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
-- <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="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="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="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="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.24 2000-01-30 06:54:50 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.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');
- print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST>!,
- qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
- qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ),
-
- ;
--
- # agent
-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
--
- $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 || 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><INPUT TYPE="text" NAME="last" VALUE="$last">, <INPUT TYPE="text" NAME="first" VALUE="$first"></TD><TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD></TR>
- <TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR>
- <TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR>
- <TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR>
- <TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1">
-print <<END;
-
-
-Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11>
-Company <INPUT TYPE="text" NAME="company" VALUE="$company">
-Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40>
- <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40>
-City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1">
--END
--
- $cust_main->country('US') unless $cust_main->country; #eww
--foreach ( qsearch('cust_main_county',{}) ) {
-- print "<OPTION";
-- print " SELECTED" if ( $cust_main->state eq $_->state
- && $cust_main->county eq $_->county
- && $cust_main->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;
- 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 ( 1999 .. 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.12 1999-04-09 04:22:34 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.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',
- 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
- '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.6 1999-01-25 12:19:07 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.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(/\s+/,$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.8 1999-02-07 09:59:27 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.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 );
- 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;
- &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';
--
--if ( $pkgpart ) {
- $error = $new->replace($old);
- my($error)=$new->replace($old);
- eidiot($error) if $error;
--} else {
- $error = $new->insert;
- $pkgpart=$new->pkgpart;
- }
- if ( $error ) {
- $cgi->param('error', $error );
- print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
- exit;
- my($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);
- die $myerror if $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;
- die $myerror if $myerror;
- my($error)=$new_pkg_svc->insert;
- eidiot($error) if $error;
-- }
- }
-
- unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
- print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
- } else {
- my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
- my %hash = $old_cust_pkg->hash;
- $hash{'pkgpart'} = $pkgpart;
- my($new_cust_pkg) = new FS::cust_pkg \%hash;
- my $myerror = $new_cust_pkg->replace($old_cust_pkg);
- die "Error modifying cust_pkg record: $myerror\n" if $myerror;
- print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
--}
--
-#$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.6 1999-02-28 00:03:47 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.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('legal') ne "Yes") {
-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 ($cgi->param('svcnum')) {
-} 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.9 1999-02-28 00:03:39 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.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.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>
- </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>
- </ul>
- <li><A NAME="admin">Administration</a>
- <ul>
- </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.6 1999-02-28 00:03:48 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.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 );
- 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;
-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->getfield('pkgnum') ne '';
--
--local $SIG{HUP} = 'IGNORE';
--local $SIG{INT} = 'IGNORE';
--local $SIG{QUIT} = 'IGNORE';
--local $SIG{TERM} = 'IGNORE';
--local $SIG{TSTP} = 'IGNORE';
-
-my($error);
--
-bless($svc_acct,"FS::svc_acct");
--$error = $svc_acct->cancel;
- &eidiot($error) if $error;
-&idiot($error) if $error;
--$error = $svc_acct->delete;
- &eidiot($error) if $error;
-&idiot($error) if $error;
--
-bless($cust_svc,"FS::cust_svc");
--$error = $cust_svc->delete;
- &eidiot($error) if $error;
-&idiot($error) if $error;
--
- print $cgi->redirect(popurl(2));
-$cgi->redirect("../");
-
-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.5 1999-04-15 14:09:17 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.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);
-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.4 1999-02-28 00:03:54 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.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 );
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
-use CGI::Request;
--use FS::UID qw(cgisuidsetup);
- use FS::CGI qw(popurl idiot);
--use FS::Record qw(qsearchs);
--
- $cgi = new CGI;
- cgisuidsetup($cgi);
-my($req)=new CGI::Request;
-cgisuidsetup($req->cgi);
--
- $cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
- $invnum = $2;
-$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
-my($invnum)=$2;
--
--if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
- print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect
- $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect
--} else { #error
- idiot("Invoice not found.");
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Invoice Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Invoice Search Error</H3>
- <HR>
- Invoice not found.
- </CENTER>
- </BODY>
-</HTML>
-END
-
--}
--
+++ /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.14 1999-08-12 04:45:21 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.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 {
- @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.9 1999-07-17 10:38:52 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.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_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>
- <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
-
- 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.10 1999-07-17 10:38:52 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.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;
-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.18 1999-08-12 04:16:01 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.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 \$! . $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.10 1999-04-14 11:27:06 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.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});
-#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 } );
-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,
-# 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.10 1999-04-08 12:00:19 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.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 } );
-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});
- $domain = $svc_domain->domain;
- $svc_acct = qsearchs('svc_acct',{'uid'=>$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.10 1999-08-27 22:18:44 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.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://209.133.38.12/step1.cgi?query=$domain">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
