GNOME.org
 

[gimp-perl] Update & test Gimp::Pod

commit f351a9095254787fe48ab0967e6187acc049ace8
Author: Ed J <m8r-35s8eo mailinator com>
Date:   Mon Apr 21 12:14:16 2014 +0100

    Update & test Gimp::Pod

 Gimp/Pod.pm                |  160 ++++++++++++--------------------------------
 MANIFEST                   |    4 +-
 TODO                       |   17 ++++-
 examples/Makefile.PL       |    2 +-
 examples/animate_cells     |    4 -
 examples/dialogtest        |   24 -------
 examples/glowing_steel     |    2 +-
 examples/selective_sharpen |   27 ++-----
 t/gimppod.t                |   26 +++++++
 9 files changed, 95 insertions(+), 171 deletions(-)
---
diff --git a/Gimp/Pod.pm b/Gimp/Pod.pm
index 2a7b79f..c34c7b6 100644
--- a/Gimp/Pod.pm
+++ b/Gimp/Pod.pm
@@ -1,108 +1,53 @@
 package Gimp::Pod;
 
-$VERSION = 2.300001;
-
-sub myqx(&) {
-   local $/;
-   local *MYQX;
-   if (0==open MYQX,"-|") {
-      &{$_[0]};
-      close STDOUT;
-      Gimp::_exit;
-   }
-   <MYQX>;
-}
+use Config;
+use strict;
+use FindBin qw($RealBin $RealScript);
 
-sub find_converters {
-   my $path = eval 'use Config; $Config{installscript}';
+our $VERSION = 2.3001;
 
-   if ($] < 5.00558) {
-      $converter{text} = sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000,       
$pod) } };
-      $converter{texta}= sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, '-a', 
$pod) } };
-   } else {
-      $converter{text} = sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
-      $converter{texta}= sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
-   }
-   $converter{html} = sub { my $pod=shift; require Pod::Html; myqx { Pod::Html::pod2html ($pod) } };
-   $converter{man}  = sub { qx($path/pod2man   $_[0]) } if -x "$path/pod2man" ;
-   $converter{latex}= sub { qx($path/pod2latex $_[0]) } if -x "$path/pod2latex" ;
-}
+warn "$$-Loading ".__PACKAGE__ if $Gimp::verbose;
 
