Checking if your kit is complete...
Looks good
Writing Makefile for DBD::WMI

Microsoft (R) Program Maintenance Utility Version 7.10.3077
Copyright (C) Microsoft Corporation.  All rights reserved.

cp lib/DBD/WMI.pm blib\lib\DBD\WMI.pm
cp lib/Win32/WQL.pm blib\lib\Win32\WQL.pm

Microsoft (R) Program Maintenance Utility Version 7.10.3077
Copyright (C) Microsoft Corporation.  All rights reserved.

	C:\cpanrun\build\5-10-0\bin\perl.exe "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib\lib', 'blib\arch')" t/*.t
t/01-use.............1..1
ok 1 - The object isa DBI::db
ok
t/02-column-parse....1..5
ok 1 - The object isa DBI::db
ok 2 - Single asterisk
ok 3 - Two columns
ok 4 - Function (not implemented but gets passed through)
ok 5 - Non-SELECT statement gets asterisk
ok
t/99-manifest........1..9
ok 1 - MANIFEST exists
ok 2 - No empty lines in MANIFEST
ok 3 - No whitespace-only lines in MANIFEST
ok 4 - No trailing whitespace on lines in MANIFEST
ok 5 - MANIFEST.skip exists
ok 6 - No empty lines in MANIFEST.skip
ok 7 - No whitespace-only lines in MANIFEST.skip
ok 8 - No trailing whitespace on lines in MANIFEST.skip
ok 9 - No test files left out of MANIFEST
ok
t/99-pod.............1..2
ok 1 - POD test for blib\lib/DBD/WMI.pm
ok 2 - POD test for blib\lib/Win32/WQL.pm
ok
t/99-todo............1..2
ok 1 - Looking for XXXes in blib\lib/DBD/WMI.pm
ok 2 - Looking for XXXes in blib\lib/Win32/WQL.pm
ok
t/99-unix-text.......1..2
not ok 1 - 'blib\lib/DBD/WMI.pm' contains no windows newlines

#   Failed test ''blib\lib/DBD/WMI.pm' contains no windows newlines'
#   at t/99-unix-text.t line 33.
#          got: '414'
#     expected: '0'
# 0: package DBD::WMI;

# 1: use strict;

# 2: use base 'DBD::File';

# 3: use DBI;

# 4: 

# 5: use vars qw($ATTRIBUTION $VERSION);

# 6: 

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

# 8: $VERSION = '0.05';

# 9: 

# 10: =head1 NAME

# 11: 

# 12: DBD::WMI - interface to the Windows WMI

# 13: 

# 14: =head1 ABSTRACT

# 15: 

# 16: This module allows you to issue WQL queries

# 17: through the DBI.

# 18: 

# 19: =head1 SYNOPSIS

# 20: 

# 21:   use DBI;

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

# 23: 

# 24:   my $sth = $dbh->prepare(<<WQL);

# 25:     SELECT * FROM Win32_Process

# 26:   WQL

# 27: 

# 28:   $sth->execute();

# 29:   while (my @row = $sth->fetchrow) {

# 30:     my $proc = $row->[0];

# 31:     print join "\t", $proc->{Caption}, $proc->{ExecutablePath} || "<system>";

# 32:     # $proc->Terminate();

# 33:     print "\n";

# 34:   }

# 35: 

# 36: The WMI

# 37: allows you to query various tables ("namespaces"), like the filesystem,

# 38: currently active processes and events:

# 39: 

# 40:      SELECT * FROM Win32_Process

# 41: 

# 42: The driver/WMI implements two kinds of queries, finite queries like the

# 43: query above and potentially infinite queries for events as they occur in

# 44: the system:

# 45: 

# 46:      SELECT * FROM __instanceoperationevent

# 47:      WITHIN 1

# 48:      WHERE TargetInstance ISA 'Win32_DiskDrive'

# 49: 

# 50: This query returns one row (via ->fetchrow_arrayref() ) whenever a disk

# 51: drive gets added to or removed from the system (think of an USB stick).

# 52: 

# 53: There is currently no support for selecting specific

# 54: columns instead of C<*>. Support for selecting columns that

# 55: then get returned as plain Perl scalars is planned.

# 56: 

# 57: =cut

# 58: 

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

# 60: 

# 61: my $drh;

# 62: sub driver {

# 63:     return $drh if $drh;

# 64: 

# 65:     my ($package,$attr) = @_;

# 66: 

# 67:     $package .= "::dr";

# 68:     $drh = DBI::_new_drh( $package, {

# 69:             Attribution => $ATTRIBUTION,

# 70:             Version     => $VERSION,

# 71:             Name        => 'WMI',

# 72:         },

# 73:     );

# 74: 

# 75:     $drh

# 76: };

# 77: 

# 78: package DBD::WMI::dr;

# 79: use strict;

# 80: use Win32::WQL;

# 81: 

# 82: use vars qw($imp_data_size);

# 83: 

# 84: $imp_data_size = 0;

# 85: 

# 86: sub connect {

# 87:     my ($drh, $dr_dsn, $user, $auth, $attr) = @_;

# 88: 

# 89:     $dr_dsn ||= ".";

# 90:     $dr_dsn =~ /^([^;]*)/i

# 91:         or die "Invalid DSN '$dr_dsn'";

# 92:     my $machine = $1 || ".";

# 93: 

# 94:     my $wmi = Win32::WQL->new(

# 95:         machine => $machine

# 96:     );

# 97: 

# 98:     my ($outer, $dbh) = DBI::_new_dbh(

# 99:         $drh,

# 100:         { Name => $dr_dsn },

# 101:     );

# 102:     $dbh->{wmi_wmi} = $wmi;

# 103: 

# 104:     #$dbh->STORE('Active',1);

# 105:     $outer

# 106: }

# 107: 

# 108: sub data_sources {

# 109:     my ($drh) = @_;

# 110: 

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

# 112:     my $sth = $wmi->prepare(<<WQL);

# 113:         SELECT * FROM meta_class

# 114: WQL

# 115: 

# 116:     my $sources = $sth->execute();

# 117:     my @res;

# 118:     while (my $ev = $sources->fetchrow()) {

# 119:         push @res, $ev->Path_->Class

# 120:     };

# 121:     @res

# 122: }

# 123: 

# 124: package DBD::WMI::db;

# 125: use strict;

# 126: 

# 127: use vars qw($imp_data_size);

# 128: $imp_data_size = 0;

# 129: 

# 130: sub prepare {

# 131:     my ($dbh, $statement, @attribs) = @_;

# 132: 

# 133:     my $own_sth = $dbh->{wmi_wmi}->prepare($statement);

# 134:     my ($outer, $sth) = DBI::_new_sth($dbh,

# 135:         { Statement => $statement,

# 136:           wmi_sth => $own_sth,

# 137:           wmi_params => [],

# 138:         },

# 139:     );

# 140: 

# 141:     my $columns = __PACKAGE__->parse_columns($statement);

# 142:     $sth->STORE('wmi_return_columns', $columns);

# 143: 

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

# 145: 

# 146:     return $outer;

# 147: }

# 148: 

# 149: =head2 C<< DBD::WMI::db::parse_columns STATEMENT >>

# 150: 

# 151: This routine parses out the requested columns

# 152: from the WQL statement and returns an array reference

# 153: with the names of the columns.

# 154: 

# 155: Currently, this only works for C<SELECT> statements.

# 156: All other statements get an implicit column

# 157: of C<*>, meaning that the Win32::OLE objects

# 158: will be returned.

# 159: 

# 160: =cut

# 161: 

# 162: sub parse_columns {

# 163:     my ($dbh, $statement) = @_;

# 164:     my @columns;

# 165:     if ($statement =~ /^\s*SELECT \s*(.*?)\s+FROM\b/mi) {

# 166:         @columns = map { s/^\s*//; s/\s*$//; $_ } split /,/, $1; # verrry simplicistic parsing

