#!/usr/bin/perl

=cut

=head1 NAME

embedxpm - embed xpm pictures into perl source

=head1 SYNOPSIS

 embedxpm picture.xpm perl_source picture_name

=head1 DESCRIPTION

embedxpm can be used to embed xpm pictures directly into a perl program. To
do this, your program source has to contain some markers (in the form of
ocmments) that describe the position where the picture should be inserted.
To only insert the xpm data, use this form:

 #%XPM:<name of xpm>%
 <your xpm data goes here>
 #%XPM%<what to attach to the end of the data>

Here is an example (taken from the Gimp/PDB program):
 
 # create the logo pixmap for the given widget
 sub create_logo($) {
    new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d(
       $_[0]->window,
       $_[0]->style->black,
       #%XPM:logo%
       'xpm data', 'xpm data...',...
       #%XPM%
    ))
 }

To insert the xpm with the name example.xpm into this source you would have
to use the following commandline:

 embedxpm example.xpm source.pl logo

I<WARNING:> embedxpm happily overwrites your source, without leaving a
backup-copy around(!). If anything goes wrong (for example when you left out
the end comment) your source may be lost, so better make a backup before. I
am not responsible for your data-loss!

=head1 SWITCHES

None ;)

=back

=head1 AUTHOR

Marc Lehmann <pcg@goof.com>

=cut

use File::Slurp;

$VERSION=1.0002;

if (@ARGV != 3) {
   die "Usage: $0 xpm_file perl_source picture_name\n";
}

$xpm=$ARGV[0];
$file=$ARGV[1];
$id=$ARGV[2];

$verbose=1;

$columns=80;

sub stringify {
   my $s=shift;
   my $r=$s.shift;
   my @r;
   while(@_) {
      if (length($r)+length($_[0])>=$columns) {
         push(@r,$r); $r="$s".shift;
      } else {
         $r.=", ".shift;
      }
   }
   join(",\n",@r,$r);
}

open XPM,"<$xpm\0" or die "$xpm: $!\n";
<XPM>=~/^\/\*\s+XPM\s+\*\/$/ or die "$xpm: not a valid xpm file\n";
<XPM>=~/^static\s+char\s+\*\s+(\S+?)(?:_xpm)?\[\]\s+=\s+{$/ or die "$xpm: not a valid xpm file\n";
$xpm_name=$1;

print STDERR "found xpm $xpm_name\n" if $verbose;

while(<XPM>) {
   y/\t/ /;
   s/'/\\\'/g;
   last unless /\"([^"]*)\"/;
   push(@xpm,"'$1'");
}

close XPM;

$patch=read_file($file);

$patch=~s/^(\s*)(#%XPM:$id%\n).*?(^\s*#%XPM%)(.*?)$/"$1$2".stringify($1,@xpm)."$4\n$3$4"/esmg;

write_file("$file~",$patch);
chmod((stat($file))[2],"$file~") or die;
rename "$file~",$file or die;