make_pdmp.pl

по многочисленным просьбам - запчасть от моей системы тестирования, которая ездит по директориям, качает .pdb и делает .pdmp файлы
Модуль PEIdent я в силу врожденной паранойи выкусил - нечего вам знать какие файлы оно у меня знает, бгг
Батник get_pdb.bat идентичен приведенному ранее

#!perl -w
# Lame script to check presence of .pdb & .pdmp file in some dirtree
# 11 Jul 2010 (C) RedPlait

use strict;
use warnings;
use FindBin qw($Bin);
use lib $Bin;

require File::Spec::Win32;
use File::Find;
use Getopt::Std;
# use PEIdent;

use vars qw/$opt_a $opt_v/;

# constants

my $pdbdump_path = 'C:/work/wintestz/bin/pdbdump.exe';
my $get_pdb      = 'get_pdb.bat';

sub usage
{
    print STDERR <<EOF;

Usage is $0 [options] dir(s)
Options:
  -a -- all files
  -v -- verbose mode
EOF
    exit (8);
}

# get short file name
# return 1 if this file has some known extension 

sub is_known_file
{
  my $fname = shift;
  return 1 if ( $fname !~ /\.([^\.\\\/]+)$/ );
  my $ext = lc($1);
  return 1 if ( ($ext eq 'idb') ||
                ($ext eq 'pl')  ||
                ($ext eq 'i64') ||
                ($ext eq 'idc') ||
                ($ext eq 'pdb') ||
                ($ext eq 'pdmp')
              );
  return 0 if ( defined $opt_a );
#  my $res = PEIdent::is_known($fname);
#  return !$res;
  return 0;
}

sub make_pdb_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.pdb/;
  return $fname;
}

sub make_pdmp_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.pdmp/;
  return $fname;
}

sub parse_log
{
  my $fh;
  open($fh, '<', 'log') or return;
  my($str, $res);
  while( $str = <$fh> )
  {
    chomp $str;
    next if ( $str =~ /^\[SYMCHK\]|^DBGHELP:/ );
    if ( $str =~ /^PdbFilename\s+(.*)$/ )
    {
      $res = $1;
      last;
    }
  }
  close $fh;
  return $res;
}

sub make_pdbs
{
  my $fname = $_;
  return if ( $fname eq '.' or
              $fname eq '..' or
              -d $fname
            );
  my $short_fname = (File::Spec->splitpath($fname))[2];
  return if ( is_known_file $short_fname );
  # check if we already have .pdb for this file
  my $pdb = make_pdb_name $fname;
  if ( ! -f $pdb )
  {
    unlink 'log' if -f 'log';
    printf("PDB needed for %s\n", $fname) if defined $opt_v;
    `get_pdb $fname`;
    my $pdb_real = parse_log();
    if ( !defined($pdb_real) or ! -f $pdb_real )
    {
      printf("Cannot download PDB for %s\n", $fname);
      return;
    } else {
      rename($pdb_real, $pdb);
      printf("Download PDB %s for %s\n", $pdb_real, $fname) if defined $opt_v;
    }
  }
  # check if we already have .pdmp for this file
  my $pdmp = make_pdmp_name $fname;
  if ( ! -f $pdmp )
  {
    printf("PDMP needed for %s\n", $fname) if defined $opt_v;
    `$pdbdump_path $pdb > $pdmp`;
    if ( -s $pdmp )
    {
      printf("PDMP %s for %s\n", $pdmp, $fname) if defined $opt_v;
    } else {
      printf("Cannot make PDMP %s for %s\n", $pdmp, $fname);
      unlink $pdmp;
    }
  }
}

# MAIN

my $status = getopts("av");
usage() if ($status == 0);
find( {
    wanted => \&make_pdbs, no_chdir => 1
  }, $_) foreach @ARGV;