view release on metacpan or  search on metacpan

lib/Mail/Decency/Helper/Database/DBD.pm  view on Meta::CPAN

        }
        elsif ( $name eq '-unique' ) {
            my $idx = join( "_", @{ $columns_ref->{ -unique } } );
            push @uniques, [
                "${schema}_${table}_${idx} ON ${schema}_${table}",
                $columns_ref->{ -unique }
            ];
        }
        else {
            my $type = ref( $ref ) eq 'ARRAY'
                ? ( $#$ref == 0
                    ? $ref->[0]
                    : "$ref->[0]($ref->[1])"
                )
                : $ref
            ;
            push @columns, "$name $type";
        }
    }
    push @columns, "id INTEGER PRIMARY KEY";
    
    my @stm;
    
    push @stm, scalar $self->sql->generate(
        'create table', "${schema}_${table}" => \@columns );
    
    push @stm, scalar $self->sql->generate(
        'create index', $_->[0] => $_->[1] )
        for @indices;
    
    push @stm, scalar $self->sql->generate(
        'create unique index', $_->[0] => $_->[1] )
        for @uniques;
    
    unless ( $execute ) {
        print join( "\n",
            "-- TABLE: ${schema}_${table} (SQLITE):",
            join( ";\n", @stm ),
        ). ";\n";
        return 0;
    }
    else {
        foreach my $stm( @stm ) {
            $self->db->dbh->do( $stm );
        }
        return 1;
    }
}




=head2 update_data

Update input data for write 

Transforms any complex "data" key into YAML

=cut

sub update_data {
    my ( $self, $data_ref ) = @_;
    $data_ref = $self->next::method( $data_ref );
    if ( defined $data_ref->{ data } && ref( $data_ref->{ data } ) ) {
        $data_ref->{ data } = YAML::Dump( $data_ref->{ data } );
    }
    return wantarray ? ( $data_ref->{ data } ) : $data_ref;
}

=head2 parse_data

Parse data after read. Parses any YAML data in "data" key into perl object

=cut

sub parse_data {
    my ( $self, $data_ref ) = @_;
    $data_ref = $self->next::method( $data_ref );
    if ( $data_ref && ref( $data_ref ) && defined $data_ref->{ data } ) {
        eval {
            $data_ref->{ data } = YAML::Load( $data_ref->{ data } );
        };
    }
    return $data_ref;
}



=head1 AUTHOR

Ulrich Kautz <uk@fortrabbit.de>

=head1 COPYRIGHT

Copyright (c) 2010 the L</AUTHOR> as listed above

=head1 LICENCSE

This library is free software and may be distributed under the same terms as perl itself.

=cut



1;