view release on metacpan or  search on metacpan

t/fuguvm/cli.t  view on Meta::CPAN

	1, 'a guest with no disk exits 1');

    # A working disk on a cached base
    my $cache = App::FuguVM::DiskCache->new("$project/cache");
    my $key = $cache->key(
	App::FuguVM::Config->new($project)->load_vm('default'));
    my $source = "$project/source.qcow2";
    system('qemu-img', 'create', '-f', 'qcow2', $source, '16M') == 0
	or skip 'cannot create a test disk image', 14;
    my $base = $cache->store($key, $source, { root_password => 'pw' });
    App::FuguVM::Disk->new($state_dir)->create('default', undef, $base);
    App::FuguVM::State->new($state_dir, 'default')->mark_installed('arm64');

    # A running guest refuses with 5. The test writes its own
    # process ID, so Fugu::Process->is_alive reports a live guest.
    make_path("$state_dir/default");
    open my $pidfh, '>', "$state_dir/default/vm.pid" or die $!;
    print $pidfh "$$\n";
    close $pidfh;
    is(App::FuguVM::CLI->run("--project=$project", '--quiet',
	    'image', 'export', $target),
	5, 'an export of a running guest exits 5');
    unlink "$state_dir/default/vm.pid";

    # The tool creates no directory for the operator
    is(App::FuguVM::CLI->run("--project=$project", '--quiet',
	    'image', 'export', "$project/absent/out.qcow2"),
	1, 'an absent parent directory exits 1');

    # The export writes the base image and reports it
    my ($code, $out) = _run_captured("--project=$project", '--quiet',
	'image', 'export', $target);
    is($code, 0, 'the export succeeds');
    ok(-f $target, 'and the file exists');
    like($out, qr/^bytes: [0-9]+$/m, 'the report holds the byte count');
    like($out, qr/^format: qcow2$/m, 'and the default format');
    like($out, qr/^key: \Q$key\E$/m, 'and the cache key of the source');
    like($out, qr/^path: .*out\.qcow2$/m, 'and the written path');
    like($out, qr/^source: \Q$base\E$/m, 'and the source image');
    like(`qemu-img info "$target"`, qr/file format: qcow2/,
	'the written file is a qcow2');
    unlike(`qemu-img info "$target"`, qr/backing file/,
	'with no backing file');

    # An existing target stays unchanged
    my $before = -s $target;
    is(App::FuguVM::CLI->run("--project=$project", '--quiet',
	    'image', 'export', $target),
	1, 'a second export onto the same path exits 1');
    is(-s $target, $before, 'and the file stays unchanged');

    # The raw form
    ($code) = _run_captured("--project=$project", '--quiet',
	'image', 'export', "$project/out.raw", '--format=raw');
    is($code, 0, 'a raw export succeeds');
    like(`qemu-img info "$project/out.raw"`, qr/file format: raw/,
	'and writes the raw format');
}

# A byte count for a person to read is presentation, so the CLI owns
# it. The cases came with the function from Fugu::Timeout.
subtest '_format_size' => sub {
	my $f = \&App::FuguVM::CLI::_format_size;

	is( $f->(0),       '0B',    'zero' );
	is( $f->(512),     '512B',  'bytes' );
	is( $f->(1023),    '1023B', 'just under 1K' );
	is( $f->(1024),    '1.0K',  'one kilobyte' );
	is( $f->(1536),    '1.5K',  'one and a half' );
	is( $f->(1024**2), '1.0M',  'one megabyte' );
	is( $f->(1024**3), '1.0G',  'one gigabyte' );
	is( $f->(1024**4), '1.0T',  'one terabyte' );
	is( $f->(1024**5), '1024.0T',
		'past the largest unit it keeps counting' );
	is( $f->(undef), '?',
		'a size nobody could measure is not a size of zero' );
};

done_testing();

# A project whose cache_dir points inside the project. Thus the tests
# never touch the developer's real ~/.cache/fuguvm. The optional
# argument appends top-level configuration lines.
sub _cache_project
{
    my ($extra) = @_;
    my $project = tempdir(CLEANUP => 1);
    make_path("$project/.fuguvm/vms", "$project/.fuguvm/state");

    open my $fh, '>', "$project/.fuguvmrc" or die $!;
    print $fh "cache_dir $project/cache\n";
    print $fh "state_dir .fuguvm/state\n";
    print $fh "default_vm default\n";
    print $fh $extra if defined $extra;
    print $fh "vm \"default\" {\n";
    print $fh "\tversion 7.8\n";
    print $fh "\tdisk_size 8G\n";
    print $fh "}\n";
    close $fh;

    return $project;
}

# Run a command with both streams captured, and return the exit
# code, the stdout text and the stderr text. Thus scriptable output
# cannot mix with the TAP stream of this test. The capture goes
# through real files, never through an in-memory scalar: a scalar
# handle has no file descriptor, and the output of a child process
# would then land wherever descriptor 1 points at that moment.
sub _run_captured
{
    my (@args) = @_;
    my $dir = tempdir(CLEANUP => 1);

    open my $saved_out, '>&', \*STDOUT or die $!;
    open STDOUT, '>', "$dir/out" or die $!;
    open my $saved_err, '>&', \*STDERR or die $!;
    open STDERR, '>', "$dir/err" or die $!;

    my $code = App::FuguVM::CLI->run(@args);