Class::MOP Browser

From: Stevan Little Date: Mon, 11 Sep 2006 20:02:03 +0000 (+0000) Subject: Adding Class::MOP::Browser catalyst app X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6e9fa894514c8869669cf8a55a2b4ba04830a4d9;p=gitmo%2FClass-MOP.git Adding Class::MOP::Browser catalyst app --- 6e9fa894514c8869669cf8a55a2b4ba04830a4d9 diff --git a/Changes b/Changes new file mode 100644 index 0000000..da6033c --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +This file documents the revision history for Perl extension Class::MOP::Browser. + +0.01 2006-09-11 13:36:09 + - initial revision, generated by Catalyst diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..e349849 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,16 @@ +use inc::Module::Install; + +name 'Class-MOP-Browser'; +all_from 'lib/Class/MOP/Browser.pm'; + +requires 'Catalyst' => '5.7001'; +requires 'Catalyst::Plugin::ConfigLoader'; +requires 'Catalyst::Plugin::Static::Simple'; +requires 'Catalyst::Action::RenderView'; +requires 'YAML'; # This should reflect the config file format you've chosen + # See Catalyst::Plugin::ConfigLoader for supported formats +catalyst; + +install_script glob('script/*.pl'); +auto_install; +WriteAll; diff --git a/README b/README new file mode 100644 index 0000000..d5053e2 --- /dev/null +++ b/README @@ -0,0 +1 @@ +Run script/class_mop_browser_server.pl to test the application. diff --git a/class_mop_browser.yml b/class_mop_browser.yml new file mode 100644 index 0000000..a447f5d --- /dev/null +++ b/class_mop_browser.yml @@ -0,0 +1,2 @@ +--- +name: Class::MOP::Browser diff --git a/lib/Class/MOP/Browser.pm b/lib/Class/MOP/Browser.pm new file mode 100644 index 0000000..2141c5a --- /dev/null +++ b/lib/Class/MOP/Browser.pm @@ -0,0 +1,121 @@ + +use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/trunk/lib'; + +package Class::MOP::Browser; + +use strict; +use warnings; + +use Class::MOP; +use B::Deparse; +use Data::Dumper; + +use Catalyst::Runtime '5.70'; +use Catalyst qw/ + -Debug + ConfigLoader + Static::Simple +/; + +our $VERSION = '0.01'; + +__PACKAGE__->config(name => 'Class::MOP::Browser'); + +__PACKAGE__->config( + 'View::TT' => { + INCLUDE_PATH => [ + __PACKAGE__->path_to(qw/root/), + __PACKAGE__->path_to(qw/root templates/), + ], + TEMPLATE_EXTENSION => ".tmpl", + WRAPPER => [ + 'wrappers/root.tmpl', + ], + }, +); + + +__PACKAGE__->setup; + +sub get_all_metaclasses { sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances } +sub get_metaclass_by_name { + shift; + Class::MOP::get_metaclass_by_name(@_); +} + +sub deparse_method { + my (undef, $method) = @_; + + my $deparse = B::Deparse->new("-d"); + my $body = $deparse->coderef2text($method->body()); + + my @body = split /\n/ => $body; + my @cleaned; + + foreach (@body) { + next if /^\s+use/; + next if /^\s+BEGIN/; + next if /^\s+package/; + push @cleaned => $_; + } + + return "sub " . $method->name . ' ' . (join "\n" => @cleaned); +} + +sub deparse_item { + my (undef, $item) = @_; + return $item unless ref $item; + local $Data::Dumper::Deparse = 1; + local $Data::Dumper::Indent = 1; + my $dumped = Dumper $item; + $dumped =~ s/^\$VAR1\s=\s//; + $dumped =~ s/\;$//; + + my @body = split /\n/ => $dumped; + my @cleaned; + + foreach (@body) { + next if /^\s+use/; + next if /^\s+BEGIN/; + next if /^\s+package/; + push @cleaned => $_; + } + + return (join "\n" => @cleaned); +} + + +1; + +__END__ + +=pod + +=head1 NAME + +Class::MOP::Browser - Catalyst based application + +=head1 SYNOPSIS + + script/class_mop_browser_server.pl + +=head1 DESCRIPTION + +[enter your description here] + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Stevan Little + +=head1 LICENSE + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Class/MOP/Browser/Controller/Root.pm b/lib/Class/MOP/Browser/Controller/Root.pm new file mode 100644 index 0000000..f638a2b --- /dev/null +++ b/lib/Class/MOP/Browser/Controller/Root.pm @@ -0,0 +1,57 @@ + +package Class::MOP::Browser::Controller::Root; + +use strict; +use warnings; + +use base 'Catalyst::Controller'; + +our $VERSION = '0.01'; + +__PACKAGE__->config->{namespace} = ''; + +sub default : Private { + my ($self, $c) = @_; + $c->response->body("Helloooooo World"); +} + +sub index : Public { + my ( $self, $c ) = @_; +} + +sub end : ActionClass('RenderView') {} + +1; + +__END__ + +=pod + +=head1 NAME + +Class::MOP::Browser::Controller::Root - Root Controller for Class::MOP::Browser + +=head1 DESCRIPTION + +[enter your description here] + +=head1 METHODS + +=head2 default + +=cut + +=head2 end + +Attempt to render a view, if needed. + +=head1 AUTHOR + +Stevan Little + +=head1 LICENSE + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Class/MOP/Browser/View/TT.pm b/lib/Class/MOP/Browser/View/TT.pm new file mode 100644 index 0000000..559bdbd --- /dev/null +++ b/lib/Class/MOP/Browser/View/TT.pm @@ -0,0 +1,38 @@ + +package Class::MOP::Browser::View::TT; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use base 'Catalyst::View::TT'; + +1; + +__END__ + +=pod + +=head1 NAME + +Class::MOP::Browser::View::TT - Catalyst TT View + +=head1 SYNOPSIS + +See L + +=head1 DESCRIPTION + +Catalyst TT View. + +=head1 AUTHOR + +Stevan Little + +=head1 LICENSE + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/root/templates/index.tmpl b/root/templates/index.tmpl new file mode 100644 index 0000000..db64163 --- /dev/null +++ b/root/templates/index.tmpl @@ -0,0 +1,113 @@ + + + + + + +[% IF c.request.param('class') %] + +[% END %] + +[% IF c.request.param('class') && c.request.param('area') == 'attributes' && c.request.param('attr') %] + +[% + meta = c.get_metaclass_by_name(c.request.param('class')) + attr = meta.get_attribute(c.request.param('attr')) +%] + + + +[% END %] + +[% IF c.request.param('class') && c.request.param('area') == 'methods' && c.request.param('method') %] + +[% + meta = c.get_metaclass_by_name(c.request.param('class')) + method = meta.get_method(c.request.param('method')) +%] + + + +[% END %] + + + + +[% IF c.request.param('class') && c.request.param('area') %] + +[% meta = c.get_metaclass_by_name(c.request.param('class')) %] + + +[% END %] + + +

