diff options
Diffstat (limited to 'httemplate/misc')
| -rw-r--r-- | httemplate/misc/phonenums.cgi | 10 | ||||
| -rw-r--r-- | httemplate/misc/regions.cgi | 26 | ||||
| -rw-r--r-- | httemplate/misc/xmlhttp-address_standardize.html | 8 | ||||
| -rw-r--r-- | httemplate/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html | 123 | ||||
| -rw-r--r-- | httemplate/misc/xmlhttp-mib-browse.html | 161 |
5 files changed, 322 insertions, 6 deletions
diff --git a/httemplate/misc/phonenums.cgi b/httemplate/misc/phonenums.cgi index fd5de2ae6..5084628eb 100644 --- a/httemplate/misc/phonenums.cgi +++ b/httemplate/misc/phonenums.cgi @@ -21,13 +21,13 @@ if ( $exchangestring ) { my %opts = (); if ( $exchangestring eq 'tollfree' ) { $opts{'tollfree'} = 1; - } - #elsif ( $exchangestring =~ /^([\w\s\:\,\(\)\-]+), ([A-Z][A-Z])$/ ) { - elsif ( $exchangestring =~ /^(.+), ([A-Z][A-Z])$/ ) { + } elsif ( $exchangestring =~ /^_REGION (.*)$/ ) { + $opts{'region'} = $1; + #} elsif ( $exchangestring =~ /^([\w\s\:\,\(\)\-]+), ([A-Z][A-Z])$/ ) { + } elsif ( $exchangestring =~ /^(.+), ([A-Z][A-Z])$/ ) { $opts{'ratecenter'} = $1; $opts{'state'} = $2; - } - else { + } else { $exchangestring =~ /\((\d{3})-(\d{3})-XXXX\)\s*$/i or die "unparsable exchange: $exchangestring"; my( $areacode, $exchange ) = ( $1, $2 ); diff --git a/httemplate/misc/regions.cgi b/httemplate/misc/regions.cgi new file mode 100644 index 000000000..2450ea31a --- /dev/null +++ b/httemplate/misc/regions.cgi @@ -0,0 +1,26 @@ +<% objToJson(\@regions) %> +<%init> + +my( $state, $svcpart ) = $cgi->param('arg'); + +my $part_svc = qsearchs('part_svc', { 'svcpart'=>$svcpart } ); +die "unknown svcpart $svcpart" unless $part_svc; + +my @regions = (); +if ( $state ) { + + my @exports = $part_svc->part_export_did; + if ( scalar(@exports) > 1 ) { + die "more than one DID-providing export attached to svcpart $svcpart"; + } elsif ( ! @exports ) { + die "no DID providing export attached to svcpart $svcpart"; + } + my $export = $exports[0]; + + my $something = $export->get_dids('state'=>$state); + + @regions = @{ $something }; + +} + +</%init> diff --git a/httemplate/misc/xmlhttp-address_standardize.html b/httemplate/misc/xmlhttp-address_standardize.html index 1620642cb..988057163 100644 --- a/httemplate/misc/xmlhttp-address_standardize.html +++ b/httemplate/misc/xmlhttp-address_standardize.html @@ -24,6 +24,7 @@ if ($old{onlyship}) { } else { @prefixes = ('bill_', 'ship_'); } +my $all_same = 1; foreach my $pre ( @prefixes ) { my $location = { @@ -38,8 +39,13 @@ foreach my $pre ( @prefixes ) { foreach ( keys(%$cache) ) { $new{$pre.$_} = $cache->get($_); } + + foreach ( qw(address1 address2 city state zip country) ) { + $all_same = 0 if ( $new{$pre.$_} ne $old{$pre.$_} ); + last if !$all_same; + } } -my $return = { old => \%old, new => \%new }; +my $return = { old => \%old, new => \%new, all_same => $all_same }; warn "result:\n".encode_json($return) if $DEBUG; </%init> diff --git a/httemplate/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html b/httemplate/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html new file mode 100644 index 000000000..993504619 --- /dev/null +++ b/httemplate/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html @@ -0,0 +1,123 @@ +<% to_json($return) %> +<%init> + +my $curuser = $FS::CurrentUser::CurrentUser; +die "access denied" unless $curuser->access_right('Post credit'); + +my $DEBUG = 0; + +my $conf = new FS::Conf; + +my $sub = $cgi->param('sub'); + +my $return = {}; + +if ( $sub eq 'calculate_taxes' ) { + + { + + my %arg = $cgi->param('arg'); + $return = \%arg; + warn join('', map "$_: $arg{$_}\n", keys %arg ) + if $DEBUG; + + #some false laziness w/cust_credit::credit_lineitems + + my $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $arg{custnum} }, + 'extra_sql' => ' AND '. $curuser->agentnums_sql, + }) or die 'unknown customer'; + + my @billpkgnums = split(',', $arg{billpkgnums}); + my @setuprecurs = split(',', $arg{setuprecurs}); + my @amounts = split(',', $arg{amounts}); + + my @cust_bill_pkg = (); + my $taxlisthash = {}; + while ( @billpkgnums ) { + my $billpkgnum = shift @billpkgnums; + my $setuprecur = shift @setuprecurs; + my $amount = shift @amounts; + + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'billpkgnum' => $billpkgnum }, + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => 'AND custnum = '. $cust_main->custnum, + }) or die "unknown billpkgnum $billpkgnum"; + + #shouldn't be passed# next if $cust_bill_pkg->pkgnum == 0; + + if ( $setuprecur eq 'setup' ) { + $cust_bill_pkg->setup($amount); + $cust_bill_pkg->recur(0); + $cust_bill_pkg->unitrecur(0); + $cust_bill_pkg->type(''); + } else { + $cust_bill_pkg->recur($amount); + $cust_bill_pkg->setup(0); + $cust_bill_pkg->unitsetup(0); + } + + push @cust_bill_pkg, $cust_bill_pkg; + + my $part_pkg = $cust_bill_pkg->part_pkg; + $cust_main->_handle_taxes( $part_pkg, + $taxlisthash, + $cust_bill_pkg, + $cust_bill_pkg->cust_pkg, + $cust_bill_pkg->cust_bill->_date, + $cust_bill_pkg->cust_pkg->pkgpart, + ); + + } + + if ( @cust_bill_pkg ) { + + my $listref_or_error = + $cust_main->calculate_taxes( \@cust_bill_pkg, $taxlisthash, $cust_bill_pkg[0]->cust_bill->_date ); + + unless ( ref( $listref_or_error ) ) { + $return->{error} = $listref_or_error; + last; + } + + my @taxlines = (); + my $taxtotal = 0; + $return->{taxlines} = \@taxlines; + foreach my $taxline ( @$listref_or_error ) { + my $amount = $taxline->setup; + my $desc = $taxline->desc; + foreach my $location ( @{$taxline->cust_bill_pkg_tax_location}, @{$taxline->cust_bill_pkg_tax_rate_location} ) { + my $taxlocnum = $location->locationnum || ''; + my $taxratelocnum = $location->taxratelocationnum || ''; + $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge + $taxtotal += $location->amount; + push @taxlines, + #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ]; + [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ]; + $amount -= $location->amount; + } + if ($amount > 0) { + $taxtotal += $amount; + push @taxlines, + [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ]; + } + } + + $return->{taxlines} = \@taxlines; + $return->{taxtotal} = sprintf('%.2f', $taxtotal); + + } else { + + $return->{taxlines} = []; + $return->{taxtotal} = '0.00'; + + } + + } + +} + +</%init> diff --git a/httemplate/misc/xmlhttp-mib-browse.html b/httemplate/misc/xmlhttp-mib-browse.html new file mode 100644 index 000000000..f3084ff6f --- /dev/null +++ b/httemplate/misc/xmlhttp-mib-browse.html @@ -0,0 +1,161 @@ +%#<% Data::Format::HTML->new->format($index{by_path}) %> +% my $json = "JSON"->new->canonical; +<% $json->encode($result) %> +<%init> +#<%once> #enable me in production +use SNMP; +SNMP::initMib(); +my $mib = \%SNMP::MIB; + +# make an index of the leaf nodes +my %index = ( + by_objectID => {}, # {.1.3.6.1.2.1.1.1} + by_fullname => {}, # {iso.org.dod.internet.mgmt.mib-2.system.sysDescr} + by_path => {}, # {iso}{org}{dod}{internet}{mgmt}{mib-2}{system}{sysDescr} + module => {}, #{SNMPv2-MIB}{by_path}{iso}{org}... + #{SNMPv2-MIB}{by_fullname}{iso.org...} +); + +my %name_of_oid = (); # '.1.3.6.1' => 'iso.org.dod.internet' + +# build up path names +my $fullname; +$fullname = sub { + my $oid = shift; + return $name_of_oid{$oid} if exists $name_of_oid{$oid}; + + my $object = $mib->{$oid}; + my $myname = '.' . $object->{label}; + # cut off the last element and recurse + $oid =~ /^(\.[\d\.]+)?(\.\d+)$/; + if ( length($1) ) { + $myname = $fullname->($1) . $myname; + } + return $name_of_oid{$oid} = $myname +}; + +my @oids = keys(%$mib); # dotted numeric OIDs +foreach my $oid (@oids) { + my $object = {}; + %$object = %{ $mib->{$oid} }; # untie it + # and remove references + delete $object->{parent}; + delete $object->{children}; + delete $object->{nextNode}; + $index{by_objectID}{$oid} = $object; + my $myname = $fullname->($oid); + $object->{fullname} = $myname; + $index{by_fullname}{$myname} = $object; + my $moduleID = $object->{moduleID}; + $index{module}{$moduleID} ||= { by_fullname => {}, by_path => {} }; + $index{module}{$moduleID}{by_fullname}{$myname} = $object; +} +my @names = sort {$a cmp $b} keys %{ $index{by_fullname} }; +foreach my $myname (@names) { + my $obj = $index{by_fullname}{$myname}; + my $moduleID = $obj->{moduleID}; + my @parts = split('\.', $myname); + shift @parts; # always starts with an empty string + for ($index{by_path}, $index{module}{$moduleID}{by_path}) { + my $subindex = $_; + for my $this_part (@parts) { + $subindex = $subindex->{$this_part} ||= {}; + } + # $subindex now = $index{by_path}{foo}{bar}{baz}. + # set {''} = the object with that name. + # and set object $index{by_path}{foo}{bar}{baz}{''} = + # the object named .foo.bar.baz + $subindex->{''} = $obj; + } +} + +#</%once> +#<%init> +# no ACL for this +my $sub = $cgi->param('sub'); +my $result = {}; +if ( $sub eq 'search' ) { + warn "search: ".$cgi->param('arg')."\n"; + my ($module, $string) = split(':', $cgi->param('arg'), 2); + my $idx; # the branch of the index to use for this search + if ( $module eq 'ANY' ) { + $idx = \%index; + } elsif (exists($index{module}{$module}) ) { + $idx = $index{module}{$module}; + } else { + warn "unknown MIB moduleID: $module\n"; + $idx = {}; # will return nothing, because you've somehow sent a bad moduleID + } + if ( exists($index{by_fullname}{$string}) ) { + warn "exact match\n"; + # don't make this module-selective--if the path matches an existing + # object, return that object + %$result = %{ $index{by_fullname}{$string} }; # put the object info in $result + #warn Dumper $result; + } + my @choices; # menu options to return + if ( $string =~ /^[\.\d]+$/ ) { + # then this is a numeric path + # ignore the module filter, and return everything starting with $string + if ( $string =~ /^\./ ) { + @choices = grep /^\Q$string\E/, keys %{$index{by_objectID}}; + } else { + # or everything containing it + @choices = grep /\Q$string\E/, keys %{$index{by_objectID}}; + } + @choices = map { $index{by_objectID}{$_}->{fullname} } @choices; + } elsif ( $string eq '' or $string =~ /^\./ ) { + # then this is an absolute path + my @parts = split('\.', $string); + shift @parts; + my $subindex = $idx->{by_path}; + my $path = ''; + @choices = keys %$subindex; + # walk all the specified path parts + foreach my $this_part (@parts) { + # stop before walking off the map + last if !exists($subindex->{$this_part}); + $subindex = $subindex->{$this_part}; + $path .= '.' . $this_part; + @choices = grep {$_} keys %$subindex; + } + # skip uninteresting nodes: those that aren't accessible nodes (have no + # data type), and have only one path forward + while ( scalar(@choices) == 1 + and (!exists $subindex->{''} or $subindex->{''}->{type} eq '') ) { + + $subindex = $subindex->{ $choices[0] }; + $path .= '.' . $choices[0]; + @choices = grep {$_} keys %$subindex; + + } + + # if we are on an existing node, and the entered path didn't exactly + # match another node, return the current node as the result + if (!keys %$result and exists($subindex->{''})) { + %$result = %{ $subindex->{''} }; + } + # prepend the path up to this point + foreach (@choices) { + $_ = $path.'.'.$_; + # also label accessible nodes for the UI + if ( exists($subindex->{$_}{''}) and $subindex->{$_}{''}{'type'} ) { + $_ .= '-'; + } + } + # also include one level above the originally requested path, + # for tree-like navigation + if ( $string =~ /^(.+)\.[^\.]+/ ) { + unshift @choices, $1; + } + } else { + # then this is a full-text search + warn "/$string/\n"; + @choices = grep /\Q$string\E/i, keys(%{ $idx->{by_fullname} }); + } + @choices = sort @choices; + $result->{choices} = \@choices; +} elsif ( $sub eq 'get_module_list' ) { + $result = { modules => [ sort keys(%{ $index{module} }) ] }; +} +</%init> |