# 167:     } else {

# 168:         @columns = ('*');

# 169:     };

# 170:     

# 171:     \@columns

# 172: };

# 173: 

# 174: sub STORE

# 175: {

# 176:   my ($dbh, $attr, $val) = @_;

# 177:   if ($attr eq 'AutoCommit') {

# 178:       # AutoCommit is currently the only standard attribute we have

# 179:       # to consider.

# 180:       if (!$val) { die "Can't disable AutoCommit"; }

# 181:       return 1;

# 182:   }

# 183:   if ($attr =~ m/^wmi_/) {

# 184:       # Handle only our private attributes here

# 185:       # Note that we could trigger arbitrary actions.

# 186:       # Ideally we should warn about unknown attributes.

# 187:       $dbh->{$attr} = $val; # Yes, we are allowed to do this,

# 188:       return 1;             # but only for our private attributes

# 189:   }

# 190:   # Else pass up to DBI to handle for us

# 191:   $dbh->SUPER::STORE($attr, $val);

# 192: }

# 193: 

# 194: sub FETCH

# 195: {

# 196:   my ($dbh, $attr) = @_;

# 197:   if ($attr eq 'AutoCommit') { return 1; }

# 198:   if ($attr =~ m/^wmi_/) {

# 199:       # Handle only our private attributes here

