App-Navegante
view release on metacpan or search on metacpan
lib/App/Navegante/CGI.pm view on Meta::CPAN
Build CGI applications in Navegante framework...
use App::Navegante::CGI;
my $app = App::Navegante::CGI->new(%args);
...
my $app = $foo->createCGI();
where %args is an hash containig the result of parsing the DSL section
of the program.
=cut
my $nav = {};
=head1 FUNCTIONS
=head2 skeleton
TODO
=cut
sub skeleton {
my $skeleton=<<'END_SKEL';
#!/usr/bin/perl
use LWP::UserAgent qw(!head);
require HTTP::Request;
use URI::URL qw(!url);
use CGI qw/:standard/;
use XML::DT 0.51;
my %estado = cookie('navcookie');
my $U;
####PERL####
my $Navegante={};
navegante_m(\&####init####,\&####proc####,\&####feedback####,\&####desc####,\&####livefeedback####);
my $ENCOD = "ISO-8859-1";
my ($pag,$URL,$MES,$CON);
if( param() ){
if( param('action') eq 'quit' ) {
# TODO
print "Content-type: text/html\n\n";
print ####quit####();
}
elsif( param('action') eq 'iframe' ) {
$U=_fixurl(param('x'));
my $iform = ####IFORM####;
if (param('user_data')) {
####annotate####();
$iform = "<body onload=\"alert('[$U] successfully annotated!');\">$iform</body>";
}
print header(cook(),-charset => 'UTF-8'), $iform;
}
elsif( $Navegante->{monadic} && param(action) eq "monadicend"){
$Navegante->{end}()
}
else {
$U=_fixurl(param('x'));
my $ua = LWP::UserAgent->new();
my $request = HTTP::Request->new(GET => _fixurl(param('x')));
my $resp = $ua->request($request);
$URL = "". $resp->base(); ## the real URL extracted
$MES = $resp->message(); ## OK if no error
$CON = $resp->content; ## the page content
$cty = $resp->content_type; ## the content type
$cen = $resp->content_encoding; ## the content encoding
$Navegante->{init}();
if($MES eq "OK"){
$pag=dtstring($CON,
-html => 1,
-pcdata => sub{ $c =~ s/&/&/g; $c =~ s/</</g ; $c =~ s/>/>/g ;
wrapper_proc($c) },
img => sub{ $v{src} = _abs($v{src}); toxml},
($Navegante->{monadic}
? (body => sub{ $c = ####TOOLBAR#### . $c; toxml } )
: ()),
link => sub{ $v{href} = _abs($v{href}); toxml},
# form => sub{ $v{action} = compoe($v{action}) if $v{action}; toxml},
a => sub{ $v{href} = compoe($v{href}) if $v{href}; toxml},
frame => sub{ $v{src} = compoe($v{src}); toxml},
iframe => sub{ $v{src} = compoe($v{src}); toxml},
meta => sub{
if($v{content} =~ /utf[_-]?8/i) {$ENCOD='UTF-8'}
elsif($v{content} =~ /iso[_-]?8859[_-]?1/i){$ENCOD='ISO-8859-1'}
toxml()},
);
print header(cook(), -charset => param('e') || $ENCOD ),$pag; }
else { errorpage($MES) }
}
}
else {
%estado =();
print header(cook(),-charset => 'UTF-8'),
start_html( -title =>'####formtitle####',
-encoding => 'UTF-8',
-author =>'jj@di.uminho.pt',
-meta =>{'keywords' =>'jspell,linguateca,spell',
'charset' =>'UTF-8'},),
div( {style=>"background-image: url(http://nrc.homelinux.org/navegante/imagens/nav_bg.gif); background-repeat: repeat-x; height: 65px; "},
"<table border='0' width='100%' cellpadding='0' cellspacing='0'><tr>",
"<td width='140'>",
img({src=>'http://nrc.homelinux.org/navegante/imagens/nav_logo.gif',border=>'0'}),
"</td>",
"<td>",a({href=>'http://natura.di.umino.pt/navegante/'}, img({src=>'http://nrc.homelinux.org/navegante/imagens/nav_title.gif',border=>'0'})),"</td>",
"</td></tr></table>",
div( {style=>"background-image: url(http://nrc.homelinux.org/navegante/imagens/nav_line.gif); background-repeat: repeat-x; width: 100%; height: 2px;"})
),
h1('####formtitle####'),
start_form, "Url ", textfield(-name =>'x',-size=>50),
popup_menu(-name=>'e', -values=>['','UTF-8','ISO-8859-1']),
submit, end_form,
$Navegante->{desc}(),
end_html;
}
sub m_error{ span({-style=>'color: red'},$_[0])}
sub m_eng { span({-style=>'color: green'},$_[0])}
sub wrapper_proc {
my $c = shift;
my $tag = ctxt(1);
my @l = (####protect####);
END_SKEL
if ($nav->{'proctags'}) {
$skeleton .= " my %proctags = (####proctags####);\n";
}
$skeleton.=<<'END_SKEL';
if (grep {$tag eq $_} @l) {
return $c;
}
else {
END_SKEL
if ($nav->{'proctags'}) {
$skeleton .= " \$proctags{\$tag} and return \$proctags{\$tag}->(\$c);\n";
}
$skeleton.=<<'END_SKEL';
return $Navegante->{f}($c);
}
}
sub compoe{
my $x= _abs($_[0]);
return $x if($x =~ /^javascript/i);
my $y = URI->new(CGI::url());
$y->query_form(e => param('e'),x => $x );
"$y";
}
sub _monadicend{
my $y = URI->new(CGI::url());
$y->query_form(action => "monadicend");
"$y";
}
sub _abs{
my $u=shift;
return $u if ( $u =~ /^javascript/i);
"". URI->new_abs($u,$URL);
}
sub _fixurl{
my $u=shift;
# $u = "file://localhost/$u" if ( $u =~ m!^/! );
$u = "http://$u" unless ( $u =~ m!:/! );
$u;
}
sub errorpage{ print header,
start_html,
h1("Error: $_[0]"),
a({href=>_fixurl(param('x'))},_fixurl(param('x'))),
" not found...",
u("Broken link?")
}
sub _exp1{
%keep = (br => 1, hr => 1, img => 1);
my $x = shift;
$x =~ s!(<(\w+)[^/>]*)/>!if($keep{$2}){"$1/>"}else{"$1></$2>"}!eg;
$x;
}
sub navegante{
$Navegante->{init} = shift or die;
$Navegante->{f} = shift or die;
$Navegante->{desc} = shift || sub{};
$Navegante->{end} = shift || sub{};
$Navegante->{monadic} = undef;
}
sub cook {
if($Navegante->{monadic}){
return (-cookie => cookie(-name => "navcookie",
-value => \%estado,
-expires => '+1h')); }
else {return ()}
}
sub navegante_m{
my ($f1,$f2,$f3,$f4,$f5) = @_;
die unless $f3;
$Navegante->{monadic} = 1;
$Navegante->{init} = $f1;
$Navegante->{f} = $f2;
$Navegante->{end} =
sub{ print header(-charset => 'UTF-8'), start_html, $f3->(), end_html; };
$Navegante->{desc} = $f4 || sub{};
$Navegante->{g} = $f5;
}
END_SKEL
return $skeleton;
}
=head2 new
This is the constructor, we use this function to create new objects for
deploying applications. This function receives an hash as an argument
which holds the information gathered by the parser after parsing the
program file. Internal state of the object is set according to this
hash.
=cut
sub new {
my($class, %args) = @_;
my $self = bless({}, $class);
foreach (keys %args) {
$nav->{$_} = $args{$_};
}
# translate proctag definition to perl code
if (defined($args{'proctags'})) {
$args{'proctags'} =~ s/=\>(\w+)/=\>\'$1\'/g;
$nav->{'proctags'} = $args{'proctags'};
}
# decide how to build the iframe if needed
if (defined($args{'iframe'})) {
$nav->{'IFORM'} = $args{'iframe'} . "()";
}
elsif (defined($args{'iform'})) {
$nav->{'IFORM'} = "\"" . createIframe($nav->{'iform'}) . "\"";
}
$nav->{'TOOLBAR'} = createToolbar();
return $self;
}
=head2 createCGI
This function creates a file that is basically a CGI. This function
returns the complete file, so you can do simething like this:
open(FH,">filename.cgi");
print FH $t->createCGI();
In order to create the CGI file, this function starts with the skeleton
definition (defined in this module) and substitutes the skeleton's
keywords with the correspond keyword extracted from DSL's section of
the program. Some sanity checks are made, and defaults set.
TODO:
* set defaults for everything
( run in 0.518 second using v1.01-cache-2.11-cpan-ad19def0cd9 )