From e7d8c9199ad383b4156ca1f74752dbe0272d9ee9 Mon Sep 17 00:00:00 2001
From: Marius Gavrilescu <marius@ieval.ro>
Date: Sat, 30 Jun 2018 19:25:06 +0300
Subject: [PATCH 1/1] Initial commit

---
 Changes                 |   4 ++
 MANIFEST                |   8 +++
 Makefile.PL             |  27 +++++++++++
 README                  |  40 +++++++++++++++
 lib/WWW/Passmark.pm     | 105 ++++++++++++++++++++++++++++++++++++++++
 lib/WWW/Passmark/CPU.pm |  56 +++++++++++++++++++++
 lib/WWW/Passmark/GPU.pm |  55 +++++++++++++++++++++
 t/WWW-Passmark.t        |  27 +++++++++++
 8 files changed, 322 insertions(+)
 create mode 100644 Changes
 create mode 100644 MANIFEST
 create mode 100644 Makefile.PL
 create mode 100644 README
 create mode 100644 lib/WWW/Passmark.pm
 create mode 100644 lib/WWW/Passmark/CPU.pm
 create mode 100644 lib/WWW/Passmark/GPU.pm
 create mode 100644 t/WWW-Passmark.t

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..473e862
--- /dev/null
+++ b/Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension WWW::Passmark.
+
+0.001 2018-06-30T19:25+03:00
+ - Initial release
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..d0903c4
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,8 @@
+Changes
+lib/WWW/Passmark.pm
+lib/WWW/Passmark/CPU.pm
+lib/WWW/Passmark/GPU.pm
+Makefile.PL
+MANIFEST
+README
+t/WWW-Passmark.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..67e3303
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,27 @@
+use 5.014000;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+	NAME              => 'WWW::Passmark',
+	VERSION_FROM      => 'lib/WWW/Passmark.pm',
+	ABSTRACT_FROM     => 'lib/WWW/Passmark.pm',
+	AUTHOR            => 'Marius Gavrilescu <marius@ieval.ro>',
+	MIN_PERL_VERSION  => '5.14.0',
+	LICENSE           => 'perl',
+	SIGN              => 1,
+	PREREQ_PM         => {
+		qw/HTML::TreeBuilder 0
+		   LWP::UserAgent 0
+		   LWP::Protocol::https 0
+		   List::MoreUtils 0/,
+	},
+	TEST_REQUIRES     => {
+		qw/Test::RequiresInternet 0/,
+	},
+	META_ADD         => {
+		dynamic_config => 0,
+		resources      => {
+			repository   => 'https://git.ieval.ro/?p=www-passmark.git',
+		},
+	}
+);
diff --git a/README b/README
new file mode 100644
index 0000000..61ccb3f
--- /dev/null
+++ b/README
@@ -0,0 +1,40 @@
+WWW-Passmark version 0.001
+==========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2018 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
diff --git a/lib/WWW/Passmark.pm b/lib/WWW/Passmark.pm
new file mode 100644
index 0000000..683bd65
--- /dev/null
+++ b/lib/WWW/Passmark.pm
@@ -0,0 +1,105 @@
+package WWW::Passmark;
+
+use 5.014000;
+use strict;
+use warnings;
+use parent qw/Exporter/;
+
+our $VERSION = '0.001';
+our @EXPORT_OK = qw/get_cpu_list get_gpu_list/;
+our @EXPORT = @EXPORT_OK;
+
+use WWW::Passmark::CPU;
+use WWW::Passmark::GPU;
+
+use HTML::TreeBuilder;
+use LWP::UserAgent; # TreeBuilder->new_from_url uses this
+use List::MoreUtils qw/natatime/;
+
+use Data::Dumper qw/Dumper/;
+
+our $CPU_URL = 'https://www.cpubenchmark.net/CPU_mega_page.html';
+our $GPU_URL = 'https://www.videocardbenchmark.net/GPU_mega_page.html';
+
+sub get_main_table {
+	my ($url) = @_;
+	my $tree = HTML::TreeBuilder->new_from_url($url);
+	my $table = $tree->look_down(class => 'tablesorter');
+	my $iter = natatime 2, $tree->find('tbody')->find('tr');
+
+	my @results;
+	while (my @items = $iter->()) {
+		my ($item, $desc) = @items;
+		push @results, [ map { $_->as_text } $item->find('td'), $desc->find('td') ]
+	}
+
+	@results
+}
+
+sub get_cpu_list {
+	my @results = map { bless $_, 'WWW::Passmark::CPU' } get_main_table $CPU_URL;
+	#bless \@results, 'WWW::Passmark::CPUList'
+	\@results
+}
+
+sub get_gpu_list {
+	my @results = map { bless $_, 'WWW::Passmark::GPU' } get_main_table $GPU_URL;
+	#bless \@results, 'WWW::Passmark::GPUList'
+	\@results
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+WWW::Passmark - look up CPU/GPU benchmark results
+
+=head1 SYNOPSIS
+
+  use WWW::Passmark;
+  my $cpu_list = get_cpu_list;
+  my $some_cpu = $cpu_list->[232];
+  say $some_cpu->name; # AMD Ryzen 7 2700X
+  say $some_cpu->socket; # AM4
+  say $some_cpu->cpumark; # 17016
+  say $some_cpu->test_date; # Apr 2018
+
+  my $gpu_list = get_gpu_list;
+  my $some_gpu = $gpu_list->[5];
+  say $some_gpu->name; # Radeon R9 Fury
+  say $some_gpu->g3dmark; # 9212
+
+=head1 DESCRIPTION
+
+This module is a scraper for Passmark software result websites. This
+is the first version of the module, which only supports two of the
+websites (cpubenchmark.net and videocardbenchmark.net) and offers few
+features.
+
+There are currently two functions, both exported by default. They are
+B<get_cpu_list> and B<get_gpu_list>, which download the list of all
+benchmark results for CPUs/GPUs and return an arrayref of objects of
+type L<WWW::Passmark::CPU> or L<WWW::Passmark::GPU>. Each such object
+represents one CPU/GPU, and contains its name and benchmark results.
+
+=head1 SEE ALSO
+
+L<https://www.cpubenchmark.net>, L<https://www.videocardbenchmark.net>
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2018 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
diff --git a/lib/WWW/Passmark/CPU.pm b/lib/WWW/Passmark/CPU.pm
new file mode 100644
index 0000000..b4bb549
--- /dev/null
+++ b/lib/WWW/Passmark/CPU.pm
@@ -0,0 +1,56 @@
+package WWW::Passmark::CPU;
+
+use 5.014000;
+use strict;
+use warnings;
+
+sub name { shift->[0] }
+sub price { shift->[1] }
+sub cpumark { shift->[2] }
+sub value { shift->[3] }
+sub single_thread_mark { shift->[4] }
+sub single_thread_value { shift->[5] }
+sub tdp { shift->[6] }
+sub power_performance { shift->[7] }
+sub test_date { shift->[8] }
+sub socket { shift->[9] }
+sub category { shift->[10] }
+sub extra_info { shift->[11] }
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+WWW::Passmark::CPU - benchmark results of a CPU
+
+=head1 SYNOPSIS
+
+  my $cpu = ...;
+  say $cpu->name; # AMD FX-8350 Eight-Core
+  say $cpu->cpumark; # 8950
+  say $cpu->test_date; # Oct 2012
+  say $cpu->tdp; # 125
+
+=head1 DESCRIPTION
+
+An instance of this module represents benchmark results for some CPU.
+Methods of this module return the various results, see source code for
+a list of available methods.
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2018 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
diff --git a/lib/WWW/Passmark/GPU.pm b/lib/WWW/Passmark/GPU.pm
new file mode 100644
index 0000000..37d3488
--- /dev/null
+++ b/lib/WWW/Passmark/GPU.pm
@@ -0,0 +1,55 @@
+package WWW::Passmark::GPU;
+
+use 5.014000;
+use strict;
+use warnings;
+
+sub name { shift->[0] }
+sub price { shift->[1] }
+sub g3dmark { shift->[2] }
+sub value { shift->[3] }
+sub g2dmark { shift->[4] }
+sub tdp { shift->[5] }
+sub power_performance { shift->[6] }
+sub test_date { shift->[7] }
+sub category { shift->[8] }
+sub extra_info { shift->[9] }
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+WWW::Passmark::GPU - benchmark results of a GPU
+
+=head1 SYNOPSIS
+
+  my $gpu = ...;
+  say $gpu->name; # Radeon RX 580
+  say $gpu->g3dmark; # 8376
+  say $gpu->g2dmark; # 748
+  say $gpu->test_date; # Apr 2017
+  say $gpu->tdp; # 185
+
+=head1 DESCRIPTION
+
+An instance of this module represents benchmark results for some GPU.
+Methods of this module return the various results, see source code for
+a list of available methods.
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2018 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
diff --git a/t/WWW-Passmark.t b/t/WWW-Passmark.t
new file mode 100644
index 0000000..1892d50
--- /dev/null
+++ b/t/WWW-Passmark.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::RequiresInternet ('www.cpubenchmark.net' => 443, 'www.videocardbenchmark.net' => 443);
+use Test::More tests => 10;
+use List::Util qw/first/;
+
+BEGIN { use_ok('WWW::Passmark') };
+
+my $cpu_list = get_cpu_list;
+my $gpu_list = get_gpu_list;
+
+my $fx8350 = first { $_->name =~ /AMD FX-8350/i } @$cpu_list;
+my $rx460 = first { $_->name eq 'Radeon RX 460' } @$gpu_list;
+
+ok defined $fx8350, 'Found AMD FX-8350 in CPU list';
+ok defined $rx460, 'Found Radeon RX 460 in GPU list';
+
+cmp_ok $fx8350->cpumark, '>', 0, 'cpumark is positive';
+cmp_ok $fx8350->single_thread_mark, '>', 0, 'single_thread_mark is positive';
+is $fx8350->tdp, 125, 'TDP is correct';
+is $fx8350->socket, 'AM3+', 'socket is correct';
+
+cmp_ok $rx460->g3dmark, '>', 0, 'g3dmark is positive';
+cmp_ok $rx460->g2dmark, '>', 0, 'g2dmark is positive';
+is $rx460->tdp, 75, 'TDP is correct';
-- 
2.39.5