Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #! /usr/bin/env perl
- use strict;
- use warnings;
- sub vbox_list {
- my %vms;
- my ($running) = @_;
- my $what = $running ? 'runningvms' : 'vms';
- local $ENV{LC_ALL} = 'C';
- open VBOX, "VBoxManage list -l $what |" or die 'VBoxManage: $!';
- local $/ = "nnn";
- while (my $section = <VBOX>) {
- my %vm = ();
- $section =~ s/nn.*//s; # strip shared folders, etc.
- foreach my $line (split /n/, $section) {
- $line =~ s/A([^:]+):s+// or next;
- $vm{$1} = $line;
- }
- $vms{$vm{UUID}} = {%vm};
- }
- close VBOX;
- return %vms;
- }
- sub vbox_list_cables {
- my ($vms) = @_;
- my @cables;
- foreach my $vm (values %$vms) {
- my %vm = %$vm;
- foreach my $key (keys %vm) {
- next unless $key =~ /ANIC *([0-9]+)z/;
- my $num = $1;
- if ($vm{$key} =~ /(^|, )Cable connected: on($|, )/) {
- push @cables, [$vm{UUID}, $vm{Name}, $num];
- }
- }
- }
- return @cables;
- }
- sub vbox_iterate_cableconnected {
- my ($cables, $onoff) = @_;
- foreach my $cable (@$cables) {
- my ($uuid, $name, $num) = @$cable;
- system 'VBoxManage', 'controlvm', $uuid, "setlinkstate$num", $onoff;
- # TODO: report errors
- }
- }
- my %vms = vbox_list(1);
- my @cables = vbox_list_cables(%vms);
- vbox_iterate_cableconnected(@cables, 'off');
- sleep(1);
- vbox_iterate_cableconnected(@cables, 'on');
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement