<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package pivot;

use umfrage;
#use strict;

@ISA = qw ( umfrage );

####################################################################
####         Pivotiert die Ergebnisse einer Umfrage
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub pivotprint {
	my $self=shift();
	my $fra=$self-&gt;loadfragen;
	my %hash; my $beschr;my $txt="";
	$hash{0}{-pin}="pin";
	foreach (@$fra) {$beschr.=$_-&gt;pivot(\%hash);}
	foreach $hpin (sort keys %hash) {
		my @text=();
		foreach $part (sort keys %{$hash{0}} ) {
			$ttxt=$hash{$hpin}{$part};
			if ($ttxt eq "") {$ttxt="0";}
			push @text, $ttxt;
		}
		$txt.=join(",",@text)."\n";
	}
	$beschr.="\n\nAlle Sammelbegriffe\n================\n";
	my $sth=$self-&gt;sqlprepare("select ID,name from pivotname where umfid=".$self-&gt;{id}." order by ID");
    while (my @x=$sth-&gt;fetchrow_array) {
		$beschr.="$x[0]\t$x[1]\n";
	}
	print "Content-type: text/plain\n\n".$txt.$beschr;
	$self-&gt;exit;
}

####################################################################
####         Handling der Buttons
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub getbearb {
	my $self=shift;
	
	if ($baseq::VARS{pbut} eq $self-&gt;trans("BU63")) {
			my $ID=$self-&gt;newgroup($baseq::VARS{newgroup});
			$self-&gt;fromgroup;
			$self-&gt;togroup($ID);
			$self-&gt;showfrage($baseq::VARS{fid});
	}	
	
	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU64")) {
			$self-&gt;fromgroup;
			$self-&gt;togroup($baseq::VARS{selgroup});
			$self-&gt;showfrage($baseq::VARS{fid});
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU65")) {
			$self-&gt;showgroup($baseq::VARS{selgr});
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU66")) {
			$self-&gt;showfrage($baseq::VARS{selfrage});
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU67")) {
			$self-&gt;pivotprint;
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU68")) {
			$self-&gt;fromgroup;
			$self-&gt;showgroup($baseq::VARS{grpid});
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU69")) {
			$self-&gt;delgroup($baseq::VARS{grpid});
			$self-&gt;showlist;
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU70")) {
			$self-&gt;renamegroup($baseq::VARS{grpid}, $baseq::VARS{newgrpname});
			$self-&gt;showlist;
	}	

	elsif ($baseq::VARS{pbut} eq $self-&gt;trans("BU71")) {
			$self-&gt;joingroups($baseq::VARS{joingrpa}, $baseq::VARS{joingrpb});
			$self-&gt;showgroup($baseq::VARS{joingrpa});
	}	

	else {$self-&gt;showlist}
}
####################################################################
####         Zeigt die Textantworten
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub showfrage {
	my $self=shift;
	my $frage=shift;
	my $f=frage-&gt;init($self,$frage);
	$f-&gt;load();
	my ($fid,$ref) = $f-&gt;createantarrayref;
	$baseq::VARS{fid}=$fid;
	my $html;
	$sth =$self-&gt;sqlprepare("select a.aid,a.pin,a.text from ergebnis a left join pivot b using(umfid,fid,aid,pin) ".
							"where a.umfid=".$self-&gt;{id}." and a.fid=$fid and a.text != '' and b.pin is NULL order by a.pin");
	while ( my ($aid, $pin, $txt) = $sth-&gt;fetchrow_array ) {
		$ref-&gt;[$aid]-&gt;slurptextant($pin, $txt);  
	}
	$html.=$f-&gt;qfont($f-&gt;{id}.") ".$f-&gt;{name})."&lt;BR&gt;\n".$f-&gt;grafikdetails.
	    "&lt;HR&gt;\n&lt;TABLE&gt;\n".
		$self-&gt;TR([$self-&gt;sfont("Suchmuster"),$self-&gt;TF("pattern","") ]).
		"&lt;/TABLE&gt;\n".
		$self-&gt;standardbut;
	$self-&gt;printhtml("Textliste",$html);
}

####################################################################
####         Zeigt die Textantworten
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub showgroup {
	my $self=shift;
	my $ID=shift;
	$self-&gt;{grpid}=$ID;
	my $name=$self-&gt;sqlselect("select name from pivotname where ID=$ID");
	my $html=$self-&gt;qfont($ID.") ".$name)."&lt;BR&gt;\n";
	$sth =$self-&gt;sqlprepare("select b.fid,b.aid,b.pin,c.text from pivot b left join ergebnis c ".
							"using(umfid, fid, aid ,pin) where b.ID=$ID order by b.fid,b.aid,b.pin");
	while ( my ($fid, $aid, $pin, $txt) = $sth-&gt;fetchrow_array ) {
		my $IDX="U".$self-&gt;{id}."F".$fid."A".$aid."PIN".$pin;
		$html.=$self-&gt;CB($IDX,1, $baseq::VARS{$IDX}) ."F:".$fid." A:".$aid." Pin:".$pin.": ".$txt."&lt;BR&gt;\n";
		
	}
	$html.=
	    "&lt;HR&gt;\n&lt;TABLE&gt;\n".
		$self-&gt;TR([$self-&gt;SM("pbut","BU68"),$self-&gt;SM("pbut","BU69")]).
		$self-&gt;TR([$self-&gt;TF("newgrpname",$baseq::VARS{newgrpname}), $self-&gt;SM("pbut","BU70")] ).
		"&lt;/TABLE&gt;\n".
		$self-&gt;standardbut;
	$self-&gt;printhtml("Textliste",$html);
}



