view release on metacpan or  search on metacpan

lib/DBIx/Mint/Table.pm  view on Meta::CPAN

           @objects = @_;
        }
        elsif (ref $_[0]) {
            # Case 2
            $mint = DBIx::Mint->instance('_DEFAULT');
            @objects = @_;
        }
        else {
            # Case 3
            $mint = DBIx::Mint->instance('_DEFAULT');
            my %data = @_;
            @objects = (\%data);
        }
     }
     else {
         $class = ref $proto;
         @objects = ($proto);
         if ($_[0] && ref $_[0] eq 'DBIx::Mint') {
             # Case 4
             $mint = shift;
         }
         else {
             # Case 5
             $mint = DBIx::Mint->instance('_DEFAULT');
         }
     }

    my $schema = $mint->schema->for_class( $class )
        || croak "A schema definition for class $class is needed to use DBIx::Mint::Table";

    # Fields that do not go into the database
    my %to_be_removed;
    @to_be_removed{ @{ $schema->fields_not_in_db } } = (1) x @{ $schema->fields_not_in_db };

    my @fields = grep {!exists $to_be_removed{$_}} keys %{ $objects[0] };
    my @quoted = map { $mint->dbh->quote_identifier( $_ ) } @fields;

    my $sql = sprintf 'INSERT INTO %s (%s) VALUES (%s)',
        $schema->table, join(', ', @quoted), join(', ', ('?') x @fields);

    my $sub = sub {
        my $sth = $_->prepare($sql);
        my @ids;
        foreach my $obj (@objects) {
            # Obtain values from the object
            my @values = @$obj{ @fields };
            $sth->execute(@values);
            if ($schema->auto_pk) {
                my $id = $_->last_insert_id(undef, undef, $schema->table, undef);
                $obj->{ $schema->pk->[0] } = $id;
            }
            push @ids, [ @$obj{ @{ $schema->pk } } ]; 
        }
        return @ids
    };
    my @ids = $mint->connector->run( fixup => $sub );
    return wantarray ? @ids : $ids[0][0];
}


sub update {
    # Input:
    # Case 1) a class name, a Mint object, two hash refs 
    # Case 2) a class name, two hash refs
    # Case 3) a blessed object

    my $proto = shift;
    my $class;
    my $mint;
    my $set;
    my $where;
    my $schema;
    if (!ref $proto) {
        $class = $proto;
        if (@_ == 3) {
            # Case 1
            ($mint, $set, $where) = @_;
            croak "DBIx::Mint::Table update: Expected the first argument to be a DBIx::Mint object "
                . "(since the three-args version was used)"
                unless ref $mint eq 'DBIx::Mint';
        }
        else {
            # Case 2
            ($set, $where) = @_;
            $mint = DBIx::Mint->instance('_DEFAULT');
        }
        $schema = $mint->schema->for_class($class)    
            || croak "A schema definition for class $class is needed to use DBIx::Mint::Table";

        croak "DBIx::Mint::Table update: called with incorrect arguments"
            unless ref $set && ref $where;
    }
    else {
        # Case 3: Updating a blessed object
        $class = ref $proto;
        my %copy = %$proto;
        $set     = \%copy;

        $mint    = DBIx::Mint->instance( $proto->_name );        
        $schema = $mint->schema->for_class($class)    
            || croak "A schema definition for class $class is needed to use DBIx::Mint::Table";

        my @pk     = @{ $schema->pk };
        my %where  = map { $_ => $proto->$_ } @pk;
        $where  = \%where;

        delete $set->{$_} foreach @{ $schema->fields_not_in_db }, @pk;
    }
    
    # Build the SQL
    my  ($sql, @bind) = $mint->abstract->update($schema->table, $set, $where);
    
    # Execute the SQL
    return $mint->connector->run( fixup => sub { $_->do($sql, undef, @bind) } );
}

sub delete {
    # Input:
    # Case 1) a class name, a Mint object, a data hash ref
    # Case 2) a class name, a data hash ref
    # Case 3) a class name, a list of scalars (primary key values)