[gimp-perl] make registry_viewer use IO::Async

[Ed J <edj src gnome org>]

commit 8f3903918f240c3ebeba457c2f48aae4c16df6ee
Author: Rain <rain terminaldefect com>
Date:   Fri Jun 20 09:34:51 2014 -0500

    make registry_viewer use IO::Async
    
    Signed-off-by: Ed J <edj src gnome org>

 examples/registry_viewer |  245 ++++++++++++++++++++++++----------------------
 1 files changed, 127 insertions(+), 118 deletions(-)
---
diff --git a/examples/registry_viewer b/examples/registry_viewer
index 9aadd0f..ea31447 100755
--- a/examples/registry_viewer
+++ b/examples/registry_viewer
@@ -23,6 +23,8 @@ sub filesize_str {
 }
 
 sub scraper_init {
+  my ($sldata) = @_;
+  # TODO: die unless $sl
   my $h = {
     list => scraper {
       process '#block-system-main div.node > h2', 'content[]' => scraper {
@@ -49,7 +51,8 @@ sub scraper_init {
            body => 'TEXT';
            process '.field-name-upload span.file > a[href]',
            'files[]' => scraper {
-             process 'a[href]', name => '@title', link => '@href',
+             process 'a[href]', name => '@title',
+             link => sub { "". $_->attr('href') },
              desc => 'TEXT',
              size => sub {
                $_->attr('type')
@@ -68,56 +71,67 @@ sub scraper_init {
            }
         }
    },
+    sl => $sldata,
     pos => 0,
+    q_uri => [],
+    plugins => [],
   };
-  my $uri = URI->new( "http://registry.gimp.org/taxonomy/term/20"; );
-  if (my $r_stubs = $h->{list}->scrape($uri)) {
-    $h->{stubs} = $r_stubs->{content};
-    if (my $next = $h->{pager}->scrape($uri)) {
-      $h->{next_uri} = URI->new($next->{link});
-    }
-    return $h;
-  }
+  return unless $h->{loop} = IO::Async::Loop::Glib->new;
+  return unless $h->{ua} = Net::Async::HTTP->new(stall_timeout => 30);
+  $h->{loop}->add($h->{ua});
+
+  $h->{ua}->do_request(
+    uri => URI->new("http://registry.gimp.org/taxonomy/term/20";),
+    on_response => sub {
+      my ($rsp) = @_;
+      die "found no plugins in registry!" # maybe don't die?
+       unless my $r_stubs = $h->{list}->scrape($rsp);
+      get_plugin ($h, $_) for @{ $r_stubs->{content} };
+      if (my $r_page = $h->{pager}->scrape($rsp)) {
+        get_page ($h, $r_page->{link});
+      }
+    },
+    on_fail => sub { die "couldn't contact registry! ", $_[0] });
+  return $h;
 }
 
-sub get_next_plugin {
-  my ($h) = @_;
-  return unless $h && $h->{list};
-  while (1) {
-    while (@{ $h->{stubs} }) {
-      $h->{pos}++;
-      my $stub = shift @{ $h->{stubs} };
-      if (my $r_node = $h->{node}->scrape ($stub->{link})) {
-        if ($r_node->{node}) {
-          $stub->{$_} = $r_node->{node}{$_} for keys %{ $r_node->{node} };
-          if ($stub->{taxonomy}) {
-            my $tx = {};
-            for my $t ( @{ $stub->{taxonomy} }) {
-              $tx->{$t->{name}} = +{ map { ($_=>1) } @{ $t->{values} }};
-            }
-            $stub->{taxonomy} = $tx;
-            @{ $stub->{files} }
-            = grep $_->{link} =~ /\.scm$/, @{ $stub->{files} };
-          }
+sub get_plugin {
+  my ($h, $p) = @_;
+  $h->{ua}->do_request (
+    uri => $p->{link},
+    on_response => sub {
+      my ($rsp) = @_;
+      return unless my $r_node = $h->{node}->scrape ($rsp);
+      return unless $r_node->{node};
+      my %node = (%$p, %{ $r_node->{node} });
+      if ($node{taxonomy}) {
+        my $tx = {};
+        for my $t ( @{ $node{taxonomy} }) {
+          $tx->{$t->{name}} = +{ map { ($_=>1) } @{ $t->{values} }};
         }
-        return $stub;
+        $node{taxonomy} = $tx;
+        @{ $node{files} }
+        = grep $_->{link} =~ /\.scm$/, @{ $node{files} };
       }
-    }
-    my $count;
-    if ($h->{next_uri}) {
-      if (my $r_page = $h->{list}->scrape($h->{next_uri})) {
-        push @{ $h->{stubs} }, @{ $r_page->{content} };
-        $count = @{ $r_page->{content} };
+      if (filter_plugin (\%node)) {
+        push @{$h->{sl}}, $node{title};
+        push @{$h->{plugins}}, [$node{body}, $node{files}];
       }
-      if (my $next = $h->{pager}->scrape($h->{next_uri})) {
-        $h->{next_uri} = URI->new($next->{link});
-        next;
-      } else {
-        delete $h->{next_uri};
+    });
+}
+
+sub get_page {
+  my ($h, $uri) = @_;
+  $h->{ua}->do_request (
+    uri => $uri,
+    on_response => sub {
+      my ($rsp) = @_;
+      return unless my $r_stubs = $h->{list}->scrape($rsp);
+      get_plugin ($h, $_) for @{ $r_stubs->{content} };
+      if (my $r_page = $h->{pager}->scrape($rsp)) {
+        get_page ($h, $r_page->{link});
       }
-    }
-    return if !$count && !$h->{next_uri};
-  }
+    });
 }
 
 sub filter_plugin {
@@ -130,26 +144,36 @@ sub filter_plugin {
   and $_[0]
 }
 
-# RETURNS $file, $dir
-sub fetch_file {
-  my ($uri, $dir, $u2lf, $file) = @_;
+sub do_file {
+  my ($h, $uri, $dir, $u2lf, $cb, $fcb) = @_;
+  my $file;
   return unless $uri = URI->new($uri);
-  # (warn "already fetched file: $file"),
-  return ($file, $dir)
-   if ($u2lf && ($file = $u2lf->{$uri}) && -r $file && -s $file);
-
-  $dir = undef if $dir && !-w $dir;
-  if ($dir ||= File::Temp->newdir()) {
-    # warn LWP::Simple::get($uri);
-    my $rc = LWP::Simple::getstore(
-      $uri->as_string, $file = "$dir/".($uri->path_segments)[-1]);
-    # (warn "fetched file: $file"),
-    return ($u2lf->{$uri} = $file, $dir)
-     if (LWP::Simple::is_success($rc) && -s $file);
-
-    warn "couldn't fetch '$uri' to '$file': $rc";
+
+  if ($u2lf && ($file = $u2lf->{$uri}) && -r $file && -s $file) {
+    $cb->($file, $dir);
+    return $dir;
   } else {
-    warn "couldn't make temp dir: $!";
+    $dir = undef if $dir && !-w $dir;
+    if ($dir ||= File::Temp->newdir()) {
+      $u2lf->{$uri} = $file = "$dir/".($uri->path_segments)[-1];
+      $h->{ua}->do_request (
+        uri => $uri,
+        on_response => sub {
+          my ($rsp) = @_;
+          my $txt = $rsp->content;
+          if (open my $fh, '>', $file) {
+            print $fh $txt;
+            close $fh;
+            $cb->($file, $dir, $txt);
+          } else {
+            warn "couldn't write to $file: $!";
+          }
+        },
+        $fcb ? (on_fail => $fcb): ());
+      return $dir;
+    } else {
+      warn "couldn't make temp dir: $!";
+    }
   }
   ()
 }
@@ -160,10 +184,19 @@ podregister {
   require File::Temp;
   require URI;
   require LWP::Simple;
-  require IO::All; IO::All->import;
-  require Web::Scraper; Web::Scraper->import;
+  require IO::All;         IO::All->import;
+  require Web::Scraper;    Web::Scraper->import;
+  require IO::Async::Loop::Glib; IO::Async::Loop::Glib->import;
+  require Net::Async::HTTP;
 
   Gimp::gtk_init;
+
+  my $list = Gtk2::SimpleList->new('Script' => 'text');
+
+  die "Failed to initialize!"
+   unless my $s_hash = scraper_init ($list->{data});
+
+
   my $d = Gtk2::Dialog->new("Browse/Install Plugins", undef,
                             [qw(modal destroy-with-parent)],
                             'Done' => 'close');
@@ -189,19 +222,16 @@ podregister {
 
   $tbl->set_border_width(6);
   $tbl->set_col_spacings(6);
-  my $list = Gtk2::SimpleList->new('Script' => 'text');
   my $l2;
   my $status = Gtk2::Label->new('');
 
-  my @nlist;
-
   $list->signal_connect (
     cursor_changed => sub {
       my ($i) = $_[0]->get_selected_indices();
       $tv->set_cursor_visible(FALSE);
       $tv->set_wrap_mode('word');
-      $b->set_text($nlist[$i][0]);
-      my $rows = @{$nlist[$i][1]};
+      $b->set_text($s_hash->{plugins}[$i][0]);
+      my $rows = @{$s_hash->{plugins}[$i][1]};
 
       $l2->destroy() if $l2;
       $l2 = Gtk2::Table->new($rows+1,3);
@@ -209,7 +239,7 @@ podregister {
       $box2->pack_start($l2,FALSE,TRUE,0);
       my $r = 1;
 
-      for my $f (@{$nlist[$i][1]}) {
+      for my $f (@{$s_hash->{plugins}[$i][1]}) {
         $l2->attach_defaults(
           Gtk2::Label->new(($f->{name} || $f->{desc} || $f->{link})
           . " (".filesize_str($f->{size}).")"),
@@ -228,30 +258,38 @@ podregister {
         $vbtn->signal_connect(
           clicked => sub {
             $status->set_text('fetching: '.$f->{link});
-            (my $file, $dir) = fetch_file($f->{link}, $dir,
-                                          \%url2localfiles);
-            return unless $file;
-            if (my $text = io($file)->all) {
-              $tv->set_cursor_visible(TRUE);
-              $tv->set_wrap_mode('none');
-              $b->set_text($text);
-            }
-            $status->set_text('');
+            $status->set_text("couldn't fetch $f->{link}")
+             unless $dir = do_file (
+               $s_hash, $f->{link}, $dir, \%url2localfiles,
+               sub {
+                 my ($file, $dir, $txt) = @_;
+                 if ($txt ||= io($file)->all) {
+                   $tv->set_cursor_visible(TRUE);
+                   $tv->set_wrap_mode('none');
+                   $b->set_text($txt);
+                 }
+                 $status->set_text('');
+               });
           });
 
         $ibtn->signal_connect(
           clicked => sub {
             $status->set_text('fetching: '.$f->{link});
-            (my $file, $dir) = fetch_file($f->{link}, $dir,
-                                          \%url2localfiles);
-            return unless $file;
-              $status->set_text('installing: '.$f->{name}||$f->{desc});
-            die "couldn't $Gimp::Config{GIMPTOOL} --install-script $file: $!"
-             unless
-             system ($Gimp::Config{GIMPTOOL}, '--install-script', $file) == 0;
-            $status->set_text('installed, refreshing');
-            Gimp->script_fu_refresh();
-            $status->set_text("installed ". $f->{name}||$f->{desc});
+            $status->set_text("couldn't install $f->{link}")
+             unless $dir = do_file (
+               $s_hash, $f->{link}, $dir, \%url2localfiles,
+               sub {
+                 my ($file, $dir) = @_;
+                 $status->set_text('installing: '.$f->{name}||$f->{desc});
+                 die ("couldn't $Gimp::Config{GIMPTOOL} ",
+                      "--install-script $file: $!")
+                  unless system ($Gimp::Config{GIMPTOOL},
+                                 '--install-script', $file) == 0;
+                 $status->set_text('installed, refreshing');
+                 Gimp->script_fu_refresh();
+                 $status->set_text("installed ". $f->{name}||$f->{desc});
+                 ()
+               });
           });
       }
       $l2->show_all();
@@ -272,42 +310,13 @@ podregister {
   $box2->hide();
   $box3->hide();
 
-  die "Failed to load web scraper, sorry."
-   unless my $s_hash = scraper_init();
-
-  Glib::Idle->add(
-    sub {
-      $status->set_text('');
-      if (my $p_hash = get_next_plugin($s_hash)) {
-        $status->set_text(
-          "checking $p_hash->{title}" .
-          ($p_hash->{taxonomy} && $p_hash->{taxonomy}{'gimp-version'}
-           ? (" (Gimp " . join (
-                ',', sort keys %{$p_hash->{taxonomy}{'gimp-version'}})
-              . ")")
-           : ''));
-        # print "got: ", Dumper ($p_hash);
-        if (filter_plugin ($p_hash)) {
-          push @{ $list->{data} }, $p_hash->{title};
-          push @nlist, [$p_hash->{body}, $p_hash->{files}];
-        }
-        # print "USING\n" if filter_plugin ($p_hash);
-        @nlist > 39 ? $status->set_text('') && 0 : 1;
-      }
-    });
-
   my $rsp = $d->run;
   $d->destroy;
 
   ()
 };
+
 exit main;
-# if (my $s = scraper_init) {
-#   my $i = 0;
-#   while (my $h = get_next_plugin($s)) {
-#     print $h->{title}, "\n";
-#   }
-# }
 
 __END__