Initial Commit

database/perl/vendor/lib/DBIx/Class/Storage/BlockRunner.pm

@@ -0,0 +1,229 @@
+package # hide from pause until we figure it all out
+  DBIx::Class::Storage::BlockRunner;
+
+use warnings;
+use strict;
+
+use DBIx::Class::Exception;
+use DBIx::Class::Carp;
+use Context::Preserve 'preserve_context';
+use DBIx::Class::_Util qw(is_exception qsub);
+use Scalar::Util qw(weaken blessed reftype);
+use Try::Tiny;
+use Moo;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::BlockRunner - Try running a block of code until success with a configurable retry logic
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+has storage => (
+  is => 'ro',
+  required => 1,
+);
+
+has wrap_txn => (
+  is => 'ro',
+  required => 1,
+);
+
+# true - retry, false - rethrow, or you can throw your own (not catching)
+has retry_handler => (
+  is => 'ro',
+  required => 1,
+  isa => qsub q{
+    (Scalar::Util::reftype($_[0])||'') eq 'CODE'
+      or DBIx::Class::Exception->throw('retry_handler must be a CODE reference')
+  },
+);
+
+has retry_debug => (
+  is => 'rw',
+  # use a sub - to be evaluated on the spot lazily
+  default => qsub '$ENV{DBIC_STORAGE_RETRY_DEBUG}',
+  lazy => 1,
+);
+
+has max_attempts => (
+  is => 'ro',
+  default => 20,
+);
+
+has failed_attempt_count => (
+  is => 'ro',
+  init_arg => undef,  # ensures one can't pass the value in
+  writer => '_set_failed_attempt_count',
+  default => 0,
+  lazy => 1,
+  trigger => qsub q{
+    $_[0]->throw_exception( sprintf (
+      'Reached max_attempts amount of %d, latest exception: %s',
+      $_[0]->max_attempts, $_[0]->last_exception
+    )) if $_[0]->max_attempts <= ($_[1]||0);
+  },
+);
+
+has exception_stack => (
+  is => 'ro',
+  init_arg => undef,
+  clearer => '_reset_exception_stack',
+  default => qsub q{ [] },
+  lazy => 1,
+);
+
+sub last_exception { shift->exception_stack->[-1] }
+
+sub throw_exception { shift->storage->throw_exception (@_) }
+
+sub run {
+  my $self = shift;
+
+  $self->_reset_exception_stack;
+  $self->_set_failed_attempt_count(0);
+
+  my $cref = shift;
+
+  $self->throw_exception('run() requires a coderef to execute as its first argument')
+    if ( reftype($cref)||'' ) ne 'CODE';
+
+  my $storage = $self->storage;
+
+  return $cref->( @_ ) if (
+    $storage->{_in_do_block}
+      and
+    ! $self->wrap_txn
+  );
+
+  local $storage->{_in_do_block} = 1 unless $storage->{_in_do_block};
+
+  return $self->_run($cref, @_);
+}
+
+# this is the actual recursing worker
+sub _run {
+  # internal method - we know that both refs are strong-held by the
+  # calling scope of run(), hence safe to weaken everything
+  weaken( my $self = shift );
+  weaken( my $cref = shift );
+
+  my $args = @_ ? \@_ : [];
+
+  # from this point on (defined $txn_init_depth) is an indicator for wrap_txn
+  # save a bit on method calls
+  my $txn_init_depth = $self->wrap_txn ? $self->storage->transaction_depth : undef;
+  my $txn_begin_ok;
+
+  my $run_err = '';
+
+  return preserve_context {
+    try {
+      if (defined $txn_init_depth) {
+        $self->storage->txn_begin;
+        $txn_begin_ok = 1;
+      }
+      $cref->( @$args );
+    } catch {
+      $run_err = $_;
+      (); # important, affects @_ below
+    };
+  } replace => sub {
+    my @res = @_;
+
+    my $storage = $self->storage;
+    my $cur_depth = $storage->transaction_depth;
+
+    if (defined $txn_init_depth and ! is_exception $run_err) {
+      my $delta_txn = (1 + $txn_init_depth) - $cur_depth;
+
+      if ($delta_txn) {
+        # a rollback in a top-level txn_do is valid-ish (seen in the wild and our own tests)
+        carp (sprintf
+          'Unexpected reduction of transaction depth by %d after execution of '
+        . '%s, skipping txn_commit()',
+          $delta_txn,
+          $cref,
+        ) unless $delta_txn == 1 and $cur_depth == 0;
+      }
+      else {
+        $run_err = eval { $storage->txn_commit; 1 } ? '' : $@;
+      }
+    }
+
+    # something above threw an error (could be the begin, the code or the commit)
+    if ( is_exception $run_err ) {
+
+      # attempt a rollback if we did begin in the first place
+      if ($txn_begin_ok) {
+        # some DBDs go crazy if there is nothing to roll back on, perform a soft-check
+        my $rollback_exception = $storage->_seems_connected
+          ? (! eval { $storage->txn_rollback; 1 }) ? $@ : ''
+          : 'lost connection to storage'
+        ;
+
+        if ( $rollback_exception and (
+          ! defined blessed $rollback_exception
+            or
+          ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
+        ) ) {
+          $run_err = "Transaction aborted: $run_err. Rollback failed: $rollback_exception";
+        }
+      }
+
+      push @{ $self->exception_stack }, $run_err;
+
+      # this will throw if max_attempts is reached
+      $self->_set_failed_attempt_count($self->failed_attempt_count + 1);
+
+      # init depth of > 0 ( > 1 with AC) implies nesting - no retry attempt queries
+      $storage->throw_exception($run_err) if (
+        (
+          defined $txn_init_depth
+            and
+          # FIXME - we assume that $storage->{_dbh_autocommit} is there if
+          # txn_init_depth is there, but this is a DBI-ism
+          $txn_init_depth > ( $storage->{_dbh_autocommit} ? 0 : 1 )
+        ) or ! $self->retry_handler->($self)
+      );
+
+      # we got that far - let's retry
+      carp( sprintf 'Retrying %s (attempt %d) after caught exception: %s',
+        $cref,
+        $self->failed_attempt_count + 1,
+        $run_err,
+      ) if $self->retry_debug;
+
+      $storage->ensure_connected;
+      # if txn_depth is > 1 this means something was done to the
+      # original $dbh, otherwise we would not get past the preceding if()
+      $storage->throw_exception(sprintf
+        'Unexpected transaction depth of %d on freshly connected handle',
+        $storage->transaction_depth,
+      ) if (defined $txn_init_depth and $storage->transaction_depth);
+
+      return $self->_run($cref, @$args);
+    }
+
+    return wantarray ? @res : $res[0];
+  };
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ACCESS.pm

@@ -0,0 +1,138 @@
+package DBIx::Class::Storage::DBI::ACCESS;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI::UniqueIdentifier';
+use mro 'c3';
+
+use DBI ();
+
+__PACKAGE__->sql_limit_dialect ('Top');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::ACCESS');
+__PACKAGE__->sql_quote_char ([qw/[ ]/]);
+
+sub sqlt_type { 'ACCESS' }
+
+__PACKAGE__->new_guid(undef);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ACCESS - Support specific to MS Access
+
+=head1 DESCRIPTION
+
+This is the base class for Microsoft Access support.
+
+This driver supports L<last_insert_id|DBIx::Class::Storage::DBI/last_insert_id>,
+empty inserts for tables with C<AUTOINCREMENT> columns, nested transactions via
+L<auto_savepoint|DBIx::Class::Storage::DBI/auto_savepoint>, C<GUID> columns via
+L<DBIx::Class::Storage::DBI::UniqueIdentifier>.
+
+=head1 SUPPORTED VERSIONS
+
+This module has currently only been tested on MS Access 2010.
+
+Information about how well it works on different version of MS Access is welcome
+(write the mailing list, or submit a ticket to RT if you find bugs.)
+
+=head1 USING GUID COLUMNS
+
+If you have C<GUID> PKs or other C<GUID> columns with
+L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> you will need to set a
+L<new_guid|DBIx::Class::Storage::DBI::UniqueIdentifier/new_guid> callback, like
+so:
+
+  $schema->storage->new_guid(sub { Data::GUID->new->as_string });
+
+Under L<Catalyst> you can use code similar to this in your
+L<Catalyst::Model::DBIC::Schema> C<Model.pm>:
+
+  after BUILD => sub {
+    my $self = shift;
+    $self->storage->new_guid(sub { Data::GUID->new->as_string });
+  };
+
+=cut
+
+sub _dbh_last_insert_id { $_[1]->selectrow_array('select @@identity') }
+
+# support empty insert
+sub insert {
+  my $self = shift;
+  my ($source, $to_insert) = @_;
+
+  my $columns_info = $source->columns_info;
+
+  if (keys %$to_insert == 0) {
+    my ($autoinc_col) = grep {
+      $columns_info->{$_}{is_auto_increment}
+    } keys %$columns_info;
+
+    $self->throw_exception(
+      'empty insert only supported for tables with an autoincrement column'
+    ) unless $autoinc_col;
+
+    my $table = $source->from;
+    $table = $$table if ref $table;
+
+    $to_insert->{$autoinc_col} = \"dmax('${autoinc_col}', '${table}')+1";
+  }
+
+  return $self->next::method(@_);
+}
+
+sub bind_attribute_by_data_type {
+  my $self = shift;
+  my ($data_type) = @_;
+
+  my $attributes = $self->next::method(@_) || {};
+
+  if ($self->_is_text_lob_type($data_type)) {
+    $attributes->{TYPE} = DBI::SQL_LONGVARCHAR;
+  }
+  elsif ($self->_is_binary_lob_type($data_type)) {
+    $attributes->{TYPE} = DBI::SQL_LONGVARBINARY;
+  }
+
+  return $attributes;
+}
+
+# savepoints are not supported, but nested transactions are.
+# Unfortunately DBI does not support nested transactions.
+# WARNING: this code uses the undocumented 'BegunWork' DBI attribute.
+
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+
+  local $self->_dbh->{AutoCommit} = 1;
+  local $self->_dbh->{BegunWork}  = 0;
+  $self->_exec_txn_begin;
+}
+
+# A new nested transaction on the same level releases the previous one.
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  local $self->_dbh->{AutoCommit} = 0;
+  local $self->_dbh->{BegunWork}  = 1;
+  $self->_exec_txn_rollback;
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO.pm

@@ -0,0 +1,93 @@
+package DBIx::Class::Storage::DBI::ADO;
+
+use warnings;
+use strict;
+
+use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
+
+use Sub::Name;
+use Try::Tiny;
+use DBIx::Class::_Util 'sigwarn_silencer';
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO - Support for L<DBD::ADO>
+
+=head1 DESCRIPTION
+
+This class provides a mechanism for discovering and loading a sub-class
+for a specific ADO backend, as well as some workarounds for L<DBD::ADO>. It
+should be transparent to the user.
+
+=cut
+
+sub _rebless { shift->_determine_connector_driver('ADO') }
+
+# cleanup some warnings from DBD::ADO
+# RT#65563, not fixed as of DBD::ADO v2.98
+sub _dbh_get_info {
+  my $self = shift;
+
+  local $SIG{__WARN__} = sigwarn_silencer(
+    qr{^Missing argument in sprintf at \S+/ADO/GetInfo\.pm}
+  );
+
+  $self->next::method(@_);
+}
+
+# Monkeypatch out the horrible warnings during global destruction.
+# A patch to DBD::ADO has been submitted as well, and it was fixed
+# as of 2.99
+# https://rt.cpan.org/Ticket/Display.html?id=65563
+sub _init {
+  unless ($DBD::ADO::__DBIC_MONKEYPATCH_CHECKED__) {
+    require DBD::ADO;
+
+    unless (try { DBD::ADO->VERSION('2.99'); 1 }) {
+      no warnings 'redefine';
+      my $disconnect = *DBD::ADO::db::disconnect{CODE};
+
+      *DBD::ADO::db::disconnect = subname 'DBD::ADO::db::disconnect' => sub {
+        local $SIG{__WARN__} = sigwarn_silencer(
+          qr/Not a Win32::OLE object|uninitialized value/
+        );
+        $disconnect->(@_);
+      };
+    }
+
+    $DBD::ADO::__DBIC_MONKEYPATCH_CHECKED__ = 1;
+  }
+}
+
+# Here I was just experimenting with ADO cursor types, left in as a comment in
+# case you want to as well. See the DBD::ADO docs.
+#sub _prepare_sth {
+#  my ($self, $dbh, $sql) = @_;
+#
+#  my $sth = $self->disable_sth_caching
+#    ? $dbh->prepare($sql, { CursorType => 'adOpenStatic' })
+#    : $dbh->prepare_cached($sql, { CursorType => 'adOpenStatic' }, 3);
+#
+#  $self->throw_exception($dbh->errstr) if !$sth;
+#
+#  $sth;
+#}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO/CursorUtils.pm

@@ -0,0 +1,42 @@
+package # hide from PAUSE
+    DBIx::Class::Storage::DBI::ADO::CursorUtils;
+
+use strict;
+use warnings;
+use base 'Exporter';
+
+our @EXPORT_OK = qw/_normalize_guids _strip_trailing_binary_nulls/;
+
+sub _strip_trailing_binary_nulls {
+  my ($select, $col_infos, $data, $storage) = @_;
+
+  foreach my $select_idx (0..$#$select) {
+
+    next unless defined $data->[$select_idx];
+
+    my $data_type = $col_infos->{$select->[$select_idx]}{data_type}
+      or next;
+
+    $data->[$select_idx] =~ s/\0+\z//
+      if $storage->_is_binary_type($data_type);
+  }
+}
+
+sub _normalize_guids {
+  my ($select, $col_infos, $data, $storage) = @_;
+
+  foreach my $select_idx (0..$#$select) {
+
+    next unless defined $data->[$select_idx];
+
+    my $data_type = $col_infos->{$select->[$select_idx]}{data_type}
+      or next;
+
+    $data->[$select_idx] =~ s/\A \{ (.+) \} \z/$1/xs
+      if $storage->_is_guid_type($data_type);
+  }
+}
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO/MS_Jet.pm

@@ -0,0 +1,159 @@
+package DBIx::Class::Storage::DBI::ADO::MS_Jet;
+
+use strict;
+use warnings;
+use base qw/
+  DBIx::Class::Storage::DBI::ADO
+  DBIx::Class::Storage::DBI::ACCESS
+/;
+use mro 'c3';
+use DBIx::Class::Storage::DBI::ADO::CursorUtils '_normalize_guids';
+use namespace::clean;
+
+__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor');
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO::MS_Jet - Support for MS Access over ADO
+
+=head1 DESCRIPTION
+
+This driver is a subclass of L<DBIx::Class::Storage::DBI::ADO> and
+L<DBIx::Class::Storage::DBI::ACCESS> for connecting to MS Access via
+L<DBD::ADO>.
+
+See the documentation for L<DBIx::Class::Storage::DBI::ACCESS> for
+information on the MS Access driver for L<DBIx::Class>.
+
+This driver implements workarounds for C<TEXT/IMAGE/MEMO> columns, sets the
+L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to
+L<DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor> to normalize returned
+C<GUID> values and provides L<DBIx::Class::InflateColumn::DateTime> support
+for C<DATETIME> columns.
+
+=head1 EXAMPLE DSNs
+
+  # older Access versions:
+  dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
+
+  # newer Access versions:
+  dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'
+
+=head1 TEXT/IMAGE/MEMO COLUMNS
+
+The ADO driver does not suffer from the
+L<problems|DBIx::Class::Storage::DBI::ODBC::ACCESS/"TEXT/IMAGE/MEMO COLUMNS">
+the L<ODBC|DBIx::Class::Storage::DBI::ODBC::ACCESS> driver has with these types
+of columns. You can use them safely.
+
+When you execute a C<CREATE TABLE> statement over this driver with a C<TEXT>
+column, it will be converted to C<MEMO>, while in the
+L<ODBC|DBIx::Class::Storage::DBI::ODBC::ACCESS> driver it is converted to
+C<VARCHAR(255)>.
+
+However, the caveat about L<LongReadLen|DBI/LongReadLen> having to be twice the
+max size of your largest C<MEMO/TEXT> column C<+1> still applies. L<DBD::ADO>
+sets L<LongReadLen|DBI/LongReadLen> to a large value by default, so it should be
+safe to just leave it unset. If you do pass a L<LongReadLen|DBI/LongReadLen> in
+your L<connect_info|DBIx::Class::Storage::DBI/connect_info>, it will be
+multiplied by two and C<1> added, just as for the
+L<ODBC|DBIx::Class::Storage::DBI::ODBC::ACCESS> driver.
+
+=cut
+
+# set LongReadLen = LongReadLen * 2 + 1 (see docs on MEMO)
+sub _run_connection_actions {
+  my $self = shift;
+
+  my $long_read_len = $self->_dbh->{LongReadLen};
+
+# This is the DBD::ADO default.
+  if ($long_read_len != 2147483647) {
+    $self->_dbh->{LongReadLen} = $long_read_len * 2 + 1;
+  }
+
+  return $self->next::method(@_);
+}
+
+# AutoCommit does not get reset properly after transactions for some reason
+# (probably because of my nested transaction hacks in ACCESS.pm) fix it up
+# here.
+
+sub _exec_txn_commit {
+  my $self = shift;
+  $self->next::method(@_);
+  $self->_dbh->{AutoCommit} = $self->_dbh_autocommit
+    if $self->{transaction_depth} == 1;
+}
+
+sub _exec_txn_rollback {
+  my $self = shift;
+  $self->next::method(@_);
+  $self->_dbh->{AutoCommit} = $self->_dbh_autocommit
+    if $self->{transaction_depth} == 1;
+}
+
+# Fix up GUIDs for ->find, for cursors see the cursor_class above.
+
+sub select_single {
+  my $self = shift;
+  my ($ident, $select) = @_;
+
+  my @row = $self->next::method(@_);
+
+  return @row unless
+    $self->cursor_class->isa('DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor');
+
+  my $col_infos = $self->_resolve_column_info($ident);
+
+  _normalize_guids($select, $col_infos, \@row, $self);
+
+  return @row;
+}
+
+sub datetime_parser_type {
+  'DBIx::Class::Storage::DBI::ADO::MS_Jet::DateTime::Format'
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::ADO::MS_Jet::DateTime::Format;
+
+my $datetime_format = '%m/%d/%Y %I:%M:%S %p';
+my $datetime_parser;
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->format_datetime(shift);
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO/MS_Jet/Cursor.pm

@@ -0,0 +1,82 @@
+package DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI::Cursor';
+use mro 'c3';
+use DBIx::Class::Storage::DBI::ADO::CursorUtils '_normalize_guids';
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor - GUID Support for MS Access over
+ADO
+
+=head1 DESCRIPTION
+
+This class is for normalizing GUIDs retrieved from Microsoft Access over ADO.
+
+You probably don't want to be here, see
+L<DBIx::Class::Storage::DBI::ACCESS> for information on the Microsoft
+Access driver.
+
+Unfortunately when using L<DBD::ADO>, GUIDs come back wrapped in braces, the
+purpose of this class is to remove them.
+L<DBIx::Class::Storage::DBI::ADO::MS_Jet> sets
+L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to this class by default.
+It is overridable via your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
+
+You can use L<DBIx::Class::Cursor::Cached> safely with this class and not lose
+the GUID normalizing functionality,
+L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data
+for the inner cursor class.
+
+=cut
+
+sub next {
+  my $self = shift;
+
+  my @row = $self->next::method(@_);
+
+  _normalize_guids(
+    $self->args->[1],
+    $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]),
+    \@row,
+    $self->storage
+  );
+
+  return @row;
+}
+
+sub all {
+  my $self = shift;
+
+  my @rows = $self->next::method(@_);
+
+  _normalize_guids(
+    $self->args->[1],
+    $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]),
+    $_,
+    $self->storage
+  ) for @rows;
+
+  return @rows;
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm

@@ -0,0 +1,454 @@
+package DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server;
+
+use strict;
+use warnings;
+
+use base qw/
+  DBIx::Class::Storage::DBI::ADO
+  DBIx::Class::Storage::DBI::MSSQL
+/;
+use mro 'c3';
+use DBIx::Class::Carp;
+use DBIx::Class::Storage::DBI::ADO::CursorUtils qw/_normalize_guids _strip_trailing_binary_nulls/;
+use namespace::clean;
+
+__PACKAGE__->cursor_class(
+  'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor'
+);
+
+__PACKAGE__->datetime_parser_type (
+  'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format'
+);
+
+__PACKAGE__->new_guid(sub {
+    my $self = shift;
+    my $guid = $self->_get_dbh->selectrow_array('SELECT NEWID()');
+    $guid =~ s/\A \{ (.+) \} \z/$1/xs;
+    return $guid;
+});
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server - Support for Microsoft
+SQL Server via DBD::ADO
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL server connections via L<DBD::ADO>.
+
+=head1 DESCRIPTION
+
+The MSSQL specific functionality is provided by
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+=head1 EXAMPLE DSN
+
+  dbi:ADO:provider=sqlncli10;server=EEEBOX\SQLEXPRESS
+
+=head1 CAVEATS
+
+=head2 identities
+
+C<_identity_method> is set to C<@@identity>, as C<SCOPE_IDENTITY()> doesn't work
+with L<DBD::ADO>. See L<DBIx::Class::Storage::DBI::MSSQL/IMPLEMENTATION NOTES>
+for caveats regarding this.
+
+=head2 truncation bug
+
+There is a bug with MSSQL ADO providers where data gets truncated based on the
+size of the bind sizes in the first prepare call:
+
+L<https://rt.cpan.org/Ticket/Display.html?id=52048>
+
+The C<ado_size> workaround is used (see L<DBD::ADO/ADO providers>) with the
+approximate maximum size of the data_type of the bound column, or 8000 (maximum
+VARCHAR size) if the data_type is not available.
+
+Please report problems with this driver and send patches.
+
+=head2 LongReadLen
+
+C<LongReadLen> is set to C<LongReadLen * 2 + 1> on connection as it is necessary
+for some LOB types. Be aware of this if you localize this value on the C<$dbh>
+directly.
+
+=head2 binary data
+
+Due perhaps to the ado_size workaround we use, and/or other reasons, binary data
+such as C<varbinary> column data comes back padded with trailing C<NULL> chars.
+The Cursor class for this driver
+(L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor>) removes them,
+of course if your binary data is actually C<NULL> padded that may be an issue to
+keep in mind when using this driver.
+
+=head2 uniqueidentifier columns
+
+uniqueidentifier columns come back from ADO wrapped in braces and must be
+submitted to the MSSQL ADO driver wrapped in braces. We take care of this
+transparently in this driver and the associated Cursor class
+(L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor>) so that you
+don't have to use braces in most cases (except in literal SQL, in those cases
+you will have to add the braces yourself.)
+
+=head2 fractional seconds
+
+Fractional seconds with L<DBIx::Class::InflateColumn::DateTime> are not
+currently supported, datetimes are truncated at the second.
+
+=cut
+
+sub _init {
+  my $self = shift;
+
+# SCOPE_IDENTITY() doesn't work
+  $self->_identity_method('@@identity');
+  $self->_no_scope_identity_query(1);
+
+  return $self->next::method(@_);
+}
+
+sub _run_connection_actions {
+  my $self = shift;
+
+# make transactions work
+  require DBD::ADO::Const;
+  $self->_dbh->{ado_conn}{CursorLocation} =
+    DBD::ADO::Const->Enums->{CursorLocationEnum}{adUseClient};
+
+# set LongReadLen = LongReadLen * 2 + 1
+# this may need to be in ADO.pm, being conservative for now...
+  my $long_read_len = $self->_dbh->{LongReadLen};
+
+# This is the DBD::ADO default.
+  if ($long_read_len != 2147483647) {
+    $self->_dbh->{LongReadLen} = $long_read_len * 2 + 1;
+  }
+
+  return $self->next::method(@_);
+}
+
+
+# Fix up binary data and GUIDs for ->find, for cursors see the cursor_class
+# above.
+sub select_single {
+  my $self = shift;
+  my ($ident, $select) = @_;
+
+  my @row = $self->next::method(@_);
+
+  return @row unless $self->cursor_class->isa(
+    'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor'
+  );
+
+  my $col_infos = $self->_resolve_column_info($ident);
+
+  _normalize_guids($select, $col_infos, \@row, $self);
+
+  _strip_trailing_binary_nulls($select, $col_infos, \@row, $self);
+
+  return @row;
+}
+
+# We need to catch VARCHAR(max) before bind_attribute_by_data_type because it
+# could be specified by size, also if bind_attribute_by_data_type fails we want
+# to specify the default ado_size of 8000.
+# Also make sure GUID binds have braces on them or else ADO throws an "Invalid
+# character value for cast specification"
+
+sub _dbi_attrs_for_bind {
+  my $self = shift;
+  my ($ident, $bind) = @_;
+
+  my $lob_max = $self->_get_dbh->{LongReadLen} || 32768;
+
+  foreach my $bind (@$bind) {
+    my $attrs     = $bind->[0];
+    my $data_type = $attrs->{sqlt_datatype};
+    my $size      = $attrs->{sqlt_size};
+
+    if ($size && lc($size) eq 'max') {
+      if ($data_type =~ /^(?:varchar|character varying|nvarchar|national char varying|national character varying|varbinary)\z/i) {
+        $attrs->{dbd_attrs} = { ado_size => $lob_max };
+      }
+      else {
+        carp_unique "bizarre data_type '$data_type' with size => 'max'";
+      }
+    }
+
+    if ($self->_is_guid_type($data_type) && substr($bind->[1], 0, 1) ne '{') {
+      $bind->[1] = '{' . $bind->[1] . '}';
+    }
+  }
+
+  my $attrs = $self->next::method(@_);
+
+  foreach my $attr (@$attrs) {
+    $attr->{ado_size} ||= 8000 if $attr;
+  }
+
+  return $attrs;
+}
+
+# Can't edit all the binds in _dbi_attrs_for_bind for _insert_bulk, so we take
+# care of those GUIDs here.
+sub _insert_bulk {
+  my $self = shift;
+  my ($source, $cols, $data) = @_;
+
+  my $columns_info = $source->columns_info($cols);
+
+  my $col_idx = 0;
+  foreach my $col (@$cols) {
+    if ($self->_is_guid_type($columns_info->{$col}{data_type})) {
+      foreach my $data_row (@$data) {
+        if (substr($data_row->[$col_idx], 0, 1) ne '{') {
+          $data_row->[$col_idx] = '{' . $data_row->[$col_idx] . '}';
+        }
+      }
+    }
+    $col_idx++;
+  }
+
+  return $self->next::method(@_);
+}
+
+sub bind_attribute_by_data_type {
+  my ($self, $data_type) = @_;
+
+  $data_type = lc $data_type;
+
+  my $max_size =
+    $self->_mssql_max_data_type_representation_size_in_bytes->{$data_type};
+
+  my $res = {};
+
+  if ($max_size) {
+    $res->{ado_size} = $max_size;
+  }
+  else {
+    carp_unique "could not map data_type '$data_type' to a max size for ado_size: defaulting to 8000";
+  }
+
+  return $res;
+}
+
+# FIXME This list is an abomination. We need a way to do this outside
+# of the scope of DBIC, as it is right now nobody will ever think to
+# even look here to diagnose some sort of misbehavior.
+sub _mssql_max_data_type_representation_size_in_bytes {
+  my $self = shift;
+
+  my $lob_max = $self->_get_dbh->{LongReadLen} || 32768;
+
+  return +{
+# MSSQL types
+    char => 8000,
+    character => 8000,
+    varchar => 8000,
+    'varchar(max)' => $lob_max,
+    'character varying' => 8000,
+    binary => 8000,
+    varbinary => 8000,
+    'varbinary(max)' => $lob_max,
+    nchar => 16000,
+    'national character' => 16000,
+    'national char' => 16000,
+    nvarchar => 16000,
+    'nvarchar(max)' => ($lob_max*2),
+    'national character varying' => 16000,
+    'national char varying' => 16000,
+    numeric => 100,
+    smallint => 100,
+    tinyint => 100,
+    smallmoney => 100,
+    bigint => 100,
+    bit => 100,
+    decimal => 100,
+    dec => 100,
+    integer => 100,
+    int => 100,
+    'int identity' => 100,
+    'integer identity' => 100,
+    money => 100,
+    float => 100,
+    double => 100,
+    'double precision' => 100,
+    real => 100,
+    uniqueidentifier => 100,
+    ntext => $lob_max,
+    text => $lob_max,
+    image => $lob_max,
+    date => 100,
+    datetime => 100,
+    datetime2 => 100,
+    datetimeoffset => 100,
+    smalldatetime => 100,
+    time => 100,
+    timestamp => 100,
+    cursor => 100,
+    hierarchyid => 100,
+    rowversion => 100,
+    sql_variant => 100,
+    table => $lob_max,
+    xml => $lob_max,
+
+# mysql types
+    bool => 100,
+    boolean => 100,
+    'tinyint unsigned' => 100,
+    'smallint unsigned' => 100,
+    'mediumint unsigned' => 100,
+    'int unsigned' => 100,
+    'integer unsigned' => 100,
+    'bigint unsigned' => 100,
+    'float unsigned' => 100,
+    'double unsigned' => 100,
+    'double precision unsigned' => 100,
+    'decimal unsigned' => 100,
+    'fixed' => 100,
+    'year' => 100,
+    tinyblob => $lob_max,
+    tinytext => $lob_max,
+    blob => $lob_max,
+    text => $lob_max,
+    mediumblob => $lob_max,
+    mediumtext => $lob_max,
+    longblob => $lob_max,
+    longtext => $lob_max,
+    enum => 100,
+    set => 8000,
+
+# Pg types
+    serial => 100,
+    bigserial => 100,
+    int8 => 100,
+    integer8 => 100,
+    serial8 => 100,
+    int4 => 100,
+    integer4 => 100,
+    serial4 => 100,
+    int2 => 100,
+    integer2 => 100,
+    float8 => 100,
+    float4 => 100,
+    'bit varying' => 8000,
+    'varbit' => 8000,
+    inet => 100,
+    cidr => 100,
+    macaddr => 100,
+    'time without time zone' => 100,
+    'time with time zone' => 100,
+    'timestamp without time zone' => 100,
+    'timestamp with time zone' => 100,
+    bytea => $lob_max,
+
+# DB2 types
+    graphic => 8000,
+    vargraphic => 8000,
+    'long vargraphic' => $lob_max,
+    dbclob => $lob_max,
+    clob => $lob_max,
+    'char for bit data' => 8000,
+    'varchar for bit data' => 8000,
+    'long varchar for bit data' => $lob_max,
+
+# oracle types
+    varchar2 => 8000,
+    binary_float => 100,
+    binary_double => 100,
+    raw => 8000,
+    nclob => $lob_max,
+    long => $lob_max,
+    'long raw' => $lob_max,
+    'timestamp with local time zone' => 100,
+
+# Sybase ASE types
+    unitext => $lob_max,
+    unichar => 16000,
+    univarchar => 16000,
+
+# SQL Anywhere types
+    'long varbit' => $lob_max,
+    'long bit varying' => $lob_max,
+    uniqueidentifierstr => 100,
+    'long binary' => $lob_max,
+    'long varchar' => $lob_max,
+    'long nvarchar' => $lob_max,
+
+# Firebird types
+    'char(x) character set unicode_fss' => 16000,
+    'varchar(x) character set unicode_fss' => 16000,
+    'blob sub_type text' => $lob_max,
+    'blob sub_type text character set unicode_fss' => $lob_max,
+
+# Informix types
+    smallfloat => 100,
+    byte => $lob_max,
+    lvarchar => 8000,
+    'datetime year to fraction(5)' => 100,
+    # FIXME add other datetime types
+
+# MS Access types
+    autoincrement => 100,
+    long => 100,
+    integer4 => 100,
+    integer2 => 100,
+    integer1 => 100,
+    logical => 100,
+    logical1 => 100,
+    yesno => 100,
+    currency => 100,
+    single => 100,
+    ieeesingle => 100,
+    ieeedouble => 100,
+    number => 100,
+    string => 8000,
+    guid => 100,
+    longchar => $lob_max,
+    memo => $lob_max,
+    longbinary => $lob_max,
+  }
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format;
+
+my $datetime_format = '%m/%d/%Y %I:%M:%S %p';
+my $datetime_parser;
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->format_datetime(shift);
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server/Cursor.pm

@@ -0,0 +1,105 @@
+package DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI::Cursor';
+use mro 'c3';
+use DBIx::Class::Storage::DBI::ADO::CursorUtils qw/_normalize_guids _strip_trailing_binary_nulls/;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor - Remove trailing
+NULLs in binary data and normalize GUIDs for MSSQL over ADO
+
+=head1 DESCRIPTION
+
+This class is for removing trailing C<NULL>s from binary data and removing braces
+from GUIDs retrieved from Microsoft SQL Server over ADO.
+
+You probably don't want to be here, see
+L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server> for information on the
+Microsoft SQL Server driver for ADO and L<DBIx::Class::Storage::DBI::MSSQL> for
+the Microsoft SQL Server driver base class.
+
+Unfortunately when using L<DBD::ADO>, binary data comes back padded with
+trailing C<NULL>s and GUIDs come back wrapped in braces, the purpose of this
+class is to remove the C<NULL>s and braces.
+L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server> sets
+L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to this class by
+default. It is overridable via your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
+
+You can use L<DBIx::Class::Cursor::Cached> safely with this class and not lose
+the binary data normalizing functionality,
+L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data
+for the inner cursor class.
+
+=cut
+
+sub next {
+  my $self = shift;
+
+  my @row = $self->next::method(@_);
+
+  $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]);
+
+  _normalize_guids(
+    $self->args->[1],
+    $self->{_colinfos},
+    \@row,
+    $self->storage
+  );
+
+  _strip_trailing_binary_nulls(
+    $self->args->[1],
+    $self->{_colinfos},
+    \@row,
+    $self->storage
+  );
+
+  return @row;
+}
+
+sub all {
+  my $self = shift;
+
+  my @rows = $self->next::method(@_);
+
+  $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]);
+
+  for (@rows) {
+    _normalize_guids(
+      $self->args->[1],
+      $self->{_colinfos},
+      $_,
+      $self->storage
+    );
+
+    _strip_trailing_binary_nulls(
+      $self->args->[1],
+      $self->{_colinfos},
+      $_,
+      $self->storage
+    );
+  }
+
+  return @rows;
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/AutoCast.pm

