[Dbix-class] Calling SQL Server 2000 stored procedures using Catalyst and DBIx::Class

[Hugh Lampert]

> Hugh Lampert wrote:
> >/ Hello!
> />/ 
> />/ I'm working with  a database that has an extensive stored procedure and
> />/ user defined function API.
> />/ 
> />/ I've looked over the Catalyst model and DBIx::Class documentation, and
> />/ while I've found some references to calling database functions that
> />/ purport to also apply to stored procedures, I don't really see how that
> />/ could be.  Can anyone give me a snippet of sample Catalyst code I can
> />/ use to call a SQL Server 2000 stored procedure that takes a few
> />/ parameters and returns a result set?  I would really appreciate being
> />/ able to keep the ORM and use the supplied stored procedures/UDF's.
> /
> It's been a long time since I did Squeal Swerver in depth; could you give us a 
> sketch of how you'd go about doing it either with just SQL or with plain DBI?
Sure, here's a sample from the utility module I wrote to handle this problem using DBI.
(of course the relevant parts are where the database handles are defined, near the top):

# !C:\perl\bin
#
# LBBWComplianceDBIO.pm - module that handles low level DBIO functions.
#

package LBBWComplianceDBIO;
use strict;

use constant {TRUE => 1, FALSE => 0};

use DBI qw(:sql_types);         # standard module for database access.
$|=1;


BEGIN {
  use Exporter ();
  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

  # set the version for version checking
  $VERSION = 1.00;

  @ISA = qw(Exporter);
  @EXPORT = qw();
} # BEGIN

# file wide variables
our (%dbi);

# local variables 
my ($connect);

# DBI Connection string

$connect = 'dbi:ADO:Provider=SQLOLEDB;Integrated Security=SSPI;'.
  'Persist Security Info=False;Initial Catalog=LBBWCompliance;Data Source=NYSRV2K08';


# connect to database
$dbi{dbh} = DBI->connect($connect)
  || die "Could not connect with connection string '$connect'.\n";
$dbi{dbh}->{ado_commandtimeout} = 600; # turn off timeout

# DBI statement handles
$dbi{sthAddUser} = $dbi{dbh}->prepare(<<'ENDSQL');
   EXEC usp_addUser @employeeID = ?,
                    @password = ?,
                    @roleCode = ?
ENDSQL
$dbi{sthTest} = $dbi{dbh}->prepare(<<'ENDSQL');
   EXEC Test
ENDSQL

# access subroutines/methods
# test - call test procedure
sub test {
  my ($retval);

  # execute the query - die if no results returned.
  die sprintf("test: Could not execute query. Error: '%s'",$dbi{sthTest}->errstr)
    unless $dbi{sthTest}->execute;

  # get the query results
  $retval = $dbi{sthTest}->fetchall_arrayref;

  return $retval;
} # sub test

#-------------------------------------------------------------------------------------------
# addUser - add a new user to the Users table.
# parameters: $employeeID - The employeeID from HR.Usr_Employees
#             $password - The (currently) plain text password.
#             $role - the role of the new user ('admin' or 'user')
#
# returns: a hash reference.  The referenced hash will contain the following
#          elements:
#           + wasSuccessful - If true, indicates the insert was done without error. 
#           + retval - will be undef for this subroutine.
#           + messages - contains any messages
#             
#
sub addUser {
  my $employeeID = $_[0];
  my $password = $_[1];
  my $role = $_[2];

  # local variables
  my %retval = (wasSuccessful => 0, retval => undef,  messages => []); # return value data structure
  my ($status, $message);

  #execute the query and check for errors.
  if ($dbi{sthAddUser}->execute($employeeID, $password, $role)) {
    ($status, $message) = $dbi{sthAddUser}->fetchrow_array;
  } # if ($dbi{sthAddUser}->execute($employeeID, $password))

  # return the DBI error if one occurred
  else {
    push @{$retval{messages}},  sprintf "Error while adding a user: %s", $dbi{sthAddUser}->errstr;
    return \%retval;
  } # else of if ($dbi{sthAddUser}->execute($employeeID, $password))

  # return the procedure status
  $retval{wasSuccessful} = TRUE if $status eq 'S';
  push @{$retval{messages}}, $message;

  return \%retval;
} # sub addUser

# end of module
1;