view release on metacpan or  search on metacpan

lib/Gimp.pm  view on Meta::CPAN

   my @export;

   # make sure we can call GIMP functions - start net conn if required
   my $net_init;
   map { $net_init = $1 if /net_init=(\S+)/; } @_;
   if ($interface_type eq "net" and not &Gimp::Net::initialized) {
      map { *{"Gimp::$_"} = \&{"Gimp::Constant::$_"} }
	 qw(RUN_INTERACTIVE RUN_NONINTERACTIVE);
      Gimp::Net::gimp_init(grep {defined} $net_init);
   }
   # do this here as not guaranteed access to GIMP before
   require Gimp::Constant;
   if (not defined &{$Gimp::Constant::EXPORT[-1]}) {
     warn "$$-Loading constants" if $Gimp::verbose >= 2;
     # now get constants from GIMP
     import Gimp::Constant;
   }

   @_=@_default unless @_;

   for(map { $_ eq ":DEFAULT" ? @_default : $_ } @_) {
      if ($_ eq ":auto") {
         push @export,@Gimp::Constant::EXPORT,@_procs;
         *{"$up\::AUTOLOAD"} = sub {
            croak "Cannot call '$AUTOLOAD' at this time" unless initialized();
            my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
            *{$AUTOLOAD} = sub { unshift @_, 'Gimp'; $AUTOLOAD = "Gimp::$name"; goto &AUTOLOAD };
            #*{$AUTOLOAD} = sub { Gimp->$name(@_) }; # old version
            goto &$AUTOLOAD;
         };
      } elsif ($_ eq ":pollute") {
	for my $class (@POLLUTE_CLASSES) {
	  push @{"$class\::ISA"}, "Gimp::$class";
	  push @{"$class\::PREFIXES"}, @{"Gimp::$class\::PREFIXES"};
	}
      } elsif ($_ eq ":consts") {
         push @export,@Gimp::Constant::EXPORT;
      } elsif ($_ eq ":param") {
         push @export,@Gimp::Constant::PARAMS;
      } elsif (/^interface=(\S+)$/) {
         croak __"interface=... tag is no longer supported\n";
      } elsif (/spawn_options=(\S+)/) {
         $spawn_opts = $1;
      } elsif (/net_init=(\S+)/) {
	 # already used above, no-op
      } elsif ($_ ne "") {
         push(@export,$_);
      } elsif ($_ eq "") {
         #nop #d#FIXME, Perl-Server requires this!
      } else {
         croak __"$_ is not a valid import tag for package $pkg";
      }
   }

   for(@export) {
      *{"$up\::$_"} = \&$_;
   }
}

# the monadic identity function
sub N_($) { shift }

my $gtk_init = 1;

sub gtk_init() {
   if ($gtk_init) {
      require Gtk2;
      Gtk2->init;
      Gtk2::Rc->parse (Gimp->gtkrc);
      $gtk_init = 0;
   }
}

# section on command-line handling/interface selection

($basename = $0) =~ s/^.*[\\\/]//;
$spawn_opts = "";
($function)=$0=~/([^\/\\]+)$/;

$Gimp::verbose=0 unless defined $Gimp::verbose;
# $Gimp::verbose=1;

$interface_type = "net";
if (@ARGV) {
   if ($ARGV[0] eq "-gimp") {
      $interface_type = "lib";
      # ignore other parameters completely
   } else {
      while(@ARGV) {
         $_=shift(@ARGV);
         if (/^-h$|^--?help$|^-\?$/) {
            $Gimp::help=1;
            print __<<EOF;
Usage: $basename [gimp-args...] [interface-args...] [script-args...]
       gimp-arguments are
           -h | -help | --help | -?   print some help
           -v | --verbose             verbose flag (ok more than once)
           --host|--tcp HOST[:PORT]   connect to HOST (optionally using PORT)
                                      (for more info, see Gimp::Net(3))
EOF
         } elsif (/^-v$|^--verbose$/) {
            $Gimp::verbose++;
         } elsif (/^--host$|^--tcp$/) {
            $host=shift(@ARGV);
         } else {
            unshift(@ARGV,$_);
            last;
         }
      }
   }
}

# section on error-handling

# section on callbacks

my %callback;

sub cbchain {
  map { @{$callback{$_} || []}; } @_;
}