/[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 627 by dpavlin, Sat Nov 29 22:02:08 2008 UTC revision 954 by dpavlin, Wed Jan 7 00:04:06 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 {
43          my $self = shift;          my $self = shift;
44          warn "# print ",dump( @_ );          warn "# print ", join(' ', map { length $_ } @_ );
45          $self->{print}->( @_ );          $self->{_print}->( @_ );
46  }  }
47    
48  sub request {  sub request {
# Line 45  sub request { Line 50  sub request {
50    
51          if ( my $ref = ref($url) ) {          if ( my $ref = ref($url) ) {
52                  die "url not URI but ", dump( $url ) unless $ref =~ m{^URI};                  die "url not URI but ", dump( $url ) unless $ref =~ m{^URI};
53            } else {
54                  $url = URI->new($url);                  $url = URI->new($url);
55          }          }
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 61  sub request { Line 76  sub request {
76                          if ( system($cmd) == 0 ) {                          if ( system($cmd) == 0 ) {
77                                  my $server = Frey::Server->new;                                  my $server = Frey::Server->new;
78                                  $self->load_config;                                  $self->load_config;
79                                  Module::Reload->check;  #                               Module::Reload->check;
80                                  warn "# reload done";                                  warn "# reload done";
81                                  $self->print( refresh( $1, 1 ) );                                  $self->print( refresh( $1, 0 ) );
82                                  return;                                  return;
83                          } else {                          } else {
84                                  warn "ERROR: $?";                                  warn "ERROR: $?";
# Line 85  sub request { Line 100  sub request {
100                          return $class;                          return $class;
101                  }                  }
102    
   
103                  my $f;                  my $f;
104    
105                  # shared run params                  # shared run params
# 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;
                         $params->{request_url} = $url,  
130                          $run->{$_} = $params->{$_} foreach keys %$params;                          $run->{$_} = $params->{$_} foreach keys %$params;
131                          $f = Frey::Run->new( class => $class, params => $run, run => $2, request_url => $url );                          $f = Frey::Run->new( class => $class, params => $run, run => $2 );
132                  } elsif (                  } elsif (
133                          $path =~ m{/([^/]+)/?$}                          $path =~ m{/([^/]+)/?$}
134                  ) {                  ) {
135                          my $class = rest2class $1;                          my $class = rest2class $1;
136                          warn "# introspect $class";                          warn "# introspect $class";
137                          $run->{class} ||= $class;                          $run->{class} ||= $class;
138                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );
139                  } else {                  } else {
140                          $f = Frey::Run->new( class => 'Frey::ClassBrowser', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Class::Browser', params => $run );
141                  }                  }
142    
143                  if ( $f ) {                  if ( $f ) {
# Line 141  sub request { Line 154  sub request {
154                          confess "# can't call request on nothing!";                          confess "# can't call request on nothing!";
155                  }                  }
156    
157                    $request->{content_type} = $f->content_type;
158          };          };
159    
160          if ( $@ ) {          if ( $@ ) {
161                  warn "SERVER ERROR: $@";                  warn "SERVER ERROR: $@";
162  #               $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} );  
163  #               Carp::REPL::repl;  #               Carp::REPL::repl;
164                    return {
165                            content_type => 'text/html',
166                            code => 404,
167                    }
168          }          }
169    
170            return $request;
171  }  }
172    
173  sub refresh {  sub refresh {
174          my ( $url, $time ) = @_;          my ( $url, $time ) = @_;
175          $url  ||= '/';          $url  ||= '/';
176          $time ||= 1;          $time ||= 0;
177          warn "# refresh $url";          warn "# refresh $url";
178          qq|          qq|
179                  <html>                  <html>
Legend:
Removed from v.627  
changed lines
  Added in v.954
  ViewVC Help
Powered by ViewVC 1.1.26