@@ -0,0 +1,94 @@
+package DBIx::Class::Storage::DBI::AutoCast;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors('simple' => 'auto_cast' );
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::AutoCast - Storage component for RDBMS requiring explicit placeholder typing
+
+=head1 SYNOPSIS
+
+  $schema->storage->auto_cast(1);
+
+=head1 DESCRIPTION
+
+In some combinations of RDBMS and DBD drivers (e.g. FreeTDS and Sybase)
+statements with values bound to columns or conditions that are not strings will
+throw implicit type conversion errors.
+
+As long as a column L<data_type|DBIx::Class::ResultSource/add_columns> is
+defined and resolves to a base RDBMS native type via
+L<_native_data_type|DBIx::Class::Storage::DBI/_native_data_type> as
+defined in your Storage driver, the placeholder for this column will be
+converted to:
+
+  CAST(? as $mapped_type)
+
+This option can also be enabled in
+L<connect_info|DBIx::Class::Storage::DBI/connect_info> as:
+
+  on_connect_call => ['set_auto_cast']
+
+=cut
+
+sub _prep_for_execute {
+  my $self = shift;
+
+  my ($sql, $bind) = $self->next::method (@_);
+
+# If we're using ::NoBindVars, there are no binds by this point so this code
+# gets skipped.
+  if ($self->auto_cast && @$bind) {
+    my $new_sql;
+    my @sql_part = split /\?/, $sql, scalar @$bind + 1;
+    for (@$bind) {
+      my $cast_type = $self->_native_data_type($_->[0]{sqlt_datatype});
+      $new_sql .= shift(@sql_part) . ($cast_type ? "CAST(? AS $cast_type)" : '?');
+    }
+    $sql = $new_sql . shift @sql_part;
+  }
+
+  return ($sql, $bind);
+}
+
+=head2 connect_call_set_auto_cast
+
+Executes:
+
+  $schema->storage->auto_cast(1);
+
+on connection.
+
+Used as:
+
+    on_connect_call => ['set_auto_cast']
+
+in L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
+
+=cut
+
+sub connect_call_set_auto_cast {
+  my $self = shift;
+  $self->auto_cast(1);
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Cursor.pm

@@ -0,0 +1,273 @@
+package DBIx::Class::Storage::DBI::Cursor;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Cursor';
+
+use Try::Tiny;
+use Scalar::Util qw(refaddr weaken);
+use DBIx::Class::_Util 'detected_reinvoked_destructor';
+use namespace::clean;
+
+__PACKAGE__->mk_group_accessors('simple' =>
+    qw/storage args attrs/
+);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
+resultset.
+
+=head1 SYNOPSIS
+
+  my $cursor = $schema->resultset('CD')->cursor();
+
+  # raw values off the database handle in resultset columns/select order
+  my @next_cd_column_values = $cursor->next;
+
+  # list of all raw values as arrayrefs
+  my @all_cds_column_values = $cursor->all;
+
+=head1 DESCRIPTION
+
+A Cursor represents a query cursor on a L<DBIx::Class::ResultSet> object. It
+allows for traversing the result set with L</next>, retrieving all results with
+L</all> and resetting the cursor with L</reset>.
+
+Usually, you would use the cursor methods built into L<DBIx::Class::ResultSet>
+to traverse it. See L<DBIx::Class::ResultSet/next>,
+L<DBIx::Class::ResultSet/reset> and L<DBIx::Class::ResultSet/all> for more
+information.
+
+=head1 METHODS
+
+=head2 new
+
+Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
+
+=cut
+
+{
+  my %cursor_registry;
+
+  sub new {
+    my ($class, $storage, $args, $attrs) = @_;
+
+    my $self = bless {
+      storage => $storage,
+      args => $args,
+      attrs => $attrs,
+    }, ref $class || $class;
+
+    if (DBIx::Class::_ENV_::HAS_ITHREADS) {
+
+      # quick "garbage collection" pass - prevents the registry
+      # from slowly growing with a bunch of undef-valued keys
+      defined $cursor_registry{$_} or delete $cursor_registry{$_}
+        for keys %cursor_registry;
+
+      weaken( $cursor_registry{ refaddr($self) } = $self )
+    }
+
+    return $self;
+  }
+
+  sub CLONE {
+    for (keys %cursor_registry) {
+      # once marked we no longer care about them, hence no
+      # need to keep in the registry, left alone renumber the
+      # keys (all addresses are now different)
+      my $self = delete $cursor_registry{$_}
+        or next;
+
+      $self->{_intra_thread} = 1;
+    }
+  }
+}
+
+=head2 next
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: \@row_columns
+
+=back
+
+Advances the cursor to the next row and returns an array of column
+values (the result of L<DBI/fetchrow_array> method).
+
+=cut
+
+sub next {
+  my $self = shift;
+
+  return if $self->{_done};
+
+  my $sth;
+
+  if (
+    $self->{attrs}{software_limit}
+      && $self->{attrs}{rows}
+        && ($self->{_pos}||0) >= $self->{attrs}{rows}
+  ) {
+    if ($sth = $self->sth) {
+      # explicit finish will issue warnings, unlike the DESTROY below
+      $sth->finish if $sth->FETCH('Active');
+    }
+    $self->{_done} = 1;
+    return;
+  }
+
+  unless ($sth = $self->sth) {
+    (undef, $sth, undef) = $self->storage->_select( @{$self->{args}} );
+
+    $self->{_results} = [ (undef) x $sth->FETCH('NUM_OF_FIELDS') ];
+    $sth->bind_columns( \( @{$self->{_results}} ) );
+
+    if ( $self->{attrs}{software_limit} and $self->{attrs}{offset} ) {
+      $sth->fetch for 1 .. $self->{attrs}{offset};
+    }
+
+    $self->sth($sth);
+  }
+
+  if ($sth->fetch) {
+    $self->{_pos}++;
+    return @{$self->{_results}};
+  } else {
+    $self->{_done} = 1;
+    return ();
+  }
+}
+
+
+=head2 all
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: \@row_columns+
+
+=back
+
+Returns a list of arrayrefs of column values for all rows in the
+L<DBIx::Class::ResultSet>.
+
+=cut
+
+sub all {
+  my $self = shift;
+
+  # delegate to DBIC::Cursor which will delegate back to next()
+  if ($self->{attrs}{software_limit}
+        && ($self->{attrs}{offset} || $self->{attrs}{rows})) {
+    return $self->next::method(@_);
+  }
+
+  my $sth;
+
+  if ($sth = $self->sth) {
+    # explicit finish will issue warnings, unlike the DESTROY below
+    $sth->finish if ( ! $self->{_done} and $sth->FETCH('Active') );
+    $self->sth(undef);
+  }
+
+  (undef, $sth) = $self->storage->_select( @{$self->{args}} );
+
+  (
+    DBIx::Class::_ENV_::SHUFFLE_UNORDERED_RESULTSETS
+      and
+    ! $self->{attrs}{order_by}
+      and
+    require List::Util
+  )
+    ? List::Util::shuffle( @{$sth->fetchall_arrayref} )
+    : @{$sth->fetchall_arrayref}
+  ;
+}
+
+sub sth {
+  my $self = shift;
+
+  if (@_) {
+    delete @{$self}{qw/_pos _done _pid _intra_thread/};
+
+    $self->{sth} = $_[0];
+    $self->{_pid} = $$ if ! DBIx::Class::_ENV_::BROKEN_FORK and $_[0];
+  }
+  elsif ($self->{sth} and ! $self->{_done}) {
+
+    my $invalidate_handle_reason;
+
+    if (DBIx::Class::_ENV_::HAS_ITHREADS and $self->{_intra_thread} ) {
+      $invalidate_handle_reason = 'Multi-thread';
+    }
+    elsif (!DBIx::Class::_ENV_::BROKEN_FORK and $self->{_pid} != $$ ) {
+      $invalidate_handle_reason = 'Multi-process';
+    }
+
+    if ($invalidate_handle_reason) {
+      $self->storage->throw_exception("$invalidate_handle_reason access attempted while cursor in progress (position $self->{_pos})")
+        if $self->{_pos};
+
+      # reinvokes the reset logic above
+      $self->sth(undef);
+    }
+  }
+
+  return $self->{sth};
+}
+
+=head2 reset
+
+Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
+
+=cut
+
+sub reset {
+  $_[0]->__finish_sth if $_[0]->{sth};
+  $_[0]->sth(undef);
+}
+
+
+sub DESTROY {
+  return if &detected_reinvoked_destructor;
+
+  $_[0]->__finish_sth if $_[0]->{sth};
+}
+
+sub __finish_sth {
+  # It is (sadly) extremely important to finish() handles we are about
+  # to lose (due to reset() or a DESTROY() ). $rs->reset is the closest
+  # thing the user has to getting to the underlying finish() API and some
+  # DBDs mandate this (e.g. DBD::InterBase will segfault, DBD::Sybase
+  # won't start a transaction sanely, etc)
+  # We also can't use the accessor here, as it will trigger a fork/thread
+  # check, and resetting a cursor in a child is perfectly valid
+
+  my $self = shift;
+
+  # No need to care about failures here
+  try { local $SIG{__WARN__} = sub {}; $self->{sth}->finish } if (
+    $self->{sth} and ! try { ! $self->{sth}->FETCH('Active') }
+  );
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/DB2.pm

@@ -0,0 +1,87 @@
+package DBIx::Class::Storage::DBI::DB2;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->datetime_parser_type('DateTime::Format::DB2');
+__PACKAGE__->sql_quote_char ('"');
+
+# lazy-default kind of thing
+sub sql_name_sep {
+  my $self = shift;
+
+  my $v = $self->next::method(@_);
+
+  if (! defined $v and ! @_) {
+    $v = $self->next::method($self->_dbh_get_info('SQL_QUALIFIER_NAME_SEPARATOR') || '.');
+  }
+
+  return $v;
+}
+
+sub sql_limit_dialect {
+  my $self = shift;
+
+  my $v = $self->next::method(@_);
+
+  if (! defined $v and ! @_) {
+    $v = $self->next::method(
+      ($self->_server_info->{normalized_dbms_version}||0) >= 5.004
+        ? 'RowNumberOver'
+        : 'FetchFirst'
+    );
+  }
+
+  return $v;
+}
+
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
+
+  my $name_sep = $self->sql_name_sep;
+
+  my $sth = $dbh->prepare_cached(
+    # An older equivalent of 'VALUES(IDENTITY_VAL_LOCAL())', for compat
+    # with ancient DB2 versions. Should work on modern DB2's as well:
+    # http://publib.boulder.ibm.com/infocenter/db2luw/v8/topic/com.ibm.db2.udb.doc/admin/r0002369.htm?resultof=%22%73%79%73%64%75%6d%6d%79%31%22%20
+    "SELECT IDENTITY_VAL_LOCAL() FROM sysibm${name_sep}sysdummy1",
+    {},
+    3
+  );
+  $sth->execute();
+
+  my @res = $sth->fetchrow_array();
+
+  return @res ? $res[0] : undef;
+}
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::DB2 - IBM DB2 support for DBIx::Class
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for DB2, sets the limit dialect to
+RowNumberOver over FetchFirst depending on the availability of support for
+RowNumberOver, queries the server name_sep from L<DBI> and sets the L<DateTime>
+parser to L<DateTime::Format::DB2>.
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Firebird.pm

@@ -0,0 +1,34 @@
+package DBIx::Class::Storage::DBI::Firebird;
+
+use strict;
+use warnings;
+
+# Because DBD::Firebird is more or less a copy of
+# DBD::Interbase, inherit all the workarounds contained
+# in ::Storage::DBI::InterBase as opposed to inheriting
+# directly from ::Storage::DBI::Firebird::Common
+use base qw/DBIx::Class::Storage::DBI::InterBase/;
+use mro 'c3';
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Firebird - Driver for the Firebird RDBMS via
+L<DBD::Firebird>
+
+=head1 DESCRIPTION
+
+This is an empty subclass of L<DBIx::Class::Storage::DBI::InterBase> for use
+with L<DBD::Firebird>, see that driver for details.
+
+=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/Storage/DBI/Firebird/Common.pm

@@ -0,0 +1,192 @@
+package DBIx::Class::Storage::DBI::Firebird::Common;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Firebird::Common - Driver Base Class for the Firebird RDBMS
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for Firebird using C<RETURNING> as well as
+L<auto_nextval|DBIx::Class::ResultSource/auto_nextval>, savepoints and server
+version detection.
+
+=cut
+
+# set default
+__PACKAGE__->_use_insert_returning (1);
+__PACKAGE__->sql_limit_dialect ('FirstSkip');
+__PACKAGE__->sql_quote_char ('"');
+
+__PACKAGE__->datetime_parser_type(
+  'DBIx::Class::Storage::DBI::InterBase::DateTime::Format'
+);
+
+sub sqlt_type {
+  return 'Firebird';
+}
+
+sub _sequence_fetch {
+  my ($self, $nextval, $sequence) = @_;
+
+  $self->throw_exception("Can only fetch 'nextval' for a sequence")
+    if $nextval !~ /^nextval$/i;
+
+  $self->throw_exception('No sequence to fetch') unless $sequence;
+
+  my ($val) = $self->_get_dbh->selectrow_array(sprintf
+    'SELECT GEN_ID(%s, 1) FROM rdb$database',
+    $self->sql_maker->_quote($sequence)
+  );
+
+  return $val;
+}
+
+sub _dbh_get_autoinc_seq {
+  my ($self, $dbh, $source, $col) = @_;
+
+  my $table_name = $source->from;
+  $table_name    = $$table_name if ref $table_name;
+  $table_name    = $self->sql_maker->quote_char ? $table_name : uc($table_name);
+
+  local $dbh->{LongReadLen} = 100000;
+  local $dbh->{LongTruncOk} = 1;
+
+  my $sth = $dbh->prepare(<<'EOF');
+SELECT t.rdb$trigger_source
+FROM rdb$triggers t
+WHERE t.rdb$relation_name = ?
+AND t.rdb$system_flag = 0 -- user defined
+AND t.rdb$trigger_type = 1 -- BEFORE INSERT
+EOF
+  $sth->execute($table_name);
+
+  while (my ($trigger) = $sth->fetchrow_array) {
+    my @trig_cols = map
+      { /^"([^"]+)/ ? $1 : uc($_) }
+      $trigger =~ /new\.("?\w+"?)/ig
+    ;
+
+    my ($quoted, $generator) = $trigger =~
+/(?:gen_id\s* \( \s* |next \s* value \s* for \s*)(")?(\w+)/ix;
+
+    if ($generator) {
+      $generator = uc $generator unless $quoted;
+
+      return $generator
+        if grep {
+          $self->sql_maker->quote_char ? ($_ eq $col) : (uc($_) eq uc($col))
+        } @trig_cols;
+    }
+  }
+
+  return undef;
+}
+
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("SAVEPOINT $name");
+}
+
+sub _exec_svp_release {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+# http://www.firebirdfaq.org/faq223/
+sub _get_server_version {
+  my $self = shift;
+
+  return $self->_get_dbh->selectrow_array(q{
+SELECT rdb$get_context('SYSTEM', 'ENGINE_VERSION') FROM rdb$database
+  });
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::InterBase::DateTime::Format;
+
+my $timestamp_format = '%Y-%m-%d %H:%M:%S.%4N'; # %F %T
+my $date_format      = '%Y-%m-%d';
+
+my ($timestamp_parser, $date_parser);
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $timestamp_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $timestamp_format,
+    on_error => 'croak',
+  );
+  return $timestamp_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $timestamp_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $timestamp_format,
+    on_error => 'croak',
+  );
+  return $timestamp_parser->format_datetime(shift);
+}
+
+sub parse_date {
+  shift;
+  require DateTime::Format::Strptime;
+  $date_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $date_format,
+    on_error => 'croak',
+  );
+  return $date_parser->parse_datetime(shift);
+}
+
+sub format_date {
+  shift;
+  require DateTime::Format::Strptime;
+  $date_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $date_format,
+    on_error => 'croak',
+  );
+  return $date_parser->format_datetime(shift);
+}
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+C<last_insert_id> support by default only works for Firebird versions 2 or
+greater, L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> however should
+work with earlier versions.
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/IdentityInsert.pm

@@ -0,0 +1,65 @@
+package DBIx::Class::Storage::DBI::IdentityInsert;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::IdentityInsert - Storage Component for Sybase ASE and
+MSSQL for Identity Inserts / Updates
+
+=head1 DESCRIPTION
+
+This is a storage component for Sybase ASE
+(L<DBIx::Class::Storage::DBI::Sybase::ASE>) and Microsoft SQL Server
+(L<DBIx::Class::Storage::DBI::MSSQL>) to support identity inserts, that is
+inserts of explicit values into C<IDENTITY> columns.
+
+This is done by wrapping C<INSERT> operations in a pair of table identity
+toggles like:
+
+  SET IDENTITY_INSERT $table ON
+  $sql
+  SET IDENTITY_INSERT $table OFF
+
+=cut
+
+# SET IDENTITY_X only works as part of a statement scope. We can not
+# $dbh->do the $sql and the wrapping set()s individually. Hence the
+# sql mangling. The newlines are important.
+sub _prep_for_execute {
+  my $self = shift;
+
+  return $self->next::method(@_) unless $self->_autoinc_supplied_for_op;
+
+  my ($op, $ident) = @_;
+
+  my $table = $self->sql_maker->_quote($ident->name);
+  $op = uc $op;
+
+  my ($sql, $bind) = $self->next::method(@_);
+
+  return (<<EOS, $bind);
+SET IDENTITY_$op $table ON
+$sql
+SET IDENTITY_$op $table OFF
+EOS
+
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Informix.pm

@@ -0,0 +1,186 @@
+package DBIx::Class::Storage::DBI::Informix;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+use Scope::Guard ();
+use Context::Preserve 'preserve_context';
+use namespace::clean;
+
+__PACKAGE__->sql_limit_dialect ('SkipFirst');
+__PACKAGE__->sql_quote_char ('"');
+__PACKAGE__->datetime_parser_type (
+  'DBIx::Class::Storage::DBI::Informix::DateTime::Format'
+);
+
+
+__PACKAGE__->mk_group_accessors('simple' => '__last_insert_id');
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Informix - Base Storage Class for Informix Support
+
+=head1 DESCRIPTION
+
+This class implements storage-specific support for the Informix RDBMS
+
+=head1 METHODS
+
+=cut
+
+sub _execute {
+  my $self = shift;
+  my ($rv, $sth, @rest) = $self->next::method(@_);
+
+  $self->__last_insert_id($sth->{ix_sqlerrd}[1])
+    if $self->_perform_autoinc_retrieval;
+
+  return (wantarray ? ($rv, $sth, @rest) : $rv);
+}
+
+sub last_insert_id {
+  shift->__last_insert_id;
+}
+
+sub _exec_svp_begin {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("SAVEPOINT $name");
+}
+
+# can't release savepoints
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+sub with_deferred_fk_checks {
+  my ($self, $sub) = @_;
+
+  my $txn_scope_guard = $self->txn_scope_guard;
+
+  $self->_do_query('SET CONSTRAINTS ALL DEFERRED');
+
+  my $sg = Scope::Guard->new(sub {
+    $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE');
+  });
+
+  return preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+  on_connect_call => 'datetime_setup'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the C<DATE> and
+C<DATETIME> formats.
+
+Sets the following environment variables:
+
+    GL_DATE="%m/%d/%Y"
+    GL_DATETIME="%Y-%m-%d %H:%M:%S%F5"
+
+The C<DBDATE> and C<DBCENTURY> environment variables are cleared.
+
+B<NOTE:> setting the C<GL_DATE> environment variable seems to have no effect
+after the process has started, so the default format is used. The C<GL_DATETIME>
+setting does take effect however.
+
+The C<DATETIME> data type supports up to 5 digits after the decimal point for
+second precision, depending on how you have declared your column. The full
+possible precision is used.
+
+The column declaration for a C<DATETIME> with maximum precision is:
+
+  column_name DATETIME YEAR TO FRACTION(5)
+
+The C<DATE> data type stores the date portion only, and it B<MUST> be declared
+with:
+
+  data_type => 'date'
+
+in your Result class.
+
+You will need the L<DateTime::Format::Strptime> module for inflation to work.
+
+=cut
+
+sub connect_call_datetime_setup {
+  my $self = shift;
+
+  delete @ENV{qw/DBDATE DBCENTURY/};
+
+  $ENV{GL_DATE}     = "%m/%d/%Y";
+  $ENV{GL_DATETIME} = "%Y-%m-%d %H:%M:%S%F5";
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::Informix::DateTime::Format;
+
+my $timestamp_format = '%Y-%m-%d %H:%M:%S.%5N'; # %F %T
+my $date_format      = '%m/%d/%Y';
+
+my ($timestamp_parser, $date_parser);
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $timestamp_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $timestamp_format,
+    on_error => 'croak',
+  );
+  return $timestamp_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $timestamp_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $timestamp_format,
+    on_error => 'croak',
+  );
+  return $timestamp_parser->format_datetime(shift);
+}
+
+sub parse_date {
+  shift;
+  require DateTime::Format::Strptime;
+  $date_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $date_format,
+    on_error => 'croak',
+  );
+  return $date_parser->parse_datetime(shift);
+}
+
+sub format_date {
+  shift;
+  require DateTime::Format::Strptime;
+  $date_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $date_format,
+    on_error => 'croak',
+  );
+  return $date_parser->format_datetime(shift);
+}
+
+=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>.
+
+=cut
+
+1;
+