# 200:       # Note that we could trigger arbitrary actions.

# 201:       return $dbh->{$attr}; # Yes, we are allowed to do this,

# 202:                             # but only for our private attributes

# 203:   }

# 204:   # Else pass up to DBI to handle

# 205:   $dbh->SUPER::FETCH($attr);

# 206: }

# 207: 

# 208: package DBD::WMI::st;

# 209: use strict;

# 210: use Carp qw(croak);

# 211: 

# 212: use vars qw($imp_data_size);

# 213: 

# 214: $imp_data_size = 0;

# 215: 

# 216: sub execute {

# 217:     my $sth = shift;

# 218: 

# 219:     # Recycle if we're still active

# 220:     $sth->finish if $sth->FETCH('Active');

# 221: 

# 222:     my $params = (@_) ?

# 223:         \@_ : $sth->{wmi_params};

# 224:     my $numParam = $sth->FETCH('NUM_OF_PARAMS');

# 225:     return $sth->set_err(1, "Wrong number of parameters")

# 226:         if @$params != $numParam;

# 227:     if ($numParam > 0) {

# 228:         return $sth->set_err(1, "DBD::WMI doesn't support parameters yet")

# 229:             if @$params > 0;

# 230:     };

# 231:     #my $statement = $sth->{'Statement'};

# 232:     #for (my $i = 0;  $i < $numParam;  $i++) {

# 233:     #    $statement =~ s/?/$params->[$i]/; # doesn't deal with quoting etc!

# 234:     #

# 235:     #};

# 236: 

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

# 238: 

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

# 240: 

# 241:     $sth->{'wmi_data'} = $iter;

# 242:     $sth->{'wmi_rows'} = 1; # we don't know/can't know

# 243:     $sth->STORE('NUM_OF_FIELDS', scalar @{$sth->FETCH('wmi_return_columns')});# $numFields;

# 244:     $sth->{'wmi_rows'} || '0E0';

# 245: }

# 246: 

# 247: sub fetchrow_arrayref

# 248: {

# 249:     my ($sth) = @_;

# 250:     my $data = $sth->{wmi_data};

# 251:     my @row = $data->fetchrow();

# 252: 

# 253:     if (! @row) {

# 254:         $sth->finish;

# 255:         return undef;

# 256:     }

# 257: 

# 258:     # Transform row objects into requested query columns

# 259:     if (my $columns = $sth->FETCH('wmi_return_columns')) {

# 260:         my $r = $row[0];

# 261:         @row = map { $_ eq '*' ? $r : $r->{$_} } @$columns;

# 262:     };

# 263: 

# 264:     if ($sth->FETCH('ChopBlanks')) {

# 265:         map { $_ =~ s/\s+$//; } @row;

# 266:     }

# 267:     return $sth->_set_fbav(\@row);

# 268: }

# 269: *fetch = \&fetchrow_arrayref; # required alias for fetchrow_arrayref

# 270: 

# 271: sub STORE

# 272: {

# 273:   my ($sth, $attr, $val) = @_;

# 274:   if ($attr =~ m/^wmi_/) {

# 275:       # Handle only our private attributes here

# 276:       # Note that we could trigger arbitrary actions.

# 277:       # Ideally we should warn about unknown attributes.

# 278:       $sth->{$attr} = $val; # Yes, we are allowed to do this,

# 279:       return 1;             # but only for our private attributes

# 280:   }

# 281:   # Else pass up to DBI to handle for us

# 282:   $sth->SUPER::STORE($attr, $val);

# 283: }

# 284: 

# 285: sub FETCH

# 286: {

# 287:   my ($sth, $attr) = @_;

# 288:   if ($attr eq 'AutoCommit') { return 1; }

# 289:   if ($attr =~ m/^wmi_/) {

# 290:       # Handle only our private attributes here

# 291:       # Note that we could trigger arbitrary actions.

# 292:       return $sth->{$attr}; # Yes, we are allowed to do this,

# 293:                             # but only for our private attributes

# 294:   }

# 295:   # Else pass up to DBI to handle

# 296:   $sth->SUPER::FETCH($attr);

# 297: }

# 298: 

# 299: 1;

# 300: 

# 301: =head1 HANDLING OF QUERY COLUMNS

# 302: 

# 303: The WMI and WQL return full objects instead of single columns. The specification

# 304: of columns is merely a hint to the object what properties to preload. The

# 305: DBD interface deviates from that approach in that it returns objects

# 306: for queries of the form C<SELECT *> and the values of the object

# 307: properties when columns are specified. These columns are then case sensitive.

# 308: 

# 309: =head1 FUN QUERIES

# 310: 

# 311: =head2 List all printers

# 312: 

# 313:   SELECT * FROM Win32_Printer

# 314: 

# 315: =head2 List all print jobs on a printer

# 316: 

# 317:   SELECT * FROM Win32_PrintJob

# 318:     WHERE DriverName = 'HP Deskjet 6122'

# 319: 

# 320: =head2 Return a new row whenever a new print job is started

# 321: 

# 322:   SELECT * FROM __InstanceCreationEvent

# 323:     WITHIN 10

# 324:     WHERE

# 325:       TargetInstance ISA 'Win32_PrintJob'

# 326: 

# 327: =head2 Finding the default printer

# 328: 

# 329:   SELECT * FROM Win32_Printer

# 330:     WHERE Default = TRUE

# 331: 

# 332: =head2 Setting the default printer (untested, WinXP, Win2003)

# 333: 

# 334:   use DBI;

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

# 336:   my $sth = $dbh->prepare(<<WQL);

# 337:       SELECT * FROM Win32_Printer

# 338:   WQL

# 339: 

# 340:   $sth->execute;

# 341:   while (my @row = $sth->fetchrow) {

# 342:       # We get Win32::OLE objects back:

# 343:       my $printer = $row[0];

# 344:       printf "Making %s the default printer\n", $printer->{Name};

# 345:       $printer->SetDefaultPrinter;

# 346:   };

# 347: 

# 348: =head2 Find all network adapters with IP enabled

# 349: 

# 350:   SELECT * from Win32_NetworkAdapterConfiguration

# 351:     WHERE IPEnabled = True

# 352: 

# 353: =head2 Find files in a directory

# 354: 

# 355:   ASSOCIATORS OF {Win32_Directory.Name='C:\WINNT'}

# 356:     WHERE ResultClass = CIM_DataFile

# 357: 

# 358: =head2 Find printers on a remote machine

# 359: 

# 360:   use DBI;

# 361:   my $machine = 'dawn';

# 362:   my $dbh = DBI->connect('dbi:WMI:'.$machine);

# 363:   my $sth = $dbh->prepare(<<WQL);

# 364:       SELECT * FROM Win32_Printer

# 365:   WQL

# 366: 

# 367:   $sth->execute;

# 368:   while (my @row = $sth->fetchrow) {

# 369:       my $printer = $row[0];

# 370:       printf "Making %s the default printer on %s\n", $printer->{Name}, $machine;

# 371:       $printer->SetDefaultPrinter;

# 372:   };

# 373: 

# 374: =head2 Get method names of objects

# 375: 

# 376:   use Win32::OLE qw(in);

# 377:   ...

# 378: 

# 379:   SELECT * FROM Win32_Process

# 380: 

# 381:   $sth->execute;

# 382: 

# 383:   while (my @row = $sth->fetchrow) {

# 384:       for my $method (in $row[0]->Methods_) {

# 385:           print "Can call $method() on the object\n"

# 386:       };

# 387:   };

# 388: 

# 389: =head1 TODO

# 390: 

# 391: =over 4

# 392: 

# 393: =item * Implement placeholders and proper interpolation of values

# 394: 

# 395: =item * Need to implement DSN parameters for remote computers, credentials

# 396: 

# 397: =back

# 398: 

# 399: =head1 SEE ALSO

# 400: 

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

# 402: 

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

# 404: 

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

# 406: 

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

# 408: 

# 409: Wikipedia on WMI at L<http://en.wikipedia.org/wiki/Windows_Management_Instrumentation>

# 410: 

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

# 412: 

# 413: =cut

not ok 2 - 'blib\lib/Win32/WQL.pm' contains no windows newlines

#   Failed test ''blib\lib/Win32/WQL.pm' contains no windows newlines'
#   at t/99-unix-text.t line 33.
#          got: '234'
#     expected: '0'
# 0: package Win32::WQL;

# 1: use strict;

# 2: use Win32::OLE; #  qw(EVENTS);

