package SymMake; use lib $ENV{RAZZLETOOLPATH} . "\\PostBuildScripts"; use lib $ENV{RAZZLETOOLPATH}; use strict; use Carp; use IO::File; use Data::Dumper; use File::Basename; use File::Find; use Logmsg; # Data structure # pdbname.binext => [(var)pdbpath,size,$binext] my ($DDFHandle, $CATHandle, $INFHandle); my %pktypes = ( FULL => 'ARCH', UPDATE => 'NTPB' ); my %revpktypes = reverse %pktypes; sub new { my $class = shift; my $instance = { KB => { "$pktypes{'FULL'}" => $_[0], "$pktypes{'UPDATE'}" => $_[1] }, SYM => {}, EXT => {}, HANDLE => {}, PKTYPE => undef }; return bless $instance, $class; } sub ReadSource { my ($self, $symbolcd) = @_; my ($fh, $kbterm, $mykey, @mylist); local $_; $kbterm = $pktypes{$self->{'PKTYPE'}}; $symbolcd = "$self->{'KB'}->{$kbterm}\\symbolcd\\symbolcd.txt" if (!defined $symbolcd); $symbolcd = "$ENV{TEMP}\\symbolcd.txt" if (!-e $symbolcd); if ($self->{'PKTYPE'} =~ /FULL/i) { if (-e $symbolcd) { # reuse ($self->{'SYM'}, $self->{'EXT'}) = @{do $symbolcd}; } else { # create one $self->HashArchServer($self->{'KB'}->{$kbterm}); # reuse $Data::Dumper::Indent=1; $Data::Dumper::Terse=1; $fh = new IO::File $symbolcd, 'w'; if (!defined $fh) { logmsg "Cannot open $symbolcd\."; } else { print $fh 'return ['; print $fh Dumper($self->{'SYM'}); print $fh ",\n"; print $fh Dumper($self->{'EXT'}); print $fh '];'; $fh->close(); } } } else { $self->HashSymbolCD($symbolcd); } return; # # $Data::Dumper::Indent=1; # $Data::T # print Dumper($self->{'SYM'}, qw(sym) } sub HashSymbolCD { my ($self, $file) = @_; my ($fh, $bin, $symbol, $subpath, $installpath, $kbterm); local $_; $kbterm = $pktypes{$self->{'PKTYPE'}}; $fh = new IO::File $file; if (!defined $fh) { logmsg "Cannot open symbolcd.txt ($file)"; return; } while(<$fh>) { chomp; ($bin,$symbol,$subpath,$installpath)=split(/\,/,$_); next if (!defined $installpath); $self->{'SYM'}->{lc"$symbol\.$installpath"} = [$kbterm, "\\" . $subpath, (-s $self->{'KB'}->{$kbterm} . '\\' . $subpath), lc$installpath]; for (keys %pktypes) { $self->{'EXT'}->{$_}->{lc$installpath} = 1; } } $fh->close(); } sub HashArchServer { my ($self, $path) = @_; my ($fh, $bin, $symbol, $subpath, $installpath, $kbterm, $pdbsize); local $_; $kbterm = $pktypes{$self->{'PKTYPE'}}; $fh = new IO::File "dir /s/b/a-d $path\\*.*|"; if (!defined $fh) { logmsg "Cannot access to $path\."; } while (<$fh>) { chomp; $pdbsize = (-s); $_ = substr($_, length($path) + 1); /\\/; ($symbol, $subpath, $installpath) = ($',$_,$`); $self->{'SYM'}->{lc"$symbol\.$installpath"} = [$kbterm, '\\' . $subpath, $pdbsize, $installpath]; $self->{'EXT'}->{$self->{'PKTYPE'}}->{$installpath} = 1; } $fh->close(); } # # pkinfoptr-> # FULL -> # CDFNAME => # INFNAME => # sub Create_Symbols_CDF { my ($self, $pkinfoptr) = @_; my ($mykbterm, $mypkname, $fhandle, $fullpdb, %mywriter); local $_; &Open_Private_Handle($pkinfoptr, 'CDF'); for $mypkname (keys %{$pkinfoptr}) { if ($mypkname ne 'FULL') { $mywriter{$mypkname} = &Writer($pkinfoptr->{$mypkname}->{'CDFHANDLE'}, $pkinfoptr->{'FULL'}->{'CDFHANDLE'}); } else { $mywriter{$mypkname} = &Writer($pkinfoptr->{'FULL'}->{'CDFHANDLE'}); } &Create_CDF_Head($pkinfoptr->{$mypkname}->{'CDFHANDLE'}, $pkinfoptr->{$mypkname}->{'CATNAME'}, $pkinfoptr->{$mypkname}->{'INFNAME'}); } for (sort keys %{$self->{'SYM'}}) { $mykbterm = $self->{'SYM'}->{$_}->[0]; $mypkname = $revpktypes{$mykbterm}; $fullpdb = $self->{'KB'}->{$mykbterm} . $self->{'SYM'}->{$_}->[1]; &{$mywriter{$mypkname}}("\" . $fullpdb . '=' . $fullpdb . "\n"); } &Close_Private_Handle($pkinfoptr, 'CDF'); } # # pkinfoptr-> # FULL -> # CABNAME => # CABDEST => # CABSIZE => # DDFLIST => (return cab list) # sub Create_Symbols_DDF { my ($self, $pkinfoptr) = @_; my ($symkey, $symptr, $kbterm, $subpath, $pktype, $mypkinfoptr, $cabname, $ddfname, $cabcount, $DDFHandle, $myddfname, $mycabname); local $_; # initialization map({$_->{'CURSIZE'} = $_->{'CABSIZE'}} values %{$pkinfoptr}); for (sort keys %{$self->{'SYM'}}) { $symkey = $_; $symptr = $self->{'SYM'}->{$_}; ($kbterm, $subpath) = ($symptr->[0],$symptr->[1]); $pktype = $revpktypes{$kbterm}; # don't generate something not specify next if (!exists $pkinfoptr->{$pktype}); $mypkinfoptr = $pkinfoptr->{$pktype}; $mypkinfoptr->{'CURSIZE'}+=$symptr->[2]; if ($mypkinfoptr->{'CURSIZE'} >= $mypkinfoptr->{'CABSIZE'}) { $mypkinfoptr->{'CURSIZE'} = $symptr->[2]; ($cabname, $ddfname, $cabcount) = ( $mypkinfoptr->{'CABNAME'}, $mypkinfoptr->{'DDFNAME'}, ++$mypkinfoptr->{'CABCOUNT'} ); $myddfname = $ddfname . $cabcount . '.ddf'; $mycabname = $cabname . $cabcount . '.cab'; $mypkinfoptr->{'DDFHANDLE'} = new IO::File $myddfname, 'w'; if (!defined $mypkinfoptr->{'DDFHANDLE'}) { logmsg "Cannot open DDF file $myddfname\."; } &Create_DDF_Head($mypkinfoptr->{'DDFHANDLE'}, $mycabname); $mypkinfoptr->{'DDFLIST'}->{$myddfname} = $mycabname; } $DDFHandle = $mypkinfoptr->{'DDFHANDLE'}; print $DDFHandle '"' . $self->{'KB'}->{$kbterm} . $subpath . '" "' . $symkey . "\"\n"; } &Close_Private_Handle($pkinfoptr, 'DDF'); } # # pkinfoptr-> # FULL -> # INFNAME => # CDFNAME => # sub Create_Symbols_INF { my ($self, $pkinfoptr) = @_; my ($mypkname, $mypkinfoptr, $INFHandle, %mywriter, %mysepwriter, %h, %cabnames); local $_; &Open_Private_Handle($pkinfoptr, 'INF'); for $mypkname (keys %{$pkinfoptr}) { ($mypkinfoptr, $INFHandle) = ($pkinfoptr->{$mypkname}, $pkinfoptr->{$mypkname}->{'INFHANDLE'}); if ($mypkname ne 'FULL') { $mywriter{$mypkname} = &Writer($INFHandle, $pkinfoptr->{'FULL'}->{'INFHANDLE'}); } else { $mywriter{$mypkname} = &Writer($INFHandle); } $mysepwriter{$mypkname} = &Writer($INFHandle); &Create_INF_Version($INFHandle, $mypkinfoptr->{'CATNAME'}); &Create_INF_Install($INFHandle, $self->{'EXT'}->{$mypkname}); $cabnames{$mypkname} = (FileParse($mypkinfoptr->{'CABNAME'}))[0]; } &Create_INF_Files($self->{'SYM'}, \%mysepwriter, \%mywriter); &Create_INF_SourceDisks($self->{'SYM'}, \%cabnames, \%mysepwriter, \%mywriter); &Close_Private_Handle($pkinfoptr, 'INF'); } sub Create_DDF_Head { my ($DDFHandle, $cabname) = @_; my ($mycabname, $mycabdest) = FileParse($cabname); print $DDFHandle <$infname\.inf=$infname\.inf CDFHEAD } sub Create_INF_Version { my ($INFHandle, $catname) = @_; $catname = (FileParse($catname))[0]; print $INFHandle <{$a}->[3] cmp $symptr->{$b}->[3]) or ($a cmp $b)} keys %{$symptr}) { $mykbterm = $symptr->{$_}->[0]; $mypkname = $revpktypes{$mykbterm}; if ($symptr->{$_}->[3] ne $tags{$mypkname}->[0]) { $tags{$mypkname} = [$symptr->{$_}->[3], - length($symptr->{$_}->[3]) -1]; &{$sepwriter->{$mypkname}}("\n\[Files\.$tags{$mypkname}->[0]\]\n"); } if ($symptr->{$_}->[3] ne $tags{'FULL'}->[0]) { $tags{'FULL'} = [$symptr->{$_}->[3], - length($symptr->{$_}->[3]) -1]; &{$sepwriter->{'FULL'}}("\n\[Files\.$tags{'FULL'}->[0]\]\n"); } &{$popwriter->{$mypkname}}(substr($_, 0, $tags{$mypkname}->[1]) . "\,$_\,\,4\n"); } } sub Create_INF_SourceDisks { my ($symptr, $cabnameptr, $sepwriter, $popwriter) = @_; # $pkinfoptr) = @_; my ($INFHandle, $cabname, $mypkname); local $_; for (keys %{$cabnameptr}) { $cabname = $cabnameptr->{$_}; &{$sepwriter->{$_}}(<{$_}->[0]}; &{$popwriter->{$mypkname}}($_ . "=1\n"); } } # # $pkinfoptr-> # $pktype -> # CABNAME # DDFNAME # INFNAME # CDFNAME # CATNAME # CABSIZE # # CABHANDLE # DDFHANDLE # INFHANDLE # # CABLIST # sub RegisterPackage { my ($pkinfoptr, $pktype, $hptr) = @_; my ($mykey); my @chklists = qw(CABNAME DDFNAME INFNAME CDFNAME CATNAME CABSIZE); $pkinfoptr->{$pktype} = $hptr; for $mykey (@chklists) { die "$mykey not defined in $pktype" if (!exists $pkinfoptr->{$pktype}->{$mykey}); } } sub Writer { my (@handles) = @_; my ($hptr)=\@handles; return sub { my ($myhandle); for $myhandle (@{$hptr}) { print $myhandle $_[0]; } }; } sub Open_Private_Handle { my ($pkinfoptr, $ftype) = @_; my ($pkname); for $pkname (keys %{$pkinfoptr}) { $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'} = new IO::File $pkinfoptr->{$pkname}->{$ftype . 'NAME'} . '.' . $ftype, 'w'; if (!defined $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}) { logmsg "Cannot open " . $pkinfoptr->{$pkname}->{$ftype . 'NAME'} . '.' . $ftype . "."; } } } sub Close_Private_Handle { my ($pkinfoptr, $ftype) = @_; my ($pkname); for $pkname (keys %{$pkinfoptr}) { $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}->close() if (defined $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}); delete $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}; } } sub FileParse { my ($name, $path, $ext) = fileparse(shift, '\.[^\.]+$'); $ext =~ s/^\.//; return $name, $path, $ext; } 1;