From 5281e109e977adc64ce0ffc2b051bd817aac0354 Mon Sep 17 00:00:00 2001
From: Brian Fraser <brian.fraser@percona.com>
Date: Thu, 9 Aug 2012 12:15:55 -0300
Subject: [PATCH] Updated Pingback.pm

---
 lib/Pingback.pm  | 37 ++++++++------------
 t/lib/Pingback.t | 89 +++++++++++++++++++++++++++++-------------------
 2 files changed, 68 insertions(+), 58 deletions(-)

diff --git a/lib/Pingback.pm b/lib/Pingback.pm
index 687e4b01..9ba1c3fc 100644
--- a/lib/Pingback.pm
+++ b/lib/Pingback.pm
@@ -7,43 +7,34 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
 local $EVAL_ERROR;
 eval {
-   require HTTP::Tiny;
-   require Transformers;
+   require HTTPMicro;
+   require VersionCheck;
 };
 
 sub pingback {
-   my ($url, $ua) = @_;
-   $ua ||= HTTP::Tiny->new( verify_ssl => 1 );
+   my ($url, $dbh, $ua) = @_; # pingback($url, $dbh[, $ua])
+   $ua ||= HTTP::Micro->new();
 
-   my $response = $ua->get($url);
+   my $response = $ua->request('GET', $url);
 
    if ( $response->{status} >= 500
-         || (exists $response->{reason} && !exists $response->{content}) )
+         ||  exists $response->{reason}
+         || !exists $response->{content} )
    {
       return;
    }
 
-   my $checks = $response->{content}
-              ? eval($response->{content})
-              : _default_checks();
-   my $e = $EVAL_ERROR;
-   $checks ||= _default_checks();
-   $checks->{check_code_error} = $e if $EVAL_ERROR;
+   my $items  = VersionCheck->parse_server_response(response => $response->{content});
+   my $checks = VersionCheck->get_versions(items => $items, dbh => $dbh);
 
-   my $options = {
-      headers  => { 'content-type'   => 'application/json', },
-      content  => Transformers::encode_json($checks),
-   };
+   my $options = { content => encode_to_plaintext($checks) };
 
-   return $ua->post($url, $options);
+   return $ua->request('POST', $url, $options);
 }
 
-sub _default_checks {
-   return +{
-         perl_version      => $],
-         DBD_mysql_version => $DBD::mysql::VERSION || 'N/A',
-         operating_system  => $^O eq "MSWin32" ? Win32::GetOSName() : $^O,
-   };
+sub encode_to_plaintext {
+   my $data = shift;
+   return join "\n", map { "$_,$data->{$_}" } keys %$data;
 }
 
 1;
diff --git a/t/lib/Pingback.t b/t/lib/Pingback.t
index 41314f84..682495ca 100644
--- a/t/lib/Pingback.t
+++ b/t/lib/Pingback.t
@@ -11,6 +11,8 @@ use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use Test::More;
 
+use PerconaTest;
+
 use Pingback;
 
 my @requests;
@@ -18,24 +20,25 @@ my @requests;
    package FakeUA;
 
    sub new { bless $_[1], $_[0] }
-   sub get { shift @{ $_[0] } }
-   sub post { push @requests, $_[2]; }
+   sub request {
+      my ($self, $type, $url, $content) = @_;
+
+      if ( $type ne 'GET' ) {
+         push @requests, $content;
+      }
+      return shift @{ $self };
+   }
 }
 
 my $fake_ua = FakeUA->new([
-   { status => 200, content => '$PerconaTest::Pingback::counter++; +{ some => "data" }' },
-   { status => 200 },
-   { status => 200, content => 'code_that_fails() !!!::,.-' },
+   { status => 200, content => "Perl;perl_variable;PERL_VERSION\nData::Dumper;perl_variable\n" }, # GET 1
+   { status => 200, }, # POST 1
+   { status => 200, content => "Perl;perl_variable;PERL_VERSION\nMySQL;mysql_variable;version_comment,version\n", }, # GET 2
+   { status => 200, }, # POST 2
 ]);
 
-$PerconaTest::Pingback::counter = 0;
-Pingback::pingback('http://www.percona.com/fake_url', $fake_ua);
-
-is(
-   $PerconaTest::Pingback::counter,
-   1,
-   "If the GET returns with status 200 and there's content, it's executed as Perl code"
-);
+@requests = ();
+Pingback::pingback('http://www.percona.com/fake_url', undef, $fake_ua);
 
 is(
    scalar @requests,
@@ -43,34 +46,50 @@ is(
    "..and it sends one request"
 );
 
-is(
-   $requests[0]->{content},
-   '{"some":"data"}',
-   "..which was obtained through the eval'd text"
-);
-
-@requests = ();
-Pingback::pingback('http://www.percona.com/fake_url', $fake_ua);
-
+my $v = sprintf('Perl,%vd', $^V);
 like(
    $requests[0]->{content},
-   qr/"perl_version":"$]"/,
-   "if the server doesn't return any code, checks the defaults"
-);
-
-@requests = ();
-Pingback::pingback('http://www.percona.com/fake_url', $fake_ua);
-
-like(
-   $requests[0]->{content},
-   qr/"perl_version":"$]"/,
-   "returns the defaults if the code returned by the server failed"
+   qr/\Q$v/,
+   "..which has the expected version of Perl"
 );
 
 like(
    $requests[0]->{content},
-   qr/"check_code_error":/,
-   "..plus an item for the error",
+   qr/\Q$Data::Dumper::VERSION/,
+   "..and the expected D::D version"
 );
 
+#@requests = ();
+#my ($out) = full_output( sub { Pingback::pingback('http://www.percona.com/fake_url', undef, $fake_ua) } );
+# 
+
+use DSNParser;
+use Sandbox;
+my $dp  = DSNParser->new(opts=>$dsn_opts);
+my $sb  = Sandbox->new(basedir => '/tmp', DSNParser => $dp);
+my $dbh = $sb->get_dbh_for('master');
+SKIP: {
+   skip 'Cannot connect to sandbox master', 3 unless $dbh;
+
+   my (undef, $mysql_version)
+      = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'");
+   my (undef, $mysql_version_comment)
+      = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'");
+      
+   @requests = ();
+   Pingback::pingback('http://www.percona.com/fake_url', $dbh, $fake_ua);
+
+   like(
+      $requests[0]->{content},
+      qr/\Q$v/,
+      "Second request has the expected version of Perl"
+   );
+
+   like(
+      $requests[0]->{content},
+      qr/\Q$mysql_version_comment $mysql_version/,
+      "..and gets the MySQL version"
+   );
+}
+
 done_testing;