Untitled

PERL databases to file
$expsel->bind_columns($tabelnaam,$huidige,$id);
while($expsel->fetch()) {

    $tbl        = substr($tabelnaam, 0,4);
    $tblnr      = substr($tabelnaam, 2,2);

    $i = 0;
    $exp_spec = $dbh->prepare("SELECT * FROM tblExportspecificatie WHERE tabelnaam = '".$tbl."' ORDER BY id");
    $exp_spec->execute();
    $exp_spec->bind_columns($id, $tblnaam, $vldnaam, $vldlngte, $ascii, $telveld, $tellen, $keystring);
    while($exp_spec->fetch()){
        if($i == 0){
            @AoA = ([ $tbl, $vldnaam, $vldlngte, $ascii, $telveld, $tellen, $keystring ]);
        }else{
            push @{ $AoA[$i] }, $tbl, $vldnaam, $vldlngte, $ascii, $telveld, $tellen, $keystring;
        }
        $i++;
    }
    $exp_spec->finish();

    # Start regel wegschrijven aan het begin van de nieuwe tabel reeks
    # printf FILE "10".$tblnr.pad2str(252, 1, "").chr(10);

    $tbl_data = $dba->prepare("SELECT * FROM ".$tbl." LIMIT 5");
    $tbl_data->execute();

    $regels = $tbl_data->rows;

    my @array;
    while ( my @arr = $tbl_data->fetchrow_array() ) {
        push @array,@arr;
    }

    for($s = 0; $s < $regels; $s++){
        for($x = 0; $x < $i; $x++){
            if($x == 0){
                if($AoA[0][1] eq "F0101" || $AoA[0][1] eq "F6115"){
                    printf FILE $tblnr.pad2str(4, 0, $gemeentecode).pad2str(8, $AoA[0][3], $array[$s][$x]);
                }else{
                    printf FILE $tblnr.pad2str($AoA[0][2], $AoA[0][3], $array[$s][$x]);
                }
            }else{
                printf FILE pad2str($AoA[$x][2], $AoA[$x][3], $array[$s][$x]);
            }

        }
        printf FILE "--".chr(10);
    }
    printf FILE chr(10);
    print Dumper @AoA;
    print Dumper @array;

    @$AoA = 0;
}

$VAR1 = [
          'st31',
          'F0120',
          '9',
          '0',
          '0',
          '0',
          ''
        ];
$VAR2 = [
          'st31',
          'F1110',
          '24',
          '1',
          '0',
          '0',
          ''
        ];
$VAR3 = [
          'st31',
          'F1120',
          '5',
          '0',
          '0',
          '0',
          ''
        ];
$VAR4 = [
          'st31',
          'F1130',
          '1',
          '1',
          '0',
          '0',
          ''
        ];
$VAR5 = [
          'st31',
          'F1140',
          '4',
          '1',
          '0',
          '0',
          ''
        ];
$VAR6 = [
          'st31',
          'F1150',
          '2',
          '1',
          '0',
          '0',
          ''
        ];
$VAR7 = [
          'st31',
          'F1160',
          '6',
          '1',
          '0',
          '0',
          ''
        ];
$VAR8 = [
          'st31',
          'F1020',
          '40',
          '1',
          '0',
          '0',
          ''
        ];
$VAR9 = [
          'st31',
          'F1310',
          '40',
          '1',
          '0',
          '0',
          ''
        ];
$VAR10 = [
           'st31',
           'F8110',
           '1',
           '1',
           '0',
           '0',
           ''
         ];
$VAR11 = [
           'st31',
           'F8120',
           '8',
           '2',
           '0',
           '0',
           ''
         ];
$VAR12 = [
           'st31',
           'F8130',
           '8',
           '2',
           '0',
           '0',
           ''
         ];
$VAR13 = [
           'st31',
           'F1170',
           '40',
           '1',
           '0',
           '0',
           ''
         ];
$VAR14 = [
           'st31',
           'F0121',
           '10',
           '0',
           '0',
           '0',
           ''
         ];
$VAR15 = [
           'st31',
           'F0130',
           '8',
           '0',
           '0',
           '0',
           ''
         ];
$VAR16 = [
           'st31',
           'FILLER',
           '4',
           '1',
           '0',
           '0',
           ''
         ];
$VAR17 = [
           'st31',
           'F0140',
           '10',
           '0',
           '0',
           '0',
           ''
         ];
$VAR18 = [
           'st31',
           'F0220',
           '2',
           '1',
           '0',
           '0',
           ''
         ];
$VAR19 = [
           'st31',
           'FILLER',
           '1',
           '1',
           '0',
           '0',
           ''
         ];
$VAR20 = [
           'st31',
           'F0410',
           '1',
           '1',
           '0',
           '0',
           ''
         ];
