"\t" . $mm_proto->oneliner( qq(\$ENV{PERLIO}='unix' and system( \$^X, qw( -MExtUtils::Command -e dos2unix -- ), $targets ) ) );
};
- require File::Spec;
# string-eval, not do(), because we need to provide the
# $mm_proto, $reqs and $*_requires lexicals to the included file
# (some includes *do* modify $reqs above)
- for my $inc (sort glob ( File::Spec->catfile('maint', 'Makefile.PL.inc', '*') ) ) {
+ for my $inc (sort glob ( 'maint/Makefile.PL.inc/*' ) ) {
my $src = do { local (@ARGV, $/) = $inc; <> } or die $!;
eval "use warnings; use strict; $src" or die sprintf
"Failed execution of %s: %s\n",
my $schema = $self->schema();
- $schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
+ $schema->create_ddl_dir(
+ $sqlt_type,
+ (defined $schema->schema_version ? $schema->schema_version : ""),
+ $self->sql_dir,
+ $preversion,
+ $sqlt_args,
+ );
}
use strict;
use warnings;
use base 'DBIx::Class';
-use File::Path;
use File::Copy;
use Path::Class;
use DBIx::Class::Carp;
unless $ENV{DBIC_IC_FILE_NOWARN};
-
__PACKAGE__->load_components(qw/InflateColumn/);
sub register_column {
for ( keys %$colinfos ) {
if ( $colinfos->{$_}{is_file_column} ) {
- rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
+ $self->_file_column_file($_)->dir->rmtree;
last; # if we've deleted one, we've deleted them all
}
}
return unless ref $value;
my $fs_file = $self->_file_column_file($column, $value->{filename});
- mkpath [$fs_file->dir];
+ $fs_file->dir->mkpath;
# File::Copy doesn't like Path::Class (or any for that matter) objects,
# thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
sub ddl_filename {
my ($self, $type, $version, $dir, $preversion) = @_;
- require File::Spec;
-
$version = "$preversion-$version" if $preversion;
my $class = blessed($self) || $self;
$class =~ s/::/-/g;
- return File::Spec->catfile($dir, "$class-$version-$type.sql");
+ return "$dir/$class-$version-$type.sql";
}
=head2 thaw
-require File::Spec;
require File::Find;
my $xt_dist_dirs;
);
}, 'xt/dist');
-my @xt_dist_tests = map { File::Spec->catfile($_, '*.t') } sort keys %$xt_dist_dirs;
+my @xt_dist_tests = map { "$_/*.t" } sort keys %$xt_dist_dirs;
# inject an explicit xt test run, mainly to check the contents of
# lib and the generated POD's *before* anything is copied around
unlink 'Makefile';
exit 1;
}
- my $meta = do { local @ARGV = 'META.yml'; local $/; <> };
+ my $meta = do { local (@ARGV, $/) = 'META.yml'; <> };
$meta =~ /^\Qname: DBIx-Class\E$/m or do {
warn "Seemingly malformed META.yml...?\n";
# leftovers in old checkouts
unlink 'lib/DBIx/Class/Optional/Dependencies.pod'
if -f 'lib/DBIx/Class/Optional/Dependencies.pod';
-File::Path::rmtree( File::Glob::bsd_glob('.generated_pod'), { verbose => 0 } )
+File::Path::rmtree([ '.generated_pod' ])
if -d '.generated_pod';
my $pod_dir = 'maint/.Generated_Pod';
# cleanup the generated pod dir (again - kill leftovers from old checkouts)
if (-d $pod_dir) {
- File::Path::rmtree( File::Glob::bsd_glob("$pod_dir/*"), { verbose => 0 } );
+ File::Path::rmtree([ File::Glob::bsd_glob("$pod_dir/*") ]);
}
else {
mkdir $pod_dir or die "Unable to create $pod_dir: $!";
# generate the DBIx/Class.pod only during distdir
{
- my $dist_pod_fn = File::Spec->catfile($pod_dir, qw(lib DBIx Class.pod));
+ my $dist_pod_fn = "$pod_dir/lib/DBIx/Class.pod";
postamble <<"EOP";
dbic_clonedir_copy_generated_pod :
\t\$(RM_F) $pod_dir.packlist
\t@{[
- $mm_proto->oneliner("install([ from_to => {q($pod_dir) => File::Spec->curdir(), write => q($pod_dir.packlist)}, verbose => 0, uninstall_shadows => 0, skip => [] ])", ['-MExtUtils::Install'])
+ $mm_proto->oneliner("install([ from_to => {q($pod_dir) => './', write => q($pod_dir.packlist)}, verbose => 0, uninstall_shadows => 0, skip => [] ])", ['-MExtUtils::Install'])
]}
EOP
# and simply appends them on *LAST*-come *FIRST*-serve basis.
# This allows us to inject extra depenencies for standard EUMM targets
-require File::Spec;
-my $dir = File::Spec->catdir(qw(maint .Generated_Pod));
-my $r_fn = File::Spec->catfile($dir, 'README');
+my $dir = 'maint/.Generated_Pod';
+my $r_fn = "$dir/README";
my $start_file = sub {
my $fn = $mm_proto->quote_literal(shift);
create_distdir : dbic_distdir_regen_license
dbic_distdir_regen_license :
-@{[ $start_file->( File::Spec->catfile( Meta->name . '-' . Meta->version, 'LICENSE') ) ]}
+@{[ $start_file->( Meta->name . '-' . Meta->version . '/LICENSE' ) ]}
\t@{[ $mm_proto->oneliner('cat', ['-MExtUtils::Command']) ]} LICENSE >> \$(DISTVNAME)/LICENSE
EOP
-require File::Spec;
-my $test_ddl_fn = File::Spec->catfile(qw( t lib sqlite.sql ));
+my $test_ddl_fn = 't/lib/sqlite.sql';
my @test_ddl_cmd = qw( -I lib -Mt::lib::ANFANG -- maint/gen_sqlite_schema_files --schema-class DBICTest::Schema );
-my $example_ddl_fn = File::Spec->catfile(qw( examples Schema db example.sql ));
-my $example_db_fn = File::Spec->catfile(qw( examples Schema db example.db ));
+my $example_ddl_fn = 'examples/Schema/db/example.sql';
+my $example_db_fn = 'examples/Schema/db/example.db';
my @example_ddl_cmd = qw( -I lib -I examples/Schema -- maint/gen_sqlite_schema_files --schema-class MyApp::Schema );
my @example_pop_cmd = qw( -I lib -I examples/Schema -- examples/Schema/insertdb.pl );
# if we don't do it some git tools (e.g. gitk) get confused that the
# ddl file is modified, when it clearly isn't
+ require File::Spec;
system('git status --porcelain >' . File::Spec->devnull);
}
local $ENV{DBICTEST_IN_PERSISTENT_ENV} = 1;
+ require File::Spec;
+
$persistence_tests = {
PPerl => {
cmd => [qw/pperl --prefork=1/, __FILE__],
{ # create the schema
# make sure we are clean
-clean_dir($ddl_dir);
+cleanup();
my $admin = DBIx::Class::Admin->new(
{ # upgrade schema
-clean_dir($ddl_dir);
+cleanup();
require DBICVersion_v1;
my $admin = DBIx::Class::Admin->new(
{ # install
-clean_dir($ddl_dir);
+cleanup();
my $admin = DBIx::Class::Admin->new(
schema_class => 'DBICVersion::Schema',
is($admin->schema->get_db_version, "4.0", 'db thinks its version 4.0');
}
-sub clean_dir {
+sub cleanup {
my ($dir) = @_;
- $dir->rmtree if -d $dir;
+ $ddl_dir->rmtree if -d $ddl_dir;
unlink $db_fn;
}
END {
- clean_dir($ddl_dir);
+ cleanup();
}
done_testing;
use strict;
use warnings;
-use FindBin;
use B::Deparse;
-use File::Copy 'move';
use Scalar::Util 'weaken';
use Test::More;
use Test::Exception;
### Now, disconnect the dbh, and move the db file;
# create a new one full of garbage, prevent SQLite from connecting.
$schema->storage->_dbh->disconnect;
-move( $db_orig, $db_tmp )
+rename( $db_orig, $db_tmp )
or die "failed to move $db_orig to $db_tmp: $!";
open my $db_file, '>', $db_orig;
print $db_file 'THIS IS NOT A REAL DATABASE';
### Now, move the db file back to the correct name
unlink($db_orig) or die "could not delete $db_orig: $!";
-move( $db_tmp, $db_orig )
+rename( $db_tmp, $db_orig )
or die "could not move $db_tmp to $db_orig: $!";
### Try the operation again... this time, it should succeed
use Test::Moose;
use Test::Exception;
-use List::Util 'first';
use Scalar::Util 'reftype';
-use File::Spec;
use Moose();
use MooseX::Types();
note "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
-my $var_dir = quotemeta ( File::Spec->catdir(qw/t var/) );
+my $var_dir_re = qr{ t [\/\\] var [\/\\] }x;
## Add a connect_info option to test option merging.
use DBIx::Class::Storage::DBI::Replicated;
$self->master_path( DBICTest->_sqlite_dbfilename );
$self->slave_paths([
- File::Spec->catfile(qw/t var DBIxClass_slave1.db/),
- File::Spec->catfile(qw/t var DBIxClass_slave2.db/),
+ 't/var/DBIxClass_slave1.db',
+ 't/var/DBIxClass_slave2.db',
]);
return $self;
## Silence warning about not supporting the is_replicating method if using the
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
- if first { $_ =~ /$var_dir/ } @replicant_names;
+ if grep { $_ =~ $var_dir_re } @replicant_names;
isa_ok $replicated->schema->storage->balancer->current_replicant
=> 'DBIx::Class::Storage::DBI';
## Silence warning about not supporting the is_replicating method if using the
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
- if first { $_ =~ /$var_dir/ } @replicant_names;
+ if grep { $_ =~ $var_dir_re } @replicant_names;
$replicated->schema->storage->pool->validate_replicants;
## Silence warning about not supporting the is_replicating method if using the
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
- if first { $_ =~ /$var_dir/ } @replicant_names;
+ if grep { $_ =~ $var_dir_re } @replicant_names;
$replicated->schema->storage->pool->validate_replicants;
use Test::More;
use Config;
-use File::Spec;
use DBICTest;
sub test_exec {
my ($perl) = $^X =~ /(.*)/;
- my @args = ($perl, '-MANFANG', File::Spec->catfile(qw(script dbicadmin)), @_);
+ my @args = ($perl, '-MANFANG', 'script/dbicadmin', @_);
if ($^O eq 'MSWin32') {
require Win32::ShellQuote; # included in test optdeps
projects / dbsrgits/DBIx-Class.git / commitdiff