[Catalyst-commits] r12322 - in trunk/examples/SmallBoard: lib
lib/DBIx lib/DBIx/Class lib/DBIx/Class/Tree
lib/DBIx/Class/Tree/Ordered lib/SmallBoard
lib/SmallBoard/Schema lib/SmallBoard/Schema/Result
lib/SmallBoard/Script lib/SmallBoard/View script
dhoss at dev.catalyst.perl.org
dhoss at dev.catalyst.perl.org
Sun Dec 13 00:20:09 GMT 2009
Author: dhoss
Date: 2009-12-13 00:20:09 +0000 (Sun, 13 Dec 2009)
New Revision: 12322
Added:
trunk/examples/SmallBoard/lib/DBIx/
trunk/examples/SmallBoard/lib/DBIx/Class/
trunk/examples/SmallBoard/lib/DBIx/Class/Tree/
trunk/examples/SmallBoard/lib/DBIx/Class/Tree/Ordered/
trunk/examples/SmallBoard/lib/DBIx/Class/Tree/Ordered/MatPath.pm
trunk/examples/SmallBoard/lib/SmallBoard/Schema/
trunk/examples/SmallBoard/lib/SmallBoard/Schema/Result/
trunk/examples/SmallBoard/lib/SmallBoard/Schema/Result/Board.pm
trunk/examples/SmallBoard/lib/SmallBoard/Schema/ResultSet/
trunk/examples/SmallBoard/lib/SmallBoard/Script/
trunk/examples/SmallBoard/lib/SmallBoard/Script/Deploy.pm
trunk/examples/SmallBoard/script/smallboard_deploy.pl
Modified:
trunk/examples/SmallBoard/lib/SmallBoard/Schema.pm
trunk/examples/SmallBoard/lib/SmallBoard/View/TT.pm
Log:
Added matpath stuff, added custom deploy script
Added: trunk/examples/SmallBoard/lib/DBIx/Class/Tree/Ordered/MatPath.pm
===================================================================
--- trunk/examples/SmallBoard/lib/DBIx/Class/Tree/Ordered/MatPath.pm (rev 0)
+++ trunk/examples/SmallBoard/lib/DBIx/Class/Tree/Ordered/MatPath.pm 2009-12-13 00:20:09 UTC (rev 12322)
@@ -0,0 +1,153 @@
+package DBIx::Class::Tree::Ordered::MatPath;
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Ordered/;
+
+sub parent_column { shift->grouping_column (@_) }
+sub path_column { shift->position_column (@_) }
+
+__PACKAGE__->mk_classdata ('escaped_separator');
+__PACKAGE__->mk_classdata (path_separator => '.');
+sub set_inherited {
+ my $self = shift;
+ $self->escaped_separator (defined $_[1] ? quotemeta($_[1]) : undef)
+ if ($_[0] eq 'path_separator');
+ $self->next::method (@_);
+}
+
+sub all_parents {
+ my $self = shift;
+
+ my $path_col = $self->path_column;
+ my $sep = $self->path_separator;
+ my $esep = $self->escaped_separator;
+
+ my @path_parts = split (/$esep/, $self->get_column($path_col));
+
+ pop @path_parts; # don't need ourselves
+ for my $i (1 .. $#path_parts) {
+ $path_parts[$i] = join ($sep, @path_parts[$i-1, $i]);
+ }
+ return $self->result_source->resultset->search({
+ $path_col => { -in => \@path_parts },
+ });
+}
+
+sub all_children {
+ my $self = shift;
+
+ my $path_col = $self->path_column;
+ my $sep = $self->path_separator;
+
+ return $self->result_source->resultset->search({
+ $path_col => { -like => join ($sep, $self->get_column($path_col),'%') },
+ });
+}
+
+sub get_parent {
+ my $self = shift;
+ my $pcol = $self->parent_column;
+ return $self->result_source->resultset->find(
+ $self->get_column ($pcol)
+ );
+}
+
+sub _position_from_value {
+ my ($self, $val) = @_;
+
+ my $esep = $self->escaped_separator;
+ return (split /$esep/, $val)[-1];
+}
+
+sub _position_value {
+ my ($self, $pos) = @_;
+
+ my $p = $self->get_parent
+ or return $pos;
+
+ return join ($self->path_separator, $p->get_column($p->path_column), $pos);
+}
+
+sub _initial_position_value {
+ my $self = shift;
+ return $self->next::method (@_) if @_;
+
+ my $init = $self->next::method;
+
+ my $p = $self->get_parent
+ or return $init;
+
+ return join ($p->path_separator, $p->get_column($p->path_column), $init );
+}
+
+sub _next_position_value {
+ my ($self, $val) = @_;
+
+ my $sep = $self->path_separator;
+ my $esep = $self->escaped_separator;
+ my @parts = split (/$esep/, $val);
+ $parts[-1]++;
+ return join ($sep, @parts);
+}
+
+sub _shift_siblings {
+ my ($self, $direction, @between) = @_;
+ return 0 unless $direction;
+
+ my $path_column = $self->path_column;
+ my $sep = $self->path_separator;
+ my $esep = $self->escaped_separator;
+
+ my ($shift, $ord);
+ if ($direction < 0) {
+ $shift = -1;
+ $ord = 'asc';
+ }
+ else {
+ $shift = 1;
+ $ord = 'desc';
+ }
+
+ my $shift_rs = $self->_group_rs->search ({ $path_column => { -between => \@between } });
+
+ for my $sibling ($shift_rs->search ({}, { order_by => { "-$ord", $path_column }})->all ) {
+ my $old_pos = $sibling->get_column($path_column);
+
+ my @parts = split (/$esep/, $old_pos);
+ $parts[-1] += $shift;
+ my $new_pos = join ($sep, @parts);
+
+ $sibling->_ordered_internal_update ({$path_column => $new_pos });
+
+ # re-number children too
+ my $children = $self->result_source->resultset->search ({$path_column => { -like => "$old_pos$sep%" } });
+ for my $child ($children->all) {
+ my $cpath = $child->get_column($path_column);
+ $cpath =~ s/^$old_pos/$new_pos/;
+ $child->_ordered_internal_update ({$path_column => $cpath });
+ }
+ }
+}
+
+## direct children:
+## all_children->search (... -not_like => 'path $sep % $sep %
+sub get_direct_children {
+ my $self = shift;
+
+ my $path_col = $self->path_column;
+ my $sep = $self->path_separator;
+
+ return $self->all_children->search (
+ $path_col => { -not_like =>
+ join ($sep, $self->get_column ($path_col), '%', '%') } );
+}
+
+sub get_immediate_child {
+ my $self = shift;
+
+ return $self->get_direct_children->first;
+}
+
+1;
\ No newline at end of file
Added: trunk/examples/SmallBoard/lib/SmallBoard/Schema/Result/Board.pm
===================================================================
--- trunk/examples/SmallBoard/lib/SmallBoard/Schema/Result/Board.pm (rev 0)
+++ trunk/examples/SmallBoard/lib/SmallBoard/Schema/Result/Board.pm 2009-12-13 00:20:09 UTC (rev 12322)
@@ -0,0 +1,19 @@
+package SmallBoard::Schema::Result::Board;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/ Tree::Ordered::MatPath Core /);
+__PACKAGE__->table ('nested');
+__PACKAGE__->add_columns (
+ id => { data_type => 'int', is_auto_increment => 1 },
+ name => { data_type => 'varchar' },
+ parent_id => { data_type => 'int', is_nullable => 1 },
+ path => { data_type => 'varchar' },
+);
+
+__PACKAGE__->set_primary_key ('id');
+
+__PACKAGE__->has_many ('children', __PACKAGE__, 'parent_id');
+__PACKAGE__->belongs_to ('parent', __PACKAGE__, 'parent_id');
+
+__PACKAGE__->position_column ('path');
+__PACKAGE__->grouping_column ('parent_id');
+1;
Modified: trunk/examples/SmallBoard/lib/SmallBoard/Schema.pm
===================================================================
--- trunk/examples/SmallBoard/lib/SmallBoard/Schema.pm 2009-12-12 23:53:00 UTC (rev 12321)
+++ trunk/examples/SmallBoard/lib/SmallBoard/Schema.pm 2009-12-13 00:20:09 UTC (rev 12322)
@@ -1,16 +1,5 @@
package SmallBoard::Schema;
-
-use strict;
-use warnings;
-
-use base 'DBIx::Class::Schema';
-
+use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_namespaces;
-
-# Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-12 16:47:33
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:JRtZFZLpIpAFZ8r+EwgYCQ
-
-
-# You can replace this text with custom content, and it will be preserved on regeneration
1;
Added: trunk/examples/SmallBoard/lib/SmallBoard/Script/Deploy.pm
===================================================================
--- trunk/examples/SmallBoard/lib/SmallBoard/Script/Deploy.pm (rev 0)
+++ trunk/examples/SmallBoard/lib/SmallBoard/Script/Deploy.pm 2009-12-13 00:20:09 UTC (rev 12322)
@@ -0,0 +1,47 @@
+package SmallBoard::Script::Deploy;
+
+use Moose;
+use MooseX::Types::Moose qw/Str/;
+use namespace::autoclean;
+with 'Catalyst::ScriptRole';
+extends 'SmallBoard::Schema';
+has dsn => (
+ traits => [qw(Getopt)],
+ isa => Str,
+ is => 'ro',
+ documentation => "dsn for your database"
+);
+
+has user => (
+ traits => [qw(Getopt)],
+ isa => Str,
+ is => 'ro',
+ documentation => "username for your database",
+);
+
+has password => (
+ traits => [qw(Getopt)],
+ isa => Str,
+ is => 'ro',
+ documentation => "password for your database",
+
+);
+
+has schema => (
+ traits => [qw(NoGetopt)],
+ isa => "SmallBoard::Schema",
+ is => "ro",
+ default => sub { my $self = shift; $self->connect($self->dsn, $self->user, $self->password); },
+);
+
+sub run {
+ my $self = shift;
+ $self->_getopt_full_usage if !$self->ARGV->[0];
+
+ $self->schema->deploy or die "Can't deploy: $!";
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
Modified: trunk/examples/SmallBoard/lib/SmallBoard/View/TT.pm
===================================================================
--- trunk/examples/SmallBoard/lib/SmallBoard/View/TT.pm 2009-12-12 23:53:00 UTC (rev 12321)
+++ trunk/examples/SmallBoard/lib/SmallBoard/View/TT.pm 2009-12-13 00:20:09 UTC (rev 12322)
@@ -5,7 +5,10 @@
use base 'Catalyst::View::TT';
-__PACKAGE__->config(TEMPLATE_EXTENSION => '.tt');
+__PACKAGE__->config(
+ TEMPLATE_EXTENSION => '.tt2',
+ WRAPPER => 'root/wrapper',
+);
=head1 NAME
Added: trunk/examples/SmallBoard/script/smallboard_deploy.pl
===================================================================
--- trunk/examples/SmallBoard/script/smallboard_deploy.pl (rev 0)
+++ trunk/examples/SmallBoard/script/smallboard_deploy.pl 2009-12-13 00:20:09 UTC (rev 12322)
@@ -0,0 +1,6 @@
+#!/usr/bin/env perl
+
+use Catalyst::ScriptRunner;
+Catalyst::ScriptRunner->run('SmallBoard', 'Deploy');
+
+1;
More information about the Catalyst-commits
mailing list