# 3: # Events support will follow later

# 4: use base 'Class::Accessor';

# 5: 

# 6: =head1 NAME

# 7: 

# 8: Win32::WQL - DBI-like wrapper for the WMI

# 9: 

# 10: =head1 SYNOPSIS

# 11: 

# 12:   use Win32::WQL;

# 13:   my $wmi = Win32::WQL->new( machine => 'remote_computer' );

# 14:   my $sth = $wmi->prepare(<<'WQL');

# 15:   

# 16:     ASSOCIATORS OF {Win32_Directory.Name='C:\\WINNT'}

# 17:     WHERE ResultClass = CIM_DataFile

# 18:     

# 19:   WQL

# 20: 

# 21:   my $remote_files = $sth->execute;

# 22:   while (my $file = $remote_files->fetch()) {

# 23:       print $file->{Name},"\n";

# 24:   };

# 25: 

# 26: =head1 OVERVIEW

# 27: 

# 28: This module implements a bare bones DBI clone

# 29: which is similar yet different. You will most likely

# 30: want to use the real thing, L<DBD::WMI>, which

# 31: is a compatibility layer over this module.

# 32: 

# 33: =cut

# 34: 

# 35: use vars qw($VERSION);

# 36: $VERSION = '0.05';

# 37: 

# 38: Win32::OLE->Option(Warn => 3);

# 39: 

# 40: __PACKAGE__->mk_accessors(qw(statement_class event_iterator_class collection_iterator_class wmi));

# 41: 

# 42: =head1 METHODS

# 43: 

# 44: =head2 C<< new %ARGS >>

# 45: 

# 46: Initializes the thin wrapper over the L<Win32::OLE>

# 47: WMI instance. All parameters are optional.

# 48: 

# 49:   machine

# 50:   

# 51: The parameter is the machine name to connect to. It defaults

# 52: to the local machine.

# 53: 

# 54:   wmi

# 55: 

# 56: A preinitialized WMI object to use. Defaults to creating

# 57: a fresh instance.

# 58: 

# 59:   statement_class

# 60:   

# 61: The class into which the results of C<prepare>

# 62: are blessed. Defaults to C<Win32::WQL::Statement>.

# 63: 

# 64:   event_iterator_class

# 65: 

# 66: The class into which the results of C<fetchrow>

# 67: are blessed for event queries. Defaults to

# 68: C<Win32::WQL::Iterator::Event>.

# 69: 

# 70:   collection_iterator_class

# 71: 

# 72: The class into which the results of C<fetchrow>

# 73: are blessed for static queries. Defaults to

# 74: C<Win32::WQL::Iterator::Collection>.

# 75: 

# 76: =cut

# 77: 

# 78: sub new {

# 79:     my ($package, %args) = @_;

# 80:     my $machine = delete $args{machine} || '.';

# 81:     my $self = {

# 82:         wmi             => Win32::OLE->GetObject("winmgmts:\\\\$machine\\root\\cimV2"),

# 83:         statement_class => 'Win32::WQL::Statement',

# 84:         event_iterator_class  => 'Win32::WQL::Iterator::Event',

# 85:         collection_iterator_class  => 'Win32::WQL::Iterator::Collection',

# 86:         %args,

# 87:     };

# 88:     $package->SUPER::new($self);

# 89: };

# 90: 

# 91: =head2 C<< $wmi->prepare QUERY >>

# 92: 

# 93: Returns a prepared query by calling 

# 94: 

# 95:     return $self->statement_class->new({

# 96:         query => $query,

# 97:         wmi => $self,

# 98:         iterator_class => $class,

# 99:         wmi_method => $method,

# 100:     });

# 101: 

# 102: =cut

# 103: 

# 104: sub prepare {

# 105:     my ($self,$query) = @_;

# 106: 

# 107:     my ($class,$method,$fetch);

# 108:     if ($self->event_query($query)) {

# 109:         $class = $self->event_iterator_class;

# 110:         $method = 'ExecNotificationQuery';

# 111:     } else {

# 112:         $class = $self->collection_iterator_class;

# 113:         $method = 'ExecQuery';

# 114:     };

# 115: 

# 116:     return $self->statement_class->new({

# 117:         query => $query,

# 118:         wmi => $self,

# 119:         iterator_class => $class,

# 120:         wmi_method => $method,

# 121:     });

# 122: }

# 123: 

# 124: =head2 C<< $wmi->event_query QUERY >>

# 125: 

# 126: Determines whether a query is an event query

