give TestPAUSE a way to "upload files" by a user

rjbs · Apr 18, 2015 · 936ea10 · 936ea10
1 parent 5775103
commit 936ea10
Showing 1 changed file with 18 additions and 1 deletion.
diff --git a/t/lib/PAUSE/TestPAUSE.pm b/t/lib/PAUSE/TestPAUSE.pm
@@ -6,7 +6,7 @@ use autodie;
 
 use DBI;
 use DBIx::RunSQL;
-use File::Copy::Recursive qw(dircopy);
+use File::Copy::Recursive qw(fcopy dircopy);
 use File::Path qw(make_path);
 use File::pushd;
 use File::Temp ();
@@ -74,6 +74,23 @@ sub import_author_root {
   dircopy($author_root, $ml_root);
 }
 
+sub upload_author_file {
+  my ($self, $author, $file) = @_;
+
+  $author = uc $author;
+  my $cpan_root  = File::Spec->catdir($self->tmpdir, 'cpan');
+  my $author_dir = File::Spec->catdir(
+    $cpan_root,
+    qw(authors id),
+    (substr $author, 0, 1),
+    (substr $author, 0, 2),
+    $author,
+  );
+
+  make_path( $author_dir );
+  fcopy($file, $author_dir);
+}
+
 has pause_config_overrides => (
   is  => 'ro',
   isa => 'HashRef',