1package System::Info::Windows;
2
3use strict;
4use warnings;
5
6use base "System::Info::Base";
7
8our $VERSION = "0.051";
9
10=head1 NAME
11
12System::Info::Windows - Object for specific Windows info.
13
14=head1 DESCRIPTION
15
16=head2 $si->prepare_sysinfo
17
18Use os-specific tools to find out more about the system.
19
20=cut
21
22sub prepare_sysinfo {
23    my $self = shift;
24    $self->SUPER::prepare_sysinfo;
25    $self->prepare_os;
26
27    my $reginfo = __get_registry_sysinfo ();
28    my $envinfo = __get_environment_sysinfo ();
29
30    for my $key (qw/__cpu_type __cpu __cpu_count/) {
31	my $value = $reginfo->{$key} || $envinfo->{$key};
32	$value and $self->{$key} = $value;
33	}
34    return $self;
35    } # prepare_sysinfo
36
37=head2 $si->prepare_os
38
39Use os-specific tools to find out more about the operating system.
40
41=cut
42
43sub prepare_os {
44    my $self = shift;
45
46    eval { require Win32 };
47    $@ and return;
48
49    my $os = $self->_os;
50    # ("Win7", "Windows 7 Professional (64-bit) Service Pack 1")
51    $os = "$^O - " . join " " => Win32::GetOSName ();
52    $os =~ s/Service\s+Pack\s+/SP/;
53    $self->{__os} = $os;
54
55    # Windows 7 Professional (64-bit) Service Pack 1
56    $self->{__osname} = Win32::GetOSDisplayName ();
57
58    # https://metacpan.org/pod/Win32#Win32::GetOSVersion()
59    # ("Service Pack 1", 6, 1, 7601, 2,   1, 0, 0x100, 1)
60    my ($name, $major, $minor, $build, $id,
61	$spmaj, $spmin, $suitemask, $producttype) = Win32::GetOSVersion ();
62    $self->{__osvers} = join "." => $major, $minor, $build;
63    } # prepare_os
64
65sub __get_registry_sysinfo {
66    eval { require Win32::TieRegistry };
67    $@ and return;
68
69    Win32::TieRegistry->import;
70    my $Registry = $Win32::TieRegistry::Registry->Open (
71	"", { Access => 0x2000000 });
72
73    my $basekey = join "\\" =>
74	qw(LMachine HARDWARE DESCRIPTION System CentralProcessor);
75
76    my $pnskey = "$basekey\\0\\ProcessorNameString";
77    my $cpustr = $Registry->{$pnskey};
78
79    my $idkey = "$basekey\\0\\Identifier";
80    $cpustr ||= $Registry->{ $idkey };
81    $cpustr =~ tr/ / /s;
82
83    my $mhzkey = "$basekey\\0\\~MHz";
84    $cpustr .= sprintf "(~%d MHz)", hex $Registry->{$mhzkey};
85    my $cpu = $cpustr;
86
87    my $ncpu = keys %{$Registry->{$basekey}};
88
89    my ($cpu_type) = $Registry->{$idkey} =~ /^(\S+)/;
90
91    return {
92	__cpu_type  => $cpu_type,
93	__cpu       => $cpu,
94	__cpu_count => $ncpu,
95	};
96    } # __get_registry_sysinfo
97
98sub __get_environment_sysinfo {
99    return {
100	__cpu_type  => $ENV{PROCESSOR_ARCHITECTURE},
101	__cpu       => $ENV{PROCESSOR_IDENTIFIER},
102	__cpu_count => $ENV{NUMBER_OF_PROCESSORS},
103	};
104    } # __get_environment_sysinfo
105
1061;
107
108__END__
109
110=head1 COPYRIGHT AND LICENSE
111
112(c) 2016-2018, Abe Timmerman & H.Merijn Brand, All rights reserved.
113
114With contributions from Jarkko Hietaniemi, Campo Weijerman, Alan Burlison,
115Allen Smith, Alain Barbet, Dominic Dunlop, Rich Rauenzahn, David Cantrell.
116
117This library is free software; you can redistribute it and/or modify
118it under the same terms as Perl itself.
119
120See:
121
122=over 4
123
124=item * L<http://www.perl.com/perl/misc/Artistic.html>
125
126=item * L<http://www.gnu.org/copyleft/gpl.html>
127
128=back
129
130This program is distributed in the hope that it will be useful,
131but WITHOUT ANY WARRANTY; without even the implied warranty of
132MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
133
134=cut
135