#!/usr/bin/perl  -w -s

use strict;
use DB_File;
use Tie::Cvs;
use Tie::TextDir;
use Biblio::Thesaurus;
use Fcntl ;
use CGI (":all","start_table",":nodebug");
use Data::Dumper ;
  $Data::Dumper::Terse   =1;
  $Data::Dumper::Indent  =1;
  $Data::Dumper::Deepcopy=1;
use HTML::BoxML;
use Pod::Simple::HTML;
use LWP::Simple qw/get/;      #import _only_ the get function

if($ENV{'PATH_INFO'}){
  my $aux = $ENV{'PATH_INFO'};
  $aux =~ s!^/!!; 
  $aux =~ s!/! !g; 
  param('topic', $aux); }

my %h;
our ($textdir,$tohtml,$export,$import,$create,$cvsdir,$slides,$base,$name,$print);
$tohtml ||=  $slides || $print;

our %conf;

if($tohtml || $textdir){
  if($ARGV[0] =~ s/^(.*?):(.*)$/$2/ ){ $base = $1  }
  $conf{mode}="FILE" unless $base;
  $conf{base} =  $textdir || $base || "."; 
}
else{
  $conf{base} = $base || $0;
  $conf{base} =~ s!.*/!!;
}


# Defaults

setDefault();

sub setDefault{

	$conf{dir}     = "/home/jj/cvs/Breviario/";
	$conf{cgidir}  = "/home/jj/public_html/bin/";
	$conf{cvsdir}  = $cvsdir || "/breviario/";
	$conf{cssfile} = "";
	$conf{mode} ||= "CVS"   ;  #by default use Tie::CVS 
	$conf{mode} ||= "DBFILE";  #by default use Tie::DB_File 
	$conf{mode} ||= "FILE";    #by default use Simple File
	$conf{topic}   = "apresentação";
	$conf{author}  = 'jj@di.uminho.pt';
	$conf{name}    = ucfirst($name || $conf{base} || "Breviário");
	undef $conf{hosts_allow};
        ### $conf{hosts_allow} = "natura.di.uminho.pt 127.0.0.1";
}


my @col=("#ffffff",
         "#226219;" , #Verde fundo
         "#6a8394;" , #azul
         "#f36e21;" , #laranja 
         "#f9ce87;" , #laranja2
         "#fbdea7;" , #laranja3
         "#d25c10;" , #laranja4
);