database/perl/vendor/lib/DBIx/Class/Storage/DBI/InterBase.pm

@@ -0,0 +1,165 @@
+package DBIx::Class::Storage::DBI::InterBase;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI::Firebird::Common/;
+use mro 'c3';
+use Try::Tiny;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS via
+L<DBD::InterBase>
+
+=head1 DESCRIPTION
+
+This driver is a subclass of L<DBIx::Class::Storage::DBI::Firebird::Common> for
+use with L<DBD::InterBase>, see that driver for general details.
+
+You need to use either the
+L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> option or
+L</connect_call_use_softcommit> (see L</CAVEATS>) for your code to function
+correctly with this driver. Otherwise you will likely get bizarre error messages
+such as C<no statement executing>. The alternative is to use the
+L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver, which is more suitable
+for long running processes such as under L<Catalyst>.
+
+To turn on L<DBIx::Class::InflateColumn::DateTime> support, see
+L</connect_call_datetime_setup>.
+
+=cut
+
+sub _ping {
+  my $self = shift;
+
+  my $dbh = $self->_dbh or return 0;
+
+  local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
+
+  return try {
+    $dbh->do('select 1 from rdb$database');
+    1;
+  } catch {
+    0;
+  };
+}
+
+# We want dialect 3 for new features and quoting to work, DBD::InterBase uses
+# dialect 1 (interbase compat) by default.
+sub _init {
+  my $self = shift;
+  $self->_set_sql_dialect(3);
+}
+
+sub _set_sql_dialect {
+  my $self = shift;
+  my $val  = shift || 3;
+
+  my $dsn = $self->_dbi_connect_info->[0];
+
+  return if ref($dsn) eq 'CODE';
+
+  if ($dsn !~ /ib_dialect=/) {
+    $self->_dbi_connect_info->[0] = "$dsn;ib_dialect=$val";
+    my $connected = defined $self->_dbh;
+    $self->disconnect;
+    $self->ensure_connected if $connected;
+  }
+}
+
+=head2 connect_call_use_softcommit
+
+Used as:
+
+  on_connect_call => 'use_softcommit'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the
+L<DBD::InterBase> C<ib_softcommit> option.
+
+You need either this option or C<< disable_sth_caching => 1 >> for
+L<DBIx::Class> code to function correctly (otherwise you may get C<no statement
+executing> errors.) Or use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird>
+driver.
+
+The downside of using this option is that your process will B<NOT> see UPDATEs,
+INSERTs and DELETEs from other processes for already open statements.
+
+=cut
+
+sub connect_call_use_softcommit {
+  my $self = shift;
+
+  $self->_dbh->{ib_softcommit} = 1;
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+  on_connect_call => 'datetime_setup'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
+timestamp formats using:
+
+  $dbh->{ib_time_all} = 'ISO';
+
+See L<DBD::InterBase> for more details.
+
+The C<TIMESTAMP> data type supports up to 4 digits after the decimal point for
+second precision. The full precision is used.
+
+The C<DATE> data type stores the date portion only, and it B<MUST> be declared
+with:
+
+  data_type => 'date'
+
+in your Result class.
+
+Timestamp columns can be declared with either C<datetime> or C<timestamp>.
+
+You will need the L<DateTime::Format::Strptime> module for inflation to work.
+
+For L<DBIx::Class::Storage::DBI::ODBC::Firebird>, this is a noop.
+
+=cut
+
+sub connect_call_datetime_setup {
+  my $self = shift;
+
+  $self->_get_dbh->{ib_time_all} = 'ISO';
+}
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+with L</connect_call_use_softcommit>, you will not be able to see changes made
+to data in other processes. If this is an issue, use
+L<disable_sth_caching|DBIx::Class::Storage::DBI/disable_sth_caching> as a
+workaround for the C<no statement executing> errors, this of course adversely
+affects performance.
+
+Alternately, use the L<ODBC|DBIx::Class::Storage::DBI::ODBC::Firebird> driver.
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/MSSQL.pm

@@ -0,0 +1,338 @@
+package DBIx::Class::Storage::DBI::MSSQL;
+
+use strict;
+use warnings;
+
+use base qw/
+  DBIx::Class::Storage::DBI::UniqueIdentifier
+  DBIx::Class::Storage::DBI::IdentityInsert
+/;
+use mro 'c3';
+
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+  _identity _identity_method _no_scope_identity_query
+/);
+
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL');
+
+__PACKAGE__->sql_quote_char([qw/[ ]/]);
+
+__PACKAGE__->datetime_parser_type (
+  'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
+);
+
+__PACKAGE__->new_guid('NEWID()');
+
+sub _prep_for_execute {
+  my $self = shift;
+  my ($op, $ident, $args) = @_;
+
+# cast MONEY values properly
+  if ($op eq 'insert' || $op eq 'update') {
+    my $fields = $args->[0];
+
+    my $colinfo = $ident->columns_info([keys %$fields]);
+
+    for my $col (keys %$fields) {
+      # $ident is a result source object with INSERT/UPDATE ops
+      if (
+        $colinfo->{$col}{data_type}
+          &&
+        $colinfo->{$col}{data_type} =~ /^money\z/i
+      ) {
+        my $val = $fields->{$col};
+        $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
+      }
+    }
+  }
+
+  my ($sql, $bind) = $self->next::method (@_);
+
+  # SELECT SCOPE_IDENTITY only works within a statement scope. We
+  # must try to always use this particular idiom first, as it is the
+  # only one that guarantees retrieving the correct id under high
+  # concurrency. When this fails we will fall back to whatever secondary
+  # retrieval method is specified in _identity_method, but at this
+  # point we don't have many guarantees we will get what we expected.
+  # http://msdn.microsoft.com/en-us/library/ms190315.aspx
+  # http://davidhayden.com/blog/dave/archive/2006/01/17/2736.aspx
+  if ($self->_perform_autoinc_retrieval and not $self->_no_scope_identity_query) {
+    $sql .= "\nSELECT SCOPE_IDENTITY()";
+  }
+
+  return ($sql, $bind);
+}
+
+sub _execute {
+  my $self = shift;
+
+  # always list ctx - we need the $sth
+  my ($rv, $sth, @bind) = $self->next::method(@_);
+
+  if ($self->_perform_autoinc_retrieval) {
+
+    # attempt to bring back the result of SELECT SCOPE_IDENTITY() we tacked
+    # on in _prep_for_execute above
+    my $identity;
+
+    # we didn't even try on ftds
+    unless ($self->_no_scope_identity_query) {
+      ($identity) = try { $sth->fetchrow_array };
+      $sth->finish;
+    }
+
+    # SCOPE_IDENTITY failed, but we can do something else
+    if ( (! $identity) && $self->_identity_method) {
+      ($identity) = $self->_dbh->selectrow_array(
+        'select ' . $self->_identity_method
+      );
+    }
+
+    $self->_identity($identity);
+  }
+
+  return wantarray ? ($rv, $sth, @bind) : $rv;
+}
+
+sub last_insert_id { shift->_identity }
+
+#
+# MSSQL is retarded wrt ordered subselects. One needs to add a TOP
+# to *all* subqueries, but one also *can't* use TOP 100 PERCENT
+# http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
+#
+sub _select_args_to_query {
+  #my ($self, $ident, $select, $cond, $attrs) = @_;
+  my $self = shift;
+  my $attrs = $_[3];
+
+  my $sql_bind = $self->next::method (@_);
+
+  # see if this is an ordered subquery
+  if (
+    $$sql_bind->[0] !~ /^ \s* \( \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
+      and
+    scalar $self->_extract_order_criteria ($attrs->{order_by})
+  ) {
+    $self->throw_exception(
+      'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL'
+    ) unless $attrs->{unsafe_subselect_ok};
+
+    $$sql_bind->[0] =~ s/^ \s* \( \s* SELECT (?=\s) / '(SELECT TOP ' . $self->sql_maker->__max_int /exi;
+  }
+
+  $sql_bind;
+}
+
+
+# savepoint syntax is the same as in Sybase ASE
+
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("SAVE TRANSACTION $name");
+}
+
+# A new SAVE TRANSACTION with the same name releases the previous one.
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("ROLLBACK TRANSACTION $name");
+}
+
+sub sqlt_type { 'SQLServer' }
+
+sub sql_limit_dialect {
+  my $self = shift;
+
+  my $supports_rno = 0;
+
+  if (exists $self->_server_info->{normalized_dbms_version}) {
+    $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
+  }
+  else {
+    # User is connecting via DBD::Sybase and has no permission to run
+    # stored procedures like xp_msver, or version detection failed for some
+    # other reason.
+    # So, we use a query to check if RNO is implemented.
+    try {
+      $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
+      $supports_rno = 1;
+    };
+  }
+
+  return $supports_rno ? 'RowNumberOver' : 'Top';
+}
+
+sub _ping {
+  my $self = shift;
+
+  my $dbh = $self->_dbh or return 0;
+
+  local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
+
+  return try {
+    $dbh->do('select 1');
+    1;
+  } catch {
+    0;
+  };
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
+
+my $datetime_format      = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
+my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
+
+my ($datetime_parser, $smalldatetime_parser);
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->format_datetime(shift);
+}
+
+sub parse_smalldatetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $smalldatetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $smalldatetime_format,
+    on_error => 'croak',
+  );
+  return $smalldatetime_parser->parse_datetime(shift);
+}
+
+sub format_smalldatetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $smalldatetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $smalldatetime_format,
+    on_error => 'croak',
+  );
+  return $smalldatetime_parser->format_datetime(shift);
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
+in DBIx::Class
+
+=head1 SYNOPSIS
+
+This is the base class for Microsoft SQL Server support, used by
+L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
+
+=head1 IMPLEMENTATION NOTES
+
+=head2 IDENTITY information
+
+Microsoft SQL Server supports three methods of retrieving the IDENTITY
+value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
+SCOPE_IDENTITY is used here because it is the safest.  However, it must
+be called is the same execute statement, not just the same connection.
+
+So, this implementation appends a SELECT SCOPE_IDENTITY() statement
+onto each INSERT to accommodate that requirement.
+
+C<SELECT @@IDENTITY> can also be used by issuing:
+
+  $self->_identity_method('@@identity');
+
+it will only be used if SCOPE_IDENTITY() fails.
+
+This is more dangerous, as inserting into a table with an on insert trigger that
+inserts into another table with an identity will give erroneous results on
+recent versions of SQL Server.
+
+=head2 identity insert
+
+Be aware that we have tried to make things as simple as possible for our users.
+For MSSQL that means that when a user tries to create a row, while supplying an
+explicit value for an autoincrementing column, we will try to issue the
+appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
+$table_name ON>. Unfortunately this operation in MSSQL requires the
+C<db_ddladmin> privilege, which is normally not included in the standard
+write-permissions.
+
+=head2 Ordered Subselects
+
+If you attempted the following query (among many others) in Microsoft SQL
+Server
+
+ $rs->search ({}, {
+  prefetch => 'relation',
+  rows => 2,
+  offset => 3,
+ });
+
+You may be surprised to receive an exception. The reason for this is a quirk
+in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
+to the way DBIC is built. DBIC can do truly wonderful things with the aid of
+subselects, and does so automatically when necessary. The list of situations
+when a subselect is necessary is long and still changes often, so it can not
+be exhaustively enumerated here. The general rule of thumb is a joined
+L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
+applied to the left part of the join.
+
+In its "pursuit of standards" Microsft SQL Server goes to great lengths to
+forbid the use of ordered subselects. This breaks a very useful group of
+searches like "Give me things number 4 to 6 (ordered by name), and prefetch
+all their relations, no matter how many". While there is a hack which fools
+the syntax checker, the optimizer may B<still elect to break the subselect>.
+Testing has determined that while such breakage does occur (the test suite
+contains an explicit test which demonstrates the problem), it is relative
+rare. The benefits of ordered subselects are on the other hand too great to be
+outright disabled for MSSQL.
+
+Thus compromise between usability and perfection is the MSSQL-specific
+L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
+It is deliberately not possible to set this on the Storage level, as the user
+should inspect (and preferably regression-test) the return of every such
+ResultSet individually. The example above would work if written like:
+
+ $rs->search ({}, {
+  unsafe_subselect_ok => 1,
+  prefetch => 'relation',
+  rows => 2,
+  offset => 3,
+ });
+
+If it is possible to rewrite the search() in a way that will avoid the need
+for this flag - you are urged to do so. If DBIC internals insist that an
+ordered subselect is necessary for an operation, and you believe there is a
+different/better way to get the same result - please file a bugreport.
+
+=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/Storage/DBI/NoBindVars.pm

