Biblio-Thesaurus-ModRewrite-0.03/0000755000076500000240000000000011606574023015676 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/.cvsignore0000644000076500000240000000016111502506263017670 0ustar smashstaffblib* Makefile Makefile.old Build _build* pm_to_blib* *.tar.gz .lwpcookies Biblio-Thesaurus-Processor-* cover_db Biblio-Thesaurus-ModRewrite-0.03/bin/0000755000076500000240000000000011606574023016446 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/bin/animals1.iso0000644000076500000240000000117711535165552020701 0ustar smashstaff%externals SN URL %language EN %baselanguage EN %inverse NT BT %inverse RT RT %inverse USE UF %inverse UF USE %inverse BT NT %description NT Narrower term %description SN Scope note %description RT Related term %description USE Synonym %description TT Top term %description UF Quasi synonym %description IS-A ... %description BT Broader term Animal BT Carnivora BT Felidae BT Panthera Carnivora BT Felidae BT Canidae Panthera NT Felidae BT lion BT tiger lion NT Panthera Felidae NT Carnivora BT Panthera BT Felis tiger NT Panthera house_cat NT Felis Lucky IS-A house_cat Felis NT Felidae BT house_cat Canidae NT Carnivora Biblio-Thesaurus-ModRewrite-0.03/bin/animals2.iso0000644000076500000240000000072411502506262020666 0ustar smashstaff%externals SN URL %languages %baselanguage ? %inverse NT BT %inverse RT RT %inverse USE UF %inverse UF USE %inverse BT NT %description NT Narrower term %description SN Scope note %description RT Related term %description USE Synonym %description TT Top term %description UF Quasi synonym %description IS-A ... %description BT Broader term lion Carnivora BT Felis house_cat NT Felis Lucky IS-A lion Felis NT Carnivora BT house_cat the_lion_king IS-A lion Biblio-Thesaurus-ModRewrite-0.03/bin/apply_rules0000755000076500000240000000055111502506262020727 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = `cat $ARGV[0]`; my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); $t->process($code); Biblio-Thesaurus-ModRewrite-0.03/bin/client.pl0000644000076500000240000000147611502506262020264 0ustar smashstaff#!/usr/bin/perl use Net::Telnet (); $t = new Net::Telnet (Timeout => 10); $t->open(Host=>"localhost",Port=>9999); while(1) { print "OMLsql> "; $cmd = ; chomp $cmd; $cmd eq 'quit' and last; $t->print($cmd); $n = $t->getline; chomp $n; my $i = 1; my @l, my @h; while($i++<=$n) { @l = (); @h = (); $line = $t->getline; foreach (split /\s+/, $line) { m/(\w+)=(\w+)/ and push @l, $2; $i == 2 and push @h, $1; } pretty_header(@h) if $i==2; pretty_line(@l); } pretty_end(@l); } sub pretty_header { my @l = @_; foreach (@l) { print '+'.'-'x20; } print "+\n"; pretty_line(@l); foreach (@l) { print '+'.'-'x20; } print "+\n"; } sub pretty_line { foreach (@_) { printf "| %-19s" ,$_; } print "|\n"; } sub pretty_end { my @l = @_; foreach (@l) { print '+'.'-'x20; } print "+\n"; } Biblio-Thesaurus-ModRewrite-0.03/bin/create_animals.pl0000644000076500000240000000216111502506262021745 0ustar smashstaff#!/usr/bin/perl use Biblio::Thesaurus; use Data::Dumper; $obj = thesaurusNew(); $obj->addTerm('Carnivora'); $obj->addTerm('Canidae'); $obj->addTerm('Felidae'); $obj->addRelation('Carnivora','BT','Canidae'); $obj->addRelation('Carnivora','BT','Felidae'); $obj->addTerm('Panthera'); $obj->addTerm('Felis'); $obj->addRelation('Felidae','BT','Panthera'); $obj->addRelation('Felidae','BT','Felis'); $obj->addTerm('lion'); $obj->addTerm('tiger'); $obj->addRelation('Panthera','BT','lion'); $obj->addRelation('Panthera','BT','tiger'); $obj->addTerm('house_cat'); $obj->addRelation('Felis','BT','house_cat'); $obj->addTerm('Lucky'); $obj->addRelation('Lucky','is-a','house_cat'); $obj->complete; $obj->save('animals1.iso'); $obj = thesaurusNew(); $obj->addTerm('house_cat'); $obj->addTerm('Felis'); $obj->addRelation('Felis','BT','house_cat'); $obj->addTerm('Lucky'); $obj->addRelation('Lucky','is-a','lion'); $obj->addTerm('Carnivora'); $obj->addRelation('Carnivora','BT','Felis'); $obj->addTerm('lion'); $obj->addTerm('the_lion_king'); $obj->addRelation('the_lion_king','is-a','lion'); $obj->complete; $obj->save('animals2.iso'); Biblio-Thesaurus-ModRewrite-0.03/bin/handle_query.pl0000755000076500000240000000104011502506262021454 0ustar smashstaff#!/usr/bin/perl -w use FindBin qw($Bin); use lib "$Bin/../lib"; $ARGV[0] ~~ m/select ([\w,]+) FROM ([^\s]+) WHERE ([^;]+);/i; my @vars = split /,/, $1; my $ont = $2; my $code = $3; foreach (@vars) { $code =~ s/(\b$_\b)/\$$_/g; } my $str = ''; foreach (@vars) { $str .= "$_=\$$_ "; } $code .= " => sub{{print \"$str\\n\";}}."; print STDERR "\n-----\n$code\n-----\n"; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $obj = thesaurusLoad("examples/$ont"); $t = Biblio::Thesaurus::ModRewrite->new($obj); $t->process($code) Biblio-Thesaurus-ModRewrite-0.03/bin/merge0000755000076500000240000000124111502506262017464 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Data::Dumper; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $obj = thesaurusLoad($ARGV[1]); foreach $i ($obj->allTerms) { foreach $j ($obj->relations($i)) { ($k,$v) = each(%{$obj->depth_first($i, 1, $j)}); print 'Checking "', $i, ' ' , $j, ' ', $k, '" ...'; $res = `./validate "$i" "$j" "$k" $ARGV[0]`; if ($res eq '') { print " OK!\n"; $obj->addRelation($i,$k,$k); } else { print " NOK!\n"; print $res; } } } $obj->save('merged.iso'); print "Written 'merged.iso'.\n"; Biblio-Thesaurus-ModRewrite-0.03/bin/server.pl0000644000076500000240000000054711502506262020312 0ustar smashstaff#!/usr/bin/perl -w package MyPackage; use base qw(Net::Server); sub process_request { my $self = shift; while () { s/\r?\n$//; last if /quit/i; print STDERR "GOT: $_\n"; @r = `./bin/handle_query.pl "$_"`; print STDERR "R ".scalar @r." lines\n\n"; print scalar @r . "\n"; foreach (@r) { print $_; } } } MyPackage->run(port => 9999); Biblio-Thesaurus-ModRewrite-0.03/bin/term2dot0000755000076500000240000000135111502506262020127 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; "$ARGV[0]" \$r \$t => sub { print " \\"\$t\\" [style=\\"filled\\",color=\\"orange\\"] \\"$ARGV[0]\\" -> \$t [ label = \\"\$r\\" ] ;\\n"; }. \$t \$r "$ARGV[0]" => sub { print " \\"\$t\\" [style=\\"filled\\",color=\\"greenyellow\\"] \$t -> \\"$ARGV[0]\\" [ label = \\"\$r\\" ] ;\\n"; }. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print "digraph zbr {\n rankdir=LR\n\"$ARGV[0]\" [style=\"filled\",color=\"red\"]\n"; $t->process($code); print "}\n"; Biblio-Thesaurus-ModRewrite-0.03/bin/term2dot.embed0000755000076500000240000000114111502506262021177 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "./lib"; if (@ARGV < 2) { print "Usage: term2dot \n"; exit 1; } use Biblio::Thesaurus::ModRewrite::Embed; OML proc(term) begin => sub { print "digraph term {\n rankdir=LR\n\"term\" [style=\"filled\",color=\"red\"]\n#}\n"; }. term $r $t => sub { print " \"$t\" [style=\"filled\",color=\"orange\"] term -> $t [ label = \"$r\" ] ;\n"; }. $t $r term => sub { print " \"$t\" [style=\"filled\",color=\"greenyellow\"] $t -> term [ label = \"$r\" ] ;\n"; }. end => sub { print "#{\n}\n"; }. ENDOML proc("$ARGV[0]",$ARGV[1]); Biblio-Thesaurus-ModRewrite-0.03/bin/term2html0000755000076500000240000000157711502506262020317 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; $ARGV[0] \$r \$t => sub{{ print " $ARGV[0]\$r\$t\\n"; }}. \$t \$r $ARGV[0] => sub{{ print " \$t\$r$ARGV[0]\\n"; }}. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print "