-sub find {
-   -f $0 ? $0 : ();
+{
+package Gimp::Pod::Parser;
+use base 'Pod::Text';
+sub output { shift->{gpp_text} .= join '', @_; }
+sub get_text { $_[0]->{gpp_text} }
 }
 
 sub new {
-   my $pkg = shift;
-   my $self={};
-   return () unless defined($self->{path}=find);
-   bless $self, $pkg;
+   return unless -f "$RealBin/$RealScript";
+   bless { path => "$RealBin/$RealScript", }, $_[0];
 }
 
 sub _cache {
    my $self = shift;
-   my $fmt = shift;
-   if (!$self->{doc}{$fmt} && $converter{$fmt}) {
-      local $^W = 0;
-      my $doc = $converter{$fmt}->($self->{path});
-      undef $doc if $?>>8;
-      undef $doc if $doc=~/^[ \t\r\n]*$/;
-      $self->{doc}{$fmt}=\$doc;
-   }
-   $self->{doc}{$fmt};
+   return $self->{doc} if $self->{doc};
+   my $parser = Gimp::Pod::Parser->new;
+   $parser->parse_from_file($self->{path});
+   $self->{doc} = $parser->get_text;
 }
 
-sub format {
-   my $self = shift;
-   my $fmt = shift || 'text';
-   ${$self->_cache($fmt)};
-}
+sub format { $_[0]->_cache; }
 
-sub sections {
-   my $self = shift;
-   my $doc = $self->_cache('text');
-   $$doc =~ /^\S.*$/mg;
-}
+sub sections { $_[0]->_cache =~ /^\S.*$/mg; }
 
 sub section {
    my $self = shift;
-   my $doc = $self->_cache('text');
-   if (defined $$doc) {
-      ($doc) = $$doc =~ /^$_[0]$(.*?)(?:^[A-Z]|$)/sm;
-      if ($doc) {
-         $doc =~ y/\r//d;
-         $doc =~ s/^\s*\n//;
-         $doc =~ s/[ \t\r\n]+$/\n/;
-         $doc =~ s/^    //mg;
-      }
-      $doc;
-   } else {
-      ();
+   warn __PACKAGE__."::section(@_)" if $Gimp::verbose;
+   return unless defined(my $doc = $self->_cache);
+   ($doc) = $doc =~ /^$_[0]\n(.*?)(?:^[A-Z]|\Z)/sm;
+   if ($doc) {
+      $doc =~ y/\r//d;
+      $doc =~ s/^\s*\n//;
+      $doc =~ s/[\s]+$/\n/;
+      $doc =~ s/^    //mg;
+      chomp $doc;
    }
+   warn __PACKAGE__."::section returning '$doc'" if $Gimp::verbose;
+   $doc;
 }
 
-sub author {
-   my $self = shift;
-   $self->section('AUTHOR');
-}
-
-sub blurb {
-   my $self = shift;
-   $self->section('BLURB') || $self->section('NAME');
-}
-
-sub description {
-   my $self = shift;
-   $self->section('DESCRIPTION');
-}
-
-sub copyright {
-   my $self = shift;
-   $self->section('COPYRIGHT') || $self->section('AUTHOR');
-}
-
-find_converters;
-
 1;
 __END__
 
@@ -113,19 +58,15 @@ Gimp::Pod - Evaluate pod documentation embedded in scripts.
 =head1 SYNOPSIS
 
   use Gimp::Pod;
-
-  $pod = new Gimp::Pod;
-  $text = $pod->format ();
-  $html = $pod->format ('html');
-  $synopsis = $pod->section ('SYNOPSIS');
-  $author = $pod->author;
-  @sections = $pod->sections;
+  my $pod = Gimp::Pod->new;
+  my $text = $pod->format;
+  my $synopsis = $pod->section('SYNOPSIS');
+  my @sections = $pod->sections;
 
 =head1 DESCRIPTION
 
 C<Gimp::Pod> can be used to find and parse embedded pod documentation in
-gimp-perl scripts.  At the moment only the formatted text can be fetched,
-future versions might have more interesting features.
+Gimp-Perl scripts, returning formatted text.
 
 =head1 METHODS
 
@@ -133,43 +74,30 @@ future versions might have more interesting features.
 
 =item new
 
-return a new Gimp::Pod object representing the current script or undef, if
+Return a new Gimp::Pod object representing the current script or undef, if
 an error occured.
 
-=item format([$format])
+=item format
 
-Returns the embedded pod documentation in the given format, or undef if no
-documentation can be found.  Format can be one of 'text', 'html', 'man' or
-'latex'. If none is specified, 'text' is assumed.
+Return the embedded pod documentation in text format, or undef if no
+documentation can be found.
 
 =item section($header)
 
-Tries to retrieve the section with the header C<$header>. There is no
-trailing newline on the returned string, which may be undef in case the
-section can't be found.
-
-=item author
-
-=item blurb
-
-=item description
-
-=item copyright
-
-Tries to retrieve fields suitable for calls to the register function.
+Return the section with the header C<$header>, or undef if not
+found. There is no trailing newline on the returned string.
 
 =item sections
 
-Returns a list of paragraphs found in the pod.
+Returns a list of paragraph titles found in the pod.
 
 =back
 
 =head1 AUTHOR
 
-Marc Lehmann <pcg goof com>
+Marc Lehmann <pcg goof com>.
+Rewritten to eliminate external executables by Ed J.
 
 =head1 SEE ALSO
 
-perl(1), Gimp(1),
-
-=cut
+perl(1), L<Gimp>
diff --git a/MANIFEST b/MANIFEST
index c78687f..6a6a479 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -44,7 +44,6 @@ examples/burst
 examples/centerguide
 examples/colorhtml
 examples/dataurl
-examples/dialogtest
 examples/ditherize
 examples/dots
 examples/dust
@@ -139,10 +138,11 @@ po/zh_CN.po
 po/zh_TW.po
 pxgettext
 t/examples-api.pl
+t/gimppod.t
 t/gimpsetup.pl
 t/import.t
-t/loadlib.t
 t/load.t
+t/loadlib.t
 t/netplugin.t
 t/pdl.t
 t/perlplugin.t
diff --git a/TODO b/TODO
index cdf1bcd..af54eb1 100644
--- a/TODO
+++ b/TODO
@@ -1,9 +1,15 @@
-Items as of 2014-03-31 (by Ed J)
+Items as of 2014-04-19 (by Ed J)
+* <Load> and <Save> need any registration as such done in Gimp::Fu - see pod
+* image in Gimp.pm POD http://perlmaven.com/how-to-add-images-to-cpan -
+  input image -> output image of a plugin
+* longer example in Gimp.pm/SYNOPSIS
+* examples POD (and Gimp::Pod TLC)
+* Add Gimp::existing (Gimp::Fu IMAGE) and ::become (examples/xachshadows)
 * Gimp/Lib.xs is huge, and not very XS-y - lots of it is manually
   pushing GIMP data structures onto perl stack and vice versa. Figure
   way to pass GIMP data back and forth directly via typemap system. May
   involve a gimp-perl "wrapper" data structure that pairs an SV with its
-  GimpPDBArgType/GimpParamDef counterpart - Gimp::Lib::Data?
+  GimpParam counterpart - Gimp::Lib::Data?
 * gimp-perl website: maybe just gimp.org/glossary entry - only needs
   links to CPAN, bugzilla, git - make sure CPAN has all POD docs
   - https://mail.gnome.org/mailman/listinfo/gimp-developer-list
@@ -13,11 +19,14 @@ Items as of 2014-03-31 (by Ed J)
 * http://search.cpan.org/dist/Glib-Object-Introspection/
 * Add a gtk2 gimp-perl console - cf http://registry.gimp.org/node/29348
   - gimp/plug-ins/script-fu/script-fu-console.c
-* Test menupath <File> etc
+* Test Gimp::Fu menupath <Load>/<Save>/<Image>/<Toolbox>/<None>
 * "IGNORE THIS MESSAGE" - $in_top - whole quiet_die probably needs to go too
 * PS flags are obsolete - replace with verbose - set_trace may also be obsolete
+* interactive collab image-editing:
+  http://users.telenet.be/blendix/verse/#gimp_plugin
+  https://github.com/verse/verse/wiki/Tutorial-Simple-C-Verse-Client
+  http://graphicdesign.stackexchange.com/questions/25077/how-can-i-collaborate-using-gimp2
 
 Legacy notes from Seth Burgess:
 * Win32 port
-* Improve documentation quality - feedback desired!
 * Figure out i18n some day.
diff --git a/examples/Makefile.PL b/examples/Makefile.PL
index cca769d..d9fe551 100644
--- a/examples/Makefile.PL
+++ b/examples/Makefile.PL
@@ -8,7 +8,7 @@ require '../config.pl';
 @pins = qw(
   Perl-Server
   dataurl
-  dialogtest
+  example-fu
   exceptiontest
   colorhtml
   fade-alpha
diff --git a/examples/animate_cells b/examples/animate_cells
index 0ae8072..2298082 100755
--- a/examples/animate_cells
+++ b/examples/animate_cells
@@ -129,10 +129,6 @@ on top of it which represent your "cells".
 
 Written in 1999 (c) by Aaron Sherman E<lt>ajs ajs comE<gt>
 
-=head1 BUGS
-
-TBD
-
 =head1 SEE ALSO
 
 L<gimp>, L<perl>, L<Gimp>: the Gimp module for perl.
diff --git a/examples/glowing_steel b/examples/glowing_steel
index c529a7f..6f79820 100755
--- a/examples/glowing_steel
+++ b/examples/glowing_steel
@@ -319,7 +319,7 @@ register
   N_"<Image>/File/Create/Logos/Glowing Steel",
   undef,
   [
-   [PF_STRING, "string", "string", "GET LOST"],
+   [PF_STRING, "string", "String", "GET LOST"],
    # The font in the poster was like "cobalt extended"
    [PF_FONT, "font", "Font", "Bitstream Charter Bold"],
    [PF_SPINNER, "size", "Size", 100, [0, 3000, 1]],
diff --git a/examples/selective_sharpen b/examples/selective_sharpen
index 845488d..eee809b 100755
--- a/examples/selective_sharpen
+++ b/examples/selective_sharpen
@@ -3,43 +3,32 @@
 use Gimp ":auto";
 use Gimp::Fu;
 
-sub SOBEL()        {0}
-sub PREWITT()      {1}
-sub GRADIENT()     {2}
-sub ROBERTS()      {3}
-sub DIFFERENTIAL() {4}
-sub LAPLACE()      {5}
-
 # Gimp::set_trace(TRACE_ALL);
 
 sub my_code {
     my ($img,$original_layer,$sharpen_radius,$sharpen_amt,$sharpen_threshold) = @_;
-    my $edge_layer;
-    my $saved_selection;
-    my @selbounds;
 
     # sanity stuff
-    $original_layer->is_layer || die "Can only operate on layers";
+    die "Can only operate on layers" unless $original_layer->is_layer;
+    $original_layer->become('Gimp::Layer');
+
     $img->undo_group_start;
 
-    @selbounds = $img->selection_bounds;
-    if ($selbounds[0] == 0) # if empty
-      {
-       $img->selection_all;
-      }
+    my @selbounds = $img->selection_bounds;
+    $img->selection_all if $selbounds[0] == 0;
 
-    $saved_selection = $img->selection_save;
+    my $saved_selection = $img->selection_save;
     $img->selection_none;
 
     # 1) take the original photo, duplicate the layer
-    $edge_layer = $original_layer->Gimp::Layer::copy(1);
+    my $edge_layer = $original_layer->Gimp::Layer::copy(1);
     $img->insert_layer($edge_layer,0,-1);
 
     # 2) convert the copy to grayscale
     $edge_layer->desaturate;
 
     # 3) run edge detect to the gray layer (default works)
-    $edge_layer->edge(2.0, 3, 0);
+    $edge_layer->edge(2.0, 2, 0);
 
     # 4) blur it slightly
     $edge_layer->gauss_iir2(3.0, 3.0);
diff --git a/t/gimppod.t b/t/gimppod.t
new file mode 100644
index 0000000..186944a
--- /dev/null
+++ b/t/gimppod.t
@@ -0,0 +1,26 @@
+use Test::More;
+#$Gimp::verbose = 1;
+require Gimp::Pod;
+
+my $p = Gimp::Pod->new;
+ok($p, 'obj init');
+is_deeply([ $p->sections ], [ qw(NAME VERBATIM OTHER) ], 'sections');
+is($p->section('NAME'), 'test - Run some tests', 'sect name');
+is($p->section('VERBATIM'), " verbatim\n verbatim2", 'sect verbatim');
+is($p->section('OTHER'), 'Other text.', 'sect at eof');
+
+done_testing;
+__END__
+
+=head1 NAME
+
+test - Run some tests
+
+=head1 VERBATIM
+
+ verbatim
+ verbatim2 
+
+=head1 OTHER
+
+Other text.
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]