@@ -0,0 +1,130 @@
+package DBIx::Class::Storage::DBI::NoBindVars;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
+
+=head1 DESCRIPTION
+
+This class allows queries to work when the DBD or underlying library does not
+support the usual C<?> placeholders, or at least doesn't support them very
+well, as is the case with L<DBD::Sybase>
+
+=head1 METHODS
+
+=head2 connect_info
+
+We can't cache very effectively without bind variables, so force the C<disable_sth_caching> setting to be turned on when the connect info is set.
+
+=cut
+
+sub connect_info {
+    my $self = shift;
+    my $retval = $self->next::method(@_);
+    $self->disable_sth_caching(1);
+    $retval;
+}
+
+=head2 _prep_for_execute
+
+Manually subs in the values for the usual C<?> placeholders.
+
+=cut
+
+sub _prep_for_execute {
+  my $self = shift;
+
+  my ($sql, $bind) = $self->next::method(@_);
+
+  # stringify bind args, quote via $dbh, and manually insert
+  #my ($op, $ident, $args) = @_;
+  my $ident = $_[1];
+
+  my @sql_part = split /\?/, $sql;
+  my $new_sql;
+
+  for (@$bind) {
+    my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify, array types are currently not supported
+
+    my $datatype = $_->[0]{sqlt_datatype};
+
+    $data = $self->_prep_interpolated_value($datatype, $data)
+      if $datatype;
+
+    $data = $self->_get_dbh->quote($data)
+      unless ($datatype and $self->interpolate_unquoted($datatype, $data) );
+
+    $new_sql .= shift(@sql_part) . $data;
+  }
+
+  $new_sql .= join '', @sql_part;
+
+  return ($new_sql, []);
+}
+
+=head2 interpolate_unquoted
+
+This method is called by L</_prep_for_execute> for every column in
+order to determine if its value should be quoted or not. The arguments
+are the current column data type and the actual bind value. The return
+value is interpreted as: true - do not quote, false - do quote. You should
+override this in you Storage::DBI::<database> subclass, if your RDBMS
+does not like quotes around certain datatypes (e.g. Sybase and integer
+columns). The default method returns false, except for integer datatypes
+paired with values containing nothing but digits.
+
+ WARNING!!!
+
+ Always validate that the bind-value is valid for the current datatype.
+ Otherwise you may very well open the door to SQL injection attacks.
+
+=cut
+
+sub interpolate_unquoted {
+  #my ($self, $datatype, $value) = @_;
+
+  return 1 if (
+    defined $_[2]
+      and
+    $_[1]
+      and
+    $_[2] !~ /\D/
+      and
+    $_[1] =~ /int(?:eger)? | (?:tiny|small|medium|big)int/ix
+  );
+
+  return 0;
+}
+
+=head2 _prep_interpolated_value
+
+Given a datatype and the value to be inserted directly into a SQL query, returns
+the necessary string to represent that value (by e.g. adding a '$' sign)
+
+=cut
+
+sub _prep_interpolated_value {
+  #my ($self, $datatype, $value) = @_;
+  return $_[2];
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ODBC.pm

@@ -0,0 +1,77 @@
+package DBIx::Class::Storage::DBI::ODBC;
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+use DBIx::Class::_Util 'modver_gt_or_eq';
+use namespace::clean;
+
+sub _rebless { shift->_determine_connector_driver('ODBC') }
+
+# Whether or not we are connecting via the freetds ODBC driver
+sub _using_freetds {
+  my $self = shift;
+
+  my $dsn = $self->_dbi_connect_info->[0];
+
+  return 1 if (
+    ( (! ref $dsn) and $dsn =~ /driver=FreeTDS/i)
+      or
+    ( ($self->_dbh_get_info('SQL_DRIVER_NAME')||'') =~ /tdsodbc/i )
+  );
+
+  return 0;
+}
+
+# Either returns the FreeTDS version via which we are connecting, 0 if can't
+# be determined, or undef otherwise
+sub _using_freetds_version {
+  my $self = shift;
+  return undef unless $self->_using_freetds;
+  return $self->_dbh_get_info('SQL_DRIVER_VER') || 0;
+}
+
+sub _disable_odbc_array_ops {
+  my $self = shift;
+  my $dbh  = $self->_get_dbh;
+
+  $DBD::ODBC::__DBIC_DISABLE_ARRAY_OPS_VIA__ ||= [ do {
+    if( modver_gt_or_eq('DBD::ODBC', '1.35_01') ) {
+      odbc_array_operations => 0;
+    }
+    elsif( modver_gt_or_eq('DBD::ODBC', '1.33_01') ) {
+      odbc_disable_array_operations => 1;
+    }
+  }];
+
+  if (my ($k, $v) = @$DBD::ODBC::__DBIC_DISABLE_ARRAY_OPS_VIA__) {
+    $dbh->{$k} = $v;
+  }
+}
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC - Base class for ODBC drivers
+
+=head1 DESCRIPTION
+
+This class simply provides a mechanism for discovering and loading a sub-class
+for a specific ODBC backend.  It should be transparent to the user.
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ODBC/ACCESS.pm

@@ -0,0 +1,161 @@
+package DBIx::Class::Storage::DBI::ODBC::ACCESS;
+
+use strict;
+use warnings;
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC
+  DBIx::Class::Storage::DBI::ACCESS
+/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors(inherited =>
+  'disable_sth_caching_for_image_insert_or_update'
+);
+
+__PACKAGE__->disable_sth_caching_for_image_insert_or_update(1);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::ACCESS - Support specific to MS Access over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft Access over ODBC.
+
+It is a subclass of L<DBIx::Class::Storage::DBI::ODBC> and
+L<DBIx::Class::Storage::DBI::ACCESS>, see those classes for more
+information.
+
+It is loaded automatically by L<DBIx::Class::Storage::DBI::ODBC> when it
+detects a MS Access back-end.
+
+This driver implements workarounds for C<IMAGE> and C<MEMO> columns, and
+L<DBIx::Class::InflateColumn::DateTime> support for C<DATETIME> columns.
+
+=head1 EXAMPLE DSN
+
+  dbi:ODBC:driver={Microsoft Access Driver (*.mdb, *.accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
+
+=head1 TEXT/IMAGE/MEMO COLUMNS
+
+Avoid using C<TEXT> columns as they will be truncated to 255 bytes. Some other
+drivers (like L<ADO|DBIx::Class::Storage::DBI::ADO::MS_Jet>) will automatically
+convert C<TEXT> columns to C<MEMO>, but the ODBC driver does not.
+
+C<IMAGE> columns work correctly, but the statements for inserting or updating an
+C<IMAGE> column will not be L<cached|DBI/prepare_cached>, due to a bug in the
+Access ODBC driver.
+
+C<MEMO> columns work correctly as well, but you must take care to set
+L<LongReadLen|DBI/LongReadLen> to C<$max_memo_size * 2 + 1>. This is done for
+you automatically if you pass L<LongReadLen|DBI/LongReadLen> in your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>; but if you set this
+attribute directly on the C<$dbh>, keep this limitation in mind.
+
+=cut
+
+# set LongReadLen = LongReadLen * 2 + 1 (see docs on MEMO)
+sub _run_connection_actions {
+  my $self = shift;
+
+  my $long_read_len = $self->_dbh->{LongReadLen};
+
+  # 80 is another default (just like 0) on some drivers
+  if ($long_read_len != 0 && $long_read_len != 80) {
+    $self->_dbh->{LongReadLen} = $long_read_len * 2 + 1;
+  }
+
+  # batch operations do not work
+  $self->_disable_odbc_array_ops;
+
+  return $self->next::method(@_);
+}
+
+sub insert {
+  my $self = shift;
+  my ($source, $to_insert) = @_;
+
+  my $columns_info = $source->columns_info;
+
+  my $is_image_insert = 0;
+
+  for my $col (keys %$to_insert) {
+    if ($self->_is_binary_lob_type($columns_info->{$col}{data_type})) {
+      $is_image_insert = 1;
+      last;
+    }
+  }
+
+  local $self->{disable_sth_caching} = 1 if $is_image_insert
+    && $self->disable_sth_caching_for_image_insert_or_update;
+
+  return $self->next::method(@_);
+}
+
+sub update {
+  my $self = shift;
+  my ($source, $fields) = @_;
+
+  my $columns_info = $source->columns_info;
+
+  my $is_image_insert = 0;
+
+  for my $col (keys %$fields) {
+    if ($self->_is_binary_lob_type($columns_info->{$col}{data_type})) {
+      $is_image_insert = 1;
+      last;
+    }
+  }
+
+  local $self->{disable_sth_caching} = 1 if $is_image_insert
+    && $self->disable_sth_caching_for_image_insert_or_update;
+
+  return $self->next::method(@_);
+}
+
+sub datetime_parser_type {
+  'DBIx::Class::Storage::DBI::ODBC::ACCESS::DateTime::Format'
+}
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::ODBC::ACCESS::DateTime::Format;
+
+my $datetime_format = '%Y-%m-%d %H:%M:%S'; # %F %T, no fractional part
+my $datetime_parser;
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->format_datetime(shift);
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm

@@ -0,0 +1,33 @@
+package DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL;
+
+use strict;
+use warnings;
+
+use base qw/
+    DBIx::Class::Storage::DBI::ODBC
+    DBIx::Class::Storage::DBI::DB2
+/;
+use mro 'c3';
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL - Support specific to DB2/400
+over ODBC
+
+=head1 DESCRIPTION
+
+This is an empty subclass of L<DBIx::Class::Storage::DBI::DB2>.
+
+=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/Storage/DBI/ODBC/Firebird.pm

@@ -0,0 +1,78 @@
+package DBIx::Class::Storage::DBI::ODBC::Firebird;
+
+use strict;
+use warnings;
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC
+  DBIx::Class::Storage::DBI::Firebird::Common
+/;
+use mro 'c3';
+use Try::Tiny;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::Firebird - Driver for using the Firebird RDBMS
+through ODBC
+
+=head1 DESCRIPTION
+
+Most functionality is provided by
+L<DBIx::Class::Storage::DBI::Firebird::Common>, see that driver for details.
+
+To build the ODBC driver for Firebird on Linux for unixODBC, see:
+
+L<http://www.firebirdnews.org/?p=1324>
+
+This driver does not suffer from the nested statement handles across commits
+issue that the L<DBD::InterBase|DBIx::Class::Storage::DBI::InterBase> or the
+L<DBD::Firebird|DBIx::Class::Storage::DBI::Firebird> based driver does. This
+makes it more suitable for long running processes such as under L<Catalyst>.
+
+=cut
+
+# batch operations in DBD::ODBC 1.35 do not work with the official ODBC driver
+sub _run_connection_actions {
+  my $self = shift;
+
+  if ($self->_dbh_get_info('SQL_DRIVER_NAME') eq 'OdbcFb') {
+    $self->_disable_odbc_array_ops;
+  }
+
+  return $self->next::method(@_);
+}
+
+# releasing savepoints doesn't work for some reason, but that shouldn't matter
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  try {
+    $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+  }
+  catch {
+    # Firebird ODBC driver bug, ignore
+    if (not /Unable to fetch information about the error/) {
+      $self->throw_exception($_);
+    }
+  };
+}
+
+=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>.
+
+
+=cut
+
+# vim:sts=2 sw=2:
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm

@@ -0,0 +1,326 @@
+package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server;
+use strict;
+use warnings;
+
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC
+  DBIx::Class::Storage::DBI::MSSQL
+/;
+use mro 'c3';
+use Scalar::Util 'reftype';
+use Try::Tiny;
+use DBIx::Class::Carp;
+use namespace::clean;
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+  _using_dynamic_cursors
+/);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
+to Microsoft SQL Server over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft SQL Server over ODBC.  It is
+loaded automatically by DBIx::Class::Storage::DBI::ODBC when it detects a
+MSSQL back-end.
+
+Most of the functionality is provided from the superclass
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+=head1 USAGE NOTES
+
+=head2 Basic Linux Setup (Debian)
+
+  sudo aptitude install tdsodbc libdbd-odbc-perl unixodbc
+
+In case it is not already there put the following (adjust for non-64bit arch) in
+C</etc/odbcinst.ini>:
+
+  [FreeTDS]
+  Description = FreeTDS
+  Driver      = /usr/lib/x86_64-linux-gnu/odbc/libtdsodbc.so
+  Setup       = /usr/lib/x86_64-linux-gnu/odbc/libtdsS.so
+  UsageCount  = 1
+
+Set your C<$dsn> in L<connect_info|DBIx::Class::Storage::DBI/connect_info> as follows:
+
+  dbi:ODBC:server=<my.host.name>;port=1433;driver=FreeTDS;tds_version=8.0
+
+If you use the EasySoft driver (L<http://www.easysoft.com>):
+
+  dbi:ODBC:server=<my.host.name>;port=1433;driver=Easysoft ODBC-SQL Server
+
+=head2 Basic Windows Setup
+
+Use the following C<$dsn> for the Microsoft ODBC driver:
+
+  dbi:ODBC:driver={SQL Server};server=SERVER\SQL_SERVER_INSTANCE_NAME
+
+And for the Native Client:
+
+  dbi:ODBC:driver={SQL Server Native Client 10.0};server=SERVER\SQL_SERVER_INSTANCE_NAME
+
+Go into Control Panel -> System and Security -> Administrative Tools -> Data
+Sources (ODBC) to check driver names and to set up data sources.
+
+Use System DSNs, not User DSNs if you want to use DSNs.
+
+If you set up a DSN, use the following C<$dsn> for
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>:
+
+  dbi:ODBC:dsn=MY_DSN
+
+=head1 MULTIPLE ACTIVE STATEMENTS
+
+The following options are alternative ways to enable concurrent executing
+statement support. Each has its own advantages and drawbacks and works on
+different platforms. Read each section carefully.
+
+For more details about using MAS in MSSQL over DBD::ODBC see this excellent
+document provided by EasySoft:
+L<http://www.easysoft.com/developer/languages/perl/multiple-active-statements.html>.
+
+In order of preference, they are:
+
+=over 8
+
+=item * L<mars|/connect_call_use_mars>
+
+=item * L<dynamic_cursors|/connect_call_use_dynamic_cursors>
+
+=item * L<server_cursors|/connect_call_use_server_cursors>
+
+=back
+
+=head1 METHODS
+
+=head2 connect_call_use_mars
+
+Use as:
+
+  on_connect_call => 'use_mars'
+
+in your connection info, or alternatively specify it directly:
+
+  Your::Schema->connect (
+    $original_dsn . '; MARS_Connection=Yes',
+    $user,
+    $pass,
+    \%attrs,
+  )
+
+Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result
+Sets". See L<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
+for more information.
+
+This does not work on FreeTDS drivers at the time of this writing, and only
+works with the Native Client, later versions of the Windows MS ODBC driver, and
+the Easysoft driver.
+
+=cut
+
+sub connect_call_use_mars {
+  my $self = shift;
+
+  my $dsn = $self->_dbi_connect_info->[0];
+
+  if (ref($dsn) eq 'CODE') {
+    $self->throw_exception('cannot change the DBI DSN on a CODE ref connect_info');
+  }
+
+  if ($dsn !~ /MARS_Connection=/) {
+    if ($self->_using_freetds) {
+      $self->throw_exception('FreeTDS does not support MARS at the time of '
+                            .'writing.');
+    }
+
+    if (exists $self->_server_info->{normalized_dbms_version} &&
+               $self->_server_info->{normalized_dbms_version} < 9) {
+      $self->throw_exception('SQL Server 2005 or later required to use MARS.');
+    }
+
+    if (my ($data_source) = $dsn =~ /^dbi:ODBC:([\w-]+)\z/i) { # prefix with DSN
+      carp_unique "Bare DSN in ODBC connect string, rewriting as 'dsn=$data_source'"
+          ." for MARS\n";
+      $dsn = "dbi:ODBC:dsn=$data_source";
+    }
+
+    $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
+    $self->disconnect;
+    $self->ensure_connected;
+  }
+}
+
+sub connect_call_use_MARS {
+  carp "'connect_call_use_MARS' has been deprecated, use "
+      ."'connect_call_use_mars' instead.";
+  shift->connect_call_use_mars(@_)
+}
+
+=head2 connect_call_use_dynamic_cursors
+
+Use as:
+
+  on_connect_call => 'use_dynamic_cursors'
+
+Which will add C<< odbc_cursortype => 2 >> to your DBI connection
+attributes, or alternatively specify the necessary flag directly:
+
+  Your::Schema->connect (@dsn, { ... odbc_cursortype => 2 })
+
+See L<DBD::ODBC/odbc_cursortype> for more information.
+
+If you're using FreeTDS, C<tds_version> must be set to at least C<8.0>.
+
+This will not work with CODE ref connect_info's.
+
+B<WARNING:> on FreeTDS (and maybe some other drivers) this will break
+C<SCOPE_IDENTITY()>, and C<SELECT @@IDENTITY> will be used instead, which on SQL
+Server 2005 and later will return erroneous results on tables which have an on
+insert trigger that inserts into another table with an C<IDENTITY> column.
+
+B<WARNING:> on FreeTDS, changes made in one statement (e.g. an insert) may not
+be visible from a following statement (e.g. a select.)
+
+B<WARNING:> FreeTDS versions > 0.82 seem to have completely broken the ODBC
+protocol. DBIC will not allow dynamic cursor support with such versions to
+protect your data. Please hassle the authors of FreeTDS to act on the bugs that
+make their driver not overly usable with DBD::ODBC.
+
+=cut
+
+sub connect_call_use_dynamic_cursors {
+  my $self = shift;
+
+  if (($self->_dbic_connect_attributes->{odbc_cursortype} || 0) < 2) {
+
+    my $dbi_inf = $self->_dbi_connect_info;
+
+    $self->throw_exception ('Cannot set DBI attributes on a CODE ref connect_info')
+      if ref($dbi_inf->[0]) eq 'CODE';
+
+    # reenter connection information with the attribute re-set
+    $dbi_inf->[3] = {} if @$dbi_inf <= 3;
+    $dbi_inf->[3]{odbc_cursortype} = 2;
+
+    $self->_dbi_connect_info($dbi_inf);
+
+    $self->disconnect; # resetting dbi attrs, so have to reconnect
+    $self->ensure_connected;
+  }
+}
+
+sub _run_connection_actions {
+  my $self = shift;
+
+  $self->next::method (@_);
+
+  # keep the dynamic_cursors_support and driver-state in sync
+  # on every reconnect
+  my $use_dyncursors = ($self->_dbic_connect_attributes->{odbc_cursortype} || 0) > 1;
+  if (
+    $use_dyncursors
+      xor
+    !!$self->_using_dynamic_cursors
+  ) {
+    if ($use_dyncursors) {
+      try {
+        my $dbh = $self->_dbh;
+        local $dbh->{RaiseError} = 1;
+        local $dbh->{PrintError} = 0;
+        $dbh->do('SELECT @@IDENTITY');
+      } catch {
+        $self->throw_exception (
+          'Your drivers do not seem to support dynamic cursors (odbc_cursortype => 2).'
+         . (
+          $self->_using_freetds
+            ? ' If you are using FreeTDS, make sure to set tds_version to 8.0 or greater.'
+            : ''
+          )
+        );
+      };
+
+      $self->_using_dynamic_cursors(1);
+      $self->_identity_method('@@identity');
+    }
+    else {
+      $self->_using_dynamic_cursors(0);
+      $self->_identity_method(undef);
+    }
+  }
+
+  $self->_no_scope_identity_query($self->_using_dynamic_cursors
+    ? $self->_using_freetds
+    : undef
+  );
+
+  # freetds is too damn broken, some fixups
+  if ($self->_using_freetds) {
+
+    # no dynamic cursors starting from 0.83
+    if ($self->_using_dynamic_cursors) {
+      my $fv = $self->_using_freetds_version || 999;  # assume large if can't be determined
+      $self->throw_exception(
+        'Dynamic cursors (odbc_cursortype => 2) are not supported with FreeTDS > 0.82 '
+      . "(you have $fv). Please hassle FreeTDS authors to fix the outstanding bugs in "
+      . 'their driver.'
+      ) if $fv > 0.82
+    }
+
+    # FreeTDS is too broken wrt execute_for_fetch batching
+    # just disable it outright until things quiet down
+    $self->_disable_odbc_array_ops;
+  }
+}
+
+=head2 connect_call_use_server_cursors
+
+Use as:
+
+  on_connect_call => 'use_server_cursors'
+
+May allow multiple active select statements. See
+L<DBD::ODBC/odbc_SQL_ROWSET_SIZE> for more information.
+
+Takes an optional parameter for the value to set the attribute to, default is
+C<2>.
+
+B<WARNING>: this does not work on all versions of SQL Server, and may lock up
+your database!
+
+At the time of writing, this option only works on Microsoft's Windows drivers,
+later versions of the ODBC driver and the Native Client driver.
+
+=cut
+
+sub connect_call_use_server_cursors {
+  my $self            = shift;
+  my $sql_rowset_size = shift || 2;
+
+  if ($^O !~ /win32|cygwin/i) {
+    $self->throw_exception('Server cursors only work on Windows platforms at '
+                          .'the time of writing.');
+  }
+
+  $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sw=2 sts=2 et

database/perl/vendor/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm

@@ -0,0 +1,45 @@
+package DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere;
+
+use strict;
+use warnings;
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC
+  DBIx::Class::Storage::DBI::SQLAnywhere
+/;
+use mro 'c3';
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere - Driver for using Sybase SQL
+Anywhere through ODBC
+
+=head1 SYNOPSIS
+
+All functionality is provided by L<DBIx::Class::Storage::DBI::SQLAnywhere>, see
+that module for details.
+
+=head1 CAVEATS
+
+=head2 uniqueidentifierstr data type
+
+If you use the C<uniqueidentifierstr> type with this driver, your queries may
+fail with:
+
+  Data truncated (SQL-01004)
+
+B<WORKAROUND:> use the C<uniqueidentifier> type instead, it is more efficient
+anyway.
+
+=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/Storage/DBI/Oracle.pm

@@ -0,0 +1,50 @@
+package DBIx::Class::Storage::DBI::Oracle;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+sub _rebless {
+  my ($self) = @_;
+
+  # Default driver
+  my $class = $self->_server_info->{normalized_dbms_version} < 9
+    ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins'
+    : 'DBIx::Class::Storage::DBI::Oracle::Generic';
+
+  $self->ensure_class_loaded ($class);
+  bless $self, $class;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Oracle - Base class for Oracle driver
+
+=head1 DESCRIPTION
+
+This class simply provides a mechanism for discovering and loading a sub-class
+for a specific version Oracle backend. It should be transparent to the user.
+
+For Oracle major versions < 9 it loads the ::Oracle::WhereJoins subclass,
+which unrolls the ANSI join style DBIC normally generates into entries in
+the WHERE clause for compatibility purposes. To force usage of this version
+no matter the database version, add
+
+  __PACKAGE__->storage_type('::DBI::Oracle::WhereJoins');
+
+to your Schema class.
+
+=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/Storage/DBI/Oracle/Generic.pm

@@ -0,0 +1,785 @@
+package DBIx::Class::Storage::DBI::Oracle::Generic;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+use DBIx::Class::Carp;
+use Scope::Guard ();
+use Context::Preserve 'preserve_context';
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->sql_limit_dialect ('RowNum');
+__PACKAGE__->sql_quote_char ('"');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle');
+__PACKAGE__->datetime_parser_type('DateTime::Format::Oracle');
+
+sub __cache_queries_with_max_lob_parts { 2 }
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Oracle::Generic - Oracle Support for DBIx::Class
+
+=head1 SYNOPSIS
+
+  # In your result (table) classes
+  use base 'DBIx::Class::Core';
+  __PACKAGE__->add_columns({ id => { sequence => 'mysequence', auto_nextval => 1 } });
+  __PACKAGE__->set_primary_key('id');
+
+  # Somewhere in your Code
+  # add some data to a table with a hierarchical relationship
+  $schema->resultset('Person')->create ({
+        firstname => 'foo',
+        lastname => 'bar',
+        children => [
+            {
+                firstname => 'child1',
+                lastname => 'bar',
+                children => [
+                    {
+                        firstname => 'grandchild',
+                        lastname => 'bar',
+                    }
+                ],
+            },
+            {
+                firstname => 'child2',
+                lastname => 'bar',
+            },
+        ],
+    });
+
+  # select from the hierarchical relationship
+  my $rs = $schema->resultset('Person')->search({},
+    {
+      'start_with' => { 'firstname' => 'foo', 'lastname' => 'bar' },
+      'connect_by' => { 'parentid' => { '-prior' => { -ident => 'personid' } },
+      'order_siblings_by' => { -asc => 'name' },
+    };
+  );
+
+  # this will select the whole tree starting from person "foo bar", creating
+  # following query:
+  # SELECT
+  #     me.persionid me.firstname, me.lastname, me.parentid
+  # FROM
+  #     person me
+  # START WITH
+  #     firstname = 'foo' and lastname = 'bar'
+  # CONNECT BY
+  #     parentid = prior personid
+  # ORDER SIBLINGS BY
+  #     firstname ASC
+
+=head1 DESCRIPTION
+
+This class implements base Oracle support. The subclass
+L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> is for C<(+)> joins in Oracle
+versions before 9.0.
+
+=head1 METHODS
+
+=cut
+
+sub _determine_supports_insert_returning {
+  my $self = shift;
+
+# TODO find out which version supports the RETURNING syntax
+# 8i has it and earlier docs are a 404 on oracle.com
+
+  return 1
+    if $self->_server_info->{normalized_dbms_version} >= 8.001;
+
+  return 0;
+}
+
+__PACKAGE__->_use_insert_returning_bound (1);
+
+sub deployment_statements {
+  my $self = shift;;
+  my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
+
+  $sqltargs ||= {};
+
+  if (
+    ! exists $sqltargs->{producer_args}{oracle_version}
+      and
+    my $dver = $self->_server_info->{dbms_version}
+  ) {
+    $sqltargs->{producer_args}{oracle_version} = $dver;
+  }
+
+  $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
+}
+
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, @columns) = @_;
+  my @ids = ();
+  foreach my $col (@columns) {
+    my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
+    my $id = $self->_sequence_fetch( 'CURRVAL', $seq );
+    push @ids, $id;
+  }
+  return @ids;
+}
+
+sub _dbh_get_autoinc_seq {
+  my ($self, $dbh, $source, $col) = @_;
+
+  my $sql_maker = $self->sql_maker;
+  my ($ql, $qr) = map { $_ ? (quotemeta $_) : '' } $sql_maker->_quote_chars;
+
+  my $source_name;
+  if ( ref $source->name eq 'SCALAR' ) {
+    $source_name = ${$source->name};
+
+    # the ALL_TRIGGERS match further on is case sensitive - thus uppercase
+    # stuff unless it is already quoted
+    $source_name = uc ($source_name) if $source_name !~ /\"/;
+  }
+  else {
+    $source_name = $source->name;
+    $source_name = uc($source_name) unless $ql;
+  }
+
+  # trigger_body is a LONG
+  local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+
+  # disable default bindtype
+  local $sql_maker->{bindtype} = 'normal';
+
+  # look up the correct sequence automatically
+  my ( $schema, $table ) = $source_name =~ /( (?:${ql})? \w+ (?:${qr})? ) \. ( (?:${ql})? \w+ (?:${qr})? )/x;
+
+  # if no explicit schema was requested - use the default schema (which in the case of Oracle is the db user)
+  $schema ||= \'= USER';
+
+  my ($sql, @bind) = $sql_maker->select (
+    'ALL_TRIGGERS',
+    [qw/TRIGGER_BODY TABLE_OWNER TRIGGER_NAME/],
+    {
+      OWNER => $schema,
+      TABLE_NAME => $table || $source_name,
+      TRIGGERING_EVENT => { -like => '%INSERT%' },  # this will also catch insert_or_update
+      TRIGGER_TYPE => { -like => '%BEFORE%' },      # we care only about 'before' triggers
+      STATUS => 'ENABLED',
+     },
+  );
+
+  # to find all the triggers that mention the column in question a simple
+  # regex grep since the trigger_body above is a LONG and hence not searchable
+  # via -like
+  my @triggers = ( map
+    { my %inf; @inf{qw/body schema name/} = @$_; \%inf }
+    ( grep
+      { $_->[0] =~ /\:new\.${ql}${col}${qr} | \:new\.$col/xi }
+      @{ $dbh->selectall_arrayref( $sql, {}, @bind ) }
+    )
+  );
+
+  # extract all sequence names mentioned in each trigger, throw away
+  # triggers without apparent sequences
+  @triggers = map {
+    my @seqs = $_->{body} =~ / ( [\.\w\"\-]+ ) \. nextval /xig;
+    @seqs
+      ? { %$_, sequences => \@seqs }
+      : ()
+    ;
+  } @triggers;
+
+  my $chosen_trigger;
+
+  # if only one trigger matched things are easy
+  if (@triggers == 1) {
+
+    if ( @{$triggers[0]{sequences}} == 1 ) {
+      $chosen_trigger = $triggers[0];
+    }
+    else {
+      $self->throw_exception( sprintf (
+        "Unable to introspect trigger '%s' for column '%s.%s' (references multiple sequences). "
+      . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+        $triggers[0]{name},
+        $source_name,
+        $col,
+        $col,
+      ) );
+    }
+  }
+  # got more than one matching trigger - see if we can narrow it down
+  elsif (@triggers > 1) {
+
+    my @candidates = grep
+      { $_->{body} =~ / into \s+ \:new\.$col /xi }
+      @triggers
+    ;
+
+    if (@candidates == 1 && @{$candidates[0]{sequences}} == 1) {
+      $chosen_trigger = $candidates[0];
+    }
+    else {
+      $self->throw_exception( sprintf (
+        "Unable to reliably select a BEFORE INSERT trigger for column '%s.%s' (possibilities: %s). "
+      . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+        $source_name,
+        $col,
+        ( join ', ', map { "'$_->{name}'" } @triggers ),
+        $col,
+      ) );
+    }
+  }
+
+  if ($chosen_trigger) {
+    my $seq_name = $chosen_trigger->{sequences}[0];
+
+    $seq_name = "$chosen_trigger->{schema}.$seq_name"
+      unless $seq_name =~ /\./;
+
+    return \$seq_name if $seq_name =~ /\"/; # may already be quoted in-trigger
+    return $seq_name;
+  }
+
+  $self->throw_exception( sprintf (
+    "No suitable BEFORE INSERT triggers found for column '%s.%s'. "
+  . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+    $source_name,
+    $col,
+    $col,
+  ));
+}
+
+sub _sequence_fetch {
+  my ( $self, $type, $seq ) = @_;
+
+  # use the maker to leverage quoting settings
+  my $sth = $self->_dbh->prepare_cached(
+    $self->sql_maker->select('DUAL', [ ref $seq ? \"$$seq.$type" : "$seq.$type" ] )
+  );
+  $sth->execute;
+  my ($id) = $sth->fetchrow_array;
+  $sth->finish;
+  return $id;
+}
+
+sub _ping {
+  my $self = shift;
+
+  my $dbh = $self->_dbh or return 0;
+
+  local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
+
+  return try {
+    $dbh->do('select 1 from dual');
+    1;
+  } catch {
+    0;
+  };
+}
+
+sub _dbh_execute {
+  #my ($self, $dbh, $sql, $bind, $bind_attrs) = @_;
+  my ($self, $sql, $bind) = @_[0,2,3];
+
+  # Turn off sth caching for multi-part LOBs. See _prep_for_execute below
+  local $self->{disable_sth_caching} = 1 if grep {
+    ($_->[0]{_ora_lob_autosplit_part}||0)
+      >
+    (__cache_queries_with_max_lob_parts - 1)
+  } @$bind;
+
+  my $next = $self->next::can;
+
+  # if we are already in a txn we can't retry anything
+  return shift->$next(@_)
+    if $self->transaction_depth;
+
+  # cheat the blockrunner we are just about to create
+  # we do want to rerun things regardless of outer state
+  local $self->{_in_do_block};
+
+  return DBIx::Class::Storage::BlockRunner->new(
+    storage => $self,
+    wrap_txn => 0,
+    retry_handler => sub {
+      # ORA-01003: no statement parsed (someone changed the table somehow,
+      # invalidating your cursor.)
+      if (
+        $_[0]->failed_attempt_count == 1
+          and
+        $_[0]->last_exception =~ /ORA-01003/
+          and
+        my $dbh = $_[0]->storage->_dbh
+      ) {
+        delete $dbh->{CachedKids}{$sql};
+        return 1;
+      }
+      else {
+        return 0;
+      }
+    },
+  )->run( $next, @_ );
+}
+
+sub _dbh_execute_for_fetch {
+  #my ($self, $sth, $tuple_status, @extra) = @_;
+
+  # DBD::Oracle warns loudly on partial execute_for_fetch failures
+  local $_[1]->{PrintWarn} = 0;
+
+  shift->next::method(@_);
+}
+
+=head2 get_autoinc_seq
+
+Returns the sequence name for an autoincrement column
+
+=cut
+
+sub get_autoinc_seq {
+  my ($self, $source, $col) = @_;
+
+  $self->dbh_do('_dbh_get_autoinc_seq', $source, $col);
+}
+
+=head2 datetime_parser_type
+
+This sets the proper DateTime::Format module for use with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+    on_connect_call => 'datetime_setup'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the session nls
+date, and timestamp values for use with L<DBIx::Class::InflateColumn::DateTime>
+and the necessary environment variables for L<DateTime::Format::Oracle>, which
+is used by it.
+
+Maximum allowable precision is used, unless the environment variables have
+already been set.
+
+These are the defaults used:
+
+  $ENV{NLS_DATE_FORMAT}         ||= 'YYYY-MM-DD HH24:MI:SS';
+  $ENV{NLS_TIMESTAMP_FORMAT}    ||= 'YYYY-MM-DD HH24:MI:SS.FF';
+  $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+To get more than second precision with L<DBIx::Class::InflateColumn::DateTime>
+for your timestamps, use something like this:
+
+  use Time::HiRes 'time';
+  my $ts = DateTime->from_epoch(epoch => time);
+
+=cut
+
+sub connect_call_datetime_setup {
+  my $self = shift;
+
+  my $date_format = $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
+  my $timestamp_format = $ENV{NLS_TIMESTAMP_FORMAT} ||=
+    'YYYY-MM-DD HH24:MI:SS.FF';
+  my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
+    'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+  $self->_do_query(
+    "alter session set nls_date_format = '$date_format'"
+  );
+  $self->_do_query(
+    "alter session set nls_timestamp_format = '$timestamp_format'"
+  );
+  $self->_do_query(
+    "alter session set nls_timestamp_tz_format='$timestamp_tz_format'"
+  );
+}
+
+### Note originally by Ron "Quinn" Straight <quinnfazigu@gmail.org>
+### https://github.com/Perl5/DBIx-Class/commit/5db2758de6
+#
+# Handle LOB types in Oracle.  Under a certain size (4k?), you can get away
+# with the driver assuming your input is the deprecated LONG type if you
+# encode it as a hex string.  That ain't gonna fly at larger values, where
+# you'll discover you have to do what this does.
+#
+# This method had to be overridden because we need to set ora_field to the
+# actual column, and that isn't passed to the call (provided by Storage) to
+# bind_attribute_by_data_type.
+#
+# According to L<DBD::Oracle>, the ora_field isn't always necessary, but
+# adding it doesn't hurt, and will save your bacon if you're modifying a
+# table with more than one LOB column.
+#
+sub _dbi_attrs_for_bind {
+  my ($self, $ident, $bind) = @_;
+
+  my $attrs = $self->next::method($ident, $bind);
+
+  # Push the column name into all bind attrs, make sure to *NOT* write into
+  # the existing $attrs->[$idx]{..} hashref, as it is cached by the call to
+  # next::method above.
+  $attrs->[$_]
+    and
+  keys %{ $attrs->[$_] }
+    and
+  $bind->[$_][0]{dbic_colname}
+    and
+  $attrs->[$_] = { %{$attrs->[$_]}, ora_field => $bind->[$_][0]{dbic_colname} }
+    for 0 .. $#$attrs;
+
+  $attrs;
+}
+
+sub bind_attribute_by_data_type {
+  my ($self, $dt) = @_;
+
+  if ($self->_is_lob_type($dt)) {
+
+    # this is a hot-ish codepath, store an escape-flag in the DBD namespace, so that
+    # things like Class::Unload work (unlikely but possible)
+    unless ($DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__) {
+
+      # no earlier - no later
+      if ($DBD::Oracle::VERSION eq '1.23') {
+        $self->throw_exception(
+          "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
+          "version (https://rt.cpan.org/Public/Bug/Display.html?id=46016)"
+        );
+      }
+
+      $DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__ = 1;
+    }
+
+    return {
+      ora_type => $self->_is_text_lob_type($dt)
+        ? DBD::Oracle::ORA_CLOB()
+        : DBD::Oracle::ORA_BLOB()
+    };
+  }
+  else {
+    return undef;
+  }
+}
+
+# Handle blob columns in WHERE.
+#
+# For equality comparisons:
+#
+# We split data intended for comparing to a LOB into 2000 character chunks and
+# compare them using dbms_lob.substr on the LOB column.
+#
+# We turn off DBD::Oracle LOB binds for these partial LOB comparisons by passing
+# dbd_attrs => undef, because these are regular varchar2 comparisons and
+# otherwise the query will fail.
+#
+# Since the most common comparison size is likely to be under 4000 characters
+# (TEXT comparisons previously deployed to other RDBMSes) we disable
+# prepare_cached for queries with more than two part comparisons to a LOB
+# column. This is done in _dbh_execute (above) which was previously overridden
+# to gracefully recover from an Oracle error. This is to be careful to not
+# exhaust your application's open cursor limit.
+#
+# See:
+# http://itcareershift.com/blog1/2011/02/21/oracle-max-number-of-open-cursors-complete-reference-for-the-new-oracle-dba/
+# on the open_cursor limit.
+#
+# For everything else:
+#
+# We assume that everything that is not a LOB comparison, will most likely be a
+# LIKE query or some sort of function invocation. This may prove to be a naive
+# assumption in the future, but for now it should cover the two most likely
+# things users would want to do with a BLOB or CLOB, an equality test or a LIKE
+# query (on a CLOB.)
+#
+# For these expressions, the bind must NOT have the attributes of a LOB bind for
+# DBD::Oracle, otherwise the query will fail. This is done by passing
+# dbd_attrs => undef.
+
+sub _prep_for_execute {
+  my $self = shift;
+  my ($op) = @_;
+
+  return $self->next::method(@_)
+    if $op eq 'insert';
+
+  my ($sql, $bind) = $self->next::method(@_);
+
+  my $lob_bind_indices = { map {
+    (
+      $bind->[$_][0]{sqlt_datatype}
+        and
+      $self->_is_lob_type($bind->[$_][0]{sqlt_datatype})
+    ) ? ( $_ => 1 ) : ()
+  } ( 0 .. $#$bind ) };
+
+  return ($sql, $bind) unless %$lob_bind_indices;
+
+  my ($final_sql, @final_binds);
+  if ($op eq 'update') {
+    $self->throw_exception('Update with complex WHERE clauses involving BLOB columns currently not supported')
+      if $sql =~ /\bWHERE\b .+ \bWHERE\b/xs;
+
+    my $where_sql;
+    ($final_sql, $where_sql) = $sql =~ /^ (.+?) ( \bWHERE\b .+) /xs;
+
+    if (my $set_bind_count = $final_sql =~ y/?//) {
+
+      delete $lob_bind_indices->{$_} for (0 .. ($set_bind_count - 1));
+
+      # bail if only the update part contains blobs
+      return ($sql, $bind) unless %$lob_bind_indices;
+
+      @final_binds = splice @$bind, 0, $set_bind_count;
+      $lob_bind_indices = { map
+        { $_ - $set_bind_count => $lob_bind_indices->{$_} }
+        keys %$lob_bind_indices
+      };
+    }
+
+    # if we got that far - assume the where SQL is all we got
+    # (the first part is already shoved into $final_sql)
+    $sql = $where_sql;
+  }
+  elsif ($op ne 'select' and $op ne 'delete') {
+    $self->throw_exception("Unsupported \$op: $op");
+  }
+
+  my @sql_parts = split /\?/, $sql;
+
+  my $col_equality_re = qr/ (?<=\s) ([\w."]+) (\s*=\s*) $/x;
+
+  for my $b_idx (0 .. $#$bind) {
+    my $bound = $bind->[$b_idx];
+
+    if (
+      $lob_bind_indices->{$b_idx}
+        and
+      my ($col, $eq) = $sql_parts[0] =~ $col_equality_re
+    ) {
+      my $data = $bound->[1];
+
+      $data = "$data" if ref $data;
+
+      my @parts = unpack '(a2000)*', $data;
+
+      my @sql_frag;
+
+      for my $idx (0..$#parts) {
+        push @sql_frag, sprintf (
+          'UTL_RAW.CAST_TO_VARCHAR2(RAWTOHEX(DBMS_LOB.SUBSTR(%s, 2000, %d))) = ?',
+          $col, ($idx*2000 + 1),
+        );
+      }
+
+      my $sql_frag = '( ' . (join ' AND ', @sql_frag) . ' )';
+
+      $sql_parts[0] =~ s/$col_equality_re/$sql_frag/;
+
+      $final_sql .= shift @sql_parts;
+
+      for my $idx (0..$#parts) {
+        push @final_binds, [
+          {
+            %{ $bound->[0] },
+            _ora_lob_autosplit_part => $idx,
+            dbd_attrs => undef,
+          },
+          $parts[$idx]
+        ];
+      }
+    }
+    else {
+      $final_sql .= shift(@sql_parts) . '?';
+      push @final_binds, $lob_bind_indices->{$b_idx}
+        ? [
+          {
+            %{ $bound->[0] },
+            dbd_attrs => undef,
+          },
+          $bound->[1],
+        ] : $bound
+      ;
+    }
+  }
+
+  if (@sql_parts > 1) {
+    carp "There are more placeholders than binds, this should not happen!";
+    @sql_parts = join ('?', @sql_parts);
+  }
+
+  $final_sql .= $sql_parts[0];
+
+  return ($final_sql, \@final_binds);
+}
+
+# Savepoints stuff.
+
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+  $self->_dbh->do("SAVEPOINT $name");
+}
+
+# Oracle automatically releases a savepoint when you start another one with the
+# same name.
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+  $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+=head2 relname_to_table_alias
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+Unfortunately, Oracle doesn't support identifiers over 30 chars in length, so
+the L<DBIx::Class::Relationship> name is shortened and appended with half of an
+MD5 hash.
+
+See L<DBIx::Class::Storage::DBI/relname_to_table_alias>.
+
+=cut
+
+sub relname_to_table_alias {
+  my $self = shift;
+  my ($relname, $join_count) = @_;
+
+  my $alias = $self->next::method(@_);
+
+  # we need to shorten here in addition to the shortening in SQLMaker itself,
+  # since the final relnames are crucial for the join optimizer
+  return $self->sql_maker->_shorten_identifier($alias);
+}
+
+=head2 with_deferred_fk_checks
+
+Runs a coderef between:
+
+  alter session set constraints = deferred
+  ...
+  alter session set constraints = immediate
+
+to defer foreign key checks.
+
+Constraints must be declared C<DEFERRABLE> for this to work.
+
+=cut
+
+sub with_deferred_fk_checks {
+  my ($self, $sub) = @_;
+
+  my $txn_scope_guard = $self->txn_scope_guard;
+
+  $self->_do_query('alter session set constraints = deferred');
+
+  my $sg = Scope::Guard->new(sub {
+    $self->_do_query('alter session set constraints = immediate');
+  });
+
+  return
+    preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
+}
+
+=head1 ATTRIBUTES
+
+Following additional attributes can be used in resultsets.
+
+=head2 connect_by or connect_by_nocycle
+
+=over 4
+
+=item Value: \%connect_by
+
+=back
+
+A hashref of conditions used to specify the relationship between parent rows
+and child rows of the hierarchy.
+
+
+  connect_by => { parentid => 'prior personid' }
+
+  # adds a connect by statement to the query:
+  # SELECT
+  #     me.persionid me.firstname, me.lastname, me.parentid
+  # FROM
+  #     person me
+  # CONNECT BY
+  #     parentid = prior persionid
+
+
+  connect_by_nocycle => { parentid => 'prior personid' }
+
+  # adds a connect by statement to the query:
+  # SELECT
+  #     me.persionid me.firstname, me.lastname, me.parentid
+  # FROM
+  #     person me
+  # CONNECT BY NOCYCLE
+  #     parentid = prior persionid
+
+
+=head2 start_with
+
+=over 4
+
+=item Value: \%condition
+
+=back
+
+A hashref of conditions which specify the root row(s) of the hierarchy.
+
+It uses the same syntax as L<DBIx::Class::ResultSet/search>
+
+  start_with => { firstname => 'Foo', lastname => 'Bar' }
+
+  # SELECT
+  #     me.persionid me.firstname, me.lastname, me.parentid
+  # FROM
+  #     person me
+  # START WITH
+  #     firstname = 'foo' and lastname = 'bar'
+  # CONNECT BY
+  #     parentid = prior persionid
+
+=head2 order_siblings_by
+
+=over 4
+
+=item Value: ($order_siblings_by | \@order_siblings_by)
+
+=back
+
+Which column(s) to order the siblings by.
+
+It uses the same syntax as L<DBIx::Class::ResultSet/order_by>
+
+  'order_siblings_by' => 'firstname ASC'
+
+  # SELECT
+  #     me.persionid me.firstname, me.lastname, me.parentid
+  # FROM
+  #     person me
+  # CONNECT BY
+  #     parentid = prior persionid
+  # ORDER SIBLINGS BY
+  #     firstname ASC
+
+=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>.
+
+=cut
+
+1;
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm

@@ -0,0 +1,80 @@
+package DBIx::Class::Storage::DBI::Oracle::WhereJoins;
+
+use strict;
+use warnings;
+
+use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
+use mro 'c3';
+
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins');
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Oracle::WhereJoins - Oracle joins in WHERE syntax
+support (instead of ANSI).
+
+=head1 PURPOSE
+
+This module is used with Oracle < 9.0 due to lack of support for standard
+ANSI join syntax.
+
+=head1 SYNOPSIS
+
+DBIx::Class should automagically detect Oracle and use this module with no
+work from you.
+
+=head1 DESCRIPTION
+
+This class implements Oracle's WhereJoin support.  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
+
+See L<DBIx::Class::SQLMaker::OracleJoins> for implementation details.
+
+=head1 BUGS
+
+Does not support full outer joins.
+Probably lots more.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<DBIx::Class::SQLMaker>
+
+=item L<DBIx::Class::SQLMaker::OracleJoins>
+
+=item L<DBIx::Class::Storage::DBI::Oracle::Generic>
+
+=item L<DBIx::Class>
+
+=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/Storage/DBI/Pg.pm

@@ -0,0 +1,294 @@
+package DBIx::Class::Storage::DBI::Pg;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+use Scope::Guard ();
+use Context::Preserve 'preserve_context';
+use DBIx::Class::Carp;
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->sql_limit_dialect ('LimitOffset');
+__PACKAGE__->sql_quote_char ('"');
+__PACKAGE__->datetime_parser_type ('DateTime::Format::Pg');
+__PACKAGE__->_use_multicolumn_in (1);
+
+sub _determine_supports_insert_returning {
+  return shift->_server_info->{normalized_dbms_version} >= 8.002
+    ? 1
+    : 0
+  ;
+}
+
+sub with_deferred_fk_checks {
+  my ($self, $sub) = @_;
+
+  my $txn_scope_guard = $self->txn_scope_guard;
+
+  $self->_do_query('SET CONSTRAINTS ALL DEFERRED');
+
+  my $sg = Scope::Guard->new(sub {
+    $self->_do_query('SET CONSTRAINTS ALL IMMEDIATE');
+  });
+
+  return preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
+}
+
+# only used when INSERT ... RETURNING is disabled
+sub last_insert_id {
+  my ($self,$source,@cols) = @_;
+
+  my @values;
+
+  my $col_info = $source->columns_info(\@cols);
+
+  for my $col (@cols) {
+    my $seq = ( $col_info->{$col}{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) )
+      or $self->throw_exception( sprintf(
+        "Could not determine sequence for column '%s.%s', please consider adding a schema-qualified sequence to its column info",
+          $source->name,
+          $col,
+      ));
+
+    push @values, $self->_dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
+  }
+
+  return @values;
+}
+
+sub _sequence_fetch {
+  my ($self, $function, $sequence) = @_;
+
+  $self->throw_exception('No sequence to fetch') unless $sequence;
+
+  my ($val) = $self->_get_dbh->selectrow_array(
+    sprintf ("select %s('%s')", $function, (ref $sequence eq 'SCALAR') ? $$sequence : $sequence)
+  );
+
+  return $val;
+}
+
+sub _dbh_get_autoinc_seq {
+  my ($self, $dbh, $source, $col) = @_;
+
+  my $schema;
+  my $table = $source->name;
+
+  # deref table name if it needs it
+  $table = $$table
+      if ref $table eq 'SCALAR';
+
+  # parse out schema name if present
+  if( $table =~ /^(.+)\.(.+)$/ ) {
+    ( $schema, $table ) = ( $1, $2 );
+  }
+
+  # get the column default using a Postgres-specific pg_catalog query
+  my $seq_expr = $self->_dbh_get_column_default( $dbh, $schema, $table, $col );
+
+  # if no default value is set on the column, or if we can't parse the
+  # default value as a sequence, throw.
+  unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ) {
+    $seq_expr = '' unless defined $seq_expr;
+    $schema = "$schema." if defined $schema && length $schema;
+    $self->throw_exception( sprintf (
+      "No sequence found for '%s%s.%s', check the RDBMS table definition or explicitly set the ".
+      "'sequence' for this column in %s",
+        $schema ? "$schema." : '',
+        $table,
+        $col,
+        $source->source_name,
+    ));
+  }
+
+  return $1;  # exception thrown unless match is made above
+}
+
+# custom method for fetching column default, since column_info has a
+# bug with older versions of DBD::Pg
+sub _dbh_get_column_default {
+  my ( $self, $dbh, $schema, $table, $col ) = @_;
+
+  # Build and execute a query into the pg_catalog to find the Pg
+  # expression for the default value for this column in this table.
+  # If the table name is schema-qualified, query using that specific
+  # schema name.
+
+  # Otherwise, find the table in the standard Postgres way, using the
+  # search path.  This is done with the pg_catalog.pg_table_is_visible
+  # function, which returns true if a given table is 'visible',
+  # meaning the first table of that name to be found in the search
+  # path.
+
+  # I *think* we can be assured that this query will always find the
+  # correct column according to standard Postgres semantics.
+  #
+  # -- rbuels
+
+  my $sqlmaker = $self->sql_maker;
+  local $sqlmaker->{bindtype} = 'normal';
+
+  my ($where, @bind) = $sqlmaker->where ({
+    'a.attnum' => {'>', 0},
+    'c.relname' => $table,
+    'a.attname' => $col,
+    -not_bool => 'a.attisdropped',
+    (defined $schema && length $schema)
+      ? ( 'n.nspname' => $schema )
+      : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' )
+  });
+
+  my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef,@bind);
+
+SELECT
+  (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid)
+   FROM pg_catalog.pg_attrdef d
+   WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)
+FROM pg_catalog.pg_class c
+     LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
+     JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid
+$where
+
+EOS
+
+  return $seq_expr;
+}
+
+
+sub sqlt_type {
+  return 'PostgreSQL';
+}
+
+# Pg is not able to MAX(boolean_column), sigh...
+#
+# Generally it would make more sense to have this in the SQLMaker hierarchy,
+# so that eventually { -max => ... } DTRT, but plans going forward are
+# murky at best
+#   --ribasushi
+#
+sub _minmax_operator_for_datatype {
+  #my ($self, $datatype, $want_max) = @_;
+
+  return ($_[2] ? 'BOOL_OR' : 'BOOL_AND')
+    if ($_[1] || '') =~ /\Abool(?:ean)?\z/i;
+
+  shift->next::method(@_);
+}
+
+sub bind_attribute_by_data_type {
+  my ($self,$data_type) = @_;
+
+  if ($self->_is_binary_lob_type($data_type)) {
+    # this is a hot-ish codepath, use an escape flag to minimize
+    # amount of function/method calls
+    # additionally version.pm is cock, and memleaks on multiple
+    # ->VERSION calls
+    # the flag is stored in the DBD namespace, so that Class::Unload
+    # will work (unlikely, but still)
+    unless ($DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__) {
+      if ($self->_server_info->{normalized_dbms_version} >= 9.0) {
+        try { DBD::Pg->VERSION('2.17.2'); 1 } or carp (
+          __PACKAGE__.': BYTEA columns are known to not work on Pg >= 9.0 with DBD::Pg < 2.17.2'
+        );
+      }
+      elsif (not try { DBD::Pg->VERSION('2.9.2'); 1 } ) { carp (
+        __PACKAGE__.': DBD::Pg 2.9.2 or greater is strongly recommended for BYTEA column support'
+      )}
+
+      $DBD::Pg::__DBIC_DBD_VERSION_CHECK_DONE__ = 1;
+    }
+
+    return { pg_type => DBD::Pg::PG_BYTEA() };
+  }
+  else {
+    return undef;
+  }
+}
+
+sub _exec_svp_begin {
+    my ($self, $name) = @_;
+
+    $self->_dbh->pg_savepoint($name);
+}
+
+sub _exec_svp_release {
+    my ($self, $name) = @_;
+
+    $self->_dbh->pg_release($name);
+}
+
+sub _exec_svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->_dbh->pg_rollback_to($name);
+}
+
+sub deployment_statements {
+  my $self = shift;;
+  my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
+
+  $sqltargs ||= {};
+
+  if (
+    ! exists $sqltargs->{producer_args}{postgres_version}
+      and
+    my $dver = $self->_server_info->{normalized_dbms_version}
+  ) {
+    $sqltargs->{producer_args}{postgres_version} = $dver;
+  }
+
+  $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
+
+=head1 SYNOPSIS
+
+  # In your result (table) classes
+  use base 'DBIx::Class::Core';
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for PostgreSQL.
+
+=head1 POSTGRESQL SCHEMA SUPPORT
+
+This driver supports multiple PostgreSQL schemas, with one caveat: for
+performance reasons, data about the search path, sequence names, and
+so forth is queried as needed and CACHED for subsequent uses.
+
+For this reason, once your schema is instantiated, you should not
+change the PostgreSQL schema search path for that schema's database
+connection. If you do, Bad Things may happen.
+
+You should do any necessary manipulation of the search path BEFORE
+instantiating your schema object, or as part of the on_connect_do
+option to connect(), for example:
+
+   my $schema = My::Schema->connect
+                  ( $dsn,$user,$pass,
+                    { on_connect_do =>
+                        [ 'SET search_path TO myschema, foo, public' ],
+                    },
+                  );
+
+=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/Storage/DBI/Replicated/Balancer.pm

@@ -0,0 +1,259 @@
+package DBIx::Class::Storage::DBI::Replicated::Balancer;
+
+use Moose::Role;
+requires 'next_storage';
+use MooseX::Types::Moose qw/Int/;
+use DBIx::Class::Storage::DBI::Replicated::Pool;
+use DBIx::Class::Storage::DBI::Replicated::Types qw/DBICStorageDBI/;
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Balancer - A Software Load Balancer
+
+=head1 SYNOPSIS
+
+This role is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
+
+=head1 DESCRIPTION
+
+Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
+database's (L<DBIx::Class::Storage::DBI::Replicated::Replicant>), defines a
+method by which query load can be spread out across each replicant in the pool.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 auto_validate_every ($seconds)
+
+If auto_validate has some sort of value, run
+L<DBIx::Class::Storage::DBI::Replicated::Pool/validate_replicants>
+every $seconds.  Be careful with this, because if you set it to 0 you
+will end up validating every query.
+
+=cut
+
+has 'auto_validate_every' => (
+  is=>'rw',
+  isa=>Int,
+  predicate=>'has_auto_validate_every',
+);
+
+=head2 master
+
+The L<DBIx::Class::Storage::DBI> object that is the master database all the
+replicants are trying to follow.  The balancer needs to know it since it's the
+ultimate fallback.
+
+=cut
+
+has 'master' => (
+  is=>'ro',
+  isa=>DBICStorageDBI,
+  required=>1,
+);
+
+=head2 pool
+
+The L<DBIx::Class::Storage::DBI::Replicated::Pool> object that we are trying to
+balance.
+
+=cut
+
+has 'pool' => (
+  is=>'ro',
+  isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+  required=>1,
+);
+
+=head2 current_replicant
+
+Replicant storages (slaves) handle all read only traffic.  The assumption is
+that your database will become readbound well before it becomes write bound
+and that being able to spread your read only traffic around to multiple
+databases is going to help you to scale traffic.
+
+This attribute returns the next slave to handle a read request.  Your L</pool>
+attribute has methods to help you shuffle through all the available replicants
+via its balancer object.
+
+=cut
+
+has 'current_replicant' => (
+  is=> 'rw',
+  isa=>DBICStorageDBI,
+  lazy_build=>1,
+  handles=>[qw/
+    select
+    select_single
+    columns_info_for
+  /],
+);
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 _build_current_replicant
+
+Lazy builder for the L</current_replicant> attribute.
+
+=cut
+
+sub _build_current_replicant {
+  my $self = shift @_;
+  $self->next_storage;
+}
+
+=head2 next_storage
+
+This method should be defined in the class which consumes this role.
+
+Given a pool object, return the next replicant that will serve queries.  The
+default behavior is to grab the first replicant it finds but you can write
+your own subclasses of L<DBIx::Class::Storage::DBI::Replicated::Balancer> to
+support other balance systems.
+
+This returns from the pool of active replicants.  If there are no active
+replicants, then you should have it return the master as an ultimate fallback.
+
+=head2 around: next_storage
+
+Advice on next storage to add the autovalidation.  We have this broken out so
+that it's easier to break out the auto validation into a role.
+
+This also returns the master in the case that none of the replicants are active
+or just forgot to create them :)
+
+=cut
+
+my $on_master;
+
+around 'next_storage' => sub {
+  my ($next_storage, $self, @args) = @_;
+  my $now = time;
+
+  ## Do we need to validate the replicants?
+  if(
+     $self->has_auto_validate_every &&
+     ($self->auto_validate_every + $self->pool->last_validated) <= $now
+  ) {
+      $self->pool->validate_replicants;
+  }
+
+  ## Get a replicant, or the master if none
+  if(my $next = $self->$next_storage(@args)) {
+    $self->master->debugobj->print("Moved back to slave\n") if $on_master;
+    $on_master = 0;
+    return $next;
+  } else {
+    $self->master->debugobj->print("No Replicants validate, falling back to master reads.\n")
+       unless $on_master++;
+
+    return $self->master;
+  }
+};
+
+=head2 increment_storage
+
+Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
+
+=cut
+
+sub increment_storage {
+  my $self = shift @_;
+  my $next_replicant = $self->next_storage;
+  $self->current_replicant($next_replicant);
+}
+
+=head2 around: select
+
+Advice on the select attribute.  Each time we use a replicant
+we need to change it via the storage pool algorithm.  That way we are spreading
+the load evenly (hopefully) across existing capacity.
+
+=cut
+
+around 'select' => sub {
+  my ($select, $self, @args) = @_;
+
+  if (my $forced_pool = $args[-1]->{force_pool}) {
+    delete $args[-1]->{force_pool};
+    return $self->_get_forced_pool($forced_pool)->select(@args);
+  } elsif($self->master->{transaction_depth}) {
+    return $self->master->select(@args);
+  } else {
+    $self->increment_storage;
+    return $self->$select(@args);
+  }
+};
+
+=head2 around: select_single
+
+Advice on the select_single attribute.  Each time we use a replicant
+we need to change it via the storage pool algorithm.  That way we are spreading
+the load evenly (hopefully) across existing capacity.
+
+=cut
+
+around 'select_single' => sub {
+  my ($select_single, $self, @args) = @_;
+
+  if (my $forced_pool = $args[-1]->{force_pool}) {
+    delete $args[-1]->{force_pool};
+    return $self->_get_forced_pool($forced_pool)->select_single(@args);
+  } elsif($self->master->{transaction_depth}) {
+    return $self->master->select_single(@args);
+  } else {
+    $self->increment_storage;
+    return $self->$select_single(@args);
+  }
+};
+
+=head2 before: columns_info_for
+
+Advice on the current_replicant_storage attribute.  Each time we use a replicant
+we need to change it via the storage pool algorithm.  That way we are spreading
+the load evenly (hopefully) across existing capacity.
+
+=cut
+
+before 'columns_info_for' => sub {
+  my $self = shift @_;
+  $self->increment_storage;
+};
+
+=head2 _get_forced_pool ($name)
+
+Given an identifier, find the most correct storage object to handle the query.
+
+=cut
+
+sub _get_forced_pool {
+  my ($self, $forced_pool) = @_;
+  if(blessed $forced_pool) {
+    return $forced_pool;
+  } elsif($forced_pool eq 'master') {
+    return $self->master;
+  } elsif(my $replicant = $self->pool->replicants->{$forced_pool}) {
+    return $replicant;
+  } else {
+    $self->master->throw_exception("'$forced_pool' is not a named replicant.");
+  }
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm

@@ -0,0 +1,57 @@
+package DBIx::Class::Storage::DBI::Replicated::Balancer::First;
+
+use Moose;
+with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Balancer::First - Just get the First Balancer
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
+shouldn't need to create instances of this class.
+
+=head1 DESCRIPTION
+
+Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
+database's (L<DBIx::Class::Storage::DBI::Replicated::Replicant>), defines a
+method by which query load can be spread out across each replicant in the pool.
+
+This Balancer just gets whichever is the first replicant in the pool.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 next_storage
+
+Just get the first storage.  Probably only good when you have one replicant.
+
+=cut
+
+sub next_storage {
+  return  (shift->pool->active_replicants)[0];
+}
+
+=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>.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm

@@ -0,0 +1,92 @@
+package DBIx::Class::Storage::DBI::Replicated::Balancer::Random;
+
+use Moose;
+with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use DBIx::Class::Storage::DBI::Replicated::Types 'Weight';
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Balancer::Random - A 'random' Balancer
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
+shouldn't need to create instances of this class.
+
+=head1 DESCRIPTION
+
+Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
+database's (L<DBIx::Class::Storage::DBI::Replicated::Replicant>), defines a
+method by which query load can be spread out across each replicant in the pool.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 master_read_weight
+
+A number greater than 0 that specifies what weight to give the master when
+choosing which backend to execute a read query on. A value of 0, which is the
+default, does no reads from master, while a value of 1 gives it the same
+priority as any single replicant.
+
+For example: if you have 2 replicants, and a L</master_read_weight> of C<0.5>,
+the chance of reading from master will be C<20%>.
+
+You can set it to a value higher than 1, making master have higher weight than
+any single replicant, if for example you have a very powerful master.
+
+=cut
+
+has master_read_weight => (is => 'rw', isa => Weight, default => sub { 0 });
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 next_storage
+
+Returns an active replicant at random.  Please note that due to the nature of
+the word 'random' this means it's possible for a particular active replicant to
+be requested several times in a row.
+
+=cut
+
+sub next_storage {
+  my $self = shift @_;
+
+  my @replicants = $self->pool->active_replicants;
+
+  if (not @replicants) {
+    # will fall back to master anyway
+    return;
+  }
+
+  my $master     = $self->master;
+
+  my $rnd = $self->_random_number(@replicants + $self->master_read_weight);
+
+  return $rnd >= @replicants ? $master : $replicants[int $rnd];
+}
+
+sub _random_number {
+  rand($_[1])
+}
+
+=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>.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod

@@ -0,0 +1,182 @@
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Introduction - Minimum Need to Know
+
+=head1 SYNOPSIS
+
+This is an introductory document for L<DBIx::Class::Storage::DBI::Replicated>.
+
+This document is not an overview of what replication is or why you should be
+using it. It is not a document explaining how to setup MySQL native replication
+either. Copious external resources are available for both. This document
+presumes you have the basics down.
+
+=head1 DESCRIPTION
+
+L<DBIx::Class> supports a framework for using database replication. This system
+is integrated completely, which means once it's setup you should be able to
+automatically just start using a replication cluster without additional work or
+changes to your code. Some caveats apply, primarily related to the proper use
+of transactions (you are wrapping all your database modifying statements inside
+a transaction, right ;) ) however in our experience properly written DBIC will
+work transparently with Replicated storage.
+
+Currently we have support for MySQL native replication, which is relatively
+easy to install and configure.  We also currently support single master to one
+or more replicants (also called 'slaves' in some documentation).  However the
+framework is not specifically tied to the MySQL framework and supporting other
+replication systems or topographies should be possible.  Please bring your
+patches and ideas to the #dbix-class IRC channel or the mailing list.
+
+For an easy way to start playing with MySQL native replication, see:
+L<MySQL::Sandbox>.
+
+If you are using this with a L<Catalyst> based application, you may also want
+to see more recent updates to L<Catalyst::Model::DBIC::Schema>, which has
+support for replication configuration options as well.
+
+=head1 REPLICATED STORAGE
+
+By default, when you start L<DBIx::Class>, your Schema (L<DBIx::Class::Schema>)
+is assigned a storage_type, which when fully connected will reflect your
+underlying storage engine as defined by your chosen database driver.  For
+example, if you connect to a MySQL database, your storage_type will be
+L<DBIx::Class::Storage::DBI::mysql>  Your storage type class will contain
+database specific code to help smooth over the differences between databases
+and let L<DBIx::Class> do its thing.
+
+If you want to use replication, you will override this setting so that the
+replicated storage engine will 'wrap' your underlying storages and present
+a unified interface to the end programmer.  This wrapper storage class will
+delegate method calls to either a master database or one or more replicated
+databases based on if they are read only (by default sent to the replicants)
+or write (reserved for the master).  Additionally, the Replicated storage
+will monitor the health of your replicants and automatically drop them should
+one exceed configurable parameters.  Later, it can automatically restore a
+replicant when its health is restored.
+
+This gives you a very robust system, since you can add or drop replicants
+and DBIC will automatically adjust itself accordingly.
+
+Additionally, if you need high data integrity, such as when you are executing
+a transaction, replicated storage will automatically delegate all database
+traffic to the master storage.  There are several ways to enable this high
+integrity mode, but wrapping your statements inside a transaction is the easy
+and canonical option.
+
+=head1 PARTS OF REPLICATED STORAGE
+
+A replicated storage contains several parts.  First, there is the replicated
+storage itself (L<DBIx::Class::Storage::DBI::Replicated>).  A replicated storage
+takes a pool of replicants (L<DBIx::Class::Storage::DBI::Replicated::Pool>)
+and a software balancer (L<DBIx::Class::Storage::DBI::Replicated::Balancer>).
+The balancer does the job of splitting up all the read traffic amongst the
+replicants in the Pool. Currently there are two types of balancers, a Random one
+which chooses a Replicant in the Pool using a naive randomizer algorithm, and a
+First replicant, which just uses the first one in the Pool (and obviously is
+only of value when you have a single replicant).
+
+=head1 REPLICATED STORAGE CONFIGURATION
+
+All the parts of replication can be altered dynamically at runtime, which makes
+it possibly to create a system that automatically scales under load by creating
+more replicants as needed, perhaps using a cloud system such as Amazon EC2.
+However, for common use you can setup your replicated storage to be enabled at
+the time you connect the databases.  The following is a breakdown of how you
+may wish to do this.  Again, if you are using L<Catalyst>, I strongly recommend
+you use (or upgrade to) the latest L<Catalyst::Model::DBIC::Schema>, which makes
+this job even easier.
+
+First, you need to get a C<$schema> object and set the storage_type:
+
+  my $schema = MyApp::Schema->clone;
+  $schema->storage_type([
+    '::DBI::Replicated' => {
+      balancer_type => '::Random',
+      balancer_args => {
+        auto_validate_every => 5,
+        master_read_weight => 1
+      },
+      pool_args => {
+        maximum_lag =>2,
+      },
+    }
+  ]);
+
+Then, you need to connect your L<DBIx::Class::Schema>.
+
+  $schema->connection($dsn, $user, $pass);
+
+Let's break down the settings.  The method L<DBIx::Class::Schema/storage_type>
+takes one mandatory parameter, a scalar value, and an option second value which
+is a Hash Reference of configuration options for that storage.  In this case,
+we are setting the Replicated storage type using '::DBI::Replicated' as the
+first value.  You will only use a different value if you are subclassing the
+replicated storage, so for now just copy that first parameter.
+
+The second parameter contains a hash reference of stuff that gets passed to the
+replicated storage.  L<DBIx::Class::Storage::DBI::Replicated/balancer_type> is
+the type of software load balancer you will use to split up traffic among all
+your replicants.  Right now we have two options, "::Random" and "::First". You
+can review documentation for both at:
+
+L<DBIx::Class::Storage::DBI::Replicated::Balancer::First>,
+L<DBIx::Class::Storage::DBI::Replicated::Balancer::Random>.
+
+In this case we will have three replicants, so the ::Random option is the only
+one that makes sense.
+
+'balancer_args' get passed to the balancer when it's instantiated.  All
+balancers have the 'auto_validate_every' option.  This is the number of seconds
+we allow to pass between validation checks on a load balanced replicant. So
+the higher the number, the more possibility that your reads to the replicant
+may be inconsistent with what's on the master.  Setting this number too low
+will result in increased database loads, so choose a number with care.  Our
+experience is that setting the number around 5 seconds results in a good
+performance / integrity balance.
+
+'master_read_weight' is an option associated with the ::Random balancer. It
+allows you to let the master be read from.  I usually leave this off (default
+is off).
+
+The 'pool_args' are configuration options associated with the replicant pool.
+This object (L<DBIx::Class::Storage::DBI::Replicated::Pool>) manages all the
+declared replicants.  'maximum_lag' is the number of seconds a replicant is
+allowed to lag behind the master before being temporarily removed from the pool.
+Keep in mind that the Balancer option 'auto_validate_every' determines how often
+a replicant is tested against this condition, so the true possible lag can be
+higher than the number you set.  The default is zero.
+
+No matter how low you set the maximum_lag or the auto_validate_every settings,
+there is always the chance that your replicants will lag a bit behind the
+master for the supported replication system built into MySQL.  You can ensure
+reliable reads by using a transaction, which will force both read and write
+activity to the master, however this will increase the load on your master
+database.
+
+After you've configured the replicated storage, you need to add the connection
+information for the replicants:
+
+  $schema->storage->connect_replicants(
+    [$dsn1, $user, $pass, \%opts],
+    [$dsn2, $user, $pass, \%opts],
+    [$dsn3, $user, $pass, \%opts],
+  );
+
+These replicants should be configured as slaves to the master using the
+instructions for MySQL native replication, or if you are just learning, you
+will find L<MySQL::Sandbox> an easy way to set up a replication cluster.
+
+And now your $schema object is properly configured!  Enjoy!
+
+=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/Storage/DBI/Replicated/Pool.pm

@@ -0,0 +1,427 @@
+package DBIx::Class::Storage::DBI::Replicated::Pool;
+
+use Moose;
+use DBIx::Class::Storage::DBI::Replicated::Replicant;
+use Scalar::Util 'reftype';
+use DBI ();
+use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
+use Try::Tiny;
+
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
+shouldn't need to create instances of this class.
+
+=head1 DESCRIPTION
+
+In a replicated storage type, there is at least one replicant to handle the
+read-only traffic.  The Pool class manages this replicant, or list of
+replicants, and gives some methods for querying information about their status.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 maximum_lag ($num)
+
+This is a number which defines the maximum allowed lag returned by the
+L<DBIx::Class::Storage::DBI/lag_behind_master> method.  The default is 0.  In
+general, this should return a larger number when the replicant is lagging
+behind its master, however the implementation of this is database specific, so
+don't count on this number having a fixed meaning.  For example, MySQL will
+return a number of seconds that the replicating database is lagging.
+
+=cut
+
+has 'maximum_lag' => (
+  is=>'rw',
+  isa=>Num,
+  required=>1,
+  lazy=>1,
+  default=>0,
+);
+
+=head2 last_validated
+
+This is an integer representing a time since the last time the replicants were
+validated. It's nothing fancy, just an integer provided via the perl L<time|perlfunc/time>
+built-in.
+
+=cut
+
+has 'last_validated' => (
+  is=>'rw',
+  isa=>Int,
+  reader=>'last_validated',
+  writer=>'_last_validated',
+  lazy=>1,
+  default=>0,
+);
+
+=head2 replicant_type ($classname)
+
+Base class used to instantiate replicants that are in the pool.  Unless you
+need to subclass L<DBIx::Class::Storage::DBI::Replicated::Replicant> you should
+just leave this alone.
+
+=cut
+
+has 'replicant_type' => (
+  is=>'ro',
+  isa=>ClassName,
+  required=>1,
+  default=>'DBIx::Class::Storage::DBI',
+  handles=>{
+    'create_replicant' => 'new',
+  },
+);
+
+=head2 replicants
+
+A hashref of replicant, with the key being the dsn and the value returning the
+actual replicant storage.  For example, if the $dsn element is something like:
+
+  "dbi:SQLite:dbname=dbfile"
+
+You could access the specific replicant via:
+
+  $schema->storage->replicants->{'dbname=dbfile'}
+
+This attributes also supports the following helper methods:
+
+=over 4
+
+=item set_replicant($key=>$storage)
+
+Pushes a replicant onto the HashRef under $key
+
+=item get_replicant($key)
+
+Retrieves the named replicant
+
+=item has_replicants
+
+Returns true if the Pool defines replicants.
+
+=item num_replicants
+
+The number of replicants in the pool
+
+=item delete_replicant ($key)
+
+Removes the replicant under $key from the pool
+
+=back
+
+=cut
+
+has 'replicants' => (
+  is=>'rw',
+  traits => ['Hash'],
+  isa=>HashRef['Object'],
+  default=>sub {{}},
+  handles  => {
+    'set_replicant' => 'set',
+    'get_replicant' => 'get',
+    'has_replicants' => 'is_empty',
+    'num_replicants' => 'count',
+    'delete_replicant' => 'delete',
+    'all_replicant_storages' => 'values',
+  },
+);
+
+around has_replicants => sub {
+    my ($orig, $self) = @_;
+    return !$self->$orig;
+};
+
+has next_unknown_replicant_id => (
+  is => 'rw',
+  traits => ['Counter'],
+  isa => Int,
+  default => 1,
+  handles => {
+    'inc_unknown_replicant_id' => 'inc',
+  },
+);
+
+=head2 master
+
+Reference to the master Storage.
+
+=cut
+
+has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1);
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 connect_replicants ($schema, Array[$connect_info])
+
+Given an array of $dsn or connect_info structures suitable for connected to a
+database, create an L<DBIx::Class::Storage::DBI::Replicated::Replicant> object
+and store it in the L</replicants> attribute.
+
+=cut
+
+sub connect_replicants {
+  my $self = shift @_;
+  my $schema = shift @_;
+
+  my @newly_created = ();
+  foreach my $connect_info (@_) {
+    $connect_info = [ $connect_info ]
+      if reftype $connect_info ne 'ARRAY';
+
+    my $connect_coderef =
+      (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
+        : (reftype($connect_info->[0])||'') eq 'HASH' &&
+          $connect_info->[0]->{dbh_maker};
+
+    my $dsn;
+    my $replicant = do {
+# yes this is evil, but it only usually happens once (for coderefs)
+# this will fail if the coderef does not actually DBI::connect
+      no warnings 'redefine';
+      my $connect = \&DBI::connect;
+      local *DBI::connect = sub {
+        $dsn = $_[1];
+        goto $connect;
+      };
+      $self->connect_replicant($schema, $connect_info);
+    };
+
+    my $key;
+
+    if (!$dsn) {
+      if (!$connect_coderef) {
+        $dsn = $connect_info->[0];
+        $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+      }
+      else {
+        # all attempts to get the DSN failed
+        $key = "UNKNOWN_" . $self->next_unknown_replicant_id;
+        $self->inc_unknown_replicant_id;
+      }
+    }
+    if ($dsn) {
+      $replicant->dsn($dsn);
+      ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
+    }
+
+    $replicant->id($key);
+    $self->set_replicant($key => $replicant);
+
+    push @newly_created, $replicant;
+  }
+
+  return @newly_created;
+}
+
+=head2 connect_replicant ($schema, $connect_info)
+
+Given a schema object and a hashref of $connect_info, connect the replicant
+and return it.
+
+=cut
+
+sub connect_replicant {
+  my ($self, $schema, $connect_info) = @_;
+  my $replicant = $self->create_replicant($schema);
+  $replicant->connect_info($connect_info);
+
+## It is undesirable for catalyst to connect at ->conect_replicants time, as
+## connections should only happen on the first request that uses the database.
+## So we try to set the driver without connecting, however this doesn't always
+## work, as a driver may need to connect to determine the DB version, and this
+## may fail.
+##
+## Why this is necessary at all, is that we need to have the final storage
+## class to apply the Replicant role.
+
+  $self->_safely($replicant, '->_determine_driver', sub {
+    $replicant->_determine_driver
+  });
+
+  Moose::Meta::Class->initialize(ref $replicant);
+
+  DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+
+  # link back to master
+  $replicant->master($self->master);
+
+  return $replicant;
+}
+
+=head2 _safely_ensure_connected ($replicant)
+
+The standard ensure_connected method with throw an exception should it fail to
+connect.  For the master database this is desirable, but since replicants are
+allowed to fail, this behavior is not desirable.  This method wraps the call
+to ensure_connected in an eval in order to catch any generated errors.  That
+way a slave can go completely offline (e.g. the box itself can die) without
+bringing down your entire pool of databases.
+
+=cut
+
+sub _safely_ensure_connected {
+  my ($self, $replicant, @args) = @_;
+
+  return $self->_safely($replicant, '->ensure_connected', sub {
+    $replicant->ensure_connected(@args)
+  });
+}
+
+=head2 _safely ($replicant, $name, $code)
+
+Execute C<$code> for operation C<$name> catching any exceptions and printing an
+error message to the C<<$replicant->debugobj>>.
+
+Returns 1 on success and undef on failure.
+
+=cut
+
+sub _safely {
+  my ($self, $replicant, $name, $code) = @_;
+
+  return try {
+    $code->();
+    1;
+  } catch {
+    $replicant->debugobj->print(sprintf(
+      "Exception trying to $name for replicant %s, error is %s",
+      $replicant->_dbi_connect_info->[0], $_)
+    );
+    undef;
+  };
+}
+
+=head2 connected_replicants
+
+Returns true if there are connected replicants.  Actually is overloaded to
+return the number of replicants.  So you can do stuff like:
+
+  if( my $num_connected = $storage->has_connected_replicants ) {
+    print "I have $num_connected connected replicants";
+  } else {
+    print "Sorry, no replicants.";
+  }
+
+This method will actually test that each replicant in the L</replicants> hashref
+is actually connected, try not to hit this 10 times a second.
+
+=cut
+
+sub connected_replicants {
+  return scalar grep
+    { $_->connected }
+    shift->all_replicants
+  ;
+}
+
+=head2 active_replicants
+
+This is an array of replicants that are considered to be active in the pool.
+This does not check to see if they are connected, but if they are not, DBIC
+should automatically reconnect them for us when we hit them with a query.
+
+=cut
+
+sub active_replicants {
+  my $self = shift @_;
+  return ( grep {$_} map {
+    $_->active ? $_:0
+  } $self->all_replicants );
+}
+
+=head2 all_replicants
+
+Just a simple array of all the replicant storages.  No particular order to the
+array is given, nor should any meaning be derived.
+
+=cut
+
+sub all_replicants {
+  my $self = shift @_;
+  return values %{$self->replicants};
+}
+
+=head2 validate_replicants
+
+This does a check to see if 1) each replicate is connected (or reconnectable),
+2) that is ->is_replicating, and 3) that it is not exceeding the lag amount
+defined by L</maximum_lag>.  Replicants that fail any of these tests are set to
+inactive, and thus removed from the replication pool.
+
+This tests L</all_replicants>, since a replicant that has been previous marked
+as inactive can be reactivated should it start to pass the validation tests again.
+
+See L<DBIx::Class::Storage::DBI> for more about checking if a replicating
+connection is not following a master or is lagging.
+
+Calling this method will generate queries on the replicant databases so it is
+not recommended that you run them very often.
+
+This method requires that your underlying storage engine supports some sort of
+native replication mechanism.  Currently only MySQL native replication is
+supported.  Your patches to make other replication types work are welcomed.
+
+=cut
+
+sub validate_replicants {
+  my $self = shift @_;
+  foreach my $replicant($self->all_replicants) {
+    if($self->_safely_ensure_connected($replicant)) {
+      my $is_replicating = $replicant->is_replicating;
+      unless(defined $is_replicating) {
+        $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'is_replicating' method.  Assuming you are manually managing.\n");
+        next;
+      } else {
+        if($is_replicating) {
+          my $lag_behind_master = $replicant->lag_behind_master;
+          unless(defined $lag_behind_master) {
+            $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'lag_behind_master' method.  Assuming you are manually managing.\n");
+            next;
+          } else {
+            if($lag_behind_master <= $self->maximum_lag) {
+              $replicant->active(1);
+            } else {
+              $replicant->active(0);
+            }
+          }
+        } else {
+          $replicant->active(0);
+        }
+      }
+    } else {
+      $replicant->active(0);
+    }
+  }
+  ## Mark that we completed this validation.
+  $self->_last_validated(time);
+}
+
+=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>.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm

@@ -0,0 +1,103 @@
+package DBIx::Class::Storage::DBI::Replicated::Replicant;
+
+use Moose::Role;
+requires qw/_query_start/;
+with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
+use MooseX::Types::Moose qw/Bool Str/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
+
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Replicant - A replicated DBI Storage Role
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
+
+=head1 DESCRIPTION
+
+Replicants are DBI Storages that follow a master DBI Storage.  Typically this
+is accomplished via an external replication system.  Please see the documents
+for L<DBIx::Class::Storage::DBI::Replicated> for more details.
+
+This class exists to define methods of a DBI Storage that only make sense when
+it's a classic 'slave' in a pool of slave databases which replicate from a
+given master database.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 active
+
+This is a boolean which allows you to programmatically activate or deactivate a
+replicant from the pool.  This way you can do stuff like disallow a replicant
+when it gets too far behind the master, if it stops replicating, etc.
+
+This attribute DOES NOT reflect a replicant's internal status, i.e. if it is
+properly replicating from a master and has not fallen too many seconds behind a
+reliability threshold. For that, use
+L<DBIx::Class::Storage::DBI::Replicated/is_replicating> and
+L<DBIx::Class::Storage::DBI::Replicated/lag_behind_master>.
+Since the implementation of those functions database specific (and not all DBIC
+supported DBs support replication) you should refer your database-specific
+storage driver for more information.
+
+=cut
+
+has 'active' => (
+  is=>'rw',
+  isa=>Bool,
+  lazy=>1,
+  required=>1,
+  default=>1,
+);
+
+has dsn => (is => 'rw', isa => Str);
+has id  => (is => 'rw', isa => Str);
+
+=head2 master
+
+Reference to the master Storage.
+
+=cut
+
+has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1);
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 debugobj
+
+Override the debugobj method to redirect this method call back to the master.
+
+=cut
+
+sub debugobj {
+  my $self = shift;
+
+  return $self->master->debugobj;
+}
+
+=head1 ALSO SEE
+
+L<http://en.wikipedia.org/wiki/Replicant>,
+L<DBIx::Class::Storage::DBI::Replicated>
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm

@@ -0,0 +1,38 @@
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::Replicated::Types;
+
+# DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
+# L<DBIx::Class::Storage::DBI::Replicated>
+
+# Workaround for https://rt.cpan.org/Public/Bug/Display.html?id=83336
+use warnings;
+use strict;
+
+use MooseX::Types
+  -declare => [qw/BalancerClassNamePart Weight DBICSchema DBICStorageDBI/];
+use MooseX::Types::Moose qw/ClassName Str Num/;
+use MooseX::Types::LoadableClass qw/LoadableClass/;
+
+class_type 'DBIx::Class::Storage::DBI';
+class_type 'DBIx::Class::Schema';
+
+subtype DBICSchema, as 'DBIx::Class::Schema';
+subtype DBICStorageDBI, as 'DBIx::Class::Storage::DBI';
+
+subtype BalancerClassNamePart,
+  as LoadableClass;
+
+coerce BalancerClassNamePart,
+  from Str,
+  via {
+    my $type = $_;
+    $type =~ s/\A::/DBIx::Class::Storage::DBI::Replicated::Balancer::/;
+    $type;
+  };
+
+subtype Weight,
+  as Num,
+  where { $_ >= 0 },
+  message { 'weight must be a decimal greater than 0' };
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm

@@ -0,0 +1,73 @@
+package DBIx::Class::Storage::DBI::Replicated::WithDSN;
+
+use Moose::Role;
+use Scalar::Util 'reftype';
+requires qw/_query_start/;
+
+use Try::Tiny;
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::WithDSN - A DBI Storage Role with DSN
+information in trace output
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
+
+=head1 DESCRIPTION
+
+This role adds C<DSN: > info to storage debugging output.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 around: _query_start
+
+Add C<DSN: > to debugging output.
+
+=cut
+
+around '_query_start' => sub {
+  my ($method, $self, $sql, @bind) = @_;
+
+  my $dsn = (try { $self->dsn }) || $self->_dbi_connect_info->[0];
+
+  my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
+  my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
+
+  my $query = do {
+    if ((reftype($dsn)||'') ne 'CODE') {
+      "$op [DSN_$storage_type=$dsn]$rest";
+    }
+    elsif (my $id = try { $self->id }) {
+      "$op [$storage_type=$id]$rest";
+    }
+    else {
+      "$op [$storage_type]$rest";
+    }
+  };
+
+  $self->$method($query, @bind);
+};
+
+=head1 ALSO SEE
+
+L<DBIx::Class::Storage::DBI>
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm

@@ -0,0 +1,223 @@
+package DBIx::Class::Storage::DBI::SQLAnywhere;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
+use mro 'c3';
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->mk_group_accessors(simple => qw/_identity/);
+__PACKAGE__->sql_limit_dialect ('RowNumberOver');
+__PACKAGE__->sql_quote_char ('"');
+
+__PACKAGE__->new_guid('UUIDTOSTR(NEWID())');
+
+# default to the UUID decoding cursor, overridable by the user
+__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor');
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::SQLAnywhere - Driver for SQL Anywhere
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for SQL Anywhere and provides
+L<DBIx::Class::InflateColumn::DateTime> support and support for the
+C<uniqueidentifier> type (via
+L<DBIx::Class::Storage::DBI::SQLAnywhere::Cursor>.)
+
+You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere
+distribution, B<NOT> the one on CPAN. It is usually under a path such as:
+
+  /opt/sqlanywhere11/sdk/perl
+
+Recommended L<connect_info|DBIx::Class::Storage::DBI/connect_info> settings:
+
+  on_connect_call => 'datetime_setup'
+
+=head1 METHODS
+
+=cut
+
+sub last_insert_id { shift->_identity }
+
+sub _prefetch_autovalues {
+  my $self = shift;
+  my ($source, $colinfo, $to_insert) = @_;
+
+  my $values = $self->next::method(@_);
+
+  my ($identity_col) =
+    grep { $colinfo->{$_}{is_auto_increment} } keys %$colinfo;
+
+# user might have an identity PK without is_auto_increment
+#
+# FIXME we probably should not have supported the above, see what
+# does it take to move away from it
+  if (not $identity_col) {
+    foreach my $pk_col ($source->primary_columns) {
+      if (
+        ! exists $to_insert->{$pk_col}
+          and
+        $colinfo->{$pk_col}{data_type}
+          and
+        $colinfo->{$pk_col}{data_type} !~ /^uniqueidentifier/i
+      ) {
+        $identity_col = $pk_col;
+        last;
+      }
+    }
+  }
+
+  if ($identity_col && (not exists $to_insert->{$identity_col})) {
+    my $dbh = $self->_get_dbh;
+    my $table_name = $source->from;
+    $table_name    = $$table_name if ref $table_name;
+
+    my ($identity) = try {
+      $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
+    };
+
+    if (defined $identity) {
+      $values->{$identity_col} = $identity;
+      $self->_identity($identity);
+    }
+  }
+
+  return $values;
+}
+
+sub _uuid_to_str {
+  my ($self, $data) = @_;
+
+  $data = unpack 'H*', $data;
+
+  for my $pos (8, 13, 18, 23) {
+    substr($data, $pos, 0) = '-';
+  }
+
+  return $data;
+}
+
+# select_single does not invoke a cursor object at all, hence UUID decoding happens
+# here if the proper cursor class is set
+sub select_single {
+  my $self = shift;
+
+  my @row = $self->next::method(@_);
+
+  return @row
+    unless $self->cursor_class->isa('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor');
+
+  my ($ident, $select) = @_;
+
+  my $col_info = $self->_resolve_column_info($ident);
+
+  for my $select_idx (0..$#$select) {
+    my $selected = $select->[$select_idx];
+
+    next if ref $selected;
+
+    my $data_type = $col_info->{$selected}{data_type}
+      or next;
+
+    if ($self->_is_guid_type($data_type)) {
+      my $returned = $row[$select_idx];
+
+      if (length $returned == 16) {
+        $row[$select_idx] = $self->_uuid_to_str($returned);
+      }
+    }
+  }
+
+  return @row;
+}
+
+# this sub stolen from MSSQL
+
+sub build_datetime_parser {
+  my $self = shift;
+  my $type = "DateTime::Format::Strptime";
+  try {
+    eval "require ${type}"
+  }
+  catch {
+    $self->throw_exception("Couldn't load ${type}: $_");
+  };
+
+  return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+    on_connect_call => 'datetime_setup'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
+timestamp formats (as temporary options for the session) for use with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+The C<TIMESTAMP> data type supports up to 6 digits after the decimal point for
+second precision. The full precision is used.
+
+The C<DATE> data type supposedly stores hours and minutes too, according to the
+documentation, but I could not get that to work. It seems to only store the
+date.
+
+You will need the L<DateTime::Format::Strptime> module for inflation to work.
+
+=cut
+
+sub connect_call_datetime_setup {
+  my $self = shift;
+
+  $self->_do_query(
+    "set temporary option timestamp_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
+  );
+  $self->_do_query(
+    "set temporary option date_format      = 'yyyy-mm-dd hh:mm:ss.ssssss'"
+  );
+}
+
+sub _exec_svp_begin {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("SAVEPOINT $name");
+}
+
+# can't release savepoints that have been rolled back
+sub _exec_svp_release { 1 }
+
+sub _exec_svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+1;
+
+=head1 MAXIMUM CURSORS
+
+A L<DBIx::Class> application can use a lot of cursors, due to the usage of
+L<prepare_cached|DBI/prepare_cached>.
+
+The default cursor maximum is C<50>, which can be a bit too low. This limit can
+be turned off (or increased) by the DBA by executing:
+
+  set option max_statement_count = 0
+  set option max_cursor_count    = 0
+
+Highly recommended.
+
+=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/Storage/DBI/SQLAnywhere/Cursor.pm

@@ -0,0 +1,103 @@
+package DBIx::Class::Storage::DBI::SQLAnywhere::Cursor;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI::Cursor';
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::SQLAnywhere::Cursor - GUID Support for SQL Anywhere
+over L<DBD::SQLAnywhere>
+
+=head1 DESCRIPTION
+
+This class is for normalizing GUIDs retrieved from SQL Anywhere via
+L<DBD::SQLAnywhere>.
+
+You probably don't want to be here, see
+L<DBIx::Class::Storage::DBI::SQLAnywhere> for information on the SQL Anywhere
+driver.
+
+Unfortunately when using L<DBD::SQLAnywhere>, GUIDs come back in binary, the
+purpose of this class is to transform them to text.
+L<DBIx::Class::Storage::DBI::SQLAnywhere> sets
+L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to this class by default.
+It is overridable via your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
+
+You can use L<DBIx::Class::Cursor::Cached> safely with this class and not lose
+the GUID normalizing functionality,
+L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data
+for the inner cursor class.
+
+=cut
+
+my $unpack_guids = sub {
+  my ($select, $col_infos, $data, $storage) = @_;
+
+  for my $select_idx (0..$#$select) {
+    next unless (
+      defined $data->[$select_idx]
+        and
+      length($data->[$select_idx]) == 16
+    );
+
+    my $selected = $select->[$select_idx];
+
+    my $data_type = $col_infos->{$select->[$select_idx]}{data_type}
+      or next;
+
+    $data->[$select_idx] = $storage->_uuid_to_str($data->[$select_idx])
+      if $storage->_is_guid_type($data_type);
+  }
+};
+
+
+sub next {
+  my $self = shift;
+
+  my @row = $self->next::method(@_);
+
+  $unpack_guids->(
+    $self->args->[1],
+    $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]),
+    \@row,
+    $self->storage
+  );
+
+  return @row;
+}
+
+sub all {
+  my $self = shift;
+
+  my @rows = $self->next::method(@_);
+
+  $unpack_guids->(
+    $self->args->[1],
+    $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]),
+    $_,
+    $self->storage
+  ) for @rows;
+
+
+  return @rows;
+}
+
+=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>.
+
+=cut
+
+1;
+
+# vim:sts=2 sw=2:

database/perl/vendor/lib/DBIx/Class/Storage/DBI/SQLite.pm

