view release on metacpan or  search on metacpan

lib/Games/Axmud/Obj/WMCtrl.pm  view on Meta::CPAN

#
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser Public License for more details.
#
# You should have received a copy of the GNU Lesser Public License along with this program. If not,
# see <http://www.gnu.org/licenses/>.
#
#
# Games::Axmud::Obj::WMCtrl, a modification of X11::WMCtrl (v0.03) by Gavin Brown
#
# Packaged along with Axmud, renamed and reduced to alleviate various problems
# List of changes (besides cosmetic ones):
#   - Added 'use warnings' as the lack of it causes Kwalitee errors
#   - Commented out $VERSION as it causes Kwalitee errors
#   - Removed POD stuff
#   - Modified ->new so it returns 'undef', rather than doing a Perl die(), if wmctrl is not
#       available on the user's system
#   - Modified ->get_windows which (rarely) creates a 'PERL WARNING: Use of uninitialized value
#       $data in split' error
#   - Commented out the close() function, which Axmud doesn't need anyway, and which sometimes
#       produces an unexplained Perl error

package Games::Axmud::Obj::WMCtrl;

use vars qw($VERSION);
use strict;
use warnings;

#our $VERSION = '0.03';

#sub new {
#   my $self = {};
#   $self->{package} = shift;
#   bless($self, $self->{package});
#   chomp($self->{wmctrl} = `which wmctrl 2> /dev/null`);
#   die("can't find the wmctrl program") if (! -x $self->{wmctrl});
#   return $self;
#}
sub new {
    my $self = {};
    $self->{package} = shift;
    bless($self, $self->{package});
    chomp($self->{wmctrl} = `which wmctrl 2> /dev/null`);
    if (! -x $self->{wmctrl}) {
        return undef;
    } else {
        return $self;
    }
}

sub get_window_manager {
    my $self = shift;
    my $data = $self->wmctrl('-m');
    my $wm = {};
    foreach my $line (split(/\n/, $data)) {
        my ($name, $value) = split(/:/, $line, 2);
        $value =~ s/^\s+//g;
        $value =~ s/\s+$//g;
        $value = ($value =~ 'OFF' ? undef : 1);
        $name = ($name =~ /showing the desktop/i ? 'show_desktop' : $name);
        $wm->{lc($name)} = $value;
    }
    return $wm;
}

#sub get_windows {
#   my $self = shift;
#   my $data = $self->wmctrl('-l');
#   my @windows;
#   foreach my $line (split(/\n/, $data)) {
#       my ($id, $strand) = split(/ +/, $line, 2);
#       my ($workspace, $host, $title);
#       if ($strand =~ /^-1/) {
#           $strand =~ s/^-1//;
#           $workspace = -1;
#           ($host, $title) = split(/ /, $strand, 2);
#       } else {
#           ($workspace, $host, $title) = split(/ /, $strand, 3);
#       }
#       push(@windows, {
#           id      => $id,
#           workspace   => $workspace,
#           host        => $host,
#           title       => $title,
#       });
#   }
#   return @windows;
#}
sub get_windows {
    my $self = shift;
    my $data = $self->wmctrl('-l');
    my @windows;
    if (defined $data) {
        foreach my $line (split(/\n/, $data)) {
            my ($id, $strand) = split(/ +/, $line, 2);
            my ($workspace, $host, $title);
            if ($strand =~ /^-1/) {
                $strand =~ s/^-1//;
                $workspace = -1;
                ($host, $title) = split(/ /, $strand, 2);
            } else {
                ($workspace, $host, $title) = split(/ /, $strand, 3);
            }
            push(@windows, {
                id      => $id,
                workspace   => $workspace,
                host        => $host,
                title       => $title,
            });
        }
    }
    return @windows;
}

sub get_workspaces {
    my $self = shift;
    my $data = $self->wmctrl('-d');
    my $workspaces = {};
    foreach my $line (split(/\n/, $data)) {
        my ($workspace, $strand) = split(/ /, $line, 2);