1290 lines
38 KiB
Perl
Executable File
1290 lines
38 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# Copyright 1999 by Leopold Toetsch <lt@toetsch.at>
|
|
#
|
|
# This program is free for private use. Private use means, you
|
|
# may install and run this program on your home/office computer(s).
|
|
# But you are not allowed to use this program on public webservers.
|
|
#
|
|
# For commercial usage on public webservers contact the author.
|
|
|
|
use CGI qw(:standard);
|
|
use CGI::Carp 'fatalsToBrowser';
|
|
use strict;
|
|
use GD;
|
|
use IO::Handle;
|
|
# socket stuff
|
|
my $use_sockets=1;
|
|
use Socket;
|
|
my $server='/tmp/isdnrate';
|
|
|
|
# configure adjusts these n/y :-(
|
|
my $MKTEMP= '/bin/mktemp';
|
|
my $ISDNRATE='/home/lt/src/testi4l/isdnlog/bin/isdnrate';
|
|
my $CODEF= '/home/lt/src/testi4l/isdnlog/tools/zone/at/code';
|
|
my $tempdir=$ENV{'DOCUMENT_ROOT'};
|
|
my $DEFLEN=153;
|
|
|
|
my $debug=0;
|
|
my $LEER='--kein--';
|
|
$tempdir = "$tempdir/tmp";
|
|
my $tempdir_url = '/tmp';
|
|
# end configurable
|
|
|
|
# cgi
|
|
my $q=new CGI;
|
|
# some security things
|
|
$CGI::POST_MAX=1000;
|
|
$CGI::DISABLE_UPLOADS=1;
|
|
|
|
# data
|
|
my @countries=($LEER, "Afghanistan","Ägypten","Alaska","Albanien","Algerien",
|
|
"Amerikanisch-Samoa","Amerikanische Jungferninseln","Andorra",
|
|
"Angola","Anguilla","Antarktis","Antigua und Barbuda","Äquatorial-Guinea",
|
|
"Argentinien","Armenien","Aruba","Ascension",
|
|
"Aserbaidschan","Äthiopien","Atlantischer Ozean (Ost)",
|
|
"Atlantischer Ozean (West)","Australien","Azoren",
|
|
"Bahamas","Bahrain","Bangladesch","Barbados","Belgien",
|
|
"Belize","Benin","Bermuda","Bhutan","Bilbao","Bolivien","Bosnien-Herzegowina",
|
|
"Botsuana Botswana","Brasilien","Britische Jungferninseln",
|
|
"Brunei","Bulgarien","Burkina Faso Obervolta","Burundi","Cape Verde",
|
|
"Chatham-Inseln","Chile","China","Cookinseln","Costa Rica",
|
|
"Deutschland","Diego Garcia","Dominica","Dominikanische Republik","Dschibuti",
|
|
"Dänemark","Ecuador","Edinburgh",
|
|
"El Salvador","Elfenbeinküste Cote de Ivoire",
|
|
"Eritrea","Estland","Falklandinseln","Fidschi","Finnland","Frankfurt",
|
|
"Frankreich","Französisch-Guayana","Französisch-Polynesien",
|
|
"Freephone Niederlande","Freephone Schweiz","Färöer-Inseln","Gabun",
|
|
"Gambia","Georgien","Gerona","Ghana","Gibraltar","Grenada","Griechenland",
|
|
"Großbritannien","Grönland","Guadeloupe","Guam",
|
|
"Guantanamo","Guantanamo Bay","Guatemala","Guinea","Guinea-Bissau","Guyana",
|
|
"Haiti","Hawaii","Honduras","Hongkong","Indien",
|
|
"Indischer Ozean","Indonesien","Inmarsat A","Inmarsat A Daten/Fax",
|
|
"Inmarsat Aero","Inmarsat B","Inmarsat B HSD","Inmarsat M","Inmarsat Mini-M",
|
|
"Irak","Iran","Iridium 008816","Iridium 008817","Irland",
|
|
"Island","Israel","Italien","Jamaika",
|
|
"Japan","Jemen (Arab. Republik)","Jordanien","Jugoslawien",
|
|
"Kaimaninseln","Kambodscha","Kamerun","Kanada","Kanarische Inseln","Kasachstan",
|
|
"Katar","Kenia","Kirgisien","Kirgistan","Kiribati","Kokosinseln","Kolumbien",
|
|
"Kongo","Korea Rep. (South)","Kroatien","Kuba",
|
|
"Kuwait","Laos","Lesotho","Lettland","Leuven","Libanon",
|
|
"Liberia","Libyen","Liechtenstein","Litauen","Luxemburg","Macao","Madagaskar",
|
|
"Madeira","Malawi","Malaysia","Malediven","Mali","Mallorca","Malta",
|
|
"Marianen (SaipanNord-)","Marokko","Marshallinseln","Martinique / Franz. Antillen",
|
|
"Mauretanien","Mauritius","Mayotte","Mazedonien","Mexiko","Midway-Inseln",
|
|
"Mikronesien","Moldavien Moldau (Republik)","Monaco","Mongolei","Montserrat",
|
|
"Mosambik","Myanmar Burma","Namibia","Nauru","Nepal","Neukaledonien",
|
|
"Neuseeland","Nicaragua","Niederl. Antillen","Niederlande",
|
|
"Niger","Nigeria","Niue-Inseln","Nordirland","Nordkorea","Norfolkinseln",
|
|
"Norwegen","Oman","Österreich","Pakistan","Palau /Belau","Panama",
|
|
"Papua-Neuguinea","Paraguay","Pazifischer Ozean",
|
|
"Peru","Philippinen","Pitcairn Inseln","Pitcairn Islands",
|
|
"Polen","Portugal","Puerto Rico","Reunion","Rotterdam","Ruanda","Rumänien",
|
|
"Russische Föderat. (westl.)","Russische Förderation (östl.)",
|
|
"Salomonen","Sambia","San Marino","Sao Tome und Principe","Saudi Arabien",
|
|
"Schweden","Schweiz","Senegal",
|
|
"Seyschellen","Sierra Leone","Simbabwe","Singapur","Slowakische Republik",
|
|
"Slowenien","Somalia","Spanien","Sri Lanka","St. Helena",
|
|
"St. Kitts und Nevis","St. Lucia","St. Pierre und Miquelon","St. Vincent und Grenadinen",
|
|
"Sudan","Suriname","Swasiland","Syrien","Südafrika","Südkorea",
|
|
"Tadschikistan","Taiwan","Tansania","Tarragona","Teneriffa",
|
|
"Thailand","Togo","Tokelan","Tokyo","Tonga","Trinidad und Tobago",
|
|
"Tristan da Cunha","Tschad","Tschechische Republik","Tunesien","Turkmenistan",
|
|
"Turks- und Caicosinseln","Tuvalu","Türkei","USA",
|
|
"Uganda","Ukraine","Ungarn","Uruguay","Usbekistan","Valencia","Vanuatu",
|
|
"Vatikan","Venezuela","Ver. Arabische Emirate",
|
|
"Vietnam","Wake Inseln","Wallis und Futuna","Weihnachtsinseln","Weissrussland",
|
|
"West-Samoa","Zaire","Zentralafrikanische Republik","Zypern");
|
|
|
|
my %towns = (0 => $LEER);
|
|
my (%url, $len, $TITLE);
|
|
my ($weekly, $daily, @names, $help, $mix);
|
|
# main
|
|
$|=1;
|
|
$TITLE="Telefonkosten";
|
|
|
|
if ($debug==2) {
|
|
&html_header('debug',1);
|
|
$q->print(hr, $q->dump());
|
|
$q->print(hr);
|
|
}
|
|
if (param('info')) {
|
|
&html_header("$TITLE - Info",0);
|
|
&info(param('info'));
|
|
}
|
|
else {
|
|
$weekly=param('graf') =~ /Wo/;
|
|
$daily=param('graf') =~ /Tag/;
|
|
$mix=param('mix');
|
|
my $subt = $mix?"Gesprächsmix":$daily?"Tagesverlauf":
|
|
$weekly?"Wochenverlauf":"Einzelgespräch";
|
|
&html_header("$TITLE - $subt",$mix?0:1);
|
|
&read_towns unless($mix);
|
|
@names=param();
|
|
$help=0;
|
|
push(@names, 'help_tel.x') if (@names && !param('tel') &&
|
|
!param('town') && !param('country') && !param('mix'));
|
|
foreach (@names) {
|
|
if (/help_(.*?)\.x/) {
|
|
show_help($1);
|
|
$help=1
|
|
}
|
|
}
|
|
if (param('clear')) { # clear mix
|
|
my $n;
|
|
param('mix',$mix=10);
|
|
param('from','');
|
|
foreach $n (0..$mix-1) {
|
|
foreach ('tel','oft','len','dday') {
|
|
param("$_$n", '');
|
|
} #for
|
|
}
|
|
param('best','20');
|
|
param('prov','');
|
|
param('xprov','');
|
|
param('_3D','on')
|
|
}
|
|
if (!$help) {
|
|
&print_table if(param('tab') eq 'Tabelle');
|
|
&make_graf if(param('graf'));
|
|
}
|
|
if (param('more')) {
|
|
$mix+=10 ;
|
|
param('mix', $mix);
|
|
}
|
|
if (!param()) {
|
|
param('best','20');
|
|
param('_3D','on');
|
|
}
|
|
&print_form;
|
|
&clean_up;
|
|
}
|
|
$q->print(p,
|
|
hr,
|
|
div({-class=>'sm'},
|
|
'Die Tarife der Provider ändern sich häufig und können daher ',
|
|
'eventuell ungenau sein. Wenn ein Tarif falsch sein sollte, wenden ',
|
|
'Sie sich bitte',
|
|
ul(li('in Österreich an ',
|
|
a({-href=>'mailto:reinelt@eunet.at?subject=Tarife'},
|
|
'Michael Reinelt')),
|
|
li('in Deutschland an ',
|
|
a({-href=>'mailto:rate-de@Joker.E.Ruhr.de?subject=Tarife'},
|
|
'die deutsche ISDN-Rate Crew'))),
|
|
' oder an den Autor dieses Pogrammes ',
|
|
a({-href=>'mailto:lt@toetsch.at?subject=Tarife'},'Leopold Tötsch.') ),
|
|
"\n"
|
|
);
|
|
$q->print(end_html);
|
|
|
|
1;
|
|
|
|
# subs
|
|
|
|
sub html_header {
|
|
my($title, $use_script) = @_;
|
|
my $script;
|
|
$q->print(header);
|
|
if ($use_script) {
|
|
$script = q(
|
|
tim = 0;
|
|
function start(but) {
|
|
if(document.form.Start.value=='Start') {
|
|
tim=setInterval("run()",1000);
|
|
document.form.len.value=0;
|
|
document.form.Start.value='Stop';
|
|
document.form.now.checked=false;
|
|
j=new Date();
|
|
document.form.day.value=j.getDate()+'.'+(j.getMonth()+1)+'.'+j.getYear();
|
|
document.form.hour.value=j.getHours()+':'+j.getMinutes()+':'+j.getSeconds();
|
|
}
|
|
else {
|
|
clearInterval(tim);
|
|
document.form.Start.value='Start';
|
|
}
|
|
}
|
|
function run() {
|
|
document.form.len.value++;
|
|
}
|
|
);#q
|
|
}
|
|
else {
|
|
$script='';
|
|
}
|
|
my $style = q(
|
|
<!--
|
|
.t {font-family:Sans Serif;font-size:10pt}
|
|
.sm {font-family:Sans Serif;font-size:9pt}
|
|
i {color:#000080}
|
|
h1,h2,h3,h4,p,td,th,body { font-family:Sans Serif,Arial }
|
|
-->
|
|
);
|
|
|
|
$q->print(start_html(-title=>$title, -bgcolor=>'#f0f0f0',
|
|
-script=> $script, -head=>style($style)),
|
|
h1({-align=>'center'},$title));
|
|
}
|
|
|
|
sub read_towns {
|
|
my($c, $t);
|
|
open(IN, $CODEF) || $q->print("Can't read $CODEF");
|
|
while (<IN>) {
|
|
chomp;
|
|
($c, $t) = split(/\t/,$_,2);
|
|
$towns{$c}=$t;
|
|
}
|
|
close(IN);
|
|
}
|
|
|
|
sub help {
|
|
my $help = 'help_'. $_[0];
|
|
image_button(-name=>$help, -src=>'/pic/help.gif', -border=>0);
|
|
}
|
|
|
|
sub show_help {
|
|
my $what = $_[0];
|
|
if ($what eq 'from') {
|
|
$q->print('Normalerweise weiß isdnrate, von wo Sie telefonieren. ',
|
|
'Sie können hier aber einen anderen Standort eingeben. ',
|
|
'Dann werden die Gebühren von dieser Vorwahl aus berechnet',
|
|
br,'Z.b. ', tt('02345'));
|
|
}
|
|
elsif($what eq 'tel') {
|
|
$q->print('Geben Sie die Nummer ein, zu der Sie die Gebühren ',
|
|
'berechnet haben möchten.',br,
|
|
ul(li(tt("1234\t"),'Ortsnetz'),
|
|
li(tt("012345\t"),'Anderer Ort'),
|
|
li(tt("00156789\t"),'Ausland'),
|
|
li(tt("[0]1012012345\t"),'Provider+Nummer')),
|
|
'oder wählen Sie aus der Liste der Städte oder Länder.',br,
|
|
'Hinweis: eine ausgewählte Stadt hat Priorität vor einem Land, ',
|
|
'dieses vor einer manuellen Eingabe.');
|
|
}
|
|
elsif($what eq 'len') {
|
|
$q->print('Wählen Sie hier Dauer und Zeitpunkt des Gesprächs. ',
|
|
'Die Dauer ist Standardmäßig in Sekunden anzugeben, Sie können ',
|
|
'aber auch durch anhängen eines ',i('m'),' die Dauer in Minuten ',
|
|
'eingeben, z.B. ',tt(i('2m 33')),'.',br,
|
|
'Mittels ',i('Start'),' können Sie aktuelle Gespräche mitstoppen ',
|
|
'und sich so die angefallenen Gesprächsgebühren anzeigen lassen.',br,
|
|
'Wenn ',i('Jetzt'),' nicht angekreuzt ist, können Sie einen beliebigen ',
|
|
'Zeitpunkt eingeben. Ist kein Tag angegeben, wird heute angenommen. ',
|
|
'Ist auch keine Uhrzeit angegeben, gilt der Zeitpunkt der Auswahlbox.');
|
|
}
|
|
elsif($what eq 'tab') {
|
|
$q->print('Mit der Schaltfläche ',i('Tabelle'),' erhalten Sie eine ',
|
|
'Aufstellung der Telefongebühen pro Provider.');
|
|
}
|
|
elsif($what eq 'graf') {
|
|
$q->print('Mit der Schaltfläche ',i('Grafik'),' erhalten Sie eine ',
|
|
'grafische Darstellung des Verlaufs der Telefongebühen bis ',
|
|
'zur gewählten Dauer. Damit sehen Sie sehr übersichtlich, ',
|
|
'ob der Provider Sekundentakt oder einen anderen vewendet.',
|
|
br
|
|
'Um kleinere Bilder (schneller) zu erhalten, verringern Sie die Größe ',
|
|
'und/oder schalten Sie ',i('3D'),' aus.');
|
|
}
|
|
elsif($what eq 'tag') {
|
|
$q->print('Die Schaltflächen ',i('Tag'),' und ',i('Woche'),' zeigen die ',
|
|
'Gebühren für die gewählte Dauer und den gewählten Tag im Verlauf ',
|
|
'eines Tages bzw. einer Woche.');
|
|
}
|
|
elsif($what eq 'prov') {
|
|
$q->print('Wählen Sie hier welche und wie viele Provider angzeigt werden. ',
|
|
'Sind ',i('nur Provider'),' angegeben, werden nur diese angezeigt. ',
|
|
'Sind ',i('nicht Provider'),' angegeben, werden diese nicht angezeigt.',
|
|
br,'Hinweis: wenn Sie mehrere Provider eingeben, trennen Sie diese ',
|
|
'mit einem Beistrich oder Leerzeichen. Sie können die ',
|
|
'Providernummer eingeben z.B. ',tt('01033,010050'),' oder auch in ',
|
|
'einer abgekürzten Variante, wobei Sie in Deutschland bei den ',
|
|
'6-stelligen Providernummern 100 addieren, also ',tt('33,150'),' für obiges Beispiel.',
|
|
br,i('Reset'),' stellt den vorhergehenden Zustand wieder her, ',
|
|
i('Löschen'),' löscht alle Eingabefelder, bzw. stellt Standardwerte ein.');
|
|
}
|
|
elsif($what eq 'mix') {
|
|
$q->print('Geben Sie die Nummer ein, zu der Sie die Gebühren ',
|
|
'berechnet haben möchten.',br,
|
|
ul(li(tt("1234\t"),'Ortsnetz'),
|
|
li(tt("012345\t"),'Anderer Ort'),
|
|
li(tt("00156789\t"),'Ausland'),
|
|
li(tt("Landesbezeichnung\t"),'Ausland'),
|
|
li(tt("[0]1012012345\t"),'Provider+Nummer')),
|
|
'Und wie oft Sie im Zeitraum, wie lange (in Sekunden) dorthin ',
|
|
'zu welcher Tageszeit durchschnittlich telefonieren.',br,
|
|
'Wenn Sie mehr Eingabefler benötigen, klicken Sie auf ',
|
|
i('Mehr'));
|
|
}
|
|
elsif($what eq 'tabm') {
|
|
$q->print('Sie erhalten eine Tabelle mit den Gesamtkosten ',
|
|
'sowie mit den einzelnen Teilen Ihres Gesprächsmix. ',
|
|
'Provider, die nicht alle Dienste zu Verfügung stellen ',
|
|
'werden mit ', tt(i('**')), ' markiert.');
|
|
}
|
|
elsif($what eq 'grafm') {
|
|
$q->print('Sie bekomme eine grafische Übersicht über Ihren ',
|
|
'gewählten Gesprächsmix. Jede Stufe im Diagramm zeigt ',
|
|
'die Gebühren für den jeweiligen Dienst. ',
|
|
'Rechst sehen Sie die Gesamkosten für all Gespräche',br,
|
|
'Provider, die nicht alle Dienste zu Verfügung stellen ',
|
|
'werden mit ', tt(i('**')), ' markiert.',
|
|
br
|
|
'Um kleinere Bilder (schneller) zu erhalten, verringern Sie die Größe ',
|
|
'und/oder schalten Sie ',i('3D'),' aus.');
|
|
}
|
|
if ($what =~ /tab|graf/) {
|
|
$q->print(br,'Sie können auf die Providernummer/-bezeichnung ',
|
|
'klicken um weitere Information über diesen Provider zu ',
|
|
'erhalten.');
|
|
}
|
|
}
|
|
|
|
sub print_form {
|
|
my($t, @cod, $i);
|
|
foreach $t (sort {$towns{$a} cmp $towns{$b} } (keys(%towns))) {
|
|
push(@cod, $t)
|
|
}
|
|
if (param()) {
|
|
$q->print(p, hr, h3('Neue Eingabe'));
|
|
}
|
|
else {
|
|
param('now','on');
|
|
param('best',20);
|
|
param('len',$DEFLEN);
|
|
}
|
|
my $t= q!$q->print(
|
|
start_form(-name=>'form'),
|
|
table({-border=>8},
|
|
Tr(td(table({-bgcolor=>'#ffffe0', -cellspacing=>0, -cellpadding=>0},
|
|
Tr(td([' ', b('Ich wähle von: ')]),
|
|
td({-colspan=>2},textfield(-name=>'from', -size=>20, -maxlength=>20)),
|
|
td([' ',
|
|
&help('from')])), !;
|
|
if ($mix) {
|
|
$t .= q!Tr([
|
|
td({-colspan=>6},hr),
|
|
td([' ',b('Und Telefoniere nach '),
|
|
b('So oft '),
|
|
b('So lang (s) '),
|
|
b('am'),&help('mix')]),
|
|
!;
|
|
for $i (0..$mix-1) {
|
|
my($ii)=$i+1;
|
|
$ii=qq('$ii ');
|
|
$t .= q!Tr(td([! . "$ii" .q!,textfield(-name=>"tel! .$i .q!", -size=>20, -maxlength=>20),
|
|
textfield(-name=>"oft! .$i .q!", -size=>4, -maxlength=>4),
|
|
textfield(-name=>"len! .$i .q!", -size=>4, -maxlength=>4),
|
|
popup_menu(-name=>"dday! .$i .q!", -values=> ['W','N'],
|
|
-labels=> {'W' =>'Tag','N'=>'Nacht'})!;
|
|
$t .= q!,submit('more','Mehr')! if($i==$mix-1);
|
|
$t .= q!])),!;
|
|
} # for
|
|
} # if mix
|
|
else {
|
|
$t .= q!Tr([
|
|
td({-colspan=>6},hr),
|
|
td([' ', '<b>nach</b> TelefonNummer: ',
|
|
textfield(-name=>'tel', -size=>20, -maxlength=>20),' ',
|
|
' ',&help('tel')])]),
|
|
Tr(
|
|
td([' ','oder Stadt: ']),
|
|
td({-colspan=>2},popup_menu(-name=>'town', -values=> \@cod, -labels=> \%towns)),
|
|
td([' ',' '])
|
|
),
|
|
Tr(
|
|
td([' ','oder Ausland: ']),
|
|
td({-colspan=>2},popup_menu(-name=>'country', -values=> \@countries)),
|
|
td([' ',' '])
|
|
),
|
|
Tr([
|
|
td({-colspan=>6},hr),
|
|
td([' ','<b>Dauer</b> s o. 2m 33',
|
|
textfield(-name=>'len', -size=>6, -maxlength=>6),
|
|
'Stoppuhr',
|
|
button(-name=>'Start',-value=>'Start', -onClick=>'start()'),
|
|
&help('len')]),
|
|
td([' ',checkbox(-name=>'now', -label=>'Jetzt - oder am'),
|
|
popup_menu(-name=>'dday', -values=> ['W','N','E'],
|
|
-labels=> {'W' =>'Werktag','N'=>'Nacht','E'=>'Sonntag'}),
|
|
' ',' ',' ']),
|
|
td([' ','oder um (hh[:mm[:ss]]) ',
|
|
textfield(-name=>'hour', -size=>8, -maxlength=>8),
|
|
'am (dd[.mm[.jj]]) ',
|
|
textfield(-name=>'day', -size=>10, -maxlength=>10),' ']),
|
|
!;
|
|
} # else mix
|
|
$t .= q!
|
|
td({-colspan=>6},hr),
|
|
td({-bgcolor=>'#ff80c0', colspan=>6, align=>'center'},b('Ausgabe')),
|
|
td({-bgcolor=>'#ffc080'},[' ',
|
|
submit('tab','Tabelle'),
|
|
!;
|
|
if ($mix) {
|
|
$t .= q!
|
|
'oder',
|
|
hidden(-name=>'mix', value=>$mix),
|
|
' ',
|
|
&help('tabm')]),
|
|
!;
|
|
}
|
|
else {
|
|
$t .= q!
|
|
'mit',
|
|
popup_menu(-name=>'explain', -values=> [0,1,2],
|
|
-labels=> {0 =>'Nur Kosten',1=>'Zonen',2=>'Details'}),
|
|
' ',
|
|
&help('tab')]),
|
|
!;
|
|
}
|
|
$t .= q!
|
|
td([ ' ',
|
|
submit('graf',' Grafik '),
|
|
'Größe',
|
|
popup_menu(-name=>'swidth', -values=> ['1024','800','640'],
|
|
-labels=> {'1024' =>'groß','800'=>'mittel','640'=>'klein'}),
|
|
checkbox(-name=>'_3D',label=>'3D'),
|
|
&help('grafm')]),
|
|
!;
|
|
if (!$mix) {
|
|
$t .= q!
|
|
td({-bgcolor=>'#ffdead'},[
|
|
' ',
|
|
submit('graf',' Tag '),
|
|
"oder Tagespreise",
|
|
' ',
|
|
' ',
|
|
&help('tag')]),
|
|
td({-bgcolor=>'#ffdead'},[
|
|
' ',
|
|
submit('graf','Woche '),
|
|
"oder Wochenpreise",
|
|
' ',' ',' '
|
|
]),
|
|
!;
|
|
}
|
|
$t .= q!
|
|
td({-colspan=>6},hr),
|
|
td([' ','der besten ',
|
|
textfield(-name=>'best', -size=>2, -maxlength=>2),
|
|
'Provider',' ',&help('prov')])
|
|
]),
|
|
Tr(
|
|
td([' ','oder nur Provider']),
|
|
td({-colspan=>2},textfield(-name=>'prov', -size=>20, -maxlength=>100)),
|
|
td([' ',' '])
|
|
),
|
|
Tr(
|
|
td([' ','oder nicht Provider']),
|
|
td({-colspan=>2},textfield(-name=>'xprov', -size=>20, -maxlength=>100)),
|
|
td([' ',' '])
|
|
),
|
|
Tr(
|
|
td([' ',' ',' ',
|
|
reset('Reset'),
|
|
!;
|
|
if ($mix) {
|
|
$t .= q!submit('clear','Löschen'),!;
|
|
}
|
|
else {
|
|
$t .= q!defaults('Löschen'),!;
|
|
}
|
|
$t .= q!
|
|
' '])
|
|
)
|
|
)))),
|
|
end_form);
|
|
!;
|
|
eval($t);
|
|
# uff
|
|
}
|
|
|
|
sub del_vbn {
|
|
my @p = split(/,/, $_[0]);
|
|
my (@np, $ret);
|
|
foreach (@p) {
|
|
if (s/^0?10//) {
|
|
$_=100+$_ if (length($_) == 3);
|
|
}
|
|
push(@np, $_);
|
|
}
|
|
$ret=join(',',@np);
|
|
$ret;
|
|
}
|
|
sub parse_len {
|
|
my $l = $_[0];
|
|
if ($l =~ /(\d+)\s*m\s*(\d)\s*s?/) {
|
|
60*$1+$2;
|
|
}
|
|
else {
|
|
$l =~ /(\d+)/;
|
|
$1;
|
|
}
|
|
}
|
|
sub call_isdnrate {
|
|
my ($hour, $day);
|
|
my ($lines) = @_;
|
|
my ($now, $explain, $tel, $from, $best, $prov);
|
|
if (param('town') != '0' && !$mix) {
|
|
param('country', $LEER);
|
|
$tel = '0'.param('town');
|
|
param('tel',$tel);
|
|
}
|
|
elsif (param('country') !~ /--/ && !$mix) {
|
|
param('tel','');
|
|
param('town', $LEER);
|
|
$tel=param('country');
|
|
}
|
|
else {
|
|
$tel = param('tel');
|
|
}
|
|
$tel =~s/ /_/g; # preserv spaces
|
|
return if($tel eq '');
|
|
my @args=($ISDNRATE,"-H", $tel);
|
|
unless (param('now')) {
|
|
push(@args, "-h$hour") if ($hour=param('hour'));
|
|
push(@args, "-d$day") if ($day=param('day')||param('hour')?param('day'):param('dday'));
|
|
}
|
|
if ($prov=param('xprov')) {
|
|
$prov =~ s/\s+/,/g;
|
|
$prov=&del_vbn($prov);
|
|
push(@args, "-x$prov");
|
|
}
|
|
elsif ($prov=param('prov')) {
|
|
$prov =~ s/\s/,/g;
|
|
$prov=&del_vbn($prov);
|
|
push(@args, "-p$prov");
|
|
}
|
|
push(@args, "-f$from") if ($from=param('from'));
|
|
if (param('graf') && !$mix) {
|
|
push(@args,$weekly? '-G98':$daily?'-G97':'-G99');
|
|
}
|
|
else {
|
|
push(@args, "-X$explain") if ($explain=param('explain'));
|
|
}
|
|
$len=&parse_len(param('len')) || $DEFLEN;
|
|
$len=&min($len, 1200);
|
|
param('len', $len);
|
|
push(@args, "-l$len");
|
|
$best=param('best') || 20;
|
|
param('best', $best>0 ? $best: 20);
|
|
push(@args, "-b$best") ;
|
|
print "<pre>@args</pre>" if($debug);
|
|
if ($use_sockets) {
|
|
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die("socket: $!");
|
|
connect(SOCK, sockaddr_un($server)) || die("connect: $!");
|
|
SOCK->autoflush(0);
|
|
shift(@args);
|
|
foreach (@args) {
|
|
print SOCK "$_ ";
|
|
}
|
|
SOCK->autoflush(1);
|
|
my $line;
|
|
while (defined($line = <SOCK>)) {
|
|
push(@$lines, $line);
|
|
}
|
|
close(SOCK);
|
|
}
|
|
else {
|
|
open(PIPE, "-|") || exec(@args) == 0 or die "Can't @args: $?";
|
|
@$lines = <PIPE>;
|
|
close(PIPE);
|
|
}
|
|
}
|
|
|
|
sub round {
|
|
$_[0] == 0 ? '--.--': sprintf("%.4f", $_[0]);
|
|
}
|
|
|
|
sub call_mix {
|
|
my ($lines) = @_;
|
|
my ($n, $N);
|
|
my (%pcost, %ptot, $ch, %pstring, %lines);
|
|
my ($pnum, $prov, $cur, $charge, $rest);
|
|
# kill empty
|
|
foreach $n (0..$mix-1) {
|
|
next if(param("tel$n") && param("oft$n") && param("len$n"));
|
|
# $n is empty
|
|
foreach $N ($n+1..$mix-1) {
|
|
if(param("tel$N") && param("oft$N") && param("len$N")) {
|
|
foreach ('tel','oft','len','dday') {
|
|
param("$_$n", param("$_$N"));
|
|
param("$_$N", '');
|
|
} #for
|
|
last;
|
|
}#if
|
|
}
|
|
}
|
|
$N=0;
|
|
foreach $n (0..$mix-1) {
|
|
my(@one);
|
|
last unless(param("tel$n") && param("oft$n") && param("len$n"));
|
|
param('tel', param("tel$n"));
|
|
param('len', param("len$n"));
|
|
param('dday', param("dday$n"));
|
|
&call_isdnrate(\@one);
|
|
shift(@one); # -H
|
|
shift(@one); # empty
|
|
foreach (@one) {
|
|
($pnum, $prov, $cur, $charge, $rest) = &split_line($_);
|
|
$ptot{$pnum} += ($ch=&round($charge * param("oft$n")));
|
|
$pstring{$pnum} = $prov;
|
|
$pcost{$pnum}[$N]= $ch;
|
|
$lines{$pnum}++;
|
|
}
|
|
$N++;
|
|
}
|
|
param('mix', &min($N+5,$mix));
|
|
$len=$N+1;
|
|
foreach $pnum (keys(%lines)) {
|
|
$pstring{$pnum} .= ' **' if($lines{$pnum}<$N);
|
|
}
|
|
if (param('tab')) {
|
|
param('explain',1);
|
|
foreach $pnum (sort { $ptot{$a} <=> $ptot{$b} } (keys(%ptot))) {
|
|
$rest = '';
|
|
foreach (@{ $pcost{$pnum} }) {
|
|
$ch = &round($_);
|
|
$rest .= qq(</font></td><td align="right"><font size=-1><b>$ch</b> );
|
|
}
|
|
$prov = $pstring{$pnum};
|
|
$ch = $ptot{$pnum};
|
|
push(@$lines, "$pnum:$prov $cur $ch $rest");
|
|
}
|
|
}
|
|
else { # graf
|
|
foreach $pnum (keys(%ptot)) {
|
|
push(@$lines, "@ $pnum"); # start
|
|
$ch = 0;
|
|
foreach $n (0..$N-1) {
|
|
$ch += 0+&round($pcost{$pnum}[$n]);
|
|
push(@$lines, "$n $ch");
|
|
}
|
|
push(@$lines, "$N $ch");
|
|
$prov = $pstring{$pnum};
|
|
push(@$lines, "@---- $cur $prov"); # end
|
|
}
|
|
}
|
|
}
|
|
|
|
sub print_table {
|
|
my (@lines);
|
|
my($pnum, $prov, $cur, $charge, $bgcolor, $i, $rest, $url);
|
|
if ($mix) {
|
|
&call_mix(\@lines);
|
|
}
|
|
else {
|
|
&call_isdnrate(\@lines);
|
|
$lines[0] = &fmt_date($lines[0]);
|
|
$q->print(p({-class=>'t'},$lines[0]));
|
|
shift(@lines); # -H
|
|
shift(@lines); # empty
|
|
}
|
|
(undef, $cur) = split(/ +/, $lines[0]);
|
|
$q->print("<table><tr><th>Nr.</th><th>Provider</th><th>$cur</th>");
|
|
$q->print("<th>Info</th>") if(param('explain'));
|
|
if ($mix) {
|
|
for($i=1;$i<$len;$i++) {
|
|
$q->print("<th>$i</th>");
|
|
}
|
|
}
|
|
$q->print("</tr>\n");
|
|
$i=0;
|
|
foreach (@lines) {
|
|
($pnum, $prov, $cur, $charge, $rest) = &split_line($_);
|
|
$charge=&round($charge);
|
|
$url{$pnum}=$q->self_url ."&info=$pnum";
|
|
$url=a({-href=>$url{$pnum}}, $prov);
|
|
$bgcolor=++$i&1?' bgcolor="#e0e0e0"':'';
|
|
$q->print(qq(<tr$bgcolor><td>$pnum</td><td>$url </td><td align="right">$charge</td>));
|
|
$q->print(qq(<td><font size="-1"> $rest</font></td>)) if(param('explain'));
|
|
$q->print("</tr>\n");
|
|
}
|
|
$q->print("</table>\n");
|
|
$q->print(p({-class=>'t'},
|
|
'Bitte beachten Sie, daß Wechsel in der Taktung in der Tabelle ',
|
|
'nicht angezeigt werden, diese aber sehr wohl in der Berechnung ',
|
|
'berücksichtig werden.'));
|
|
|
|
}
|
|
|
|
sub split_line {
|
|
my $l = $_[0];
|
|
my ($pnum,$prov, $cur, $charge, $rest);
|
|
($prov, $cur, $charge) = split(/ +/, $l);
|
|
($pnum,$prov) = split(/:/, $prov);
|
|
if(param('explain')) {
|
|
($charge,$rest) = split(/ /, $charge, 2);
|
|
$rest =~ s/0+s/0s/g;
|
|
}
|
|
($pnum,$prov, $cur, $charge, $rest);
|
|
}
|
|
|
|
sub fmt_date {
|
|
my %days=(Mon=>'Mo',Tue=>'Di',Wed=>'Mi',Thu=>'Do',Fri=>'Fr',Sat=>'Sa',Sun=>'So');
|
|
my %mons=(Mar=>'Mär',May=>'Mai',Oct=>'Okt',Dez=>'Dez');
|
|
my ($db, $m, $d, $t, $y, $k);
|
|
if ($_[0] =~ m/(\d+) Sekunden/) {
|
|
$k = $&;
|
|
$d = $1;
|
|
if ($d >= 60) {
|
|
$m = int($d / 60);
|
|
$d = $d % 60;
|
|
my $mn = $m > 1 ? 'n' : '';
|
|
my $sn = $d > 1 ? 'n' : '';
|
|
my $st = $d ? " $d Sekunde$sn": '';
|
|
$_[0] =~ s/$k/$m Minute$mn$st/;
|
|
}
|
|
}
|
|
if ($_[0] =~ s/(\w{3}) (\w{3}) (\d\d?) (\S{8}) (\d{4})//) {
|
|
($db, $m, $d, $t, $y) = ($1,$2,$3,$4,$5);
|
|
$db=$days{$db};
|
|
$m=$mons{$m} ? $mons{$m} : $m;
|
|
$t = '' if($daily);
|
|
$_[0] .= "$db $d. $m $y um $t" unless($weekly);
|
|
}
|
|
$_[0];
|
|
}
|
|
|
|
sub min {
|
|
$_[0] < $_[1] ? $_[0] : $_[1];
|
|
}
|
|
sub max {
|
|
$_[0] > $_[1] ? $_[0] : $_[1];
|
|
}
|
|
sub fmts {
|
|
my($h,$m,$s);
|
|
$s = $_[0];
|
|
$h = int($s/3600); $s -= $h*3600; $h='' unless($h); $h .= 'h' if($h);
|
|
$m = int($s/60); $s -= $m*60; $m='' unless($m);$m .= 'm' if($m);
|
|
$s='' unless($s);$s .= 's' if($s);
|
|
"$h$m$s";
|
|
}
|
|
my($H, $xo, $yo, $xs, $ys, $sy, $DEP);
|
|
sub make_graf {
|
|
my ($W,$LEG,$LIN,$white,$black,$lgrey,$dgrey,$llgrey,$borcol,$tempf,$i);
|
|
my (@lines, $n, $dx, @rawcolors, @colors, %pstring, %unused);
|
|
my ($prov, $cur, $charge, $pnum, %pc, %pt, $r, $g, $bl);
|
|
my ($swidth, %dim);
|
|
$swidth=param('swidth')||1024;
|
|
# dimensions
|
|
%dim = (1024=>[600,300,190], 800=>[500,240,180],640=>[300,200,180]);
|
|
$W=$dim{$swidth}[0];
|
|
$H=$dim{$swidth}[1];
|
|
$LEG=$dim{$swidth}[2];
|
|
$DEP=$H/2;
|
|
$LIN=10;
|
|
$dx = 10;
|
|
$xo=35; $yo=20;
|
|
# make some colors
|
|
$n=0;
|
|
foreach $g ('00','33','66','99') {
|
|
foreach $r ('00','33','66','99') {
|
|
foreach $bl ('00','33','66','99') {
|
|
$i= ++$n*29 % (4*4*4);
|
|
push(@rawcolors, "$i-0x$r-0x$g-0x$bl");
|
|
}
|
|
}
|
|
}
|
|
@rawcolors=sort(@rawcolors);
|
|
# get data
|
|
my ($text);
|
|
if ($mix) {
|
|
&call_mix(\@lines);
|
|
}
|
|
else {
|
|
&call_isdnrate(\@lines);
|
|
}
|
|
foreach (@lines) {
|
|
if (/^\@--+ (\S+) (\S.*)/) { # end
|
|
if (($pnum && $#{ $pc{$pnum} } == 0) || $2 eq '(null)') { # any data
|
|
pop( @{ $pt{$pnum} } );
|
|
pop( @{ $pc{$pnum} } );
|
|
delete $pstring{$pnum};
|
|
$unused{$pnum}++;
|
|
next;
|
|
}
|
|
$pstring{$pnum} = $2;
|
|
$cur=$1;
|
|
if ($daily || $weekly) {
|
|
push( @{ $pt{$pnum} }, $daily?24:7*24); # time
|
|
push( @{ $pc{$pnum} }, $pc{$pnum}[0]); # charge
|
|
}
|
|
$url{$pnum}=$q->self_url ."&info=$pnum";
|
|
$pnum = '';
|
|
}
|
|
elsif (/^\@ (\d+)/) { # start
|
|
$pnum=$1;
|
|
if (!$daily && !$weekly && !$mix) {
|
|
push( @{ $pt{$pnum} }, 0); # time
|
|
push( @{ $pc{$pnum} }, 0); # charge
|
|
}
|
|
}
|
|
elsif (/(\d+) (\d+(\.\d+)?)/ && $pnum) {
|
|
push( @{ $pt{$pnum} }, $1==1&&!$mix?0.1:$1); # time
|
|
push( @{ $pc{$pnum} }, $2); # charge
|
|
}
|
|
elsif (/ekunden/) { # -H text
|
|
$text = $_;
|
|
}
|
|
}
|
|
# info
|
|
$text = &fmt_date($text);
|
|
$q->print(p({-class=>'t'},$text));
|
|
|
|
my ($p, $max, $dy, $my, $min);
|
|
$max=$n=0;
|
|
$min = 99999;
|
|
|
|
# sorting cheapest 1.
|
|
sub bylast { $pc{$a}[$#{$pc{$a}}] <=> $pc{$b}[$#{$pc{$b}}] }
|
|
sub byav {
|
|
my ($v, $sa, $sb);
|
|
foreach $v (0..$#{ $pc{$a} }) {
|
|
$sa += $pc{$a}[$v];
|
|
}
|
|
foreach $v (0..$#{ $pc{$b} }) {
|
|
$sb += $pc{$b}[$v];
|
|
}
|
|
$sa <=> $sb;
|
|
}
|
|
my(@all, $sortfunc);
|
|
$sortfunc = $daily||$weekly ? \*byav : \*bylast;
|
|
foreach $p (sort $sortfunc (keys(%pstring))) {
|
|
push(@all, $p);
|
|
# calc max
|
|
foreach $i (0 .. $#{ $pc{$p} }) {
|
|
$max = $pc{$p}[$i] if ($pc{$p}[$i] > $max);
|
|
$min = $pc{$p}[$i] if ($pc{$p}[$i] < $min);
|
|
}
|
|
last if (++$n >= param('best'));
|
|
}
|
|
return unless($n);
|
|
@all=reverse(@all);
|
|
my ($font, $tx, $lw);
|
|
$font = GD::gdMediumBoldFont;
|
|
$lw = int($DEP/$n);
|
|
$DEP=$lw*$n;
|
|
if (!param('_3D')) {
|
|
$DEP=0;$lw=2;
|
|
$LIN=50;
|
|
}
|
|
# make img
|
|
my $im = new GD::Image($W+$LEG+$DEP, $H+$DEP);
|
|
# alloc colors
|
|
my(%rcols);
|
|
my $c = 0;
|
|
foreach $p (@all) {
|
|
(undef, $r, $g, $b) = split(/-/, $rawcolors[$c++]);
|
|
$rcols{$p} = $im->colorAllocate(eval($r), eval($g), eval($b));
|
|
}
|
|
$white = $im->colorAllocate(255,255,255);
|
|
$llgrey = $im->colorAllocate(0xf0,0xf0,0xf0);
|
|
$im->transparent($llgrey);
|
|
$lgrey = $im->colorAllocate(0xe0,0xe0,0xe0);
|
|
$dgrey = $im->colorAllocate(0x80,0x80,0x80);
|
|
$black = $im->colorAllocate(0,0,0);
|
|
$borcol =$im->colorAllocate(0xff,0xff,0xe0);
|
|
# all transparent
|
|
$im->filledRectangle(0,0,$W+$LEG-1+$DEP,$H-1+$DEP,$llgrey);
|
|
# drawing region
|
|
my $poly = new GD::Polygon;
|
|
$poly->addPt($DEP,0);
|
|
$poly->addPt($xo,$DEP);
|
|
$poly->addPt($xo,$DEP+$H);
|
|
$poly->addPt($W,$DEP+$H);
|
|
$poly->addPt($W+$DEP,$H);
|
|
$poly->addPt($W+$DEP,0);
|
|
$im->filledPolygon($poly, $white);
|
|
# draw axis region
|
|
my $poly = new GD::Polygon;
|
|
$poly->addPt(0,$DEP+0);
|
|
$poly->addPt(0,$DEP+$H-1);
|
|
$poly->addPt($W-1,$DEP+$H-1);
|
|
$poly->addPt($DEP+$W-1,$H-1);
|
|
$poly->addPt($DEP+$W-1,$H-1-$yo);
|
|
$poly->addPt($W-1,$DEP+$H-$yo);
|
|
$poly->addPt($xo,$DEP+$H-$yo);
|
|
$poly->addPt($xo,$DEP+0);
|
|
$poly->addPt($DEP+$xo,0);
|
|
$poly->addPt($DEP,0);
|
|
# borders
|
|
$im->rectangle($DEP+$xo,0,$DEP+$W-1,$H-$yo,$black);
|
|
$im->line($W,$DEP,$W+$DEP,0,$black);
|
|
$im->line($xo,$H+$DEP-$yo,$xo+$DEP,$H-$yo,$black);
|
|
$im->filledPolygon($poly, $borcol);
|
|
$im->polygon($poly, $black);
|
|
$im->line($W-1, $DEP+$H-1, $W-1, $DEP+$H-$yo, $black); # last x-tick
|
|
|
|
my ($x,$y);
|
|
# y-scaling
|
|
($sy,$my,$dy) = _best_ends($min, $max,4..6);
|
|
$dy = ($my-$sy)/$dy;
|
|
$ys = ($H-$yo)/($my-$sy);
|
|
# y-axis
|
|
sub yaxis {
|
|
my($fg) = $_[0];
|
|
my($col) = $fg?$lgrey:$dgrey;
|
|
for ($i = $sy; $i <= $my; $i+=$dy) {
|
|
$y = &_y($i);
|
|
$im->line($i<$my&&$i?$xo/2:0, $y,$xo,$y,$black) if($fg); # tick
|
|
if($i<$my && $i>$sy) {
|
|
if($fg) {
|
|
$im->line($xo+1, $y,$W-1,$y,$col);
|
|
}
|
|
else {
|
|
$im->line($xo+1, $y,$xo+1+$DEP,$y-$DEP,$col);
|
|
$im->line($DEP+$xo+1, $y-$DEP,$DEP+$W-1,$y-$DEP,$col);
|
|
}
|
|
}
|
|
$im->string($font, 4, $y+2, $i, $black); # price
|
|
}
|
|
$im->string($font, 4, &_y($my)+3+$font->height, $cur, $black);
|
|
} #yaxis
|
|
|
|
# x-scaling
|
|
if ($weekly) {
|
|
$len=7*24+1;
|
|
$dx=1;
|
|
}
|
|
elsif ($daily) {
|
|
$len=25;
|
|
$dx=2;
|
|
}
|
|
elsif ($mix) {
|
|
$dx=1;
|
|
}
|
|
else {
|
|
$dx = $len>240 ? 60 : $len>=120 ? 20 : 10;
|
|
}
|
|
$xs = ($W-$xo)/($len-1);
|
|
# x-axis
|
|
sub xaxis {
|
|
my($fg) = $_[0];
|
|
my @days= qw(Mo Di Mi Do Fr Sa So);
|
|
my($col) = $fg?$lgrey:$dgrey;
|
|
for ($i = 0; $i < $len-1; $i+=$dx) {
|
|
if (($weekly && $i%8==0) || !$weekly) {
|
|
$x = &_x($i);
|
|
$im->line($x, $DEP+$H-$yo/2, $x, $DEP+$H-$yo, $black); # tick
|
|
if ($i) {
|
|
if($fg) {
|
|
$im->line($x, $DEP+$H-$yo-1, $x, $DEP+1, $col);
|
|
}
|
|
else {
|
|
$im->line($DEP+$x, $H-$yo-1, $DEP+$x, 1, $col);
|
|
$im->line($x, $DEP+$H-$yo-1, $DEP+$x, $H-1-$yo, $col);
|
|
}
|
|
}
|
|
}
|
|
next unless($fg);
|
|
if ($weekly) {
|
|
$tx='';
|
|
if ($i % 8==0) {
|
|
$tx = $i % 24 == 0 ? $days[$i/24] : $i % 24;
|
|
}
|
|
}
|
|
elsif ($daily) {
|
|
$tx = $i;
|
|
}
|
|
elsif ($mix) {
|
|
$tx = &fmts(param("len$i")*param("oft$i")) .
|
|
param("dday$i") . '=>'. substr(param("tel$i"),0,4);
|
|
}
|
|
else {
|
|
$tx = $i == $dx*(int($len/$dx)-1) ? $i ." s" : $i; # nn s
|
|
}
|
|
$im->string($font, &_x($i)+3, $DEP+$H-$yo+2, $tx, $black);
|
|
}
|
|
} # xaxis
|
|
# data
|
|
&yaxis(0);
|
|
&xaxis(0);
|
|
#goto nodata;
|
|
my ($ii,$k,$x2,$y2,$col, $dep);
|
|
$dep=$DEP-$lw if($DEP);
|
|
foreach $p (@all) {
|
|
foreach $i (0..$#{ $pc{$p} }-1) {
|
|
$ii=$i+1;
|
|
$x = &_x($pt{$p}[$i]);
|
|
$x2 = &_x($pt{$p}[$ii]);
|
|
$y = &_y($pc{$p}[$i]);
|
|
$y2 = &_y($pc{$p}[$ii]);
|
|
if ($i==0 && $y2 && $DEP) {
|
|
for $k ($dep ..$dep+$lw-2) {
|
|
$im->line($k+$x2, -$k+$y2-1, $k+$x2,-$k+&_y($sy)-3,
|
|
$k==$dep ?$rcols{$p} :$lgrey);
|
|
}
|
|
}
|
|
$im->filledRectangle($dep+$x,-$dep+$y,$dep+$x2,-$dep+&_y($sy),$lgrey) if(0);
|
|
for ($k=$dep+$lw-1;$k>=$dep;$k--) {
|
|
$col = $k>$dep||!$DEP?$rcols{$p}:$black;
|
|
if ($pt{$p}[$i]+1 == $pt{$p}[$ii] && !$daily && !$weekly && !$mix) {
|
|
$im->line($k+$x, -$k+$y,$k+$x2, -$k+$y2, $col);
|
|
}
|
|
else {
|
|
$im->line($k+$x, -$k+$y, $k+$x2, -$k+$y,$col);
|
|
$im->line($k+$x2,-$k+$y, $k+$x2, -$k+$y2,$col);
|
|
}
|
|
}
|
|
}
|
|
if ($DEP) {
|
|
for $k ($dep ..$dep+$lw-2) {
|
|
$im->line($k+$x2, -$k+$y2-1, $k+$x2,-$k+&_y($sy)-3,
|
|
$k==$dep ?$rcols{$p} :$lgrey);
|
|
}
|
|
}
|
|
$dep-=$lw if($DEP);
|
|
}
|
|
nodata:
|
|
&yaxis(1);
|
|
&xaxis(1);
|
|
#goto nolegend;
|
|
# legend
|
|
my ($ndy, $sty, $mapx, $mapy, @map);
|
|
$y=$H-$yo+$DEP;
|
|
$i=min($n, $y/($font->height + 1));
|
|
$dep=$lw/2;
|
|
foreach $p (reverse(@all)) {
|
|
$ndy = ($font->height + 1)*$i;
|
|
$sty = &_y($pc{$p}[$#{$pc{$p}}])-$dep;
|
|
$y = max($ndy,min($y,$sty));
|
|
$im->dashedLine($W+2+$dep,$sty, $W+$LIN+$DEP,$y, $rcols{$p});
|
|
$im->dashedLine($W+2+$dep+1,$sty-1, $W+$LIN+$DEP+1,$y-1, $rcols{$p});
|
|
$im->string($font, $mapx=$W+$LIN+5+$DEP, $mapy=$y-$font->height/2, "$p ".$pstring{$p}, $rcols{$p});
|
|
&add_map($p, $mapx, $mapy, $font->height, $W+$LEG+$DEP, \@map);
|
|
$y -= $font->height+1;
|
|
$dep+=$lw if($DEP);
|
|
$i--;
|
|
}
|
|
nolegend:
|
|
# front box lines
|
|
$im->line($xo+1,$DEP,$W-1,$DEP,!$DEP?$black:$lgrey);
|
|
$im->line($W-1,$DEP,$W-1,$DEP+$H-1-$yo,!$DEP?$black:$lgrey);
|
|
$im->line($W,$DEP,$DEP+$W-1,1,$lgrey) if($DEP);
|
|
# write file
|
|
$tempf = `$MKTEMP -q "$tempdir/irXXXXXX"`;
|
|
chomp($tempf);
|
|
rename($tempf, "$tempf.gif") || $q->print(p,"Can't rename $tempf");;
|
|
$tempf = "$tempf.gif";
|
|
open(TEMP,">$tempf") || $q->print(p,"Can't write $tempf");
|
|
print(TEMP $im->gif);
|
|
close(TEMP);
|
|
# ret img tag
|
|
$tempf =~ s!^$tempdir/!!;
|
|
$q->print(qq(<MAP NAME="map">\n));
|
|
foreach (@map) {
|
|
$q->print("$_\n");
|
|
}
|
|
$q->print(qq(</MAP>\n));
|
|
$q->print(img({-src=>"$tempdir_url/$tempf", -height=>$H+$DEP, -border=>0,
|
|
-width=>$W+$LEG+$DEP, -align=>'"CENTER"', -usemap=>'#map'}));
|
|
}
|
|
|
|
sub add_map {
|
|
my ($p, $mapx, $mapy, $height, $width, $mref) = @_;
|
|
my($xu,$yu, $url);
|
|
$mapx=int($mapx);
|
|
$mapy=int($mapy);
|
|
$xu=int($width-2);
|
|
$yu=int($mapy+$height);
|
|
$url=$url{$p};
|
|
push(@$mref,qq(<AREA SHAPE="RECT" COORDS="$mapx,$mapy,$xu,$yu" href="$url">));
|
|
}
|
|
sub _y {
|
|
$DEP+$H-$yo-($_[0]-$sy)*$ys;
|
|
}
|
|
sub _x {
|
|
$xo+$_[0]*$xs;
|
|
}
|
|
|
|
# del gifs older then 1 hour
|
|
sub clean_up {
|
|
my(@All, $file, $now);
|
|
opendir(DIR, $tempdir);
|
|
@All = readdir(DIR);
|
|
closedir(DIR);
|
|
$now=time();
|
|
foreach $file (@All) {
|
|
if($now - (stat("$tempdir/$file"))[9] > 3600 && $file =~ /^ir.{6}\.gif/) {
|
|
unlink("$tempdir/$file");
|
|
}
|
|
}
|
|
}
|
|
|
|
# info: show info for provider
|
|
sub info {
|
|
my($pnum) = $_[0];
|
|
my(@lines, $l, $prov, $cur, $charge, $rest, $day, $text, $fromgraf, $sav_q);
|
|
$q->delete('info');
|
|
$fromgraf=param('graf');
|
|
$q->delete('graf');
|
|
CGI::delete('graf'); #??
|
|
$sav_q=$q->query_string;
|
|
param('prov', $pnum);
|
|
param('tab','Tabelle');
|
|
param('xprov','');
|
|
param('explain', 2);
|
|
param('now','');
|
|
for $day ('W', 'N') { #
|
|
param('day',$day);
|
|
for $l (1,140) {
|
|
my (@one);
|
|
param('len', $l);
|
|
call_isdnrate(\@one);
|
|
# -H & empty
|
|
$text = $one[0] unless($text);
|
|
print(pre(@one)) if($debug==2);
|
|
(undef, $prov, $cur, $charge, $rest) = &split_line($one[2]);
|
|
push(@lines, $rest);
|
|
}
|
|
}
|
|
# restore q/Q
|
|
$q = new CGI($sav_q);
|
|
|
|
# print report
|
|
$q->print(h2('Provider',$pnum,'-', $prov),h3('Tarifinfo'));
|
|
$q->print(pre(@lines)) if($debug);
|
|
my (@unit, @dur, @mp, $i, $zone, $day, @time);
|
|
$i=0;
|
|
foreach (@lines) {
|
|
m!((\d+\.)?\d+) # unit 1
|
|
.*?/((\d+\.)?\d+)s # cur/dur 3
|
|
\s=\s((\d+\.)?\d+) # mp 5
|
|
\s.*?\( # explain
|
|
([^,]+) # zone? 7
|
|
,\s(\S+)(\s\(.+?\))? # day day? 8
|
|
(,\s?(.+?))?\)!x; # time 11
|
|
($unit[$i], $dur[$i], $mp[$i], $zone, $day,$time[$i]) = ($1, $3, $5, $7, $8, $11);
|
|
$q->print("$unit[$i], $dur[$i], $mp[$i], $zone") if($debug==2);
|
|
$i++;
|
|
}
|
|
@time=qw(Tag Tag Abend Abend) unless $time[0];
|
|
$text =~ s/^.*?indung //;
|
|
$text =~ s/ kost.*//;
|
|
$q->print("Bei einem Gespräch ($text) in der Zone '$zone' ",
|
|
'sind die Tarifseinheiten ');
|
|
my $any=0;
|
|
for ($i = 1; $i <= $#unit; $i++) {
|
|
if ($unit[0] != $unit[$i]) {
|
|
$any=1;
|
|
last;
|
|
}
|
|
}
|
|
if ($any) {
|
|
$q->print("unterschiedlich teuer, am Tag ($time[1]), $unit[1], ",
|
|
"sonst ($time[3]) $unit[3] $cur.");
|
|
$q->param('prov', $pnum);
|
|
$q->param('graf', 'Tag');
|
|
$q->delete('_3D');
|
|
$q->delete('tab');
|
|
$q->print(br,'Für eine genauere Gültigkeit der Preise wählen ',
|
|
'Sie bitte die ',a({-href=>$q->self_url},'Tagesübersicht'),'.');
|
|
$q = new CGI($sav_q);
|
|
}
|
|
else {
|
|
$q->print('gleich teuer, und zwar ', $unit[0], " $cur",'.');
|
|
}
|
|
$any=0;
|
|
for ($i = 1; $i <= $#dur; $i++) {
|
|
if ($dur[0] != $dur[$i]) {
|
|
$any=1;
|
|
last;
|
|
}
|
|
}
|
|
if (!$any) {
|
|
$q->print(br,"Die Impulsdauer ist einheitlich $dur[0]s.");
|
|
}
|
|
elsif ($dur[0] == $dur[1]) {
|
|
$q->print(br,"Die Impulsdauer ist am Tag $dur[1]s, sonst $dur[3]s.");
|
|
}
|
|
else {
|
|
$q->print(br,"Der Provider scheint einen Mindestgesprächsgebühr von ",
|
|
"$unit[0] $cur zu verrechnen");
|
|
$q->print(", bzw. dauert der erste Taktimpuls $dur[0]s, sonst $dur[3]s") if($dur[0]);
|
|
$q->print(".");
|
|
}
|
|
$any=0;
|
|
for ($i = 1; $i <= $#mp; $i++) {
|
|
if ($mp[0] != $mp[$i]) {
|
|
$any=1;
|
|
last;
|
|
}
|
|
}
|
|
$q->print(br,"Das führt in der genannten Zone zu einem Minutenpreis ");
|
|
if($any) {
|
|
$q->print("von am Tag $mp[1], sonst $mp[3] $cur.");
|
|
}
|
|
else {
|
|
$q->print("von einheitlich $mp[3] $cur.");
|
|
}
|
|
$q->print(p,hr,h3('Verzonungsinfo'),p('TODO'));
|
|
$q->print(p,hr,h3('Gebühren'),p('TODO'));
|
|
$q->print(p,hr,h3('Kontakt'));
|
|
$q->print(table(Tr([
|
|
td(['Adresse','Todo']),
|
|
td(['Homepage','Todo']),
|
|
td(['Hotline','Todo']),
|
|
td(['Telefon','Todo']),
|
|
td(['Telefax','Todo'])
|
|
])));
|
|
param('graf',$fromgraf);
|
|
$q->param('graf',$fromgraf);
|
|
$q->print(p,hr, a({-href=>'javascript:history.back()'},'[ JS:Zurück ]'),
|
|
a({-href=>$q->self_url},'[ Zurück ]'));
|
|
}
|
|
|
|
|
|
# next is from GIFgraph
|
|
|
|
# Usage:
|
|
# ($nmin,$nmax,$nint) = _best_ends(247, 508);
|
|
# ($nmin,$nmax) = _best_ends(247, 508, 5);
|
|
# use 5 intervals
|
|
# ($nmin,$nmax,$nint) = _best_ends(247, 508, 4..7);
|
|
# best of 4,5,6,7 intervals
|
|
|
|
sub _best_ends {
|
|
my ($min, $max, @n) = @_;
|
|
my ($best_min, $best_max, $best_num) = ($min, $max, 1);
|
|
|
|
# fix endpoints, fix intervals, set defaults
|
|
($min, $max) = ($max, $min) if ($min > $max);
|
|
($min, $max) = ($min) ? ($min * 0.5, $min * 1.5) : (-1,1)
|
|
if ($max == $min);
|
|
@n = (3..6) if (@n <= 0 || $n[0] =~ /auto/i);
|
|
my $best_fit = 1e30;
|
|
my $range = $max - $min;
|
|
|
|
# create array of interval sizes
|
|
my $s = 1;
|
|
while ($s < $range) { $s *= 10 }
|
|
while ($s > $range) { $s /= 10 }
|
|
my @step = map {$_ * $s} (0.2, 0.5, 1, 2, 5);
|
|
|
|
for (@n)
|
|
{
|
|
# Try all numbers of intervals
|
|
my $n = $_;
|
|
next if ($n < 1);
|
|
for (@step)
|
|
{
|
|
next if ($n != 1) && ($_ < $range/$n); # $step too small
|
|
|
|
my $nice_min = $_ * int($min/$_);
|
|
$nice_min -= $_ if ($nice_min > $min);
|
|
my $nice_max = ($n == 1)
|
|
? $_ * int($max/$_ + 1)
|
|
: $nice_min + $n * $_;
|
|
my $nice_range = $nice_max - $nice_min;
|
|
|
|
next if ($nice_max < $max); # $nice_min too small
|
|
next if ($best_fit <= $nice_range - $range); # not closer fit
|
|
|
|
$best_min = $nice_min;
|
|
$best_max = $nice_max;
|
|
$best_fit = $nice_range - $range;
|
|
$best_num = $n;
|
|
}
|
|
}
|
|
return ($best_min, $best_max, $best_num)
|
|
}
|