view release on metacpan or  search on metacpan

PApp/DataRef.pm  view on Meta::CPAN

sub STORE {
   my $self = shift; my ($field, %args) = ref $_[0] ? @{+shift} : shift;
   my @value = ref $args{store} ? $args{store}->($self, shift) : shift;
   return unless @value;

   Convert::Scalar::utf8_upgrade $value[0] if $self->{utf8} && (!ref $self->{utf8} || $self->{utf8}{$field});

   if ($self->{delay}) {
      $self->{_store}{$field} = \($self->{_cache}{$field} = $value[0]);
   } else {
      $self->{_cache}{$field} = $value[0] if $self->{cache};

      $self->_sequence unless defined $self->{id};
      sql_exec $self->dbh,
               "update $self->{table} set $field = ? where $self->{key_expr}",
               $value[0], @{$self->{id}};
      $sql_exec > 0
         or sql_exec $self->dbh,
            "insert into $self->{table} (" .
               (join ",", $field, @{$self->{key}}) .
            ") values (" .
               (join ",", ("?") x (1 + @{$self->{key}})) .
            ")",
            $value[0],
            @{$self->{id}};
   }
}

# we do not officially support iterators yet, but define them so we can display this object
sub FIRSTKEY {
   my $self = shift;
   keys %{$self->{_cache}};
   each %{$self->{_cache}};
}

sub NEXTKEY {
   my $self = shift;
   each %{$self->{_cache}};
}

sub EXISTS {
   my $self = shift;
   my $field = shift;
   exists $self->{_cache}{$field} or do {
      # do it the slow way. not sure wether the limit 0 is portable or not
      my $st = sql_exec $self->{database}->dbh,
                        "select * from $self->{table} limit 0";
      my %f; @f{@{$st->{NAME_lc}}} = ();
      $st->finish;
      exists $f{lc $field};
   };
}

=item @key = $hd->id

Returns the key value(s) for the selected row, creating it if necessary.

=cut

sub id($) {
   my $self = shift;
   $self->_sequence;
   wantarray ? @{$self->{id}} : $self->{id}[0];
}

=item $hd->flush

Flush all pending store operations. See HOW FLUSHES ARE IMPLEMENTED below
to see how, well, flushes are implemented on the SQL-level.

=cut

sub flush {
   my $self = shift;

   my $store = delete $self->{_store};

   if (%$store) {
      my $dbh = $self->dbh;

      my $insrep = sub {
         sql_exec $dbh,
               "$_[0] into $self->{table} (" .
                  (join ",", @{$self->{key}}, keys %$store) .
               ") values (" .
                  (join ",", ("?") x (@{$self->{key}} + keys %$store)) .
               ")",
               @{$self->{id}},
               (map $$_, values %$store);
      };

      my $update = sub {
         sql_exec $dbh,
                  "update $self->{table} set" .
                     (join ",", map " $_ = ?", keys %$store) .
                  " where $self->{key_expr}",
                  (map $$_, values %$store), @{$self->{id}};
      };

      $self->_sequence unless $self->{id};

      if (0 && $self->{preload} && !ref $self->{preload}
          && $dbh->{Driver}{Name} eq "mysql"
        ) {
         # disabled because $store doesn't contain all values, and _cache might contain
         # the id field twice. reenable when id is a normal member of _cache
         $insrep->("replace");
         delete $self->{preload}; # preload also acts as a "we know all columns" flag
      } else {
         &$update;
         $sql_exec > 0 or eval { local $SIG{__DIE__}; $insrep->("insert") };
         $sql_exec > 0 or &$update;
      }
   }
}

=item $hd->dirty

Return true when there are store operations that are delayed. Call
C<flush> to execute these.