sub newgroup {
	my $self=shift;
	my $name=shift;
	my $fid=$baseq::VARS{fid}+0;
	my ($max)=$self-&gt;sqlselect("select max(ID)+1 from pivotname");
	if ($max==0) {$max=100000}
	$self-&gt;sqldo("insert into pivotname (ID, umfid, fid, name) values ($max,$self-&gt;{id},$fid,'$name')");
	return $max;
}

sub renamegroup {
	my ($self, $grpid, $grpname) = @_;
	$grpid+=0;
	my $sql="update pivotname set name='$grpname' where ID=$grpid";
	$self-&gt;sqldo($sql);
}

sub joingroups {
	my ($self, $G1, $G2) = @_; #verschiebe G2 zu G1 und loesche G2
	return if $G1 == $G2 || $G1 == 0 || $G2 == 0;	
	$self-&gt;sqldo("update pivot set ID=$G1 where ID=$G2");
	$self-&gt;sqldo("delete from pivotname where ID=$G2");
	return;
}

sub delgroup {
	my $self=shift;
	my $ID=shift;
	$self-&gt;sqldo("delete from pivot where ID=$ID");
	$self-&gt;sqldo("delete from pivotname where ID=$ID");
}

sub togroup {
	my ($self, $ID) = @_;
	my $fid=$baseq::VARS{fid}+0;
	foreach (keys %baseq::VARS) {
		if (/^U(\d+)F(\d+)A(\d+)PIN(\d+)$/) {
			$self-&gt;sqldo("insert into pivot (ID, umfid, fid, aid, pin) values($ID,$self-&gt;{id},$fid,$3,$4)");
		}
	}
	$self-&gt;autogroup($ID);
}

sub autogroup {
	my ($self, $ID) = @_;
	my $fid=$baseq::VARS{fid};
	my $txt=$baseq::VARS{pattern};
	return if $txt eq "";
	my $sth=$self-&gt;sqlprepare("select umfid,fid,aid, pin from ergebnis where umfid=$self-&gt;{id} and fid=$fid and text like '%$txt%'");
	while (my @X=$sth-&gt;fetchrow_array) { 
	   $self-&gt;sqldo("insert into pivot (ID, umfid, fid, aid, pin) values ($ID,".join(",",@X).")");
	}
}

sub fromgroup {
	my $self = shift;
	foreach (keys %baseq::VARS) {
		if (/^U(\d+)F(\d+)A(\d+)PIN(\d+)$/) {
			$self-&gt;sqldo("delete from pivot where umfid=$1 and fid=$2 and aid=$3 and pin=$4");
		}
	}
}

sub showlist {
	my $self=shift;
	$self-&gt;printhtml("Textliste",$self-&gt;standardbut);
}

sub DDgroup {
	my ($self, $htname)=@_;
	my $whereplus;
	my $sth=$self-&gt;sqlprepare("select ID, name from pivotname where umfid=$self-&gt;{id} $whereplus order by ID");
	my (@L,%H);
	while (($ID, $name) = $sth-&gt;fetchrow_array) {
		push @L, $ID;
		$name=~s/&lt;[^&gt;]+[&gt;\$]//g;
		$H{$ID}=$ID.") ".$name;
	}
	return $self-&gt;DD($htname,\@L,$baseq::VARS{$htname},\%H);
}

sub DDfrage {
	my $self=shift;
	my $sth=$self-&gt;sqlprepare("select distinct x.fid, x.frage from fragen x left join ergebnis using(umfid,fid) where text != '' and x.umfid=".$self-&gt;{id}." and (x.typ='E' or x.typ='M' or x.typ='T') order by fid");
	my (@L,%H);
	while (($ID, $name) = $sth-&gt;fetchrow_array) {
		push @L, $ID;
		$name=~s/&lt;[^&gt;]+[&gt;\$]//g;
		$H{$ID}=$ID.") ".substr($name,0,60);
	}
	return $self-&gt;DD("selfrage",\@L,$baseq::VARS{selfrage},\%H);
}

sub standardbut {
	my $self=shift;
	return 
	"&lt;HR&gt;\n&lt;TABLE&gt;\n".
		$self-&gt;TR([$self-&gt;SM("pbut","BU63"),$self-&gt;TF("newgroup","") ]).
		$self-&gt;TR([$self-&gt;SM("pbut","BU64"),$self-&gt;DDgroup("selgroup") ]).
		$self-&gt;TR([$self-&gt;SM("pbut","BU65"),$self-&gt;DDgroup("selgr") ]).
	    $self-&gt;TR([$self-&gt;DDgroup("joingrpa"), $self-&gt;DDgroup("joingrpb"), $self-&gt;SM("pbut","BU71") ]).
		$self-&gt;TR([$self-&gt;SM("pbut","BU66"),$self-&gt;DDfrage,$self-&gt;SM("pbut","BU67") ]).
	"&lt;/TABLE&gt;\n";
}
</pre></body></html>