POE-XUL
1 match

 view release on metacpan or  search on metacpan

lib/POE/Component/XUL.pm  view on Meta::CPAN 

# Recursively create the file in $cfile from $bfile
sub create_cache_file
{
    my( $self, $cfile, $bfile ) = @_;
    my $out = $cfile;
    $out = IO::File->new( "> $cfile" ) unless ref $cfile;

    my $dir = dirname $bfile;

    if( $self->{loop_check}{ $bfile } ) {
        die "Recursion detected: $bfile included more then once";
    }
    local $self->{loop_check}{ $bfile } = 1;

    my $in = IO::File->new( $bfile ) or die "Unable to read $bfile: $!\n";
    while( my $line = <$in> ) {
        if( $line =~ /^\s*\@include "(.+)"\s*$/) {
            my $file = File::Spec->rel2abs( $1, $dir );
            $self->create_cache_file( $out, $file );
        }
        else {
            $out->print( $line );
        }
    }
}

############################################################
sub guess_ct
{
    my($self, $file)=@_;
    $file =~ s/\.cache$//;
    my $ct = $self->{mimetypes}->mimeTypeOf( $file );
    $ct ||=  'application/octet-stream';
    $ct .= '; charset=iso-8859-1'  if $ct eq 'text/html';

    return $ct;
}

############################################################
# URI that would restart an application
sub uri_restart
{
    my( $self ) = @_;
    my $req = $self->{request};
    my $uri = $req->uri;

    # We need to know what the browser thinks we are called
    my $host = $req->header( 'X-Forwarded-Host' );
    if( $host ) {
        xwarn "Restart on $host";
        $host =~ s/,.+$//;
        $uri->host( $host );
        $uri->port( undef ) if defined $uri->port and 0==$uri->port;
    }
    my $referer = $req->header( 'Referer' );
    if( $referer and $referer =~ /https/ ) {
        $uri->scheme( 'https' );
    }
    $uri->path( '/start.xul' );
    my $app = $req->param( 'app' );
    $uri->query_keywords( $app );
    return $uri;
}

############################################################################
# Error handling

############################################################
sub error
{
    my($self, $code, $text, $ct)=@_;

    $ct ||= 'text/plain';

    # This could get annoying fast.  It also shows 404s
    warn "$code $text\n"unless $ENV{AUTOMATED_TESTING};
    xlog "$code $text\n"
                if $ct eq 'text/plain' and (DEBUG or $code != RC_NOT_FOUND);

    if( $self->{response} ) {
        $self->{response}->code( $code );
        $self->{response}->content_type( $ct );
        if( $ct eq 'text/html' ) {
            $text = encode_entities_numeric( $text, "\x80-\xff" );
        }

        $self->{response}->content( $text );
        $self->{response}->content_length( length $text );
    }
    else {
        xcarp "Response was already sent!";
    }
    return $code;
}

############################################################
sub error_standard
{
    my( $self, $code, $when, $what ) = @_;

    # Thank you HTTP::Status
    my $message = status_message( $code );
    $message ||= 'unknown';

    $what ||= '';

    return $self->error( $code, "Error while $when: $message ($code)\n$what" );
}

############################################################
sub error_not_found
{
    my( $self, $file ) = @_;
    my $msg = "Unknown file '$file'";
    xwarn "$msg\n";

    return $self->error( RC_NOT_FOUND, <<"    HTML", 'text/html');
<html>
    <head><title>404 N'existe pas</title></head>
    <body>
    <h1>Le fichier que vous cherchez ne semble pas exister.</h1>



( run in 0.532 second using v1.01-cache-2.11-cpan-98e64b0badf )