r64900 - in /trunk/librose-db-perl: Changes META.yml debian/changelog 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:27:12 UTC 2010


Author: gregoa
Date: Sun Nov 14 14:27:03 2010
New Revision: 64900

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=64900
Log:
New upstream release 0.762.

Modified:
    trunk/librose-db-perl/Changes
    trunk/librose-db-perl/META.yml
    trunk/librose-db-perl/debian/changelog
    trunk/librose-db-perl/lib/Rose/DB.pm
    trunk/librose-db-perl/lib/Rose/DB/MySQL.pm
    trunk/librose-db-perl/lib/Rose/DB/Oracle.pm
    trunk/librose-db-perl/lib/Rose/DB/Pg.pm

Modified: trunk/librose-db-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/Changes?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/Changes (original)
+++ trunk/librose-db-perl/Changes Sun Nov 14 14:27:03 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: trunk/librose-db-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/META.yml?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/META.yml (original)
+++ trunk/librose-db-perl/META.yml Sun Nov 14 14:27:03 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Rose-DB
-version:            0.761
+version:            0.762
 abstract:           ~
 author:  []
 license:            perl

Modified: trunk/librose-db-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/debian/changelog?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/debian/changelog (original)
+++ trunk/librose-db-perl/debian/changelog Sun Nov 14 14:27:03 2010
@@ -1,4 +1,4 @@
-librose-db-perl (0.761-1) UNRELEASED; urgency=low
+librose-db-perl (0.762-1) UNRELEASED; urgency=low
 
   WAITS-FOR libdatetime-format-oracle-perl
 
@@ -8,8 +8,9 @@
 
   [ gregor herrmann ]
   * New upstream release 0.761.
+  * New upstream release 0.762.
 
- -- gregor herrmann <gregoa at debian.org>  Sun, 23 May 2010 17:50:35 +0200
+ -- gregor herrmann <gregoa at debian.org>  Sun, 14 Nov 2010 15:25:37 +0100
 
 librose-db-perl (0.758-1) unstable; urgency=low
 

Modified: trunk/librose-db-perl/lib/Rose/DB.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/lib/Rose/DB.pm?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/lib/Rose/DB.pm (original)
+++ trunk/librose-db-perl/lib/Rose/DB.pm Sun Nov 14 14:27:03 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: trunk/librose-db-perl/lib/Rose/DB/MySQL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/lib/Rose/DB/MySQL.pm?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/lib/Rose/DB/MySQL.pm (original)
+++ trunk/librose-db-perl/lib/Rose/DB/MySQL.pm Sun Nov 14 14:27:03 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: trunk/librose-db-perl/lib/Rose/DB/Oracle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/lib/Rose/DB/Oracle.pm?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/lib/Rose/DB/Oracle.pm (original)
+++ trunk/librose-db-perl/lib/Rose/DB/Oracle.pm Sun Nov 14 14:27:03 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: trunk/librose-db-perl/lib/Rose/DB/Pg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/librose-db-perl/lib/Rose/DB/Pg.pm?rev=64900&op=diff
==============================================================================
--- trunk/librose-db-perl/lib/Rose/DB/Pg.pm (original)
+++ trunk/librose-db-perl/lib/Rose/DB/Pg.pm Sun Nov 14 14:27:03 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