r71079 - in /trunk/libdbix-class-candy-perl: ./ debian/ lib/DBIx/Class/ lib/DBIx/Class/Candy/ t/ t/lib/A/Schema/ t/lib/A/Schema/Result/ t/lib/IRC/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Mar 11 00:41:27 UTC 2011


Author: jawnsy-guest
Date: Fri Mar 11 00:41:07 2011
New Revision: 71079

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71079
Log:
builds clean, looks good

Added:
    trunk/libdbix-class-candy-perl/t/irc-schema.t
      - copied unchanged from r71075, branches/upstream/libdbix-class-candy-perl/current/t/irc-schema.t
    trunk/libdbix-class-candy-perl/t/lib/A/Schema/Candy.pm
      - copied unchanged from r71075, branches/upstream/libdbix-class-candy-perl/current/t/lib/A/Schema/Candy.pm
    trunk/libdbix-class-candy-perl/t/lib/IRC/
      - copied from r71075, branches/upstream/libdbix-class-candy-perl/current/t/lib/IRC/
Modified:
    trunk/libdbix-class-candy-perl/Changes
    trunk/libdbix-class-candy-perl/MANIFEST
    trunk/libdbix-class-candy-perl/META.json
    trunk/libdbix-class-candy-perl/Makefile.PL
    trunk/libdbix-class-candy-perl/README
    trunk/libdbix-class-candy-perl/debian/changelog
    trunk/libdbix-class-candy-perl/debian/control
    trunk/libdbix-class-candy-perl/dist.ini
    trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy.pm
    trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy/Exports.pm
    trunk/libdbix-class-candy-perl/t/imports.t
    trunk/libdbix-class-candy-perl/t/lib/A/Schema/Result/Artist.pm

Modified: trunk/libdbix-class-candy-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/Changes?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/Changes (original)
+++ trunk/libdbix-class-candy-perl/Changes Fri Mar 11 00:41:07 2011
@@ -1,4 +1,10 @@
 Revision history for DBIx-Class-Candy
+
+0.002000  2011-03-09 12:03:50 CST6CDT
+  - Add unique_column sugar
+  - Allow Candy to automatically set table name
+  - Allow Candy subclass to define default base and default perl version
+  - Add missing docs for primary_column sugar
 
 0.001006  2011-03-01 22:44:45 CST6CDT
   - Add primary_column sugar

Modified: trunk/libdbix-class-candy-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/MANIFEST?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/MANIFEST (original)
+++ trunk/libdbix-class-candy-perl/MANIFEST Fri Mar 11 00:41:07 2011
@@ -8,11 +8,22 @@
 lib/DBIx/Class/Candy.pm
 lib/DBIx/Class/Candy/Exports.pm
 t/imports.t
+t/irc-schema.t
 t/lib/A/Component.pm
 t/lib/A/Schema.pm
+t/lib/A/Schema/Candy.pm
 t/lib/A/Schema/Result.pm
 t/lib/A/Schema/Result/Album.pm
 t/lib/A/Schema/Result/Artist.pm
 t/lib/A/Schema/Result/Song.pm
+t/lib/IRC/Schema.pm
+t/lib/IRC/Schema/Candy.pm
+t/lib/IRC/Schema/Result.pm
+t/lib/IRC/Schema/Result/Channel.pm
+t/lib/IRC/Schema/Result/Message.pm
+t/lib/IRC/Schema/Result/Mode.pm
+t/lib/IRC/Schema/Result/Network.pm
+t/lib/IRC/Schema/Result/User.pm
+t/lib/IRC/Schema/ResultSet.pm
 t/release-pod-coverage.t
 t/release-pod-syntax.t

Modified: trunk/libdbix-class-candy-perl/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/META.json?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/META.json (original)
+++ trunk/libdbix-class-candy-perl/META.json Fri Mar 11 00:41:07 2011
@@ -22,8 +22,11 @@
       "runtime" : {
          "requires" : {
             "DBIx::Class" : "0.08123",
+            "Lingua::EN::Inflect" : 0,
             "MRO::Compat" : "0.11",
+            "String::CamelCase" : 0,
             "Sub::Exporter" : "0.982",
+            "Test::Deep" : 0,
             "Test::More" : "0.94",
             "namespace::clean" : "0.18"
          }
@@ -37,6 +40,6 @@
          "web" : "http://github.com/frioux/DBIx-Class-Candy"
       }
    },
-   "version" : "0.001006"
+   "version" : "0.002000"
 }
 

Modified: trunk/libdbix-class-candy-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/Makefile.PL?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/Makefile.PL (original)
+++ trunk/libdbix-class-candy-perl/Makefile.PL Fri Mar 11 00:41:07 2011
@@ -21,12 +21,15 @@
   'NAME' => 'DBIx::Class::Candy',
   'PREREQ_PM' => {
     'DBIx::Class' => '0.08123',
+    'Lingua::EN::Inflect' => '0',
     'MRO::Compat' => '0.11',
+    'String::CamelCase' => '0',
     'Sub::Exporter' => '0.982',
+    'Test::Deep' => '0',
     'Test::More' => '0.94',
     'namespace::clean' => '0.18'
   },
-  'VERSION' => '0.001006',
+  'VERSION' => '0.002000',
   'test' => {
     'TESTS' => 't/*.t'
   }

Modified: trunk/libdbix-class-candy-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/README?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/README (original)
+++ trunk/libdbix-class-candy-perl/README Fri Mar 11 00:41:07 2011
@@ -2,16 +2,14 @@
     DBIx::Class::Candy - Sugar for your favorite ORM, DBIx::Class
 
 VERSION
-    version 0.001006
+    version 0.002000
 
 SYNOPSIS
      package MyApp::Schema::Result::Artist;
 
-     use DBIx::Class::Candy;
-
-     table 'artists';
-
-     column id => {
+     use DBIx::Class::Candy -autotable => v1;
+
+     primary_column id => {
        data_type => 'int',
        is_auto_increment => 1,
      };
@@ -21,8 +19,6 @@
        size => 25,
        is_nullable => 1,
      };
-
-     primary_key 'id';
 
      has_many albums => 'A::Schema::Result::Album', 'artist_id';
 
@@ -57,12 +53,22 @@
     removed.
 
 IMPORT OPTIONS
+    See "SETTING DEFAULT IMPORT OPTIONS" for information on setting these
+    schema wide.
+
   -base
      use DBIx::Class::Candy -base => 'MyApp::Schema::Result';
 
     The first thing you can do to customize your usage of
     "DBIx::Class::Candy" is change the parent class. Do that by using the
     "-base" import option.
+
+  -autotable
+     use DBIx::Class::Candy -autotable => v1;
+
+    Don't waste your precious keystrokes typing "table 'buildings'", let
+    "DBIx::Class::Candy" do that for you! See "AUTOTABLE VERSIONS" for what
+    the existing versions will generate for you.
 
   -components
      use DBIx::Class::Candy -components => ['FilterColumn'];
@@ -114,10 +120,41 @@
      unique_constraint => 'add_unique_constraint',
      relationship      => 'add_relationship',
 
+SETTING DEFAULT IMPORT OPTIONS
+    Eventually you will get tired of writing the following in every single
+    one of your results:
+
+     use DBIx::Class::Candy
+       -base      => 'MyApp::Schema::Result',
+       -perl5     => v12,
+       -autotable => v1;
+
+    You can set all of these for your whole schema if you define your own
+    "Candy" subclass as follows:
+
+     package MyApp::Schema::Candy;
+
+     use base 'DBIx::Class::Candy';
+
+     sub base { $_[1] || 'MyApp::Schema::Result' }
+     sub perl_version { 12 }
+     sub autotable { 1 }
+
+    Note the "$_[1] ||" in "base". All of these methods are passed the
+    values passed in from the arguments to the subclass, so you can either
+    throw them away, honor them, die on usage, or whatever. To be clear, if
+    you define your subclass, and someone uses it as follows:
+
+     use MyApp::Schema::Candy -base => 'Moose', -perl5 => v30, -autotable => v3;
+
+    Your "base" method will get "Moose", your "perl_version" will get 30,
+    and your "autotable" will get 3.
+
 SECONDARY API
-    Lastly, there is currently a single "transformer" for "add_columns", so
-    that people used to the Moose api will feel more at home. Note that this
-    may go into a "Candy Component" at some point.
+  has_column
+    There is currently a single "transformer" for "add_columns", so that
+    people used to the Moose api will feel more at home. Note that this may
+    go into a "Candy Component" at some point.
 
     Example usage:
 
@@ -127,6 +164,62 @@
        is_nullable => 1,
      );
 
+  primary_column
+    Another handy little feature that allows you to define a column and set
+    it as the primary key in a single call:
+
+     primary_column id => {
+       data_type => 'int',
+       is_auto_increment => 1,
+     };
+
+  unique_column
+    This allows you to define a column and set it as unique in a single
+    call:
+
+     unique_column name => {
+       data_type => 'varchar',
+       size => 30,
+     };
+
+AUTOTABLE VERSIONS
+    Currently there is a single version, "v1", which looks at your class
+    name, grabs everything after "::Schema::Result::", removes the "::"'s,
+    converts it to underscores instead of camel-case, and pluralizes it.
+    Here are some examples if that's not clear:
+
+     MyApp::Schema::Result::Cat -> cats
+     MyApp::Schema::Result::Software::Buidling -> software_buildings
+     MyApp::Schema::Result::LonelyPerson -> lonely_people
+
+    Also, if you just want to be different, you can easily set up your own
+    naming scheme. Just add a "gen_table" method to your candy subclass. The
+    method gets passed the class name and the autotable version, which of
+    course you may ignore. For example, one might just do the following:
+
+     sub gen_table {
+       my ($self, $class) = @_;
+
+       $class =~ s/::/_/g;
+       lc $class;
+     }
+
+    Which would tranform "MyApp::Schema::Result::Foo" into
+    "myapp_schema_result_foo".
+
+    Or maybe instead of using the standard "MyApp::Schema::Result" namespace
+    you decided to be different and do "MyApp::DB::Table" or something silly
+    like that. You could pre-process your class name so that the default
+    "gen_table" will still work:
+
+     sub gen_table {
+       my $self = shift;
+       my $class = $_[0];
+
+       $class =~ s/::DB::Table::/::Schema::Result::/;
+       return $self->next::method(@_);
+     }
+
 AUTHOR
     Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
 

Modified: trunk/libdbix-class-candy-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/debian/changelog?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/debian/changelog (original)
+++ trunk/libdbix-class-candy-perl/debian/changelog Fri Mar 11 00:41:07 2011
@@ -1,3 +1,9 @@
+libdbix-class-candy-perl (0.002000-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Jonathan Yu <jawnsy at cpan.org>  Thu, 10 Mar 2011 20:05:31 -0500
+
 libdbix-class-candy-perl (0.001006-1) unstable; urgency=low
 
   * New upstream release

Modified: trunk/libdbix-class-candy-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/debian/control?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/debian/control (original)
+++ trunk/libdbix-class-candy-perl/debian/control Fri Mar 11 00:41:07 2011
@@ -7,6 +7,9 @@
  libmro-compat-perl (>= 0.11),
  libnamespace-clean-perl (>= 0.18),
  libsub-exporter-perl (>= 0.982),
+ libstring-camelcase-perl,
+ libtest-deep-perl,
+ liblingua-en-inflect-perl,
  libtest-simple-perl (>= 0.94) | perl (>= 5.11.1)
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Rafael Kitover <rkitover at cpan.org>,
@@ -22,6 +25,8 @@
  libdbix-class-perl (>= 0.08123),
  libmro-compat-perl (>= 0.11),
  libnamespace-clean-perl (>= 0.18),
+ libstring-camelcase-perl,
+ liblingua-en-inflect-perl,
  libsub-exporter-perl (>= 0.982)
 Description: module providing syntax sugar for DBIx::Class
  DBIx::Class::Candy is a Perl module that provides syntactic sugar for result

Modified: trunk/libdbix-class-candy-perl/dist.ini
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/dist.ini?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/dist.ini (original)
+++ trunk/libdbix-class-candy-perl/dist.ini Fri Mar 11 00:41:07 2011
@@ -2,7 +2,7 @@
 author           = Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>
 license          = Perl_5
 copyright_holder = Arthur Axel "fREW" Schmidt
-version          = 0.001006
+version          = 0.002000
 
 [NextRelease]
 [@Git]
@@ -18,9 +18,12 @@
 [PodCoverageTests]
 [PodSyntaxTests]
 
-[Prereq]
+[Prereqs]
 DBIx::Class      = 0.08123
 Sub::Exporter    = 0.982
 Test::More       = 0.94
+Test::Deep       = 0
 namespace::clean = 0.18
 MRO::Compat      = 0.11
+String::CamelCase = 0
+Lingua::EN::Inflect = 0

Modified: trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy.pm?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy.pm (original)
+++ trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy.pm Fri Mar 11 00:41:07 2011
@@ -1,6 +1,6 @@
 package DBIx::Class::Candy;
 BEGIN {
-  $DBIx::Class::Candy::VERSION = '0.001006';
+  $DBIx::Class::Candy::VERSION = '0.002000';
 }
 
 use strict;
@@ -9,6 +9,8 @@
 require DBIx::Class::Candy::Exports;
 use MRO::Compat;
 use Sub::Exporter 'build_exporter';
+use Lingua::EN::Inflect ();
+use String::CamelCase ();
 
 # ABSTRACT: Sugar for your favorite ORM, DBIx::Class
 
@@ -38,44 +40,203 @@
    sequence
 );
 
+sub base { return $_[1] || 'DBIx::Class::Core' }
+
+sub perl_version { return $_[1] }
+
+sub autotable { $_[1] }
+
+sub gen_table {
+   my ( $self, $class, $version ) = @_;
+   if ($version == 1) {
+      $class =~ /::Schema::Result::(.+)$/;
+      my $part = $1;
+      $part =~ s/:://g;
+      $part = String::CamelCase::decamelize($part);
+      return join q{_}, split /\s+/,
+         Lingua::EN::Inflect::PL(join q{ }, split /_/, $part);
+   }
+}
+
 sub import {
    my $self = shift;
 
-   my $base = 'DBIx::Class::Core';
-   my $perl_version = undef;
-   my $components = [];
-
+   my $inheritor = caller(0);
+   my $args         = $self->parse_arguments(\@_);
+   my $perl_version = $self->perl_version($args->{perl_version});
+   my @rest         = @{$args->{rest}};
+
+   $self->set_base($inheritor, $args->{base});
+   $inheritor->load_components(@{$args->{components}});
    my @custom_methods;
    my %custom_aliases;
-   my @rest;
-
-   my $inheritor = caller(0);
-   my $skipnext;
-   for my $idx ( 0 .. $#_ ) {
-      my $val = $_[$idx];
-
-      next unless defined $val;
-      if ($skipnext) {
-         $skipnext--;
-         next;
-      }
-
-      if ( $val eq '-base' ) {
-         $base = $_[$idx + 1];
-         $skipnext = 1;
-      } elsif ( $val eq '-perl5' ) {
-         $perl_version = ord $_[$idx + 1];
-         $skipnext = 1;
-      } elsif ( $val eq '-components' ) {
-         $components = $_[$idx + 1];
-         $skipnext = 1;
-      } else {
-         push @rest, $val;
-      }
+   {
+      my @custom = $self->gen_custom_imports($inheritor);
+      @custom_methods = @{$custom[0]};
+      %custom_aliases = %{$custom[1]};
    }
 
+   my $set_table = sub {};
+   if (my $v = $self->autotable($args->{autotable})) {
+     my $table_name = $self->gen_table($inheritor, $v);
+     $set_table = sub { $inheritor->table($table_name); $set_table = sub {} }
+   }
+   @_ = ($self, @rest);
+   my $import = build_exporter({
+      exports => [
+         has_column => $self->gen_has_column($inheritor, $set_table),
+         primary_column => $self->gen_primary_column($inheritor, $set_table),
+         unique_column => $self->gen_unique_column($inheritor, $set_table),
+         (map { $_ => $self->gen_proxy($inheritor, $set_table) } @methods, @custom_methods),
+         (map { $_ => $self->gen_rename_proxy($inheritor, $set_table, \%aliases, \%custom_aliases) }
+            keys %aliases, keys %custom_aliases),
+      ],
+      groups  => {
+         default => [
+            qw(has_column primary_column unique_column), @methods, @custom_methods, keys %aliases, keys %custom_aliases
+         ],
+      },
+      installer  => $self->installer($inheritor),
+      collectors => [
+         INIT => $self->gen_INIT($perl_version, \%custom_aliases, \@custom_methods, $inheritor),
+      ],
+   });
+
+   goto $import
+}
+
+sub gen_custom_imports {
+  my ($self, $inheritor) = @_;
+  my @methods;
+  my %aliases;
+  for (@{mro::get_linear_isa($inheritor)}) {
+    if (my $a = $DBIx::Class::Candy::Exports::aliases{$_}) {
+      %aliases = (%aliases, %$a)
+    }
+    if (my $m = $DBIx::Class::Candy::Exports::methods{$_}) {
+      @methods = (@methods, @$m)
+    }
+  }
+  return(\@methods, \%aliases)
+}
+
+sub parse_arguments {
+  my $self = shift;
+  my @args = @{shift @_};
+
+  my $skipnext;
+  my $base;
+  my @rest;
+  my $perl_version = undef;
+  my $components   = [];
+  my $autotable = 0;
+  for my $idx ( 0 .. $#args ) {
+    my $val = $args[$idx];
+
+    next unless defined $val;
+    if ($skipnext) {
+      $skipnext--;
+      next;
+    }
+
+    if ( $val eq '-base' ) {
+      $base = $args[$idx + 1];
+      $skipnext = 1;
+    } elsif ( $val eq '-autotable' ) {
+      $autotable = ord $args[$idx + 1];
+      $skipnext = 1;
+    } elsif ( $val eq '-perl5' ) {
+      $perl_version = ord $args[$idx + 1];
+      $skipnext = 1;
+    } elsif ( $val eq '-components' ) {
+      $components = $args[$idx + 1];
+      $skipnext = 1;
+    } else {
+      push @rest, $val;
+    }
+  }
+
+  return {
+    autotable    => $autotable,
+    base         => $base,
+    perl_version => $perl_version,
+    components   => $components,
+    rest         => \@rest,
+  };
+}
+
+sub gen_primary_column {
+  my ($self, $inheritor, $set_table) = @_;
+  sub {
+    my $i = $inheritor;
+    sub {
+      my $column = shift;
+      my $info   = shift;
+      $set_table->();
+      $i->add_columns($column => $info);
+      $i->set_primary_key($column);
+    }
+  }
+}
+
+sub gen_unique_column {
+  my ($self, $inheritor, $set_table) = @_;
+  sub {
+    my $i = $inheritor;
+    sub {
+      my $column = shift;
+      my $info   = shift;
+      $set_table->();
+      $i->add_columns($column => $info);
+      $i->add_unique_constraint([ $column ]);
+    }
+  }
+}
+
+sub gen_has_column {
+  my ($self, $inheritor, $set_table) = @_;
+  sub {
+    my $i = $inheritor;
+    sub {
+      my $column = shift;
+      $set_table->();
+      $i->add_columns($column => { @_ })
+    }
+  }
+}
+
+sub gen_rename_proxy {
+  my ($self, $inheritor, $set_table, $aliases, $custom_aliases) = @_;
+  sub {
+    my ($class, $name) = @_;
+    my $meth = $aliases->{$name} || $custom_aliases->{$name};
+    my $i = $inheritor;
+    sub { $set_table->(); $i->$meth(@_) }
+  }
+}
+
+sub gen_proxy {
+  my ($self, $inheritor, $set_table) = @_;
+  sub {
+    my ($class, $name) = @_;
+    my $i = $inheritor;
+    sub { $set_table->(); $i->$name(@_) }
+  }
+}
+
+sub installer {
+  my ($self, $inheritor) = @_;
+  sub {
+    Sub::Exporter::default_installer @_;
+    namespace::clean->import( -cleanee => $inheritor )
+  }
+}
+
+sub set_base {
+   my ($self, $inheritor, $base) = @_;
+
    # inlined from parent.pm
-   for ( my @useless = $base ) {
+   for ( my @useless = $self->base($base) ) {
       s{::|'}{/}g;
       require "$_.pm"; # dies if the file is not found
    }
@@ -84,81 +245,28 @@
       no strict 'refs';
       # This is more efficient than push for the new MRO
       # at least until the new MRO is fixed
-      @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , $base);
+      @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , $self->base($base));
    }
-   $inheritor->load_components(@{$components});
-   for (@{mro::get_linear_isa($inheritor)}) {
-      if (my $hashref = $DBIx::Class::Candy::Exports::aliases{$_}) {
-         %custom_aliases = (%custom_aliases, %{$hashref})
-      }
-      if (my $arrayref = $DBIx::Class::Candy::Exports::methods{$_}) {
-         @custom_methods = (@custom_methods, @{$arrayref})
-      }
-   }
-
-   @_ = ($self, @rest);
-   my $import = build_exporter({
-      exports => [
-         has_column => sub {
-            my $i = $inheritor;
-            sub {
-               my $column = shift;
-               $i->add_columns($column => { @_ })
-            }
-         },
-         primary_column => sub {
-            my $i = $inheritor;
-            sub {
-               my $column = shift;
-               my $info   = shift;
-               $i->add_columns($column => $info);
-               $i->set_primary_key($column);
-            }
-         },
-         (map { $_ => sub {
-            my ($class, $name) = @_;
-            my $i = $inheritor;
-            sub { $i->$name(@_) }
-         } } @methods, @custom_methods),
-         (map { $_ => sub {
-            my ($class, $name) = @_;
-            my $meth = $aliases{$name} || $custom_aliases{$name};
-            my $i = $inheritor;
-            sub { $i->$meth(@_) }
-         } } keys %aliases, keys %custom_aliases),
-      ],
-      groups  => {
-         default => [
-            'has_column', 'primary_column', @methods, @custom_methods, keys %aliases, keys %custom_aliases
-         ],
-      },
-      installer  => sub {
-         Sub::Exporter::default_installer @_;
-         namespace::clean->import(
-            -cleanee => $inheritor,
-         )
-      },
-      collectors => [
-         INIT => sub {
-            my $orig = $_[1]->{import_args};
-            $_[1]->{import_args} = [];
-            %custom_aliases = ();
-            @custom_methods = ();
-
-            if ($perl_version) {
-               require feature;
-               feature->import(":5.$perl_version")
-            }
-
-            strict->import;
-            warnings->import;
-
-            1;
-         }
-      ],
-   });
-
-   goto $import
+}
+
+sub gen_INIT {
+  my ($self, $perl_version, $custom_aliases, $custom_methods, $inheritor) = @_;
+  sub {
+    my $orig = $_[1]->{import_args};
+    $_[1]->{import_args} = [];
+    %$custom_aliases = ();
+    @$custom_methods = ();
+
+    if ($perl_version) {
+       require feature;
+       feature->import(":5.$perl_version")
+    }
+
+    strict->import;
+    warnings->import;
+
+    1;
+  }
 }
 
 1;
@@ -173,17 +281,15 @@
 
 =head1 VERSION
 
-version 0.001006
+version 0.002000
 
 =head1 SYNOPSIS
 
  package MyApp::Schema::Result::Artist;
 
- use DBIx::Class::Candy;
-
- table 'artists';
-
- column id => {
+ use DBIx::Class::Candy -autotable => v1;
+
+ primary_column id => {
    data_type => 'int',
    is_auto_increment => 1,
  };
@@ -194,8 +300,6 @@
    is_nullable => 1,
  };
 
- primary_key 'id';
-
  has_many albums => 'A::Schema::Result::Album', 'artist_id';
 
  1;
@@ -244,12 +348,22 @@
 
 =head1 IMPORT OPTIONS
 
+See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these schema wide.
+
 =head2 -base
 
  use DBIx::Class::Candy -base => 'MyApp::Schema::Result';
 
 The first thing you can do to customize your usage of C<DBIx::Class::Candy>
 is change the parent class.  Do that by using the C<-base> import option.
+
+=head2 -autotable
+
+ use DBIx::Class::Candy -autotable => v1;
+
+Don't waste your precious keystrokes typing C<< table 'buildings' >>, let
+C<DBIx::Class::Candy> do that for you!  See L<AUTOTABLE VERSIONS> for what the
+existing versions will generate for you.
 
 =head2 -components
 
@@ -304,9 +418,43 @@
  unique_constraint => 'add_unique_constraint',
  relationship      => 'add_relationship',
 
+=head1 SETTING DEFAULT IMPORT OPTIONS
+
+Eventually you will get tired of writing the following in every single one of
+your results:
+
+ use DBIx::Class::Candy
+   -base      => 'MyApp::Schema::Result',
+   -perl5     => v12,
+   -autotable => v1;
+
+You can set all of these for your whole schema if you define your own C<Candy>
+subclass as follows:
+
+ package MyApp::Schema::Candy;
+
+ use base 'DBIx::Class::Candy';
+
+ sub base { $_[1] || 'MyApp::Schema::Result' }
+ sub perl_version { 12 }
+ sub autotable { 1 }
+
+Note the C<< $_[1] || >> in C<base>.  All of these methods are passed the
+values passed in from the arguments to the subclass, so you can either throw
+them away, honor them, die on usage, or whatever.  To be clear, if you define
+your subclass, and someone uses it as follows:
+
+ use MyApp::Schema::Candy -base => 'Moose', -perl5 => v30, -autotable => v3;
+
+Your C<base> method will get C<Moose>, your
+C<perl_version> will get C<30>, and your C<autotable> will get
+C<3>.
+
 =head1 SECONDARY API
 
-Lastly, there is currently a single "transformer" for C<add_columns>, so that
+=head2 has_column
+
+There is currently a single "transformer" for C<add_columns>, so that
 people used to the L<Moose> api will feel more at home.  Note that this B<may>
 go into a "Candy Component" at some point.
 
@@ -318,6 +466,64 @@
    is_nullable => 1,
  );
 
+=head2 primary_column
+
+Another handy little feature that allows you to define a column and set it as
+the primary key in a single call:
+
+ primary_column id => {
+   data_type => 'int',
+   is_auto_increment => 1,
+ };
+
+=head2 unique_column
+
+This allows you to define a column and set it as unique in a single call:
+
+ unique_column name => {
+   data_type => 'varchar',
+   size => 30,
+ };
+
+=head1 AUTOTABLE VERSIONS
+
+Currently there is a single version, C<v1>, which looks at your class name,
+grabs everything after C<::Schema::Result::>, removes the C<::>'s, converts it
+to underscores instead of camel-case, and pluralizes it.  Here are some
+examples if that's not clear:
+
+ MyApp::Schema::Result::Cat -> cats
+ MyApp::Schema::Result::Software::Buidling -> software_buildings
+ MyApp::Schema::Result::LonelyPerson -> lonely_people
+
+Also, if you just want to be different, you can easily set up your own naming
+scheme.  Just add a C<gen_table> method to your candy subclass.  The method
+gets passed the class name and the autotable version, which of course you may
+ignore.  For example, one might just do the following:
+
+ sub gen_table {
+   my ($self, $class) = @_;
+
+   $class =~ s/::/_/g;
+   lc $class;
+ }
+
+Which would tranform C<MyApp::Schema::Result::Foo> into
+C<myapp_schema_result_foo>.
+
+Or maybe instead of using the standard C<MyApp::Schema::Result> namespace you
+decided to be different and do C<MyApp::DB::Table> or something silly like that.
+You could pre-process your class name so that the default C<gen_table> will
+still work:
+
+ sub gen_table {
+   my $self = shift;
+   my $class = $_[0];
+
+   $class =~ s/::DB::Table::/::Schema::Result::/;
+   return $self->next::method(@_);
+ }
+
 =head1 AUTHOR
 
 Arthur Axel "fREW" Schmidt <frioux+cpan at gmail.com>

Modified: trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy/Exports.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy/Exports.pm?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy/Exports.pm (original)
+++ trunk/libdbix-class-candy-perl/lib/DBIx/Class/Candy/Exports.pm Fri Mar 11 00:41:07 2011
@@ -1,6 +1,6 @@
 package DBIx::Class::Candy::Exports;
 BEGIN {
-  $DBIx::Class::Candy::Exports::VERSION = '0.001006';
+  $DBIx::Class::Candy::Exports::VERSION = '0.002000';
 }
 
 # ABSTRACT: Create sugar for your favorite ORM, DBIx::Class
@@ -31,7 +31,7 @@
 
 =head1 VERSION
 
-version 0.001006
+version 0.002000
 
 =head1 SYNOPSIS
 

Modified: trunk/libdbix-class-candy-perl/t/imports.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/t/imports.t?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/t/imports.t (original)
+++ trunk/libdbix-class-candy-perl/t/imports.t Fri Mar 11 00:41:07 2011
@@ -6,7 +6,7 @@
 use A::Schema;
 use A::Schema::Result::Album;
 
-my $result_class =A::Schema->resultset('Album')->result_class;
+my $result_class = A::Schema->resultset('Album')->result_class;
 isa_ok $result_class, 'DBIx::Class::Core';
 
 is( $result_class->table, 'albums', 'table set correctly' );
@@ -15,4 +15,9 @@
 is( $cols[1], 'name', 'name column set correctly' );
 A::Schema::Result::Album::test_strict;
 
+ok( !$result_class->can('column'), 'namespace gets cleaned');
+
+my $artist_result = A::Schema->resultset('Artist')->result_class;
+isa_ok( $artist_result, 'A::Schema::Result');
+
 done_testing;

Modified: trunk/libdbix-class-candy-perl/t/lib/A/Schema/Result/Artist.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbix-class-candy-perl/t/lib/A/Schema/Result/Artist.pm?rev=71079&op=diff
==============================================================================
--- trunk/libdbix-class-candy-perl/t/lib/A/Schema/Result/Artist.pm (original)
+++ trunk/libdbix-class-candy-perl/t/lib/A/Schema/Result/Artist.pm Fri Mar 11 00:41:07 2011
@@ -1,6 +1,6 @@
 package A::Schema::Result::Artist;
 
-use DBIx::Class::Candy -base => 'A::Schema::Result';
+use A::Schema::Candy;
 
 table 'artists';
 




More information about the Pkg-perl-cvs-commits mailing list