File Coverage

blib/lib/OS2/SoftInstaller.pm

Criterion	Covered	Total	%
statement	15	58	25.8
branch	0	18	0.0
condition	0	5	0.0
subroutine	5	8	62.5
pod	2	2	100.0
total	22	91	24.1

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 <

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

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

#  print <#

#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) ? <
  REPLACEINUSE = 'D I R U',
EOI

    $out{$relname} .= <
  DATE = $date,
  TIME = $time,
  SIZE = $size,
  PWSPATH = '$dirid'
EOO
  };

  print <

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 <

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


  print <

* 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 <

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__