view release on metacpan or  search on metacpan

bin/navegante  view on Meta::CPAN

sub
#line 18 "lib/App/Navegante.yp"
{+{ %{$_[1]}, formtitle => $_[3]}}
	],
	[#Rule 17
		 'actions', 3,
sub
#line 19 "lib/App/Navegante.yp"
{+{ %{$_[1]}, filename => $_[3]}}
	],
	[#Rule 18
		 'actions', 3,
sub
#line 20 "lib/App/Navegante.yp"
{+{ %{$_[1]}, protect => $_[3]}}
	],
	[#Rule 19
		 'actions', 0,
sub
#line 21 "lib/App/Navegante.yp"
{+{}}
	],
	[#Rule 20
		 'actarg', 1,
sub
#line 24 "lib/App/Navegante.yp"
{ +{arg=>$_[1]}}
	],
	[#Rule 21
		 'actarg', 3,
sub
#line 25 "lib/App/Navegante.yp"
{ +{arg=>$_[1], feedback => $_[3] }}
	]
],
                                  @_);
    bless($self,$class);
}

#line 28 "lib/App/Navegante.yp"


package App::Navegante;
use lib './lib/';
use CGI qw( :all :nodebug);
use Data::Dumper;
use App::Navegante::CGI;

my $File;
my $t = parseFile();

preparafiles($t->{action}) if $t->{action};
geraCgi($t);

sub preparafiles{
  my $a= shift;
  if($a->{save} && !-e $a->{save}{arg}){
      open(F,">$a->{save}{arg}") or die ("cant create $a->{save}{arg}\n");
      print F "##Created by FormLang\n";
      close F;
      chmod (0666,$a->{save}{arg})
  }
}

sub geraCgi{
    my %args = (%{$_[0]{action}}, PERL=>$_[0]{perl});
    my $t = App::Navegante::CGI->new(%args);

    if( defined $_[0]{action}{filename}) {
        open(F,">$_[0]{action}{filename}") or die ("cant create $_[0]{action}{filename}");
        print F $t->createCGI();
        close(F);
        chmod(0755,$_[0]{action}{filename});
    }
    else {
        print $t->createCGI();
    }
}

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

sub parseFile {
  my $p = new Navegante();
  init_lex();
  $p->YYParse(
      yylex   => \&lex,
      yyerror => \&yyerror
  );
}

sub init_lex{
 local $/;
 undef $/;
 $File = <>
}


sub lex{
 for($File){
   s!^\s+!!;
   if($_ eq "")             {    return ("","") }
   s!^\(([^)]+)\)!!          and return("STRING",$1);
   s!^([\{\}\[\];+*/,:])!!   and return($1,$1);
   s!^\((.*?)\)!!            and return("ARG",$1);
   s!^##(.*)$!!s             and return("FIM",$1);
   s!^(init|desc|formtitle|save|mail|filename|feedback|proc|proctags|livefeedback|annotate|iform|iframe|quit|protect)\b!!
                             and return($1,$1);
   s!^(\w+)!!                and return("ID",$1);

   print STDERR "Simbolos desconhecidos '$File'\n" ;
 }
}

1;