/[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 653 by dpavlin, Sun Nov 30 23:49:32 2008 UTC revision 1107 by dpavlin, Mon Jun 29 15:05:25 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            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 {          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                          $run->{$_} = $params->{$_} foreach keys %$params;                          foreach my $p ( keys %$params ) {
131                                    $run->{$p} = $params->{$p} if defined $params->{$p} && $params->{$p} ne '';
132                            }
133                          $f = Frey::Run->new( class => $class, params => $run, run => $2 );                          $f = Frey::Run->new( class => $class, params => $run, run => $2 );
134                  } elsif (                  } elsif (
135                          $path =~ m{/([^/]+)/?$}                          $path =~ m{/([^/]+)/?$}
# Line 123  sub request { Line 139  sub request {
139                          $run->{class} ||= $class;                          $run->{class} ||= $class;
140                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );
141                  } else {                  } else {
142                          $f = Frey::Run->new( class => 'Frey::ClassBrowser', params => $run );                          $f = Frey::Run->new( class => 'Frey::Class::Browser', params => $run );
143                  }                  }
144    
145                  if ( $f ) {                  if ( $f ) {
# Line 140  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 {
# Line 169  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    my $timestamp_interval = 3;
194    my $output_tell = 0;
195    
196    $SIG{ALRM} = sub {
197            if ( tell(STDERR) != $output_tell ) {
198                    warn "\nTIMESTAMP: " . localtime() . "\n\n";
199                    $output_tell = tell(STDERR);
200            }
201            alarm $timestamp_interval;
202    };
203    alarm $timestamp_interval;
204    
205  1;  1;
Legend:
Removed from v.653  
changed lines
  Added in v.1107
  ViewVC Help
Powered by ViewVC 1.1.26