Vyššie na [Platon] / web-apps / call-centre-system / modules

Added DBI module into the list of used modules

#
# modules/dbh_query.pm
#
# Developed by Ondrej Jombik <nepto@platon.sk>
# Copyright (c) 2004 Platon SDG, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 17/01/2004 - created
#

# $Platon: web-apps/call-centre-system/modules/dbh_query.pm,v 1.1 2004/03/10 11:34:53 nepto Exp $

package dbh_query;

use strict;
use DBI;
use Carp;
use vars qw(
  $VERSION @ISA @EXPORT $AUTOLOAD
  $dbh $db_source $db_name $db_host $db_user $db_pass
);

@ISA    = qw(Exporter);
@EXPORT = qw(dbh_quote dbh_query);

$VERSION = '0.1';

$db_source = 'mysql';
$db_host   = 'localhost';
$db_name   = 'cc_system';
$db_user   = 'cc_system';
$db_pass   = 'kofola';

#
# dbh_connect()
#
sub dbh_connect    # {{{
{
    $dbh = DBI->connect( "dbi:$db_source:database=$db_name;host=$db_host", $db_user, $db_pass )
      or die "Can't connect to $db_source: $DBI::errstr";
}                  # }}}

#
# dbh_disconnect()
#
sub dbh_disconnect    # {{{
{
    $dbh->disconnect();
    undef $dbh;
}                     # }}}

#
# dbh_quote()
#
sub dbh_quote         # {{{
{
    dbh_connect() if ( !defined $dbh );
    return $dbh->quote(@_);
}                     # }}}

#
# dbh_query()
#
# do the query and get result if needed
#
sub dbh_query         # {{{
{
    my ( $sql, $ret, $sql_debug ) = @_;

    die "2nd argument have to be one of (SCALAR|HASH|HASHARRAYREF|HASHREF|ARRAYREF|ARRAY|1ARRAY|UNDEF)"
      if ( defined $ret && $ret !~ /^(SCALAR|HASH|HASHARRAYREF|HASHREF|ARRAYREF|ARRAY|1ARRAY|UNDEF)$/ );
    $ret = $ret || 'UNDEF';

    $sql_debug = 0 if ( !defined $sql_debug );

    dbh_connect() if ( !defined $dbh );

    my ( $sth, $rv, @rv, $row, @row );

    $sql =~ s/\n\t+/ /go;
    print STDERR "dbh_query($sql,$ret,$sql_debug)[" if $sql_debug;

    if ( !( $sth = $dbh->prepare($sql) ) ) {
        print STDERR " ", $dbh->errstr, "\n";
        return undef
    }
    if ( !$sth->execute ) {
        print STDERR " ", $dbh->errstr, "\n";
        return undef
    }
    print STDERR $sth->rows, "]\n" if $sql_debug;

    #
    # Guess what?
    #
    if ( $ret eq 'SCALAR' ) {
        $rv = ( $sth->fetchrow_array )[0];

        #
        # Hash by 1st column
        #
    } elsif ( $ret eq 'HASH' ) {
        my (%rv) = ();
        while ( @row = $sth->fetchrow_array ) {
            $rv{ $row[0] } = $row[1];
        }
        return wantarray ? %rv : \%rv;

        #
        # Hash of arrayref
        #
    } elsif ( $ret eq 'HASHARRAYREF' ) {
        my (%rv) = ();
        my $key;
        while ( @row = $sth->fetchrow_array ) {

            #print STDERR $row[0].':'.$row[1].':'.$row[2]."\n";
            $key = shift @row;

            # TODO!!! Array copying needed here
            #$rv{ $key } = \@row; # does not work!
            $rv{$key} = [ $row[0], $row[1] ];
        }
        return wantarray ? %rv : \%rv;

        #
        # Array of hashrefs
        #
    } elsif ( $ret eq 'HASHREF' ) {
        return $sth->fetchrow_hashref if ( $sql =~ /\s+LIMIT (\d+,)?1$/ );
        push @rv, $row while ( $row = $sth->fetchrow_hashref );
        return wantarray ? @rv : \@rv;

        #
        # Array of arrayrefs
        #
    } elsif ( $ret eq 'ARRAYREF' ) {
        $rv = $sth->fetchall_arrayref;
        return wantarray ? @$rv : $rv;

        #
        # Array of arrays
        #
    } elsif ( $ret eq 'ARRAY' ) {
        while ( @row = $sth->fetchrow_array ) {
            push @rv, @row;
        }
        return wantarray ? @rv : \@rv;

        #
        # Array of arrays
        #
    } elsif ( $ret eq '1ARRAY' ) {
        while ( @row = $sth->fetchrow_array ) {
            push @rv, $row[0];
        }
        return wantarray ? @rv : \@rv;

        #
        # Undefined
        #
    } elsif ( $ret eq 'UNDEF' ) {
        return undef;
    }
}    # }}}

1;

__END__

=head1 NAME

dbh_query - do the query and get result if needed

=head1 SYNOPSIS

use dbh_query;

my $ret = dbh_query($query, $type);

=head1 DESCRIPTION

The dbh_query module allows you to perform queries on $dbh database handle.

=head2 EXPORT

dbh_query

=head1 SEE ALSO

=head1 AUTHORS

Ondrej Jombik, <nepto@platon.sk>

=cut


# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3