keys of the related table are not fetched
- fix count for group_by as scalar
- add horrific fix to make Oracle's retarded limit syntax work
- - remove Carp require
+ - changed UUIDColumns to use new UUIDMaker classes for uuid creation
+ using whatever module may be available
0.05003 2006-02-08 17:50:20
- add component_class accessors and use them for *_class
--- /dev/null
+=head1 NAME
+
+DBIx::Class::Manual::Example - Simple CD database example
+
+=head1 DESCRIPTION
+
+This tutorial will guide you through the proeccess of setting up and testing a very basic CD database using Mysql, with DBIx::Class::Schema as the database frontend.
+
+The database consists of the following:
+
+ table 'artist' with columns: artistid, name
+ table 'cd' with columns: cdid, artist, title
+ table 'track' with columns: trackid, cd, title
+
+
+And these rules exists:
+
+ one artist can have many cds
+ one cd belongs to one artist
+ one cd can have many tracks
+ one track belongs to one cd
+
+
+=head2 Installation
+
+=head3 Create the database/tables and populate them with a few records
+
+ CREATE DATABASE cdtestdb ;
+ USE cdtestdb;
+
+ CREATE TABLE artist (
+ artistid INT NOT NULL AUTO_INCREMENT ,
+ name CHAR( 40 ) NOT NULL ,
+ PRIMARY KEY ( artistid )
+ );
+
+ CREATE TABLE cd (
+ cdid INT NOT NULL AUTO_INCREMENT ,
+ artist INT NOT NULL ,
+ title CHAR( 40 ) NOT NULL ,
+ PRIMARY KEY ( cdid )
+ );
+
+ CREATE TABLE track (
+ trackid INT NOT NULL AUTO_INCREMENT ,
+ cd INT NOT NULL ,
+ title CHAR( 40 ) NOT NULL ,
+ PRIMARY KEY ( trackid )
+ ;
+
+
+ INSERT INTO artist VALUES
+ (NULL,'Michael Jackson'),
+ (NULL,'Eminem');
+
+ INSERT INTO cd VALUES
+ (NULL,'1','Thriller'),
+ (NULL,'1','Bad'),
+ (NULL,'2','The Marshall Mathers LP');
+
+ INSERT INTO track VALUES
+ (NULL,'1','Beat it'),
+ (NULL,'1','Billie Jean'),
+ (NULL,'2','Dirty Diana'),
+ (NULL,'2','Smooth Criminal'),
+ (NULL,'2','Leave Me Alone'),
+ (NULL,'3','Stan'),
+ (NULL,'3','The Way I Am');
+
+
+
+=head3 Set up DBIx::Class::Schema
+
+First, create some dirs and change working directory:
+
+ mkdir app
+ mkdir app/DB
+ mkdir app/DB/Main
+ cd app
+
+
+Then, create the following DBIx::Class::Schema classes:
+
+DB/Main.pm:
+
+ package DB::Main;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_classes(qw/Artist CD Track/);
+
+ 1;
+
+
+DB/Main/Artist.pm:
+
+ package DB::Main::Artist;
+ use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('artist');
+ __PACKAGE__->add_columns(qw/ artistid name /);
+ __PACKAGE__->set_primary_key('artistid');
+ __PACKAGE__->has_many('cds' => 'DB::Main::CD');
+
+ 1;
+
+
+DB/Main/CD.pm:
+
+ package DB::Main::CD;
+ use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('cd');
+ __PACKAGE__->add_columns(qw/ cdid artist title/);
+ __PACKAGE__->set_primary_key('cdid');
+ __PACKAGE__->belongs_to('artist' => 'DB::Main::Artist');
+ __PACKAGE__->has_many('tracks' => 'DB::Main::Track');
+
+ 1;
+
+
+DB/Main/Track.pm:
+
+ package DB::Main::Track;
+ use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('track');
+ __PACKAGE__->add_columns(qw/ trackid cd title/);
+ __PACKAGE__->set_primary_key('trackid');
+ __PACKAGE__->belongs_to('cd' => 'DB::Main::CD');
+
+ 1;
+
+
+=head3 Create and run the test script
+
+testdb.pl:
+
+ #!/usr/bin/perl -w
+
+ use DB::Main;
+ use strict;
+
+ my $schema = DB::Main->connect('dbi:mysql:cdtestdb', 'testuser', 'testpass');
+
+ get_tracks_by_cd('Bad');
+ get_tracks_by_artist('Michael Jackson');
+
+ get_cd_by_track('Stan');
+ get_cds_by_artist('Michael Jackson');
+
+ get_artist_by_track('Dirty Diana');
+ get_artist_by_cd('The Marshall Mathers LP');
+
+
+ sub get_tracks_by_cd {
+ my $cdtitle = shift;
+ print "get_tracks_by_cd($cdtitle):\n";
+ my $rs = $schema->resultset('Track')->search(
+ {
+ 'cd.title' => $cdtitle
+ },
+ {
+ join => [qw/ cd /],
+ prefetch => [qw/ cd /]
+ }
+ );
+ while (my $track = $rs->next) {
+ print $track->title . "\n";
+ }
+ print "\n";
+ }
+
+ sub get_tracks_by_artist {
+ my $artistname = shift;
+ print "get_tracks_by_artist($artistname):\n";
+ my $rs = $schema->resultset('Track')->search(
+ {
+ 'artist.name' => $artistname
+ },
+ {
+ join => {
+ 'cd' => 'artist'
+ },
+ }
+ );
+ while (my $track = $rs->next) {
+ print $track->title . "\n";
+ }
+ print "\n";
+ }
+
+
+
+ sub get_cd_by_track {
+ my $tracktitle = shift;
+ print "get_cd_by_track($tracktitle):\n";
+ my $rs = $schema->resultset('CD')->search(
+ {
+ 'tracks.title' => $tracktitle
+ },
+ {
+ join => [qw/ tracks /],
+ }
+ );
+ my $cd = $rs->first;
+ print $cd->title . "\n\n";
+ }
+
+ sub get_cds_by_artist {
+ my $artistname = shift;
+ print "get_cds_by_artist($artistname):\n";
+ my $rs = $schema->resultset('CD')->search(
+ {
+ 'artist.name' => $artistname
+ },
+ {
+ join => [qw/ artist /],
+ prefetch => [qw/ artist /]
+ }
+ );
+ while (my $cd = $rs->next) {
+ print $cd->title . "\n";
+ }
+ print "\n";
+ }
+
+
+
+ sub get_artist_by_track {
+ my $tracktitle = shift;
+ print "get_artist_by_track($tracktitle):\n";
+ my $rs = $schema->resultset('Artist')->search(
+ {
+ 'tracks.title' => $tracktitle
+ },
+ {
+ join => {
+ 'cds' => 'tracks'
+ }
+ }
+ );
+ my $artist = $rs->first;
+ print $artist->name . "\n\n";
+ }
+
+ sub get_artist_by_cd {
+ my $cdtitle = shift;
+ print "get_artist_by_cd($cdtitle):\n";
+ my $rs = $schema->resultset('Artist')->search(
+ {
+ 'cds.title' => $cdtitle
+ },
+ {
+ join => [qw/ cds /],
+ }
+ );
+ my $artist = $rs->first;
+ print $artist->name . "\n\n";
+ }
+
+
+
+It should output:
+
+ get_tracks_by_cd(Bad):
+ Dirty Diana
+ Smooth Criminal
+ Leave Me Alone
+
+ get_tracks_by_artist(Michael Jackson):
+ Beat it
+ Billie Jean
+ Dirty Diana
+ Smooth Criminal
+ Leave Me Alone
+
+ get_cd_by_track(Stan):
+ The Marshall Mathers LP
+
+ get_cds_by_artist(Michael Jackson):
+ Thriller
+ Bad
+
+ get_artist_by_track(Dirty Diana):
+ Michael Jackson
+
+ get_artist_by_cd(The Marshall Mathers LP):
+ Eminem
+
+=head1 AUTHOR
+
+ sc_
+
+=cut
=head2 txn_do
-=head3 Arguments: <$coderef>, [@coderef_args]
+=head3 Arguments: <coderef>, [@coderef_args]
-Executes C<$coderef> with (optional) arguments C<@coderef_args>
-transactionally, returning its result (if any). If an exception is
-caught, a rollback is issued and the exception is rethrown. If the
-rollback fails, (i.e. throws an exception) an exception is thrown that
-includes a "Rollback failed" message.
+Executes <coderef> with (optional) arguments <@coderef_args> transactionally,
+returning its result (if any). If an exception is caught, a rollback is issued
+and the exception is rethrown. If the rollback fails, (i.e. throws an
+exception) an exception is thrown that includes a "Rollback failed" message.
For example,
}
}
-Nested transactions work as expected (i.e. only the outermost
+Nested transactions should work as expected (i.e. only the outermost
transaction will issue a txn_commit on the Schema's storage)
=cut
sub _quote {
my ($self, $label) = @_;
return '' unless defined $label;
- return "*" if $label eq '*';
return $label unless $self->{quote_char};
- if(ref $self->{quote_char} eq "ARRAY"){
- return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
- if !defined $self->{name_sep};
- my $sep = $self->{name_sep};
- return join($self->{name_sep},
- map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
- split(/\Q$sep\E/,$label));
- }
return $self->SUPER::_quote($label);
}
}
sub _find_uuid_module {
- if ($^O ne 'openbsd' && eval{require APR::UUID}) {
+ if (eval{require Data::UUID}) {
+ return '::Data::UUID';
+ } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) {
# APR::UUID on openbsd causes some as yet unfound nastyness for XS
return '::APR::UUID';
} elsif (eval{require UUID}) {
return '::UUID';
- } elsif (eval{require Data::UUID}) {
- return '::Data::UUID';
} elsif (eval{
# squelch the 'too late for INIT' warning in Win32::API::Type
local $^W = 0;
};
};
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDColumns - Implicit uuid columns
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class> component resembles the behaviour of
+L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
+
+When loaded, C<UUIDColumns> will search for a suitable uuid generation module
+from the following list of supported modules:
+
+ Data::UUID
+ APR::UUID*
+ UUID
+ Win32::Guidgen
+ Win32API::GUID
+
+If no supporting module can be found, an exception will be thrown.
+
+*APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS
+issue.
+
+If you would like to use a specific module, you can set C<uuid_class>:
+
+ __PACKAGE__->uuid_class('::Data::UUID');
+ __PACKAGE__->uuid_class('MyUUIDGenerator');
+
+Note that the component needs to be loaded before Core.
+
+=head1 METHODS
+
+=head2 uuid_columns(@columns)
+
+Takes a list of columns to be filled with uuids during insert.
+
+ __PACKAGE__->uuid_columns('id');
+
+=head2 uuid_class($classname)
+
+Takes the name of a UUIDMaker subclass to be used for uuid value generation.
+This can be a fully qualified class name, or a shortcut name starting with ::
+that matches one of the available DBIx::Class::UUIDMaker subclasses:
+
+ __PACKAGE__->uuid_class('CustomUUIDGenerator');
+ # loads CustomeUUIDGenerator
+
+ __PACKAGE->uuid_class('::Data::UUID');
+ # loads DBIx::Class::UUIDMaker::Data::UUID;
+
+Note that C<uuid_class> chacks to see that the specified class isa
+DBIx::Class::UUIDMaker subbclass and throws and exception if it isn't.
+
+=head2 uuid_maker
+
+Returns the current UUIDMaker instance for the given module.
+
+ my $uuid = __PACKAGE__->uuid_maker->as_string;
+
+=head1 SEE ALSO
+
+L<DBIx::Class::UUIDMaker>
+
=head1 AUTHORS
Chia-liang Kao <clkao@clkao.org>
+++ /dev/null
-package DBIx::Class::UUIDColumns;
-use base qw/DBIx::Class/;
-
-use Data::UUID;
-
-__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
-
-=head1 NAME
-
-DBIx::Class::UUIDColumns - Implicit uuid columns
-
-=head1 SYNOPSIS
-
- pacakge Artist;
- __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
- __PACKAGE__->uuid_columns( 'artist_id' );x
-
-=head1 DESCRIPTION
-
-This L<DBIx::Class> component resambles the behaviour of
-L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
-
-Note that the component needs to be loaded before Core.
-
-=head1 METHODS
-
-=head2 uuid_columns
-
-=cut
-
-# be compatible with Class::DBI::UUID
-sub uuid_columns {
- my $self = shift;
- for (@_) {
- $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
- }
- $self->uuid_auto_columns(\@_);
-}
-
-sub insert {
- my $self = shift;
- for my $column (@{$self->uuid_auto_columns}) {
- $self->store_column( $column, $self->get_uuid )
- unless defined $self->get_column( $column );
- }
- $self->next::method(@_);
-}
-
-sub get_uuid {
- return Data::UUID->new->to_string(Data::UUID->new->create),
-}
-
-=head1 AUTHORS
-
-Chia-liang Kao <clkao@clkao.org>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-
-1;
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker - UUID wrapper module
+
+=head1 SYNOPSIS
+
+ package CustomUUIDMaker;
+ use base qw/DBIx::Class::/;
+
+ sub as_string {
+ my $uuid;
+ ...magic encantations...
+ return $uuid;
+ };
+
+=head1 DESCRIPTION
+
+DBIx::Class::UUIDMaker is a base class used by the various uuid generation
+subclasses.
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<DBIx::Class::UUIDMaker>,
+L<DBIx::Class::UUIDMaker::UUID>,
+L<DBIx::Class::UUIDMaker::APR::UUID>,
+L<DBIx::Class::UUIDMaker::Data::UUID>,
+L<DBIx::Class::UUIDMaker::Win32::Guidgen>,
+L<DBIx::Class::UUIDMaker::Win32API::GUID>,
+L<DBIx::Class::UUIDMaker::Data::Uniqid>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::APR::UUID - Create uuids using APR::UUID
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::APR::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses APR::UUID to generate uuid
+strings in the following format:
+
+ 098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<APR::UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Data::UUID - Create uuids using Data::UUID
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::Data::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Data::UUID to generate uuid
+strings in the following format:
+
+ 098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Data::UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Data::Uniqid - Create uuids using Data::Uniqid
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::Data::Uniqid');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Data::Uniqid to generate uuid
+strings using Data::Uniqid::luniqid.
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Data::Data::Uniqid>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::UUID - Create uuids using UUID
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::UUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses UUID to generate uuid
+strings in the following format:
+
+ 098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<UUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
sub as_string {
my $uuid = Win32::Guidgen::create();
- $uuid =~ s/(^\{|\}$)//;
+ $uuid =~ s/(^\{|\}$)//g;
return $uuid;
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Win32:::Guidgen - Create uuids using Win32::Guidgen
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::Win32::Guidgen');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Win32::Guidgen to generate uuid
+strings in the following format:
+
+ 098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Win32::Guidgen>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
};
1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::UUIDMaker::Win32API:::GUID - Create uuids using Win32API::GUID
+
+=head1 SYNOPSIS
+
+ package Artist;
+ __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+ __PACKAGE__->uuid_columns( 'artist_id' );
+ __PACKAGE__->uuid_class('::Win32API::GUID');
+
+=head1 DESCRIPTION
+
+This DBIx::Class::UUIDMaker subclass uses Win32API::GUID to generate uuid
+strings in the following format:
+
+ 098f2470-bae0-11cd-b579-08002b30bfeb
+
+=head1 METHODS
+
+=head2 as_string
+
+Returns the new uuid as a string.
+
+=head1 SEE ALSO
+
+L<Win32API::GUID>
+
+=head1 AUTHOR
+
+Chris Laco <claco@chrislaco.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
projects / dbsrgits/DBIx-Class.git / commitdiff