summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-05-30 11:14:01 +0200
committerfranck cuny <franck@lumberjaph.net>2009-05-30 11:14:01 +0200
commitb96d3c0287b46c5fd30a8c084c28a20723f1e967 (patch)
tree7708fd30e0429f720bb278f68e18d795942f644b
downloadcatalystx-dispatcher-asgraph-b96d3c0287b46c5fd30a8c084c28a20723f1e967.tar.gz
import
-rw-r--r--.shipit6
-rw-r--r--Changes4
-rw-r--r--Makefile.PL13
-rw-r--r--README27
-rw-r--r--bin/catalyst_graph_dispatcher.pl11
-rw-r--r--lib/CatalystX/Dispatcher/AsGraph.pm64
-rw-r--r--t/00_compile.t4
-rw-r--r--xt/01_podspell.t10
-rw-r--r--xt/02_perlcritic.t8
-rw-r--r--xt/03_pod.t4
-rw-r--r--xt/perlcriticrc2
11 files changed, 153 insertions, 0 deletions
diff --git a/.shipit b/.shipit
new file mode 100644
index 0000000..e28b215
--- /dev/null
+++ b/.shipit
@@ -0,0 +1,6 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist
+git.tagpattern = release-%v
+git.push_to = release
+
+CheckChangeLog.files = Changes
+MakeDist.destination = ~/code/distribs/
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..19cbcff
--- /dev/null
+++ b/Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension CatalystX::Dispatcher::AsGraph
+
+0.01    Sat May 30 10:36:31 2009
+        - original version
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..3ee1e88
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,13 @@
+use inc::Module::Install;
+name 'CatalystX-Dispatcher-AsGraph';
+all_from 'lib/CatalystX/Dispatcher/AsGraph.pm';
+
+# requires '';
+
+tests 't/*.t';
+author_tests 'xt';
+
+build_requires 'Test::More';
+use_test_base;
+auto_include;
+WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..327ad75
--- /dev/null
+++ b/README
@@ -0,0 +1,27 @@
+This is Perl module CatalystX::Dispatcher::AsGraph.
+
+INSTALLATION
+
+CatalystX::Dispatcher::AsGraph installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+    % cpan CatalystX::Dispatcher::AsGraph
+
+Download it, unpack it, then build it as per the usual:
+
+    % perl Makefile.PL
+    % make && make test
+
+Then install it:
+
+    % make install
+
+DOCUMENTATION
+
+CatalystX::Dispatcher::AsGraph documentation is available as in POD. So you can do:
+
+    % perldoc CatalystX::Dispatcher::AsGraph
+
+to read the documentation online with your favorite pager.
+
+Default Name
diff --git a/bin/catalyst_graph_dispatcher.pl b/bin/catalyst_graph_dispatcher.pl
new file mode 100644
index 0000000..e8fc5c1
--- /dev/null
+++ b/bin/catalyst_graph_dispatcher.pl
@@ -0,0 +1,11 @@
+#!/usr/bin/perl -w
+use strict;
+use lib('/home/franck/code/git/CatalystX-Dispatcher-AsGraph/lib');
+use CatalystX::Dispatcher::AsGraph;
+
+my $graph = CatalystX::Dispatcher::AsGraph->new_with_options();
+$graph->run;
+if ( open( my $png, '|-', 'dot -Tpng -o ' . $graph->output ) ) {
+    print $png $graph->graph->as_graphviz;
+    close($png);
+}
diff --git a/lib/CatalystX/Dispatcher/AsGraph.pm b/lib/CatalystX/Dispatcher/AsGraph.pm
new file mode 100644
index 0000000..ceb372d
--- /dev/null
+++ b/lib/CatalystX/Dispatcher/AsGraph.pm
@@ -0,0 +1,64 @@
+use MooseX::Declare;
+use Graph::Easy;
+use UNIVERSAL::require;
+
+class CatalystX::Dispatcher::AsGraph {
+
+    with 'MooseX::Getopt';
+
+    has [qw/appname output/] => ( is => 'ro', isa => 'Str', required => 1 );
+    has 'graph' => ( is => 'ro', default => sub { Graph::Easy->new } );
+
+    method run{
+        my $class  = $self->appname;
+        $class->require or die $@;
+        my $app    = $class->new;
+        my $routes = $app->dispatcher->_tree;
+        $self->_new_node($routes, '');
+    }
+
+    method _new_node($parent, $prefix) {
+        my $name = $prefix . $parent->getNodeValue || '';
+        my $node = $self->graph->add_node($name);
+
+        for my $child ( $parent->getAllChildren ) {
+            my $child_node = $self->_new_node( $child, $name . ' -> ' );
+            $self->graph->add_edge( $node, $child_node );
+        }
+        my $actions = $parent->getNodeValue->actions;
+        for my $action ( keys %{$actions} ) {
+            next if ( ( $action =~ /^_.*/ ) );
+            $self->graph->add_edge( $node, "[action] " . $action);
+        }
+        return $node;
+    }
+}
+
+
+__END__
+
+=head1 NAME
+
+CatalystX::Dispatcher::AsGraph - Create a graph from Catalyst dispatcher
+
+=head1 SYNOPSIS
+
+    use CatalystX::Dispatcher::AsGraph;
+    my $graph = CatalystX::Dispatcher::AsGraph->new_with_options();
+    $graph->graph;
+
+=head1 DESCRIPTION
+
+CatalystX::Dispatcher::AsGraph create a graph for a Catalyst application
+using his dispatcher.
+
+=head1 AUTHOR
+
+Franck Cuny E<lt>franck@lumberjaph.netE<gt>
+
+=head1 SEE ALSO
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
diff --git a/t/00_compile.t b/t/00_compile.t
new file mode 100644
index 0000000..e3d455a
--- /dev/null
+++ b/t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'CatalystX::Dispatcher::AsGraph' }
diff --git a/xt/01_podspell.t b/xt/01_podspell.t
new file mode 100644
index 0000000..9db996e
--- /dev/null
+++ b/xt/01_podspell.t
@@ -0,0 +1,10 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+$ENV{LANG} = 'C';
+all_pod_files_spelling_ok('lib');
+__DATA__
+Default Name
+default {at} example.com
+CatalystX::Dispatcher::AsGraph
diff --git a/xt/02_perlcritic.t b/xt/02_perlcritic.t
new file mode 100644
index 0000000..b977df8
--- /dev/null
+++ b/xt/02_perlcritic.t
@@ -0,0 +1,8 @@
+use strict;
+use Test::More;
+eval {
+    require Test::Perl::Critic;
+    Test::Perl::Critic->import( -profile => 'xt/perlcriticrc');
+};
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok('lib');
diff --git a/xt/03_pod.t b/xt/03_pod.t
new file mode 100644
index 0000000..437887a
--- /dev/null
+++ b/xt/03_pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
diff --git a/xt/perlcriticrc b/xt/perlcriticrc
new file mode 100644
index 0000000..fa96144
--- /dev/null
+++ b/xt/perlcriticrc
@@ -0,0 +1,2 @@
+[TestingAndDebugging::ProhibitNoStrict]
+allow=refs