/[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 628 by dpavlin, Sat Nov 29 22:43:13 2008 UTC revision 793 by dpavlin, Wed Dec 10 17:51:29 2008 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 lib 'lib';
10  use Frey::Run;  use Frey::Run;
11    
12  has 'port' => (  has 'port' => (
# Line 32  has 'editor' => ( Line 33  has 'editor' => (
33  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
34  documented only in source code.  documented only in source code.
35    
36      my $content_type = $self->request( $url, $params );
37    
38  =cut  =cut
39    
40  sub print {  sub print {
# Line 45  sub request { Line 48  sub request {
48    
49          if ( my $ref = ref($url) ) {          if ( my $ref = ref($url) ) {
50                  die "url not URI but ", dump( $url ) unless $ref =~ m{^URI};                  die "url not URI but ", dump( $url ) unless $ref =~ m{^URI};
51            } else {
52                  $url = URI->new($url);                  $url = URI->new($url);
53          }          }
54    
55          my $path = $url->path;          my $path = $url->path;
56            my $content_type = 'text/plain';
57    
58  #       eval {          eval {
59          {  #       {
60    
61                  if ( $path =~ m{/reload(.*)} ) {                  if ( $path =~ m{/reload(.*)} ) {
62    
# Line 61  sub request { Line 66  sub request {
66                          if ( system($cmd) == 0 ) {                          if ( system($cmd) == 0 ) {
67                                  my $server = Frey::Server->new;                                  my $server = Frey::Server->new;
68                                  $self->load_config;                                  $self->load_config;
69                                  Module::Reload->check;  #                               Module::Reload->check;
70                                  warn "# reload done";                                  warn "# reload done";
71                                  $self->print( refresh( $1, 1 ) );                                  $self->print( refresh( $1, 0 ) );
72                                  return;                                  return;
73                          } else {                          } else {
74                                  warn "ERROR: $?";                                  warn "ERROR: $?";
# Line 85  sub request { Line 90  sub request {
90                          return $class;                          return $class;
91                  }                  }
92    
   
93                  my $f;                  my $f;
94    
95                  # shared run params                  # shared run params
# Line 113  sub request { Line 117  sub request {
117                          my $class = rest2class $1;                          my $class = rest2class $1;
118                          warn "# run $path -> $class $2";                          warn "# run $path -> $class $2";
119                          $run->{format} = $3 if $3;                          $run->{format} = $3 if $3;
                         $params->{request_url} = $url,  
120                          $run->{$_} = $params->{$_} foreach keys %$params;                          $run->{$_} = $params->{$_} foreach keys %$params;
121                          $f = Frey::Run->new( class => $class, params => $run, run => $2, request_url => $url );                          $f = Frey::Run->new( class => $class, params => $run, run => $2 );
122                  } elsif (                  } elsif (
123                          $path =~ m{/([^/]+)/?$}                          $path =~ m{/([^/]+)/?$}
124                  ) {                  ) {
125                          my $class = rest2class $1;                          my $class = rest2class $1;
126                          warn "# introspect $class";                          warn "# introspect $class";
127                          $run->{class} ||= $class;                          $run->{class} ||= $class;
128                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );
129                  } else {                  } else {
130                          $f = Frey::Run->new( class => 'Frey::ClassBrowser', params => $run, request_url => $url );                          $f = Frey::Run->new( class => 'Frey::Class::Browser', params => $run );
131                  }                  }
132    
133                  if ( $f ) {                  if ( $f ) {
# Line 141  sub request { Line 144  sub request {
144                          confess "# can't call request on nothing!";                          confess "# can't call request on nothing!";
145                  }                  }
146    
147                    $content_type = $f->content_type;
148          };          };
149    
150          if ( $@ ) {          if ( $@ ) {
# Line 150  sub request { Line 154  sub request {
154  #               Carp::REPL::repl;  #               Carp::REPL::repl;
155          }          }
156    
157            return $content_type;
158  }  }
159    
160  sub refresh {  sub refresh {
161          my ( $url, $time ) = @_;          my ( $url, $time ) = @_;
162          $url  ||= '/';          $url  ||= '/';
163          $time ||= 1;          $time ||= 0;
164          warn "# refresh $url";          warn "# refresh $url";
165          qq|          qq|
166                  <html>                  <html>
Legend:
Removed from v.628  
changed lines
  Added in v.793
  ViewVC Help
Powered by ViewVC 1.1.26