DBD::WMI - interface to the Windows WMI

DBD-WMI documentation Contained in the DBD-WMI distribution.

Index

Code Index:

NAME

Top

DBD::WMI - interface to the Windows WMI

ABSTRACT

Top

This module allows you to issue WQL queries through the DBI.

SYNOPSIS

Top

  use DBI;
  my $dbh = DBI->connect('dbi:WMI:');

  my $sth = $dbh->prepare(<<WQL);
    SELECT * FROM Win32_Process
  WQL

  $sth->execute();
  while (my @row = $sth->fetchrow) {
    my $proc = $row->[0];
    print join "\t", $proc->{Caption}, $proc->{ExecutablePath} || "<system>";
    # $proc->Terminate();
    print "\n";
  }

The WMI allows you to query various tables ("namespaces"), like the filesystem, currently active processes and events:

     SELECT * FROM Win32_Process

The driver/WMI implements two kinds of queries, finite queries like the query above and potentially infinite queries for events as they occur in the system:

     SELECT * FROM __instanceoperationevent
     WITHIN 1
     WHERE TargetInstance ISA 'Win32_DiskDrive'

This query returns one row (via ->fetchrow_arrayref() ) whenever a disk drive gets added to or removed from the system (think of an USB stick).

There is currently no support for selecting specific columns instead of *. Support for selecting columns that then get returned as plain Perl scalars is planned.

DBD::WMI::db::parse_columns STATEMENT

This routine parses out the requested columns from the WQL statement and returns an array reference with the names of the columns.

Currently, this only works for SELECT statements. All other statements get an implicit column of *, meaning that the Win32::OLE objects will be returned.

HANDLING OF QUERY COLUMNS

Top

The WMI and WQL return full objects instead of single columns. The specification of columns is merely a hint to the object what properties to preload. The DBD interface deviates from that approach in that it returns objects for queries of the form SELECT * and the values of the object properties when columns are specified. These columns are then case sensitive.

FUN QUERIES

Top

List all printers

  SELECT * FROM Win32_Printer

List all print jobs on a printer

  SELECT * FROM Win32_PrintJob
    WHERE DriverName = 'HP Deskjet 6122'

Return a new row whenever a new print job is started

  SELECT * FROM __InstanceCreationEvent
    WITHIN 10
    WHERE
      TargetInstance ISA 'Win32_PrintJob'

Finding the default printer

  SELECT * FROM Win32_Printer
    WHERE Default = TRUE

Setting the default printer (untested, WinXP, Win2003)

  use DBI;
  my $dbh = DBI->connect('dbi:WMI:');
  my $sth = $dbh->prepare(<<WQL);
      SELECT * FROM Win32_Printer
  WQL

  $sth->execute;
  while (my @row = $sth->fetchrow) {
      # We get Win32::OLE objects back:
      my $printer = $row[0];
      printf "Making %s the default printer\n", $printer->{Name};
      $printer->SetDefaultPrinter;
  };

Find all network adapters with IP enabled

  SELECT * from Win32_NetworkAdapterConfiguration
    WHERE IPEnabled = True

Find files in a directory

  ASSOCIATORS OF {Win32_Directory.Name='C:\WINNT'}
    WHERE ResultClass = CIM_DataFile

Find printers on a remote machine

  use DBI;
  my $machine = 'dawn';
  my $dbh = DBI->connect('dbi:WMI:'.$machine);
  my $sth = $dbh->prepare(<<WQL);
      SELECT * FROM Win32_Printer
  WQL

  $sth->execute;
  while (my @row = $sth->fetchrow) {
      my $printer = $row[0];
      printf "Making %s the default printer on %s\n", $printer->{Name}, $machine;
      $printer->SetDefaultPrinter;
  };

Get method names of objects

  use Win32::OLE qw(in);
  ...

  SELECT * FROM Win32_Process

  $sth->execute;

  while (my @row = $sth->fetchrow) {
      for my $method (in $row[0]->Methods_) {
          print "Can call $method() on the object\n"
      };
  };