Relations for term
$ARGV[0]

\n"; $t->process($code); print "
TermRelationTerm
\n"; Biblio-Thesaurus-ModRewrite-0.03/bin/term2html.cgi0000755000076500000240000000213311502506262021045 0ustar smashstaff#!/usr/bin/perl use lib '/home/smash/LOCAL/mestrado/natura/Biblio/modrewrite.r6656/lib'; use CGI qw/:standard/; $ARGV[0] = param('t'); $ARGV[1] = '/home/smash/LOCAL/mestrado/natura/Biblio/modrewrite.r6656/examples/geografia.iso'; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; $ARGV[0] \$r \$t => sub{{ print " $ARGV[0]\$r\$t\\n"; }}. \$t \$r $ARGV[0] => sub{{ print " \$t\$r$ARGV[0]\\n"; }}. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print "Content-type: text/html\n\n"; #print "
$code
"; print "

Relations for term
$ARGV[0]

\n"; $t->process($code); print "
TermRelationTerm
\n"; Biblio-Thesaurus-ModRewrite-0.03/bin/term2tex0000755000076500000240000000216111502506262020141 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; $ARGV[0] \$r \$t => sub{{ print "\$r & \$t \\\\\\\\ \\n \\\\hline \\n "; }}. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print<<"TEX"; \\documentclass{article} \\usepackage{colortbl} \\begin{document} \\section{Relations for term $ARGV[0]} \\begin{tabular}{|l|l|} \\hline TEX print "\\multicolumn{2}{|>{\\columncolor[rgb]{0.82,0.82,0.82} }p{6cm}|}{\\bf{$ARGV[0]}} \\\\ \n\\hline \n\\hline \n"; $t->process($code); print<<"TEX"; \\end{tabular} \\section{Terms related with $ARGV[0]} TEX my $code = <<"EOF"; \$t \$r $ARGV[0] => sub{{ print "\\\\begin{tabular}{|l|l|}\\n\\\\hline\\n\\\\multicolumn{2}{|>{\\\\columncolor[rgb]{0.82,0.82,0.82} }p{6cm}|}{\\\\bf{\$t} } \\\\\\\\ \\n\\\\hline \\n\\\\hline \\n \$r & $ARGV[0] \\\\\\\\ \\n\\\\hline \\n\\\\end{tabular} \\n\\\\\\\\\\n"; }}. EOF $t->process($code); print<<'TEX'; \end{document} TEX Biblio-Thesaurus-ModRewrite-0.03/bin/terms2tab0000755000076500000240000000110411502506262020266 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; $ARGV[0] \$r \$t => sub{ print " Portugal -> \$t [ label = \\"\$r\\" ] ;\\n"; }. \$t \$r $ARGV[0] => sub{ print " \$t -> Portugal [ label = \\"\$r\\" ] ;\\n"; }. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print "digraph $ARGV[0] {\n rankdir=LR\n"; $t->process($code); print "}\n"; Biblio-Thesaurus-ModRewrite-0.03/bin/validate0000755000076500000240000000112411527522147020165 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $t1 = $ARGV[0]; my $r = $ARGV[1]; my $t2 = $ARGV[2]; #print "t1 $t1 r $r t2 $t2\n"; my $code = <<"EOF"; $t1 \"$r\" $t2 ⇒ sub{ print ".. already exists!\\n"; }. $t1 'is-a' \$a ⇒ sub{ if(\"$r\" =~ m/is-a/i) { print ".. $t1 is already a \$a\\n" unless(\"$t2\" eq \$a);} }. $t1 \"$r\" \$a ∧ \$a \"$r\" $t2 ⇒ sub{ print ".. no need, $t1 $r \$a $r $t2\\n"; }. EOF my $obj = thesaurusLoad($ARGV[3]); $t = Biblio::Thesaurus::ModRewrite->new($obj); $t->process($code); Biblio-Thesaurus-ModRewrite-0.03/Changes0000644000076500000240000000044411606573155017200 0ustar smashstaffRevision history for Biblio-Thesaurus-ModRewrite 0.03 Jul 11, 2011 + fix dependecies + cleanup examples 0.02 Jan 19, 2009 + improve documentation + add prereq to Makefile.PL 0.01 Date/time First version, released on an unsuspecting world. Biblio-Thesaurus-ModRewrite-0.03/examples/0000755000076500000240000000000011606574023017514 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/examples/embed0000755000076500000240000000062011530466174020517 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; use Biblio::Thesaurus::ModRewrite::Embed; use Biblio::Thesaurus; OML test(term) $a 'city-of' term => del($a 'city-of' term). ENDOML my $obj = thesaurusLoad('geografia.iso'); test($obj,'Portugal'); #test('geografia.iso','Portugal'); #test('/home/smash/LOCAL/mestrado/natura/Biblio/modrewrite.r6656/examples/geografia.iso','Portugal'); Biblio-Thesaurus-ModRewrite-0.03/examples/ex10000644000076500000240000000070411502506263020131 0ustar smashstaff PP={ a BT b ==> add(b NT a). $a capital $b ==> add($b temComoCapital $a) add($a isa cidade) add($b isa país ). $a isa $a ==> sub{ warn( "isa reclexia para $a\n"); } # esquece...#### sub{ my($a)=@_; warn( "isa reclexia para $a\n"); } # $a $b $a ==> sub{ warn( "$b reclexia para $a\n"); } } t1 = Thesaurusload("x"). ## booleano = verficase(t1 , PP); aplica(t1,PP); ThesurusSave(t1,"y"); ## comentário! (## =head1 ) Biblio-Thesaurus-ModRewrite-0.03/examples/ex20000644000076500000240000000043711502506263020135 0ustar smashstaffa BT b ==> add(b NT a). $a capital $b ==> add($b temComoCapital $a) add($a isa cidade) add($b isa país ). $a isa $a ==> sub{ warn( "isa reclexia para $a\n"); } __END__ fazMilagres regras the (vai executar: t1 = Thesaurusload("x"). aplica(t1,PP); ThesurusSave(t1,"y"); ) Biblio-Thesaurus-ModRewrite-0.03/examples/ex30000644000076500000240000000064511502506263020137 0ustar smashstaffdefinir-funcoes... PP={ inv(B, NT). $a capital $b ==> add($b temComoCapital $a) add($a isa cidade) add($b isa país ). $a isa $a ==> sub{ warn( "isa reclexia para $a\n"); } # esquece...#### sub{ my($a)=@_; warn( "isa reclexia para $a\n"); } # $a $b $a ==> sub{ warn( "$b reclexia para $a\n"); } } t1 = Thesaurusload("x"). ## booleano = verficase(t1 , PP); aplica(t1,PP); ThesurusSave(t1,"y"); Biblio-Thesaurus-ModRewrite-0.03/examples/geo.iso0000644000076500000240000000244311606573324021010 0ustar smashstaff%externals SN URL %languages %baselanguage ? %inverse NT BT %inverse RT RT %inverse USE UF %inverse UF USE %inverse BT NT %description NT Narrower term %description LNG ... %description CITY-OF ... %description COUNTRY-OF ... %description IS-A ... %description BT Broader term %description SN Scope note %description USE Synonym %description RT Related term %description TT Top term %description UF Quasi synonym %description CAPITAL-OF ... %description LAT ... Lisboa LNG -9.1657589 CAPITAL-OF Portugal CITY-OF Portugal LAT 38.7385758 IS-A city Bruxelas CAPITAL-OF Belgica CITY-OF Belgica IS-A city Vigo CITY-OF Espanha IS-A city -8.4229034 city -8.2956069 country Paris CAPITAL-OF Franca CITY-OF Franca IS-A city Europa Braga LNG -8.4229034 CITY-OF Portugal CITY-OF Braga LAT 41.5517605 IS-A city 38.7385758 Madrid CAPITAL-OF Espanha CITY-OF Espanha IS-A city Franca IS-A country 41.5517605 41.4419546 Espanha COUNTRY-OF Europa IS-A country Londres CAPITAL-OF Inglaterra CITY-OF Inglaterra IS-A city Guimaraes LNG -8.2956069 CITY-OF Portugal LAT 41.4419546 IS-A city 39.399872 Inglaterra COUNTRY-OF Europa IS-A country -9.1657589 Portugal LNG -8.224454 COUNTRY-OF Europa LAT 39.399872 IS-A country Porto CITY-OF Portugal IS-A city -8.224454 Belgica COUNTRY-OF Europa IS-A country Biblio-Thesaurus-ModRewrite-0.03/examples/term2desc0000755000076500000240000000065711502506263021336 0ustar smashstaff#!/usr/bin/perl use FindBin qw($Bin); use lib "$Bin/../lib"; if (@ARGV < 2) { print "Usage: apply_rules \n"; exit 1; } use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = <<"EOF"; $ARGV[0] \$r \$t => sub { print "\$r \$t
"; }. EOF my $obj = thesaurusLoad($ARGV[1]); $t = Biblio::Thesaurus::ModRewrite->new($obj); print "$ARGV[0]
"; $t->process($code); Biblio-Thesaurus-ModRewrite-0.03/lib/0000755000076500000240000000000011606574023016444 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/lib/Biblio/0000755000076500000240000000000011606574023017644 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/0000755000076500000240000000000011606574023021627 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/ModRewrite/0000755000076500000240000000000011606574023023710 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/ModRewrite/Embed.pm0000644000076500000240000000456111606573504025273 0ustar smashstaffpackage Biblio::Thesaurus::ModRewrite::Embed; use Filter::Simple; use Data::Dumper; use warnings; use strict; =head1 NAME Biblio::Thesaurus::ModRewrite::Embed - a module to embed OML programs in Perl code. =cut our $VERSION = '0.03'; =head1 SYNOPSIS use Biblio::Thesaurus::ModRewrite::Embed; OML proc $city 'city-of' $country => sub { print "$city is in $country\n"; }. ENDOML proc('ontology.iso'); =head1 DESCRIPTION This module can be used to embed OML programs in Perl source code. This module works as a filter for the source code, so you should only need to load it. =head1 FUNCTIONS =head2 buildOML This function is used to create a new funcion to execute the OML code found. =cut sub buildOML { (my $name, my $list, my $code) = @_; $list = '' unless $list; # begin my $c = "sub $name {\n"; # handle ontology $c .= "\tmy \$ont = shift;\n"; $c .= "\tuse Biblio::Thesaurus;\n"; $c .= "\tuse Biblio::Thesaurus::ModRewrite;\n"; $c .= "\tmy \$obj;\n"; $c .= "\tif (ref(\$ont) eq 'Biblio::Thesaurus') {\n"; $c .= "\t\t\$obj = \$ont;\n"; $c .= "\t} else {\n"; $c .= "\t\t\$obj = thesaurusLoad(\$ont);\n"; $c .= "\t}\n\n"; # handle OML code $c .= "my \$code=<<'EOF';\n"; $c .= "$code"; $c .= "EOF\n\n"; # black magic $c .= "\tif(\"$list\" eq '') {\n"; $c .= "\t\tmy \@ARGV = \@_;\n\n"; $c .= "\t\t\$code =~ s/\\\$ARGV\\[(\\d+)\\]/\$ARGV[\$1]/ge;\n\n"; $c .= "\t} else {\n"; $c .= "\t\t\@tmp = split /,/, \"$list\";\n"; $c .= "\t\tforeach (\@_) { my \$i = shift \@tmp;\n"; $c .= "\t\t\t\$code =~ s/\\b\$i\\b/'\$_'/g;\n"; $c .= "\t\t}\n"; $c .= "\t}\n"; # main $c .= "\$t = Biblio::Thesaurus::ModRewrite->new(\$obj);\n"; $c .= "\$t->process(\$code);\n"; # finish $c .="}\n"; $c; } =head2 FILTER This filters your Perl source code. =cut FILTER { return if m/^(\s|\n)*$/; #print "BEFORE $_\n"; s/^OML\s+(\w+)(\(([\w,]+)\))?\s*\n((?:.|\n)*?)^ENDOML/buildOML($1,$3,$4)/gem; #print "AFTER $_\n"; $_; }; =head1 EXAMPLES Look in the F and F directory for sample programs. =head1 AUTHOR Nuno Carvalho, C<< >> J.Joao Almeida, C<< >> Alberto Simoes, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008 Nuno Carvalho, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Biblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/ModRewrite/Parser.pm0000644000076500000240000002074411606574021025507 0ustar smashstaff#################################################################### # # This file was generated using Parse::Yapp version 1.05. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package Biblio::Thesaurus::ModRewrite::Parser; use vars qw ( @ISA ); use strict; @ISA= qw ( Parse::Yapp::Driver ); use Parse::Yapp::Driver; #line 1 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" =head1 NAME Biblio::Thesaurus::ModRewrite::Parser - this module implements the parser for OML programs =head1 VERSION Version 0.02 =cut our $VERSION = '0.03'; my $File; my $t; ### Reg exp for blocks my $bl0 = qr((?:\\[{}]|[^{}])*); my $bl1 = qr(\{$bl0\}); my $bl2 = qr(\{$bl0(?:$bl1*$bl0)*\}); my $bl3 = qr(\{$bl0(?:$bl2*$bl0)*\}); my $bl4 = qr(\{$bl0(?:$bl3*$bl0)*\}); my $blmidle = qr($bl0(?:$bl4*$bl0)*); =head1 DESCRIPTION This module implements the parser used in Biblio::Thesaurus::ModRewrite to execute programs written in OML. OML is a domain specific language to describe operations to execut eon ontologies. =head1 FUNCTIONS =cut =head2 new Create a new object. =cut sub new { my($class)=shift; ref($class) and $class=ref($class); my($self)=$class->SUPER::new( yyversion => '1.05', yystates => [ {#State 0 DEFAULT => -3, GOTOS => { 'statement_list' => 1, 'program' => 2 } }, {#State 1 ACTIONS => { 'REL' => 4, 'VAR' => 8, 'TERM' => 9, 'DO' => 10, 'STRING' => 5 }, DEFAULT => -1, GOTOS => { 'cond_block' => 3, 'statement' => 7, 'token' => 11, 'term' => 6 } }, {#State 2 ACTIONS => { '' => 12 } }, {#State 3 ACTIONS => { 'ARROW' => 13 } }, {#State 4 ACTIONS => { 'OPEN' => 14 } }, {#State 5 DEFAULT => -11 }, {#State 6 ACTIONS => { 'VAR' => 16, 'STRING' => 15 }, GOTOS => { 'relation' => 17 } }, {#State 7 ACTIONS => { 'DOT' => 18 } }, {#State 8 DEFAULT => -12 }, {#State 9 ACTIONS => { 'OPEN' => 19 } }, {#State 10 ACTIONS => { 'ARROW' => 20 } }, {#State 11 ACTIONS => { 'AND' => 21, 'OR' => 23 }, DEFAULT => -6, GOTOS => { 'oper' => 22 } }, {#State 12 DEFAULT => 0 }, {#State 13 DEFAULT => -19, GOTOS => { 'action_block' => 24, 'action_list' => 25 } }, {#State 14 ACTIONS => { 'VAR' => 16, 'STRING' => 15 }, GOTOS => { 'relation' => 26 } }, {#State 15 DEFAULT => -13 }, {#State 16 DEFAULT => -14 }, {#State 17 ACTIONS => { 'VAR' => 8, 'STRING' => 5 }, GOTOS => { 'term' => 27 } }, {#State 18 DEFAULT => -2 }, {#State 19 ACTIONS => { 'VAR' => 8, 'STRING' => 5 }, GOTOS => { 'term' => 28 } }, {#State 20 DEFAULT => -19, GOTOS => { 'action_block' => 29, 'action_list' => 25 } }, {#State 21 DEFAULT => -15 }, {#State 22 ACTIONS => { 'REL' => 4, 'VAR' => 8, 'TERM' => 9, 'STRING' => 5 }, GOTOS => { 'cond_block' => 30, 'token' => 11, 'term' => 6 } }, {#State 23 DEFAULT => -16 }, {#State 24 DEFAULT => -4 }, {#State 25 ACTIONS => { 'SUB' => 31, 'ACTION' => 32 }, DEFAULT => -17, GOTOS => { 'action' => 33 } }, {#State 26 ACTIONS => { 'CLOSE' => 34 } }, {#State 27 DEFAULT => -8 }, {#State 28 ACTIONS => { 'CLOSE' => 35 } }, {#State 29 DEFAULT => -5 }, {#State 30 DEFAULT => -7 }, {#State 31 ACTIONS => { 'CODE' => 36 } }, {#State 32 ACTIONS => { 'OPEN' => 37 } }, {#State 33 DEFAULT => -18 }, {#State 34 DEFAULT => -10 }, {#State 35 DEFAULT => -9 }, {#State 36 DEFAULT => -21 }, {#State 37 ACTIONS => { 'REL' => 4, 'VAR' => 8, 'TERM' => 9, 'STRING' => 5 }, GOTOS => { 'token' => 38, 'term' => 6 } }, {#State 38 ACTIONS => { 'CLOSE' => 39 } }, {#State 39 DEFAULT => -20 } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'program', 1, sub #line 47 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{ program=>$_[1] } } ], [#Rule 2 'statement_list', 3, sub #line 51 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { my $n = keys %{$_[1]}; +{ %{$_[1]}, $n=>$_[2]} } ], [#Rule 3 'statement_list', 0, sub #line 55 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{} } ], [#Rule 4 'statement', 3, sub #line 58 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{cond=>$_[1],action=>$_[3]} } ], [#Rule 5 'statement', 3, sub #line 59 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{cond=>'true',action=>$_[3]} } ], [#Rule 6 'cond_block', 1, undef ], [#Rule 7 'cond_block', 3, sub #line 63 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{$_[2] => [$_[1],$_[3]]} } ], [#Rule 8 'token', 3, sub #line 66 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { [ $_[1], $_[2], $_[3] ] } ], [#Rule 9 'token', 4, sub #line 67 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'term'=>$_[3]} } ], [#Rule 10 'token', 4, sub #line 68 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'rel'=>$_[3]} } ], [#Rule 11 'term', 1, sub #line 71 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'term'=>$_[1]} } ], [#Rule 12 'term', 1, sub #line 72 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'var'=>$_[1]} } ], [#Rule 13 'relation', 1, sub #line 75 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'relation'=>$_[1]} } ], [#Rule 14 'relation', 1, sub #line 76 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{'var',$_[1]} } ], [#Rule 15 'oper', 1, sub #line 79 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { 'and' } ], [#Rule 16 'oper', 1, sub #line 80 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { 'or' } ], [#Rule 17 'action_block', 1, undef ], [#Rule 18 'action_list', 2, sub #line 87 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { my $n = keys %{$_[1]}; +{ %{$_[1]}, $n=>$_[2] } } ], [#Rule 19 'action_list', 0, sub #line 91 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{} } ], [#Rule 20 'action', 4, sub #line 94 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{ $_[1] => $_[3] } } ], [#Rule 21 'action', 2, sub #line 95 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" { +{ $_[1] => $_[2] } } ] ], @_); bless($self,$class); } #line 98 "lib/Biblio/Thesaurus/ModRewrite/Parser.yp" =head2 lex Function used to tokenize source code. =cut sub lex { for ($File) { s!^\s+!!; s!^\#.*?\n!!; ($_ eq '') and return ('',undef); s!^(\=\>)!! and return('ARROW',$1); s!^(and|\&\&|∧)!!i and return('AND',$1); s!^(or|\|\||∨)!!i and return('OR',$1); s!^(not|\!)!!i and return('NOT',$1); s!^(do|begin|end)!!i and return('DO',$1); s!^(\=\>|⇒)!! and return('ARROW',$1); s!^(\:)!! and return('COLON',$1); s!^(\()!! and return('OPEN',$1); s!^(\))!! and return('CLOSE',$1); s!^(\,)!! and return('COMMA',$1); s!^(\.)!! and return('DOT',$1); s!^(sub)!! and return('SUB',$1); #s!^\{(.*)\}!!s and print "|$1|\n" and return('CODE',$1); #s!^\{([^{}]*(\{[^{}]*\}[^{}]*)*)\}!!s and return('CODE',$1); s!^\{($blmidle)\}!!s and return('CODE',$1); s!^(term)!! and return('TERM',$1); s!^(rel)!! and return('REL',$1); s!^(add|del)!! and return('ACTION',$1); if (s!^(\w+|\'.*?\'|\".*?\")!!) { my $zbr = $1; $zbr =~ s/\'|\"//g; return('STRING',$zbr); } s!^\$([a-z]+)!! and return('VAR',$1); } } =head2 yyerror Function used to report errors. =cut sub yyerror { if ($_[0]->YYCurtok) { printf STDERR ('Error: a "%s" (%s) was found where %s was expected'."\n", $_[0]->YYCurtok, $_[0]->YYCurval, $_[0]->YYExpect) } else { print STDERR "Expecting one of ",join(", ",$_[0]->YYExpect),"\n"; } } =head2 init_lex Function used to initialize everything we need. =cut sub init_lex { my $self = shift; $File = shift; local $/; undef $/; #$File = <> } =head1 AUTHOR Nuno Carvalho, C<< >> J.Joao Almeida, C<< >> Alberto Simoes, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008 Nuno Carvalho, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vim: set filetype=perl 1; Biblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/ModRewrite/Parser.yp0000644000076500000240000000774011606573527025536 0ustar smashstaff%{ =head1 NAME Biblio::Thesaurus::ModRewrite::Parser - this module implements the parser for OML programs =head1 VERSION Version 0.02 =cut our $VERSION = '0.03'; my $File; my $t; ### Reg exp for blocks my $bl0 = qr((?:\\[{}]|[^{}])*); my $bl1 = qr(\{$bl0\}); my $bl2 = qr(\{$bl0(?:$bl1*$bl0)*\}); my $bl3 = qr(\{$bl0(?:$bl2*$bl0)*\}); my $bl4 = qr(\{$bl0(?:$bl3*$bl0)*\}); my $blmidle = qr($bl0(?:$bl4*$bl0)*); =head1 DESCRIPTION This module implements the parser used in Biblio::Thesaurus::ModRewrite to execute programs written in OML. OML is a domain specific language to describe operations to execut eon ontologies. =head1 FUNCTIONS =cut =head2 new Create a new object. =cut %} %% program : statement_list { +{ program=>$_[1] } } ; statement_list : statement_list statement DOT { my $n = keys %{$_[1]}; +{ %{$_[1]}, $n=>$_[2]} } | { +{} } ; statement : cond_block ARROW action_block { +{cond=>$_[1],action=>$_[3]} } | DO ARROW action_block { +{cond=>'true',action=>$_[3]} } ; cond_block : token | token oper cond_block { +{$_[2] => [$_[1],$_[3]]} } ; token: term relation term { [ $_[1], $_[2], $_[3] ] } | TERM OPEN term CLOSE { +{'term'=>$_[3]} } | REL OPEN relation CLOSE { +{'rel'=>$_[3]} } ; term : STRING { +{'term'=>$_[1]} } | VAR { +{'var'=>$_[1]} } ; relation : STRING { +{'relation'=>$_[1]} } | VAR { +{'var',$_[1]} } ; oper : AND { 'and' } | OR { 'or' } ; action_block : action_list ; action_list : action_list action { my $n = keys %{$_[1]}; +{ %{$_[1]}, $n=>$_[2] } } | { +{} } ; action : ACTION OPEN token CLOSE { +{ $_[1] => $_[3] } } | SUB CODE { +{ $_[1] => $_[2] } } ; %% =head2 lex Function used to tokenize source code. =cut sub lex { for ($File) { s!^\s+!!; s!^\#.*?\n!!; ($_ eq '') and return ('',undef); s!^(\=\>)!! and return('ARROW',$1); s!^(and|\&\&|∧)!!i and return('AND',$1); s!^(or|\|\||∨)!!i and return('OR',$1); s!^(not|\!)!!i and return('NOT',$1); s!^(do|begin|end)!!i and return('DO',$1); s!^(\=\>|⇒)!! and return('ARROW',$1); s!^(\:)!! and return('COLON',$1); s!^(\()!! and return('OPEN',$1); s!^(\))!! and return('CLOSE',$1); s!^(\,)!! and return('COMMA',$1); s!^(\.)!! and return('DOT',$1); s!^(sub)!! and return('SUB',$1); #s!^\{(.*)\}!!s and print "|$1|\n" and return('CODE',$1); #s!^\{([^{}]*(\{[^{}]*\}[^{}]*)*)\}!!s and return('CODE',$1); s!^\{($blmidle)\}!!s and return('CODE',$1); s!^(term)!! and return('TERM',$1); s!^(rel)!! and return('REL',$1); s!^(add|del)!! and return('ACTION',$1); if (s!^(\w+|\'.*?\'|\".*?\")!!) { my $zbr = $1; $zbr =~ s/\'|\"//g; return('STRING',$zbr); } s!^\$([a-z]+)!! and return('VAR',$1); } } =head2 yyerror Function used to report errors. =cut sub yyerror { if ($_[0]->YYCurtok) { printf STDERR ('Error: a "%s" (%s) was found where %s was expected'."\n", $_[0]->YYCurtok, $_[0]->YYCurval, $_[0]->YYExpect) } else { print STDERR "Expecting one of ",join(", ",$_[0]->YYExpect),"\n"; } } =head2 init_lex Function used to initialize everything we need. =cut sub init_lex { my $self = shift; $File = shift; local $/; undef $/; #$File = <> } =head1 AUTHOR Nuno Carvalho, C<< >> J.Joao Almeida, C<< >> Alberto Simoes, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008 Nuno Carvalho, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # vim: set filetype=perl Biblio-Thesaurus-ModRewrite-0.03/lib/Biblio/Thesaurus/ModRewrite.pm0000644000076500000240000002655111606573467024272 0ustar smashstaffpackage Biblio::Thesaurus::ModRewrite; use warnings; #use strict; =head1 NAME Biblio::Thesaurus::ModRewrite - a module to manipulate ontologies =head1 VERSION Version 0.02 =cut our $VERSION = '0.03'; =head1 SYNOPSIS use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; my $code = "Lisbon 'city-of' Portugal => add (Lisbon 'city-of' Europe)."; $thesaurus = thesaurusLoad($file); $obj = Biblio::Thesaurus::ModRewrite->new($thesaurus); $obj->process($code); =head1 DESCRIPTION This module implements a compiler to run programs written in a domain specific language that can be used to manipulate information in ontologies. This domain specific language is called OML and is descibed in the next section. =head1 OML OML is a domain specific language that can be used to describe operations that manipulate information in a ontology. Programs written in OML are a set of rules that are executed in order, each rule looks something like: pattern => action . Which means that when the C is found the given C block is executed. =head2 Patterns Patterns describe information in the ontology. A pattern can be used to represent terms, relations, relations between terms, or any combination of any of these. =head2 Actions The action block is used to describe the operations that are going to be executed if a given pattern is found. =cut use FindBin qw($Bin); use lib "$Bin/lib"; use Data::Dumper; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; use Biblio::Thesaurus::ModRewrite::Parser; my $code; our $obj; my $tree; my $sem; my %arg; my $target = ''; my $DEBUG = 1; =head1 FUNCTIONS =head2 new This function creates a new object and stores the source file for the thesaurus given as argument. =cut sub new { my ($class, $thesaurus) = @_; my $self = bless({}, $class); $obj = $thesaurus; return $self; } =head2 process This funcion processes source code written in OML. This and C should be the only functions you need to call to use this module. =cut sub process { my $self = shift; $code = shift; $target = shift if @_>0; $tree = parseFile(); if ($target eq 'parse') { print Dumper $tree; return 1; } $sem = buildSemanticTree($tree); if ($target eq 'process') { print Dumper $sem; return 1; } run_program($sem); } =head2 parseFile This function parses the source code and builds a parsing tree. The parser is defined in the Biblio::Thesaurus::ModRewrite::Parser module. =cut sub parseFile { my $self = shift; my $parser = Biblio::Thesaurus::ModRewrite::Parser->new; $parser->init_lex($code); my $t = $parser->YYParse( yylex => \&Biblio::Thesaurus::ModRewrite::Parser::lex, yyerror => \&Biblio::Thesaurus::ModRewrite::Parser::yyerror); } =head2 buildSemanticTree This function calculates the solution node for every pattern in the parsing tree. =cut sub buildSemanticTree { my $t = shift; foreach (sort keys %{$tree->{'program'}}) { my $set = calc_set($tree->{'program'}{$_}{'cond'}); $sem->{$_} = [ $set, $tree->{'program'}{$_}{'action'}]; } return $sem; } =head2 calc_set This funcion calculates the solution for a given pattern. =cut sub calc_set { my $c = shift; my @return; if ($c eq 'true') { my @a = ('1'); return @a; } if (ref $c eq 'ARRAY') { (my $k0, my $v0) = each %{ @$c[0] }; (my $k1, my $v1) = each %{ @$c[1] }; (my $k2, my $v2) = each %{ @$c[2] }; if ($k0 eq 'term' and $k1 eq 'relation' and $k2 eq 'term') { return $obj->hasRelation(@$c[0]->{'term'},@$c[1]->{'relation'},@$c[2]->{'term'}); } my @a = (); if ($k0 eq 'var' and $k1 eq 'relation' and $k2 eq 'term') { foreach ($obj->allTerms) { ($obj->hasRelation($_,@$c[1]->{'relation'},@$c[2]->{'term'})) and push @return, +{$v0=>$_}; } return \@return; } if ($k0 eq 'term' and $k1 eq 'relation' and $k2 eq 'var') { foreach ($obj->allTerms) { ($obj->hasRelation(@$c[0]->{'term'},@$c[1]->{'relation'},$_)) and push @return, +{$v2=>$_}; } return \@return; } my @b = (); if ($k0 eq 'var' and $k1 eq 'relation' and $k2 eq 'var') { foreach my $i ($obj->allTerms) { foreach my $j ($obj->allTerms) { if ($obj->hasRelation($i,@$c[1]->{'relation'},$j)) { if ($v0 eq $v2) { ($i eq $j) and push @return, +{ $v0=>$i, $v2=>$j }; } else { push @return, +{ $v0=>$i, $v2=>$j }; } } } } return \@return; } if ($k0 eq 'term' and $k1 eq 'var' and $k2 eq 'term') { foreach ($obj->relations(@$c[0]->{'term'})) { ($obj->hasRelation(@$c[0]->{'term'},$_,@$c[2]->{'term'})) and push @return, +{$v1=>$_}; } return \@return; } if ($k0 eq 'term' and $k1 eq 'var' and $k2 eq 'var') { foreach my $i ($obj->relations(@$c[0]->{'term'})) { foreach my $j ($obj->allTerms) { ($obj->hasRelation(@$c[0]->{'term'},$i,$j)) and push @return, +{$v1=>$i, $v2=>$j}; } } return \@return; } if ($k0 eq 'var' and $k1 eq 'var' and $k2 eq 'term') { foreach my $i ($obj->allTerms) { foreach my $j ($obj->relations($i)) { ($obj->hasRelation($i,$j,@$c[2]->{'term'})) and push @return, +{$v0=>$i, $v1=>$j}; } } return \@return; } if ($k0 eq 'var' and $k1 eq 'var' and $k2 eq 'var') { foreach my $i ($obj->allTerms) { foreach my $j ($obj->relations($i)) { foreach my $k ($obj->allTerms) { ($obj->hasRelation($i,$j,$k)) and push @return, +{$v0=>$i, $v1=>$j, $v2=>$k}; } } } return \@return; } } if (ref $c eq 'HASH') { (my $k, my $v) = each %$c; (my $op, my $l) = each %$v; if ($op eq 'term') { print "term only"; } if ($op eq 'var') { if ($k eq 'term') { foreach ($obj->allTerms) { push @return, +{$l=>$_}; } } if ($k eq 'rel') { my %visited; foreach my $i ($obj->allTerms) { foreach ($obj->relations($i)) { push @return, +{$l=>$_} unless($visited{$_}); $visited{$_}++; } } } return \@return; } my $res; foreach my $i (@$l) { my $tmp = calc_set($i); if (!defined $res) { $res = Storable::dclone($tmp); } else { $op eq 'and' and $res = _intersect($res, $tmp); $op eq 'or' and $res = _union($res, $tmp); } } return $res; } 0; } =head2 _intersect This function is used by C and should not be called on it's own. =cut sub _intersect { my $left = Storable::dclone($_[0]); my $right = Storable::dclone($_[1]); my @final = (); my @left_array = @$left; my @right_array = @$right; foreach my $i (@left_array) { foreach my $j (@right_array) { my @a = keys %{$i}; my @b = keys %{$j}; my @r = _comum(\@a,\@b); my $flag = 1; if (@r > 0) { foreach (@r) { $flag = 0 unless $i->{$_} eq $j->{$_}; } $flag and push @final, +{ %$i, %$j }; } else { push @final, +{ %$i, %$j }; } } } return \@final; } =head2 _comum This function is used by C and should not be called on it's own. =cut sub _comum { my $a = shift; my $b = shift; my @res = (); foreach my $m (@{$a}) { my $exists = grep {$m eq $_} @{$b}; ($exists > 0) and push @res, $m; } return @res; } =head2 _union This function is used by C and should not be called on it's own. =cut sub _union { my $left = Storable::dclone($_[0]); my $right = Storable::dclone($_[1]); my @final = (); my @left_array = @$left; my @right_array = @$right; foreach my $i (@left_array) { push @final, +{ %$i }; } foreach my $j (@right_array) { push @final, +{ %$j }; } return \@final; } =head2 run_program This function executes every action for each rule in an OML program. =cut sub run_program { my $t = shift; foreach (sort keys %$t) { my $set = $t->{$_}[0]; my $action = $t->{$_}[1]; if ($set eq 1) { # XXX execute($action); } else { foreach my $i (@$set) { foreach my $key (keys %$i) { $arg{$key} = $i->{$key}; } execute($action); } } } return 1; # XXX } my %callback = ( 'add' => sub { my $arg = shift; (ref $arg eq 'ARRAY') and $DEBUG and print "\$obj->addRelation($arg->[0]->{'term'},$arg->[1]->{'relation'},$arg->[2]->{'term'})\n"; return $obj->addRelation($arg->[0]->{'term'},$arg->[1]->{'relation'},$arg->[2]->{'term'}); }, 'del' => sub { my $arg = shift; (ref $arg eq 'ARRAY') and $DEBUG and print "\$obj->deleteRelation($arg->[0]->{'term'},$arg->[1]->{'relation'},$arg->[2]->{'term'})\n"; return $obj->deleteRelation($arg->[0]->{'term'},$arg->[1]->{'relation'},$arg->[2]->{'term'}); }, ); =head2 execute This function is used to execute an action. =cut sub execute { my $ref = shift; my $copy = Storable::dclone($ref); while( my ($n, $code) = each %$copy ) { my ($op, $args) = each %$code; if ($op eq 'sub') { # run a perl sub my $code = ''; foreach (keys %arg) { $code .= " my \$$_ = '$arg{$_}'; "; } $code = $code . $args; eval $code; warn "$@ in block{$code}" if $@; } else { # not a sub run an op from the callback table my $tag = 'term'; foreach (@$args) { my ($l,$r) = each %$_; $l eq 'var' and $_ = +{ $tag => $arg{$r} }; if ($tag eq 'term') { $tag = 'relation'; } else { $tag = 'term'; } } $callback{$op}->($args); } } } =head1 EXAMPLES Look in the F and F directory for sample programs. =head1 AUTHOR Nuno Carvalho, C<< >> J.Joao Almeida, C<< >> Alberto Simoes, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008 Nuno Carvalho, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1 or not 1; Biblio-Thesaurus-ModRewrite-0.03/Makefile.PL0000644000076500000240000000204011606572122017642 0ustar smashstaffuse strict; use warnings; use ExtUtils::MakeMaker; my $MY_YAPP = `which yapp`; chomp $MY_YAPP; $MY_YAPP eq '' and die "install Parse::Yapp"; `$MY_YAPP -m Biblio::Thesaurus::ModRewrite::Parser -o lib/Biblio/Thesaurus/ModRewrite/Parser.pm lib/Biblio/Thesaurus/ModRewrite/Parser.yp`; if ($? == 0) { print "Building lib/Biblio/Thesaurus/ModRewrite/Parser.pm\n"; } else { print "Building lib/Biblio/Thesaurus/ModRewrite.pm (failed)\n"; } WriteMakefile( NAME => 'Biblio::Thesaurus::ModRewrite', AUTHOR => 'Nuno Carvalho ', VERSION_FROM => 'lib/Biblio/Thesaurus/ModRewrite.pm', ABSTRACT_FROM => 'lib/Biblio/Thesaurus/ModRewrite.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'Test::Output' => 0, 'Parse::Yapp' => 0, 'Biblio::Thesaurus' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Biblio-Thesaurus-ModRewrite-*' }, MAKEFILE_OLD => '', ); Biblio-Thesaurus-ModRewrite-0.03/MANIFEST0000644000076500000240000000122611606574023017030 0ustar smashstaff.cvsignore bin/animals1.iso bin/animals2.iso bin/apply_rules bin/client.pl bin/create_animals.pl bin/handle_query.pl bin/merge bin/server.pl bin/term2dot bin/term2dot.embed bin/term2html bin/term2html.cgi bin/term2tex bin/terms2tab bin/validate Changes examples/embed examples/ex1 examples/ex2 examples/ex3 examples/term2desc examples/geo.iso lib/Biblio/Thesaurus/ModRewrite.pm lib/Biblio/Thesaurus/ModRewrite/Embed.pm lib/Biblio/Thesaurus/ModRewrite/Parser.pm lib/Biblio/Thesaurus/ModRewrite/Parser.yp Makefile.PL MANIFEST README t/00-load.t t/05-process.t t/pod-coverage.t t/pod.t META.yml Module meta-data (added by MakeMaker) Biblio-Thesaurus-ModRewrite-0.03/META.yml0000644000076500000240000000121211606574023017143 0ustar smashstaff--- #YAML:1.0 name: Biblio-Thesaurus-ModRewrite version: 0.03 abstract: a module to manipulate ontologies author: - Nuno Carvalho license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Biblio::Thesaurus: 0 Parse::Yapp: 0 Test::More: 0 Test::Output: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Biblio-Thesaurus-ModRewrite-0.03/README0000644000076500000240000000272211502506263016555 0ustar smashstaffBiblio-Thesaurus-ModRewrite The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it to get an idea of the module's uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Biblio::Thesaurus::ModRewrite You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Biblio-Thesaurus-ModRewrite AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Biblio-Thesaurus-ModRewrite CPAN Ratings http://cpanratings.perl.org/d/Biblio-Thesaurus-ModRewrite Search CPAN http://search.cpan.org/dist/Biblio-Thesaurus-ModRewrite COPYRIGHT AND LICENCE Copyright (C) 2008 Nuno Carvalho This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Biblio-Thesaurus-ModRewrite-0.03/t/0000755000076500000240000000000011606574023016141 5ustar smashstaffBiblio-Thesaurus-ModRewrite-0.03/t/00-load.t0000644000076500000240000000030211502506262017450 0ustar smashstaff#!perl use Test::More tests => 1; BEGIN { use_ok( 'Biblio::Thesaurus::ModRewrite' ); } diag( "Testing Biblio::Thesaurus::ModRewrite $Biblio::Thesaurus::ModRewrite::VERSION, Perl $], $^X" ); Biblio-Thesaurus-ModRewrite-0.03/t/05-process.t0000644000076500000240000000311011606573403020222 0ustar smashstaff#!perl use Test::More tests => 7; use Test::Output; use Biblio::Thesaurus; use Biblio::Thesaurus::ModRewrite; sub proc { my $code = shift; my $obj = thesaurusLoad('examples/geo.iso'); my $t = Biblio::Thesaurus::ModRewrite->new($obj); $t->process($code); } # 1 -- term relation term output_is { proc(<<'CODE') } <<'OUTPUT','','term relation term'; Braga 'CITY-OF' Portugal => sub { print "found\n"; }. CODE found OUTPUT # 2 -- $t relation term output_is { proc(<<'CODE') } <<'OUTPUT','','$t relation term'; $city 'CITY-OF' Portugal => sub { print $city . "\n"; }. CODE Braga Guimaraes Lisboa Porto OUTPUT # 3 -- term relation $t output_is { proc(<<'CODE') } <<'OUTPUT','','term relation $t'; Guimaraes 'CITY-OF' $country => sub { print $country . "\n"; }. CODE Portugal OUTPUT # 4 -- term $r term output_is { proc(<<'CODE') } <<'OUTPUT','','term $r term'; Braga $relation Portugal => sub { print "$relation\n"; }. CODE CITY-OF OUTPUT # 5 -- $t relation $t output_is { proc(<<'CODE') } <<'OUTPUT','','$t relation $t'; $a 'CITY-OF' $b => sub { print "$a @ $b\n"; }. CODE Braga @ Braga Braga @ Portugal Bruxelas @ Belgica Guimaraes @ Portugal Lisboa @ Portugal Londres @ Inglaterra Madrid @ Espanha Paris @ Franca Porto @ Portugal Vigo @ Espanha OUTPUT # 6 -- $t relation $t output_is { proc(<<'CODE') } '', <<'OUTPUT','$t relation $t'; $a 'CITY-OF' $a => sub { warn "CITY-OF reflexiva para $a\n"; }. CODE CITY-OF reflexiva para Braga OUTPUT # 7 -- $t relation term -- empty $t output_is { proc(<<'CODE') } '','','$t relation term -- empty $t'; $city 'CITY-OF' Russia => sub { print $city; }. CODE Biblio-Thesaurus-ModRewrite-0.03/t/pod-coverage.t0000644000076500000240000000104711502506262020676 0ustar smashstaffuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Biblio-Thesaurus-ModRewrite-0.03/t/pod.t0000644000076500000240000000035011502506262017101 0ustar smashstaff#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok();