My first Catalyst::Helper

I've been poking around on my user system I wrote a little while ago for Catalyst.  I decided it'd be neat to have a helper create the Schema files I need so that I don't have to do a git pull/clone every time I want to use them. 

Then, just maybe, someone will come along and decide they want to use my system.  This will also help get my controller code into CatalystX:: or Catalyst::Controller::Users or some such.

The code looks fairly easy to deal with (EXTREMELY preliminary code, mostly stolen from Catalyst::Helper::Model::DBIC::Schema):

package Catalyst::Helper::Model::CR::Users;

use strict;
use warnings;

our $VERSION = '0.21';

use Carp;
use UNIVERSAL::require;

=head1 NAME

Catalyst::Helper::Model::CR::Users - Helper for creating users the way codedright.net does

=head1 SYNOPSIS

  script/create.pl model UserClassName 

=head1 DESCRIPTION

Helper for creating a user setup.

=head2 Arguments:



=head1 TYPICAL EXAMPLES

 

=head1 METHODS

=head2 mk_compclass

=cut

sub mk_compclass {
    my ( $self, $helper, $schema_class, @connect_info) = @_;

    $helper->{schema_class} = $schema_class
        or croak "Must supply schema class name";

    my $create = '';
    if($connect_info[0] && $connect_info[0] =~ /^create=(dynamic|static)$/) {
        $create = $1;
        shift @connect_info;
    }

    if(@connect_info) {
        $helper->{setup_connect_info} = 1;
        my @helper_connect_info = @connect_info;
        for(@helper_connect_info) {
            $_ = qq{'$_'} if $_ !~ /^\s*[[{]/;
        }
        $helper->{connect_info} = \@helper_connect_info;
    }

    if($create eq 'dynamic') {
        my @schema_parts = split(/\:\:/, $helper->{schema_class});
        my $schema_file_part = pop @schema_parts;

        my $schema_dir  = File::Spec->catfile( $helper->{base}, 'lib', @schema_parts );
        my $schema_file = File::Spec->catfile( $schema_dir, $schema_file_part . '.pm' );

        $helper->mk_dir($schema_dir);
        $helper->render_file( 'schemaclass', $schema_file );
    }
    elsif($create eq 'static') {
        my $schema_dir  = File::Spec->catfile( $helper->{base}, 'lib' );
        DBIx::Class::Schema::Loader->use("dump_to_dir:$schema_dir", 'make_schema_at')
            or croak "Cannot load DBIx::Class::Schema::Loader: $@";

        my @loader_connect_info = @connect_info;
        my $num = 6; # argument number on the commandline for "dbi:..."
        for(@loader_connect_info) {
            if(/^\s*[[{]/) {
                $_ = eval "$_";
                croak "Perl syntax error in commandline argument $num: $@" if $@;
            }
            $num++;
        }

        make_schema_at(
            $schema_class,
            { relationships => 1 },
            \@loader_connect_info,
        );
    }

    my $file = $helper->{file};
    $helper->render_file( 'compclass', $file );
}

=head1 SEE ALSO

General Catalyst Stuff:

L, L, L,
L, L, L,

Stuff related to DBIC and this Model style:

L, L,
L, L

=head1 AUTHOR

Devin Austin
http://www.codedright.net
dhoss@cpan.org

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__DATA__

=begin pod_to_ignore

__schemaclass__
package [% schema_class %];

use strict;
use base qw/DBIx::Class::Schema::Loader/;

__PACKAGE__->loader_options(
    relationships => 1,
    # debug => 1,
);

=head1 NAME

[% schema_class %] - DBIx::Class::Schema::Loader class

=head1 SYNOPSIS

See L<[% app %]>

=head1 DESCRIPTION

Generated by L for use in L<[% class %]>

=head1 AUTHOR

[% author %]

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__compclass__
package [% class %];

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config(
    schema_class => '[% schema_class %]',
    [% IF setup_connect_info %]connect_info => [
        [% FOREACH arg = connect_info %][% arg %],
        [% END %]
    ],[% END %]
);

=head1 NAME

[% class %] - Catalyst DBIC Schema Model
=head1 SYNOPSIS

See L<[% app %]>

=head1 DESCRIPTION

L Model using schema L<[% schema_class %]>

=head1 AUTHOR

[% author %]

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;