# Copyright (C) 2008 Andreas Hofmann
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
use strict;
use v5.10;
AddModuleDescription('relation.pl', 'Relation Extension');
our ($q, %Action, $OpenPageName, @MyRules, $DataDir);
our (@RelationLinking, $RelationPassedFlag);
push(@MyRules, \&RelationRule);
$RelationPassedFlag = 0;
my $referencefile = "References.txt";
my $dummy = RelationRead();
sub RelationRead {
# return scalar(@RelationLinking) if (scalar(@RelationLinking));
open (my $RRR, '<', encode_utf8("$DataDir/$referencefile")) || return(0);
while (<$RRR>) {
chomp;
my ($a,$b,$c) = split(';');
# print "\n";
push @RelationLinking, [$a, $b, $c];
};
close($RRR);
return (scalar(@RelationLinking));
}
sub RelationRule {
if (m/\G((forward@@|backward@@|forward@|backward@):([_A-Za-z0-9 ]+?);)/cg) {
Dirty($1);
my $rememberpos = pos;
my $fwbw =$2;
my $rel=$3;
my $rtext = '';
my $rhead;
$RelationPassedFlag++;
my @result;
if ( substr($fwbw,0,7) eq 'forward' ) {
@result = map { $_->[2] } grep { $_->[0] eq $OpenPageName and $_->[1] eq $rel } @RelationLinking;
$rhead = "".NormalToFree($OpenPageName)." $rel:
\n";
}
else{
@result = map { $_->[0] } grep { $_->[2] eq $OpenPageName and $_->[1] eq $rel } @RelationLinking;
$rhead = "$rel ".NormalToFree($OpenPageName).":
\n";
}
if (scalar(@result) == 0 ) {
if (substr($fwbw,-2) eq '@@') {
$rtext = "\n"
}
else {
$rtext = "$rhead\n";
}
}
else {
$rtext = $rhead."\n";
foreach my $LLL (@result) {
$rtext .= "- " . GetPageOrEditLink($LLL,$LLL) . "
\n";
};
$rtext .= "
\n";
};
pos = $rememberpos;
return $rtext;
}
return;
}
*OldRelationPrintFooter = \&PrintFooter;
*PrintFooter = \&RelationPrintFooter;
sub RelationPrintFooter {
my @params = @_;
if ($RelationPassedFlag > 0) {
print "\n";
};
OldRelationPrintFooter(@params);
};
$Action{'checkrelates'} = sub {
my $id = shift;
my @result = @RelationLinking;
print $q->header;
print "Edit Relations\n";
print "\n";
print "Relations of $id (to be deleted)
\n";
print "\n";
print "\n";
};
$Action{'updaterelates'} = sub {
my $id = shift;
print $q->header;
print "Relations\n";
my %h = $q->Vars;
print "Relations of $id
";
my $newrelationto = undef;
my $newtargetto = undef;
my $newrelationfrom = undef;
my $newsourcefrom = undef;
foreach my $r (keys %h) {
if ( $r =~ m/^delete([0-9]+)/ ) {
my $n = $1;
my $s = $h{$r};
print "delete: ". $RelationLinking[$n]->[0]." -> ". $RelationLinking[$n]->[1]." -> " . $RelationLinking[$n]->[2]."
\n";
$RelationLinking[$n] = undef;
}
elsif ( $r eq 'newtargetto') {
$newtargetto = $h{$r};
}
elsif ( $r eq 'newrelationto') {
$newrelationto = $h{$r};
}
elsif ( $r eq 'newsourcefrom') {
$newsourcefrom = $h{$r};
}
elsif ( $r eq 'newrelationfrom') {
$newrelationfrom = $h{$r};
}
else {
my $s = $h{$r};
print "other: $r -> $s
\n" unless ($r eq 'action' or $r eq 'id');
};
};
if (defined($newrelationto) and defined($newtargetto) and $newrelationto ne '' and $newtargetto ne '') {
print "new: $id -> $newrelationto -> $newtargetto
\n";
push @RelationLinking, [$id, $newrelationto, FreeToNormal($newtargetto)];
}
else {
print "no new target
\n";
}
if (defined($newrelationfrom) and defined($newsourcefrom) and $newrelationfrom ne '' and $newsourcefrom ne '') {
print "new: $newsourcefrom -> $newrelationfrom -> $id
\n";
push @RelationLinking, [FreeToNormal($newsourcefrom), $newrelationfrom, $id];
}
else {
print "no new source
\n";
}
open (my $RRR, '>', encode_utf8("$DataDir/$referencefile"));
print "
\n";
foreach my $t (@RelationLinking) {
next unless (defined($t));
# print "trace:". $t->[0] .";". $t->[1].";". $t->[2] ."
\n";
print $RRR $t->[0] .";". $t->[1].";". $t->[2] ."\n";
};
close($RRR);
print ScriptLink('id='.$id, $id, 'index');
print "\n";
};
1;