[gimp-perl] Add registry_viewer.
- From: Ed J <edj src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp-perl] Add registry_viewer.
- Date: Wed, 28 May 2014 20:38:48 +0000 (UTC)
commit 7423d67d40f638dcf37ba5e46fb94383abe32d64
Author: Ed J <edj src gnome org>
Date: Wed May 28 21:38:10 2014 +0100
Add registry_viewer.
MANIFEST | 1 +
Makefile.PL | 1 +
examples/Makefile.PL | 1 +
examples/registry_viewer | 352 ++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 355 insertions(+), 0 deletions(-)
---
diff --git a/MANIFEST b/MANIFEST
index 9eb8aea..059eeb4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -78,6 +78,7 @@ examples/randomart1
examples/randomblends
examples/README
examples/redeye
+examples/registry_viewer
examples/repdup
examples/scratches
examples/selective_sharpen
diff --git a/Makefile.PL b/Makefile.PL
index f3549ff..9cdeb3d 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -52,6 +52,7 @@ WriteMakefile(
ExtUtils::PkgConfig => 0,
Gtk2::Ex::PodViewer => 0,
IO::Scalar => 0,
+ Web::Scraper => 0,
},
META_MERGE => {
"meta-spec" => { version => 2 },
diff --git a/examples/Makefile.PL b/examples/Makefile.PL
index cfabd3e..29cef85 100644
--- a/examples/Makefile.PL
+++ b/examples/Makefile.PL
@@ -11,6 +11,7 @@ our %cfg;
my @pins = qw(
Perl-Server
Perl-Console
+ registry_viewer
dataurl
example-fu
exceptiontest
diff --git a/examples/registry_viewer b/examples/registry_viewer
new file mode 100755
index 0000000..7b126d3
--- /dev/null
+++ b/examples/registry_viewer
@@ -0,0 +1,352 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gimp;
+use Gimp::Fu;
+
+sub process;
+sub scraper(&);
+
+sub filesize_str {
+ my $size = $_[0];
+ ($size > 1099511627776)
+ ? sprintf ( "%.2f TiB", $size/1099511627776 )
+ : ( $size > 1073741824 )
+ ? sprintf ( "%.2f GiB", $size/1073741824 )
+ : ( $size > 1048576 )
+ ? sprintf ( "%.2f MiB", $size/1048576 )
+ : ( $size > 1024 )
+ ? sprintf ( "%.2f KiB", $size/1024 )
+ : ("$size byte" . ( $size == 1 ? "" : "s" ))
+}
+
+sub scraper_init {
+ my $h = {
+ list => scraper {
+ process '#block-system-main div.node > h2', 'content[]' => scraper {
+ process '>a[href]', link => '@href', title => sub { $_->as_trimmed_text }
+ }
+ },
+
+ pager => scraper {
+ process '#block-system-main li.pager-next a[href]', link => '@href'
+ },
+
+ node => scraper {
+ process 'div.node-scriptfu', 'classes' => sub {
+ my $c = $_->attr('class');
+ $c ? +{ map { ($_=>1) } split ' ', $c } : ()
+ },
+ node => scraper {
+ process 'span.submitted', 'submit-date' => sub {
+ (my $x = ($_->content)[0][0]) =~ s/\s*\x{2014}\s*$//;
+ $x
+ };
+ process 'span.submitted > span.username', 'author' => 'TEXT';
+ process '.field-name-body .field-items > .field-item',
+ body => 'TEXT';
+ process '.field-name-upload span.file > a[href]',
+ 'files[]' => scraper {
+ process 'a[href]', name => '@title', link => '@href',
+ desc => 'TEXT',
+ size => sub {
+ $_->attr('type')
+ && $_->attr('type') =~ /length=(\d+)/
+ && $1
+ };
+ };
+ process '.field-type-taxonomy-term-reference',
+ 'taxonomy[]' => scraper {
+ process '.field-label', name => sub {
+ (my $x = lc ($_->as_text)) =~ s/\W+/-/g;
+ $x =~ s/-+$//;
+ $x
+ };
+ process '.field-item > a[href]', 'values[]' => 'TEXT';
+ }
+ }
+ },
+ pos => 0,
+ };
+ 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;
+ }
+}
+
+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} };
+ }
+ }
+ return $stub;
+ }
+ }
+ 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 (my $next = $h->{pager}->scrape($h->{next_uri})) {
+ $h->{next_uri} = URI->new($next->{link});
+ next;
+ } else {
+ delete $h->{next_uri};
+ }
+ }
+ return if !$count && !$h->{next_uri};
+ }
+}
+
+sub filter_plugin {
+ ref ($_[0]) eq 'HASH'
+ and $_[0]{files}
+ and @{ $_[0]{files} }
+ and $_[0]{taxonomy}{'gimp-version'}
+ and ($_[0]{taxonomy}{'gimp-version'}{2.7}
+ || $_[0]{taxonomy}{'gimp-version'}{2.8})
+ and $_[0]
+}
+
+# RETURNS $file, $dir
+sub fetch_file {
+ my ($uri, $dir, $u2lf, $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";
+ } else {
+ warn "couldn't make temp dir: $!";
+ }
+ ()
+}
+
+podregister {
+ require Gimp::Config;
+ require Gtk2::SimpleList;
+ require File::Temp;
+ require URI;
+ require LWP::Simple;
+ require IO::All; IO::All->import;
+ require Web::Scraper; Web::Scraper->import;
+
+ Gimp::gtk_init;
+ my $d = Gtk2::Dialog->new("Browse/Install Plugins", undef,
+ [qw(modal destroy-with-parent)],
+ 'Done' => 'close');
+ $d->set_default_response('close');
+ my $ca = $d->get_content_area;
+
+ my $box1 = Gtk2::VBox->new (FALSE, 2);
+ my $box2 = Gtk2::VBox->new (FALSE, 2);
+ my $box3 = Gtk2::VBox->new (FALSE, 2);
+
+ my $tbl = Gtk2::Table->new(1,2);
+ my $s = Gtk2::ScrolledWindow->new(undef,undef);
+ $s->set_policy ('automatic', 'automatic');
+ $s->set_size_request (300, 500);
+
+ my $t = Gtk2::ScrolledWindow->new(undef,undef);
+ $t->set_policy ('automatic', 'automatic');
+ $t->set_size_request (300, 500);
+
+ my $tv = Gtk2::TextView->new;
+ $tv->set_editable(FALSE);
+ my $b = $tv->get_buffer;
+
+ $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]};
+
+ $l2->destroy() if $l2;
+ $l2 = Gtk2::Table->new($rows+1,3);
+ $l2->attach_defaults(Gtk2::Label->new('Files'), 0, 3, 0, 1);
+ $box2->pack_start($l2,FALSE,TRUE,0);
+ my $r = 1;
+
+ for my $f (@{$nlist[$i][1]}) {
+ $l2->attach_defaults(
+ Gtk2::Label->new(($f->{name} || $f->{desc} || $f->{link})
+ . " (".filesize_str($f->{size}).")"),
+ 0, 1, $r, $r+1);
+
+ $l2->attach(
+ my $vbtn = Gtk2::Button->new("View"), 1, 2, $r, $r+1,
+ 'shrink','fill', 2, 2);
+ $l2->attach(
+ my $ibtn = Gtk2::Button->new ("Install"), 2, 3, $r, $r+1,
+ 'shrink','fill', 2, 2);
+ ++$r;
+
+ my ($dir, %url2localfiles);
+
+ $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('');
+ });
+
+ $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});
+ });
+ }
+ $l2->show_all();
+ $box2->show();
+ });
+
+ $ca->add($box1);
+ $ca->add($box3);
+ $box1->pack_start($tbl,TRUE,TRUE,0);
+ $box1->pack_start($status,FALSE,FALSE,0);
+ $tbl->attach_defaults($s, 0, 1, 0, 1);
+ $tbl->attach_defaults($box2, 1, 2, 0, 1);
+ $box2->pack_start($t,TRUE,TRUE,0);
+ $s->add($list);
+ $t->add($tv);
+
+ $d->show_all();
+ $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__
+
+=head1 NAME
+
+registry_viewer - Browse the gimp plugin registry
+
+=head1 SYNOPSIS
+
+<Toolbox>/Filters/Languages/Browse Pl_ug-in Registry
+
+=head1 DESCRIPTION
+
+Browse scripts from http://registry.gimp.org.
+
+Currently only shows scriptfu scripts compatible with Gimp 2.8.
+
+Requires Web::Scraper.
+
+=head1 PARAMETERS
+
+=head1 AUTHOR
+
+Rain <rain AT terminaldefect DOT com>
+
+=head1 DATE
+
+2014-05-19
+
+=head1 LICENSE
+
+This program is free software: you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation, either version 3 of the License, or (at your option) any later
+version.
+
+This program is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License along with
+this program. If not, see <http://www.gnu.org/licenses/>.
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
