r64898 - in /branches/upstream/librose-db-perl/current: Changes META.yml lib/Rose/DB.pm lib/Rose/DB/MySQL.pm lib/Rose/DB/Oracle.pm lib/Rose/DB/Pg.pm
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Nov 14 14:25:01 UTC 2010
Author: gregoa
Date: Sun Nov 14 14:24:51 2010
New Revision: 64898
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=64898
Log:
[svn-upgrade] new version librose-db-perl (0.762)
Modified:
branches/upstream/librose-db-perl/current/Changes
branches/upstream/librose-db-perl/current/META.yml
branches/upstream/librose-db-perl/current/lib/Rose/DB.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/MySQL.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm
branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
Modified: branches/upstream/librose-db-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/Changes?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/Changes (original)
+++ branches/upstream/librose-db-perl/current/Changes Sun Nov 14 14:24:51 2010
@@ -1,3 +1,7 @@
+0.762 (06.23.2010) - John Siracusa <siracusa at gmail.com>
+
+ * Support for Rose::DB::Object 0.789.
+
0.761 (05.22.2010) - John Siracusa <siracusa at gmail.com>
* Support for Rose::DB::Object 0.788.
Modified: branches/upstream/librose-db-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/META.yml?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/META.yml (original)
+++ branches/upstream/librose-db-perl/current/META.yml Sun Nov 14 14:24:51 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Rose-DB
-version: 0.761
+version: 0.762
abstract: ~
author: []
license: perl
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB.pm?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB.pm Sun Nov 14 14:24:51 2010
@@ -20,7 +20,7 @@
our $Error;
-our $VERSION = '0.761';
+our $VERSION = '0.762';
our $Debug = 0;
@@ -2344,6 +2344,129 @@
return 'SELECT ' . ($hints->{'comment'} ? "/* $hints->{'comment'} */" : '');
}
+sub format_select_lock { '' }
+
+sub column_sql_from_lock_on_value
+{
+ my($self, $object_or_class, $name, $tables) = @_;
+
+ my %map;
+
+ if($tables)
+ {
+ my $tn = 1;
+
+ foreach my $table (@$tables)
+ {
+ (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
+ $map{$table_key} = 't' . $tn++;
+ }
+ }
+
+ my $table;
+ my $chase_meta = $object_or_class->meta;
+
+ # Chase down multi-level keys: e.g., products.vendor.name
+ while($name =~ /\G([^.]+)(\.|$)/g)
+ {
+ my($sub_name, $more) = ($1, $2);
+
+ my $key = $chase_meta->foreign_key($sub_name) ||
+ $chase_meta->relationship($sub_name);
+
+ if($key)
+ {
+ $chase_meta = $key->can('foreign_class') ?
+ $key->foreign_class->meta : $key->class->meta;
+
+ $table = $chase_meta->table;
+ }
+ else
+ {
+ if($more)
+ {
+ Carp::confess 'Invalid lock => { on => ... } argument: ',
+ "no foreign key or relationship named '$sub_name' ",
+ 'found in ', $chase_meta->class;
+ }
+ else
+ {
+ my $column = $sub_name;
+
+ if($table)
+ {
+ $table = $map{$table} if(defined $map{$table});
+ return $self->auto_quote_column_with_table($column, $table);
+ }
+ else
+ {
+ return $self->auto_quote_column_name($column);
+ }
+ }
+ }
+ }
+
+ Carp::confess "Invalid lock => { on => ... } argument: $name";
+}
+
+sub table_sql_from_lock_on_value
+{
+ my($self, $object_or_class, $name, $tables) = @_;
+
+ my %map;
+
+ if($tables)
+ {
+ my $tn = 1;
+
+ foreach my $table (@$tables)
+ {
+ (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
+ $map{$table_key} = 't' . $tn++;
+ }
+ }
+
+ my $table;
+ my $chase_meta = $object_or_class->meta;
+
+ # Chase down multi-level keys: e.g., products.vendor.location
+ while($name =~ /\G([^.]+)(\.|$)/g)
+ {
+ my($sub_name, $more) = ($1, $2);
+
+ my $key = $chase_meta->foreign_key($sub_name) ||
+ $chase_meta->relationship($sub_name);
+
+ if($key || !$more)
+ {
+ if($key)
+ {
+ $chase_meta = $key->can('foreign_class') ?
+ $key->foreign_class->meta : $key->class->meta;
+
+ $table = $chase_meta->table;
+ }
+ else
+ {
+ $table = $sub_name;
+ }
+
+ next if($more);
+
+ $table = $map{$table} if(defined $map{$table});
+ return $self->auto_quote_table_name($table);
+ }
+ else
+ {
+ Carp::confess 'Invalid lock => { on => ... } argument: ',
+ "no foreign key or relationship named '$sub_name' ",
+ 'found in ', $chase_meta->class;
+ }
+ }
+
+ Carp::confess "Invalid lock => { on => ... } argument: $name";
+}
+
sub supports_on_duplicate_key_update { 0 }
#
@@ -3821,7 +3944,7 @@
=head1 CONTRIBUTORS
-Peter Karman, Lucian Dragus, Ron Savage
+Kostas Chatzikokolakis, Peter Karman, Lucian Dragus, Ron Savage
=head1 AUTHOR
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/MySQL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/MySQL.pm?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/MySQL.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/MySQL.pm Sun Nov 14 14:24:51 2010
@@ -15,7 +15,7 @@
use Rose::DB;
-our $VERSION = '0.759';
+our $VERSION = '0.762';
our $Debug = 0;
@@ -230,6 +230,26 @@
(map { $hints->{$_} ? uc($_) : () } qw(high_priority straight_join)));
}
+sub format_select_lock
+{
+ my($self, $class, $lock, $tables_list) = @_;
+
+ $lock = { type => $lock } unless(ref $lock);
+
+ $lock->{'type'} ||= 'for update' if($lock->{'for_update'});
+
+ my %types =
+ (
+ 'for update' => 'FOR UPDATE',
+ 'shared' => 'LOCK IN SHARE MODE',
+ );
+
+ my $sql = $types{$lock->{'type'}}
+ or Carp::croak "Invalid lock type: $lock->{'type'}";
+
+ return $sql;
+}
+
sub validate_date_keyword
{
no warnings;
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Oracle.pm Sun Nov 14 14:24:51 2010
@@ -9,7 +9,7 @@
our $Debug = 0;
-our $VERSION = '0.761';
+our $VERSION = '0.762';
use Rose::Class::MakeMethods::Generic
(
@@ -461,6 +461,74 @@
}
}
+sub format_select_lock
+{
+ my($self, $class, $lock, $tables) = @_;
+
+ $lock = { type => $lock } unless(ref $lock);
+
+ $lock->{'type'} ||= 'for update' if($lock->{'for_update'});
+
+ unless($lock->{'type'} eq 'for update')
+ {
+ Carp::croak "Invalid lock type: $lock->{'type'}";
+ }
+
+ my $sql = 'FOR UPDATE';
+
+ my @columns;
+
+ if(my $on = $lock->{'on'})
+ {
+ @columns = map { $self->column_sql_from_lock_on_value($class, $_, $tables) } @$on;
+ }
+ elsif(my $columns = $lock->{'columns'})
+ {
+ my %map;
+
+ if($tables)
+ {
+ my $tn = 1;
+
+ foreach my $table (@$tables)
+ {
+ (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
+ $map{$table_key} = 't' . $tn++;
+ }
+ }
+
+ @columns = map
+ {
+ ref $_ eq 'SCALAR' ? $$_ :
+ /^([^.]+)\.([^.]+)$/ ?
+ $self->auto_quote_column_with_table($2, defined $map{$1} ? $map{$1} : $1) :
+ $self->auto_quote_column_name($_)
+ }
+ @$columns;
+ }
+
+ if(@columns)
+ {
+ $sql .= ' OF ' . join(', ', @columns);
+ }
+
+ if($lock->{'nowait'})
+ {
+ $sql .= ' NOWAIT';
+ }
+ elsif(my $wait = $lock->{'wait'})
+ {
+ $sql .= " WAIT $wait";
+ }
+
+ if($lock->{'skip_locked'})
+ {
+ $sql .= ' SKIP LOCKED';
+ }
+
+ return $sql;
+}
+
sub format_boolean { $_[1] ? 't' : 'f' }
#
Modified: branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm?rev=64898&op=diff
==============================================================================
--- branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm (original)
+++ branches/upstream/librose-db-perl/current/lib/Rose/DB/Pg.pm Sun Nov 14 14:24:51 2010
@@ -97,6 +97,62 @@
#}
return undef;
+}
+
+sub format_select_lock
+{
+ my($self, $class, $lock, $tables_list) = @_;
+
+ $lock = { type => $lock } unless(ref $lock);
+
+ $lock->{'type'} ||= 'for update' if($lock->{'for_update'});
+
+ my %types =
+ (
+ 'for update' => 'FOR UPDATE',
+ 'shared' => 'FOR SHARE',
+ );
+
+ my $sql = $types{$lock->{'type'}}
+ or Carp::croak "Invalid lock type: $lock->{'type'}";
+
+ my @tables;
+
+ if(my $on = $lock->{'on'})
+ {
+ @tables = map { $self->table_sql_from_lock_on_value($class, $_, $tables_list) } @$on;
+ }
+ elsif(my $lock_tables = $lock->{'tables'})
+ {
+ my %map;
+
+ if($tables_list)
+ {
+ my $tn = 1;
+
+ foreach my $table (@$tables_list)
+ {
+ (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
+ $map{$table_key} = 't' . $tn++;
+ }
+ }
+
+ @tables = map
+ {
+ ref $_ eq 'SCALAR' ? $$_ :
+ $self->auto_quote_table_name(defined $map{$_} ? $map{$_} : $_)
+ }
+ @$lock_tables;
+ }
+
+ if(@tables)
+ {
+ $sql .= ' OF ' . join(', ', @tables);
+ }
+
+ $sql .= ' NOWAIT' if($lock->{'nowait'});
+
+ return $sql;
}
sub parse_datetime
More information about the Pkg-perl-cvs-commits
mailing list