my $defaultcss = "<!--
  hr       { border: none; border-top: solid thin $col[3] }
  *.boxed  { border: solid 1px $col[3] margin: 6pt; padding: 6pt; }
  *.orange { color: $col[3] }
  a        { color: $col[6] text-decoration: none; }
  a:white  { color: #ffffff; text-decoration: none; }
  a:hover  { color: #000; text-decoration: none; }
  h1.newslide  { background-color: $col[4] font-size: large;
             color: #000; padding: 3px; margin-top: 400px; }
  h1       { background-color: $col[4] font-size: large;
             color: #000; padding: 3px; margin-bottom: 2px; }
  h2       { background-color: $col[5] font-size: medium;
	     color: #000; padding: 3px; margin-bottom: 2px; }
  h3       { background-color: $col[5] font-size: small;
	     color: #000; padding: 3px; margin-bottom: 2px; }
  div.body { margin-left: 15px; margin-right: 15px; }
  p        { text-align: justify; }
  /* for Boxml: */
  table.box   { border: solid 1px #000; margin: 1px;  }
  th.boxtitle { background-color: #548b8e;
                color: #fff; border-bottom: solid 1px #000; }
  *.tiny      { font-size:small;}
  --> ";

my $fgo=  q[
 var i = 0; 
 var max=30; 
 var loc; 
 function go(){ 
   if(i > max){ i=0; } loc="#slide"+i;i++; this.location=loc;}];


if (-f "$conf{base}.cnf") {
  open CONFIG, "$conf{base}.cnf" or die "Cannot open configuration file $conf{base}.cnf";
  my @conf_keys = qw/dir cgidir cssfile base hosts_allow topic author name datadir/;
  while (<CONFIG>) {
    chomp;
    my ($key,$data) = split /\s*=>\s*/;
    for (@conf_keys) {
      $conf{$_} = $data if $_ eq $key;
    }
  }
  close CONFIG;
}

## prepare datadir
$conf{datadir}     = "$conf{dir}/DataDir" unless exists $conf{datadir};

if(defined $conf{hosts_allow}){
  ## prepare hosts_allow
  my $s=$conf{hosts_allow};
  $conf{hosts_allow}={};
  for (grep {/./} split /\s+/, $s) {
      $conf{hosts_allow}{$_} = $_; } 
}

param('base',param('base')||"$conf{dir}$conf{base}.db");
param('topic',param('topic')||$conf{topic});

my $x;

if($conf{mode} eq q{CVS}){
      $x = tie %h, 'Tie::Cvs', "$conf{cvsdir}$conf{base}", 0664
  or die("can't open '$conf{cvsdir}$conf{base}'".":$!\n");
}
elsif($conf{mode} eq q{DBFILE}) {$x = tie %h, 'DB_File', param('base'),
  O_RDWR|O_CREAT , 0666, $DB_BTREE
  or die("can't open ".param('base').":$!\n");
}
elsif($conf{mode} eq q{FILE}) {$x = tie %h, 'Tie::TextDir', $conf{'base'}
  or die("can't open dir '$conf{base}':$!\n");
  print STDERR  Dumper($x);
}

my ($mday,$mon,$year) = (localtime(time()))[3,4,5];
##my $fulldate = localtime;
my $fulldate = sprintf('%4d/%.2d/%.2d',$year+1900,$mon+1,$mday);
my %a =
  ( -defaultaction => 'consultar',

    -common => { action => sub { param('topic',param('topic')||'apresentação');},
	         inter  => sub { strong(big("&nbsp;".
					     a({-class=>"homeurl",
						-href=>url()."?todo=consultar&topic=$conf{topic}"},
					       $conf{name})."&nbsp;")) .
				    textfield(-name=>'topic') }
		},

    consultar => { action => sub {
      my $opt={};
      if(param("topic") =~ m{(.*)!(\w+)}){
        param("topic",$1);
        $opt={$2=>1}}
      print tohtml($opt,$h{"the::".param("topic")}||param('topic'),
		   $h{param("topic")},
		   lista_anexos(param("topic")));
                   my $the = procthe($h{"the::".param("topic")});
                   param("classe",$the->{thesaurus}{fmt}[0] || "sp");
                   },
		  args =>['classe','topic','n'],
                 },

    listar => sub {
      my @keys = listartopics();
      print p(start_table({class=>"box",cellspacing=>"0",cellpadding=>"0"}),
                    Tr(th({class=>"boxtitle",width=>'60%'},"Tópico"),
                       th({class=>"boxtitle",width=>'20%'},"Tamanho"),
                       th({class=>"boxtitle",width=>'20%'},"Data")));
      my $i = 1;
      param('todo','consultar');
      for (@keys) {
	$i++;
	my $clss = $i % 2 ? "odd" : "even";
	print "<tr><td class=\"$clss\">",sp2url($_),"</td>\n";
	print "    <td align=\"right\" class=\"$clss\"><small>";
	print format_size(length($h{$_}))." bytes</small></td>\n";
	print "    <td align=\"right\" class=\"$clss\"><small>",getDate($h{"the::$_"}),"</small></td>\n";
	print "</tr>\n";
      }
      print "</table></p>\n";
    },

    editar => [
	       { inter => sub {
		   my $str = "";
		   $str .= textarea(
                                    -wrap =>"virtual",
                                    -style => "width:100%",
				    -name    => 'thesaurus',
				    -default => $h{"the::".param('topic')} || param('topic')
				    ."\nfmt sp\n",
				    -rows    => 4,
				    -columns => 80
				   );
		   $str .= textarea(
                                    -wrap =>"virtual",
                                    -style => "width:100%",
				    -name    => 'def',
				    -default => $h{param('topic')} || "",
				    -rows    => 40,
				    -columns => 80);
		   $str .= p("Anexar ficheiro:",br,
			     submit(-name => 'upload',
				    -value => 'Upload'),
			     br,
			     filefield(-name => 'file',
				       -size => 60));
		   $str .= lista_anexos(param('topic'));

		   $str;
		 },
		 precond => sub{
		   if (not valid(remote_host(),$conf{hosts_allow})) {
                     #Dumper($conf{hosts_allow}).
		     "Sorry you cant edit this topic..."; #.remote_host();
		   } else{""} },
		 args  =>['topic'],
		 next  => 'preview'
	       },
	       { action => sub {
		   my $thesaurus = param("thesaurus");
		   $thesaurus =~ s!\ndate\s+.+\n!\n!;
		   $thesaurus.= "\ndate $fulldate\n";
		   param("thesaurus", $thesaurus);
		   print tohtml(param("thesaurus")||param('topic'),
				param("def"),
				lista_anexos(param("topic")));},
		 args =>['topic','def','thesaurus'],
		 poscond => sub{
		   my $thes=param('thesaurus');
		   if ($thes =~ m/\nfmt\s+perl\b/ and not isTheServer()){
		        "Just local user can make perl document";}
		   else{""} },
		 next =>'commit'
	       },
	       sub {
		 $h{param('topic')} = n(param('def'));
		 $h{"the::".param('topic')} = n(param('thesaurus'))||param('topic');
		 completa_parcial(param('topic'));
		 print tohtml(param("thesaurus")||param('topic'),
			      param("def"),
			      lista_anexos(param("topic"))); }
	      ],

    revert => [
	       { action => sub {print tohtml($h{"the::".param('topic')}||param('topic'),
					     $h{param("topic")},
					     lista_anexos(param("topic")))},
		 precond => sub{
		   if (isTheServer()) {""}
                   else{"Sorry you cant delete this topic...";}},
		 args =>['topic'],
		 next =>'REVERT confima?' },
	       sub{ delete($h{param('topic')});
		    print p(param("topic"). ": última alteração foi removida."); },
	      ],
    slides => [ {action => sub { my $p=param('topic');
                    print tohtml2({slides=>1},param('topic'));},
		 args =>['classe','topic'],
		 precond => sub{
                    if(classof(param('topic')) eq "slides"){""}
                    else{ "not a presentation";}},
                },
              ]
  );

sub classof{
 my $t=shift or return ("");
 if(! param("classe")){
   my $the1 = $h{"the::$t"} or return("") ;
   my $the = procthe($h{"the::$t"});
   param("classe",$the->{thesaurus}{fmt}[0] || "");
 }
 param("classe")
}

sub pod2html{my $doc = shift;
	my $podparser = Pod::Simple::HTML->new();
        my $str;
        $podparser->output_string(\$str);
        $podparser->parse_string_document($doc);
        $str =~ s!^.*?(<H1>.*)</BODY>.*!$1!si;
        $str =~ s!H2>!H4>!ig;
        $str =~ s!H1>!H3>!ig;
	$str;
    };

sub cat{my $file=shift;
  local $/;
  undef $/;
  open(CAT,"$file") or warn("can open $file\n");
  my $r=<CAT>;
  close CAT;
  $r
}

my %plugin =
  ( perl => sub{ my ($the,$prog) = @_; eval($prog).$@  },
    perlpath => sub{ my ($the,$file) = @_; chomp $file;
         eval(cat($file))},
    html => sub{ my ($the,$file) = @_; $file },
    htmlpath => sub{ my ($the,$file) = @_; chomp $file;
         cat($file)},
    url => sub{ my ($the,$file) = @_; $file=~s/\n.*//;return url2html($file) },
    verbatim => sub{ my ($the,$file) = @_; 
         "<pre>\n".txt2html($file)."\n</pre>\n" },
    verbatimpath => sub{ my ($the,$file) = @_; chomp $file;
         "<pre>\n".txt2html(cat($file))."\n</pre>\n" },
    slides => sub{ my ($the,$file) = @_;
         sp2html($file)},
    man => sub{ my ($the,$file) = @_;
	 my $name = $the->{thesaurus}{term};
	 $name = $1  if ($name =~ m/^man\s*(.*)/i);
         man2html($name); },
    pod  => sub{ my ($the,$file) = @_; pod2html($file) },
    podpath => sub{ my ($the,$file) = @_; chomp $file;
	 pod2html(cat($file)) },
    perldoc => sub{ my ($the,$file) = @_;
	 my $name = $the->{thesaurus}{term};
	 $name = $1  if ($name =~ m/^perldoc\s*(.*)/i);
	 "$name".pod2html(scalar `/usr/bin/perldoc -u $name`) },
  );

if   ($export){ print Dumper \%h; }
elsif($create){ my $b=shift; cmdcreate($b)}
elsif($tohtml){ cmdtohtml()}
elsif($import){ cmdimport()}
else {
  completa(\%a);
  my $todo = param("todo") || $a{-defaultaction};
  my $e = $a{$todo};
  my $err="";
  my %style= ($conf{cssfile})?(-src => $conf{cssfile}):( -code => $defaultcss );

  print header;
  print start_html(
		   -title  => "$conf{name}",
		   -style  => { %style },
                   -script => $fgo,
                   onClick => q{ go(); },
		   -author => $conf{author});

  if($e->{precond}){ $err = &{$e->{precond}};}
  if($e->{poscond}){ $err = &{$e->{poscond}};}
  print start_form();
  print(h1($err))                                  if $err;
  print(&{$a{-common}{inter}})                     if $a{-common}{inter};
  print(map {submit(-name=>'todo', -value=>$_) if(activeoption($a{$_}))}
	@{$a{-common}{next}})                      if $a{-common}{next};

  print hr,submit(-name=>'todo', -value=>$e->{next}),br if $e->{next} && !$err;

  &{$e->{action}}                                  if $e->{action} && !$err;
  &{$a{-common}{action}}                           if $a{-common}{action};
  print(map {hidden(-name=>$_)} @{$e->{args}})     if $e->{args};
  print(&{$e->{inter}})                            if $e->{inter};
  print end_form();

  ## print "Debug",remote_host(), server_name();
  print end_html, "\n";
}

undef $x;
untie %h;

sub cmdcreate{
  my $base = shift or die ("usage: breviario -create basename\n");
  $conf{base}=$base;
  $conf{cvsdir}=$cvsdir if $cvsdir;
  undef $x;
  untie %h;
  if($conf{mode} eq q{CVS}) {
    my $basedir= "$conf{cvsdir}$conf{base}";
    $x= tie %h, 'Tie::Cvs', $basedir or die("can't create $basedir:$!\n");
    system("chown -R apache.cvs $basedir $basedir.co");
    system("chmod -R 2775 $basedir $basedir.co");
    system("find $basedir -type f -exec chmod ug+rw {} \\;");
    system("find $basedir.co -type f -exec chmod ug+rw {} \\;");
  }
  elsif($conf{mode} eq q{DBFILE}) {
     $x= tie %h, 'DB_File', "$conf{dir}$base.db", O_RDWR|O_CREAT , 
         0666, $DB_BTREE or die("can't create $conf{dir}$base.db:$!\n");
     chmod(0666,"$conf{dir}$base.db");
  }
  unlink("$conf{cgidir}$base") if(-l "$conf{cgidir}$base");
  symlink("$conf{dir}/breviario","$conf{cgidir}$base") 
    or die ("cant create symbolic-link .($!,$@)..");
}

sub cmdtohtml{
  local $/;
  undef $/;
  mkdir("HTML");
  for((@ARGV)?(@ARGV):(keys %h)){ 
     print STDERR "Debug $conf{mode}:$conf{base} -- $_\n";
     next if(m/^the::/);
     next if(-d $_);
     my $na=term2filename($_);
     open(F,">HTML/$na") or die("cant create HTML/$na\n");
     my %style = ($conf{cssfile})
                 ?(-src => $conf{cssfile}):( -code => $defaultcss );
     print F  start_html(
                   -title  => "$conf{name}",
                   -style  => { %style },
         ($slides || $print
          ? ( -script => $fgo , onClick => q{ go(); }) 
          : ()),
                   -author => $conf{author}),
             tohtml2({slides=>$slides,print=>$print},$_),
             end_html, "\n";
     close F;
  }
}

sub cmdimport{
  local $/;
  undef $/;
  my $h1= <>;
  my $h2 = eval($h1); die("something wrong with input:$@") if $@;
  %h = %$h2;
    my $basedir= "$conf{cvsdir}$conf{base}";
    system("find $basedir.co -type f -exec chmod ug+rw {} \\;");
}

sub listartopics{  grep(!/the::/, (sort {lc($a) cmp lc($b)} keys %h)); }

sub tohtml {
   my %opt=();
   if(ref($_[0])){%opt = (%opt ,%{shift(@_)}) }
   my $the = procthe(shift);
   my $pag = shift;
   my $files = shift || "";
   my $p = $the->{thesaurus}{fmt}[0] ||$the->{thesaurus}{FMT}[0] || "sp";
   #  $opt{slides} = 1 if($p eq "slides");
   my $fin;
   if ($p ne "sp"){
      if (defined($plugin{$p})) { $fin = &{$plugin{$p}}($the,$pag); }
      else                      { $fin = pre(Dumper($the)).$pag} }
   else { $fin = sp2html(\%opt,$pag)}
   if($opt{slides}){
      br.h2(a({name =>'slide0', 
            href=>'javascript:void(0);', 
            onclick=>'i=0; go();'}, ucfirst($the->{thesaurus}{term})).
         a({href=>'#slide0'},"(*)")). html2slides($fin )
   }
   elsif($opt{'print'}){
      br.h2(a({name =>'slide0', 
            href=>'javascript:void(0);', 
            onclick=>'i=0; go();'}, ucfirst($the->{thesaurus}{term})).
         a({href=>'#slide0'},"(*)")). html2slides({'print'=>1},$fin )
   }
   elsif ($files) {
     htext(ph([ pv ([box(big(ucfirst($the->{thesaurus}{term})),[cel($fin)]),
		     box(big("Anexos"),[cel($files)])]),
		$the->{hlinks}]))
   } else {
     htext(ph([ box(big(ucfirst($the->{thesaurus}{term})),[cel($fin)]),
		$the->{hlinks}]))
   }
}

sub isExternal{ my %a=(date => 1, sn =>1); $a{$_[0]} }

sub procthe{
  my $the = shift || die("no thesaurus provided\n");
  if ($the =~ m/^(\S.*?)(\n.*|$)/s){
    my $h = n($1);
    my $t = $2;
    my %r=();
    my $th={term => $h};
    while($t =~ m/\n(\w+)\s+(.*)/g){
      my $k=$1;
      my $terms=$2;
      for(split(/\s*[,;]\s*/,$terms)){
	push(@{$th->{$k}}, n($_));
	push @{$r{$k}}, sp2url(n($_)) unless isExternal($k); ### BAD 
      }
    }
    +{thesaurus => $th,
      htopic => ftitle("",ucfirst($h),""), 
      hlinks => 
      box({class=>"tiny",width =>"15%"},"Ver também",
	  [join(br,map {div({style=>"margin-top: 5px;font-weight: bold; border-bottom: dotted 1px #000"},
			    lc($_)).join(br,sort @{$r{$_}})} keys %r)]),
     };
  }
  else{
    +{htopic=> ftitle("",ucfirst($the),""),hlinks=>cel(""),thesaurus => {}};
  }
}

sub math2html{
  my $f=shift;
  $f =~ s/\&/\&amp;/g;
  $f =~ s/-->/&rarr;/g;      #?????????
  $f =~ s/<--/&larr;/g;      #?????????
  $f =~ s!/\\!&and;!g;      #?????????
  $f =~ s!\\/!&or;!g;      #?????????
  $f =~ s/==>/&rArr;/g;      #?????????
  $f =~ s/<==/&rLrr;/g;      #?????????
  $f =~ s/</\&lt;/g;
  $f =~ s/>/\&gt;/g;
  $f;
}

sub txt2html{
  my $f=shift;
  $f =~ s/\n +<hr> *\n/\n---hr---\n/g;
  $f =~ s/\&/\&amp;/g;
  $f =~ s/</\&lt;/g;
  $f =~ s/>/\&gt;/g;
  $f =~ s/\n---hr---\n/\n<hr>/g;
  $f;
}

sub sp2html {
   my %opt=();
   if(ref($_[0])){%opt = (%opt ,%{shift(@_)}) }
   my $pagina = "\n" . (shift(@_) || "") ;
   my %verb=();
   my $n=0;

   if ($pagina) {
     for ($pagina) {
       s/\cM//g;
       s/[ \t]+\n/\n/g;

       # delete after __END__
       s/\n__END__.*/\n/s; 
       
       #Verbatim paragraphs
       s{\n\n([ \t]+\S.*?)(?=\s*\n\S|$)}{ 
          $verb{++$n}= "\n<pre class='boxed'>".txt2html($1)."</pre>\n";
          "\n\n\caMARCA\ca$n\n"}seg;

       # Hard rule
       s/(\n)---+[^\n+]*($|\n)/$1<hr\/>\n/g;

       # Titles wiki-like
       s/\n---+\+\+\+(.*)/<h3>$1<\/h3>/g;
       s/\n---+\+\+(.*)/<h2>$1<\/h2>/g;
       s/\n---+\+(.*)/<h1>$1<\/h1>/g;

       # Titles jj-like
       s/\n\d\.\d\.\d\.(.*)/<h3>$1<\/h3>/g;
       s/\n\d\.\d\.(.*)/<h2>$1<\/h2>/g;
       s/\n\d\.(.*)/<h1>$1<\/h1>/g;

       # bolds, italics, tts, wiki-like
       s!__([^_]+)__!<b><i>$1</i></b>!g;
       s!_\((.+?)\)_!"<i style='color:green'>".math2html($1)."</i>"!eg;
       s!_\[(.+?)\]_!"<div style='color:green;margin-left:4\%'>".math2html($1)."</div>"!eg;
       s!==(.+?)==!"<b><tt>".txt2html($1)."</tt></b>"!eg;
       s!\b_\B((?:[^_]|\B_\B)+)\B_\b!<i>$1</i>!g;
       s!=\b([^=\n]+)\b=!"<tt>".txt2html($1)."</tt>"!eg;
       s!\*(\[|\b)([^*]+)(\]|\b)\*!<b>$2</b>!g;

       # Links...
       s/\[!\[(.+?)\]\]/$verb{++$n}=sp2html(\%opt,$h{$1});
                        "\n\n\x01MARCA\x01$n\n"/ge;
       s/\[!man\[(.+?)\]\]/man2html($1)/ge;
       s/\[!url\[(.+?)\]\]/url2html($1)/ge;
       s#\[!img\[(.+?)\]\]#<img src="$1"/>#g;
       s#\[!wimg\[(.+?)\]\]#<img width="100%" src="$1"/>#g;
       s/\[!html\[(.+?)\]\]/cat($1)/ge;
       s/\[\[(.+?)\@(.+?)\]\]/sp2url({base=>$2},$1)/ge;
       s/\[(?:\[([^\]]+?)\])?\[(.+?)\]\]/sp2url($2,$1)/ge;
       s/\[(?:([^|\]]+)\|)?([^\]]+)\]/a({href=>$2,onclick=>'""'},$1 || $2)/ge;


       #New paragraph
       s/\n\s*\n/\n<p>\n/g;

       #Itemizes and Enumerates
       s/:\n(?=\s*\.\d)/\x03\n/gs;
       s/:\n(?=\s*\.)/\x02\n/gs;
#       while(s/\x03([^\x03\x02#]+?\n\s*)#/<ol>$1<\/ol>/g + 
#	     s/\x02([^\x03\x02#]+?\n\s*)#/<ul>$1<\/ul>/g ) {};
#       s/\n\s*\.\d?(.*)/<li>$1<\/li>/g;
       while(s/\x03([^\x03\x02#]+?\n\s*)#/ol(markLi($1))/ge + 
	     s/\x02([^\x03\x02#]+?\n\s*)#/ul(markLi($1))/ge ) {};

       s/[\x02\x03]/:/gs;
       s/\n\x01MARCA\x01(\d+)\n/$verb{$1}/g;
     }
     return $pagina;
   } else {
     return "";
   }
}

sub markLi{ my $a=shift;
  for($a){ s{\n\s*\.\d?(.*?)(?=(\n\s*\.|$))}{<li>$1</li>}gs; }
  $a
}

sub html2slides{
   my %opt=();
   if(ref($_[0])){%opt = (%opt ,%{shift(@_)}) }
 
 my $n=0;
 my $seg=0;
 my $page=shift;
 my $prev=0;
 my $cu=0;
 my $tit="";
 my $co="";
 my $toc="";
 my $vspace = " &nbsp;<br>" x 30;
 $vspace = hr if $opt{print};
 $page =~ s!(?:<h([123])>(.*?)</h[123]>)(.*?)(?=<h[123]|$)!
     ($cu,$tit,$co)=($1,$2,$3);
     $tit =~ s{</?a\b.*?>}{}gis;
     $n++;
     $toc.= "<ul>"  x ( $cu-$prev)  if($cu > $prev);
     $toc.= "</ul>" x ($prev-$cu)   if($cu < $prev);
     $toc.= li(a({href=>"#slide$n"},(($cu==1)?strong($tit):$tit)));
     $prev=$cu;
     $seg=$n+1;
     "<h$cu>".a({name =>"slide$n", 
                 href =>'javascript:void(0);', 
                 onclick => "i=". ( $n-1) ."; go();" },$tit)."</h$cu>$co$vspace"

     !gexsi;
 $page =~ s!#slide$seg!#slide0!;
 $toc.= ("</ul>" x $cu) if($cu);
 $toc .$vspace . $page;
}

sub term2filename{
  my $a = shift;
  $a =~ s/ (\w)/uc($1)/ge;
  $a =~ y/áéíóúçãõâêôû/aeioucaoaeou/;
  "$a.html"
}

sub sp2url {
  my $c={};
  $c=shift if (ref($_[0]) eq "HASH");
  my $u = shift;
  my $t = shift || "";
  $t = sprintf(' type="%s" ',$t) if $t;
  return a({onclick=>'""', href=>$u},$u) if $u =~ m!^\w+:/!;
  if($tohtml and not $c->{base}){ ##FIXME THIS
    my $na=term2filename($u);
    a({onclick => '""', href=>$na}, ucfirst($u));
  }
  else{
    my $url = url();
    my $todo= (param('todo') && param('todo') eq "slides")? "todo=slides":"";
    $url =~ s!(.*/)(.*)!$1$c->{base}! if $c->{base};
    my $ua = $u;
    $u .= "\@$c->{base}" if $c->{base};
    $ua =~ s/\s+/\%20/g;
    "<a type='$t' href='$url?$todo&topic=$ua'>".ucfirst($u)."</a>";
  }
}

sub n{                 # normaliza nomes
  my $a = shift;
  for ($a) { s/^\s+//g; s/\s+$//g; s/\cM//g; }
  $a
}

sub completa{
  my $a = shift;
  my @acts = (grep {/^[^-]/} (keys %$a));
  $a->{-common}{next} ||= [@acts];
  for (keys %$a){
    if( ref($a->{$_}) eq "ARRAY" ){
      my $k=$_;
      my @names=($k,(map {ref($_) eq "HASH" ? $_->{next}:"??"} @{$a->{$k}}));
      pop @names;
      for ( (1.. scalar(@{$a->{$k}})-1) , 0)
	{$a->{$names[$_]} = $a->{$k}[$_] };
    }
  }
  for (keys %$a){
    if( ref($a->{$_}) eq "CODE" ){ $a->{$_} = { action => $a->{$_} }; }
  }
}

sub termos_referidos{
  my $ t =shift;
  (map {($_ eq "date")
        ? () 
        : (ref($t->{$_}) ? (@{$t->{$_}}) : ($t->{$_}))} keys %$t) 
}

sub txt2the{
  my $te=shift;
  my $the = $h{"the::$te"} ;
  $the = "" unless defined $the;
  if ($the =~ m/^(\S.*?)(\n.*|$)/s){
     my $h = n($1);
     my $t = $2;
     my $th={term => $h};
     while($t =~ m/\n(\w+)\s+(.*)/g){
        my $k=$1;
        my $terms=$2;
        for(split(/\s*[,;]\s*/,$terms)){ push(@{$th->{$k}}, n($_)); }
     }
     $th }
  else {+{term=>$te}};
}

sub completa_parcial{
 my $te=shift;
 my @l=termos_referidos(txt2the($te));
 my $a = thesaurusNew();
 $a->addInverse("iof","inst");
 $a->addInverse("has","pof");
 $a->addInverse("fmt","ex");
 $a->addInverse("sec","in");
 $a->addInverse("needs","usedin");
 $a->_setExternal("date");
 for (@l){
    my $t = txt2the($_);
    if($_ eq $te){ 
       my $text=$h{$_};
       while($text =~ /\[\[([^\]]*?)\]\[([^\]]*?)\]\]/g){
          my ($rel,$t1)=($1,$2);
          push(@{$t->{$rel}},$t1) unless $t1 =~ m/(^(man|http|ftp):)/ ;}}
    $a->addTerm($t->{term});
    for (keys %$t){
       next if /^term$/;
       $a->addRelation($t->{term},$_,@{$t->{$_}});
    }
 }
 $a->complete();
 $a->downtr({ -default => sub{lc($rel)." ".join(", ",@terms)."\n"},
              -eachTerm => sub{$h{"the::$term"}="$term\n$_" },
              -order => ["bt","isa","iof","has","rt","nt","inst"] },@l);
}

sub tohtml2{
  my %opt=();
  if(ref($_[0])){%opt = (%opt ,%{shift(@_)}) }
  my $t=shift;
  tohtml(\%opt,$h{"the::$t"}||$t, $h{$t})
}

sub getDate {
  my $the = shift;
  return $1 if ($the =~ m!\ndate\s+(.*)\n!);
  return "";
}

sub isTheServer{remote_host() eq server_name() or 
                remote_host() eq "localhost.localdomain" or
                remote_host() eq "127.0.0.1"}
sub valid {
  my $h=shift;
  my $ha=shift;
  return 1 unless (ref($ha) eq "HASH");
  exists $ha->{$h};
}

sub url2html {
  return get(shift);
}

sub man2html{
  my $name=shift;
  my $t = `/usr/bin/man -w $name`;
  chomp $t;
  if($t =~ /\.gz$/){ $t = `/bin/zcat $t | /usr/bin/man2html`;}
  else             { $t = `/usr/bin/man2html $t`;            }
  ## return "Erro $!-$@\n" if $! || $@;
  $t =~ s!^.*?(<H2>NAME</H2>.*)<H2>Index</H2>.*!$1!si;
  $t =~ s!H3>!H4>!ig;
  $t =~ s!H2>!H3>!ig;
  $t =~ s!\s*</pre>\s*<p>\s*<pre>(\s*(?=\n))?!\n!ig;
  $t =~ s!\s*</pre>\s*<p>\s*!</pre>\n!ig;
  $t =~ s!\s*<p>\s*<pre>(\s*(?=\n))?!\n<pre>!ig;
  $t =~ s!\s*</pre>\s*!\n</pre>\n!ig;
  $t =~ s!\s*<pre>\s*\n!\n<pre>\n!ig;
  $t}

sub lista_anexos {
  my $topic = shift;
  my $dir = "$conf{datadir}/$topic";
  my $str = "";
  if (-d $dir) {
    my @files = <$dir/*>;
    return "" unless @files;
    my $i = 0;
    $str .= "<table width=\"100%\" class=\"box\" cellspacing=\"0\" cellpadding=\"0\">";
    $str .= "<tr><th class=\"boxtitle\" width=\"80%\">Nome</th>\n";
    $str .= "<th class=\"boxtitle\" width=\"20%\">Tamanho</th></tr>\n";
    for (@files) {
      my $size = format_size(-s);
      s/$dir\///;
      my $class=($i++%2)?" class=\"even\"":" class=\"odd\"";
      $str .= "<tr><td$class>$_</td><td$class align=\"right\">$size bytes</td></tr>\n";
    }
    $str .= "</table></p>\n";
  }
  $str
}

sub format_size {
  my $x = shift;
  while($x =~ s/(\d)(\d\d\d)(\.|$)/$1.$2/g) {}
  $x
}

sub activeoption{ my $a=shift;
  if(defined $a->{precond}){ not &{$a->{precond}};} 
  else {1}
}

__END__

=head1 NAME

breviario - a wiki system with ontology

=head1 SYNOPSIS

 breviario -tohtml [-slides]        -> builds a HTML dir with all the topics
 breviario -tohtml [-slides] topic* -> builds a HTML dir with these topics
 breviario -slides topic*           -> builds a HTML dir with these topics 
 breviario -tohtml [-print] topic* -> builds a HTML dir with these topics
 breviario -create basename         -> creates a new CGI and base
 breviario -import < filename       -> import a textual version
 breviario -export > filename       -> export textual

=head1 DESCRIPTION

Breviario is based on Tie::Cvs -- the topics are stored in CVS

Breviario uses Biblio::Thesuarus to 

=head2 Instalation

In order to use breviario, you need to install the following modules:

 Tie::Cvs
 Biblio::Thesaurus;
 CGI (":all",":nodebug");
 Data::Dumper ;
 boxml;
 Pod::Simple::HTML;    (for html plugin)
 LWP::Simple qw/get/;  (for 

=head1 AUTHOR

J.Joao Almeida, jj@di.uminho.pt

Alberto Simões, albie@alfarrabio.di.uminho.pt

=head1 SEE ALSO

perl(1).

=head1 TODO

-import is not working!

Transformar metade deste ficheiro num módulo;