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

use strict;
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

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

our %conf;

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;}];


my $x;

my ($mday,$mon,$year) = (localtime(time()))[3,4,5];

my $fulldate = sprintf('%4d/%.2d/%.2d',$year+1900,$mon+1,$mday);

for(@ARGV){
  print tohtml("sp",$_);
}

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;
	 $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;
	 $name = $1  if ($name =~ m/^perldoc\s*(.*)/i);
	 "$name".pod2html(scalar `/usr/bin/perldoc -u $name`) },
  );

  my %style= ($conf{cssfile})?(-src => $conf{cssfile}):( -code => $defaultcss );

sub tohtml {
   my %opt=();
   if(ref($_[0])){%opt = (%opt ,%{shift(@_)}) }
   my $fmt = shift;
   my $name = shift;
   my $pag = cat($name);
   $name =~ s!.*[\\/]!!;
   my $the = {thesaurus => {term => $name}};
   my $files = shift || "";
   my $p = $fmt || "sp";
   my $fin;
   if ($p ne "sp"){
      if (defined($plugin{$p})) { $fin = &{$plugin{$p}}($name,$pag); }
      else                      { $fin = pre($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(box(big(ucfirst($the->{thesaurus}{term})),[cel($fin)]))
   } else {
     htext(box(big(ucfirst($the->{thesaurus}{term})),[cel($fin)]))
   }
}

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

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 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 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 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}

__END__

=head1 NAME

breviario2html - 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;