DBD-DtfSQLmac

 view release on metacpan or  search on metacpan

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

            18,     undef,  undef,  'precision, scale', 1,  0,  2,  0,  0,  0,  undef,  0,  15, 10 
        ],      
        ] # BINARY (blob) type not supported, SQL_BIT not defined in DBI 1.08
    }

    
        
    # Should return a list of table and view names. Views are not supported by dtF/SQL,
    # so we simply return a list of all user table names.
    
    sub tables   { 
        my $dbh = shift;                        # database handle
        my $htra = $dbh->{'dtf_htra'};          # get transaction handle
        my $hres = 0;                           # result handle
        my $reqClass;                           # request class, should be DTF_RC_RESULT_AVAILABLE, see above 
        my $affectedRecords = 0;                # rowcount  
        my $statement = 'SHOW TABLES';          # sql statement

        my $err;        # error code
        my $errstr;     # error message
        my $errgrp;     # error group
        my $errpos;     # error position within the SQL request
        
        my @tables = (); # list of table names we will return
            
        if ( ($htra != 0) && $dbh->FETCH('Active') ) {
            if ( $err = Mac::DtfSQL::DtfTraExecute($htra , $statement, $reqClass, $affectedRecords, $hres) ) # != 0 means error
            {
                #  Any errors resulted from the SQL request
                #  will be processed here.
                
                if ($hres) { # dispose the result handle
                    DtfResDestroy($hres);
                }

                if ( Mac::DtfSQL::DtfHdlGetError($htra, $err, $errstr, $errgrp, $errpos) ) # != 0 means error
                {
                    $errstr = "ERROR(tables): Can't query the transaction error";
                    return $dbh->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
                } else {
                    return $dbh->DBI::set_err($err, "ERROR(tables): " . $errstr . " (group: " .  $errgrp . ")");
                }#if
            }#if

        } else { # we are not active
            $errstr = "ERROR(tables): The connection seems to be closed";
            return $dbh->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
        
        }#if
        
        #
        # Here we have a valid result handle only if $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE(),  
        # else $hres will be NULL (0). The result table may be empty, though ($affectedRecords == 0).
        # Don't get confused by this.
        #
        
        if ( $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE() ) {      
            # We have a result table, which is a two column table, were a row/record looks like
            # <user-table name, table comment>. We are only interested in the first column.
            
            # We have a sequential cursor (by default) and will use DtfResMoveToFirstRow()  
            # and DtfResMoveToNextRow() for iterating through the result.
            
            Mac::DtfSQL::DtfResMoveToFirstRow($hres);

            for (my $row = 0; $row < $affectedRecords; $row++) {
                
                my $data_item = '';     # field data (init to avoid undef warnings)
                my $isNULL = 0;         # NULL indicator (init to avoid undef warnings)
                my $colIndex = 0;       # first column
                
                # We retrieve the column's data as string (DTF_CT_CSTRING), a type hint (last argument)
                # is not nescessary and will be set to 0
                                        
                if ( ! ( $err = Mac::DtfSQL::DtfResGetField($hres, $colIndex, Mac::DtfSQL::DTF_CT_CSTRING(), $data_item, $isNULL, 0)) ) 
                {
                    if ($isNULL) {
                        push (@tables, undef); # undef means NULL, see DBI spec
                    } else {
                        push (@tables, $data_item);
                    }#if
                } else {
                    $errstr = "ERROR(tables): Can't retrieve column data";
                    #  Do not forget to destroy the result handle.
                    Mac::DtfSQL::DtfResDestroy($hres);
                    
                    return $dbh->DBI::set_err($err, $errstr); 
                }#if

                Mac::DtfSQL::DtfResMoveToNextRow($hres);
            }#for row
            
            #  Do not forget to destroy the result handle
            #  after processing it.
            Mac::DtfSQL::DtfResDestroy($hres);
            
        }#if
        
        return @tables;

    }#tables


    # table_col_info retrieves metadata about a table's columns, i.e. for each column its name, 
    # its type (a DBI SQL type number), its type as string (as declared in CREATE TABLE), its 
    # position (starting with 0), its nullable attribute (0 or 1) and the column's comment are 
    # retrieved.
 
    # The result is returned as a hash, where the key is the column name and the value is a 
    # reference to an array holding the DBI SQL type constant , type as string, position, nullable and  
    # comment information:
 
    # %resulthash = (
    #                columnname_0 => ['DBI_type', 'type as string', 'position', 'nullable', 'comment'],
    #                ..
    #                columnname_n => ['DBI_type', 'type as string', 'position', 'nullable', 'comment'],
    # );
 
    # call it with $dbh->func($tablename, 'table_col_info');
    
    sub table_col_info   { 

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

        my $htra = $dbh->{'dtf_htra'};          # get transaction handle
        my $hres = 0;                           # result handle
        my $reqClass;                           # request class, should be DTF_RC_RESULT_AVAILABLE, see above 
        my $affectedRecords = 0;                # rowcount  
        my $columncount = 0;                    # columncount

        my $err;        # error code
        my $errstr;     # error message
        my $errgrp;     # error group
        my $errpos;     # error position within the SQL request
        
        my %resulthash = ();    # hash we will return (hash of array references)
                
        my $statement = 'SHOW COLUMNS FOR ' . $tablename;       # SQL statement
        
        if ( ($htra != 0) && $dbh->FETCH('Active') ) {
            if ( $err = Mac::DtfSQL::DtfTraExecute($htra , $statement, $reqClass, $affectedRecords, $hres) ) # != 0 means error
            {
                #  Any errors resulted from the SQL request
                #  will be processed here.
                
                if ($hres) { # dispose the result handle
                    DtfResDestroy($hres);
                }

                if ( Mac::DtfSQL::DtfHdlGetError($htra, $err, $errstr, $errgrp, $errpos) ) # != 0 means error
                {
                    $errstr = "ERROR(table_col_info): Can't query the transaction error";
                    return $dbh->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
                } else {
                    return $dbh->DBI::set_err($err, "ERROR(table_col_info): " . $errstr . " (group: " .  $errgrp . ")");
                }#if
            }#if

        } else { # we are not active
            $errstr = "ERROR(table_col_info): The connection seems to be closed";
            return $dbh->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
        
        }#if
        
        #
        # Here we have a valid result handle only if $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE(),  
        # else $hres will be NULL (0). The result table may be empty, though ($affectedRecords == 0).
        # Don't get confused by this.
        #
        
        if ( $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE() ) {      
            
            # We have a result table ...
            
            if ($affectedRecords > 0) { # ... and this table has rows
            
                if ( ( $columncount = Mac::DtfSQL::DtfResColumnCount($hres) ) != 5 ) { # should be 5
                    $errstr = "ERROR(table_col_info): Unexpected result table for $statement";
                    #  Do not forget to destroy the result handle.
                    Mac::DtfSQL::DtfResDestroy($hres);
                
                    return $dbh->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
                }
            
                # We have a sequential cursor (by default) and will use DtfResMoveToFirstRow()  
                # and DtfResMoveToNextRow() for iterating through the result.
            
                Mac::DtfSQL::DtfResMoveToFirstRow($hres);
            
                my $columnname = '';        # columnname
                my $typestring = '';        # columns data type as string
                my $type = 0;               # columns data type as DBI SQL type number
                my $nullable = '';          # nullable attribute 

                for (my $row = 0; $row < $affectedRecords; $row++) {
                
                    my $data_item = 0;      # field data (init to avoid undef warnings)
                    my $isNULL = 0;         # NULL indicator (init to avoid undef warnings)
                
                    my @rowdata = ();       # a single result set's row

                
                    for (my $col = 0; $col < $columncount; $col++) {
      
                        # We retrieve the column's data as string (DTF_CT_CSTRING), a type hint (last argument)
                        # is not nescessary and will be set to 0
                
                        if ( ! ($err = Mac::DtfSQL::DtfResGetField($hres, $col, Mac::DtfSQL::DTF_CT_CSTRING(), $data_item, $isNULL, 0)) ) # != 0 means error
                        {
                            if ($isNULL) {
                                push (@rowdata, undef); # the DBI spec says, NULL fields should be returned as undef
                            } else {
                                push (@rowdata, $data_item);
                            }#if
                        } else {
                            $errstr = "ERROR(table_col_info): Can't retrieve column data";
                            #  Do not forget to destroy the result handle.
                            Mac::DtfSQL::DtfResDestroy($hres);
                    
                            return $dbh->DBI::set_err($err, $errstr); 
                        }#if
                    }#for col
                
                    $columnname = shift @rowdata;               # first element is column name
                    $typestring = $rowdata[0];                  # columns data type as string, e.g. varchar(20)
                    $type = _str2DBItype( $typestring );        # determine DBI SQL type number
                    unshift @rowdata, $type;                    # append to front of array              
                    $nullable = $rowdata[3];                    # nullable attribute ('' or 'NN' - not null)
                    if ( $nullable =~ /NN/ ) {
                        $rowdata[3] = 0; # is not nullable
                    } else {
                        $rowdata[3] = 1; # is nullable
                    }
                    $resulthash{$columnname} = [ @rowdata ];    # add array_ref to hash
                
                    Mac::DtfSQL::DtfResMoveToNextRow($hres);
                
                }#for row
            
            }#if $affectedRecords > 0 
            
            #  Do not forget to destroy the result handle
            #  after processing it.
            Mac::DtfSQL::DtfResDestroy($hres);
        

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

        my $tablename = shift;                  # tablename 
        my $hres = 0;                           # result handle
        my $reqClass;                           # request class, should be DTF_RC_RESULT_AVAILABLE, see above 
        my $affectedRecords = 0;                # rowcount  
        my $columncount = 0;                    # columncount

        my $err;        # error code
        my $errstr;     # error message
        my $errgrp;     # error group
        my $errpos;     # error position within the SQL request
        
        my %resulthash = ();    # hash we will return 
                
        my $statement = 'SHOW COLUMNS FOR ' . $tablename;       # sql statement
        
        if ( $htra != 0 ) {
            if ( $err = Mac::DtfSQL::DtfTraExecute($htra , $statement, $reqClass, $affectedRecords, $hres) ) # != 0 means error
            {
                #  Any errors resulted from the SQL request
                #  will be processed here.
                
                if ($hres) { # dispose the result handle
                    DtfResDestroy($hres);
                }

                if ( Mac::DtfSQL::DtfHdlGetError($htra, $err, $errstr, $errgrp, $errpos) ) # != 0 means error
                {
                    $errstr = "ERROR(_col_nullable): Can't query the transaction error";
                    return ($err, $errstr, 0); 
                } else {
                    return ($err, "ERROR(_col_nullable): " . $errstr . " (group: " .  $errgrp . ")", 0);
                }#if
            }#if

        } else { # transaction handle not valid
            $errstr = "ERROR(_col_nullable): The connection seems to be closed";
            return (64, $errstr, 0); # 64 == Mac::DtfSQL::DTF_ERR_USER()
        
        }#if
        
        #
        # Here we have a valid result handle only if $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE(),  
        # else $hres will be NULL (0). The result table may be empty, though ($affectedRecords == 0).
        # Don't get confused by this.
        #
        
        if ( $reqClass == Mac::DtfSQL::DTF_RC_RESULT_AVAILABLE() ) {      
            
            # We have a result table ...
            
            if ($affectedRecords > 0) { # ... and this table has rows 
            
                if ( ( $columncount = Mac::DtfSQL::DtfResColumnCount($hres) ) != 5 ) { # should be 5
                    $errstr = "ERROR(_col_nullable): Unexpected result table for $statement";
                    #  Do not forget to destroy the result handle.
                    Mac::DtfSQL::DtfResDestroy($hres);
        
                    return (64, $errstr, 0); 
                }
            
                # We have a sequential cursor (by default) and will use DtfResMoveToFirstRow()  
                # and DtfResMoveToNextRow() for iterating through the result.
            
                Mac::DtfSQL::DtfResMoveToFirstRow($hres);
            
                my $columnname = '';        # columnname, column 0
                my $nullable = '';          # nullable attribute , column 3

                for (my $row = 0; $row < $affectedRecords; $row++) {
                
                    my $data_item = 0;      # field data (init to avoid undef warnings)
                    my $isNULL = 0;         # NULL indicator (init to avoid undef warnings)
                
                    my @rowdata = ();       # a single result set's row, filled with (columnname, nullable)

                    foreach my $col (0, 3)  { # col 0 is column name, col 3 is nullable info
      
                        # We retrieve the column's data as string (DTF_CT_CSTRING), a type hint (last argument)
                        # is not nescessary and will be set to 0
                
                        if ( ! ( $err = Mac::DtfSQL::DtfResGetField($hres, $col, Mac::DtfSQL::DTF_CT_CSTRING(), $data_item, $isNULL, 0)) ) # != 0 means error
                        {
                            if ($isNULL) {
                                $errstr = "ERROR(_col_nullable): Unexpected column data NULL ";
                                #  Do not forget to destroy the result handle.
                                Mac::DtfSQL::DtfResDestroy($hres);
                                return (64, $errstr, 0); # field value should not be null
                            } else {
                                push (@rowdata, $data_item);
                            }#if
                        } else {
                            $errstr = "ERROR(_col_nullable): Can't retrieve column data";
                            #  Do not forget to destroy the result handle.
                            Mac::DtfSQL::DtfResDestroy($hres);
                            return ($err, $errstr, 0);
                        }#if
                    }#for col
                
                    # $columnname = $rowdata[0];    # first element is column name
                    # $nullable = $rowdata[1];      # nullable attribute ('' or 'NN' - not null)
                    if ( $rowdata[1] eq 'ERROR' ) {
                        $resulthash{$rowdata[0]} = 2; # unknown
                    } elsif ( $rowdata[1] =~ /NN/ ) {
                        $resulthash{$rowdata[0]} = 0; # is not nullable
                    } else {
                        $resulthash{$rowdata[0]} = 1; # is nullable
                    }
                
                    Mac::DtfSQL::DtfResMoveToNextRow($hres);
                }#for row
            
            }#if $affectedRecords > 0
            
            #  Do not forget to destroy the result handle
            #  after processing it.
            Mac::DtfSQL::DtfResDestroy($hres) if ($hres);
            
        }#if $reqClass
                
        return (0, '', \%resulthash); 

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

                }#if        
            }#if

            # now, begin substitution ...
        
            my @stmt_array = split (/'/, $statement); # all even elements ([0], [2] etc.) are unquoted parts
            my $stmt_elements = @stmt_array;
        
            my ($i, $j) = (0, 0);
        
            for ($i = 1; $i < $stmt_elements; $i += 2) {
                $stmt_array[$i] = "'" . $stmt_array[$i] .  "'"; # (re-) quote the odd array elements
            }
        
            for ($i = 0; $i < $stmt_elements; $i += 2) {
                if ($stmt_array[$i] =~ /\?/) { # substr contains '?' placeholder
                
                    # The split algorithm needs to know, whether the statement substring $stmt_array[$i] ends   
                    # with the placeholder '?'. In this case, there's no string (not even an empty string) for  
                    # the chars "after" the last '?'.               
                    # Example: 
                    # 'WHERE id = ?' will split to one element 'WHERE id = '
                    # Thus we have to replace the placeholder for *all* elements of @qmark_array. If the statement 
                    # substring doesn't end with '?', we have to replace the placeholder for all question mark 
                    # substrings *except the last*. 
                
                    my $sub_last = 1; # replace all substrings except the last
                    if ($stmt_array[$i] =~ /\?$/ ) { # ends with '?'
                        $sub_last = 0; # replace all substrings
                    } 
                
                    @qmark_array = split (/\?/, $stmt_array[$i]); # split statement substr on '?' placeholder
                    $qmark_elements = @qmark_array;             
                
                    for ($j = 0; $j < ($qmark_elements - $sub_last); $j++) { # replace '?' placeholder with actual value
                        my $param_val = shift @params_array; # value
                        if (! defined($param_val) ) { # undef = NULL
                            $qmark_array[$j] = $qmark_array[$j] . 'NULL'; # bind NULL
                        } else {
                            # a $type_hint may not exist, if number of placeholders != number of type hints,
							# in this case, we bind the value as string by default
                            $type_hint = @param_types_ary ? shift @param_types_ary : DBI::SQL_VARCHAR();

							# bind value as string or num according to the type hint by using the quote method
							$qmark_array[$j] = $qmark_array[$j] . $dbh->quote($param_val, $type_hint); 
                        }#if                    
                    }#for
                    # concatenate substrings
                    $stmt_array[$i] = join ('', @qmark_array);
                }#if
            }#for
            # concatenate statement, and that's it
            $statement = join ('', @stmt_array);
            #print "QUERY= $statement\n"; # TEST
        }#if placeholders

        # Now we have a proper SQL string we will send to the database engine using the 
        # function DtfTraExecute() which is typically used for sending SQL requests which 
        # are unknown to the program developer. Note that, other than with DtfTraExecuteQuery(), 
        # the parameter "restype" is missing. Instead, the default result type (DTF_RT_SEQUENTIAL 
        # => sequential cursor), modifiable with DtfHdlSetAttribute(), will be used.
    
        # Description
        # DTF_RT_SEQUENTIAL sequential cursor; restricted to DtfResMoveToFirstRow() and 
        # DtfResMoveToNextRow() for iterating through the result; needs little memory, 
        # independent from the resultÕs size.


        # After the function DtfTraExecute returns, $reqClass will contain the SQL requestÕs 
        # class if the request was executed successfully; $reqClass will be one of the following 
        # values:

        # DTF_RC_ROWS_AFFECTED (= 0)
        #       The statement was of a modifying kind (insert, update, delete statements), and 
        #       affected 0 or more records (check $affectedRecords).
            
        # DTF_RC_RESULT_AVAILABLE (= 1)
        #       The statement was of a querying kind (select, show statements), and returned 0  
        #       or more rows of data ($hres is valid (!= 0), $affectedRecords = row count).

        # DTF_RC_OTHER (= 2)
        #       The statment was of a different kind than the above, for example a create, drop, 
        #       grant, and revoke statement.
 
 
        #  and now execute the statement ...
        my $hres = 0;                               # result handle
        my $reqClass;                               # request class, see above
        my $columncount = 0;                        # columncount :)
        my $affectedRecords = 0;                    # rowcount
        my $htra = $dbh->{'dtf_htra'};              # get transaction handle
        
        my $err;        # error code
        my $errgrp;     # error group
        my $errpos;     # error position within the SQL request
        
        if ( ($htra != 0) && $dbh->FETCH('Active') ) {
            if ( $err = Mac::DtfSQL::DtfTraExecute($htra , $statement, $reqClass, $affectedRecords, $hres) ) # != 0 means error
            {
                #  Any errors resulted from the SQL request
                #  will be processed here.
                
                if ($hres) { # dispose the result handle 
                    DtfResDestroy($hres);
                }

                if ( Mac::DtfSQL::DtfHdlGetError($htra, $err, $errstr, $errgrp, $errpos) ) # != 0 means error
                {
                    $errstr = "ERROR(execute): Can't query the transaction error";
                    return $sth->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
                } else {
                    return $sth->DBI::set_err($err, "ERROR(execute): " . $errstr . " (group: " .  $errgrp . ")");
                }#if
            }#if

        } else { # we are not active
            $errstr = "ERROR(execute): The connection seems to be closed";
            return $sth->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
        
        }#if
                
        # What gets returned from execute?
        # An undef is returned if an error occurs, a successful execute always returns true regardless 
        # of the number of rows affected (even if it's zero, see below). 

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

    
                    
                    # determine type precision, the info stored in the database is a bit buggy in some cases,
                    # thus we will do this by hand
                    if ( ($ctype == 9) || ($ctype == 90) || ($ctype == 16) ) { # a char/string or a decimal
                        $err = Mac::DtfSQL::DtfHdlQueryAttribute($hcol, Mac::DtfSQL::DTF_LAT_PRECISION(), $prec);
                        $prec = (! $err) ? $prec : undef;
                    } else { 
                        if ( ($ctype == 1) || ($ctype == 2) ) { # char or byte
                            $prec = 3; # display width should be 4
                        } elsif ( ($ctype == 3) || ($ctype == 4) ) { # smallint/short or word
                            $prec = 5; # display width should be 6
                        } elsif ( ($ctype == 5) || ($ctype == 6) ) { #
                            $prec = 10; # display width should be 11
                        } elsif ($ctype == 8) { # real, float, double
                            $prec = 15; # display width should be 22
                        } elsif ($ctype == 13) { # date yyyy-mm-dd
                            $prec = 10; # display width should be 10
                        } elsif ($ctype == 14) { # time hh:mm:ss[.fff]
                            $prec = 12; # display width should be 12 (wrong in dtF/SQL)
                        } elsif ($ctype == 15) { # timestamp yyyy-mm-dd hh:mm:ss[.fff]
                            $prec = 23; # display width should be 23 (wrong in dtF/SQL)
                        } else {
                            $prec = undef;
                        }                   
                    }#if
                    push (@precisionArray, $prec);
                    
                    # determine scale                   
                    if ($ctype == 16) { # a decimal
                        $err = Mac::DtfSQL::DtfHdlQueryAttribute($hcol, Mac::DtfSQL::DTF_LAT_SCALE(), $scale); 
                        $scale = (! $err) ? $scale : undef;
                    } else {
                        $scale = undef; # for all other types
                    }#if                    
                    push (@scaleArray, $scale);                 

                    #  Do not forget to destroy the column handle
                    #  after processing it.
                    Mac::DtfSQL::DtfColDestroy($hcol);
                    
                } else { # can't create column handle
                    $errstr = "ERROR(execute): Can't create column handle";
                    return $sth->DBI::set_err(64, $errstr); # Mac::DtfSQL::DTF_ERR_USER()
                }#if
            }#for col
            
            $sth->{'dtf_name'} = \@nameArray;
            $sth->{'dtf_table_i'} = \@tableArray; # driver specific, no DBI standard                                                    
            $sth->{'dtf_type'} = \@dbi_typeArray;
            $sth->{'dtf_precision'} = \@precisionArray;
            $sth->{'dtf_scale'} = \@scaleArray;
            
                    
            #
            #  Step 2: retrieve and store result table
            #
            
            my @resulttable = (); # this is my LoL          
            
            # We have a sequential cursor (by default) and will use DtfResMoveToFirstRow()  
            # and DtfResMoveToNextRow() for iterating through the result.
            
            Mac::DtfSQL::DtfResMoveToFirstRow($hres);

            for (my $row = 0; $row < $affectedRecords; $row++) {
                
                my $data_item = 0;      # field data (init to avoid undef warnings)
                my $isNULL = 0;         # NULL indicator (init to avoid undef warnings)
                
                my @rowdata = ();

                if ($columncount > 0) {
                    for (my $col = 0; $col < $columncount; $col++) {    
                        # we retrieve the data as STRING ( DTF_CT_CSTRING ), a type hint (last argument)
                        # is not nescessary and will be set to 0
                        if ( ! ($err = Mac::DtfSQL::DtfResGetField($hres, $col, Mac::DtfSQL::DTF_CT_CSTRING(), $data_item, 
                                $isNULL, 0)) ) # != 0 means error
                        {
                            if ($isNULL) {
                                push (@rowdata, undef); # the DBI spec says, NULL fields should be returned as undef
                            } else {
                                push (@rowdata, $data_item);
                            }#if
                        } else {
                            $errstr = "ERROR(execute): Can't retrieve column data";
                            return $sth->DBI::set_err($err, $errstr); 
                        }#if
                    }#for col
                }#if

                push (@resulttable, [ @rowdata ]); # push the ref to @rowdata at the end of my LoL @resulttable
                Mac::DtfSQL::DtfResMoveToNextRow($hres);
            }#for row
            
            # now store a reference to the @resulttable as data
            $sth->{'dtf_data'} = \@resulttable;
            
            #  Do not forget to destroy the result handle
            #  after processing it.
            Mac::DtfSQL::DtfResDestroy($hres);
            
            #
            # Step 3: retrieve nullable information
            #
            
            # The following is odd: the nullable metadata can only be retrieved via a "SHOW COLUMNS FOR <table>"
            # statement. This will require a new result handle, and therefore we retrieve this information after
            # the result handle for the actual SQL statement was destroyed.
            
            # @tableArray contains all table names, I need a list (hash) of unique table names
            my $table;      
            my %unique_tableHash = ();
            foreach $table (@tableArray) {
                $unique_tableHash{$table} = 1;
            }
                    
            # \%resulthash = (
            #                columnname_0 => nullable, # 0 -> is not nullable (NOT NULL)
            #                ..
            #                columnname_n => nullable, # 1 -> is nullable

