February 2009 Archives

package My::App::Model::Kioku;
use Moose;
use My::App::Backend::Kioku;

has 'backend' => (
    is       => 'ro',
    isa      => 'My::App::Backend::Kioku',
    required => 1,
);

sub COMPONENT {
    my ($self, $app, $args) = @_;
    $self->new(
        backend => My::App::Backend::Kioku->new(
            %$args,
        ),
    );
}

sub ACCEPT_CONTEXT {
    my ($self, $c, @args) = @_;
    my $be = $self->backend;
    $c->stash->{__kioku_scope} ||= $be->db->new_scope;
    return $be;
}

1;

package Person;

has spouse => (
    isa => __PACKAGE__,
    is  => "rw",
    weak_ref => 1,
   
my $marge_id = $dir->store(
     Person->new( name => "Marge Simpson" ),
    );
);

 {
     my $scope = $dir->new_scope;

     my ( $marge, $homer ) = $dir->lookup( $marge_id, $homer_id );

     $marge->spouse($homer);
     $homer->spouse($marge);

     $dir->store( $marge, $homer );
 }

That just looks *damn* cool to me!

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;

devin@devin-laptop:~/web-devel/womens-studies-library$ perl Makefile.PL 
Can't call method "load_all_extensions" on an undefined value at inc/Module/Install.pm line 167.
BEGIN failed--compilation aborted at Makefile.PL line 3.