%{
# vim:syntax=perl:
use locale;
use lib qw(../lib);
use Chronology::Event;
%}

%token NAME ID DATE URL IDREF DESC

%%
main: main chrono 
    |
    ;

chrono: '>>' NAME ido metadata eventa
;

eventa: eventa DATE DATEo NAMEo ido metadata DESC
{ parse_desc($_[7]); }
      |
      ;

DATEo : DATE
      | 
      ;

NAMEo : NAME
      |
      ;

namel : namel list_sep NAME
      |
      ;

list_sep : ',' | ';' ;

ido : ID
    |
    ; 

metadata: metadata '!!' metainfo  
        |
        ;

metainfo: 'keyword' ':' NAME namel
        | 'author' ':' NAME namel
        | 'lang' ':' NAME
        | 'local' ':' NAME
        | 'ref' ':' ref refl
        | 'isa' ':' class classl
        ;

class: '[' NAME '|' NAME ']'
     ;

classl : classl list_sep class
       |
       ; 

refl : refl list_sep ref
     |
     ; 

ref: '[' NAME '|' ref2 ']'
   ;

ref2: URL
    | IDREF
    | ID
    ;

%%

sub parse_desc {
   my $s = shift();
   my @res;
   my $temp = '';
   my $name = '[\t ]*(\w[^\n\|\[\]]*?)[ \t]*';
   my $lurl = '(img|file)://([\w~\.\/=\-&]+)';
   my $rurl = '(http|ftp)://([\w~\.\/=\-&]+)';

   $s =~ s/^\s+//;
   $s =~ s/\s+$//;
   $s =~ s/\n(?![ \t]*\n)/ /g;
   $s =~ s/\n\s+/\n/g;

   while($s) {
      if($s =~ s/^\[$name\|[ \t]*\{(\w+(?:\:\w+)?)\}[ \t]*\]//) {
         push(@res, ['ref', Chronology::Event->make_ref('chrono',
                            $2, $1)]);
      } elsif($s =~ s!^\[$name\|[ \t]*$lurl[ \t]*\]!!) {
         push(@res, ['ref', Chronology::Event->make_ref($2, $3,
                                                       $1)]);
      } elsif($s =~ s!^\[$name\|[ \t]*$rurl[ \t]*\]!!) {
         push(@res, ['ref', Chronology::Event->make_ref($2,
                                           "$2://$3", $1)]);
      } elsif($s =~ s/^\[$name\|$name\]//) {
         push(@res, ['isa', Chronology::Event->make_isa($1, $2)]);
      } elsif($s =~ s/^\n//) {
         push(@res, Chronology::Event->make_newline());
      } elsif($s =~ s/^\*\*(.+?)\*\*//) {
         push(@res, Chronology::Event->make_strong_text($1));
      } elsif($s =~ s/^\*((?:\\\*|[^\n*])+?)\*//) {
         push(@res, Chronology::Event->make_emph_text($1));
      } elsif($s =~ s/^((?:\\\[|\\\*|[^\n\[\*])+?)(?=[*\[\n])//) {
         push(@res, Chronology::Event->make_plain_text($1));
      } elsif($s =~ s/^((?:\\\[|\\\*|[^\n\[\*])+?)$//) {
         push(@res, Chronology::Event->make_plain_text($1));
      } else {
         push(@res, Chronology::Event->make_plain_text($s));
         $s = '';
      }
   }
   return(\@res);
}

sub lex {
   my $s = shift();
   my $file = $s->YYData->{INPUT};

   for($$file) {
      s!^[\t ]+!!;
      s!^\n\n+!\n!;

      if($_ eq "")               { return("","") }

      s/^\n(>>|!!)//            and return($1, $1);

      s!^\{(\w+\:\w+)\}!!     and return("IDREF", $1);

      s!^\{(\w+)\}!!            and return("ID", $1);

      s{^\n?
         \[(\s*~?
               \s*(?:bc)?
               \s*(?:\d{1,4})
               (?:[/:-]\d{1,2}
                (?:[/:-]\d{1,2}
                 (?:\s*[T ]\s*\d{1,2}:\d{1,2})?
                )?
               )?
           )
            \]}{}xi                 and return("DATE",$1);

      s!^(keyword|author|lang|local|ref|isa)\b!! and return($1,$1);
      
      s!^(img|file)://([\w~\.\/=\-&]+)!!    
             and return("URL", [$1, $2]);
      s!^(http|ftp)://([\w~\.\/=\-&]+)!!
             and return("URL", [$1, "$1://$2"]);

      s!^(\w.*?)[ \t]*(?=[\n\|\{;,\[\]\}])!!  and return("NAME", $1);

      s{^(\n[^>!\[].*
            (?:\n(?:[^>!\[\n].*)?)*
         )}{}x                  and return("DESC", parse_desc($1));
      s!^([\{\}\[\];,:|])!!     and return($1,$1);
      s!^\n!!                   and return('NL', '\n');

      printf STDERR "Simbolos desconhecidos '%s'\n", $$file;
   }
}

sub init_lex {
   my $self = shift();
   my $file = shift();
   my $text = "";
   
   open(FILE, "<$file") or die "Error opening file:$!\n";
   while(my $line = <FILE>) {
      $text .= $line unless($line =~ /^\s*\#/);
   }
   close(FILE);

   $text = "\n$text";
   $text =~ s/\n\s+\n/\n\n/g;
   $self->YYData->{INPUT} = \$text;
}

sub yyerror {
   if ($_[0]->YYCurtok) {
      printf STDERR "Error: a \"%s\" (%s) was found where %s (%s) was expected.\n",
                     $_[0]->YYCurtok, $_[0]->YYCurval, $_[0]->YYExpect, $_[0]->YYLexer;
   } else { print  STDERR "Expecting one of ",join(", ",$_[0]->YYExpect),"\n";
   }
}

sub parseFile($$) {
   my $self = shift();
   my $file = shift();
   $self->init_lex($file);
   $self->YYParse(
      yylex   => \&lex,
      yyerror => \&yyerror,
      #yydebug   => 0x1F,
   );
}