Initial Commit

database/perl/vendor/lib/DBIx/Class/CDBICompat/AbstractSearch.pm

@@ -0,0 +1,50 @@
+package # hide form PAUSE
+    DBIx::Class::CDBICompat::AbstractSearch;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::AbstractSearch - Emulates Class::DBI::AbstractSearch
+
+=head1 SYNOPSIS
+
+See DBIx::Class::CDBICompat for usage directions.
+
+=head1 DESCRIPTION
+
+Emulates L<Class::DBI::AbstractSearch>.
+
+=cut
+
+# The keys are mostly the same.
+my %cdbi2dbix = (
+    limit               => 'rows',
+);
+
+sub search_where {
+    my $class = shift;
+    my $where = (ref $_[0]) ? $_[0] : { @_ };
+    my $attr  = (ref $_[0]) ? $_[1] : {};
+
+    # Translate the keys
+    $attr->{$cdbi2dbix{$_}} = delete $attr->{$_} for keys %cdbi2dbix;
+
+    return $class->resultset_instance->search($where, $attr);
+}
+
+=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/CDBICompat/AccessorMapping.pm

@@ -0,0 +1,75 @@
+package # hide from PAUSE Indexer
+  DBIx::Class::CDBICompat::AccessorMapping;
+
+use strict;
+use warnings;
+
+use Scalar::Util 'blessed';
+use namespace::clean;
+
+sub mk_group_accessors {
+    my ($class, $group, @cols) = @_;
+
+    foreach my $col (@cols) {
+        my($accessor, $col) = ref $col eq 'ARRAY' ? @$col : (undef, $col);
+
+        my($ro_meth, $wo_meth);
+        if (defined blessed $col and $col->isa('Class::DBI::Column')) {
+            $ro_meth = $col->accessor;
+            $wo_meth = $col->mutator;
+        }
+        elsif (defined $accessor and ($accessor ne $col)) {
+            $ro_meth = $wo_meth = $accessor;
+        }
+        else {
+            $ro_meth = $class->accessor_name_for($col);
+            $wo_meth = $class->mutator_name_for($col);
+        }
+
+        # warn "class: $class / col: $col / ro: $ro_meth / wo: $wo_meth\n";
+        if ($ro_meth eq $wo_meth or # they're the same
+            $wo_meth eq $col)     # or only the accessor is custom
+        {
+            $class->next::method($group => [ $ro_meth => $col ]);
+        }
+        else {
+            $class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
+            $class->mk_group_wo_accessors($group => [ $wo_meth => $col ]);
+        }
+    }
+}
+
+
+sub accessor_name_for {
+    my ($class, $column) = @_;
+    if ($class->can('accessor_name')) {
+        return $class->accessor_name($column)
+    }
+
+    return $column;
+}
+
+sub mutator_name_for {
+    my ($class, $column) = @_;
+    if ($class->can('mutator_name')) {
+        return $class->mutator_name($column)
+    }
+
+    return $column;
+}
+
+
+sub new {
+    my ($class, $attrs, @rest) = @_;
+    $class->throw_exception( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+    foreach my $col ($class->columns) {
+        my $acc = $class->accessor_name_for($col);
+        $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
+
+        my $mut = $class->mutator_name_for($col);
+        $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
+    }
+    return $class->next::method($attrs, @rest);
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/AttributeAPI.pm

@@ -0,0 +1,36 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::AttributeAPI;
+
+use strict;
+use warnings;
+
+sub _attrs {
+  my ($self, @atts) = @_;
+  return @{$self->{_column_data}}{@atts};
+}
+
+*_attr = \&_attrs;
+
+sub _attribute_store {
+  my $self   = shift;
+  my $vals   = @_ == 1 ? shift: {@_};
+  $self->store_column($_, $vals->{$_}) for keys %{$vals};
+}
+
+sub _attribute_set {
+  my $self   = shift;
+  my $vals   = @_ == 1 ? shift: {@_};
+  $self->set_column($_, $vals->{$_}) for keys %{$vals};
+}
+
+sub _attribute_delete {
+  my ($self, $attr) = @_;
+  delete $self->{_column_data}{$attr};
+}
+
+sub _attribute_exists {
+  my ($self, $attr) = @_;
+  $self->has_column_loaded($attr);
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/AutoUpdate.pm

@@ -0,0 +1,40 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::AutoUpdate;
+
+use strict;
+use warnings;
+
+use base qw/Class::Data::Inheritable/;
+
+__PACKAGE__->mk_classdata('__AutoCommit');
+
+sub set_column {
+  my $self = shift;
+  my $ret = $self->next::method(@_);
+  $self->update if ($self->autoupdate && $self->{_in_storage});
+  return $ret;
+}
+
+sub autoupdate {
+        my $proto = shift;
+        ref $proto
+          ? $proto->_obj_autoupdate(@_)
+          : $proto->_class_autoupdate(@_) ;
+}
+
+sub _obj_autoupdate {
+        my ($self, $set) = @_;
+        my $class = ref $self;
+        $self->{__AutoCommit} = $set if defined $set;
+        defined $self->{__AutoCommit}
+                ? $self->{__AutoCommit}
+                : $class->_class_autoupdate;
+}
+
+sub _class_autoupdate {
+        my ($class, $set) = @_;
+        $class->__AutoCommit($set) if defined $set;
+        return $class->__AutoCommit;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/ColumnCase.pm

@@ -0,0 +1,104 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::ColumnCase;
+
+use strict;
+use warnings;
+
+sub _register_column_group {
+  my ($class, $group, @cols) = @_;
+  return $class->next::method($group => map lc, @cols);
+}
+
+sub add_columns {
+  my ($class, @cols) = @_;
+  return $class->result_source_instance->add_columns(map lc, @cols);
+}
+
+sub has_a {
+    my($self, $col, @rest) = @_;
+
+    $self->_declare_has_a(lc $col, @rest);
+    $self->_mk_inflated_column_accessor($col);
+
+    return 1;
+}
+
+sub has_many {
+  my ($class, $rel, $f_class, $f_key, @rest) = @_;
+  return $class->next::method(
+    $rel,
+    $f_class,
+    (ref($f_key) ?
+      $f_key :
+      lc($f_key||'')
+    ),
+    @rest
+  );
+}
+
+sub get_inflated_column {
+  my ($class, $get, @rest) = @_;
+  return $class->next::method(lc($get), @rest);
+}
+
+sub store_inflated_column {
+  my ($class, $set, @rest) = @_;
+  return $class->next::method(lc($set), @rest);
+}
+
+sub set_inflated_column {
+  my ($class, $set, @rest) = @_;
+  return $class->next::method(lc($set), @rest);
+}
+
+sub get_column {
+  my ($class, $get, @rest) = @_;
+  return $class->next::method(lc($get), @rest);
+}
+
+sub set_column {
+  my ($class, $set, @rest) = @_;
+  return $class->next::method(lc($set), @rest);
+}
+
+sub store_column {
+  my ($class, $set, @rest) = @_;
+  return $class->next::method(lc($set), @rest);
+}
+
+sub find_column {
+  my ($class, $col) = @_;
+  return $class->next::method(lc($col));
+}
+
+# _build_query
+#
+# Build a query hash for find, et al. Overrides Retrieve::_build_query.
+
+sub _build_query {
+  my ($self, $query) = @_;
+
+  my %new_query;
+  $new_query{lc $_} = $query->{$_} for keys %$query;
+
+  return \%new_query;
+}
+
+sub _deploy_accessor {
+  my($class, $name, $accessor) = @_;
+
+  return if $class->_has_custom_accessor($name);
+
+         $class->next::method(lc $name   => $accessor);
+  return $class->next::method($name      => $accessor);
+}
+
+
+sub new {
+  my ($class, $attrs, @rest) = @_;
+  my %att;
+  $att{lc $_} = $attrs->{$_} for keys %$attrs;
+  return $class->next::method(\%att, @rest);
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/ColumnGroups.pm

@@ -0,0 +1,180 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::ColumnGroups;
+
+use strict;
+use warnings;
+use Sub::Name ();
+use Storable 'dclone';
+use List::Util ();
+
+use base qw/DBIx::Class::Row/;
+
+__PACKAGE__->mk_classdata('_column_groups' => { });
+
+sub columns {
+  my $proto = shift;
+  my $class = ref $proto || $proto;
+  my $group = shift || "All";
+  $class->_init_result_source_instance();
+
+  $class->_add_column_group($group => @_) if @_;
+  return $class->all_columns    if $group eq "All";
+  return $class->primary_column if $group eq "Primary";
+
+  my $grp = $class->_column_groups->{$group};
+  my @grp_cols = sort { $grp->{$b} <=> $grp->{$a} } (keys %$grp);
+  return @grp_cols;
+}
+
+sub _add_column_group {
+  my ($class, $group, @cols) = @_;
+  $class->mk_group_accessors(column => @cols);
+  $class->add_columns(@cols);
+  $class->_register_column_group($group => @cols);
+}
+
+sub add_columns {
+  my ($class, @cols) = @_;
+  $class->result_source_instance->add_columns(@cols);
+}
+
+sub _register_column_group {
+  my ($class, $group, @cols) = @_;
+
+  # Must do a complete deep copy else column groups
+  # might accidentally be shared.
+  my $groups = dclone $class->_column_groups;
+
+  if ($group eq 'Primary') {
+    $class->set_primary_key(@cols);
+    delete $groups->{'Essential'}{$_} for @cols;
+    my $first = List::Util::max(values %{$groups->{'Essential'}});
+    $groups->{'Essential'}{$_} = ++$first for reverse @cols;
+  }
+
+  if ($group eq 'All') {
+    unless (exists $class->_column_groups->{'Primary'}) {
+      $groups->{'Primary'}{$cols[0]} = 1;
+      $class->set_primary_key($cols[0]);
+    }
+    unless (exists $class->_column_groups->{'Essential'}) {
+      $groups->{'Essential'}{$cols[0]} = 1;
+    }
+  }
+
+  delete $groups->{$group}{$_} for @cols;
+  my $first = List::Util::max(values %{$groups->{$group}});
+  $groups->{$group}{$_} = ++$first for reverse @cols;
+
+  $class->_column_groups($groups);
+}
+
+# CDBI will never overwrite an accessor, but it only uses one
+# accessor for all column types.  DBIC uses many different
+# accessor types so, for example, if you declare a column()
+# and then a has_a() for that same column it must overwrite.
+#
+# To make this work CDBICompat has decide if an accessor
+# method was put there by itself and only then overwrite.
+{
+  my %our_accessors;
+
+  sub _has_custom_accessor {
+    my($class, $name) = @_;
+
+    no strict 'refs';
+    my $existing_accessor = *{$class .'::'. $name}{CODE};
+    return $existing_accessor && !$our_accessors{$existing_accessor};
+  }
+
+  sub _deploy_accessor {
+    my($class, $name, $accessor) = @_;
+
+    return if $class->_has_custom_accessor($name);
+
+    {
+      no strict 'refs';
+      no warnings 'redefine';
+      my $fullname = join '::', $class, $name;
+      *$fullname = Sub::Name::subname $fullname, $accessor;
+    }
+
+    $our_accessors{$accessor}++;
+
+    return 1;
+  }
+}
+
+sub _mk_group_accessors {
+  my ($class, $type, $group, @fields) = @_;
+
+  # So we don't have to do lots of lookups inside the loop.
+  my $maker = $class->can($type) unless ref $type;
+
+  # warn "$class $type $group\n";
+  foreach my $field (@fields) {
+    if( $field eq 'DESTROY' ) {
+        carp("Having a data accessor named DESTROY in ".
+             "'$class' is unwise.");
+    }
+
+    my $name = $field;
+
+    ($name, $field) = @$field if ref $field;
+
+    my $accessor = $class->$maker($group, $field);
+    my $alias = "_${name}_accessor";
+
+    # warn "  $field $alias\n";
+    {
+      no strict 'refs';
+
+      $class->_deploy_accessor($name,  $accessor);
+      $class->_deploy_accessor($alias, $accessor);
+    }
+  }
+}
+
+sub all_columns { return shift->result_source_instance->columns; }
+
+sub primary_column {
+  my ($class) = @_;
+  my @pri = $class->primary_columns;
+  return wantarray ? @pri : $pri[0];
+}
+
+sub _essential {
+    return shift->columns("Essential");
+}
+
+sub find_column {
+  my ($class, $col) = @_;
+  return $col if $class->has_column($col);
+}
+
+sub __grouper {
+  my ($class) = @_;
+  my $grouper = { class => $class };
+  return bless($grouper, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
+}
+
+sub _find_columns {
+  my ($class, @col) = @_;
+  return map { $class->find_column($_) } @col;
+}
+
+package # hide from PAUSE (should be harmless, no POD no Version)
+    DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
+
+sub groups_for {
+  my ($self, @cols) = @_;
+  my %groups;
+  foreach my $col (@cols) {
+    foreach my $group (keys %{$self->{class}->_column_groups}) {
+      $groups{$group} = 1 if $self->{class}->_column_groups->{$group}->{$col};
+    }
+  }
+  return keys %groups;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm

@@ -0,0 +1,118 @@
+package
+    DBIx::Class::CDBICompat::ColumnsAsHash;
+
+use strict;
+use warnings;
+
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::ColumnsAsHash - Emulates the behavior of Class::DBI where the object can be accessed as a hash of columns.
+
+=head1 SYNOPSIS
+
+See DBIx::Class::CDBICompat for usage directions.
+
+=head1 DESCRIPTION
+
+Emulates the I<undocumented> behavior of Class::DBI where the object can be accessed as a hash of columns.  This is often used as a performance hack.
+
+    my $column = $result->{column};
+
+=head2 Differences from Class::DBI
+
+If C<DBIC_CDBICOMPAT_HASH_WARN> is true it will warn when a column is accessed as a hash key.
+
+=cut
+
+sub new {
+    my $class = shift;
+
+    my $new = $class->next::method(@_);
+
+    $new->_make_columns_as_hash;
+
+    return $new;
+}
+
+sub inflate_result {
+    my $class = shift;
+
+    my $new = $class->next::method(@_);
+
+    $new->_make_columns_as_hash;
+
+    return $new;
+}
+
+
+sub _make_columns_as_hash {
+    my $self = shift;
+
+    for my $col ($self->columns) {
+        if( exists $self->{$col} ) {
+            warn "Skipping mapping $col to a hash key because it exists";
+        }
+
+        tie $self->{$col}, 'DBIx::Class::CDBICompat::Tied::ColumnValue',
+            $self, $col;
+    }
+}
+
+
+package DBIx::Class::CDBICompat::Tied::ColumnValue;
+
+use Carp;
+use Scalar::Util qw(weaken isweak);
+
+
+sub TIESCALAR {
+    my($class, $obj, $col) = @_;
+    my $self = [$obj, $col];
+    weaken $self->[0];
+
+    return bless $self, $_[0];
+}
+
+sub FETCH {
+    my $self = shift;
+    my($obj, $col) = @$self;
+
+    my $class = ref $obj;
+    my $id    = $obj->id;
+    carp "Column '$col' of '$class/$id' was fetched as a hash"
+        if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
+
+    return $obj->column_info($col)->{_inflate_info}
+                ? $obj->get_inflated_column($col)
+                : $obj->get_column($col);
+}
+
+sub STORE {
+    my $self = shift;
+    my($obj, $col) = @$self;
+
+    my $class = ref $obj;
+    my $id    = $obj->id;
+    carp "Column '$col' of '$class/$id' was stored as a hash"
+        if $ENV{DBIC_CDBICOMPAT_HASH_WARN};
+
+    return $obj->column_info($col)->{_inflate_info}
+                ? $obj->set_inflated_column($col => shift)
+                : $obj->set_column($col => 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/CDBICompat/Constraints.pm

@@ -0,0 +1,51 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Constraints;
+
+use strict;
+use warnings;
+
+sub constrain_column {
+  my $class = shift;
+  my $col   = $class->find_column(+shift)
+    or return $class->throw_exception("constraint_column needs a valid column");
+  my $how = shift
+    or return $class->throw_exception("constrain_column needs a constraint");
+  if (ref $how eq "ARRAY") {
+    my %hash = map { $_ => 1 } @$how;
+    $class->add_constraint(list => $col => sub { exists $hash{ +shift } });
+  } elsif (ref $how eq "Regexp") {
+    $class->add_constraint(regexp => $col => sub { shift =~ $how });
+  } else {
+    $how =~ m/([^:]+)$/; # match is safe - we throw above on empty $how
+    my $try_method = sprintf '_constrain_by_%s', lc $1; # $how->moniker;
+    if (my $dispatch = $class->can($try_method)) {
+      $class->$dispatch($col => ($how, @_));
+    } else {
+      $class->throw_exception("Don't know how to constrain $col with $how");
+    }
+  }
+}
+
+sub add_constraint {
+  my $class = shift;
+  $class->_invalid_object_method('add_constraint()') if ref $class;
+  my $name = shift or return $class->throw_exception("Constraint needs a name");
+  my $column = $class->find_column(+shift)
+    or return $class->throw_exception("Constraint $name needs a valid column");
+  my $code = shift
+    or return $class->throw_exception("Constraint $name needs a code reference");
+  return $class->throw_exception("Constraint $name '$code' is not a code reference")
+    unless ref($code) eq "CODE";
+
+  #$column->is_constrained(1);
+  $class->add_trigger(
+    "before_set_$column" => sub {
+      my ($self, $value, $column_values) = @_;
+      $code->($value, $self, $column, $column_values)
+        or return $self->throw_exception(
+        "$class $column fails '$name' constraint with '$value'");
+    }
+  );
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Constructor.pm

@@ -0,0 +1,31 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Constructor;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::CDBICompat::ImaDBI';
+
+use Carp;
+use DBIx::Class::_Util qw(quote_sub perlstring);
+
+__PACKAGE__->set_sql(Retrieve => <<'');
+SELECT __ESSENTIAL__
+FROM   __TABLE__
+WHERE  %s
+
+sub add_constructor {
+    my ($class, $method, $fragment) = @_;
+
+    croak("constructors needs a name") unless $method;
+
+    carp("$method already exists in $class") && return
+       if $class->can($method);
+
+    quote_sub "${class}::${method}" => sprintf( <<'EOC', perlstring $fragment );
+      my $self = shift;
+      $self->sth_to_objects($self->sql_Retrieve(%s), \@_);
+EOC
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Copy.pm

@@ -0,0 +1,49 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Copy;
+
+use strict;
+use warnings;
+
+use Carp;
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::Copy - Emulates Class::DBI->copy($new_id)
+
+=head1 SYNOPSIS
+
+See DBIx::Class::CDBICompat for usage directions.
+
+=head1 DESCRIPTION
+
+Emulates C<<Class::DBI->copy($new_id)>>.
+
+=cut
+
+
+# CDBI's copy will take an id in addition to a hash ref.
+sub copy {
+    my($self, $arg) = @_;
+    return $self->next::method($arg) if ref $arg;
+
+    my @primary_columns = $self->primary_columns;
+    croak("Need hash-ref to edit copied column values")
+        if @primary_columns > 1;
+
+    return $self->next::method({ $primary_columns[0] => $arg });
+}
+
+=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/CDBICompat/DestroyWarning.pm

@@ -0,0 +1,19 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::DestroyWarning;
+
+use strict;
+use warnings;
+use DBIx::Class::_Util 'detected_reinvoked_destructor';
+use namespace::clean;
+
+sub DESTROY {
+  return if &detected_reinvoked_destructor;
+
+  my ($self) = @_;
+  my $class = ref $self;
+  warn "$class $self destroyed without saving changes to "
+         .join(', ', keys %{$self->{_dirty_columns} || {}})
+    if keys %{$self->{_dirty_columns} || {}};
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/GetSet.pm

@@ -0,0 +1,32 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::GetSet;
+
+use strict;
+use warnings;
+
+#use base qw/Class::Accessor/;
+
+sub get {
+  my ($self, @cols) = @_;
+  if (@cols > 1) {
+    return map { $self->get_column($_) } @cols;
+  } else {
+    return $self->get_column($_[1]);
+  }
+}
+
+sub set {
+  my($self, %data) = @_;
+
+  # set_columns() is going to do a string comparison before setting.
+  # This breaks on DateTime objects (whose comparison is arguably broken)
+  # so we stringify anything first.
+  for my $key (keys %data) {
+    next unless ref $data{$key};
+    $data{$key} = "$data{$key}";
+  }
+
+  return shift->set_columns(\%data);
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/ImaDBI.pm

@@ -0,0 +1,142 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::ImaDBI;
+
+use strict;
+use warnings;
+use DBIx::ContextualFetch;
+use DBIx::Class::_Util qw(quote_sub perlstring);
+
+use base qw(Class::Data::Inheritable);
+
+__PACKAGE__->mk_classdata('sql_transformer_class' =>
+                          'DBIx::Class::CDBICompat::SQLTransformer');
+
+__PACKAGE__->mk_classdata('_transform_sql_handler_order'
+                            => [ qw/TABLE ESSENTIAL JOIN IDENTIFIER/ ] );
+
+__PACKAGE__->mk_classdata('_transform_sql_handlers' =>
+  {
+    'TABLE' =>
+      sub {
+        my ($self, $class, $data) = @_;
+        return $class->result_source_instance->name unless $data;
+        my ($f_class, $alias) = split(/=/, $data);
+        $f_class ||= $class;
+        $self->{_classes}{$alias} = $f_class;
+        return $f_class->result_source_instance->name." ${alias}";
+      },
+    'ESSENTIAL' =>
+      sub {
+        my ($self, $class, $data) = @_;
+        $class = $data ? $self->{_classes}{$data} : $class;
+        return join(', ', $class->columns('Essential'));
+      },
+    'IDENTIFIER' =>
+      sub {
+        my ($self, $class, $data) = @_;
+        $class = $data ? $self->{_classes}{$data} : $class;
+        return join ' AND ', map  "$_ = ?", $class->primary_columns;
+      },
+    'JOIN' =>
+      sub {
+        my ($self, $class, $data) = @_;
+        my ($from, $to) = split(/ /, $data);
+        my ($from_class, $to_class) = @{$self->{_classes}}{$from, $to};
+        my ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
+                          map { $from_class->relationship_info($_) }
+                            $from_class->relationships;
+        unless ($rel_obj) {
+          ($from, $to) = ($to, $from);
+          ($from_class, $to_class) = ($to_class, $from_class);
+          ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
+                          map { $from_class->relationship_info($_) }
+                            $from_class->relationships;
+        }
+        $self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" )
+          unless $rel_obj;
+        my $join = $from_class->storage->sql_maker->_join_condition(
+          scalar $from_class->result_source_instance->_resolve_condition(
+            $rel_obj->{cond}, $to, $from
+          )
+        );
+        return $join;
+      }
+
+  } );
+
+sub db_Main {
+  return $_[0]->storage->dbh;
+}
+
+sub connection {
+  my ($class, @info) = @_;
+  $info[3] = { %{ $info[3] || {}} };
+  $info[3]->{RootClass} = 'DBIx::ContextualFetch';
+  return $class->next::method(@info);
+}
+
+sub __driver {
+  return $_[0]->storage->dbh->{Driver}->{Name};
+}
+
+sub set_sql {
+  my ($class, $name, $sql) = @_;
+
+  quote_sub "${class}::sql_${name}", sprintf( <<'EOC', perlstring $sql );
+    my $class = shift;
+    return $class->storage->dbh_do(
+      _prepare_sth => $class->transform_sql(%s, @_)
+    );
+EOC
+
+
+  if ($sql =~ /select/i) {  # FIXME - this should be anchore surely...?
+    quote_sub "${class}::search_${name}", sprintf( <<'EOC', "sql_$name" );
+      my ($class, @args) = @_;
+      $class->sth_to_objects( $class->%s, \@args);
+EOC
+  }
+}
+
+sub sth_to_objects {
+  my ($class, $sth, $execute_args) = @_;
+
+  $sth->execute(@$execute_args);
+
+  my @ret;
+  while (my $row = $sth->fetchrow_hashref) {
+    push(@ret, $class->inflate_result($class->result_source_instance, $row));
+  }
+
+  return @ret;
+}
+
+sub transform_sql {
+  my ($class, $sql, @args) = @_;
+
+  my $tclass = $class->sql_transformer_class;
+  $class->ensure_class_loaded($tclass);
+  my $t = $tclass->new($class, $sql, @args);
+
+  return sprintf($t->sql, $t->args);
+}
+
+package
+  DBIx::ContextualFetch::st; # HIDE FROM PAUSE THIS IS NOT OUR CLASS
+
+no warnings 'redefine';
+
+sub _untaint_execute {
+  my $sth = shift;
+  my $old_value = $sth->{Taint};
+  $sth->{Taint} = 0;
+  my $ret;
+  {
+    no warnings 'uninitialized';
+    $ret = $sth->SUPER::execute(@_);
+  }
+  $sth->{Taint} = $old_value;
+  return $ret;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Iterator.pm

@@ -0,0 +1,76 @@
+package DBIx::Class::CDBICompat::Iterator;
+
+use strict;
+use warnings;
+
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::Iterator - Emulates the extra behaviors of the Class::DBI search iterator.
+
+=head1 SYNOPSIS
+
+See DBIx::Class::CDBICompat for usage directions.
+
+=head1 DESCRIPTION
+
+Emulates the extra behaviors of the Class::DBI search iterator.
+
+=head2 Differences from DBIx::Class result set
+
+The CDBI iterator returns true if there were any results, false otherwise.  The DBIC result set always returns true.
+
+=cut
+
+
+sub _init_result_source_instance {
+  my $class = shift;
+
+  my $table = $class->next::method(@_);
+  $table->resultset_class("DBIx::Class::CDBICompat::Iterator::ResultSet");
+
+  return $table;
+}
+
+=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 # hide
+  DBIx::Class::CDBICompat::Iterator::ResultSet;
+
+use strict;
+use warnings;
+
+use base qw(DBIx::Class::ResultSet);
+
+sub _bool {
+    # Performance hack so internal checks whether the result set
+    # exists won't do a SQL COUNT.
+    return 1 if caller =~ /^DBIx::Class::/;
+
+    return $_[0]->count;
+}
+
+sub _construct_results {
+  my $self = shift;
+
+  my $rows = $self->next::method(@_);
+
+  if (my $f = $self->_resolved_attrs->{record_filter}) {
+    $_ = $f->($_) for @$rows;
+  }
+
+  return $rows;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/LazyLoading.pm

@@ -0,0 +1,115 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::LazyLoading;
+
+use strict;
+use warnings;
+
+sub resultset_instance {
+  my $self = shift;
+  my $rs = $self->next::method(@_);
+  $rs = $rs->search(undef, { columns => [ $self->columns('Essential') ] });
+  return $rs;
+}
+
+
+# Emulate that CDBI throws out all changed columns and reloads them on
+# request in case the database modifies the new value (say, via a trigger)
+sub update {
+    my $self = shift;
+
+    my @dirty_columns = keys %{$self->{_dirty_columns}};
+
+    my $ret = $self->next::method(@_);
+    $self->_clear_column_data(@dirty_columns);
+
+    return $ret;
+}
+
+
+# And again for create
+sub create {
+    my $class = shift;
+    my($data) = @_;
+
+    my @columns = keys %$data;
+
+    my $obj = $class->next::method(@_);
+    return $obj unless defined $obj;
+
+    my %primary_cols = map { $_ => 1 } $class->primary_columns;
+    my @data_cols = grep !$primary_cols{$_}, @columns;
+    $obj->_clear_column_data(@data_cols);
+
+    return $obj;
+}
+
+
+sub _clear_column_data {
+    my $self = shift;
+
+    delete $self->{_column_data}{$_}     for @_;
+    delete $self->{_inflated_column}{$_} for @_;
+}
+
+
+sub get_column {
+  my ($self, $col) = @_;
+  if ((ref $self) && (!exists $self->{'_column_data'}{$col})
+    && $self->{'_in_storage'}) {
+    $self->_flesh(grep { exists $self->_column_groups->{$_}{$col}
+                           && $_ ne 'All' }
+                   keys %{ $self->_column_groups || {} });
+  }
+  $self->next::method(@_[1..$#_]);
+}
+
+# CDBI does not explicitly declare auto increment columns, so
+# we just clear out our primary columns before copying.
+sub copy {
+  my($self, $changes) = @_;
+
+  for my $col ($self->primary_columns) {
+    $changes->{$col} = undef unless exists $changes->{$col};
+  }
+
+  return $self->next::method($changes);
+}
+
+sub discard_changes {
+  my($self) = shift;
+
+  delete $self->{_column_data}{$_} for $self->is_changed;
+  delete $self->{_dirty_columns};
+  delete $self->{_relationship_data};
+
+  return $self;
+}
+
+sub _ident_cond {
+  my ($class) = @_;
+  return join(" AND ", map { "$_ = ?" } $class->primary_columns);
+}
+
+sub _flesh {
+  my ($self, @groups) = @_;
+  @groups = ('All') unless @groups;
+  my %want;
+  $want{$_} = 1 for map { keys %{$self->_column_groups->{$_}} } @groups;
+  if (my @want = grep { !exists $self->{'_column_data'}{$_} } keys %want) {
+    my $cursor = $self->result_source->storage->select(
+                $self->result_source->name, \@want,
+                \$self->_ident_cond, { bind => [ $self->_ident_values ] });
+    #my $sth = $self->storage->select($self->_table_name, \@want,
+    #                                   $self->ident_condition);
+    # Not sure why the first one works and this doesn't :(
+    my @val = $cursor->next;
+
+    return unless @val; # object must have been deleted from the database
+
+    foreach my $w (@want) {
+      $self->{'_column_data'}{$w} = shift @val;
+    }
+  }
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm

@@ -0,0 +1,92 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::LiveObjectIndex;
+
+use strict;
+use warnings;
+
+use Scalar::Util qw/weaken/;
+
+use base qw/Class::Data::Inheritable/;
+
+__PACKAGE__->mk_classdata('purge_object_index_every' => 1000);
+__PACKAGE__->mk_classdata('live_object_index' => { });
+__PACKAGE__->mk_classdata('live_object_init_count' => { });
+
+# Caching is on by default, but a classic CDBI hack to turn it off is to
+# set this variable false.
+$Class::DBI::Weaken_Is_Available = 1
+    unless defined $Class::DBI::Weaken_Is_Available;
+__PACKAGE__->mk_classdata('__nocache' => 0);
+
+sub nocache {
+    my $class = shift;
+
+    return $class->__nocache(@_) if @_;
+
+    return 1 if $Class::DBI::Weaken_Is_Available == 0;
+    return $class->__nocache;
+}
+
+# Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
+# all blame due to me for whatever bugs I introduced porting it.
+
+sub purge_dead_from_object_index {
+  my $live = shift->live_object_index;
+  delete @$live{ grep !defined $live->{$_}, keys %$live };
+}
+
+sub remove_from_object_index {
+  my $self = shift;
+  delete $self->live_object_index->{$self->ID};
+}
+
+sub clear_object_index {
+  my $live = shift->live_object_index;
+  delete @$live{ keys %$live };
+}
+
+
+# And now the fragments to tie it in to DBIx::Class::Table
+
+sub insert {
+  my ($self, @rest) = @_;
+  $self->next::method(@rest);
+
+  return $self if $self->nocache;
+
+  # Because the insert will die() if it can't insert into the db (or should)
+  # we can be sure the object *was* inserted if we got this far. In which
+  # case, given primary keys are unique and ID only returns a
+  # value if the object has all its primary keys, we can be sure there
+  # isn't a real one in the object index already because such a record
+  # cannot have existed without the insert failing.
+  if (my $key = $self->ID) {
+    my $live = $self->live_object_index;
+    weaken($live->{$key} = $self);
+    $self->purge_dead_from_object_index
+      if ++$self->live_object_init_count->{count}
+              % $self->purge_object_index_every == 0;
+  }
+
+  return $self;
+}
+
+sub inflate_result {
+  my ($class, @rest) = @_;
+  my $new = $class->next::method(@rest);
+
+  return $new if $new->nocache;
+
+  if (my $key = $new->ID) {
+    #warn "Key $key";
+    my $live = $class->live_object_index;
+    return $live->{$key} if $live->{$key};
+    weaken($live->{$key} = $new);
+    $class->purge_dead_from_object_index
+      if ++$class->live_object_init_count->{count}
+              % $class->purge_object_index_every == 0;
+  }
+  return $new;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/NoObjectIndex.pm

@@ -0,0 +1,47 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::NoObjectIndex;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::NoObjectIndex - Defines empty methods for object indexing. They do nothing
+
+=head1 SYNOPSIS
+
+    Part of CDBICompat
+
+=head1 DESCRIPTION
+
+Defines empty methods for object indexing.  They do nothing.
+
+Using NoObjectIndex instead of LiveObjectIndex and nocache(1) is a little
+faster because it removes code from the object insert and retrieve chains.
+
+=cut
+
+sub nocache { return 1 }
+
+sub purge_object_index_every {}
+
+sub purge_dead_from_object_index {}
+
+sub remove_from_object_index {}
+
+sub clear_object_index {}
+
+=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/CDBICompat/Pager.pm

@@ -0,0 +1,23 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Pager;
+
+use strict;
+
+# even though fatalization has been proven over and over to be a universally
+# bad idea, this line has been part of the code from the beginning
+# leaving the compat layer as-is, something may in fact depend on that
+use warnings FATAL => 'all';
+
+*pager = \&page;
+
+sub page {
+  my $class = shift;
+
+  my $rs = $class->search(@_);
+  unless ($rs->{attrs}{page}) {
+    $rs = $rs->page(1);
+  }
+  return ( $rs->pager, $rs );
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/ReadOnly.pm

@@ -0,0 +1,14 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::ReadOnly;
+
+use strict;
+use warnings;
+
+sub make_read_only {
+  my $proto = shift;
+  $proto->add_trigger("before_$_" => sub { shift->throw_exception("$proto is read only") })
+    foreach qw/create delete update/;
+  return $proto;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Relationship.pm

@@ -0,0 +1,49 @@
+package
+    DBIx::Class::CDBICompat::Relationship;
+
+use strict;
+use warnings;
+
+use DBIx::Class::_Util 'quote_sub';
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::Relationship - Emulate the Class::DBI::Relationship object returned from meta_info()
+
+=head1 DESCRIPTION
+
+Emulate the Class::DBI::Relationship object returned from C<meta_info()>.
+
+=cut
+
+my %method2key = (
+    name            => 'type',
+    class           => 'self_class',
+    accessor        => 'accessor',
+    foreign_class   => 'class',
+    args            => 'args',
+);
+
+quote_sub __PACKAGE__ . "::$_" => "\$_[0]->{$method2key{$_}}"
+  for keys %method2key;
+
+sub new {
+    my($class, $args) = @_;
+
+    return bless $args, $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>.
+
+=cut
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Relationships.pm

@@ -0,0 +1,222 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Relationships;
+
+use strict;
+use warnings;
+use base 'Class::Data::Inheritable';
+
+use Clone;
+use DBIx::Class::CDBICompat::Relationship;
+use DBIx::Class::_Util qw(quote_sub perlstring);
+
+__PACKAGE__->mk_classdata('__meta_info' => {});
+
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::Relationships - Emulate has_a(), has_many(), might_have() and meta_info()
+
+=head1 DESCRIPTION
+
+Emulate C<has_a>, C<has_many>, C<might_have> and C<meta_info>.
+
+=cut
+
+sub has_a {
+    my($self, $col, @rest) = @_;
+
+    $self->_declare_has_a($col, @rest);
+    $self->_mk_inflated_column_accessor($col);
+
+    return 1;
+}
+
+
+sub _declare_has_a {
+  my ($self, $col, $f_class, %args) = @_;
+  $self->throw_exception( "No such column ${col}" )
+   unless $self->has_column($col);
+  $self->ensure_class_loaded($f_class);
+
+  my $rel_info;
+
+  # Class::DBI allows Non database has_a with implicit deflate and inflate
+  # Hopefully the following will catch Non-database tables.
+  if( !$f_class->isa('DBIx::Class::Row') and !$f_class->isa('Class::DBI::Row') ) {
+    $args{'inflate'} ||= sub { $f_class->new(shift) }; # implicit inflate by calling new
+    $args{'deflate'} ||= sub { shift() . '' }; # implicit deflate by stringification
+  }
+
+  if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
+    if (!ref $args{'inflate'}) {
+      my $meth = $args{'inflate'};
+      $args{'inflate'} = sub { $f_class->$meth(shift); };
+    }
+    if (!ref $args{'deflate'}) {
+      my $meth = $args{'deflate'};
+      $args{'deflate'} = sub { shift->$meth; };
+    }
+    $self->inflate_column($col, \%args);
+
+    $rel_info = {
+        class => $f_class
+    };
+  }
+  else {
+    $self->belongs_to($col, $f_class);
+    $rel_info = $self->result_source_instance->relationship_info($col);
+  }
+
+  $rel_info->{args} = \%args;
+
+  $self->_extend_meta(
+    has_a => $col,
+    $rel_info
+  );
+
+  return 1;
+}
+
+sub _mk_inflated_column_accessor {
+    my($class, $col) = @_;
+
+    return $class->mk_group_accessors('inflated_column' => $col);
+}
+
+sub has_many {
+  my ($class, $rel, $f_class, $f_key, $args) = @_;
+
+  my @f_method;
+
+  if (ref $f_class eq 'ARRAY') {
+    ($f_class, @f_method) = @$f_class;
+  }
+
+  if (ref $f_key eq 'HASH' && !$args) { $args = $f_key; undef $f_key; };
+
+  $args ||= {};
+  my $cascade = delete $args->{cascade} || '';
+  if (delete $args->{no_cascade_delete} || $cascade eq 'None') {
+    $args->{cascade_delete} = 0;
+  }
+  elsif( $cascade eq 'Delete' ) {
+    $args->{cascade_delete} = 1;
+  }
+  elsif( length $cascade ) {
+    warn "Unemulated cascade option '$cascade' in $class->has_many($rel => $f_class)";
+  }
+
+  if( !$f_key and !@f_method ) {
+      $class->ensure_class_loaded($f_class);
+      my $f_source = $f_class->result_source_instance;
+      ($f_key) = grep { $f_source->relationship_info($_)->{class} eq $class }
+                      $f_source->relationships;
+  }
+
+  $class->next::method($rel, $f_class, $f_key, $args);
+
+  my $rel_info = $class->result_source_instance->relationship_info($rel);
+  $args->{mapping}      = \@f_method;
+  $args->{foreign_key}  = $f_key;
+  $rel_info->{args} = $args;
+
+  $class->_extend_meta(
+    has_many => $rel,
+    $rel_info
+  );
+
+  if (@f_method) {
+    quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel), { '$rf' => \sub { my $o = shift; $o = $o->$_ for @f_method; $o } };
+      my $rs = shift->search_related( %s => @_);
+      $rs->{attrs}{record_filter} = $rf;
+      return (wantarray ? $rs->all : $rs);
+EOC
+
+    return 1;
+  }
+}
+
+
+sub might_have {
+  my ($class, $rel, $f_class, @columns) = @_;
+
+  my $ret;
+  if (ref $columns[0] || !defined $columns[0]) {
+    $ret = $class->next::method($rel, $f_class, @columns);
+  } else {
+    $ret = $class->next::method($rel, $f_class, undef,
+                                { proxy => \@columns });
+  }
+
+  my $rel_info = $class->result_source_instance->relationship_info($rel);
+  $rel_info->{args}{import} = \@columns;
+
+  $class->_extend_meta(
+    might_have => $rel,
+    $rel_info
+  );
+
+  return $ret;
+}
+
+
+sub _extend_meta {
+    my ($class, $type, $rel, $val) = @_;
+    my %hash = %{ Clone::clone($class->__meta_info || {}) };
+
+    $val->{self_class} = $class;
+    $val->{type}       = $type;
+    $val->{accessor}   = $rel;
+
+    $hash{$type}{$rel} = DBIx::Class::CDBICompat::Relationship->new($val);
+    $class->__meta_info(\%hash);
+}
+
+
+sub meta_info {
+    my ($class, $type, $rel) = @_;
+    my $meta = $class->__meta_info;
+    return $meta unless $type;
+
+    my $type_meta = $meta->{$type};
+    return $type_meta unless $rel;
+    return $type_meta->{$rel};
+}
+
+
+sub search {
+  my $self = shift;
+  my $attrs = {};
+  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+    $attrs = { %{ pop(@_) } };
+  }
+  my $where = (@_ ? ((@_ == 1) ? ((ref $_[0] eq "HASH") ? { %{+shift} } : shift)
+                               : {@_})
+                  : undef());
+  if (ref $where eq 'HASH') {
+    foreach my $key (keys %$where) { # has_a deflation hack
+      $where->{$key} = ''.$where->{$key}
+        if eval { $where->{$key}->isa('DBIx::Class') };
+    }
+  }
+  $self->next::method($where, $attrs);
+}
+
+sub new_related {
+  return shift->search_related(shift)->new_result(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/CDBICompat/Retrieve.pm

@@ -0,0 +1,97 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Retrieve;
+
+use strict;
+
+# even though fatalization has been proven over and over to be a universally
+# bad idea, this line has been part of the code from the beginning
+# leaving the compat layer as-is, something may in fact depend on that
+use warnings FATAL => 'all';
+
+sub retrieve {
+  my $self = shift;
+  die "No args to retrieve" unless @_ > 0;
+
+  my @cols = $self->primary_columns;
+
+  my $query;
+  if (ref $_[0] eq 'HASH') {
+    $query = { %{$_[0]} };
+  }
+  elsif (@_ == @cols) {
+    $query = {};
+    @{$query}{@cols} = @_;
+  }
+  else {
+    $query = {@_};
+  }
+
+  $query = $self->_build_query($query);
+  $self->find($query);
+}
+
+sub find_or_create {
+  my $self = shift;
+  my $query = ref $_[0] eq 'HASH' ? shift : {@_};
+
+  $query = $self->_build_query($query);
+  $self->next::method($query);
+}
+
+# _build_query
+#
+# Build a query hash. Defaults to a no-op; ColumnCase overrides.
+
+sub _build_query {
+  my ($self, $query) = @_;
+
+  return $query;
+}
+
+sub retrieve_from_sql {
+  my ($class, $cond, @rest) = @_;
+
+  $cond =~ s/^\s*WHERE//i;
+
+  # Need to parse the SQL clauses after WHERE in reverse
+  # order of appearance.
+
+  my %attrs;
+
+  if( $cond =~ s/\bLIMIT\s+(\d+)\s*$//i ) {
+      $attrs{rows} = $1;
+  }
+
+  if ( $cond =~ s/\bORDER\s+BY\s+(.*)\s*$//i ) {
+      $attrs{order_by} = $1;
+  }
+
+  if( $cond =~ s/\bGROUP\s+BY\s+(.*)\s*$//i ) {
+      $attrs{group_by} = $1;
+  }
+
+  return $class->search_literal($cond, @rest, ( %attrs ? \%attrs : () ) );
+}
+
+sub construct {
+    my $class = shift;
+    my $obj = $class->resultset_instance->new_result(@_);
+    $obj->in_storage(1);
+
+    return $obj;
+}
+
+sub retrieve_all      { shift->search              }
+sub count_all         { shift->count               }
+
+sub maximum_value_of  {
+    my($class, $col) = @_;
+    return $class->resultset_instance->get_column($col)->max;
+}
+
+sub minimum_value_of  {
+    my($class, $col) = @_;
+    return $class->resultset_instance->get_column($col)->min;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/SQLTransformer.pm

@@ -0,0 +1,116 @@
+package DBIx::Class::CDBICompat::SQLTransformer;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::SQLTransformer - Transform SQL
+
+=head1 DESCRIPTION
+
+This is a copy of L<Class::DBI::SQL::Transformer> from Class::DBI 3.0.17.
+It is here so we can be compatible with L<Class::DBI> without having it
+installed.
+
+=cut
+
+sub new {
+    my ($me, $caller, $sql, @args) = @_;
+    bless {
+        _caller      => $caller,
+        _sql         => $sql,
+        _args        => [@args],
+        _transformed => 0,
+    } => $me;
+}
+
+sub sql {
+    my $self = shift;
+    $self->_do_transformation if !$self->{_transformed};
+    return $self->{_transformed_sql};
+}
+
+sub args {
+    my $self = shift;
+    $self->_do_transformation if !$self->{_transformed};
+    return @{ $self->{_transformed_args} };
+}
+
+sub _expand_table {
+    my $self = shift;
+    my ($class, $alias) = split /=/, shift, 2;
+    my $caller = $self->{_caller};
+    my $table = $class ? $class->table : $caller->table;
+    $self->{cmap}{ $alias || $table } = $class || ref $caller || $caller;
+    ($alias ||= "") &&= " $alias";
+    return $table . $alias;
+}
+
+sub _expand_join {
+    my $self  = shift;
+    my $joins = shift;
+    my @table = split /\s+/, $joins;
+
+    my $caller = $self->{_caller};
+    my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1;
+    my @sql;
+    while (my ($t1, $t2) = each %tojoin) {
+        my ($c1, $c2) = map $self->{cmap}{$_}
+            || $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2);
+
+        my $join_col = sub {
+            my ($c1, $c2) = @_;
+            my $meta = $c1->meta_info('has_a');
+            my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta;
+            $col;
+        };
+
+        my $col = $join_col->($c1 => $c2) || do {
+            ($c1, $c2) = ($c2, $c1);
+            ($t1, $t2) = ($t2, $t1);
+            $join_col->($c1 => $c2);
+        };
+
+        $caller->_croak("Don't know how to join $c1 to $c2") unless $col;
+        push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2->primary_column;
+    }
+    return join " AND ", @sql;
+}
+
+sub _do_transformation {
+    my $me     = shift;
+    my $sql    = $me->{_sql};
+    my @args   = @{ $me->{_args} };
+    my $caller = $me->{_caller};
+
+    $sql =~ s/__TABLE\(?(.*?)\)?__/$me->_expand_table($1)/eg;
+    $sql =~ s/__JOIN\((.*?)\)__/$me->_expand_join($1)/eg;
+    $sql =~ s/__ESSENTIAL__/join ", ", $caller->_essential/eg;
+    $sql =~
+        s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller->_essential/eg;
+    if ($sql =~ /__IDENTIFIER__/) {
+        my $key_sql = join " AND ", map "$_=?", $caller->primary_columns;
+        $sql =~ s/__IDENTIFIER__/$key_sql/g;
+    }
+
+    $me->{_transformed_sql}  = $sql;
+    $me->{_transformed_args} = [@args];
+    $me->{_transformed}      = 1;
+    return 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/CDBICompat/Stringify.pm

@@ -0,0 +1,21 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Stringify;
+
+use strict;
+use warnings;
+
+use Scalar::Util;
+
+use overload
+  '""' => sub { return shift->stringify_self; },
+  fallback => 1;
+
+sub stringify_self {
+        my $self = shift;
+        my @cols = $self->columns('Stringify');
+        @cols = $self->primary_column unless @cols;
+        my $ret = join "/", map { $self->get_column($_) || '' } @cols;
+        return $ret || ref $self;
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/TempColumns.pm

@@ -0,0 +1,94 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::TempColumns;
+
+use strict;
+use warnings;
+use base qw/Class::Data::Inheritable/;
+
+use Carp;
+
+__PACKAGE__->mk_classdata('_temp_columns' => { });
+
+sub _add_column_group {
+  my ($class, $group, @cols) = @_;
+
+  return $class->next::method($group, @cols) unless $group eq 'TEMP';
+
+  my %new_cols = map { $_ => 1 } @cols;
+  my %tmp_cols = %{$class->_temp_columns};
+
+  for my $existing_col ( grep $new_cols{$_}, $class->columns ) {
+      # Already been declared TEMP
+      next if $tmp_cols{$existing_col};
+
+      carp "Declaring column $existing_col as TEMP but it already exists";
+  }
+
+  $class->_register_column_group($group => @cols);
+  $class->mk_group_accessors('temp' => @cols);
+
+  $class->_temp_columns({ %tmp_cols, %new_cols });
+}
+
+sub new {
+  my ($class, $attrs, @rest) = @_;
+
+  my $temp = $class->_extract_temp_data($attrs);
+
+  my $new = $class->next::method($attrs, @rest);
+
+  $new->set_temp($_, $temp->{$_}) for keys %$temp;
+
+  return $new;
+}
+
+sub _extract_temp_data {
+  my($self, $data) = @_;
+
+  my %temp;
+  foreach my $key (keys %$data) {
+    $temp{$key} = delete $data->{$key} if $self->_temp_columns->{$key};
+  }
+
+  return \%temp;
+}
+
+sub find_column {
+  my ($class, $col, @rest) = @_;
+  return $col if $class->_temp_columns->{$col};
+  return $class->next::method($col, @rest);
+}
+
+sub set {
+  my($self, %data) = @_;
+
+  my $temp_data = $self->_extract_temp_data(\%data);
+
+  $self->set_temp($_, $temp_data->{$_}) for keys %$temp_data;
+
+  return $self->next::method(%data);
+}
+
+sub get_temp {
+  my ($self, $column) = @_;
+  $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
+  $self->throw_exception( "No such TEMP column '${column}'" ) unless $self->_temp_columns->{$column} ;
+  return $self->{_temp_column_data}{$column}
+    if exists $self->{_temp_column_data}{$column};
+  return undef;
+}
+
+sub set_temp {
+  my ($self, $column, $value) = @_;
+  $self->throw_exception( "No such TEMP column '${column}'" )
+    unless $self->_temp_columns->{$column};
+  $self->throw_exception( "set_temp called for ${column} without value" )
+    if @_ < 3;
+  return $self->{_temp_column_data}{$column} = $value;
+}
+
+sub has_real_column {
+  return 1 if shift->has_column(shift);
+}
+
+1;

database/perl/vendor/lib/DBIx/Class/CDBICompat/Triggers.pm

@@ -0,0 +1,44 @@
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::Triggers;
+
+use strict;
+use warnings;
+use Class::Trigger;
+
+sub insert {
+  my $self = shift;
+
+  return $self->create(@_) unless ref $self;
+
+  $self->call_trigger('before_create');
+  $self->next::method(@_);
+  $self->call_trigger('after_create');
+  return $self;
+}
+
+sub update {
+  my $self = shift;
+  $self->call_trigger('before_update');
+  my @to_update = keys %{$self->{_dirty_columns} || {}};
+  return -1 unless @to_update;
+  $self->next::method(@_);
+  $self->call_trigger('after_update');
+  return $self;
+}
+
+sub delete {
+  my $self = shift;
+  $self->call_trigger('before_delete') if ref $self;
+  $self->next::method(@_);
+  $self->call_trigger('after_delete') if ref $self;
+  return $self;
+}
+
+sub store_column {
+  my ($self, $column, $value, @rest) = @_;
+  my $vals = { $column => $value };
+  $self->call_trigger("before_set_${column}", $value, $vals);
+  return $self->next::method($column, $vals->{$column});
+}
+
+1;