$VAR21 = [
           'st31',
           'F0310',
           '8',
           '2',
           '0',
           '0',
           ''
         ];
$VAR22 = [
           'st31',
           'F0810',
           '8',
           '2',
           '0',
           '0',
           ''
         ];
$VAR23 = [
           'st31',
           'F0811',
           '1',
           '1',
           '0',
           '0',
           ''
         ];
$VAR24 = [
           'st31',
           'FILLER',
           '5',
           '1',
           '0',
           '0',
           ''
         ];
$VAR25 = [
           'st31',
           'F1010',
           '1',
           '1',
           '0',
           '0',
           ''
         ];
$VAR26 = [
           'st31',
           'FILLER',
           '7',
           '1',
           '0',
           '0',
           ''
         ];
$VAR1 = [
          '170805955',
          'Waterlelie              ',
          '16',
          undef,
          undef,
          undef,
          '3434VK',
          'Nieuwegein                              ',
          undef,
          'I',
          '2010-01-01',
          '2011-01-01',
          undef,
          '356000000',
          '0',
          '2147483647',
          undef,
          'V',
          '1946-10-24',
          '0000-00-00',
          'A',
          'W'
        ];

<<DEBUG>> L-> 9 AS-> 0, DATA-> 170805955
<<DEBUG>> L-> 24 AS-> 1, DATA-> Waterlelie
<<DEBUG>> L-> 5 AS-> 0, DATA-> 16
<<DEBUG>> L-> 1 AS-> 1, DATA->
<<DEBUG>> L-> 4 AS-> 1, DATA->
<<DEBUG>> L-> 2 AS-> 1, DATA->
<<DEBUG>> L-> 6 AS-> 1, DATA-> 3434VK
<<DEBUG>> L-> 40 AS-> 1, DATA-> Nieuwegein
<<DEBUG>> L-> 40 AS-> 1, DATA->
<<DEBUG>> L-> 1 AS-> 1, DATA-> I
<<DEBUG>> L-> 8 AS-> 2, DATA-> 2010-01-01
<<DEBUG>> L-> 8 AS-> 2, DATA-> 2011-01-01
<<DEBUG>> L-> 40 AS-> 1, DATA->
<<DEBUG>> L-> 10 AS-> 0, DATA-> 356000000
<<DEBUG>> L-> 8 AS-> 0, DATA-> 0
<FILLER> <-- things are getting messy!
<<DEBUG>> L-> 4 AS-> 1, DATA-> 2147483647
<<DEBUG>> L-> 10 AS-> 0, DATA->
<<DEBUG>> L-> 2 AS-> 1, DATA-> V
<<DEBUG>> L-> 1 AS-> 1, DATA-> 1946-10-24
<<DEBUG>> L-> 1 AS-> 1, DATA-> 0000-00-00
<<DEBUG>> L-> 8 AS-> 2, DATA-> A
<<DEBUG>> L-> 8 AS-> 2, DATA-> W
<<DEBUG>> L-> 1 AS-> 1, DATA->
<<DEBUG>> L-> 5 AS-> 1, DATA->
<<DEBUG>> L-> 1 AS-> 1, DATA->
<<DEBUG>> L-> 7 AS-> 1, DATA->

use List::MoreUtils qw<pairwise>;

# push behavior into statement handles...
{   package DBI::st;
    sub get_rows {
        my $sth = shift;
        my @results;
        $sth->execute( @_ );
        while ( my @row = $sth->fetchrow_array ) {
            push @results, @row;
        }
        $sth->close;
        return @results;
    }
}

my %needs_adjustment = qw<F0101 1 F6115 1>;
$expsel->bind_columns( $tabelnaam, $huidige, $id);
while( $expsel->fetch()) {

    $tbl   = substr( $tabelnaam, 0, 4 );
    $tblnr = substr( $tabelnaam, 2, 2 );

    my ( $first_col )
        = @AoA
        = $dbh->prepare( qq/
          SELECT *
            FROM tblExportspecificatie
           WHERE tabelnaam = '$tbl'
          ORDER BY id
        / )->get_rows
        ;

    my $adjust_first = $needs_adjustment{ $first_col->[1] };
    $first_col->[2]  = 8 if $adjust_first;
    ( $sth = $dba->prepare("SELECT * FROM $tbl LIMIT 5"))->execute;

    while ( my $row = $sth->fetchrow_arrayref ) {
        print $fh
              $tblnr
            , ( $adjust_first ? pad2str( 4, 0, $gemeentecode ) : '' )
            , ( pairwise { pad2str( @$a[2,3], $b ) } @AoA, @$row )
            , chr(10)
            ;
    }
    print $fh chr(10);
}