lib/DBIx/Class/CDBICompat/Retrieve.pm

   1 package # hide from PAUSE
   2     DBIx::Class::CDBICompat::Retrieve;
   3
   4 use strict;
   5
   6 # even though fatalization has been proven over and over to be a universally
   7 # bad idea, this line has been part of the code from the beginning
   8 # leaving the compat layer as-is, something may in fact depend on that
   9 use warnings FATAL => 'all';
  10
  11 use base 'DBIx::Class';
  12
  13 sub retrieve {
  14   my $self = shift;
  15   die "No args to retrieve" unless @_ > 0;
  16
  17   my @cols = $self->primary_columns;
  18
  19   my $query;
  20   if (ref $_[0] eq 'HASH') {
  21     $query = { %{$_[0]} };
  22   }
  23   elsif (@_ == @cols) {
  24     $query = {};
  25     @{$query}{@cols} = @_;
  26   }
  27   else {
  28     $query = {@_};
  29   }
  30
  31   $query = $self->_build_query($query);
  32   $self->find($query);
  33 }
  34
  35 sub find_or_create {
  36   my $self = shift;
  37   my $query = ref $_[0] eq 'HASH' ? shift : {@_};
  38
  39   $query = $self->_build_query($query);
  40   $self->next::method($query);
  41 }
  42
  43 # _build_query
  44 #
  45 # Build a query hash. Defaults to a no-op; ColumnCase overrides.
  46
  47 sub _build_query {
  48   my ($self, $query) = @_;
  49
  50   return $query;
  51 }
  52
  53 sub retrieve_from_sql {
  54   my ($class, $cond, @rest) = @_;
  55
  56   $cond =~ s/^\s*WHERE//i;
  57
  58   # Need to parse the SQL clauses after WHERE in reverse
  59   # order of appearance.
  60
  61   my %attrs;
  62
  63   if( $cond =~ s/\bLIMIT\s+(\d+)\s*$//i ) {
  64       $attrs{rows} = $1;
  65   }
  66
  67   if ( $cond =~ s/\bORDER\s+BY\s+(.*)\s*$//i ) {
  68       $attrs{order_by} = $1;
  69   }
  70
  71   if( $cond =~ s/\bGROUP\s+BY\s+(.*)\s*$//i ) {
  72       $attrs{group_by} = $1;
  73   }
  74
  75   return $class->search_literal($cond, @rest, ( %attrs ? \%attrs : () ) );
  76 }
  77
  78 sub construct {
  79     my $class = shift;
  80     my $obj = $class->resultset_instance->new_result(@_);
  81     $obj->in_storage(1);
  82
  83     return $obj;
  84 }
  85
  86 sub retrieve_all      { shift->search              }
  87 sub count_all         { shift->count               }
  88
  89 sub maximum_value_of  {
  90     my($class, $col) = @_;
  91     return $class->resultset_instance->get_column($col)->max;
  92 }
  93
  94 sub minimum_value_of  {
  95     my($class, $col) = @_;
  96     return $class->resultset_instance->get_column($col)->min;
  97 }
  98
  99 1;