#!/usr/local/bin/perl -w # -*- perl -*- ###################################################################### # keyprint.pl -- print BioWare key files # Copyright (c) 2004 Tero Kivinen # All Rights Reserved. ###################################################################### # Program: keyprint.pl # $Source: /u/samba/nwn/bin/RCS/keyprint.pl,v $ # Author : $Author: kivinen $ # # (C) Tero Kivinen 2004 # # Creation : 16:02 Aug 14 2004 kivinen # Last Modification : 01:27 May 24 2007 kivinen # Last check in : $Date: 2007/05/23 22:27:14 $ # Revision number : $Revision: 1.3 $ # State : $State: Exp $ # Version : 1.16 # Edit time : 9 min # # Description : Print BioWare key files # # $Log: keyprint.pl,v $ # Revision 1.3 2007/05/23 22:27:14 kivinen # Fixed path splitting to accept windows paths. # # Revision 1.2 2004/09/20 11:45:33 kivinen # Added internal globbing. # # Revision 1.1 2004/08/15 12:36:43 kivinen # Created. # # $EndLog$ # # # # ###################################################################### # initialization require 5.6.0; package KeyPrint; use strict; use Getopt::Long; use File::Glob ':glob'; use KeyRead; use Key; use Time::HiRes qw(time); $Opt::verbose = 0; ###################################################################### # Get version information open(PROGRAM, "<$0") || die "Cannot open myself from $0 : $!"; undef $/; $Prog::program = ; $/ = "\n"; close(PROGRAM); if ($Prog::program =~ /\$revision:\s*([\d.]*)\s*\$/i) { $Prog::revision = $1; } else { $Prog::revision = "?.?"; } if ($Prog::program =~ /version\s*:\s*([\d.]*\.)*([\d]*)\s/mi) { $Prog::save_version = $2; } else { $Prog::save_version = "??"; } if ($Prog::program =~ /edit\s*time\s*:\s*([\d]*)\s*min\s*$/mi) { $Prog::edit_time = $1; } else { $Prog::edit_time = "??"; } $Prog::version = "$Prog::revision." . "$Prog::save_version.$Prog::edit_time"; $Prog::progname = $0; $Prog::progname =~ s/^.*[\/\\]//g; $| = 1; ###################################################################### # Read rc-file if (defined($ENV{'HOME'})) { read_rc_file("$ENV{'HOME'}/.keyprintrc"); } ###################################################################### # Option handling Getopt::Long::Configure("no_ignore_case"); if (!GetOptions("config=s" => \$Opt::config, "verbose|v+" => \$Opt::verbose, "help|h" => \$Opt::help, "version|V" => \$Opt::version) || defined($Opt::help)) { usage(); } if (defined($Opt::version)) { print("\u$Prog::progname version $Prog::version by Tero Kivinen.\n"); exit(0); } while (defined($Opt::config)) { my($tmp); $tmp = $Opt::config; undef $Opt::config; if (-f $tmp) { read_rc_file($tmp); } else { die "Config file $Opt::config not found: $!"; } } ###################################################################### # Main loop $| = 1; my($i, $j, $t0); if (join(";", @ARGV) =~ /[*?]/) { my(@argv); foreach $i (@ARGV) { push(@argv, bsd_glob($i)); } @ARGV = @argv; } foreach $i (@ARGV) { my($key, $filename); $t0 = time(); if ($Opt::verbose) { print("Reading file $i...\n"); } $key = KeyRead::read('filename' => $i); if ($Opt::verbose) { printf("Read done, %g seconds\n", time() - $t0); } printf("File $i, type = %s, version = %s\n", $key->file_type, $key->file_version) if ($Opt::verbose > 1); printf("bif_count = %d, key_count = %d, build_year = %d, day = %s\n", $key->bif_count, $key->key_count, $key->build_year + 1900, $key->build_day) if ($Opt::verbose > 1); for($j = 0; $j < $key->bif_count; $j++) { printf("Filename = %s:%s, size = %d\n", $key->drive($j), $key->file_name($j), $key->file_size($j)); } for($j = 0; $j < $key->key_count; $j++) { printf("Resource = %s.%s, from file %s:%s, index %d\n", $key->resource_reference($j), $key->resource_extension($j), $key->resource_drive($j), $key->resource_filename($j), $key->resource_index($j)); } } exit 0; ###################################################################### # Read rc file sub read_rc_file { my($file) = @_; my($next, $space); if (open(RCFILE, "<$file")) { while () { chomp; while (/\\$/) { $space = 0; if (/\s+\\$/) { $space = 1; } s/\s*\\$//g; $next = ; chomp $next; if ($next =~ s/^\s+//g) { $space = 1; } if ($space) { $_ .= " " . $next; } else { $_ .= $next; } } if (/^\s*([a-zA-Z0-9_]+)\s*$/) { eval('$Opt::' . lc($1) . ' = 1;'); } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*\"([^\"]*)\"\s*$/) { my($key, $value) = ($1, $2); $value =~ s/\\n/\n/g; $value =~ s/\\t/\t/g; eval('$Opt::' . lc($key) . ' = $value;'); } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*(.*)\s*$/) { my($key, $value) = ($1, $2); $value =~ s/\\n/\n/g; $value =~ s/\\t/\t/g; eval('$Opt::' . lc($key) . ' = $value;'); } } close(RCFILE); } } ###################################################################### # mkdir_p sub mkdir_p { my($dir, $mask) = @_; my(@dirs) = split(/\//, $dir); my($d, $i); $d = ''; foreach $i (@dirs) { $d .= $i; mkdir($d, $mask); $d .= "/"; } } ###################################################################### # Usage sub usage { print("Usage: $Prog::progname [--help] [--version] ". "\n\t[--verbose|-v] " . "\n\t[--config config-file] " . "\n\tfilename ...\n"); exit(0); }