#use strict; # zeik ding package dbq; require Exporter; @ISA = qw(Exporter); @EXPORT = qw() ; use Pg; sub dbq::new{ my $class = shift; my $self = {}; bless $self, $class; &pg_connect; $self; } sub dbq::doq{ my $self = shift; $self->{query}=shift; my ($query)=$self->{query}; my ($result,$string,$j,$i,$fieldsn); my (@field,@row); $result = $conn->exec("$query"); &cmp_eq(PGRES_TUPLES_OK, $result->resultStatus); $fieldsn=$result->nfields; # mk @field for ($k = 0; $k < $fieldsn; $k++) { $field[$k] = $result->fname($k); #print "field#$k: $field[$k] \n"; } #print "\n"; $rown=0; while (@row = $result->fetchrow) { $id[$rown] = $row[0]; $id[$rown] =~ s/\s*$//; $self->{id}[$rown]=$id[$rown]; #print "$rown:", $id[$rown],"\n"; for ($k = 1; $k < $fieldsn; $k++){ $row[$k]=~ s/\s*$// if ($row[$k]); #${$field[$k]}{$id[$rown]}=$row[$k]; $self->{$field[$k]}{$id[$rown]}=$row[$k]; } $rown++; } print "rows: $rown\n" if ($debug); $self->{rown}=$rown; $ev="return \\\@id"; for ($k=1;$k<@field;$k++){ $ev .= ",\\%".$field[$k]; } $self->{fields}=\@field; $self->{fieldsn}=$fieldsn; $self; } #--------------------------------------------------------- sub cmp_eq { my $cmp = shift; my $ret = shift; my $msg; if ("$cmp" eq "$ret") { # print "ok $cnt\n"; } else { $msg = $conn->errorMessage; print "not ok $cnt: $cmp, $ret\n$msg\n"; exit; } $cnt++; } sub cmp_ne { my $cmp = shift; my $ret = shift; my $msg; if ("$cmp" ne "$ret") { #print "ok $cnt\n"; } else { $msg = $conn->errorMessage; print "not ok $cnt: $cmp, $ret\n$msg\n"; exit; } $cnt++; } sub pg_connect{ $PGRES_EMPTY_QUERY = 0 ; $PGRES_COMMAND_OK = 1 ; $PGRES_TUPLES_OK = 2 ; $PGRES_COPY_OUT = 3 ; $PGRES_COPY_IN = 4 ; $PGRES_BAD_RESPONSE = 5 ; $PGRES_NONFATAL_ERROR = 6 ; $PGRES_FATAL_ERROR = 7 ; $| = 1; $dbname = 'tv'; $cnt = 2; $conn = Pg::connectdb("dbname=$dbname"); $db = $conn->db; $user = $conn->user; $port = $conn->port; #print "db: $db, $user, $port\n"; } sub initprut{ $Q = new CGI; $Qself = $Q->self_url; $Qselfs = $Q->url; print $Q->header(-type=>'text/html', -expires=>'+5min'); print < tv GROK } sub OptionForm{ $clockform="" if ($Q->param(Interval) eq "now"); $popupt = $Q->popup_menu( -name=>"Interval", -"values"=>['now','+15 min','+1 hour','+3 hours','+1 day','+1 week','+1 month','+1 year','+100 year','whenever','-15 min','-1 hour','-1 day','-1 week','-1 month','-1 year','-100 year'], -default=>$Q->{Interval}, ); $popupz = $Q->popup_menu( -name=>"Zender", -"values"=>['All','BBC1','BBC2','NED1'], -default=>$Q->{Zender}, ); $popups = $Q->popup_menu( -name=>"SearchOnField", -"values"=>['All','name','zender','descr'], -default=>$Q->{SearchOnField}, ); $zoekding=$Q->{Search}[0] if ($Q->{Search}) ; $sortorder = $Q->popup_menu( -name=>"SortOrder", -"values"=>['timed','zender','name','endtime','descr'], -default=>$Q->{SortOrder}, ); print <
GROK $R->{align}="middle"; print $R->begin; print < When: $popupt Zender: $popupz Zoek in $popups Sort $sortorder GROK print $R->end; print "\n
$clockform
"; #end } sub PrintPopJS{ print < function js_title_menu(name,zender,localf,d) { if( parseInt(navigator.appVersion) < 4 ){ return true; } l = null; l = document.layers['popup']; l.src = "fav.pl?name="+name+"&zender="+zender+"&localf="+localf; l.top = d.target.y - 6; l.left = d.target.x - 6; if( l.left + l.clipWidth > window.width ){ l.left = window.width - l.clipWidth; } l.visibility="show"; return false; } function js_options_menu(d) { if( parseInt(navigator.appVersion) < 4 ){ return true; } l = document.layers['oppopup']; l.top = d.target.y - 6; l.left = d.target.x - 6; if( l.left + l.clipWidth > window.width ){ l.left = window.width - l.clipWidth; } l.visibility="show"; return false; } GROK } sub PrintClockJS{ $nexttime = &UnixDate($nexttime,"%H:%M"); print < GROK } sub BouwQuery{ if ($Q->param(Search)){ my ($qwhere,$searcht,$i,$searchf,$query); $searcht = $Q->param(Search); $searcht =~ s/([A-Za-z])/\[\L$1\U$1\]/gi; $qwhere .="( "; if ($Q->param(SearchOnField) ne "All"){ $searchf = $Q->param(SearchOnField); $qwhere .= "".$searchf." ~ '$searcht' "; } if ($Q->param(SearchOnField) eq "All"){ foreach $i ("name","zender","descr","namesub"){ $qwhere .= "$i ~ '$searcht' OR "; } $qwhere =~ s/OR\s$//; } $qwhere .=") "; } if ($Q->param(Zender)){ if ($Q->param(Zender) ne "All"){ $qwhere .= " AND " if ($qwhere); $qwhere .= " (zender = '".$Q->param(Zender)."') "; } } if ($Q->param(Interval) && $Q->param(Interval) ne "whenever"){ $qwhere .= " AND " if ($qwhere); if ($Q->param(Interval) eq "now"){ $qwhere .= "endtime > '$nowm' AND timed < '$nowm'"; }else{ if ($Q->param(Interval) =~ /^\-/){ $qwhere .= " (timed < '$nowm' AND timed > '"; $qwhere .= &DateCalc($nowm,$Q->param(Interval)); $qwhere .= "') "; } if ($Q->param(Interval) =~ /^\+/){ $qwhere .= " (timed > '$nowm' AND timed < '"; $qwhere .= &DateCalc($nowm,$Q->param(Interval)); $qwhere .= "') "; } } } $query = "where ".$qwhere; $query =~ s/^\(//; $query =~ s/\)$//; $query =~ s/where\s$//; $query = "select * from programs ".$query; $query .=" order by ".$Q->param(SortOrder)." "; print "Query: ",$query if ($debug); return $query; } sub toencode{ my($toencode) = @_; $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub PrintBottom{ @ops = ('Debug','ShowSql','WarnFav'); $R->{align}='right'; print $R->begin; foreach $i (@ops){ print $Q->checkbox(-name=>$i, ),"
"; } print $Q->submit; print $R->end; } sub Round1{ print < GROK } sub Round2{ print < GROK } 1;