# 127: or a static query.

# 128: 

# 129: Event queries return a row whenever a new event

# 130: arrives and block if there is no event available.

# 131: 

# 132: Static queries are static and return all rows in

# 133: one go.

# 134: 

# 135: A query is considered an event query if it

# 136: matches 

# 137: 

# 138:      $query =~ /\b__instance(?:\w+)event\b/i

# 139:   or $query =~ /\wEvent\b/i

# 140: 

# 141: =cut

# 142: 

# 143: sub event_query {

# 144:     my ($package, $query) = @_;

# 145:     return

# 146:     (   $query =~ /\b__instance(?:\w+)event\b/i

# 147:      or $query =~ /\wEvent\b/i

# 148:     )

# 149: }

# 150: 

# 151: package Win32::WQL::Statement;

# 152: use strict;

# 153: use Win32::OLE;

# 154: use base 'Class::Accessor';

# 155: 

# 156: __PACKAGE__->mk_accessors(qw(iterator_class wmi query wmi_method));

# 157: 

# 158: sub execute {

# 159:     my ($self) = @_;

# 160:     my $m = $self->wmi_method;

# 161:     my $i = $self->wmi->wmi->$m( $self->query );

# 162:     return $self->iterator_class->new({

# 163:         wql_iterator => $i

# 164:     });

# 165: }

# 166: 

# 167: package Win32::WQL::Iterator::Collection;

# 168: use strict;

# 169: use base 'Class::Accessor';

# 170: __PACKAGE__->mk_accessors(qw(wql_iterator items));

# 171: 

# 172: use Win32::OLE qw(in);

# 173: use Data::Dumper;

# 174: 

# 175: # Finite, prefetched list

# 176: 

# 177: sub new {

# 178:     my ($package,$args) = @_;

# 179:     my @items = in delete $args->{wql_iterator};

# 180:     $args->{items} = \@items;

# 181:     $package->SUPER::new($args);

# 182: }

# 183: 

# 184: sub fetchrow {

# 185:     my ($self) = @_;

# 186:     if (@{ $self->items }) {

# 187:         shift @{ $self->items };

# 188:     } else {

# 189:         return ()

# 190:     };

# 191: }

# 192: 

# 193: package Win32::WQL::Iterator::Event;

# 194: use strict;

# 195: use base 'Class::Accessor';

# 196: __PACKAGE__->mk_accessors(qw(wql_iterator));

# 197: 

# 198: # potentially infinite list

# 199: 

# 200: sub fetchrow {

# 201:     my ($self) = @_;

# 202:     return $self->wql_iterator->NextEvent();

# 203: }

# 204: 

# 205: 1;

# 206: 

# 207: =head1 SEE ALSO

# 208: 

# 209: L<DBD::WMI> for more examples

# 210: 

# 211: =head1 TODO

# 212: 

# 213: =over 4

# 214: 

# 215: =item * Implement parameters for and credentials

# 216: 

# 217: =item * Implement a multiplexer by using multiple, waiting threads so you can C<SELECT>

# 218: events from more than one WMI namespace

# 219: 

# 220: =back

# 221: 

# 222: =head1 AUTHOR

# 223: 

# 224: Max Maischein (corion@cpan.org)

# 225: 

# 226: =head1 COPYRIGHT

# 227: 

# 228: Copyright (C) 2006 Max Maischein.  All Rights Reserved.

# 229: 

# 230: This code is free software; you can redistribute it and/or modify it

# 231: under the same terms as Perl itself.

# 232: 

# 233: =cut

# Looks like you failed 2 tests of 2.
dubious
	Test returned status 2 (wstat 512, 0x200)
DIED. FAILED tests 1-2
	Failed 2/2 tests, 0.00% okay
t/99-versions........# Checking for $VERSION = '0.05';
ok 1 - blib/lib/DBD/WMI.pm
ok 2 - blib/lib/Win32/WQL.pm
1..2
ok
Failed Test      Stat Wstat Total Fail  List of Failed
-------------------------------------------------------------------------------
t/99-unix-text.t    2   512     2    2  1-2
Failed 1/7 test scripts. 2/23 subtests failed.
Files=7, Tests=23,  2 wallclock secs ( 0.00 cusr +  0.00 csys =  0.00 CPU)
Failed 1/7 test programs. 2/23 subtests failed.
NMAKE : fatal error U1077: 'C:\cpanrun\build\5-10-0\bin\perl.exe' : return code '0xff'
Stop.