DB-Handy

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    attribute.
  - t/1019_types.t: new, 37 assertions covering the INT range check,
    the values that stay accepted, DATE validity including the leap
    year rules, NULL handling, the same checks on UPDATE, and byte
    transparency of the .dat file.
  - t/1018_hardening.t: new, 33 assertions covering the second-round
    fixes: comment stripping and literal protection, index integrity
    across INSERT/UPDATE/DELETE/vacuum, the new statement attributes,
    placeholder handling, the documented fetchall_arrayref slice
    behaviour, and I/O failure reporting on the write paths.  The
    last group is skipped when chmod does not stop the test process
    from writing (running as root, or a file system without it).
  - t/1017_regression.t: new, 29 assertions covering each of the eight
    fixes above.  Its plan count is derived from the list of test
    closures rather than hard-coded, and the runner turns a die inside
    a closure into a single "not ok" so that one crashing case does not
    truncate the report.

  Code:
  - lib/DB/Handy.pm: _load_schema() builds the schema as a hash
    reference from the start instead of taking \%sch of a named hash.

pmake.bat  view on Meta::CPAN

        $tardir =~ s#^lib-##;
        rmtree($tardir, 0, 0);

        if ($^O =~ /(?:solaris|linux)/i) {
            for my $file (@file) {
                if (-e $file) {
                    mkpath(dirname("$tardir/$file"), 0, 0777);
                    print STDERR "copy $file $tardir/$file\n";
                    copy($file, "$tardir/$file");
                    if ($file =~ m/ (?: Build\.PL | Makefile\.PL ) \z/oxmsi) {
                        chmod(0644, "$tardir/$file");
                    }
                    elsif ($file =~ m/\. (?: pl | bat | exe | com ) \z/oxmsi) {
                        chmod(0755, "$tardir/$file");
                    }
                    elsif ($file =~ m{^bin/}oxmsi) {
                        chmod(0755, "$tardir/$file");
                    }
                    else {
                        chmod(0644, "$tardir/$file");
                    }
                }
            }
            system(qq{tar -cvf $tardir.tar $tardir});
            system(qq{gzip -f $tardir.tar});
        }
        else {

#-----------------------------------------------------------------------------
# https://metacpan.org/search?q=Archive%3A%3ATar%3A%3AConstant

pmake.bat  view on Meta::CPAN

            print FH_TARBAT ":endofperl\n";
            close FH_TARBAT;
        }

        # make ptar
        else {
            open(FH_TARBAT, '>ptar') || die "Can't open file: ptar\n";
            print FH_TARBAT '#!', &which($^X), "\n";
            print FH_TARBAT $ptar;
            close FH_TARBAT;
            chmod 0755, 'ptar';
        }
    }

    # unzip and untar *.tar.gz
    elsif ($target =~ /^xzvf$/) {
        for my $gzfile (grep m/\.tar\.gz$/xmsi, @ARGV) {

            if ($^O =~ /(?:solaris|linux)/i) {
                system(qq{gzip -cd $gzfile | tar -xvf -});
            }

pmake.bat  view on Meta::CPAN

            print FH_WGETBAT ":endofperl\n";
            close FH_WGETBAT;
        }

        # make pwget
        else {
            open(FH_WGETBAT, '>pwget') || die "Can't open file: pwget\n";
            print FH_WGETBAT '#!', &which($^X), "\n";
            print FH_WGETBAT $pwget;
            close FH_WGETBAT;
            chmod 0755, 'pwget';
        }
    }
    # pmake selfcheck [--check1] [--check2]
    elsif ($target eq 'selfcheck') {
        my $do_check1 = 0;
        my $do_check2 = 0;
        for my $arg (@ARGV) {
            $do_check1 = 1 if $arg eq '--check1';
            $do_check2 = 1 if $arg eq '--check2';
        }

t/1018_hardening.t  view on Meta::CPAN

File::Path::rmtree($BASE) if -d $BASE;

# Remove the scratch directory however the script leaves: a normal exit,
# a die in mid-file, or an interrupt.  Without this an aborted run left a
# stale tree behind in the system temp directory.
END { File::Path::rmtree($BASE) if defined($BASE) && -d $BASE }

my $dbh = DB::Handy->connect($BASE, 'hard')
    or die "connect failed: $DB::Handy::errstr\n";

# Does chmod actually stop this process from writing?  It does not when the
# test runs as root, and it behaves differently across file systems, so H6
# probes first and skips rather than reporting a spurious failure.
my $CHMOD_BITES = 0;
{
    my $probe = File::Spec->catfile($BASE, 'probe.tmp');
    local *PFH;
    if (open(PFH, "> $probe")) {
        print PFH "x";
        close PFH;
        chmod 0444, $probe;
        if (open(PFH, "+< $probe")) { close PFH }
        else                        { $CHMOD_BITES = 1 }
        chmod 0644, $probe;
        unlink $probe;
    }
}

# H6 works on its own table; create it up front so the last H6 assertion
# holds whether or not the chmod-based cases run.
$dbh->do('CREATE TABLE ro (id INT)');
$dbh->do('INSERT INTO ro (id) VALUES (1)');

# Flatten selectall_arrayref output into a comparable string.
sub flat {
    my($r) = @_;
    return 'undef' unless defined $r;
    return join('|', map { join(',', map { defined($_) ? $_ : 'NULL' } @$_) } @$r);
}

t/1018_hardening.t  view on Meta::CPAN

        is(join(',', sort keys %{$all->[0]}), 'Id,Nm',
           'H5 - a hash slice still returns hash-refs');
    },

    # -------------------------------------------------------------------
    # H6 -- write paths report I/O failure
    # -------------------------------------------------------------------
    sub {
        unless ($CHMOD_BITES) {
            skip('H6 - INSERT reports a read-only data file',
                 'chmod does not stop this process from writing');
            return;
        }
        my $dat = File::Spec->catfile($BASE, 'hard', 'ro.dat');
        chmod 0444, $dat;
        my $rc = $dbh->do('INSERT INTO ro (id) VALUES (2)');
        chmod 0644, $dat;
        ok(!defined $rc, 'H6 - INSERT reports a read-only data file');
    },
    sub {
        unless ($CHMOD_BITES) {
            skip('H6 - the error message names the failure',
                 'chmod does not stop this process from writing');
            return;
        }
        my $dat = File::Spec->catfile($BASE, 'hard', 'ro.dat');
        chmod 0444, $dat;
        $dbh->do('INSERT INTO ro (id) VALUES (3)');
        my $msg = $dbh->errstr;
        chmod 0644, $dat;
        ok(((defined($msg) && ($msg =~ /dat|record/i))) ? 1 : 0,
           'H6 - the error message names the failure');
    },
    sub {
        # After the file is writable again the table must still work.
        my $rc = $dbh->do('INSERT INTO ro (id) VALUES (4)');
        is($rc, 1, 'H6 - the table is usable once the file is writable again');
    },
);