8 |
#use Continuity::REPL; |
#use Continuity::REPL; |
9 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
10 |
|
|
11 |
use Frey; |
use Frey::ClassLoader; |
|
use Frey::Introspect; |
|
|
use Frey::ObjectBrowser; |
|
12 |
|
|
13 |
my @messages; # Global (shared) list of messages |
my @messages; # Global (shared) list of messages |
14 |
my $got_message; # Flag to indicate that there is a new message to display |
my $got_message; # Flag to indicate that there is a new message to display |
18 |
#$repl = Continuity::REPL->new; |
#$repl = Continuity::REPL->new; |
19 |
|
|
20 |
sub run { |
sub run { |
21 |
|
my ( $self, $port ) = @_; |
22 |
$server = Continuity->new( |
$server = Continuity->new( |
23 |
port => 16001, |
port => $port || 16001, |
24 |
path_session => 1, |
path_session => 1, |
25 |
cookie_session => 'sid', |
cookie_session => 'sid', |
26 |
callback => \&main, |
callback => \&main, |
27 |
debug_level => 1, |
debug_level => 1, |
28 |
staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ }, |
staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ }, |
29 |
); |
); |
30 |
|
Frey::ClassLoader->new->load_all_classes(); |
31 |
$server->loop; |
$server->loop; |
32 |
} |
} |
33 |
|
|
51 |
} |
} |
52 |
|
|
53 |
if ( $path =~ m!/ob/([^/]+)(?:/([^/]*))?! ) { |
if ( $path =~ m!/ob/([^/]+)(?:/([^/]*))?! ) { |
54 |
my $f = Frey::ObjectBrowser->new; |
my $f = Frey::ObjectBrowser->new( fey_class => $1 ); |
55 |
$f->html( $req ); |
$f->html( $req ); |
56 |
} |
} |
57 |
|
|
69 |
ul => [ |
ul => [ |
70 |
map { |
map { |
71 |
warn dump( $_ ); |
warn dump( $_ ); |
72 |
my ( $package, $path ) = %$_; |
my $package = $_; |
73 |
( li => [ |
( li => [ |
74 |
a => { href => '/~/' . $package . '/' } => [ $package ], |
a => { href => '/~/' . $package . '/' } => [ $package ], |
75 |
' ', |
' <tt>', $f->package_path( $package ), '</tt> ', |
76 |
a => { href => '/ob/' . $package } => [ 'browse' ], |
$package->can('rows') ? |
77 |
" <tt>$path</tt>" |
( a => { href => '/ob/' . $package } => [ 'browse' ] ) : '', |
78 |
] ) |
] ) |
79 |
} @{ $f->classes } |
} $f->classes |
80 |
], |
], |
81 |
); |
); |
82 |
$req->print( $classes ); |
$req->print( $classes ); |