view release on metacpan or  search on metacpan

lib/Gimp/Pod.pm  view on Meta::CPAN

}

sub _cache {
   my $self = shift;
   return $self->{doc} if $self->{doc};
   $self->{doc} = Pod::Simple::SimpleTree->new->parse_file($self->{path})->root;
}

sub sections {
  my ($self, $sub) = @_;
  my $doc = $self->_cache;
  if (defined $sub) {
    my $i = 2; # skip 'Document' and initial attrs
    $i++ until
      $i >= @$doc or ($doc->[$i]->[0] eq 'head1' and $doc->[$i]->[2] eq $sub);
    return if $i >= @$doc;
    my $i2 = ++$i;
    $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] =~ /^head1/;
    $i2--;
    map { $_->[2] } grep { ref and $_->[0] eq 'head2' } @{$doc}[$i..$i2];
  } else {
    map $_->[2], grep { ref eq 'ARRAY' and $_->[0] eq 'head1' } @$doc;
  }
}

sub _flatten_para {
  my $para = shift;
  join '', map { ref($_) ? _flatten_para($_) : $_ } @{$para}[2..$#{$para}];
}

sub section {
  my $self = shift;
  warn "$$-".__PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
  return unless defined(my $doc = $self->_cache);
  my $i = 2; # skip 'Document' and initial attrs
  my $depth = 0;
  while (defined(my $sec = shift)) {
    $depth++;
    $i++ until
      $i >= @$doc or
      ($doc->[$i]->[0] eq "head$depth" and $doc->[$i]->[2] eq $sec);
    return if $i >= @$doc;
  }
  my $i2 = ++$i;
  $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] =~ /^head/;
  $i2--;
  my $text = join "\n\n", map { _flatten_para($_) } @{$doc}[$i..$i2];
  warn "$$-".__PACKAGE__."::section returning '$text'" if $Gimp::verbose >= 2;
  $text;
}

sub lazy_image_params { ([&Gimp::PDB_IMAGE, "image", "Input image"],
  [&Gimp::PDB_DRAWABLE, "drawable", "Input drawable", '%a']); }
sub lazy_load_params  { ([&Gimp::PDB_STRING, "filename", "Filename"],
  [&Gimp::PDB_STRING, "raw_filename", "User-given filename"]); }
sub lazy_save_params  { (&lazy_image_params, &lazy_load_params); }
sub lazy_image_retval { [&Gimp::PDB_IMAGE, "image", "Output image"]; }
sub insert_params {
   my @p = @_;
   die __<<EOF unless $p[6] =~ /^<(?:Image|Load|Save|Toolbox|None)>/;
Menupath must start with <Image>, <Load>, <Save>, <Toolbox>, or <None>!
(got '$p[6]')
EOF
   if ($p[6] =~ /^<Image>\//) {
      if ($p[7]) {
         unshift @{$p[8]}, &lazy_image_params;
      } else {
         # undef or ''
         unshift @{$p[9]}, &lazy_image_retval
            if !@{$p[9]} or $p[9]->[0]->[0] != &Gimp::PDB_IMAGE;
      }
   } elsif ($p[6] =~ /^<Load>\//) {
      my ($start, $label, $fileext, $prefix) = split '/', $p[6];
      $prefix = '' unless $prefix;
      Gimp::on_query { Gimp->register_load_handler($p[0], $fileext, $prefix); };
      $p[6] = join '/', $start, $label;
      unshift @{$p[8]}, &lazy_load_params;
      unshift @{$p[9]}, &lazy_image_retval;
   } elsif ($p[6] =~ /^<Save>\/(.*)/) {
      my ($start, $label, $fileext, $prefix) = split '/', $p[6];
      $prefix = '' unless $prefix;
      Gimp::on_query { Gimp->register_save_handler($p[0], $fileext, $prefix); };
      $p[6] = join '/', $start, $label;
      unshift @{$p[8]}, &lazy_save_params;
   } elsif ($p[6] =~ m#^<Toolbox>/Xtns/#) {
      undef $p[7];
   } elsif ($p[6] =~ /^<None>/) {
      undef $p[6]; undef $p[7];
   }
   @p;
}

my %IND2SECT = (
   2 => 'DESCRIPTION', 3 => 'AUTHOR', 4 => 'LICENSE',
   5 => 'DATE', 6 => 'SYNOPSIS', 7 => 'IMAGE TYPES',
   8 => 'PARAMETERS', 9 => 'RETURN VALUES',
);
sub _getpod { $_[0] ||= new __PACKAGE__; $_[0]->section($_[1]); }
sub _patchup_eval ($$) {
   my ($label, $text) = @_;
   no strict;
   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, '' 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); }
   for my $i (8, 9) {
      my $s = $IND2SECT{$i};
      $p[$i] = $p[$i] ? ref $p[$i] ? $p[$i] : [ _patchup_eval $s, $p[$i] ] : [];
   }