[gimp-perl] Move fixup_args into Gimp::Pod.

From: Ed J <edj src gnome org>
To: commits-list gnome org
Cc:
Subject: [gimp-perl] Move fixup_args into Gimp::Pod.
Date: Sat, 3 May 2014 03:06:56 +0000 (UTC)
commit 14080bff911d92c9579e90d1f8ff53e3328f1a69
Author: Ed J <edj src gnome org>
Date:   Sat May 3 04:06:40 2014 +0100

    Move fixup_args into Gimp::Pod.

 Gimp/Fu.pm  |   61 ++++++++-------------------
 Gimp/Pod.pm |  133 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 151 insertions(+), 43 deletions(-)
---
diff --git a/Gimp/Fu.pm b/Gimp/Fu.pm
index 2656f03..3d7298c 100644
--- a/Gimp/Fu.pm
+++ b/Gimp/Fu.pm
@@ -1,6 +1,7 @@
 package Gimp::Fu;
 
 use Gimp::Data;
+use Gimp::Pod;
 use File::Basename;
 use strict;
 use Carp qw(croak carp);
@@ -108,12 +109,9 @@ my %IND2SECT = (
 my $podreg_re = qr/(\bpodregister\s*{)/;
 FILTER {
    return unless /$podreg_re/;
-   my @p = fixup_args(('') x 9, 1);
-   return unless @{$p[9]};
-   my $myline = 'my ('.join(',', map { '$'.$_->[1] } @{$p[9]}).') = @_;';
-   warn __PACKAGE__."::FILTER_ONLY: $myline" if $Gimp::verbose;
+   my $myline = make_arg_line(insert_params(fixup_args(('') x 9, 1)));
    s/$podreg_re/$1\n$myline/;
-   warn __PACKAGE__."::FILTER_ONLY: found: '$1'" if $Gimp::verbose;
+   warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose;
 };
 
 @EXPORT_OK = qw($run_mode save_image);
@@ -273,49 +271,25 @@ Gimp::on_query {
    }
 };
 
-sub podregister (&) { unshift @_, ('') x 9; goto &register; }
-sub getpod ($$) {
-   require Gimp::Pod; $_[0] ||= new Gimp::Pod; $_[0]->section($_[1]);
-}
-# inserts type after imagetypes
-sub fixup_args {
+sub insert_params {
    my @p = @_;
-   my $pod;
-   splice @p, 9, 0, [ eval (getpod($pod, 'RETURN VALUES') // '') ] if @p == 10;
-      die $@ if $@;
-   croak sprintf
-      __"register called with too many or wrong arguments: wanted 11, got %d(%s)",
-      scalar(@p),
-      join(' ', @p),
-      unless @p == 11;
-   @p[0,1] = (getpod($pod,'NAME')//'') =~ /(.*?)\s*-\s*(.*)/ unless $p[0] or $p[1];
-   ($p[0]) = File::Basename::fileparse($RealScript, qr/\.[^.]*/) unless $p[0];
-   while (my ($k, $v) = each %IND2SECT) { $p[$k] ||= getpod($pod, $v); }
-   $p[8] ||= [
-      eval "package main;\n#line 0 \"$0 PARAMETERS\"\n".
-        (getpod($pod, 'PARAMETERS') // '')
-   ]; die $@ if $@;
-   for my $i (0..6, 10) {
-      croak "$0: Need arg $i (or POD ".($IND2SECT{$i}//'')." section)" unless $p[$i]
-   }
    die __<<EOF unless $p[6] =~ /^<(?:Image|Load|Save|Toolbox|None)>/;
 Menupath must start with <Image>, <Load>, <Save>, <Toolbox>, or <None>!
 (got '$p[6]')
 EOF
-   splice @p, 8, 0, Gimp::PLUGIN;
    if ($p[6] =~ /^<Image>\//) {
       if ($p[7]) {
-        unshift @{$p[9]}, @image_params;
+         unshift @{$p[8]}, @image_params;
       } else {
-        # undef or ''
-        unshift @{$p[10]}, $image_retval
-           if ! {$p[10]} or $p[10]->[0]->[0] != PF_IMAGE;
+         # undef or ''
+         unshift @{$p[9]}, $image_retval
+            if ! {$p[9]} or $p[9]->[0]->[0] != PF_IMAGE;
       }
    } elsif ($p[6] =~ /^<Load>\//) {
-      unshift @{$p[9]}, @load_params;
-      unshift @{$p[10]}, $image_retval;
+      unshift @{$p[8]}, @load_params;
+      unshift @{$p[9]}, $image_retval;
    } elsif ($p[6] =~ /^<Save>\//) {
-      unshift @{$p[9]}, @save_params;
+      unshift @{$p[8]}, @save_params;
    } elsif ($p[6] =~ m#^<Toolbox>/Xtns/#) {
       undef $p[7];
    } elsif ($p[6] =~ /^<None>/) {
@@ -324,11 +298,11 @@ EOF
    @p;
 }
 
-#(func,blurb,help,author,copyright,date,menupath,imagetypes,params,return,code)
+sub podregister (&) { unshift @_, ('') x 9; goto &register; }
 sub register($$$$$$$$$;@) {
    no strict 'refs';
    my ($function, $blurb, $help, $author, $copyright, $date, $menupath,
-       $imagetypes, $type, $params, $results, $code) = fixup_args(@_);
+       $imagetypes, $params, $results, $code) = insert_params(fixup_args(@_));
    for my $p (@$params,@$results) {
       next unless ref $p;
       croak __"$function: argument/return value '$p->[1]' has illegal type '$p->[0]'"
@@ -338,9 +312,7 @@ sub register($$$$$$$$$;@) {
    }
 
    $function="perl_fu_".$function unless $function =~ /^(?:perl_fu_|extension_|plug_in_|file_)/ || $function 
=~ s/^\+//;
-
    $function=~/^[0-9a-z_]+(-ALT)?$/ or carp(__"$function: function name contains unusual characters, good 
style is to use only 0-9, a-z and _");
-
    carp __"function name contains dashes instead of underscores\n"
       if $function =~ y/-//;
 
@@ -427,7 +399,8 @@ sub register($$$$$$$$$;@) {
 
    Gimp::register_callback($function,$perl_sub);
    push(@scripts,[$function,$blurb,$help,$author,$copyright,$date,
-                  $menupath,$imagetypes,$type,$params,$results,$perl_sub]);
+               $menupath,$imagetypes,Gimp::PLUGIN,$params,$results,$perl_sub]);
+
 }
 
 sub save_image($$) {
@@ -615,7 +588,9 @@ All these parameters except the code-ref can be replaced with C<''>, in
 which case they will be substituted with appropriate values from various
 sections (see below) of the POD documentation in your script.
 
-It is B<highly> recommended you use the L</PODREGISTER> interface.
+It is B<highly> recommended you use the L</PODREGISTER> interface,
+unless you wish to have more than one interface (i.e. menu entry) to
+your plugin, with different parameters.
 
 =over 2
 
diff --git a/Gimp/Pod.pm b/Gimp/Pod.pm
index ccbd43d..a6d8448 100644
--- a/Gimp/Pod.pm
+++ b/Gimp/Pod.pm
@@ -1,13 +1,19 @@
 package Gimp::Pod;
 
 use Config;
+use Carp qw(croak carp);
 use strict;
 use FindBin qw($RealBin $RealScript);
+use File::Basename;
+use base 'Exporter';
 
+our @EXPORT = qw(fixup_args make_arg_line);
 our $VERSION = 2.3002;
 
 warn "$$-Loading ".__PACKAGE__ if $Gimp::verbose;
 
+sub __ ($) { goto &Gimp::__ }
+
 {
 package Gimp::Pod::Parser;
 use base 'Pod::Text';
@@ -48,6 +54,51 @@ sub section {
    $doc;
 }
 
+my %IND2SECT = (
+   2 => 'DESCRIPTION', 3 => 'AUTHOR', 4 => 'LICENSE',
+   5 => 'DATE', 6 => 'SYNOPSIS', 7 => 'IMAGE TYPES',
+);
+sub _getpod { $_[0] ||= new __PACKAGE__; $_[0]->section($_[1]); }
+sub _patchup_eval ($$) {
+   my ($label, $text) = @_;
+   my @result = eval "package main;\n#line 0 \"$0 $label\"\n" . ($text // '');
+   die $@ if $@;
+   @result;
+}
+sub fixup_args {
+   my @p = @_;
+   my $pod;
+   splice @p, 9, 0, [ _patchup_eval 'RETURN VALUES', _getpod($pod, 'RETURN VALUES') ] if @p == 10;
+   croak sprintf
+      __"register given wrong number of arguments: wanted 11, got %d(%s)",
+      scalar(@p),
+      join(' ', @p),
+      unless @p == 11;
+   @p[0,1] = (_getpod($pod,'NAME')//'') =~ /(.*?)\s*-\s*(.*)/ unless $p[0] or $p[1];
+   ($p[0]) = File::Basename::fileparse($RealScript, qr/\.[^.]*/) unless $p[0];
+   while (my ($k, $v) = each %IND2SECT) { $p[$k] ||= _getpod($pod, $v); }
+   $p[8] ||= [ _patchup_eval 'PARAMETERS', _getpod($pod, 'PARAMETERS') ];
+   for my $i (0..6, 10) {
+      croak "$0: Need arg $i (or POD ".($IND2SECT{$i}//'')." section)" unless $p[$i]
+   }
+   for my $val (@{$p[8]}, @{$p[9]}) {
+      croak __"$p[0]: argument/return '$val->[1]' has illegal type '$val->[0]'"
+       unless int($val->[0]) eq $val->[0];
+      carp __"$p[0]: argument name '$val->[1]' contains illegal characters, only 0-9, a-z and _ allowed"
+       unless $val->[1]=~/^[0-9a-z_]+$/;
+   }
+   @p;
+}
+
+sub make_arg_line {
+   my @p = @_;
+   return '' unless @{$p[8]};
+   die "$0: parameter had empty string\n" if grep { !length $_->[1] } @{$p[8]};
+   my $myline = 'my ('.join(',', map { '$'.$_->[1] } @{$p[8]}).') = @_;';
+   warn __PACKAGE__."::make_arg_line: $myline" if $Gimp::verbose;
+   $myline;
+}
+
 1;
 __END__
 
@@ -63,11 +114,93 @@ Gimp::Pod - Evaluate pod documentation embedded in scripts.
   my $synopsis = $pod->section('SYNOPSIS');
   my @sections = $pod->sections;
 
+  my @args = fixup_args(@register_args);
+
 =head1 DESCRIPTION
 
 C<Gimp::Pod> can be used to find and parse embedded pod documentation in
 Gimp-Perl scripts, returning formatted text.
 
+=head1 FUNCTIONS
+
+=over 4
+
+=item fixup_args
+
+C<fixup_args> is exported by default. It takes a list of arguments,
+and for all the scalar arguments, will (if they are false) extract them
+from various parts of the calling script's POD documentation, and then
+return the fixed-up list:
+
+=over 4
+
+=item $function
+
+Defaults to the NAME section of the POD, the part B<before> the first
+C<->. Falls back to the script's filename.
+
+=item $blurb
+
+Defaults to the NAME section of the POD, the part B<after> the first C<->.
+
+=item $help
+
+Defaults to the DESCRIPTION section of the POD.
+
+=item $author
+
+Defaults to the AUTHOR section of the POD.
+
+=item $copyright
+
+Defaults to the LICENSE section of the POD.
+
+=item $date
+
+Defaults to the DATE section of the POD.
+
+=item $menupath
+
+Defaults to the SYNOPSIS section of the POD.
+
+=item $imagetypes
+
+Defaults to the "IMAGE TYPES" section of the POD.
+
+=item $params
+
+Defaults to the "PARAMETERS" section of the POD, passed to C<eval>, e.g.:
+
+  =head PARAMETERS
+
+    [ PF_COLOR, 'color', 'Colour', 'black' ],
+    [ PF_FONT, 'font', 'Font', 'Arial' ],
+
+You don't B<have> to indent it so that POD treats it as verbatim, but
+it will be more readable in any POD viewer if you do.
+
+=item $results
+
+Defaults to the "RETURN VALUES" section of the POD, passed to C<eval>.
+Not providing the relevant POD section is perfectly valid, so long as
+you intend to return no values.
+
+=item $other
+
+Untouched. Must be supplied - will normally be the code reference.
+
+=back
+
+=item make_arg_line
+
+C<make_arg_line> is exported by default. It is used by source filters
+in L<Gimp::Fu> and L<Gimp::Extension> to generate the line inserted at
+the start of functions passed to C<podregister>. It takes as arguments,
+the output of C<fixup_args>, and returns the text to be inserted (possibly
+an empty string).
+
+=back
+
 =head1 METHODS
 
 =over 4
[Date Prev][Date Next] [Thread Prev][Thread Next] [Thread Index] [Date Index] [Author Index]