Initial commit master 0.001
authorMarius Gavrilescu <marius@ieval.ro>
Sat, 30 Jun 2018 16:25:06 +0000 (19:25 +0300)
committerMarius Gavrilescu <marius@ieval.ro>
Sat, 30 Jun 2018 16:25:06 +0000 (19:25 +0300)
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/WWW/Passmark.pm [new file with mode: 0644]
lib/WWW/Passmark/CPU.pm [new file with mode: 0644]
lib/WWW/Passmark/GPU.pm [new file with mode: 0644]
t/WWW-Passmark.t [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
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 (file)
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 (file)
index 0000000..67e3303
--- /dev/null
@@ -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 (file)
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 (file)
index 0000000..683bd65
--- /dev/null
@@ -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 (file)
index 0000000..b4bb549
--- /dev/null
@@ -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 (file)
index 0000000..37d3488
--- /dev/null
@@ -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 (file)
index 0000000..1892d50
--- /dev/null
@@ -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';
This page took 0.016206 seconds and 4 git commands to generate.