lib/DBD/DtfSQLmac.pm  view on Meta::CPAN

        
            if ($attr eq 'dtf_table') {
                return $sth->{'dtf_table_i'};   # dtf_table_i is used internally, this
                                                # makes dtf_table read-only
            } else {            
                return $sth->{$attr};
            }#if
            
        }#if

        # Note that the DtfSQLmac driver cannot provide valid values for all  
        # of the following attributes until after $sth->execute has been called.


        # NAME (array-ref, read-only):      * valid after execute *
        #       Returns a reference to an array of field names for each column 
        #       example: print "First column name: $sth->{NAME}->[0]\n";
            
        if ($attr eq 'NAME') {
            return $sth->{'dtf_name'};
        }   
        
        
        # TYPE  (array-ref, read-only):     * valid after execute *
        #       Returns a reference to an array of integer values for each column. The 
        #       value indicates the data type of the corresponding column.
        
        if ($attr eq 'TYPE') {
            return $sth->{'dtf_type'};
        }
        
        # PRECISION  (array-ref, read-only):    * valid after execute *
        #       Returns a reference to an array of integer values for each column.  For 
        #       nonnumeric columns the value generally refers to either the maximum length 
        #       or the defined length of the column.  For numeric columns the value refers 
        #       to the maximum number of significant digits used by the data type (without 
        #       considering a sign character or decimal point).
        
        if ($attr eq 'PRECISION') {
            return $sth->{'dtf_precision'};
        }
        
        # SCALE  (array-ref, read-only):        * valid after execute *
        #       Returns a reference to an array of integer values for each column. NULL (undef) 
        #       values indicate columns where scale is not applicable. 

        if ($attr eq 'SCALE') {
            return $sth->{'dtf_scale'};
        }
        
        # NULLABLE  (array-ref, read-only):     * valid after execute *
        #       Returns a reference to an array indicating the possibility of each column 
        #       returning a null: 0 = no, 1 = yes, 2 = unknown.
        #       example: print "First column may return NULL\n" if $sth->{NULLABLE}->[0];

        if ($attr eq 'NULLABLE') {
            return $sth->{'dtf_nullable'};
        }
                
        # CursorName  (string, read-only):      * not supported *   
        #       Returns the name of the cursor associated with the statement handle if available. 
        #       If not available or the database driver does not support the "where current of ..." 
        #       SQL syntax then it returns undef. 

        if ($attr eq 'CursorName') {
            return undef; # Not supported.
        }
        
        # RowsInCache  (integer, read-only):    
        #       If the driver supports a local row cache for select statements then this attribute 
        #       holds the number of un-fetched rows in the cache. If the driver doesn't, then it 
        #       returns undef. Note that some drivers pre-fetch rows on execute, others wait till 
        #       the first fetch.
        
        if ($attr eq 'RowsInCache') {
            return undef; # Not supported.
        }

        $sth->SUPER::FETCH($attr);
    }

    # Destroys the $sth object on garbage collection. 
   
    sub DESTROY {
        return undef;
    }


} # END PACKAGE DBD::DtfSQLmac::st
    

1;


__END__

=head1 NAME

DBD::DtfSQLmac - A DBI driver for the dtF/SQL 2.01 database engine, Macintosh edition

=head1 SYNOPSIS

    use DBI 1.08;
    # or
    use DBI 1.08 qw(:sql_types :utils);


    $dsn = "dbi:DtfSQLmac:HardDisk:path:to:database";
    # or
    $dsn = "dbi:DtfSQLmac:HardDisk:path:to:database;dtf_commit_on_disconnect=1";

    # get a list of all available data sources (databases), the 
    # search will start in the current directory
    @ary = DBI->data_sources('DtfSQLmac');
    
    # specify the commit behavior when diconnecting from a database
    $dbh ->{dtf_commit_on_disconnect} = 1;
    
    # retrieve metadata about a table's columns
    %resulthash = $dbh->func($tablename, 'table_col_info'); 



( run in 2.977 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )