The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package OS2::SoftInstaller;

use strict;
use vars qw($VERSION @ISA @EXPORT);

require Exporter;

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	     make_pkg
	     size_date_time_pkg
	    );
$VERSION = '0.09';


# Preloaded methods go here.
use Config '%Config';
use File::Find 'find';
use strict;

sub size_date_time_pkg {
    my $file = shift;
    my $time = $^T - 24 * 60 * 60 * (-M $file) ;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $time;
    my $yy = sprintf('%02d', $year%100);
    my $mm = sprintf('%02d', $mon + 1);
    my $dd = sprintf('%02d', $mday);
    my $hh = sprintf('%02d', $hour);
    my $mn = sprintf('%02d', $min);
    my $ss = sprintf('%02d', $sec);
    return (-s _, "$yy$mm$dd", "$hh$mn");
}

sub make_pkg {
  my %args = @_;
  my ($toplevel, $zipfile, $packid, $nozip, $exclude, $dirid, $strip) = 
    @args{qw(toplevel zipfile packid nozip exclude dirid strip)};
  $strip ||= '';
  $toplevel =~ s,\\,/,g ;
  $toplevel =~ s,/$,, ;
  my $toplevelq = "\Q$toplevel/$strip";
  my (%seen, %out, %duplicates, %seen_duplicates, $file);
  unless (defined $packid) {
    ($packid) = ($zipfile =~ /([\w.]+)\./);
    $packid =~ s/\./_/g;
  }
  
# SOURCE ID PACKID keywords do not take variable substitution:
#  print <<EOPT if defined $packtoken;

#FILE
#  EXIT = 'setvar $packtoken=$packtoken'
#EOPT

#  my $zipid = ($packtoken || "my") . "_zip";

#  print <#<EOPT;

#FILE
#  EXIT = 'setvar $zipid=$zipfile'
#EOPT

#  $zipfile = "%$zipid%";

  my $wanted = sub {
    -f or return;
    my ($size, $date, $time) = size_date_time_pkg($_);
    my $relname = $File::Find::name;
    $relname =~ s/^$toplevelq// 
      or die "Cannot find `^$toplevelq' in `$relname'";	# Top directory does not match, but is skipped by -f
    my ($shortname) = ($relname =~ m,([^/]+)$, );
    $seen{ lc $shortname }++;
    $out{$relname} = ($relname =~ /\.(exe|dll)$/i) ? <<EOI : '' ;
  REPLACEINUSE = 'D I R U',
EOI
    
    $out{$relname} .= <<EOO;
  DATE = $date,
  TIME = $time,
  SIZE = $size,
  PWSPATH = '$dirid'
EOO
  };

  print <<EOP unless $nozip;	# Multiple components in the same zipfile

PACKFILE
  ID = '$packid',
  SOURCE = 'DRIVE: $zipfile',
  * -j circumvents a limitation of SI
  UNPACK = '%UNZIP% %EPFICURUPS% %UNZIP_D% %EPFICURUPDIR%'
EOP

  find($wanted, $toplevel);

 Dups:
  for $file (keys %out) {
    my ($shortname) = ($file =~ m,([^/]+)$, );
    if ($seen{ lc $shortname } > 1) {
      $duplicates{$file}++;
      next Dups;
    }
  }
  
 Bulk:
  for $file (sort keys %out) {
    next Bulk if defined $exclude and $file =~ /$exclude/;
    $seen_duplicates{$file}++, next Bulk if $duplicates{$file};

    # Good for bulk replacement
    print <<EOP;

FILE
  PWS = '$file',
  PACKID = '$packid',
$out{$file}
EOP
  }


  print <<EOP if %seen_duplicates;

* The following files need a special treatment since their names
* would conflict with -j extraction from .zip.
EOP

 One_by_one:
  for $file (sort keys %seen_duplicates) {
    # Now do it one-by-one
    print <<EOP;

FILE
  PWS = '$file',
  SOURCE = 'DRIVE: $zipfile',
  UNPACK = '%UNZIP% %EPFICURUPS% %UNZIP_D% %EPFICURUPDIR% $strip$file',
$out{$file}
EOP
  }
 
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

OS2::SoftInstaller - Perl extension for generation of daughter
packages for IBM's Software Installer.

=head1 SYNOPSIS

  use OS2::SoftInstaller;
  open PKG, '>my.pkg';
  select PKG;
  make_pkg toplevel => '.', zipfile => 'my.zip', packid => 'myzip', 
    nozip => 0, exclude => undef, dirid => 'FILE', strip => 'emx/';
  select STDOUT;
  close PKG;

=head1 DESCRIPTION

=head2 I<size_date_time_pkg(name)>

Takes file name, returns an array C<($size, $date,$time)>, suitable for
C<SIZE>, C<DATE>, and C<TIME> entries of SoftInstaller.

=head2 I<make_pkg(...)>

The function make_pkg() takes a hash-like list of arguments. The
recognized keys are:

=over 10

=item toplevel

toplevel directory of the tree to duplicate.

=item zipfile

name of the zipfile which corresponds to this directory in the distribution.

=item packid

symbolic name for this zipfile, autogenerated if needed.

=item nozip

Do not generate toplevel description of the ZIP file (useful if the
same zipfile is used in multiple components).

=item exclude

if defined, is a regexp for files to exclude from the generated
package file.

=item dirid

id of the directory to install to (eg, FILE or AUX7).

=item strip

prefix in all the files in the ZIP file which should be removed. It is
supposed that the default value for the directory to install to (eg,
FILE or AUX7) already contains this prefix. (Useful to make the ZIP
file appropriate for manual install as well.)

=back

We suppose that C<%unzip%> has the value of something like C<unzip -oj>,
C<%unzip_d%> is something like C<-d> (directory to extract),
and the output of this script is included like this:

 FILE
   EXIT = 'setvar unzip=unzip -oj'

 FILE
   EXIT = 'setvar unzip_d=-d'

 INCLUDE
   NAME = 'my.pkg'

into the parent package file.

=head1 AUTHOR

Ilya Zakharevich, ilya@math.ohio-state.edu

=head1 SEE ALSO

perl(1).

=cut