@@ -0,0 +1,401 @@
+package DBIx::Class::Storage::DBI::SQLite;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+use SQL::Abstract::Util 'is_plain_value';
+use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer);
+use DBIx::Class::Carp;
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::SQLite');
+__PACKAGE__->sql_limit_dialect ('LimitOffset');
+__PACKAGE__->sql_quote_char ('"');
+__PACKAGE__->datetime_parser_type ('DateTime::Format::SQLite');
+
+sub _determine_supports_multicolumn_in {
+  ( shift->_server_info->{normalized_dbms_version} < '3.014' )
+    ? 0
+    : 1
+}
+
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::SQLite - Automatic primary key class for SQLite
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  use base 'DBIx::Class::Core';
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for SQLite.
+
+=head2 Known Issues
+
+=over
+
+=item RT79576
+
+ NOTE - This section applies to you only if ALL of these are true:
+
+  * You are or were using DBD::SQLite with a version lesser than 1.38_01
+
+  * You are or were using DBIx::Class versions between 0.08191 and 0.08209
+    (inclusive) or between 0.08240-TRIAL and 0.08242-TRIAL (also inclusive)
+
+  * You use objects with overloaded stringification and are feeding them
+    to DBIC CRUD methods directly
+
+An unfortunate chain of events led to DBIx::Class silently hitting the problem
+described in L<RT#79576|https://rt.cpan.org/Public/Bug/Display.html?id=79576>.
+
+In order to trigger the bug condition one needs to supply B<more than one>
+bind value that is an object with overloaded stringification (numification
+is not relevant, only stringification is). When this is the case the internal
+DBIx::Class call to C<< $sth->bind_param >> would be executed in a way that
+triggers the above-mentioned DBD::SQLite bug. As a result all the logs and
+tracers will contain the expected values, however SQLite will receive B<all>
+these bind positions being set to the value of the B<last> supplied
+stringifiable object.
+
+Even if you upgrade DBIx::Class (which works around the bug starting from
+version 0.08210) you may still have corrupted/incorrect data in your database.
+DBIx::Class warned about this condition for several years, hoping to give
+anyone affected sufficient notice of the potential issues. The warning was
+removed in 2015/v0.082820.
+
+=back
+
+=head1 METHODS
+
+=cut
+
+sub backup {
+
+  require File::Spec;
+  require File::Copy;
+  require POSIX;
+
+  my ($self, $dir) = @_;
+  $dir ||= './';
+
+  ## Where is the db file?
+  my $dsn = $self->_dbi_connect_info()->[0];
+
+  my $dbname = $1 if($dsn =~ /dbname=([^;]+)/);
+  if(!$dbname)
+  {
+    $dbname = $1 if($dsn =~ /^dbi:SQLite:(.+)$/i);
+  }
+  $self->throw_exception("Cannot determine name of SQLite db file")
+    if(!$dbname || !-f $dbname);
+
+#  print "Found database: $dbname\n";
+#  my $dbfile = file($dbname);
+  my ($vol, $dbdir, $file) = File::Spec->splitpath($dbname);
+#  my $file = $dbfile->basename();
+  $file = POSIX::strftime("%Y-%m-%d-%H_%M_%S", localtime()) . $file;
+  $file = "B$file" while(-f $file);
+
+  mkdir($dir) unless -f $dir;
+  my $backupfile = File::Spec->catfile($dir, $file);
+
+  my $res = File::Copy::copy($dbname, $backupfile);
+  $self->throw_exception("Backup failed! ($!)") if(!$res);
+
+  return $backupfile;
+}
+
+sub _exec_svp_begin {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("SAVEPOINT $name");
+}
+
+sub _exec_svp_release {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _exec_svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->_dbh->do("ROLLBACK TO SAVEPOINT $name");
+
+  # resync state for older DBD::SQLite (RT#67843)
+  # https://github.com/DBD-SQLite/DBD-SQLite/commit/9b3cdbf
+  if (
+    ! modver_gt_or_eq('DBD::SQLite', '1.33')
+      and
+    $self->_dbh->FETCH('AutoCommit')
+  ) {
+    $self->_dbh->STORE('AutoCommit', 0);
+    $self->_dbh->STORE('BegunWork', 1);
+  }
+}
+
+sub _ping {
+  my $self = shift;
+
+  # Be extremely careful what we do here. SQLite is notoriously bad at
+  # synchronizing its internal transaction state with {AutoCommit}
+  # https://metacpan.org/source/ADAMK/DBD-SQLite-1.37/lib/DBD/SQLite.pm#L921
+  # There is a function http://www.sqlite.org/c3ref/get_autocommit.html
+  # but DBD::SQLite does not expose it (nor does it seem to properly use it)
+
+  # Therefore only execute a "ping" when we have no other choice *AND*
+  # scrutinize the thrown exceptions to make sure we are where we think we are
+  my $dbh = $self->_dbh or return undef;
+  return undef unless $dbh->FETCH('Active');
+  return undef unless $dbh->ping;
+
+  my $ping_fail;
+
+  # older DBD::SQLite does not properly synchronize commit state between
+  # the libsqlite and the $dbh
+  unless (defined $DBD::SQLite::__DBIC_TXN_SYNC_SANE__) {
+    $DBD::SQLite::__DBIC_TXN_SYNC_SANE__ = modver_gt_or_eq('DBD::SQLite', '1.38_02');
+  }
+
+  # fallback to travesty
+  unless ($DBD::SQLite::__DBIC_TXN_SYNC_SANE__) {
+    # since we do not have access to sqlite3_get_autocommit(), do a trick
+    # to attempt to *safely* determine what state are we *actually* in.
+    # FIXME
+    # also using T::T here leads to bizarre leaks - will figure it out later
+    my $really_not_in_txn = do {
+      local $@;
+
+      # older versions of DBD::SQLite do not properly detect multiline BEGIN/COMMIT
+      # statements to adjust their {AutoCommit} state. Hence use such a statement
+      # pair here as well, in order to escape from poking {AutoCommit} needlessly
+      # https://rt.cpan.org/Public/Bug/Display.html?id=80087
+      eval {
+        # will fail instantly if already in a txn
+        $dbh->do("-- multiline\nBEGIN");
+        $dbh->do("-- multiline\nCOMMIT");
+        1;
+      } or do {
+        ($@ =~ /transaction within a transaction/)
+          ? 0
+          : undef
+        ;
+      };
+    };
+
+    # if we were unable to determine this - we may very well be dead
+    if (not defined $really_not_in_txn) {
+      $ping_fail = 1;
+    }
+    # check the AC sync-state
+    elsif ($really_not_in_txn xor $dbh->{AutoCommit}) {
+      carp_unique (sprintf
+        'Internal transaction state of handle %s (apparently %s a transaction) does not seem to '
+      . 'match its AutoCommit attribute setting of %s - this is an indication of a '
+      . 'potentially serious bug in your transaction handling logic',
+        $dbh,
+        $really_not_in_txn ? 'NOT in' : 'in',
+        $dbh->{AutoCommit} ? 'TRUE' : 'FALSE',
+      );
+
+      # it is too dangerous to execute anything else in this state
+      # assume everything works (safer - worst case scenario next statement throws)
+      return 1;
+    }
+  }
+
+  # do the actual test and return on no failure
+  ( $ping_fail ||= ! try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 } )
+    or return 1; # the actual RV of _ping()
+
+  # ping failed (or so it seems) - need to do some cleanup
+  # it is possible to have a proper "connection", and have "ping" return
+  # false anyway (e.g. corrupted file). In such cases DBD::SQLite still
+  # keeps the actual file handle open. We don't really want this to happen,
+  # so force-close the handle via DBI itself
+  #
+  local $@; # so that we do not clobber the real error as set above
+  eval { $dbh->disconnect }; # if it fails - it fails
+  undef; # the actual RV of _ping()
+}
+
+sub deployment_statements {
+  my $self = shift;
+  my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
+
+  $sqltargs ||= {};
+
+  if (
+    ! exists $sqltargs->{producer_args}{sqlite_version}
+      and
+    my $dver = $self->_server_info->{normalized_dbms_version}
+  ) {
+    $sqltargs->{producer_args}{sqlite_version} = $dver;
+  }
+
+  $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
+}
+
+sub bind_attribute_by_data_type {
+
+  # According to http://www.sqlite.org/datatype3.html#storageclasses
+  # all numeric types are dynamically allocated up to 8 bytes per
+  # individual value
+  # Thus it should be safe and non-wasteful to bind everything as
+  # SQL_BIGINT and have SQLite deal with storage/comparisons however
+  # it deems correct
+  $_[1] =~ /^ (?: int(?:[1248]|eger)? | (?:tiny|small|medium|big)int ) $/ix
+    ? DBI::SQL_BIGINT()
+    : undef
+  ;
+}
+
+# FIXME - what the flying fuck... work around RT#76395
+# DBD::SQLite warns on binding >32 bit values with 32 bit IVs
+sub _dbh_execute {
+  if (
+    (
+      DBIx::Class::_ENV_::IV_SIZE < 8
+        or
+      DBIx::Class::_ENV_::OS_NAME eq 'MSWin32'
+    )
+      and
+    ! defined $DBD::SQLite::__DBIC_CHECK_dbd_mishandles_bound_BIGINT
+  ) {
+    $DBD::SQLite::__DBIC_CHECK_dbd_mishandles_bound_BIGINT = (
+      modver_gt_or_eq('DBD::SQLite', '1.37')
+    ) ? 1 : 0;
+  }
+
+  local $SIG{__WARN__} = sigwarn_silencer( qr/
+    \Qdatatype mismatch: bind\E \s (?:
+      param \s+ \( \d+ \) \s+ [-+]? \d+ (?: \. 0*)? \Q as integer\E
+        |
+      \d+ \s type \s @{[ DBI::SQL_BIGINT() ]} \s as \s [-+]? \d+ (?: \. 0*)?
+    )
+  /x ) if (
+    (
+      DBIx::Class::_ENV_::IV_SIZE < 8
+        or
+      DBIx::Class::_ENV_::OS_NAME eq 'MSWin32'
+    )
+      and
+    $DBD::SQLite::__DBIC_CHECK_dbd_mishandles_bound_BIGINT
+  );
+
+  shift->next::method(@_);
+}
+
+# DBD::SQLite (at least up to version 1.31 has a bug where it will
+# non-fatally numify a string value bound as an integer, resulting
+# in insertions of '0' into supposed-to-be-numeric fields
+# Since this can result in severe data inconsistency, remove the
+# bind attr if such a situation is detected
+#
+# FIXME - when a DBD::SQLite version is released that eventually fixes
+# this situation (somehow) - no-op this override once a proper DBD
+# version is detected
+sub _dbi_attrs_for_bind {
+  my ($self, $ident, $bind) = @_;
+
+  my $bindattrs = $self->next::method($ident, $bind);
+
+  if (! defined $DBD::SQLite::__DBIC_CHECK_dbd_can_bind_bigint_values) {
+    $DBD::SQLite::__DBIC_CHECK_dbd_can_bind_bigint_values
+      = modver_gt_or_eq('DBD::SQLite', '1.37') ? 1 : 0;
+  }
+
+  for my $i (0.. $#$bindattrs) {
+    if (
+      defined $bindattrs->[$i]
+        and
+      defined $bind->[$i][1]
+        and
+      grep { $bindattrs->[$i] eq $_ } (
+        DBI::SQL_INTEGER(), DBI::SQL_TINYINT(), DBI::SQL_SMALLINT(), DBI::SQL_BIGINT()
+      )
+    ) {
+      if ( $bind->[$i][1] !~ /^ [\+\-]? [0-9]+ (?: \. 0* )? $/x ) {
+        carp_unique( sprintf (
+          "Non-integer value supplied for column '%s' despite the integer datatype",
+          $bind->[$i][0]{dbic_colname} || "# $i"
+        ) );
+        undef $bindattrs->[$i];
+      }
+      elsif (
+        ! $DBD::SQLite::__DBIC_CHECK_dbd_can_bind_bigint_values
+      ) {
+        # unsigned 32 bit ints have a range of −2,147,483,648 to 2,147,483,647
+        # alternatively expressed as the hexadecimal numbers below
+        # the comparison math will come out right regardless of ivsize, since
+        # we are operating within 31 bits
+        # P.S. 31 because one bit is lost for the sign
+        if ($bind->[$i][1] > 0x7fff_ffff or $bind->[$i][1] < -0x8000_0000) {
+          carp_unique( sprintf (
+            "An integer value occupying more than 32 bits was supplied for column '%s' "
+          . 'which your version of DBD::SQLite (%s) can not bind properly so DBIC '
+          . 'will treat it as a string instead, consider upgrading to at least '
+          . 'DBD::SQLite version 1.37',
+            $bind->[$i][0]{dbic_colname} || "# $i",
+            DBD::SQLite->VERSION,
+          ) );
+          undef $bindattrs->[$i];
+        }
+        else {
+          $bindattrs->[$i] = DBI::SQL_INTEGER()
+        }
+      }
+    }
+  }
+
+  return $bindattrs;
+}
+
+=head2 connect_call_use_foreign_keys
+
+Used as:
+
+    on_connect_call => 'use_foreign_keys'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to turn on foreign key
+(including cascading) support for recent versions of SQLite and L<DBD::SQLite>.
+
+Executes:
+
+  PRAGMA foreign_keys = ON
+
+See L<http://www.sqlite.org/foreignkeys.html> for more information.
+
+=cut
+
+sub connect_call_use_foreign_keys {
+  my $self = shift;
+
+  $self->_do_query(
+    'PRAGMA foreign_keys = ON'
+  );
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Sybase.pm

@@ -0,0 +1,132 @@
+package DBIx::Class::Storage::DBI::Sybase;
+
+use strict;
+use warnings;
+use Try::Tiny;
+use namespace::clean;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase - Base class for drivers using
+L<DBD::Sybase>
+
+=head1 DESCRIPTION
+
+This is the base class/dispatcher for Storage's designed to work with
+L<DBD::Sybase>
+
+=head1 METHODS
+
+=cut
+
+sub _rebless {
+  my $self = shift;
+
+  my $dbtype;
+  try {
+    $dbtype = @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
+  } catch {
+    $self->throw_exception("Unable to establish connection to determine database type: $_")
+  };
+
+  if ($dbtype) {
+    $dbtype =~ s/\W/_/gi;
+
+    # saner class name
+    $dbtype = 'ASE' if $dbtype eq 'SQL_Server';
+
+    my $subclass = __PACKAGE__ . "::$dbtype";
+    if ($self->load_optional_class($subclass)) {
+      bless $self, $subclass;
+      $self->_rebless;
+    }
+  }
+}
+
+sub _init {
+  # once the driver is determined see if we need to insert the DBD::Sybase w/ FreeTDS fixups
+  # this is a dirty version of "instance role application", \o/ DO WANT Moo \o/
+  my $self = shift;
+  if (! $self->isa('DBIx::Class::Storage::DBI::Sybase::FreeTDS') and $self->_using_freetds) {
+    require DBIx::Class::Storage::DBI::Sybase::FreeTDS;
+
+    my @isa = @{mro::get_linear_isa(ref $self)};
+    my $class = shift @isa; # this is our current ref
+
+    my $trait_class = $class . '::FreeTDS';
+    mro::set_mro ($trait_class, 'c3');
+    no strict 'refs';
+    @{"${trait_class}::ISA"} = ($class, 'DBIx::Class::Storage::DBI::Sybase::FreeTDS', @isa);
+
+    bless ($self, $trait_class);
+
+    Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
+
+    $self->_init(@_);
+  }
+
+  $self->next::method(@_);
+}
+
+sub _ping {
+  my $self = shift;
+
+  my $dbh = $self->_dbh or return 0;
+
+  local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
+
+  ( try { $dbh->do('select 1'); 1 } )
+    ? 1
+    : 0
+  ;
+}
+
+sub _set_max_connect {
+  my $self = shift;
+  my $val  = shift || 256;
+
+  my $dsn = $self->_dbi_connect_info->[0];
+
+  return if ref($dsn) eq 'CODE';
+
+  if ($dsn !~ /maxConnect=/) {
+    $self->_dbi_connect_info->[0] = "$dsn;maxConnect=$val";
+    my $connected = defined $self->_dbh;
+    $self->disconnect;
+    $self->ensure_connected if $connected;
+  }
+}
+
+# Whether or not DBD::Sybase was compiled against FreeTDS. If false, it means
+# the Sybase OpenClient libraries were used.
+sub _using_freetds {
+  my $self = shift;
+  return ($self->_get_dbh->{syb_oc_version}||'') =~ /freetds/i;
+}
+
+# Either returns the FreeTDS version against which DBD::Sybase was compiled,
+# 0 if can't be determined, or undef otherwise
+sub _using_freetds_version {
+  my $inf = shift->_get_dbh->{syb_oc_version};
+  return undef unless ($inf||'') =~ /freetds/i;
+  return $inf =~ /v([0-9\.]+)/ ? $1 : 0;
+}
+
+=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>.
+
+=cut
+
+1;
+

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Sybase/ASE/NoBindVars.pm

@@ -0,0 +1,107 @@
+package DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars;
+
+use warnings;
+use strict;
+
+use base qw/
+  DBIx::Class::Storage::DBI::NoBindVars
+  DBIx::Class::Storage::DBI::Sybase::ASE
+/;
+use mro 'c3';
+use Scalar::Util 'looks_like_number';
+use namespace::clean;
+
+sub _init {
+  my $self = shift;
+  $self->disable_sth_caching(1);
+  $self->_identity_method('@@IDENTITY');
+  $self->next::method (@_);
+}
+
+sub _fetch_identity_sql { 'SELECT ' . $_[0]->_identity_method }
+
+my $number = sub { looks_like_number $_[0] };
+
+my $decimal = sub { $_[0] =~ /^ [-+]? \d+ (?:\.\d*)? \z/x };
+
+my %noquote = (
+    int => sub { $_[0] =~ /^ [-+]? \d+ \z/x },
+    bit => => sub { $_[0] =~ /^[01]\z/ },
+    money => sub { $_[0] =~ /^\$ \d+ (?:\.\d*)? \z/x },
+    float => $number,
+    real => $number,
+    double => $number,
+    decimal => $decimal,
+    numeric => $decimal,
+);
+
+sub interpolate_unquoted {
+  my $self = shift;
+  my ($type, $value) = @_;
+
+  return $self->next::method(@_) if not defined $value or not defined $type;
+
+  if (my ($key) = grep { $type =~ /$_/i } keys %noquote) {
+    return 1 if $noquote{$key}->($value);
+  }
+  elsif ($self->is_datatype_numeric($type) && $number->($value)) {
+    return 1;
+  }
+
+  return $self->next::method(@_);
+}
+
+sub _prep_interpolated_value {
+  my ($self, $type, $value) = @_;
+
+  if ($type =~ /money/i && defined $value) {
+    # change a ^ not followed by \$ to a \$
+    $value =~ s/^ (?! \$) /\$/x;
+  }
+
+  return $value;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars - Storage::DBI subclass for
+Sybase ASE without placeholder support
+
+=head1 DESCRIPTION
+
+If you're using this driver then your version of Sybase or the libraries you
+use to connect to it do not support placeholders.
+
+You can also enable this driver explicitly using:
+
+  my $schema = SchemaClass->clone;
+  $schema->storage_type('::DBI::Sybase::ASE::NoBindVars');
+  $schema->connect($dsn, $user, $pass, \%opts);
+
+See the discussion in
+L<< DBD::Sybase/Using ? Placeholders & bind parameters to $sth->execute >>
+for details on the pros and cons of using placeholders with this particular
+driver.
+
+One advantage of not using placeholders is that C<select @@identity> will work
+for obtaining the last insert id of an C<IDENTITY> column, instead of having to
+do C<select max(col)> in a transaction as the base Sybase driver does.
+
+When using this driver, bind variables will be interpolated (properly quoted of
+course) into the SQL query itself, without using placeholders.
+
+The caching of prepared statements is also explicitly disabled, as the
+interpolation renders it useless.
+
+=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/Storage/DBI/Sybase/FreeTDS.pm

@@ -0,0 +1,119 @@
+package DBIx::Class::Storage::DBI::Sybase::FreeTDS;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI::Sybase/;
+use mro 'c3';
+use Try::Tiny;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::FreeTDS - Base class for drivers using
+DBD::Sybase over FreeTDS.
+
+=head1 DESCRIPTION
+
+This is the base class for Storages designed to work with L<DBD::Sybase> over
+FreeTDS.
+
+It is a subclass of L<DBIx::Class::Storage::DBI::Sybase>.
+
+=head1 METHODS
+
+=cut
+
+# The subclass storage driver defines _set_autocommit_stmt
+# for MsSQL it is SET IMPLICIT_TRANSACTIONS ON/OFF
+# for proper Sybase it's SET CHAINED ON/OFF
+sub _set_autocommit {
+  my $self = shift;
+
+  if ($self->_dbh_autocommit) {
+    $self->_dbh->do($self->_set_autocommit_stmt(1));
+  } else {
+    $self->_dbh->do($self->_set_autocommit_stmt(0));
+  }
+}
+
+# Handle AutoCommit and SET TEXTSIZE because LongReadLen doesn't work.
+#
+sub _run_connection_actions {
+  my $self = shift;
+
+  # based on LongReadLen in connect_info
+  $self->set_textsize;
+
+  $self->_set_autocommit;
+
+  $self->next::method(@_);
+}
+
+=head2 set_textsize
+
+When using DBD::Sybase with FreeTDS, C<< $dbh->{LongReadLen} >> is not available,
+use this function instead. It does:
+
+  $dbh->do("SET TEXTSIZE $bytes");
+
+Takes the number of bytes, or uses the C<LongReadLen> value from your
+L<connect_info|DBIx::Class::Storage::DBI/connect_info> if omitted, lastly falls
+back to the C<32768> which is the L<DBD::Sybase> default.
+
+=cut
+
+sub set_textsize {
+  my $self = shift;
+  my $text_size =
+    shift
+      ||
+    try { $self->_dbic_cinnect_attributes->{LongReadLen} }
+      ||
+    32768; # the DBD::Sybase default
+
+  $self->_dbh->do("SET TEXTSIZE $text_size");
+}
+
+sub _exec_txn_begin {
+  my $self = shift;
+
+  if ($self->{_in_do_block}) {
+    $self->_dbh->do('BEGIN TRAN');
+  }
+  else {
+    $self->dbh_do(sub { $_[1]->do('BEGIN TRAN') });
+  }
+}
+
+sub _exec_txn_commit {
+  my $self = shift;
+
+  my $dbh = $self->_dbh
+    or $self->throw_exception('cannot COMMIT on a disconnected handle');
+
+  $dbh->do('COMMIT');
+}
+
+sub _exec_txn_rollback {
+  my $self = shift;
+
+  my $dbh  = $self->_dbh
+    or $self->throw_exception('cannot ROLLBACK on a disconnected handle');
+
+  $dbh->do('ROLLBACK');
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm

@@ -0,0 +1,50 @@
+package DBIx::Class::Storage::DBI::Sybase::MSSQL;
+
+use strict;
+use warnings;
+
+use DBIx::Class::Carp;
+use namespace::clean;
+
+carp 'Setting of storage_type is redundant as connections through DBD::Sybase'
+    .' are now properly recognized and reblessed into the appropriate subclass'
+    .' (DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server in the'
+    .' case of MSSQL). Please remove the explicit call to'
+    .q/ $schema->storage_type('::DBI::Sybase::MSSQL')/
+    .', as this storage class has been deprecated in favor of the autodetected'
+    .' ::DBI::Sybase::Microsoft_SQL_Server';
+
+
+use base qw/DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server/;
+use mro 'c3';
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::MSSQL - (DEPRECATED) Legacy storage class for MSSQL via DBD::Sybase
+
+=head1 NOTE
+
+Connections through DBD::Sybase are now correctly recognized and reblessed
+into the appropriate subclass (L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>
+in the case of MSSQL). Please remove the explicit storage_type setting from your
+schema.
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL connected via L<DBD::Sybase>.
+
+  $schema->storage_type('::DBI::Sybase::MSSQL');
+  $schema->connect_info('dbi:Sybase:....', ...);
+
+=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/Storage/DBI/Sybase/Microsoft_SQL_Server.pm

@@ -0,0 +1,188 @@
+package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
+
+use strict;
+use warnings;
+
+use base qw/
+  DBIx::Class::Storage::DBI::Sybase
+  DBIx::Class::Storage::DBI::MSSQL
+/;
+use mro 'c3';
+
+use DBIx::Class::Carp;
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Support for Microsoft
+SQL Server via DBD::Sybase
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL server connections via L<DBD::Sybase>.
+
+=head1 DESCRIPTION
+
+This driver tries to determine whether your version of L<DBD::Sybase> and
+supporting libraries (usually FreeTDS) support using placeholders, if not the
+storage will be reblessed to
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars>.
+
+The MSSQL specific functionality is provided by
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+=head1 METHODS
+
+=cut
+
+__PACKAGE__->datetime_parser_type(
+  'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format'
+);
+
+sub _rebless {
+  my $self = shift;
+  my $dbh  = $self->_get_dbh;
+
+  return if ref $self ne __PACKAGE__;
+  if (not $self->_use_typeless_placeholders) {
+    carp_once <<'EOF' unless $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN};
+Placeholders do not seem to be supported in your configuration of
+DBD::Sybase/FreeTDS.
+
+This means you are taking a large performance hit, as caching of prepared
+statements is disabled.
+
+Make sure to configure your server with "tds version" of 8.0 or 7.0 in
+/etc/freetds/freetds.conf .
+
+To turn off this warning, set the DBIC_MSSQL_FREETDS_LOWVER_NOWARN environment
+variable.
+EOF
+    require
+      DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
+    bless $self,
+      'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
+    $self->_rebless;
+  }
+}
+
+sub _init {
+  my $self = shift;
+
+  $self->next::method(@_);
+
+  # work around massively broken freetds versions after 0.82
+  # - explicitly no scope_identity
+  # - no sth caching
+  #
+  # warn about the fact as well, do not provide a mechanism to shut it up
+  if ($self->_using_freetds and (my $ver = $self->_using_freetds_version||999) > 0.82) {
+    carp_once(
+      "Your DBD::Sybase was compiled against buggy FreeTDS version $ver. "
+    . 'Statement caching does not work and will be disabled.'
+    );
+
+    $self->_identity_method('@@identity');
+    $self->_no_scope_identity_query(1);
+    $self->disable_sth_caching(1);
+  }
+}
+
+# invoked only if DBD::Sybase is compiled against FreeTDS
+sub _set_autocommit_stmt {
+  my ($self, $on) = @_;
+
+  return 'SET IMPLICIT_TRANSACTIONS ' . ($on ? 'OFF' : 'ON');
+}
+
+sub _get_server_version {
+  my $self = shift;
+
+  my $product_version = $self->_get_dbh->selectrow_hashref('master.dbo.xp_msver ProductVersion');
+
+  if ((my $version = $product_version->{Character_Value}) =~ /^(\d+)\./) {
+    return $version;
+  }
+  else {
+    $self->throw_exception(
+      "MSSQL Version Retrieval Failed, Your ProductVersion's Character_Value is missing or malformed!"
+    );
+  }
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+  on_connect_call => 'datetime_setup'
+
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set:
+
+  $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
+
+On connection for use with L<DBIx::Class::InflateColumn::DateTime>
+
+This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
+C<SMALLDATETIME> columns only have minute precision.
+
+=cut
+
+sub connect_call_datetime_setup {
+  my $self = shift;
+  my $dbh = $self->_get_dbh;
+
+  if ($dbh->can('syb_date_fmt')) {
+    # amazingly, this works with FreeTDS
+    $dbh->syb_date_fmt('ISO_strict');
+  }
+  else{
+    carp_once
+      'Your DBD::Sybase is too old to support '
+    . 'DBIx::Class::InflateColumn::DateTime, please upgrade!';
+  }
+}
+
+
+package # hide from PAUSE
+  DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format;
+
+my $datetime_parse_format  = '%Y-%m-%dT%H:%M:%S.%3NZ';
+my $datetime_format_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
+
+my ($datetime_parser, $datetime_formatter);
+
+sub parse_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_parser ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_parse_format,
+    on_error => 'croak',
+  );
+  return $datetime_parser->parse_datetime(shift);
+}
+
+sub format_datetime {
+  shift;
+  require DateTime::Format::Strptime;
+  $datetime_formatter ||= DateTime::Format::Strptime->new(
+    pattern  => $datetime_format_format,
+    on_error => 'croak',
+  );
+  return $datetime_formatter->format_datetime(shift);
+}
+
+=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>.
+
+=cut
+
+1;
+

database/perl/vendor/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/NoBindVars.pm

@@ -0,0 +1,55 @@
+package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
+
+use strict;
+use warnings;
+
+use base qw/
+  DBIx::Class::Storage::DBI::NoBindVars
+  DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server
+/;
+use mro 'c3';
+
+sub _init {
+  my $self = shift;
+  $self->disable_sth_caching(1);
+
+  $self->next::method(@_);
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars - Support for Microsoft
+SQL Server via DBD::Sybase without placeholders
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL server connections via DBD::Sybase when ? style
+placeholders are not available.
+
+=head1 DESCRIPTION
+
+If you are using this driver then your combination of L<DBD::Sybase> and
+libraries (most likely FreeTDS) does not support ? style placeholders.
+
+This storage driver uses L<DBIx::Class::Storage::DBI::NoBindVars> as a base.
+This means that bind variables will be interpolated (properly quoted of course)
+into the SQL query itself, without using bind placeholders.
+
+More importantly this means that caching of prepared statements is explicitly
+disabled, as the interpolation renders it useless.
+
+In all other respects, it is a subclass of
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
+
+=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/Storage/DBI/UniqueIdentifier.pm

@@ -0,0 +1,122 @@
+package DBIx::Class::Storage::DBI::UniqueIdentifier;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors(inherited => 'new_guid');
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::UniqueIdentifier - Storage component for RDBMSes
+supporting GUID types
+
+=head1 DESCRIPTION
+
+This is a storage component for databases that support GUID types such as
+C<uniqueidentifier>, C<uniqueidentifierstr> or C<guid>.
+
+GUIDs are generated automatically for PK columns with a supported
+L<data_type|DBIx::Class::ResultSource/data_type>, as well as non-PK with
+L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> set.
+
+=head1 METHODS
+
+=head2 new_guid
+
+The composing class must set C<new_guid> to the method used to generate a new
+GUID. It can also set it to C<undef>, in which case the user is required to set
+it, or a runtime error will be thrown. It can be:
+
+=over 4
+
+=item string
+
+In which case it is used as the name of database function to create a new GUID,
+
+=item coderef
+
+In which case the coderef should return a string GUID, using L<Data::GUID>, or
+whatever GUID generation method you prefer. It is passed the C<$self>
+L<DBIx::Class::Storage> reference as a parameter.
+
+=back
+
+For example:
+
+  $schema->storage->new_guid(sub { Data::GUID->new->as_string });
+
+=cut
+
+my $GUID_TYPE = qr/^(?:uniqueidentifier(?:str)?|guid)\z/i;
+
+sub _is_guid_type {
+  my ($self, $data_type) = @_;
+
+  return $data_type =~ $GUID_TYPE;
+}
+
+sub _prefetch_autovalues  {
+  my $self = shift;
+  my ($source, $col_info, $to_insert) = @_;
+
+  my %guid_cols;
+  my @pk_cols = $source->primary_columns;
+  my %pk_col_idx;
+  @pk_col_idx{@pk_cols} = ();
+
+  my @pk_guids = grep {
+    $col_info->{$_}{data_type}
+    &&
+    $col_info->{$_}{data_type} =~ $GUID_TYPE
+  } @pk_cols;
+
+  my @auto_guids = grep {
+    $col_info->{$_}{data_type}
+    &&
+    $col_info->{$_}{data_type} =~ $GUID_TYPE
+    &&
+    $col_info->{$_}{auto_nextval}
+  } grep { not exists $pk_col_idx{$_} } $source->columns;
+
+  my @get_guids_for =
+    grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
+
+  for my $guid_col (@get_guids_for) {
+    my $new_guid;
+
+    my $guid_method = $self->new_guid;
+
+    if (not defined $guid_method) {
+      $self->throw_exception(
+        'You must set new_guid() on your storage. See perldoc '
+       .'DBIx::Class::Storage::DBI::UniqueIdentifier'
+      );
+    }
+
+    if (ref $guid_method eq 'CODE') {
+      $to_insert->{$guid_col} = $guid_method->($self);
+    }
+    else {
+      ($to_insert->{$guid_col}) = $self->_get_dbh->selectrow_array("SELECT $guid_method");
+    }
+  }
+
+  return $self->next::method(@_);
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/DBI/mysql.pm

@@ -0,0 +1,221 @@
+package DBIx::Class::Storage::DBI::mysql;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MySQL');
+__PACKAGE__->sql_limit_dialect ('LimitXY');
+__PACKAGE__->sql_quote_char ('`');
+
+__PACKAGE__->_use_multicolumn_in (1);
+
+sub with_deferred_fk_checks {
+  my ($self, $sub) = @_;
+
+  $self->_do_query('SET FOREIGN_KEY_CHECKS = 0');
+  $sub->();
+  $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
+}
+
+sub connect_call_set_strict_mode {
+  my $self = shift;
+
+  # the @@sql_mode puts back what was previously set on the session handle
+  $self->_do_query(q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)|);
+  $self->_do_query(q|SET SQL_AUTO_IS_NULL = 0|);
+}
+
+sub _dbh_last_insert_id {
+  my ($self, $dbh, $source, $col) = @_;
+  $dbh->{mysql_insertid};
+}
+
+sub _prep_for_execute {
+  my $self = shift;
+  #(my $op, $ident, $args) = @_;
+
+  # Only update and delete need special double-subquery treatment
+  # Insert referencing the same table (i.e. SELECT MAX(id) + 1) seems
+  # to work just fine on MySQL
+  return $self->next::method(@_) if ( $_[0] eq 'select' or $_[0] eq 'insert' );
+
+
+  # FIXME FIXME FIXME - this is a terrible, gross, incomplete, MySQL-specific
+  # hack but it works rather well for the limited amount of actual use cases
+  # which can not be done in any other way on MySQL. This allows us to fix
+  # some bugs without breaking MySQL support in the process and is also
+  # crucial for more complex things like Shadow to be usable
+  #
+  # This code is just a pre-analyzer, working in tandem with ::SQLMaker::MySQL,
+  # where the possibly-set value of {_modification_target_referenced_re} is
+  # used to demarcate which part of the final SQL to double-wrap in a subquery.
+  #
+  # This is covered extensively by "offline" tests, so that competing SQLMaker
+  # implementations could benefit from the existing tests just as well.
+
+  # extract the source name, construct modification indicator re
+  my $sm = $self->sql_maker;
+
+  my $target_name = $_[1]->from;
+
+  if (ref $target_name) {
+    if (
+      ref $target_name eq 'SCALAR'
+        and
+      $$target_name =~ /^ (?:
+          \` ( [^`]+ ) \` #`
+        | ( [\w\-]+ )
+      ) $/x
+    ) {
+      # this is just a plain-ish name, which has been literal-ed for
+      # whatever reason
+      $target_name = (defined $1) ? $1 : $2;
+    }
+    else {
+      # this is something very complex, perhaps a custom result source or whatnot
+      # can't deal with it
+      undef $target_name;
+    }
+  }
+
+  local $sm->{_modification_target_referenced_re} =
+      qr/ (?<!DELETE) [\s\)] (?: FROM | JOIN ) \s (?: \` \Q$target_name\E \` | \Q$target_name\E ) [\s\(] /xi
+    if $target_name;
+
+  $self->next::method(@_);
+}
+
+# here may seem like an odd place to override, but this is the first
+# method called after we are connected *and* the driver is determined
+# ($self is reblessed). See code flow in ::Storage::DBI::_populate_dbh
+sub _run_connection_actions {
+  my $self = shift;
+
+  # default mysql_auto_reconnect to off unless explicitly set
+  if (
+    $self->_dbh->{mysql_auto_reconnect}
+      and
+    ! exists $self->_dbic_connect_attributes->{mysql_auto_reconnect}
+  ) {
+    $self->_dbh->{mysql_auto_reconnect} = 0;
+  }
+
+  $self->next::method(@_);
+}
+
+# we need to figure out what mysql version we're running
+sub sql_maker {
+  my $self = shift;
+
+  # it is critical to get the version *before* calling next::method
+  # otherwise the potential connect will obliterate the sql_maker
+  # next::method will populate in the _sql_maker accessor
+  my $mysql_ver = $self->_server_info->{normalized_dbms_version};
+
+  my $sm = $self->next::method(@_);
+
+  # mysql 3 does not understand a bare JOIN
+  $sm->{_default_jointype} = 'INNER' if $mysql_ver < 4;
+
+  $sm;
+}
+
+sub sqlt_type {
+  return 'MySQL';
+}
+
+sub deployment_statements {
+  my $self = shift;
+  my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
+
+  $sqltargs ||= {};
+
+  if (
+    ! exists $sqltargs->{producer_args}{mysql_version}
+      and
+    my $dver = $self->_server_info->{normalized_dbms_version}
+  ) {
+    $sqltargs->{producer_args}{mysql_version} = $dver;
+  }
+
+  $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
+}
+
+sub _exec_svp_begin {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("SAVEPOINT $name");
+}
+
+sub _exec_svp_release {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("RELEASE SAVEPOINT $name");
+}
+
+sub _exec_svp_rollback {
+    my ($self, $name) = @_;
+
+    $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
+
+sub is_replicating {
+    my $status = shift->_get_dbh->selectrow_hashref('show slave status');
+    return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes');
+}
+
+sub lag_behind_master {
+    return shift->_get_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::mysql - Storage::DBI class implementing MySQL specifics
+
+=head1 SYNOPSIS
+
+Storage::DBI autodetects the underlying MySQL database, and re-blesses the
+C<$storage> object into this class.
+
+  my $schema = MyApp::Schema->connect( $dsn, $user, $pass, { on_connect_call => 'set_strict_mode' } );
+
+=head1 DESCRIPTION
+
+This class implements MySQL specific bits of L<DBIx::Class::Storage::DBI>,
+like AutoIncrement column support and savepoints. Also it augments the
+SQL maker to support the MySQL-specific C<STRAIGHT_JOIN> join type, which
+you can use by specifying C<< join_type => 'straight' >> in the
+L<relationship attributes|DBIx::Class::Relationship::Base/join_type>
+
+
+It also provides a one-stop on-connect macro C<set_strict_mode> which sets
+session variables such that MySQL behaves more predictably as far as the
+SQL standard is concerned.
+
+=head1 STORAGE OPTIONS
+
+=head2 set_strict_mode
+
+Enables session-wide strict options upon connecting. Equivalent to:
+
+  ->connect ( ... , {
+    on_connect_do => [
+      q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)|,
+      q|SET SQL_AUTO_IS_NULL = 0|,
+    ]
+  });
+
+=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/Storage/Debug/PrettyPrint.pm

@@ -0,0 +1,132 @@
+package DBIx::Class::Storage::Debug::PrettyPrint;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::Statistics';
+
+use SQL::Abstract::Tree;
+
+__PACKAGE__->mk_group_accessors( simple => '_sqlat' );
+__PACKAGE__->mk_group_accessors( simple => '_clear_line_str' );
+__PACKAGE__->mk_group_accessors( simple => '_executing_str' );
+__PACKAGE__->mk_group_accessors( simple => '_show_progress' );
+__PACKAGE__->mk_group_accessors( simple => '_last_sql' );
+__PACKAGE__->mk_group_accessors( simple => 'squash_repeats' );
+
+sub new {
+   my $class = shift;
+   my $args  = shift;
+
+   my $clear_line = $args->{clear_line} || "\r\x1b[J";
+   my $executing  = $args->{executing}  || (
+      eval { require Term::ANSIColor } ? do {
+          my $c = \&Term::ANSIColor::color;
+          $c->('blink white on_black') . 'EXECUTING...' . $c->('reset');
+      } : 'EXECUTING...'
+   );
+   my $show_progress = $args->{show_progress};
+
+   my $squash_repeats = $args->{squash_repeats};
+   my $sqlat = SQL::Abstract::Tree->new($args);
+   my $self = $class->next::method(@_);
+   $self->_clear_line_str($clear_line);
+   $self->_executing_str($executing);
+   $self->_show_progress($show_progress);
+
+   $self->squash_repeats($squash_repeats);
+
+   $self->_sqlat($sqlat);
+   $self->_last_sql('');
+
+   return $self
+}
+
+sub print {
+  my $self = shift;
+  my $string = shift;
+  my $bindargs = shift || [];
+
+  my ($lw, $lr);
+  ($lw, $string, $lr) = $string =~ /^(\s*)(.+?)(\s*)$/s;
+
+  local $self->_sqlat->{fill_in_placeholders} = 0 if defined $bindargs
+    && defined $bindargs->[0] && $bindargs->[0] eq q('__BULK_INSERT__');
+
+  my $use_placeholders = !!$self->_sqlat->fill_in_placeholders;
+
+  my $sqlat = $self->_sqlat;
+  my $formatted;
+  if ($self->squash_repeats && $self->_last_sql eq $string) {
+     my ( $l, $r ) = @{ $sqlat->placeholder_surround };
+     $formatted = '... : ' . join(', ', map "$l$_$r", @$bindargs)
+  } else {
+     $self->_last_sql($string);
+     $formatted = $sqlat->format($string, $bindargs);
+     $formatted = "$formatted : " . join ', ', @{$bindargs}
+        unless $use_placeholders;
+  }
+
+  $self->next::method("$lw$formatted$lr", @_);
+}
+
+sub query_start {
+  my ($self, $string, @bind) = @_;
+
+  if (defined $self->callback) {
+    $string =~ m/^(\w+)/;
+    $self->callback->($1, "$string: ".join(', ', @bind)."\n");
+    return;
+  }
+
+  $string =~ s/\s+$//;
+
+  $self->print("$string\n", \@bind);
+
+  $self->debugfh->print($self->_executing_str) if $self->_show_progress
+}
+
+sub query_end {
+  $_[0]->debugfh->print($_[0]->_clear_line_str) if $_[0]->_show_progress
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::Storage::Debug::PrettyPrint - Pretty Printing DebugObj
+
+=head1 SYNOPSIS
+
+ DBIC_TRACE_PROFILE=~/dbic.json perl -Ilib ./foo.pl
+
+Where dbic.json contains:
+
+ {
+   "profile":"console",
+   "show_progress":1,
+   "squash_repeats":1
+ }
+
+=head1 METHODS
+
+=head2 new
+
+ my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({
+   show_progress  => 1,             # tries it's best to make it clear that a SQL
+                                    # statement is still running
+   executing      => '...',         # the string that is added to the end of SQL
+                                    # if show_progress is on.  You probably don't
+                                    # need to set this
+   clear_line     => '<CR><ESC>[J', # the string used to erase the string added
+                                    # to SQL if show_progress is on.  Again, the
+                                    # default is probably good enough.
+
+   squash_repeats => 1,             # set to true to make repeated SQL queries
+                                    # be ellided and only show the new bind params
+   # any other args are passed through directly to SQL::Abstract::Tree
+ });
+
+

database/perl/vendor/lib/DBIx/Class/Storage/Debug/PrettyTrace.pm

@@ -0,0 +1,143 @@
+package DBIx::Class::Storage::Debug::PrettyTrace;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::Statistics';
+
+use SQL::Abstract::Tree;
+
+__PACKAGE__->mk_group_accessors( simple => '_sqlat' );
+__PACKAGE__->mk_group_accessors( simple => '_clear_line_str' );
+__PACKAGE__->mk_group_accessors( simple => '_executing_str' );
+__PACKAGE__->mk_group_accessors( simple => '_show_progress' );
+__PACKAGE__->mk_group_accessors( simple => '_last_sql' );
+__PACKAGE__->mk_group_accessors( simple => 'squash_repeats' );
+
+sub new {
+   my $class = shift;
+   my $args  = shift;
+
+   my $clear_line = $args->{clear_line} || "\r\x1b[J";
+   my $executing  = $args->{executing}  || (
+      eval { require Term::ANSIColor } ? do {
+          my $c = \&Term::ANSIColor::color;
+          $c->('blink white on_black') . 'EXECUTING...' . $c->('reset');
+      } : 'EXECUTING...'
+   );
+   my $show_progress = $args->{show_progress};
+
+   my $squash_repeats = $args->{squash_repeats};
+   my $sqlat = SQL::Abstract::Tree->new($args);
+   my $self = $class->next::method(@_);
+   $self->_clear_line_str($clear_line);
+   $self->_executing_str($executing);
+   $self->_show_progress($show_progress);
+
+   $self->squash_repeats($squash_repeats);
+
+   $self->_sqlat($sqlat);
+   $self->_last_sql('');
+
+   return $self
+}
+
+sub print {
+  my $self = shift;
+  my $string = shift;
+  my $bindargs = shift || [];
+
+  my ($lw, $lr);
+  ($lw, $string, $lr) = $string =~ /^(\s*)(.+?)(\s*)$/s;
+
+  local $self->_sqlat->{fill_in_placeholders} = 0 if defined $bindargs
+    && defined $bindargs->[0] && $bindargs->[0] eq q('__BULK_INSERT__');
+
+  my $use_placeholders = !!$self->_sqlat->fill_in_placeholders;
+
+  my $sqlat = $self->_sqlat;
+  my $formatted;
+  if ($self->squash_repeats && $self->_last_sql eq $string) {
+     my ( $l, $r ) = @{ $sqlat->placeholder_surround };
+     $formatted = '... : ' . join(', ', map "$l$_$r", @$bindargs)
+  } else {
+     $self->_last_sql($string);
+     $formatted = $sqlat->format($string, $bindargs);
+     $formatted = "$formatted : " . join ', ', @{$bindargs}
+        unless $use_placeholders;
+  }
+
+  $self->next::method("$lw$formatted$lr", @_);
+}
+
+sub query_start {
+  my ($self, $string, @bind) = @_;
+
+  if (defined $self->callback) {
+    $string =~ m/^(\w+)/;
+    $self->callback->($1, "$string: ".join(', ', @bind)."\n");
+    return;
+  }
+
+  $string =~ s/\s+$//;
+
+  $self->print("$string\n", \@bind);
+
+  $self->debugfh->print($self->_executing_str) if $self->_show_progress
+}
+
+sub query_end {
+  $_[0]->debugfh->print($_[0]->_clear_line_str) if $_[0]->_show_progress
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::Storage::Debug::PrettyTrace - Pretty Tracing DebugObj
+
+=head1 SYNOPSIS
+
+ DBIC_TRACE_PROFILE=~/dbic.json perl -Ilib ./foo.pl
+
+Where dbic.json contains:
+
+ {
+   "profile":"console",
+   "show_progress":1,
+   "squash_repeats":1
+ }
+
+=head1 METHODS
+
+=head2 new
+
+ my $pp = DBIx::Class::Storage::Debug::PrettyTrace->new({
+   show_progress  => 1,             # tries it's best to make it clear that a SQL
+                                    # statement is still running
+   executing      => '...',         # the string that is added to the end of SQL
+                                    # if show_progress is on.  You probably don't
+                                    # need to set this
+   clear_line     => '<CR><ESC>[J', # the string used to erase the string added
+                                    # to SQL if show_progress is on.  Again, the
+                                    # default is probably good enough.
+
+   squash_repeats => 1,             # set to true to make repeated SQL queries
+                                    # be ellided and only show the new bind params
+   # any other args are passed through directly to SQL::Abstract::Tree
+ });
+
+=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>.
+
+=cut

database/perl/vendor/lib/DBIx/Class/Storage/Statistics.pm

@@ -0,0 +1,234 @@
+package DBIx::Class::Storage::Statistics;
+
+use strict;
+use warnings;
+
+use DBIx::Class::_Util qw(sigwarn_silencer qsub);
+use IO::Handle ();
+use Moo;
+extends 'DBIx::Class';
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Storage::Statistics - SQL Statistics
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class is called by DBIx::Class::Storage::DBI as a means of collecting
+statistics on its actions.  Using this class alone merely prints the SQL
+executed, the fact that it completes and begin/end notification for
+transactions.
+
+To really use this class you should subclass it and create your own method
+for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
+
+=head1 METHODS
+
+=head2 new
+
+Returns a new L<DBIx::Class::Storage::Statistics> object.
+
+=head2 debugfh
+
+Sets or retrieves the filehandle used for trace/debug output.  This should
+be an L<IO::Handle> compatible object (only the
+L<< print|IO::Handle/METHODS >> method is used). By
+default it is initially set to STDERR - although see discussion of the
+L<DBIC_TRACE|DBIx::Class::Storage/DBIC_TRACE> environment variable.
+
+Invoked as a getter it will lazily open a filehandle and set it to
+L<< autoflush|perlvar/HANDLE->autoflush( EXPR ) >> (if one is not
+already set).
+
+=cut
+
+# FIXME - there ought to be a way to fold this into _debugfh itself
+# having the undef re-trigger the builder (or better yet a default
+# which can be folded in as a qsub)
+sub debugfh {
+  my $self = shift;
+
+  return $self->_debugfh(@_) if @_;
+  $self->_debugfh || $self->_build_debugfh;
+}
+
+has _debugfh => (
+  is => 'rw',
+  lazy => 1,
+  trigger => qsub '$_[0]->_defaulted_to_stderr(undef)',
+  builder => '_build_debugfh',
+);
+
+sub _build_debugfh {
+  my $fh;
+
+  my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
+
+  if (defined($debug_env) and ($debug_env =~ /=(.+)$/)) {
+    open ($fh, '>>', $1)
+      or die("Cannot open trace file $1: $!\n");
+  }
+  else {
+    open ($fh, '>&STDERR')
+      or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!\n");
+    $_[0]->_defaulted_to_stderr(1);
+  }
+
+  $fh->autoflush(1);
+
+  $fh;
+}
+
+has [qw(_defaulted_to_stderr silence callback)] => (
+  is => 'rw',
+);
+
+=head2 print
+
+Prints the specified string to our debugging filehandle.  Provided to save our
+methods the worry of how to display the message.
+
+=cut
+sub print {
+  my ($self, $msg) = @_;
+
+  return if $self->silence;
+
+  my $fh = $self->debugfh;
+
+  # not using 'no warnings' here because all of this can change at runtime
+  local $SIG{__WARN__} = sigwarn_silencer(qr/^Wide character in print/)
+    if $self->_defaulted_to_stderr;
+
+  $fh->print($msg);
+}
+
+=head2 silence
+
+Turn off all output if set to true.
+
+=head2 txn_begin
+
+Called when a transaction begins.
+
+=cut
+sub txn_begin {
+  my $self = shift;
+
+  return if $self->callback;
+
+  $self->print("BEGIN WORK\n");
+}
+
+=head2 txn_rollback
+
+Called when a transaction is rolled back.
+
+=cut
+sub txn_rollback {
+  my $self = shift;
+
+  return if $self->callback;
+
+  $self->print("ROLLBACK\n");
+}
+
+=head2 txn_commit
+
+Called when a transaction is committed.
+
+=cut
+sub txn_commit {
+  my $self = shift;
+
+  return if $self->callback;
+
+  $self->print("COMMIT\n");
+}
+
+=head2 svp_begin
+
+Called when a savepoint is created.
+
+=cut
+sub svp_begin {
+  my ($self, $name) = @_;
+
+  return if $self->callback;
+
+  $self->print("SAVEPOINT $name\n");
+}
+
+=head2 svp_release
+
+Called when a savepoint is released.
+
+=cut
+sub svp_release {
+  my ($self, $name) = @_;
+
+  return if $self->callback;
+
+  $self->print("RELEASE SAVEPOINT $name\n");
+}
+
+=head2 svp_rollback
+
+Called when rolling back to a savepoint.
+
+=cut
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+  return if $self->callback;
+
+  $self->print("ROLLBACK TO SAVEPOINT $name\n");
+}
+
+=head2 query_start
+
+Called before a query is executed.  The first argument is the SQL string being
+executed and subsequent arguments are the parameters used for the query.
+
+=cut
+sub query_start {
+  my ($self, $string, @bind) = @_;
+
+  my $message = "$string: ".join(', ', @bind)."\n";
+
+  if(defined($self->callback)) {
+    $string =~ m/^(\w+)/;
+    $self->callback->($1, $message);
+    return;
+  }
+
+  $self->print($message);
+}
+
+=head2 query_end
+
+Called when a query finishes executing.  Has the same arguments as query_start.
+
+=cut
+
+sub query_end {
+  my ($self, $string) = @_;
+}
+
+=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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/Storage/TxnScopeGuard.pm

@@ -0,0 +1,175 @@
+package DBIx::Class::Storage::TxnScopeGuard;
+
+use strict;
+use warnings;
+use Try::Tiny;
+use Scalar::Util qw(weaken blessed refaddr);
+use DBIx::Class;
+use DBIx::Class::_Util qw(is_exception detected_reinvoked_destructor);
+use DBIx::Class::Carp;
+use namespace::clean;
+
+sub new {
+  my ($class, $storage) = @_;
+
+  my $guard = {
+    inactivated => 0,
+    storage => $storage,
+  };
+
+  # we are starting with an already set $@ - in order for things to work we need to
+  # be able to recognize it upon destruction - store its weakref
+  # recording it before doing the txn_begin stuff
+  #
+  # FIXME FRAGILE - any eval that fails but *does not* rethrow between here
+  # and the unwind will trample over $@ and invalidate the entire mechanism
+  # There got to be a saner way of doing this...
+  if (is_exception $@) {
+    weaken(
+      $guard->{existing_exception_ref} = (ref($@) eq '') ? \$@ : $@
+    );
+  }
+
+  $storage->txn_begin;
+
+  weaken( $guard->{dbh} = $storage->_dbh );
+
+  bless $guard, ref $class || $class;
+
+  $guard;
+}
+
+sub commit {
+  my $self = shift;
+
+  $self->{storage}->throw_exception("Refusing to execute multiple commits on scope guard $self")
+    if $self->{inactivated};
+
+  # FIXME - this assumption may be premature: a commit may fail and a rollback
+  # *still* be necessary. Currently I am not aware of such scenarious, but I
+  # also know the deferred constraint handling is *severely* undertested.
+  # Making the change of "fire txn and never come back to this" in order to
+  # address RT#107159, but this *MUST* be reevaluated later.
+  $self->{inactivated} = 1;
+  $self->{storage}->txn_commit;
+}
+
+sub DESTROY {
+  return if &detected_reinvoked_destructor;
+
+  my $self = shift;
+
+  return if $self->{inactivated};
+
+  # if our dbh is not ours anymore, the $dbh weakref will go undef
+  $self->{storage}->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
+  return unless $self->{dbh};
+
+  my $exception = $@ if (
+    is_exception $@
+      and
+    (
+      ! defined $self->{existing_exception_ref}
+        or
+      refaddr( ref($@) eq '' ? \$@ : $@ ) != refaddr($self->{existing_exception_ref})
+    )
+  );
+
+  {
+    local $@;
+
+    carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
+      unless defined $exception;
+
+    my $rollback_exception;
+    # do minimal connectivity check due to weird shit like
+    # https://rt.cpan.org/Public/Bug/Display.html?id=62370
+    try { $self->{storage}->_seems_connected && $self->{storage}->txn_rollback }
+    catch { $rollback_exception = shift };
+
+    if ( $rollback_exception and (
+      ! defined blessed $rollback_exception
+          or
+      ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
+    ) ) {
+      # append our text - THIS IS A TEMPORARY FIXUP!
+      # a real stackable exception object is in the works
+      if (ref $exception eq 'DBIx::Class::Exception') {
+        $exception->{msg} = "Transaction aborted: $exception->{msg} "
+          ."Rollback failed: ${rollback_exception}";
+      }
+      elsif ($exception) {
+        $exception = "Transaction aborted: ${exception} "
+          ."Rollback failed: ${rollback_exception}";
+      }
+      else {
+        carp (join ' ',
+          "********************* ROLLBACK FAILED!!! ********************",
+          "\nA rollback operation failed after the guard went out of scope.",
+          'This is potentially a disastrous situation, check your data for',
+          "consistency: $rollback_exception"
+        );
+      }
+    }
+  }
+
+  $@ = $exception;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::Storage::TxnScopeGuard - Scope-based transaction handling
+
+=head1 SYNOPSIS
+
+ sub foo {
+   my ($self, $schema) = @_;
+
+   my $guard = $schema->txn_scope_guard;
+
+   # Multiple database operations here
+
+   $guard->commit;
+ }
+
+=head1 DESCRIPTION
+
+An object that behaves much like L<Scope::Guard>, but hardcoded to do the
+right thing with transactions in DBIx::Class.
+
+=head1 METHODS
+
+=head2 new
+
+Creating an instance of this class will start a new transaction (by
+implicitly calling L<DBIx::Class::Storage/txn_begin>. Expects a
+L<DBIx::Class::Storage> object as its only argument.
+
+=head2 commit
+
+Commit the transaction, and stop guarding the scope. If this method is not
+called and this object goes out of scope (e.g. an exception is thrown) then
+the transaction is rolled back, via L<DBIx::Class::Storage/txn_rollback>
+
+=cut
+
+=head1 SEE ALSO
+
+L<DBIx::Class::Schema/txn_scope_guard>.
+
+L<Scope::Guard> by chocolateboy (inspiration for this module)
+
+=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>.