[Catalyst-commits] r6625 - in trunk/examples: . CatPaste
CatPaste/lib CatPaste/lib/CatPaste
CatPaste/lib/CatPaste/Controller CatPaste/lib/CatPaste/Model
CatPaste/lib/CatPaste/Schema CatPaste/lib/CatPaste/View
CatPaste/root CatPaste/root/paste CatPaste/root/site
CatPaste/root/site/layouts CatPaste/root/site/layouts/default
CatPaste/root/site/shared CatPaste/root/static
CatPaste/root/static/css CatPaste/root/static/images
CatPaste/script CatPaste/t
jshirley at dev.catalyst.perl.org
jshirley at dev.catalyst.perl.org
Wed Aug 8 01:39:15 GMT 2007
Author: jshirley
Date: 2007-08-08 01:39:14 +0100 (Wed, 08 Aug 2007)
New Revision: 6625
Added:
trunk/examples/CatPaste/
trunk/examples/CatPaste/Changes
trunk/examples/CatPaste/Makefile.PL
trunk/examples/CatPaste/README
trunk/examples/CatPaste/catpaste.yml
trunk/examples/CatPaste/db/
trunk/examples/CatPaste/files/
trunk/examples/CatPaste/lib/
trunk/examples/CatPaste/lib/CatPaste.pm
trunk/examples/CatPaste/lib/CatPaste/
trunk/examples/CatPaste/lib/CatPaste/Controller/
trunk/examples/CatPaste/lib/CatPaste/Controller/Root.pm
trunk/examples/CatPaste/lib/CatPaste/Model/
trunk/examples/CatPaste/lib/CatPaste/Model/IKC.pm
trunk/examples/CatPaste/lib/CatPaste/Model/Schema.pm
trunk/examples/CatPaste/lib/CatPaste/Schema.pm
trunk/examples/CatPaste/lib/CatPaste/Schema/
trunk/examples/CatPaste/lib/CatPaste/Schema/Category.pm
trunk/examples/CatPaste/lib/CatPaste/Schema/Paste.pm
trunk/examples/CatPaste/lib/CatPaste/View/
trunk/examples/CatPaste/lib/CatPaste/View/TT.pm
trunk/examples/CatPaste/root/
trunk/examples/CatPaste/root/favicon.ico
trunk/examples/CatPaste/root/paste.tt
trunk/examples/CatPaste/root/paste/
trunk/examples/CatPaste/root/paste/root.tt
trunk/examples/CatPaste/root/paste/view.tt
trunk/examples/CatPaste/root/root.tt
trunk/examples/CatPaste/root/site/
trunk/examples/CatPaste/root/site/layouts/
trunk/examples/CatPaste/root/site/layouts/default.tt
trunk/examples/CatPaste/root/site/layouts/default/
trunk/examples/CatPaste/root/site/layouts/default/footer.tt
trunk/examples/CatPaste/root/site/layouts/default/header.tt
trunk/examples/CatPaste/root/site/shared/
trunk/examples/CatPaste/root/site/shared/macros.tt
trunk/examples/CatPaste/root/site/wrapper.tt
trunk/examples/CatPaste/root/site/xhtml.tt
trunk/examples/CatPaste/root/static/
trunk/examples/CatPaste/root/static/css/
trunk/examples/CatPaste/root/static/css/kate.css
trunk/examples/CatPaste/root/static/css/screen.css
trunk/examples/CatPaste/root/static/images/
trunk/examples/CatPaste/root/static/images/btn_120x50_built.png
trunk/examples/CatPaste/root/static/images/btn_120x50_built_shadow.png
trunk/examples/CatPaste/root/static/images/btn_120x50_powered.png
trunk/examples/CatPaste/root/static/images/btn_120x50_powered_shadow.png
trunk/examples/CatPaste/root/static/images/btn_88x31_built.png
trunk/examples/CatPaste/root/static/images/btn_88x31_built_shadow.png
trunk/examples/CatPaste/root/static/images/btn_88x31_powered.png
trunk/examples/CatPaste/root/static/images/btn_88x31_powered_shadow.png
trunk/examples/CatPaste/root/static/images/catalyst_logo.png
trunk/examples/CatPaste/script/
trunk/examples/CatPaste/script/catpaste_cgi.pl
trunk/examples/CatPaste/script/catpaste_create.pl
trunk/examples/CatPaste/script/catpaste_fastcgi.pl
trunk/examples/CatPaste/script/catpaste_server.pl
trunk/examples/CatPaste/script/catpaste_spawn_db.pl
trunk/examples/CatPaste/script/catpaste_test.pl
trunk/examples/CatPaste/t/
trunk/examples/CatPaste/t/01app.t
trunk/examples/CatPaste/t/02pod.t
trunk/examples/CatPaste/t/03podcoverage.t
trunk/examples/CatPaste/t/model_Schema.t
trunk/examples/CatPaste/t/view_TT.t
Log:
Basic quick hack of a Catalyst-based Paste bot that does POE-IKC notifications and RSS
Added: trunk/examples/CatPaste/Changes
===================================================================
--- trunk/examples/CatPaste/Changes (rev 0)
+++ trunk/examples/CatPaste/Changes 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,4 @@
+This file documents the revision history for Perl extension CatPaste.
+
+0.01 2007-08-06 17:37:16
+ - initial revision, generated by Catalyst
Added: trunk/examples/CatPaste/Makefile.PL
===================================================================
--- trunk/examples/CatPaste/Makefile.PL (rev 0)
+++ trunk/examples/CatPaste/Makefile.PL 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,26 @@
+use inc::Module::Install;
+
+name 'CatPaste';
+all_from 'lib/CatPaste.pm';
+
+requires 'Catalyst' => '5.7007';
+requires 'DBIx::Class';
+requires 'DBD::SQLite';
+requires 'XML::Feed';
+requires 'Syntax::Highlight::Engine::Kate';
+
+requires 'Catalyst::Plugin::ConfigLoader';
+requires 'Catalyst::Plugin::Static::Simple';
+requires 'Catalyst::Action::RenderView';
+requires 'Catalyst::View::TT';
+requires 'Catalyst::Model::DBIC::Schema';
+
+requires 'DBIx::Class::TimeStamp';
+
+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;
Added: trunk/examples/CatPaste/README
===================================================================
--- trunk/examples/CatPaste/README (rev 0)
+++ trunk/examples/CatPaste/README 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,8 @@
+First, you need to spawn the db:
+ script/catpaste_spawn_db.pl
+
+Then you can run script/catpaste_server.pl to start the application, if you
+want to use debug mode (advised) use:
+ script/catpaste_server.pl -d
+
+Patches Welcome.
Added: trunk/examples/CatPaste/catpaste.yml
===================================================================
--- trunk/examples/CatPaste/catpaste.yml (rev 0)
+++ trunk/examples/CatPaste/catpaste.yml 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,17 @@
+---
+name: CatPaste
+static_path: /static
+bucket:
+ # Where do we put the files
+ path: __HOME__/files
+ # Limit before rolling over
+ delete_after: '30 days'
+Model::Schema:
+ connect_info:
+ - dbi:SQLite:__HOME__/db/database.db
+Model::IKC:
+ port: 9990
+ name: "CatPaste"
+ # Where are you posting (IKC::ClientLite->post)
+ channel: Infobot/update
+
Added: trunk/examples/CatPaste/lib/CatPaste/Controller/Root.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Controller/Root.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Controller/Root.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,225 @@
+package CatPaste::Controller::Root;
+
+use strict;
+use warnings;
+use base 'Catalyst::Controller::BindLex';
+
+use XML::Feed;
+
+# Just used for keeping track of the syntax highlighter meta-information.
+# It desperately needs to get moved into a Model class.
+our $VALID_TYPES;
+our %VALID_TYPES_HASH;
+
+# What weight (sort order) do we want for the languages?
+our %WEIGHT = (
+ Perl => 100,
+ JavaScript => 90,
+ PHP_PHP => 80,
+ PHP_HTML => 70,
+ SQL_MySQL => 60
+);
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+# Add C<my $foo : Param> support to BindLex
+__PACKAGE__->config->{bindlex}{Param} = sub { $_[0]->req->params };
+
+=head1 NAME
+
+CatPaste::Controller::Root - Root Controller for CatPaste
+
+=head1 DESCRIPTION
+
+The root controller encapsulates all the actions for CatPaste. It's just not
+that complex of an application
+
+=head1 METHODS
+
+=cut
+
+=head2 base
+
+The base level chain, this is similar to "auto" and all other actions attach
+to it.
+
+=cut
+
+sub base : Chained('/') PathPart('') CaptureArgs(0) {
+ my $page : Stashed;
+ $page ||= {
+ links => [],
+ scripts => [],
+ stylesheets => []
+ };
+
+}
+
+=head2 root
+
+Root action, displays the paste
+
+=cut
+
+sub root : Chained('base') PathPart('') Args(0) {
+ my ( $self, $c ) = @_;
+
+ $c->forward('valid_types');
+
+ # TODO 0.02: Categories not in use in 0.01
+ #my $categories : Stashed = $c->model('Schema::Category');
+}
+
+=head2 post
+
+Post a new paste to store
+
+=cut
+
+sub post : Chained('base') PathPart('post') Args(0) {
+ my ( $self, $c ) = @_;
+
+ my $paste : Param;
+ my $title : Param;
+ my $type : Param;
+
+ unless ( $c->req->method eq 'POST' and $paste ) {
+ $c->res->redirect( $c->uri_for( $c->controller->action_for('root' ) ) );
+ $c->detach;
+ }
+ $c->forward('valid_types');
+
+ my $pk1;
+
+ my $create_txn = sub {
+ my $entry : Stashed = $c->model('Schema::Paste')->create( {
+ category_pk1 => $c->model('Schema::Category')
+ ->find_or_create({ label => 'General' })->pk1,
+ title => $title || 'Untitled Paste',
+ type => exists $VALID_TYPES_HASH{$type} ?
+ $type : 'Plain'
+ });
+ my $file = File::Spec->catfile(
+ $c->config->{bucket}->{path}, $entry->pk1);
+ $c->log->debug("Opening $file") if $c->debug;
+ open( my $fh, ">$file" ) or die "Unable to open $file";
+ print $fh $paste;
+ close( $fh );
+
+ $pk1 = $entry->pk1;
+
+ $c->model('IKC')->notify(
+ "Paste: $title at " .
+ $c->uri_for( $c->controller->action_for('paste'), $pk1 )
+ );
+ };
+ $c->model('Schema')->schema->txn_do( $create_txn );
+
+ if ( $pk1 ) {
+ $c->res->redirect(
+ $c->uri_for( $c->controller->action_for('paste'), $pk1 )
+ );
+ $c->detach;
+ } else {
+ my $template : Stashed = 'paste/root.tt';
+ my $error : Stashed =
+ 'Sorry, there was a problem creating your paste';
+ }
+}
+
+=head2 paste/${paste_id}
+
+Display a paste from the database. The template will take care of rendering
+a not found message (not good practice).
+
+=cut
+
+sub paste : Chained('base') PathPart('') Args(1) {
+ my ( $self, $c, $paste_id ) = @_;
+ my $paste : Stashed = $c->model('Schema::Paste')->find( int($paste_id) );
+}
+
+=head2 feed
+
+Generate the RSS feed of the last 50 pastes.
+
+=cut
+
+sub feed : Chained('base') PathPart('current.rss') Args(0) {
+ my ( $self, $c ) = @_;
+
+ my $feed = XML::Feed->new('RSS');
+ my $entries : Stashed = $c->model('Schema::Paste')->search(
+ undef, { page => 1, rows => 50 } );
+
+ $feed->title( 'CatPaste RSS Feed' );
+ $feed->link( $c->req->base );
+ $feed->description( 'Where the pastes are.' );
+
+ while ( my $entry = $entries->next ) {
+ my $feed_entry = XML::Feed::Entry->new('RSS');
+ $feed_entry->title( $entry->title );
+ $feed_entry->link(
+ $c->uri_for( $c->controller->action_for('paste'), $entry->id ) );
+ $feed_entry->issued( $entry->t_created );
+ $feed->add_entry( $feed_entry );
+ }
+
+ $c->res->content_type('application/rss+xml');
+ $c->res->body( $feed->as_xml );
+
+}
+
+=head1 PRIVATE ACTIONS
+
+=head2 valid_types
+
+Populate the stash key "types" with valid syntax highlighting types.
+
+This code would be better served out of a module that loads the information at
+startup, rather than first request.
+
+=cut
+
+sub valid_types : Private {
+ unless ( $VALID_TYPES ) {
+ my $finder = Module::Pluggable::Object->new(
+ search_path => 'Syntax::Highlight::Engine::Kate'
+ );
+ %VALID_TYPES_HASH =
+ map { s/Syntax::Highlight::Engine::Kate:://; $_ => 1 ; }
+ $finder->plugins;
+
+ $VALID_TYPES = [
+ sort { ( $WEIGHT{$b} || 1 ) <=> ( $WEIGHT{$a} || 1 ) }
+ keys %VALID_TYPES_HASH
+ ];
+ }
+ my $types : Stashed = $VALID_TYPES;
+}
+
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+J. Shirley <jshirley at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste/Model/IKC.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Model/IKC.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Model/IKC.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,55 @@
+package CatPaste::Model::IKC;
+
+use strict;
+use warnings;
+use base 'Catalyst::Model';
+
+use POE::Component::IKC::ClientLite;
+
+__PACKAGE__->mk_accessors( qw/remote/ );
+
+=head1 NAME
+
+CatPaste::Model::IKC - Catalyst Model for POE::Component::IKC communications
+
+=head1 DESCRIPTION
+
+Catalyst Model.
+
+=cut
+
+sub COMPONENT {
+ my $self = shift->NEXT::COMPONENT(@_);
+
+ die "Check configuration, requires port and channel to publish"
+ unless $self->{port} and $self->{channel};
+ my $name = $self->{name} || ref $self;
+
+ $self->remote( create_ikc_client(
+ port => $self->{port},
+ name => $self->{name} . "_$$",
+ timeout => 10
+ ) );
+ die "Couldn't create IKC client\n"
+ unless $self->remote;
+
+ return $self;
+}
+
+sub notify {
+ my ( $self, $message ) = @_;
+ $self->remote->post( $self->{channel}, $message );
+}
+
+=head1 AUTHOR
+
+J. Shirley <jshirley at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste/Model/Schema.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Model/Schema.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Model/Schema.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,33 @@
+package CatPaste::Model::Schema;
+
+use strict;
+use base 'Catalyst::Model::DBIC::Schema';
+
+__PACKAGE__->config(
+ schema_class => 'CatPaste::Schema',
+
+);
+
+=head1 NAME
+
+CatPaste::Model::Schema - Catalyst DBIC Schema Model
+=head1 SYNOPSIS
+
+See L<CatPaste>
+
+=head1 DESCRIPTION
+
+L<Catalyst::Model::DBIC::Schema> Model using schema L<CatPaste::Schema>
+
+=head1 AUTHOR
+
+A clever guy
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste/Schema/Category.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Schema/Category.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Schema/Category.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,52 @@
+package CatPaste::Schema::Category;
+
+use DBIx::Class;
+
+use base qw/DBIx::Class/;
+
+=head1 NAME
+
+CatPaste::Schema::Category - Categories of pastes
+
+=head1 DESCRIPTION
+
+A category can be any container a paste belongs into. As an example, you could
+setup categories for each IRC channel you wish to notify.
+
+Categories support passwords, so you can protect pastes in a specific category
+
+=head1 IMPORTANT
+
+This schema class is not used in version 0.01. It will be used in 0.02.
+
+=cut
+
+__PACKAGE__->load_components(qw/TimeStamp Core/);
+__PACKAGE__->table('category');
+
+__PACKAGE__->add_columns(
+ pk1 => { data_type => 'integer', size => 16, is_auto_increment => 1 },
+ label => { data_type => 'varchar', size => 255 },
+ password => { data_type => 'varchar', size => 25, is_nullable => 1 },
+);
+
+__PACKAGE__->set_primary_key('pk1');
+
+__PACKAGE__->has_many( 'pastes', 'CatPaste::Schema::Paste', 'category_pk1' );
+
+=head1 SEE ALSO
+
+L<CatPaste>, L<CatPaste::Schema::Paste>, L<Catalyst>
+
+=head1 AUTHOR
+
+J. Shirley <jshirley at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste/Schema/Paste.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Schema/Paste.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Schema/Paste.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,116 @@
+package CatPaste::Schema::Paste;
+
+use DBIx::Class;
+
+use Syntax::Highlight::Engine::Kate;
+use Syntax::Highlight::Engine::Kate::All;
+
+use base qw/DBIx::Class/;
+
+=head1 NAME
+
+CatPaste::Schema::Paste - Schema class for storing paste information
+
+=head1 DESCRIPTION
+
+The Paste schema class provides the links to the pastes as they sit on disk.
+
+This needs to be moved to
+=cut
+
+__PACKAGE__->load_components(qw/InflateColumn::File TimeStamp Core/);
+__PACKAGE__->table('paste');
+
+__PACKAGE__->add_columns(
+ pk1 => { data_type => 'integer', size => 16, is_auto_increment => 1 },
+ category_pk1 => { data_type => 'integer', size => 16 },
+ title => { data_type => 'varchar', size => 255 },
+ type => { data_type => 'varchar', size => 25 },
+ t_created => { data_type => 'datetime', set_on_create => 1 }
+);
+
+__PACKAGE__->set_primary_key('pk1');
+
+__PACKAGE__->belongs_to( 'category', 'CatPaste::Schema::Category',
+ { 'foreign.pk1' => 'self.category_pk1' } );
+
+sub contents {
+ my ( $self, $c, $no_hl ) = @_;
+ return undef unless $c;
+
+ my $file = File::Spec
+ ->catfile($c->config->{bucket}->{path}, $self->pk1 );
+ open( my $fh, $file ) or die "Unable to open $file";
+#return $data;
+ my $hl;
+ eval {
+ $hl = new Syntax::Highlight::Engine::Kate(
+ language => $self->type,
+ substitutions => {
+ "<" => "<",
+ ">" => ">",
+ "&" => "&",
+ " " => " ",
+ "\t" => " ",
+ "\n" => "<br />\n",
+ },
+ format_table => {
+ Alert => ["<span class=\"alert\">", "</span>"],
+ BaseN => ["<font color=\"#007f00\">", "</font>"],
+ BString => ["<font color=\"#c9a7ff\">", "</font>"],
+ Char => ["<span class=\"char\">", "</span>"],
+ Comment => ["<span class=\"comment\">", "</span>"],
+ DataType => ["<span class=\"datatype\">", "</span>"],
+ DecVal => ["<span class=\"#decval\">", "</span>"],
+ Error => ["<span class=\"error\">", "</span>"],
+ Float => ["<font color=\"#00007f\">", "</font>"],
+ Function => ["<span class=\"function\">", "</span>"],
+ IString => ["<span class=\"istring\">", "</span>"],
+ Keyword => ["<span class=\"keyword\">", "</span>"],
+ Normal => ["", ""],
+ Operator => ["<span class=\"operator\">", "</span>"],
+ Others => ["<span class=\"others\">", "</span>"],
+ RegionMarker => ["<span class=\"region_marker\">", "</span>"],
+ Reserved => ["<span class=\"reservedf\">", "</span>"],
+ String => ["<span class=\"string\">", "</span>"],
+ Variable => ["<span class=\"variable\">", "</span>"],
+ Warning => ["<span class=\"warning\"", "</span>"],
+ },
+ );
+ }; if ( $@ ) { $hl = undef; $no_hl = 1; }
+ my $output = '';
+ while ( my $in = <$fh> ) {
+ chomp $in;
+ $output .= ( $hl and not $no_hl ) ? $hl->highlightText( $in ) : $in;
+ }
+ close($fh);
+
+ return $output;
+}
+
+=head1 TODO
+
+=over
+
+=item Add user information, such as IP address and "Who am I?" values
+
+=item Get the categories and verification working
+
+=back
+
+=head1 SEE ALSO
+
+L<CatPaste>, L<Catalyst>
+
+=head1 AUTHOR
+
+J. Shirley <jshirley at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste/Schema.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/Schema.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/Schema.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,8 @@
+package CatPaste::Schema;
+
+use base qw/DBIx::Class::Schema/;
+
+__PACKAGE__->load_classes;
+
+1;
+
Added: trunk/examples/CatPaste/lib/CatPaste/View/TT.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste/View/TT.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste/View/TT.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,31 @@
+package CatPaste::View::TT;
+
+use strict;
+use base 'Catalyst::View::TT';
+
+__PACKAGE__->config(TEMPLATE_EXTENSION => '.tt');
+
+=head1 NAME
+
+CatPaste::View::TT - TT View for CatPaste
+
+=head1 DESCRIPTION
+
+TT View for CatPaste.
+
+=head1 AUTHOR
+
+=head1 SEE ALSO
+
+L<CatPaste>
+
+A clever guy
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/lib/CatPaste.pm
===================================================================
--- trunk/examples/CatPaste/lib/CatPaste.pm (rev 0)
+++ trunk/examples/CatPaste/lib/CatPaste.pm 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,69 @@
+package CatPaste;
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+# Set flags and add plugins for the application
+#
+# ConfigLoader: will load the configuration from a YAML file in the
+# application's home directory
+# Static::Simple: will serve static files from the application's root
+# directory
+
+use Catalyst qw/ConfigLoader Static::Simple/;
+
+our $VERSION = '0.01';
+
+# Configure the application.
+#
+# Note that settings in CatPaste.yml (or other external
+# configuration file that you set up manually) take precedence
+# over this when using ConfigLoader. Thus configuration
+# details given here can function as a default configuration,
+# with a external configuration file acting as an override for
+# local deployment.
+
+__PACKAGE__->config(
+ name => 'CatPaste',
+ 'View::TT' => {
+ WRAPPER => 'site/wrapper.tt',
+ TEMPLATE_EXTENSION => '.tt'
+ }
+);
+
+# Start the application
+__PACKAGE__->setup;
+
+
+=head1 NAME
+
+CatPaste - Catalyst based PasteBot
+
+=head1 SYNOPSIS
+
+ script/catpaste_server.pl
+
+=head1 DESCRIPTION
+
+CatPaste is a simple pastebot with L<Syntax::Highlight::Engine::Kate> support
+with future plans to support L<POE::Component::IKC> to support instant
+notification to listening programs (such as a plagger based ircbot)
+
+=head1 SEE ALSO
+
+L<CatPaste::Controller::Root>, L<Catalyst>
+
+=head1 AUTHOR
+
+J. Shirley <jshirley at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/examples/CatPaste/root/favicon.ico
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/favicon.ico
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/paste/root.tt
===================================================================
--- trunk/examples/CatPaste/root/paste/root.tt (rev 0)
+++ trunk/examples/CatPaste/root/paste/root.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,23 @@
+<form method="post" action="[% c.uri_for( c.controller('Root').action_for('post') ) %]">
+<fieldset class="paste">
+ <legend>Paste It</legend>
+ <div>
+ <label for="title">Title: </label>
+ <input type="text" id="title" name="title" size="40"/>
+ </div>
+ <div>
+ <label for="type">Language:</label>
+ <select name="type">
+ [%- FOREACH type IN types %]
+ <option value="[% type %]">[% type %]</option>
+ [%- END %]
+ </select>
+ </div>
+ <div>
+ <textarea name="paste" rows="20" cols="80"></textarea>
+ </div>
+ <p>
+ <input type="submit" value="Paste"/>
+ </p>
+</fieldset>
+</form>
Added: trunk/examples/CatPaste/root/paste/view.tt
===================================================================
--- trunk/examples/CatPaste/root/paste/view.tt (rev 0)
+++ trunk/examples/CatPaste/root/paste/view.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,5 @@
+[% page.stylesheets.push('kate.css') %]
+<h2>[% paste.title %] ([% paste.type %])</h2>
+<div class="contents">
+ <pre>[% paste.contents(c, c.req.params.no_highlight) %]</pre>
+</div>
Added: trunk/examples/CatPaste/root/paste.tt
===================================================================
--- trunk/examples/CatPaste/root/paste.tt (rev 0)
+++ trunk/examples/CatPaste/root/paste.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,6 @@
+[%~
+IF paste;
+ PROCESS "paste/view.tt";
+ELSE %]
+ <h3 class="error">Sorry, we could not find the paste requested.</h3>
+[% END %]
Added: trunk/examples/CatPaste/root/root.tt
===================================================================
--- trunk/examples/CatPaste/root/root.tt (rev 0)
+++ trunk/examples/CatPaste/root/root.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,11 @@
+[%
+
+page.links.push({
+ href => c.uri_for( c.controller('Root').action_for('feed') ),
+ rel => "alternate",
+ title => "RSS Feed",
+ type => "application/rss+xml"
+});
+
+PROCESS "paste/root.tt"
+%]
Added: trunk/examples/CatPaste/root/site/layouts/default/footer.tt
===================================================================
--- trunk/examples/CatPaste/root/site/layouts/default/footer.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/layouts/default/footer.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,7 @@
+<div id="footer">
+ <p>CatPaste [% c.VERSION %]</p>
+ <a href="http://www.catalystframework.org">
+ <img src="[% static('images/btn_88x31_powered_shadow.png') %]"
+ alt="Powered by Catalyst" title="Powered by Catalyst"/>
+ </a>
+</div>
Added: trunk/examples/CatPaste/root/site/layouts/default/header.tt
===================================================================
--- trunk/examples/CatPaste/root/site/layouts/default/header.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/layouts/default/header.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,7 @@
+<div id="header">
+ <h1>CatPaste</h1>
+ <a href="[% c.uri_for( c.controller('Root').action_for('root') ) %]">
+ New Paste
+ </a>
+</div>
+
Added: trunk/examples/CatPaste/root/site/layouts/default.tt
===================================================================
--- trunk/examples/CatPaste/root/site/layouts/default.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/layouts/default.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,6 @@
+[%
+PROCESS "site/layouts/${layout.header}/header.tt";
+content;
+PROCESS "site/layouts/${layout.footer}/footer.tt"
+%]
+
Added: trunk/examples/CatPaste/root/site/shared/macros.tt
===================================================================
--- trunk/examples/CatPaste/root/site/shared/macros.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/shared/macros.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,17 @@
+[%
+
+page.stylesheets.push('screen.css');
+
+MACRO static(res, versioned, query) BLOCK;
+ uri_params = query || {};
+ IF res.match('^http');
+ res;
+ ELSIF versioned && ( uri_params.ver || c.config.static_build );
+ uri_params.ver = uri_params.ver || c.config.static_build;
+ c.uri_for( c.config.static_path || '/', res, uri_params );
+ ELSE;
+ c.uri_for( c.config.static_path || '/', res );
+ END;
+END;
+
+%]
Added: trunk/examples/CatPaste/root/site/wrapper.tt
===================================================================
--- trunk/examples/CatPaste/root/site/wrapper.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/wrapper.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,20 @@
+[%-
+# Load common macros
+PROCESS site/shared/macros.tt;
+
+# Process the appropriate layout
+IF partial_render != 1 && template.name.match('.tt');
+ DEFAULT site.layout = 'default'
+ layout.header = 'default'
+ layout.footer = 'default';
+
+ IF layout == 0;
+ content WRAPPER site/xhtml.tt;
+ ELSE;
+ content WRAPPER site/xhtml.tt + "site/layouts/${site.layout}.tt";
+ END;
+ELSE;
+ content;
+END;
+-%]
+
Added: trunk/examples/CatPaste/root/site/xhtml.tt
===================================================================
--- trunk/examples/CatPaste/root/site/xhtml.tt (rev 0)
+++ trunk/examples/CatPaste/root/site/xhtml.tt 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,50 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+ <head>
+ <title>[% page.title || page.caption || "CatPaste" %]</title>
+ <meta http-equiv="Content-Language" content="en" />
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+[%
+# Add all page.links
+FOREACH link IN page.links;
+ NEXT UNLESS link.href %]
+ <link rel="[% link.rel || 'alternate' %]"
+ [%- IF link.type %] type="[% link.type %]"[% END -%]
+ [%- IF link.title %] title="[% link.title %]"[% END -%]
+ href="[% link.href %]" />[%-
+END;
+
+# Add all stylesheet refs in page.stylesheets
+page.stylesheets = page.stylesheets.unique;
+
+FOREACH stylesheet IN page.stylesheets;
+ NEXT UNLESS stylesheet;
+ stylesheet = stylesheet.match('^http') ?
+ stylesheet :
+ static('css/' _ stylesheet, 1); %]
+ <link rel="stylesheet" href="[% stylesheet %]" media="screen"/>[%
+END;
+
+# Add all javascript refs in page.scripts
+page.scripts = page.scripts.unique;
+FOREACH script IN page.scripts;
+ script = script.match('^http') ? script : static('scripts/' _ script, 1); %]
+ <script type="text/javascript" src="[% script %]"></script>[%
+END; %]
+ </head>
+ <!--[if !IE]> <-->
+ <body>
+ <!--><![endif]-->
+ <!--[if IE 5]>
+ <body class="IE IE5">
+ <![endif]-->
+ <!--[if IE 6]>
+ <body class="IE IE6">
+ <![endif]-->
+ <!--[if IE 7]>
+ <body class="IE IE7">
+ <![endif]-->
+ [% content %]
+ </body>
+</html>
+
Added: trunk/examples/CatPaste/root/static/css/kate.css
===================================================================
--- trunk/examples/CatPaste/root/static/css/kate.css (rev 0)
+++ trunk/examples/CatPaste/root/static/css/kate.css 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,17 @@
+span.string { color: #f00; }
+span.variable { color: #00f; font-weight: bold; }
+span.operator { color: #ffa500; }
+span.warning { color: #00f; font-weight: bold; font-style: italic; }
+span.error { color: #f00; font-weight: bold; font-style: italic; }
+span.reserved { color: #9b30ff; font-weight: bold; }
+span.region_marker { color: #96b9ff; font-style: italic; }
+span.keyword { font-weight: bold; }
+span.char { color: #f0f; }
+span.comment { color: #7f7f7f; font-style: italic; }
+span.datatype { color: #00f; }
+span.decval { color: #00007f; }
+span.function { color: #007f00; }
+span.istring { color: #f00; }
+span.others { color: #b03060; }
+span.alert { color: #00f; }
+
Added: trunk/examples/CatPaste/root/static/css/screen.css
===================================================================
--- trunk/examples/CatPaste/root/static/css/screen.css (rev 0)
+++ trunk/examples/CatPaste/root/static/css/screen.css 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,14 @@
+body {
+ font-family: "Lucida Grande", Verdana, Arial, sans serif;
+}
+
+img { border: none; }
+
+#footer {
+ font-size: 72.5%;
+ text-align: center;
+ color: #777;
+}
+
+.paste div label { display: block; padding-top: 10px; }
+.paste textarea { margin: 1em 0; }
Added: trunk/examples/CatPaste/root/static/images/btn_120x50_built.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_120x50_built.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_120x50_built_shadow.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_120x50_built_shadow.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_120x50_powered.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_120x50_powered.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_120x50_powered_shadow.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_120x50_powered_shadow.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_88x31_built.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_88x31_built.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_88x31_built_shadow.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_88x31_built_shadow.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_88x31_powered.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_88x31_powered.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/btn_88x31_powered_shadow.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/btn_88x31_powered_shadow.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/root/static/images/catalyst_logo.png
===================================================================
(Binary files differ)
Property changes on: trunk/examples/CatPaste/root/static/images/catalyst_logo.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/examples/CatPaste/script/catpaste_cgi.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_cgi.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_cgi.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -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 CatPaste;
+
+CatPaste->run;
+
+1;
+
+=head1 NAME
+
+catpaste_cgi.pl - Catalyst CGI
+
+=head1 SYNOPSIS
+
+See L<Catalyst::Manual>
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as a cgi script.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+
+=head1 COPYRIGHT
+
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Property changes on: trunk/examples/CatPaste/script/catpaste_cgi.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/script/catpaste_create.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_create.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_create.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -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( 'CatPaste', @ARGV );
+
+1;
+
+=head1 NAME
+
+catpaste_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+catpaste_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:
+ catpaste_create.pl controller My::Controller
+ catpaste_create.pl -mechanize controller My::Controller
+ catpaste_create.pl view My::View
+ catpaste_create.pl view MyView TT
+ catpaste_create.pl view TT TT
+ catpaste_create.pl model My::Model
+ catpaste_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+ dbi:SQLite:/tmp/my.db
+ catpaste_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<sri at oook.de>
+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
Property changes on: trunk/examples/CatPaste/script/catpaste_create.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/script/catpaste_fastcgi.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_fastcgi.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_fastcgi.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,80 @@
+#!/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 CatPaste;
+
+my $help = 0;
+my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
+
+GetOptions(
+ 'help|?' => \$help,
+ 'listen|l=s' => \$listen,
+ 'nproc|n=i' => \$nproc,
+ 'pidfile|p=s' => \$pidfile,
+ 'manager|M=s' => \$manager,
+ 'daemon|d' => \$detach,
+ 'keeperr|e' => \$keep_stderr,
+);
+
+pod2usage(1) if $help;
+
+CatPaste->run(
+ $listen,
+ { nproc => $nproc,
+ pidfile => $pidfile,
+ manager => $manager,
+ detach => $detach,
+ keep_stderr => $keep_stderr,
+ }
+);
+
+1;
+
+=head1 NAME
+
+catpaste_fastcgi.pl - Catalyst FastCGI
+
+=head1 SYNOPSIS
+
+catpaste_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
+ -e -keeperr send error messages to STDOUT, not
+ to the webserver
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as fastcgi.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+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
Property changes on: trunk/examples/CatPaste/script/catpaste_fastcgi.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/script/catpaste_server.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_server.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_server.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ $ENV{CATALYST_SCRIPT_GEN} = 30;
+ require Catalyst::Engine::HTTP;
+}
+
+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 CatPaste;
+
+CatPaste->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
+
+catpaste_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+catpaste_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<sri at oook.de>
+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
Property changes on: trunk/examples/CatPaste/script/catpaste_server.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/script/catpaste_spawn_db.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_spawn_db.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_spawn_db.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,120 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use DateTime;
+use Getopt::Long;
+use Pod::Usage;
+use Path::Class;
+use Config::Any;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use CatPaste::Schema;
+use YAML;
+use Digest;
+use Sys::Hostname;
+
+my @databases = [ qw/ MySQL SQLite PostgreSQL Oracle XML YAML / ];
+my $help = 0;
+my $bin = dir($FindBin::Bin);
+
+my $hostname = hostname;
+my $conf = 'catpaste.yml';
+if ( $ENV{CATALYST_DEBUG} and -f 'catpaste_local.yml' ) {
+ $conf = 'catpaste_local.yml'
+}
+
+my $config = YAML::LoadFile(file($bin->parent, $conf));
+my $deploy = 0;
+my $create_ddl_dir = 0;
+my $attrs = { add_drop_table => 0, no_comments => 1 };
+my $type = '';
+
+my ($user, $pass, $dsn);
+GetOptions('help|?' => \$help,
+ 'dsn=s' => \$dsn,
+ 'user=s' => \$user,
+ 'pass=s' => \$pass,
+ 'deploy' => \$deploy,
+ 'create_ddl_dir' => \$create_ddl_dir,
+ );
+
+pod2usage(1) if ($help);
+
+my $config_dsn;
+eval {
+ ($config_dsn, $user, $pass) =
+ @{$config->{'Model::Schema'}->{'connect_info'}};
+};
+if ($@ ){
+ die "Your DSN line in catpaste.yml doesn't look like a valid DSN."
+}
+$dsn = $config_dsn if(!$dsn);
+die "No valid Data Source Name (DSN).\n" if !$dsn;
+
+($type) = ($dsn =~ m/:(.+?):/);
+$type = 'MySQL' if $type eq 'mysql';
+
+$dsn =~ s/__HOME__/$FindBin::Bin\/\.\./g;
+
+my $db = CatPaste::Schema->connect($dsn, $user, $pass, $attrs);
+if ($create_ddl_dir) {
+ print $db->storage->create_ddl_dir($db, @databases, '0.1',
+ "$FindBin::Bin/../db/", $attrs);
+}
+else {
+ print "Connecting to $dsn\n";
+ print " User: $user\n" if $user;
+ print " Password: ********\n" if $pass;
+ $db->storage->ensure_connected;
+ $db->deploy( $attrs );
+
+ my @people = $db->populate('Category', [
+ [ qw/label password/ ],
+ [ 'General', undef ],
+ [ 'PT', 'ptftw!' ],
+ ]);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+catpaste_spawn_db.pl - prodcues the sql statements needed to create a
+MailRoller database
+
+=head1 SYNOPSIS
+
+catpaste_spawndb.pl [options]
+
+ Options:
+ -help Display this help and exit
+ -create_ddl_dir Create SQL files for common databases in /db.
+ Requires SQL::Translator installed.
+ Example:
+ catpaste_spawndb.pl
+
+ See also:
+ perldoc CatPAste
+
+=head1 SEE ALSO
+
+L<CatPaste>
+
+=head1 Cargo Culter (MAINTAINER)
+
+J. Shirley <jshirley at gmail.com>
+
+=head2 ORIGINAL AUTHOR
+
+K. J. Cheetham <jamie at shadowcatsystems.co.uk>
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
Property changes on: trunk/examples/CatPaste/script/catpaste_spawn_db.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/script/catpaste_test.pl
===================================================================
--- trunk/examples/CatPaste/script/catpaste_test.pl (rev 0)
+++ trunk/examples/CatPaste/script/catpaste_test.pl 2007-08-08 00:39:14 UTC (rev 6625)
@@ -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 'CatPaste';
+
+my $help = 0;
+
+GetOptions( 'help|?' => \$help );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+print request($ARGV[0])->content . "\n";
+
+1;
+
+=head1 NAME
+
+catpaste_test.pl - Catalyst Test
+
+=head1 SYNOPSIS
+
+catpaste_test.pl [options] uri
+
+ Options:
+ -help display this help and exits
+
+ Examples:
+ catpaste_test.pl http://localhost/some_action
+ catpaste_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<sri at oook.de>
+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
Property changes on: trunk/examples/CatPaste/script/catpaste_test.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/examples/CatPaste/t/01app.t
===================================================================
--- trunk/examples/CatPaste/t/01app.t (rev 0)
+++ trunk/examples/CatPaste/t/01app.t 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+BEGIN { use_ok 'Catalyst::Test', 'CatPaste' }
+
+ok( request('/')->is_success, 'Request should succeed' );
Added: trunk/examples/CatPaste/t/02pod.t
===================================================================
--- trunk/examples/CatPaste/t/02pod.t (rev 0)
+++ trunk/examples/CatPaste/t/02pod.t 2007-08-08 00:39:14 UTC (rev 6625)
@@ -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();
Added: trunk/examples/CatPaste/t/03podcoverage.t
===================================================================
--- trunk/examples/CatPaste/t/03podcoverage.t (rev 0)
+++ trunk/examples/CatPaste/t/03podcoverage.t 2007-08-08 00:39:14 UTC (rev 6625)
@@ -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();
Added: trunk/examples/CatPaste/t/model_Schema.t
===================================================================
--- trunk/examples/CatPaste/t/model_Schema.t (rev 0)
+++ trunk/examples/CatPaste/t/model_Schema.t 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,6 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'CatPaste::Model::Schema' }
+
Added: trunk/examples/CatPaste/t/view_TT.t
===================================================================
--- trunk/examples/CatPaste/t/view_TT.t (rev 0)
+++ trunk/examples/CatPaste/t/view_TT.t 2007-08-08 00:39:14 UTC (rev 6625)
@@ -0,0 +1,6 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'CatPaste::View::TT' }
+
More information about the Catalyst-commits
mailing list