#!/usr/bin/perl -w
#tv fav
#
#
#
package TV::fav;
use CGI qw(:standard :html3);
use CGI qw/:push -nph/;
use CGI;
$|=1;$:=1;
&main;
sub main{
my $now=&ParseDate("now");
$Q = new CGI;
#print $Q->header(-type=>'text/html',
# -expires=>'-5min',
# -pragma=>'no-cache');
print multipart_init(-boundary=>'----------------here we go!') if ($Q ne "none");
$mpb=multipart_start(-type=>'text/html');
$mpe=multipart_end;
print $mpb,"loading \n" if ($Q ne "none");
print &s("loading modules... ");
use dbq;
use Date::Manip;
use XML::DOM;
$Qself = $Q->self_url;
$Qselfs = $Q->url;
my $action=$Q->param('action');
$action="show" unless ($action);
my $uid=$Q->param('uid');
$uid="oligoly" unless ($uid);
#making domfavhash
my $file="users.xml";
print &s("parsing file $file...");
$doc=&domdoc($file);
print &s("spuiing old file...");
$olddoc=$doc->toString;
print &s("hak the dom...");
$users = $doc->getElementsByTagName('user');
&hakdom;
print <done.
$mpe
$mpb
$uid\'s kwark fav $action.TV->
fav->
users('$uid')->
GROK
#what aim gonna do
if ($action eq "set" && $Q->param('ptitle') && $Q->param('notif') ){
my $n=$Q->param('notif');
my $t=$Q->param('ptitle');
my $uid=$uid;
print "set \'$t\' to $n.";
unless ($F{$uid}{$t}){
print " (and create new node) ";
$D{$uid}{$t}=&mkfnode($uid,$t,$n);
&hakdom;
# print $D{$uid}{$t};
# $F{$uid}{$t}=$n;
}
$F{$uid}{$t}=$n;
$D{$uid}{$t}->setAttribute("notif",$n);
}elsif ($action eq "edit" && $Q->param('ptitle') ){
my $t=$Q->param('ptitle');
print "edit \'",$t,"\' ";
unless ($F{$uid}{$t} ){
print "and create ";
}
print &spuiFE($uid,$t,'weetniet');
}elsif ($action eq "show"){
print "show";
}elsif ($action eq "delete" && $Q->param('ptitle') && $Q->param('uid') && $D{$uid}{$Q->param('ptitle')} ){
my $t=$Q->param('ptitle');
my $uid=$Q->param('uid');
print "del $t bij $uid";
print $D{$uid}{$t};
print $D{$uid}{$t}->toString;
#$doc->removeChild($D{$uid}{$t});
# print ($D{$uid}{'ofavs'})->toString;
$D{$uid}{'ofavs'}->removeChild($D{$uid}{$t});
undef(%D);
undef(%F);
undef(%UF);
&hakdom;
print "hak dom";
}else{
print "nothing to do here. \n
\n and try a legal url.";
}
#end of action?
print <
GROK
@users=keys %F;
foreach $i (@users){
print <
a
$i
GROK
*UF=$F{$i};
my @favs= keys %UF;
print"
\n";
foreach $ii (@favs){
my $n=$UF{$ii};
#print " ",$ii," ",$n,"\n";
print &spuiFI($i,$ii,$n);
}
$FE=&spuiFE($i,'','weetniet');
print <
$FE
GROK
}
$doc->printToFile("users.xml");
&spuidom;
print <pip\@dds.nl changed
fav.pl.
GROK
}
#-----------------------------
sub hakdom{
undef(%usr,$user,%D,%F,%UF);
foreach my $user (@$users){
my ($f)= &dumpU($user);
}
}
#----------------------------------------
sub spuidom{
my $nd=$doc->toString;
print <
$nd
$olddoc
GROK
}
sub mkfnode{
#$D{$uid}{$t}->setAttribute("notif",$n);
my ($u,$t,$n)=@_;
#print "-$u $t $n-";
# my $t=$Q->param('ptitle');
my $oF=$D{$u}{'ofavs'};
#print $oF,"\n";
my $frag=$doc->createElement("pname");
my $tn=$doc->createTextNode($t);
$frag->appendChild($tn);
$oF->appendChild($doc->createTextNode("\t\t"));
$oF->appendChild($frag);
$oF->appendChild($doc->createTextNode("\n"));
$frag;
}
sub spuiFE{
my $u=shift;
my $p=shift;
my $n=shift;
my $r;
my $up=&toencode($p);
$r =<
GROK
$r;
}
sub spuiFI{
my $u=shift;
my $p=shift;
my $n=shift;
my $r;
my $up=&toencode($p);
$r =<$n $p (set to:
warnemaildelete)
search
GROK
$r;
}
sub dumpU{
my $user=shift;
local $uid=&di($user,'id');
my ($r);
my $t=$user->getElementsByTagName("favs");
$D{$uid}{'ofavs'}=$user->getElementsByTagName("favs")->[0];
my $favs = $user->getElementsByTagName("pname");
foreach $fav (@$favs){
my $prgname=$fav->getFirstChild->getData;
# my $prgname = &di($fav,'pname');
my $notif = $fav->getAttribute("notif");
$notif="unkown" unless ($notif);
$F{$uid}{$prgname}=$notif;
$D{$uid}{$prgname}=$fav;
}
$r;
}
#dom sub
sub di{
my $user=shift;
my $tagname=shift;
my $t = $user->getElementsByTagName("$tagname");
my $re = $t->[0]->getFirstChild->getData;
$re;
}
sub domdoc{
my $file=shift;
if ($parser) {
print "parserda " if ($debug);
} else {
$parser = new XML::DOM::Parser;
print "created domparser: ",$parser if($debug);
}
$parser->parsefile ("$file") || die "Cant domopen file $file $!\n";
}
#endom sub
sub toencode{
my($toencode) = @_;
$toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
return $toencode;
}
sub s{
my $i=shift;
return <
GROK
}