/[Frey]/trunk/lib/Frey/Server.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Server.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 639 by dpavlin, Sun Nov 30 15:04:07 2008 UTC revision 1133 by dpavlin, Tue Jun 30 15:10:55 2009 UTC
# Line 6  with 'Frey::Config'; Line 6  with 'Frey::Config';
6    
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8    
9    #use Carp::REPL; # 'nodie';
10    
11    use lib 'lib';
12  use Frey::Run;  use Frey::Run;
13    
14  has 'port' => (  has 'port' => (
# Line 32  has 'editor' => ( Line 35  has 'editor' => (
35  This is simple dispatcher for our server. Currently it's in flux and  This is simple dispatcher for our server. Currently it's in flux and
36  documented only in source code.  documented only in source code.
37    
38      my $content_type = $self->request( $url, $params );
39    
40  =cut  =cut
41    
42  sub print {  sub print {
# Line 51  sub request { Line 56  sub request {
56    
57          my $path = $url->path;          my $path = $url->path;
58    
59  #       eval {          if ( $path =~ m{^/(favicon.ico|__history__.html)$} ) {
60          {                  warn "INFO: $path ignored";
61                    return { code => 404, content_type => 'text/plain' };
62            }
63    
64            my $request = {
65                    content_type => 'text/html',
66                    code => 200,
67            };
68    
69            eval {
70    
71                  if ( $path =~ m{/reload(.*)} ) {                  if ( $path =~ m{/reload(.*)} ) {
72    
# Line 108  sub request { Line 122  sub request {
122                          $self->print( $self->editor->command( $path ) );                          $self->print( $self->editor->command( $path ) );
123                          return;                          return;
124                  } elsif (                  } elsif (
125                          $path =~ m{/([^/]+)/(\w*as_\w+)/?([^/]+)?}                          $path =~ m{/([^/]+)/(\w+)/?([^/]+)?}
126                  ) {                  ) {
127                          my $class = rest2class $1;                          my $class = rest2class $1;
128                          warn "# run $path -> $class $2";                          warn "# run $path -> $class $2";
129                          $run->{format} = $3 if $3;                          $run->{format} = $3 if $3;
130                          $params->{request_url} = $url,                          foreach my $p ( keys %$params ) {
131                          $run->{$_} = $params->{$_} foreach keys %$params;                                  $run->{$p} = $params->{$p} if defined $params->{$p} && $params->{$p} ne '';
132                          $f = Frey::Run->new( class => $class, params => $run, run => $2, request_url => $url );                          }
133                            $f = Frey::Run->new( class => $class, params => $run, run => $2 );
134                  } elsif (                  } elsif (
135                          $path =~ m{/([^/]+)/?$}                          $path =~ m{/([^/]+)/?$}
136                  ) {                  ) {
137                          my $class = rest2class $1;                          my $class = rest2class $1;
138                          warn "# introspect $class";                          warn "# introspect $class";
139                          $run->{class} ||= $class;                          $run->{class} ||= $class;
140                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );
141                  } else {                  } else {
142                          $f = Frey::Run->new( class => 'Frey::ClassBrowser', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Class::Browser', params => $run );
143                  }                  }
144    
145                  if ( $f ) {                  if ( $f ) {
# Line 141  sub request { Line 156  sub request {
156                          confess "# can't call request on nothing!";                          confess "# can't call request on nothing!";
157                  }                  }
158    
159                    $request->{content_type} = $f->content_type;
160          };          };
161    
162          if ( $@ ) {          if ( $@ ) {
163                  warn "SERVER ERROR: $@";                  warn "SERVER ERROR: $@";
164  #               $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it                  $self->print( qq|<pre class="frey-error">$@<pre>| );
                 $self->print( qq{<pre class="frey-error">$@<pre>\r\n\r\n} );  
165  #               Carp::REPL::repl;  #               Carp::REPL::repl;
166                    return {
167                            content_type => 'text/html',
168                            code => 404,
169                    }
170          }          }
171    
172            return $request;
173  }  }
174    
175  sub refresh {  sub refresh {
176          my ( $url, $time ) = @_;          my ( $url, $time ) = @_;
177          $url  ||= '/';          $url  ||= '/';
178          $time ||= 1;          $time ||= 0;
179          warn "# refresh $url";          warn "# refresh $url";
180          qq|          qq|
181                  <html>                  <html>
# Line 170  sub refresh { Line 190  sub refresh {
190          |; # XXX newlines at end are important to flush content to browser          |; # XXX newlines at end are important to flush content to browser
191  }  }
192    
193    __PACKAGE__->meta->make_immutable;
194    no Moose;
195    
196    my $timestamp_interval = 3;
197    my $output_tell = 0;
198    
199    $SIG{ALRM} = sub {
200            if ( tell(STDERR) != $output_tell ) {
201                    warn "\nTIMESTAMP: " . localtime() . "\n\n";
202                    $output_tell = tell(STDERR);
203            }
204            alarm $timestamp_interval;
205    };
206    alarm $timestamp_interval;
207    
208  1;  1;
Legend:
Removed from v.639  
changed lines
  Added in v.1133
  ViewVC Help
Powered by ViewVC 1.1.26