view release on metacpan or  search on metacpan

t/Catmandu-BagIt.t  view on Meta::CPAN

    ok $bagit->add_file("poem.txt",$fh) , 'add_file(IO::File)';

    ok $bagit->add_file("results.txt", sub {
        my $io = shift;
        for (0..9) {
            $io->print($_);
        }
    });

    ok $bagit->write($bag_dir, overwrite => 1) , 'write bag overwrite';

    ok -f "$bag_dir/data/test.txt" , "got a $bag_dir/data/test.txt";
    ok -f "$bag_dir/data/poem.txt" , "got a $bag_dir/data/poem.txt";
    ok -f "$bag_dir/data/results.txt" , "got a $bag_dir/data/results.txt";

    like path("$bag_dir/data/test.txt")->slurp_utf8 , qr/test789/, 'file content is correct';
    like path("$bag_dir/data/poem.txt")->slurp_utf8 , qr/Violets are blue/ , 'file content is correct';
    like path("$bag_dir/data/results.txt")->slurp_utf8 , qr/0123456789/ , 'file content is correct';

    ok $bagit->add_file("poem.txt",IO::File->new("t/poem2.txt"), overwrite => 1) , 'setting new file content';

    ok $bagit->write($bag_dir, overwrite => 1) , 'write bag overwrite';

    like path("$bag_dir/data/poem.txt")->slurp_utf8 , qr/The rose is red, the violet's blue/ , 'file content is correct';

    my $payload_oxum = $bagit->payload_oxum;

    is $payload_oxum , '218.3' , 'payload oxum';

    ok $bagit->add_fetch("http://www.gutenberg.org/cache/epub/1980/pg1980.txt","290000","shortstories.txt") , 'adding payload';

    $payload_oxum = $bagit->payload_oxum;

    is $payload_oxum , '290218.4' , 'new payload oxum reflects the fetch file';

    remove_path($bag_dir);
}

note("mirror fetch");
{
    my $bagit = Catmandu::BagIt->new(user_agent => user_agent() );

    $bagit->add_fetch("http://demo.org/","65","poem.txt");

    dies_ok { $bagit->get_fetch() } 'get_fetch without parameters dies';

    ok ! $bagit->get_fetch("poem123.txt") , 'get_fetch() on non-existing';

    my $fetch = $bagit->get_fetch("poem.txt");

    ok $fetch , 'get_fetch()';

    ok $bagit->write($bag_dir, overwrite => 1) , 'write bag overwrite';

    ok $bagit->mirror_fetch($fetch) , 'mirror_fetch';

    ok $bagit->write($bag_dir, overwrite => 1) , 'write bag overwrite';

    ok -r "$bag_dir/data/poem.txt";

    my $size = [stat("$bag_dir/data/poem.txt")]->[7];

    is $size , 65 , 'got the correct size';

    remove_path($bag_dir);
}

note("lock");
{
    my $bagit = Catmandu::BagIt->read("bags/demo03");

    ok ! $bagit->locked , '!locked';

    $bagit = Catmandu::BagIt->new;

    ok $bagit->write($bag_dir);

    $bagit->touch("$bag_dir/.lock");

    ok $bagit->locked , 'locked';

    remove_path($bag_dir);
}

note("pipe");
{
  SKIP: {
      skip "ENV{PIPETEST} not set", 4 unless $ENV{PIPETEST};

      my $pipe = new IO::Pipe;

      if(my $pid = fork()) { # Parent
          $pipe->reader();

          my $bagit = Catmandu::BagIt->new;

          ok $bagit->add_file("test.txt",$pipe) , 'add_file() pipe';

          ok $bagit->write($bag_dir) , 'write()';

          my $file = $bagit->get_file("test.txt");

          ok $file;

          is path($file->path)->slurp_utf8 , "Hello, parent!\n" , 'file->data';

          remove_path($bag_dir);
      }
      elsif(defined $pid) { # Child
          $pipe->writer();

          print $pipe "Hello, parent!\n";

          exit(0);
      }
  }
}

note("supply md5");
{