+ [% FOREACH metaclass IN c.get_all_metaclasses %] + + [% IF c.request.param('class') == metaclass.name %] + + [% ELSE %] + + [% END %] + + [% END %] +

[% metaclass.name %]

+ + [% FOREACH area IN [ 'attributes', 'methods', 'superclasses' ] %] + [% IF c.request.param('area') == area %] + + [% ELSE %] + + [% END %] + [% END %] + +

[% area %]

+ [% FOREACH aspect IN [ 'name', 'init_arg', 'reader', 'writer', 'accessor', 'predicate', 'default' ]%] + [% item = attr.$aspect() %] + + + + + [% END %] +

[% aspect %]

[% IF item == undef %]—[% ELSE %]

[% c.deparse_item(item) %]

[% END %]

+ [% FOREACH aspect IN [ 'name', 'package_name', 'fully_qualified_name' ]%] + + + + + [% END %] + + + + +

[% aspect %]	[% method.$aspect() %]
body	[% c.deparse_method(method) %]

+ [% IF c.request.param('area') == 'methods' %] + [% FOREACH method IN meta.get_method_list.sort %] + + [% IF c.request.param('method') == method %] + + [% ELSE %] + + [% END %] + + [% END %] + [% END %] + [% IF c.request.param('area') == 'attributes' %] + [% FOREACH attr IN meta.get_attribute_list.sort %] + + [% IF c.request.param('attr') == attr %] + + [% ELSE %] + + [% END %] + + [% END %] + [% END %] + [% IF c.request.param('area') == 'superclasses' %] + [% FOREACH super IN meta.superclasses.sort %] + + + + [% END %] + [% END %] +

[% method %]	[% method %]
[% attr %]	[% attr %]
[% super %]

\ No newline at end of file diff --git a/root/wrappers/root.tmpl b/root/wrappers/root.tmpl new file mode 100644 index 0000000..35939b9 --- /dev/null +++ b/root/wrappers/root.tmpl @@ -0,0 +1,21 @@ + + +Class::MOP Browser + + + +[% content %] + + \ No newline at end of file diff --git a/script/class_mop_browser_cgi.pl b/script/class_mop_browser_cgi.pl new file mode 100755 index 0000000..857a2bf --- /dev/null +++ b/script/class_mop_browser_cgi.pl @@ -0,0 +1,37 @@ +#!/usr/bin/perl -w + +BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' } + +use strict; +use warnings; +use FindBin; +use lib "$FindBin::Bin/../lib"; +use Class::MOP::Browser; + +Class::MOP::Browser->run; + +1; + +=head1 NAME + +class_mop_browser_cgi.pl - Catalyst CGI + +=head1 SYNOPSIS + +See L + +=head1 DESCRIPTION + +Run a Catalyst application as a cgi script. + +=head1 AUTHOR + +Sebastian Riedel, C + +=head1 COPYRIGHT + + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/script/class_mop_browser_create.pl b/script/class_mop_browser_create.pl new file mode 100755 index 0000000..b546c9b --- /dev/null +++ b/script/class_mop_browser_create.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use Getopt::Long; +use Pod::Usage; +use Catalyst::Helper; + +my $force = 0; +my $mech = 0; +my $help = 0; + +GetOptions( + 'nonew|force' => \$force, + 'mech|mechanize' => \$mech, + 'help|?' => \$help + ); + +pod2usage(1) if ( $help || !$ARGV[0] ); + +my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } ); + +pod2usage(1) unless $helper->mk_component( 'Class::MOP::Browser', @ARGV ); + +1; + +=head1 NAME + +class_mop_browser_create.pl - Create a new Catalyst Component + +=head1 SYNOPSIS + +class_mop_browser_create.pl [options] model|view|controller name [helper] [options] + + Options: + -force don't create a .new file where a file to be created exists + -mechanize use Test::WWW::Mechanize::Catalyst for tests if available + -help display this help and exits + + Examples: + class_mop_browser_create.pl controller My::Controller + class_mop_browser_create.pl -mechanize controller My::Controller + class_mop_browser_create.pl view My::View + class_mop_browser_create.pl view MyView TT + class_mop_browser_create.pl view TT TT + class_mop_browser_create.pl model My::Model + class_mop_browser_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\ + dbi:SQLite:/tmp/my.db + class_mop_browser_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\ + dbi:Pg:dbname=foo root 4321 + + See also: + perldoc Catalyst::Manual + perldoc Catalyst::Manual::Intro + +=head1 DESCRIPTION + +Create a new Catalyst Component. + +Existing component files are not overwritten. If any of the component files +to be created already exist the file will be written with a '.new' suffix. +This behavior can be suppressed with the C<-force> option. + +=head1 AUTHOR + +Sebastian Riedel, C +Maintained by the Catalyst Core Team. + +=head1 COPYRIGHT + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/script/class_mop_browser_fastcgi.pl b/script/class_mop_browser_fastcgi.pl new file mode 100755 index 0000000..4e41b9d --- /dev/null +++ b/script/class_mop_browser_fastcgi.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' } + +use strict; +use warnings; +use Getopt::Long; +use Pod::Usage; +use FindBin; +use lib "$FindBin::Bin/../lib"; +use Class::MOP::Browser; + +my $help = 0; +my ( $listen, $nproc, $pidfile, $manager, $detach ); + +GetOptions( + 'help|?' => \$help, + 'listen|l=s' => \$listen, + 'nproc|n=i' => \$nproc, + 'pidfile|p=s' => \$pidfile, + 'manager|M=s' => \$manager, + 'daemon|d' => \$detach, +); + +pod2usage(1) if $help; + +Class::MOP::Browser->run( + $listen, + { nproc => $nproc, + pidfile => $pidfile, + manager => $manager, + detach => $detach, + } +); + +1; + +=head1 NAME + +class_mop_browser_fastcgi.pl - Catalyst FastCGI + +=head1 SYNOPSIS + +class_mop_browser_fastcgi.pl [options] + + Options: + -? -help display this help and exits + -l -listen Socket path to listen on + (defaults to standard input) + can be HOST:PORT, :PORT or a + filesystem path + -n -nproc specify number of processes to keep + to serve requests (defaults to 1, + requires -listen) + -p -pidfile specify filename for pid file + (requires -listen) + -d -daemon daemonize (requires -listen) + -M -manager specify alternate process manager + (FCGI::ProcManager sub-class) + or empty string to disable + +=head1 DESCRIPTION + +Run a Catalyst application as fastcgi. + +=head1 AUTHOR + +Sebastian Riedel, C +Maintained by the Catalyst Core Team. + +=head1 COPYRIGHT + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/script/class_mop_browser_server.pl b/script/class_mop_browser_server.pl new file mode 100755 index 0000000..df03feb --- /dev/null +++ b/script/class_mop_browser_server.pl @@ -0,0 +1,110 @@ +#!/usr/bin/perl -w + +BEGIN { + $ENV{CATALYST_ENGINE} ||= 'HTTP'; + $ENV{CATALYST_SCRIPT_GEN} = 28; +} + +use strict; +use warnings; +use Getopt::Long; +use Pod::Usage; +use FindBin; +use lib "$FindBin::Bin/../lib"; + +my $debug = 0; +my $fork = 0; +my $help = 0; +my $host = undef; +my $port = 3000; +my $keepalive = 0; +my $restart = 0; +my $restart_delay = 1; +my $restart_regex = '\.yml$|\.yaml$|\.pm$'; +my $restart_directory = undef; + +my @argv = @ARGV; + +GetOptions( + 'debug|d' => \$debug, + 'fork' => \$fork, + 'help|?' => \$help, + 'host=s' => \$host, + 'port=s' => \$port, + 'keepalive|k' => \$keepalive, + 'restart|r' => \$restart, + 'restartdelay|rd=s' => \$restart_delay, + 'restartregex|rr=s' => \$restart_regex, + 'restartdirectory=s' => \$restart_directory, +); + +pod2usage(1) if $help; + +if ( $restart ) { + $ENV{CATALYST_ENGINE} = 'HTTP::Restarter'; +} +if ( $debug ) { + $ENV{CATALYST_DEBUG} = 1; +} + +# This is require instead of use so that the above environment +# variables can be set at runtime. +require Class::MOP::Browser; + +Class::MOP::Browser->run( $port, $host, { + argv => \@argv, + 'fork' => $fork, + keepalive => $keepalive, + restart => $restart, + restart_delay => $restart_delay, + restart_regex => qr/$restart_regex/, + restart_directory => $restart_directory, +} ); + +1; + +=head1 NAME + +class_mop_browser_server.pl - Catalyst Testserver + +=head1 SYNOPSIS + +class_mop_browser_server.pl [options] + + Options: + -d -debug force debug mode + -f -fork handle each request in a new process + (defaults to false) + -? -help display this help and exits + -host host (defaults to all) + -p -port port (defaults to 3000) + -k -keepalive enable keep-alive connections + -r -restart restart when files get modified + (defaults to false) + -rd -restartdelay delay between file checks + -rr -restartregex regex match files that trigger + a restart when modified + (defaults to '\.yml$|\.yaml$|\.pm$') + -restartdirectory the directory to search for + modified files + (defaults to '../') + + See also: + perldoc Catalyst::Manual + perldoc Catalyst::Manual::Intro + +=head1 DESCRIPTION + +Run a Catalyst Testserver for this application. + +=head1 AUTHOR + +Sebastian Riedel, C +Maintained by the Catalyst Core Team. + +=head1 COPYRIGHT + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/script/class_mop_browser_test.pl b/script/class_mop_browser_test.pl new file mode 100755 index 0000000..d4f99ce --- /dev/null +++ b/script/class_mop_browser_test.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use Getopt::Long; +use Pod::Usage; +use FindBin; +use lib "$FindBin::Bin/../lib"; +use Catalyst::Test 'Class::MOP::Browser'; + +my $help = 0; + +GetOptions( 'help|?' => \$help ); + +pod2usage(1) if ( $help || !$ARGV[0] ); + +print request($ARGV[0])->content . "\n"; + +1; + +=head1 NAME + +class_mop_browser_test.pl - Catalyst Test + +=head1 SYNOPSIS + +class_mop_browser_test.pl [options] uri + + Options: + -help display this help and exits + + Examples: + class_mop_browser_test.pl http://localhost/some_action + class_mop_browser_test.pl /some_action + + See also: + perldoc Catalyst::Manual + perldoc Catalyst::Manual::Intro + +=head1 DESCRIPTION + +Run a Catalyst action from the command line. + +=head1 AUTHOR + +Sebastian Riedel, C +Maintained by the Catalyst Core Team. + +=head1 COPYRIGHT + +This library is free software, you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/01app.t b/t/01app.t new file mode 100644 index 0000000..8f3fbec --- /dev/null +++ b/t/01app.t @@ -0,0 +1,7 @@ +use strict; +use warnings; +use Test::More tests => 2; + +BEGIN { use_ok 'Catalyst::Test', 'Class::MOP::Browser' } + +ok( request('/')->is_success, 'Request should succeed' ); diff --git a/t/02pod.t b/t/02pod.t new file mode 100644 index 0000000..251640d --- /dev/null +++ b/t/02pod.t @@ -0,0 +1,9 @@ +use strict; +use warnings; +use Test::More; + +eval "use Test::Pod 1.14"; +plan skip_all => 'Test::Pod 1.14 required' if $@; +plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; + +all_pod_files_ok(); diff --git a/t/03podcoverage.t b/t/03podcoverage.t new file mode 100644 index 0000000..ae59d4c --- /dev/null +++ b/t/03podcoverage.t @@ -0,0 +1,9 @@ +use strict; +use warnings; +use Test::More; + +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; +plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; + +all_pod_coverage_ok(); diff --git a/t/view_TT.t b/t/view_TT.t new file mode 100644 index 0000000..7854b05 --- /dev/null +++ b/t/view_TT.t @@ -0,0 +1,6 @@ +use strict; +use warnings; +use Test::More tests => 1; + +BEGIN { use_ok 'Class::MOP::Browser::View::TT' } +