view release on metacpan or  search on metacpan

t/01_class.t  view on Meta::CPAN

like($@,
    qr/Failed to detect the highest version/,
    'Initialize new object with bad current_version'
);

SKIP: {
  mkdir('bogus-dir', 0000) or die $!;

  if(opendir(my $dir, 'bogus-dir')) {
    closedir $dir;
    chmod(0700, 'bogus-dir');
    rmdir('bogus-dir');

    skip "root can write to everything", 1;
  }

  eval {
      $mh = $mh->new(
          dbh                     =>      $dbh,
          dir                     =>      'bogus-dir',
          schema                  =>      'TestSchema',
          current_version         =>      -1,
      );
  };

  like($@,
      qr/^opendir\("bogus-dir"\) failed:/,
      'Initialize with directory we dont have access to'
  );

  chmod(0700, 'bogus-dir');
  rmdir('bogus-dir');
}

t/10_dir_sql.t  view on Meta::CPAN

    'basic dir_sql'
);

eval { $m->dir_sql('100'); };
like($@, qr/^opendir\(".+?"\) failed:/, 'no such directory');

if(open(my $fh, '>', $tf)) {
    pass('open test file');
    print $fh "test\n";
    close($fh);
    chmod(0000, $tf);

    SKIP: {
      if(open(my $fh2, '<', $tf)) {
        skip 'root has access to everything', 1;
      }

      eval { $m->dir_sql('001'); };
    
      like($@, qr/^open\(".+?"\) failed:/, 'bad file in directory');
    }
    
    chmod(0700, $tf);
    unlink($tf);    
} else {
    fail('open test file');
    fail('bad file in directory');
}

is($m->run_sql(@sql), 1, 'run_sql passes if $dbh->do() passes');
$dbh->bad_rv;
is($m->run_sql(@sql), undef, 'run_sql failes if $dbh->do() fails');
$dbh->good_rv;