RTFM
rtfm / Perl/ DBI/ syb-proc.pl
.etla.org
use strict;

use DBI;

sub syb_proc_call ($\%@);

use constant DSN => 'dbi:Sybase:database=foo';
use constant USR => 'sa';
use constant PWD => ''; # no, these are not my system details :)

MAIN:
{
    my %pval;

    my $dbh = DBI->connect( DSN, USR, PWD )
      || die( "connect(): [$DBI::errstr]" );

    # not sure about sybase proc call syntax: It's been a while.
    my $sth = $dbh->prepare( "exec procname ?, ?" )
      || die( "prepare(): ",$dbh->errstr() );

    my $val = syb_proc_call( $sth, %pval, "abc", "def" );

    # %pval now contains the parameter return values.
}

sub syb_proc_call ($\%@)
{
    my $sth      = shift(@_); # DBI::st statement handle
    my $rval     = shift(@_);
    my $continue = 1;
    my $status   = '';

    # This will bind all parameters as varchar by default.
    # Sybase can be picky about this, so you might want to
    # use $sth->bind_param(NUM, VAL, TYPE) explicitly on each
    # parameter in turn, then call this function with just 1 arg
    # ( the $sth ).
    $sth->execute(@_);

    while( $continue )
    {
	my $rtype = $sth->{syb_result_type};

	if( $rtype == DBD::Sybase::CS_PARAM_RESULT() )
	{
	    my @label = @{ $sth->{NAME} };
	    my $value;

	    while( $value = $sth->fetchrow_arrayref() )
	    {
		for (my $n = 0; $n <= $#label; $n++)
		{
		    $rval->{ $label[$n] } = $value->[$n];
		}
	    }
	}
	elsif( $rtype == DBD::Sybase::CS_STATUS_RESULT() )
	{
	    # we really only ever expect 1 row with a single value,
	    # but you never know, something weird could happen:
	    my $stat;

	    while( $stat = $sth->fetchrow_arrayref() )
	    {
		$status .= join( ',', @{ $stat } );
	    }
	}
	else
	{
	    # Throw these way, we're not interested: you may wish to
	    # throw a fatal error instead of calling undef(), since
	    # CS_PARAM_RESULT and CS_STATUS_RESULT are the only valid
	    # magic values for procedure calls:
	    while( $sth->fetchrow_arrayref() ) { undef() }
	}

	$continue = $sth->{syb_more_results};
    }

    return $status;
}



Valid HTML 4.01! Valid CSS! Any Browser Debian Pepperfish