Initial Commit

database/perl/vendor/lib/DBIx/Class/SQLMaker/ACCESS.pm

@@ -0,0 +1,34 @@
+package # Hide from PAUSE
+  DBIx::Class::SQLMaker::ACCESS;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::SQLMaker';
+
+# inner joins must be prefixed with 'INNER '
+sub new {
+  my $class = shift;
+  my $self  = $class->next::method(@_);
+
+  $self->{_default_jointype} = 'INNER';
+
+  return $self;
+}
+
+# MSAccess is retarded wrt multiple joins in FROM - it requires a certain
+# way of parenthesizing each left part before each next right part
+sub _recurse_from {
+  my @j = shift->_gen_from_blocks(@_);
+
+  # first 2 steps need no parenthesis
+  my $fin_join = join (' ', splice @j, 0, 2);
+
+  while (@j) {
+    $fin_join = sprintf '( %s ) %s', $fin_join, (shift @j);
+  }
+
+  # the entire FROM is *ALSO* expected parenthesized
+  "( $fin_join )";
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/SQLMaker/LimitDialects.pm

@@ -0,0 +1,189 @@
+# because of how loose dep specs are, we need to keep squatting
+# on the CPAN face - FOREVER.
+package DBIx::Class::SQLMaker::LimitDialects;
+
+use warnings;
+use strict;
+
+##
+## Compat in case someone is using these in the wild...
+##
+
+my $sigh = sub {
+  require DBIx::Class::_Util;
+  require DBIx::Class::SQLMaker;
+
+  my( $meth ) = (caller(1))[3] =~ /([^:]+)$/;
+
+  DBIx::Class::_Util::emit_loud_diag(
+    skip_frames => 1,
+    msg => "The $meth() constant is now provided by DBIx::Class::SQLMaker::ClassicExtensions: please adjust your code"
+  );
+
+  DBIx::Class::SQLMaker::ClassicExtensions->$meth;
+};
+
+sub __rows_bindtype { $sigh->() }
+sub __offset_bindtype { $sigh->() }
+sub __total_bindtype { $sigh->() }
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::SQLMaker::LimitDialects - SQL::Abstract::Limit-like functionality in DBIx::Class::SQLMaker
+
+=head1 DESCRIPTION
+
+DBIC's SQLMaker stack replicates and surpasses all of the functionality
+originally found in L<SQL::Abstract::Limit>. While simple limits would
+work as-is, the more complex dialects that require e.g. subqueries could
+not be reliably implemented without taking full advantage of the metadata
+locked within L<DBIx::Class::ResultSource> classes. After reimplementation
+of close to 80% of the L<SQL::Abstract::Limit> functionality it was deemed
+more practical to simply make an independent DBIx::Class-specific
+limit-dialect provider.
+
+=head1 SQL LIMIT DIALECTS
+
+Note that the actual implementations listed below never use C<*> literally.
+Instead proper re-aliasing of selectors and order criteria is done, so that
+the limit dialect are safe to use on joined resultsets with clashing column
+names.
+
+Currently the provided dialects are:
+
+=head2 LimitOffset
+
+ SELECT ... LIMIT $limit OFFSET $offset
+
+Supported by B<PostgreSQL> and B<SQLite>
+
+=head2 LimitXY
+
+ SELECT ... LIMIT $offset, $limit
+
+Supported by B<MySQL> and any L<SQL::Statement> based DBD
+
+=head2 RowNumberOver
+
+ SELECT * FROM (
+  SELECT *, ROW_NUMBER() OVER( ORDER BY ... ) AS RNO__ROW__INDEX FROM (
+   SELECT ...
+  )
+ ) WHERE RNO__ROW__INDEX BETWEEN ($offset+1) AND ($limit+$offset)
+
+
+ANSI standard Limit/Offset implementation. Supported by B<DB2> and
+B<< MSSQL >= 2005 >>.
+
+=head2 SkipFirst
+
+ SELECT SKIP $offset FIRST $limit * FROM ...
+
+Supported by B<Informix>, almost like LimitOffset. According to
+L<SQL::Abstract::Limit> C<... SKIP $offset LIMIT $limit ...> is also supported.
+
+=head2 FirstSkip
+
+ SELECT FIRST $limit SKIP $offset * FROM ...
+
+Supported by B<Firebird/Interbase>, reverse of SkipFirst. According to
+L<SQL::Abstract::Limit> C<... ROWS $limit TO $offset ...> is also supported.
+
+=head2 RowNum
+
+Depending on the resultset attributes one of:
+
+ SELECT * FROM (
+  SELECT *, ROWNUM AS rownum__index FROM (
+   SELECT ...
+  ) WHERE ROWNUM <= ($limit+$offset)
+ ) WHERE rownum__index >= ($offset+1)
+
+or
+
+ SELECT * FROM (
+  SELECT *, ROWNUM AS rownum__index FROM (
+    SELECT ...
+  )
+ ) WHERE rownum__index BETWEEN ($offset+1) AND ($limit+$offset)
+
+or
+
+ SELECT * FROM (
+    SELECT ...
+  ) WHERE ROWNUM <= ($limit+1)
+
+Supported by B<Oracle>.
+
+=head2 Top
+
+ SELECT * FROM
+
+ SELECT TOP $limit FROM (
+  SELECT TOP $limit FROM (
+   SELECT TOP ($limit+$offset) ...
+  ) ORDER BY $reversed_original_order
+ ) ORDER BY $original_order
+
+Unreliable Top-based implementation, supported by B<< MSSQL < 2005 >>.
+
+=head3 CAVEAT
+
+Due to its implementation, this limit dialect returns B<incorrect results>
+when $limit+$offset > total amount of rows in the resultset.
+
+=head2 FetchFirst
+
+ SELECT * FROM
+ (
+ SELECT * FROM (
+  SELECT * FROM (
+   SELECT * FROM ...
+  ) ORDER BY $reversed_original_order
+    FETCH FIRST $limit ROWS ONLY
+ ) ORDER BY $original_order
+   FETCH FIRST $limit ROWS ONLY
+ )
+
+Unreliable FetchFirst-based implementation, supported by B<< IBM DB2 <= V5R3 >>.
+
+=head3 CAVEAT
+
+Due to its implementation, this limit dialect returns B<incorrect results>
+when $limit+$offset > total amount of rows in the resultset.
+
+=head2 GenericSubQ
+
+ SELECT * FROM (
+  SELECT ...
+ )
+ WHERE (
+  SELECT COUNT(*) FROM $original_table cnt WHERE cnt.id < $original_table.id
+ ) BETWEEN $offset AND ($offset+$rows-1)
+
+This is the most evil limit "dialect" (more of a hack) for I<really> stupid
+databases. It works by ordering the set by some unique column, and calculating
+the amount of rows that have a less-er value (thus emulating a L</RowNum>-like
+index). Of course this implies the set can only be ordered by a single unique
+column.
+
+Also note that this technique can be and often is B<excruciatingly slow>. You
+may have much better luck using L<DBIx::Class::ResultSet/software_limit>
+instead.
+
+Currently used by B<Sybase ASE>, due to lack of any other option.
+
+=head1 FURTHER QUESTIONS?
+
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
+
+=head1 COPYRIGHT AND LICENSE
+
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.

database/perl/vendor/lib/DBIx/Class/SQLMaker/MSSQL.pm

@@ -0,0 +1,16 @@
+package # Hide from PAUSE
+  DBIx::Class::SQLMaker::MSSQL;
+
+use warnings;
+use strict;
+
+use base qw( DBIx::Class::SQLMaker );
+
+#
+# MSSQL does not support ... OVER() ... RNO limits
+#
+sub _rno_default_order {
+  return \ '(SELECT(1))';
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/SQLMaker/MySQL.pm

@@ -0,0 +1,115 @@
+package # Hide from PAUSE
+  DBIx::Class::SQLMaker::MySQL;
+
+use warnings;
+use strict;
+
+use base qw( DBIx::Class::SQLMaker );
+
+#
+# MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
+# Adjust SQL here instead
+#
+sub insert {
+  my $self = shift;
+
+  if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
+    my $table = $self->_quote($_[0]);
+    return "INSERT INTO ${table} () VALUES ()"
+  }
+
+  return $self->next::method (@_);
+}
+
+# Allow STRAIGHT_JOIN's
+sub _generate_join_clause {
+    my ($self, $join_type) = @_;
+
+    if( $join_type && $join_type =~ /^STRAIGHT\z/i ) {
+        return ' STRAIGHT_JOIN '
+    }
+
+    return $self->next::method($join_type);
+}
+
+my $force_double_subq;
+$force_double_subq = sub {
+  my ($self, $sql) = @_;
+
+  require Text::Balanced;
+  my $new_sql;
+  while (1) {
+
+    my ($prefix, $parenthesized);
+
+    ($parenthesized, $sql, $prefix) = do {
+      # idiotic design - writes to $@ but *DOES NOT* throw exceptions
+      local $@;
+      Text::Balanced::extract_bracketed( $sql, '()', qr/[^\(]*/ );
+    };
+
+    # this is how an error is indicated, in addition to crapping in $@
+    last unless $parenthesized;
+
+    if ($parenthesized =~ $self->{_modification_target_referenced_re}) {
+      # is this a select subquery?
+      if ( $parenthesized =~ /^ \( \s* SELECT \s+ /xi ) {
+        $parenthesized = "( SELECT * FROM $parenthesized `_forced_double_subquery` )";
+      }
+      # then drill down until we find it (if at all)
+      else {
+        $parenthesized =~ s/^ \( (.+) \) $/$1/x;
+        $parenthesized = join ' ', '(', $self->$force_double_subq( $parenthesized ), ')';
+      }
+    }
+
+    $new_sql .= $prefix . $parenthesized;
+  }
+
+  return $new_sql . $sql;
+};
+
+sub update {
+  my $self = shift;
+
+  # short-circuit unless understood identifier
+  return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
+
+  my ($sql, @bind) = $self->next::method(@_);
+
+  $sql = $self->$force_double_subq($sql)
+    if $sql =~ $self->{_modification_target_referenced_re};
+
+  return ($sql, @bind);
+}
+
+sub delete {
+  my $self = shift;
+
+  # short-circuit unless understood identifier
+  return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
+
+  my ($sql, @bind) = $self->next::method(@_);
+
+  $sql = $self->$force_double_subq($sql)
+    if $sql =~ $self->{_modification_target_referenced_re};
+
+  return ($sql, @bind);
+}
+
+# LOCK IN SHARE MODE
+my $for_syntax = {
+   update => 'FOR UPDATE',
+   shared => 'LOCK IN SHARE MODE'
+};
+
+sub _lock_select {
+   my ($self, $type) = @_;
+
+   my $sql = $for_syntax->{$type}
+    || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
+
+   return " $sql";
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/SQLMaker/Oracle.pm

@@ -0,0 +1,257 @@
+package # Hide from PAUSE
+  DBIx::Class::SQLMaker::Oracle;
+
+use warnings;
+use strict;
+
+use base qw( DBIx::Class::SQLMaker );
+
+BEGIN {
+  use DBIx::Class::Optional::Dependencies;
+  die('The following extra modules are required for Oracle-based Storages ' . DBIx::Class::Optional::Dependencies->req_missing_for ('id_shortener') . "\n" )
+    unless DBIx::Class::Optional::Dependencies->req_ok_for ('id_shortener');
+}
+
+sub new {
+  my $self = shift;
+  my %opts = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
+  push @{$opts{special_ops}}, {
+    regex => qr/^prior$/i,
+    handler => '_where_field_PRIOR',
+  };
+
+  $self->next::method(\%opts);
+}
+
+sub _assemble_binds {
+  my $self = shift;
+  return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where oracle_connect_by group having order limit/);
+}
+
+
+sub _parse_rs_attrs {
+    my $self = shift;
+    my ($rs_attrs) = @_;
+
+    my ($cb_sql, @cb_bind) = $self->_connect_by($rs_attrs);
+    push @{$self->{oracle_connect_by_bind}}, @cb_bind;
+
+    my $sql = $self->next::method(@_);
+
+    return "$cb_sql $sql";
+}
+
+sub _connect_by {
+    my ($self, $attrs) = @_;
+
+    my $sql = '';
+    my @bind;
+
+    if ( ref($attrs) eq 'HASH' ) {
+        if ( $attrs->{'start_with'} ) {
+            my ($ws, @wb) = $self->_recurse_where( $attrs->{'start_with'} );
+            $sql .= $self->_sqlcase(' start with ') . $ws;
+            push @bind, @wb;
+        }
+        if ( my $connect_by = $attrs->{'connect_by'} || $attrs->{'connect_by_nocycle'} ) {
+            my ($connect_by_sql, @connect_by_sql_bind) = $self->_recurse_where( $connect_by );
+            $sql .= sprintf(" %s %s",
+                ( $attrs->{'connect_by_nocycle'} ) ? $self->_sqlcase('connect by nocycle')
+                    : $self->_sqlcase('connect by'),
+                $connect_by_sql,
+            );
+            push @bind, @connect_by_sql_bind;
+        }
+        if ( $attrs->{'order_siblings_by'} ) {
+            $sql .= $self->_order_siblings_by( $attrs->{'order_siblings_by'} );
+        }
+    }
+
+    return wantarray ? ($sql, @bind) : $sql;
+}
+
+sub _order_siblings_by {
+    my ( $self, $arg ) = @_;
+
+    my ( @sql, @bind );
+    for my $c ( $self->_order_by_chunks($arg) ) {
+        if (ref $c) {
+            push @sql, shift @$c;
+            push @bind, @$c;
+        }
+        else {
+            push @sql, $c;
+        }
+    }
+
+    my $sql =
+      @sql
+      ? sprintf( '%s %s', $self->_sqlcase(' order siblings by'), join( ', ', @sql ) )
+      : '';
+
+    return wantarray ? ( $sql, @bind ) : $sql;
+}
+
+# we need to add a '=' only when PRIOR is used against a column directly
+# i.e. when it is invoked by a special_op callback
+sub _where_field_PRIOR {
+  my ($self, $lhs, $op, $rhs) = @_;
+  my ($sql, @bind) = $self->_recurse_where ($rhs);
+
+  $sql = sprintf ('%s = %s %s ',
+    $self->_convert($self->_quote($lhs)),
+    $self->_sqlcase ($op),
+    $sql
+  );
+
+  return ($sql, @bind);
+}
+
+# use this codepath to hook all identifiers and mangle them if necessary
+# this is invoked regardless of quoting being on or off
+sub _quote {
+  my ($self, $label) = @_;
+
+  return '' unless defined $label;
+  return ${$label} if ref($label) eq 'SCALAR';
+
+  $label =~ s/ ( [^\.]{31,} ) /$self->_shorten_identifier($1)/gxe;
+
+  $self->next::method($label);
+}
+
+# this takes an identifier and shortens it if necessary
+# optionally keywords can be passed as an arrayref to generate useful
+# identifiers
+sub _shorten_identifier {
+  my ($self, $to_shorten, $keywords) = @_;
+
+  # 30 characters is the identifier limit for Oracle
+  my $max_len = 30;
+  # we want at least 10 characters of the base36 md5
+  my $min_entropy = 10;
+
+  my $max_trunc = $max_len - $min_entropy - 1;
+
+  return $to_shorten
+    if length($to_shorten) <= $max_len;
+
+  $self->throw_exception("'keywords' needs to be an arrayref")
+    if defined $keywords && ref $keywords ne 'ARRAY';
+
+  # if no keywords are passed use the identifier as one
+  my @keywords = @{$keywords || []};
+  @keywords = $to_shorten unless @keywords;
+
+  # get a base36 md5 of the identifier
+  require Digest::MD5;
+  require Math::BigInt;
+  require Math::Base36;
+  my $b36sum = Math::Base36::encode_base36(
+    Math::BigInt->from_hex (
+      '0x' . Digest::MD5::md5_hex ($to_shorten)
+    )
+  );
+
+  # switch from perl to java
+  # get run-length
+  my ($concat_len, @lengths);
+  for (@keywords) {
+    $_ = ucfirst (lc ($_));
+    $_ =~ s/\_+(\w)/uc ($1)/eg;
+
+    push @lengths, length ($_);
+    $concat_len += $lengths[-1];
+  }
+
+  # if we are still too long - try to disemvowel non-capitals (not keyword starts)
+  if ($concat_len > $max_trunc) {
+    $concat_len = 0;
+    @lengths = ();
+
+    for (@keywords) {
+      $_ =~ s/[aeiou]//g;
+
+      push @lengths, length ($_);
+      $concat_len += $lengths[-1];
+    }
+  }
+
+  # still too long - just start cutting proportionally
+  if ($concat_len > $max_trunc) {
+    my $trim_ratio = $max_trunc / $concat_len;
+
+    for my $i (0 .. $#keywords) {
+      $keywords[$i] = substr ($keywords[$i], 0, int ($trim_ratio * $lengths[$i] ) );
+    }
+  }
+
+  my $fin = join ('', @keywords);
+  my $fin_len = length $fin;
+
+  return sprintf ('%s_%s',
+    $fin,
+    substr ($b36sum, 0, $max_len - $fin_len - 1),
+  );
+}
+
+sub _unqualify_colname {
+  my ($self, $fqcn) = @_;
+
+  return $self->_shorten_identifier($self->next::method($fqcn));
+}
+
+#
+# Oracle has a different INSERT...RETURNING syntax
+#
+
+sub _insert_returning {
+  my ($self, $options) = @_;
+
+  my $f = $options->{returning};
+
+  my ($f_list, @f_names) = do {
+    if (! ref $f) {
+      (
+        $self->_quote($f),
+        $f,
+      )
+    }
+    elsif (ref $f eq 'ARRAY') {
+      (
+        (join ', ', map { $self->_quote($_) } @$f),
+        @$f,
+      )
+    }
+    elsif (ref $f eq 'SCALAR') {
+      (
+        $$f,
+        $$f,
+      )
+    }
+    else {
+      $self->throw_exception("Unsupported INSERT RETURNING option $f");
+    }
+  };
+
+  my $rc_ref = $options->{returning_container}
+    or $self->throw_exception('No returning container supplied for IR values');
+
+  @$rc_ref = (undef) x @f_names;
+
+  return (
+    ( join (' ',
+      $self->_sqlcase(' returning'),
+      $f_list,
+      $self->_sqlcase('into'),
+      join (', ', ('?') x @f_names ),
+    )),
+    map {
+      $self->{bindtype} eq 'columns'
+        ? [ $f_names[$_] => \$rc_ref->[$_] ]
+        : \$rc_ref->[$_]
+    } (0 .. $#f_names),
+  );
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/SQLMaker/OracleJoins.pm

@@ -0,0 +1,186 @@
+package DBIx::Class::SQLMaker::OracleJoins;
+
+use warnings;
+use strict;
+
+use base qw( DBIx::Class::SQLMaker::Oracle );
+
+sub select {
+  my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
+
+  # pull out all join conds as regular WHEREs from all extra tables
+  if (ref($table) eq 'ARRAY') {
+    $where = $self->_oracle_joins($where, @{ $table }[ 1 .. $#$table ]);
+  }
+
+  return $self->next::method($table, $fields, $where, $rs_attrs, @rest);
+}
+
+sub _recurse_from {
+  my ($self, $from, @join) = @_;
+
+  my @sqlf = $self->_from_chunk_to_sql($from);
+
+  for (@join) {
+    my ($to, $on) = @$_;
+
+    if (ref $to eq 'ARRAY') {
+      push (@sqlf, $self->_recurse_from(@{ $to }));
+    }
+    else {
+      push (@sqlf, $self->_from_chunk_to_sql($to));
+    }
+  }
+
+  return join q{, }, @sqlf;
+}
+
+sub _oracle_joins {
+  my ($self, $where, @join) = @_;
+  my $join_where = $self->_recurse_oracle_joins(@join);
+
+  if (keys %$join_where) {
+    if (!defined($where)) {
+      $where = $join_where;
+    } else {
+      if (ref($where) eq 'ARRAY') {
+        $where = { -or => $where };
+      }
+      $where = { -and => [ $join_where, $where ] };
+    }
+  }
+  return $where;
+}
+
+sub _recurse_oracle_joins {
+  my $self = shift;
+
+  my @where;
+  for my $j (@_) {
+    my ($to, $on) = @{ $j };
+
+    push @where, $self->_recurse_oracle_joins(@{ $to })
+      if (ref $to eq 'ARRAY');
+
+    my $join_opts  = ref $to eq 'ARRAY' ? $to->[0] : $to;
+    my $left_join  = q{};
+    my $right_join = q{};
+
+    if (ref $join_opts eq 'HASH' and my $jt = $join_opts->{-join_type}) {
+      #TODO: Support full outer joins -- this would happen much earlier in
+      #the sequence since oracle 8's full outer join syntax is best
+      #described as INSANE.
+      $self->throw_exception("Can't handle full outer joins in Oracle 8 yet!\n")
+        if $jt =~ /full/i;
+
+      $left_join  = q{(+)} if $jt =~ /left/i
+        && $jt !~ /inner/i;
+
+      $right_join = q{(+)} if $jt =~ /right/i
+        && $jt !~ /inner/i;
+    }
+
+    # FIXME - the code below *UTTERLY* doesn't work with custom conds... sigh
+    # for the time being do not do any processing with the likes of _collapse_cond
+    # instead only unroll the -and hack if present
+    $on = $on->{-and}[0] if (
+      ref $on eq 'HASH'
+        and
+      keys %$on == 1
+        and
+      ref $on->{-and} eq 'ARRAY'
+        and
+      @{$on->{-and}} == 1
+    );
+
+
+    push @where, map { \do {
+        my ($sql) = $self->_recurse_where({
+          # FIXME - more borkage, more or less a copy of the kludge in ::SQLMaker::_join_condition()
+          $_ => ( length ref $on->{$_}
+            ? $on->{$_}
+            : { -ident => $on->{$_} }
+          )
+        });
+
+        $sql =~ s/\s*\=/$left_join =/
+          if $left_join;
+
+        "$sql$right_join";
+      }
+    } sort keys %$on;
+  }
+
+  return { -and => \@where };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::SQLMaker::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
+
+=head1 PURPOSE
+
+This module is used with Oracle < 9.0 due to lack of support for standard
+ANSI join syntax.
+
+=head1 SYNOPSIS
+
+Not intended for use directly; used as the sql_maker_class for schemas and components.
+
+=head1 DESCRIPTION
+
+Implements pre-ANSI joins specified in the where clause.  Instead of:
+
+    SELECT x FROM y JOIN z ON y.id = z.id
+
+It will write:
+
+    SELECT x FROM y, z WHERE y.id = z.id
+
+It should properly support left joins, and right joins.  Full outer joins are
+not possible due to the fact that Oracle requires the entire query be written
+to union the results of a left and right join, and by the time this module is
+called to create the where query and table definition part of the sql query,
+it's already too late.
+
+=head1 METHODS
+
+=over
+
+=item select
+
+Overrides DBIx::Class::SQLMaker's select() method, which calls _oracle_joins()
+to modify the column and table list before calling next::method().
+
+=back
+
+=head1 BUGS
+
+Does not support full outer joins (however neither really does DBIC itself)
+
+=head1 SEE ALSO
+
+=over
+
+=item L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
+
+=item L<DBIx::Class::SQLMaker> - Parent module
+
+=item L<DBIx::Class> - Duh
+
+=back
+
+=head1 FURTHER QUESTIONS?
+
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
+
+=head1 COPYRIGHT AND LICENSE
+
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.

database/perl/vendor/lib/DBIx/Class/SQLMaker/Role/SQLA2Passthrough.pm

@@ -0,0 +1,209 @@
+package DBIx::Class::SQLMaker::Role::SQLA2Passthrough;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+our @EXPORT = qw(on);
+
+sub on (&) {
+  my ($on) = @_;
+  sub {
+    my ($args) = @_;
+    $args->{self_resultsource}
+         ->schema->storage->sql_maker
+         ->expand_join_condition(
+             $on->($args),
+             $args
+           );
+  }
+}
+
+use Role::Tiny;
+
+around select => sub {
+  my ($orig, $self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
+
+  $fields = \[ $self->render_expr({ -list => [
+    grep defined,
+    map +(ref($_) eq 'HASH'
+          ? do {
+              my %f = %$_;
+              my $as = delete $f{-as};
+              my ($f, $rhs) = %f;
+              my $func = +{ ($f =~ /^-/ ? $f : "-${f}") => $rhs };
+              ($as
+                ? +{ -op => [ 'as', $func, { -ident => [ $as ] } ] }
+                : $func)
+            }
+          : $_), ref($fields) eq 'ARRAY' ? @$fields : $fields
+  ] }, -ident) ];
+
+  if (my $gb = $rs_attrs->{group_by}) {
+    $rs_attrs = {
+      %$rs_attrs,
+      group_by => \[ $self->render_expr({ -list => $gb }, -ident) ]
+    };
+  }
+  $self->$orig($table, $fields, $where, $rs_attrs, $limit, $offset);
+};
+
+sub expand_join_condition {
+  my ($self, $cond, $args) = @_;
+  my ($type, %known) = do {
+    if (my $obj = $args->{self_result_object}) {
+      (self => $obj->get_columns)
+    } elsif (my $val = $args->{foreign_values}) {
+      (foreign => %$val)
+    } else {
+      ('')
+    }
+  };
+  my $maybe = $type ? 1 : 0;
+  my $outside;
+  my $wrap = sub {
+    my ($orig) = @_;
+    $outside = $orig;
+    sub {
+      my $res = $orig->(@_);
+      my ($name, $col) = @{$res->{-ident}};
+      if ($name eq 'self' or $name eq 'foreign') {
+        if ($type eq $name) {
+          $maybe = 0 unless exists $known{$col};
+        }
+        return { -ident => [ $args->{"${name}_alias"}, $col ] };
+      }
+      return $res;
+    };
+  };
+  my $sqla = $self->clone->wrap_op_expander(ident => $wrap);
+  my $aqt = $sqla->expand_expr($cond, -ident);
+  return $aqt unless $maybe;
+  my $inner_wrap = sub {
+    my $res = $outside->(@_);
+    my ($name, $col) = @{$res->{-ident}};
+    if ($name eq 'self' or $name eq 'foreign') {
+      if ($type eq $name) {
+        return { -bind => [ $args->{"${name}_alias"}.'.'.$col, $known{$col} ] };
+      }
+      return { -ident => [ $args->{"${name}_alias"}, $col ] };
+    }
+    return $res;
+  };
+  $sqla->op_expander(ident => $inner_wrap);
+  my $inner_aqt = $self->_collapsify($sqla->expand_expr($cond, -ident));
+  return ($aqt, $inner_aqt);
+}
+
+sub _collapsify {
+  my ($self, $aqt) = @_;
+  return $aqt unless my @opargs = @{$aqt->{-op}};
+  my ($logop, @args) = @opargs;
+  return $aqt unless $logop eq 'and';
+  my %collapsed = map {
+    my $q = $_;
+    return $aqt unless my @opargs = @{$q->{-op}};
+    my ($op, $lhs, @rest) = @opargs;
+    return $aqt unless my @ident = @{$lhs->{-ident}};
+    (join('.', @ident), { $op => \@rest });
+  } @args;
+  return \%collapsed;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::SQLMaker::Role::SQLA2Passthrough - A test of future possibilities
+
+=head1 SYNOPSIS
+
+=over 4
+
+=item * select and group_by options are processed using the richer SQLA2 code
+
+=item * expand_join_condition is provided to more easily express rich joins
+
+=back
+
+See C<examples/sqla2passthrough.pl> for a small amount of running code.
+
+=head1 SETUP
+
+  (on_connect_call => sub {
+     my ($storage) = @_;
+     $storage->sql_maker
+             ->with::roles('DBIx::Class::SQLMaker::Role::SQLA2Passthrough');
+  })
+
+=head2 expand_join_condition
+
+  __PACKAGE__->has_many(minions => 'Blah::Person' => sub {
+    my ($args) = @_;
+    $args->{self_resultsource}
+         ->schema->storage->sql_maker
+         ->expand_join_condition(
+             $args
+           );
+  });
+
+=head2 on
+
+  __PACKAGE__->has_many(minions => 'Blah::Person' => on {
+    { 'self.group_id' => 'foreign.group_id',
+      'self.rank' => { '>', 'foreign.rank' } }
+  });
+
+Or with ParameterizedJoinHack,
+
+  __PACKAGE__->parameterized_has_many(
+      priority_tasks => 'MySchema::Result::Task',
+      [['min_priority'] => sub {
+          my $args = shift;
+          return +{
+              "$args->{foreign_alias}.owner_id" => {
+                  -ident => "$args->{self_alias}.id",
+              },
+              "$args->{foreign_alias}.priority" => {
+                  '>=' => $_{min_priority},
+              },
+          };
+      }],
+  );
+
+becomes
+
+  __PACKAGE__->parameterized_has_many(
+      priority_tasks => 'MySchema::Result::Task',
+      [['min_priority'] => on {
+        { 'foreign.owner_id' => 'self.id',
+          'foreign.priority' => { '>=', { -value => $_{min_priority} } } }
+      }]
+  );
+
+Note that foreign/self can appear in such a condition on either side, BUT
+if you want L<DBIx::Class> to be able to use a join-less version you must
+ensure that the LHS is all foreign columns, i.e.
+
+  on {
+    +{
+      'foreign.x' => 'self.x',
+      'self.y' => { -between => [ 'foreign.y1', 'foreign.y2' ] }
+    }
+  }
+
+is completely valid but DBIC will insist on doing a JOIN even if you
+have a fully populated row object to call C<search_related> on - to avoid
+the spurious JOIN, you must specify it with explicit LHS foreign cols as:
+
+  on {
+    +{
+      'foreign.x' => 'self.x',
+      'foreign.y1' => { '<=', 'self.y' },
+      'foreign.y2' => { '>=', 'self.y' },
+    }
+  }
+
+=cut

database/perl/vendor/lib/DBIx/Class/SQLMaker/SQLite.pm

@@ -0,0 +1,14 @@
+package # Hide from PAUSE
+  DBIx::Class::SQLMaker::SQLite;
+
+use warnings;
+use strict;
+
+use base qw( DBIx::Class::SQLMaker );
+
+#
+# SQLite does not understand SELECT ... FOR UPDATE
+# Disable it here
+sub _lock_select () { '' };
+
+1;