1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
#!/usr/bin/perl -Tw
#
# $Id: cust_pkg.cgi,v 1.11 2000-07-17 16:45:41 ivan Exp $
#
# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
#
# $Log: cust_pkg.cgi,v $
# Revision 1.11 2000-07-17 16:45:41 ivan
# first shot at invoice browsing and some other cleanups
#
# Revision 1.10 2000/07/17 12:49:29 ivan
# better error message if a package isn't linked to a customer (that shouldn't happen)
#
# Revision 1.9 1999/07/17 10:38:52 ivan
# scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
# gave me a great bugreport at the last rhythmethod
#
# Revision 1.8 1999/02/09 09:22:57 ivan
# visual and bugfixes
#
# Revision 1.7 1999/02/07 09:59:37 ivan
# more mod_perl fixes, and bugfixes Peter Wemm sent via email
#
# Revision 1.6 1999/01/19 05:14:13 ivan
# for mod_perl: no more top-level my() variables; use vars instead
# also the last s/create/new/;
#
# Revision 1.5 1999/01/18 09:41:38 ivan
# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
# (good idea anyway)
#
# Revision 1.4 1999/01/18 09:22:33 ivan
# changes to track email addresses for email invoicing
#
# Revision 1.3 1998/12/23 03:05:59 ivan
# $cgi->keywords instead of $cgi->query_string
#
# Revision 1.2 1998/12/17 09:41:09 ivan
# s/CGI::(Base|Request)/CGI.pm/;
#
use strict;
use vars qw ( $cgi @cust_pkg $sortby $query );
use CGI;
use CGI::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;
$cgi = new CGI;
&cgisuidsetup($cgi);
($query) = $cgi->keywords;
#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");
exit;
} elsif ( scalar(@cust_pkg) == 0 ) { #error
eidiot("No packages found");
} else {
my($total)=scalar(@cust_pkg);
print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END;
$total matching packages found
<TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
<TR>
<TH>Package #</TH>
<TH>Customer #</TH>
<TH>Contact name</TH>
<TH>Company</TH>
</TR>
END
my(%saw,$cust_pkg);
foreach $cust_pkg (
sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
) {
my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
my($pkgnum,$custnum,$name,$company)=(
$cust_pkg->pkgnum,
$cust_pkg->custnum,
$cust_main ? $cust_main->last. ', '. $cust_main->first : '',
$cust_main ? $cust_main->company : '',
);
my $p = popurl(2);
print <<END;
<TR>
<TD><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
END
if ( $cust_main ) {
print <<END;
<TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$custnum</A></FONT></TD>
<TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$name</A></FONT></TD>
<TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$company</A></FONT></TD>
</TR>
END
} else {
print <<END;
<TD COLSPAN=3>WARNING: couldn't find cust_main.custnum $custnum (cust_pkg.pkgnum $pkgnum)</TD>
</TR>
END
}
}
print <<END;
</TABLE>
</BODY>
</HTML>
END
exit;
}
sub pkgnum_sort {
$a->getfield('pkgnum') <=> $b->getfield('pkgnum');
}
|