TODO

Top

* Implement placeholders and proper interpolation of values
* Need to implement DSN parameters for remote computers, credentials

SEE ALSO

Top

WMI is Microsofts implementation of the WBEM standard (http://www.dmtf.org/standards/wbem/) except that it uses DCOM and not CIM-XML as the transport medium.

The MS WMI main page at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wmi_start_page.asp

The WQL documentation at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wql_sql_for_wmi.asp

The "Hey Scripting Guy" column at http://www.microsoft.com/technet/scriptcenter/resources/qanda/default.mspx

Wikipedia on WMI at http://en.wikipedia.org/wiki/Windows_Management_Instrumentation

List of available Win32 WMI classes at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_classes.asp

DBD-WMI documentation Contained in the DBD-WMI distribution. 
package DBD::WMI;
use strict;
use base 'DBD::File';
use DBI;

use vars qw($ATTRIBUTION $VERSION);

$ATTRIBUTION = 'DBD::WMI by Max Maischein <dbd-wmi@corion.net>';
$VERSION = '0.06';


# Investigate System.Management.MethodData to get at the methods and properties

my $drh;
sub driver {
    return $drh if $drh;

    my ($package,$attr) = @_;

    $package .= "::dr";
    $drh = DBI::_new_drh( $package, {
            Attribution => $ATTRIBUTION,
            Version     => $VERSION,
            Name        => 'WMI',
        },
    );

    $drh
};

package DBD::WMI::dr;
use strict;
use Win32::WQL;

use vars qw($imp_data_size);

$imp_data_size = 0;

sub connect {
    my ($drh, $dr_dsn, $user, $auth, $attr) = @_;

    $dr_dsn ||= ".";
    $dr_dsn =~ /^([^;]*)/i
        or die "Invalid DSN '$dr_dsn'";
    my $machine = $1 || ".";

    my $wmi = Win32::WQL->new(
        machine => $machine
    );

    my ($outer, $dbh) = DBI::_new_dbh(
        $drh,
        { Name => $dr_dsn },
    );
    $dbh->{wmi_wmi} = $wmi;

    #$dbh->STORE('Active',1);
    $outer
}

sub data_sources {
    my ($drh) = @_;

    my $wmi = Win32::WQL->new();
    my $sth = $wmi->prepare(<<WQL);
        SELECT * FROM meta_class
WQL

    my $sources = $sth->execute();
    my @res;
    while (my $ev = $sources->fetchrow()) {
        push @res, $ev->Path_->Class
    };
    @res
}

package DBD::WMI::db;
use strict;

use vars qw($imp_data_size);
$imp_data_size = 0;

sub prepare {
    my ($dbh, $statement, @attribs) = @_;

    my $own_sth = $dbh->{wmi_wmi}->prepare($statement);
    my ($outer, $sth) = DBI::_new_sth($dbh,
        { Statement => $statement,
          wmi_sth => $own_sth,
          wmi_params => [],
        },
    );

    my $columns = __PACKAGE__->parse_columns($statement);
    $sth->STORE('wmi_return_columns', $columns);

    $sth->STORE('NUM_OF_PARAMS', ($statement =~ tr/?//));

    return $outer;
}


sub parse_columns {
    my ($dbh, $statement) = @_;
    my @columns;
    if ($statement =~ /^\s*SELECT \s*(.*?)\s+FROM\b/mi) {
        @columns = map { s/^\s*//; s/\s*$//; $_ } split /,/, $1; # verrry simplicistic parsing
    } else {
        @columns = ('*');
    };
    
    \@columns
};

sub STORE
{
  my ($dbh, $attr, $val) = @_;
  if ($attr eq 'AutoCommit') {
      # AutoCommit is currently the only standard attribute we have
      # to consider.
      if (!$val) { die "Can't disable AutoCommit"; }
      return 1;
  }
  if ($attr =~ m/^wmi_/) {
      # Handle only our private attributes here
      # Note that we could trigger arbitrary actions.
      # Ideally we should warn about unknown attributes.
      $dbh->{$attr} = $val; # Yes, we are allowed to do this,
      return 1;             # but only for our private attributes
  }
  # Else pass up to DBI to handle for us
  $dbh->SUPER::STORE($attr, $val);
}

sub FETCH
{
  my ($dbh, $attr) = @_;
  if ($attr eq 'AutoCommit') { return 1; }
  if ($attr =~ m/^wmi_/) {
      # Handle only our private attributes here
      # Note that we could trigger arbitrary actions.
      return $dbh->{$attr}; # Yes, we are allowed to do this,
                            # but only for our private attributes
  }
  # Else pass up to DBI to handle
  $dbh->SUPER::FETCH($attr);
}

package DBD::WMI::st;
use strict;
use Carp qw(croak);

use vars qw($imp_data_size);

$imp_data_size = 0;

sub execute {
    my $sth = shift;

    # Recycle if we're still active
    $sth->finish if $sth->FETCH('Active');

    my $params = (@_) ?
        \@_ : $sth->{wmi_params};
    my $numParam = $sth->FETCH('NUM_OF_PARAMS');
    return $sth->set_err(1, "Wrong number of parameters")
        if @$params != $numParam;
    if ($numParam > 0) {
        return $sth->set_err(1, "DBD::WMI doesn't support parameters yet")
            if @$params > 0;
    };
    #my $statement = $sth->{'Statement'};
    #for (my $i = 0;  $i < $numParam;  $i++) {
    #    $statement =~ s/?/$params->[$i]/; # doesn't deal with quoting etc!
    #
    #};

    my $iter = $sth->{wmi_sth}->execute(@$params);

    #$sth->STORE('Active',1);

    $sth->{'wmi_data'} = $iter;
    $sth->{'wmi_rows'} = 1; # we don't know/can't know
    $sth->STORE('NUM_OF_FIELDS', scalar @{$sth->FETCH('wmi_return_columns')});# $numFields;
    $sth->{'wmi_rows'} || '0E0';
}

sub fetchrow_arrayref
{
    my ($sth) = @_;
    my $data = $sth->{wmi_data};
    my @row = $data->fetchrow();

    if (! @row) {
        $sth->finish;
        return undef;
    }

    # Transform row objects into requested query columns
    if (my $columns = $sth->FETCH('wmi_return_columns')) {
        my $r = $row[0];
        @row = map { $_ eq '*' ? $r : $r->{$_} } @$columns;
    };

    if ($sth->FETCH('ChopBlanks')) {
        map { $_ =~ s/\s+$//; } @row;
    }
    return $sth->_set_fbav(\@row);
}
*fetch = \&fetchrow_arrayref; # required alias for fetchrow_arrayref

sub STORE
{
  my ($sth, $attr, $val) = @_;
  if ($attr =~ m/^wmi_/) {
      # Handle only our private attributes here
      # Note that we could trigger arbitrary actions.
      # Ideally we should warn about unknown attributes.
      $sth->{$attr} = $val; # Yes, we are allowed to do this,
      return 1;             # but only for our private attributes
  }
  # Else pass up to DBI to handle for us
  $sth->SUPER::STORE($attr, $val);
}

sub FETCH
{
  my ($sth, $attr) = @_;
  if ($attr eq 'AutoCommit') { return 1; }
  if ($attr =~ m/^wmi_/) {
      # Handle only our private attributes here
      # Note that we could trigger arbitrary actions.
      return $sth->{$attr}; # Yes, we are allowed to do this,
                            # but only for our private attributes
  }
  # Else pass up to DBI to handle
  $sth->SUPER::FETCH($attr);
}

1;