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 sub retrieve {
  12   my $self = shift;
  13   die "No args to retrieve" unless @_ > 0;
  14
  15   my @cols = $self->primary_columns;
  16
  17   my $query;
  18   if (ref $_[0] eq 'HASH') {
  19     $query = { %{$_[0]} };
  20   }
  21   elsif (@_ == @cols) {
  22     $query = {};
  23     @{$query}{@cols} = @_;
  24   }
  25   else {
  26     $query = {@_};
  27   }
  28
  29   $query = $self->_build_query($query);
  30   $self->find($query);
  31 }
  32
  33 sub find_or_create {
  34   my $self = shift;
  35   my $query = ref $_[0] eq 'HASH' ? shift : {@_};
  36
  37   $query = $self->_build_query($query);
  38   $self->next::method($query);
  39 }
  40
  41 # _build_query
  42 #
  43 # Build a query hash. Defaults to a no-op; ColumnCase overrides.
  44
  45 sub _build_query {
  46   my ($self, $query) = @_;
  47
  48   return $query;
  49 }
  50
  51 sub retrieve_from_sql {
  52   my ($class, $cond, @rest) = @_;
  53
  54   $cond =~ s/^\s*WHERE//i;
  55
  56   # Need to parse the SQL clauses after WHERE in reverse
  57   # order of appearance.
  58
  59   my %attrs;
  60
  61   if( $cond =~ s/\bLIMIT\s+(\d+)\s*$//i ) {
  62       $attrs{rows} = $1;
  63   }
  64
  65   if ( $cond =~ s/\bORDER\s+BY\s+(.*)\s*$//i ) {
  66       $attrs{order_by} = $1;
  67   }
  68
  69   if( $cond =~ s/\bGROUP\s+BY\s+(.*)\s*$//i ) {
  70       $attrs{group_by} = $1;
  71   }
  72
  73   return $class->search_literal($cond, @rest, ( %attrs ? \%attrs : () ) );
  74 }
  75
  76 sub construct {
  77     my $class = shift;
  78     my $obj = $class->resultset_instance->new_result(@_);
  79     $obj->in_storage(1);
  80
  81     return $obj;
  82 }
  83
  84 sub retrieve_all      { shift->search              }
  85 sub count_all         { shift->count               }
  86
  87 sub maximum_value_of  {
  88     my($class, $col) = @_;
  89     return $class->resultset_instance->get_column($col)->max;
  90 }
  91
  92 sub minimum_value_of  {
  93     my($class, $col) = @_;
  94     return $class->resultset_instance->get_column($col)->min;
  95 }
  96
  97 1;