App-Navegante

 view release on metacpan or  search on metacpan

lib/App/Navegante/CGI.pm  view on Meta::CPAN

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/&/&amp;/g; $c =~ s/</&lt;/g ; $c =~ s/>/&gt;/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';



( run in 2.742 seconds using v1.01-cache-2.11-cpan-99c4e6809bf )