1#!/usr/perl5/bin/perl -w 2# 3# CDDL HEADER START 4# 5# The contents of this file are subject to the terms of the 6# Common Development and Distribution License, Version 1.0 only 7# (the "License"). You may not use this file except in compliance 8# with the License. 9# 10# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 11# or http://www.opensolaris.org/os/licensing. 12# See the License for the specific language governing permissions 13# and limitations under the License. 14# 15# When distributing Covered Code, include this CDDL HEADER in each 16# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 17# If applicable, add the following below this CDDL HEADER, with the 18# fields enclosed by brackets "[]" replaced with your own identifying 19# information: Portions Copyright [yyyy] [name of copyright owner] 20# 21# CDDL HEADER END 22# 23# 24# Copyright (c) 1996-2000 by Sun Microsystems, Inc. 25# All rights reserved. 26# 27#ident "%Z%%M% %I% %E% SMI" 28# 29 30# 31# This utility program reads the symcheck output of each binary and 32# creates additional output for then and an overall report. 33# 34 35require 5.005; 36use strict; 37use locale; 38use POSIX qw(locale_h); 39use Sun::Solaris::Utils qw(textdomain gettext); 40use File::Basename; 41use File::Path; 42 43use lib qw(/usr/lib/abi/appcert); 44use AppcertUtil; 45 46setlocale(LC_ALL, ""); 47textdomain(TEXT_DOMAIN); 48 49use vars qw( 50 $tmp_report_dir 51 $misc_check_databases_loaded_ok 52 %result_list_hash 53 %result_msg 54 %warnings_found 55); 56 57set_clean_up_exit_routine(\&clean_up_exit); 58 59import_vars_from_environment(); 60 61signals('on', \&interrupted); 62 63set_working_dir(); 64 65generate_reports(); 66 67clean_up(); 68 69exit 0; 70 71# 72# working_dir has been imported by import_vars_from_environment() 73# A sanity check is performed here to make sure it exists. 74# 75sub set_working_dir 76{ 77 if (! defined($working_dir) || ! -d $working_dir) { 78 exiter("$command_name: " . sprintf(gettext( 79 "cannot locate working directory: %s\n"), $working_dir)); 80 } 81} 82 83# 84# Called when interrupted by user. 85# 86sub interrupted 87{ 88 $SIG{$_[0]} = 'DEFAULT'; 89 signals('off'); 90 clean_up_exit(1); 91} 92 93# 94# Does the cleanup and then exit with return code $rc. Note: The 95# utility routine exiter() will call this routine. 96# 97sub clean_up_exit 98{ 99 my ($rc) = @_; 100 $rc = 0 unless ($rc); 101 102 clean_up(); 103 exit $rc; 104} 105 106# 107# General cleanup activities are placed here. There may not be an 108# immediate exit after this cleanup. 109# 110sub clean_up 111{ 112 if (defined($tmp_report_dir) && -d $tmp_report_dir) { 113 rmtree($tmp_report_dir); 114 } 115} 116 117# 118# Top level routine for generating the additional reports. 119# 120sub generate_reports 121{ 122 # Make a tmp dir for the reporting work. 123 $tmp_report_dir = create_tmp_dir($tmp_dir); 124 125 if (! -d $tmp_report_dir) { 126 exiter(nocreatedir($tmp_report_dir, $!)); 127 } 128 129 pmsg("\n"); 130 print_line(); 131 132 my ($dir, $path_to_object); 133 134 # 135 # Loop over each object item in the working_dir. 136 # - $dir will be each one of these object directories. 137 # - $path_to_object will be the corresponding actual path 138 # to the the binary to be profiled. 139 # Output will be placed down in $dir, e.g. "$dir/report" 140 # 141 142 while (defined($dir = next_dir_name())) { 143 144 # Map object output dir to actual path of the object: 145 $path_to_object = dir_name_to_path($dir); 146 147 # Make a report for it: 148 report_object($path_to_object, $dir); 149 } 150 151 my $type; 152 foreach $type (keys(%result_list_hash)) { 153 $result_list_hash{$type} =~ s/\|+$//; 154 } 155 156 print_report(); 157 my $tout; 158 $tout = gettext( 159 "Additional output regarding private symbols usage and other\n" . 160 "data is in the directory:\n"); 161 162 $tout .= "\n $working_dir\n\n"; 163 164 $tout .= gettext( 165 "see the appcert documentation for more information.\n"); 166 167 pmsg("%s", $tout); 168 169 clean_up(); # Remove any tmp directories and files. 170} 171 172# 173# Examines the symcheck output for a given binary object recording and 174# reporting and problems found. Generates additional reports and 175# summaries. 176# 177sub report_object 178{ 179 my ($object, $dir) = @_; 180 181 my (%problems); 182 183 my $problems_file = "$dir/check.problems"; 184 185 my $problems_fh = do { local *FH; *FH }; 186 open($problems_fh, "<$problems_file") || 187 exiter(nofile($problems_file, $!)); 188 189 # We need the "warning" msgs and text from the Misc Checks loaded: 190 if (! defined($misc_check_databases_loaded_ok)) { 191 $misc_check_databases_loaded_ok = load_misc_check_databases(); 192 } 193 194 my ($prob, $incomp, $c, $w); 195 my $problem_count = 0; 196 my $incomplete_count = 0; 197 my $line_count = 0; 198 199 while (<$problems_fh>) { 200 chomp; 201 $prob = 1; 202 $incomp = 0; 203 $line_count++; 204 205 if (/^DYNAMIC: PRIVATE_SYMBOL_USE\s+(\d*)/) { 206 $problems{'private_syms'} += $1; 207 } elsif (/^DYNAMIC: UNBOUND_SYMBOL_USE\s+(\d*)/) { 208 $problems{'unbound_syms'} += $1; 209 $incomp = 1; 210 } elsif (/^DYNAMIC: UNRECOGNIZED_SYMBOL_USE\s+(\d*)/) { 211 $problems{'unrecognized_syms'} += $1; 212 $incomp = 1; 213 } elsif (/^DYNAMIC: NO_DYNAMIC_BINDINGS_FOUND\s*(.*)$/) { 214 $problems{'no_dynamic_bindings'} .= "$1, "; 215 $incomp = 1; 216 } elsif (/^STATIC: LINKED_ARCHIVE\s+(.*)$/) { 217 $problems{'static_linking'} .= "$1, "; 218 } elsif (/^STATIC: COMPLETELY_STATIC/) { 219 $problems{'completely_static'}++; 220 } elsif (/^MISC: REMOVED_SCOPED_SYMBOLS:\s+(.*)$/) { 221 $problems{'scoped_symbols'} .= "$1, "; 222 } elsif (/^MISC: WARNING:\s+(INCOMPLETE\S+)/) { 223 $problems{'warnings'} .= "$1|"; 224 $incomp = 1; 225 } elsif (/^MISC: WARNING:\s+(.*)$/) { 226 $problems{'warnings'} .= "$1|"; 227 } else { 228 $prob = 0; 229 } 230 $problem_count += $prob; 231 $incomplete_count += $incomp; 232 } 233 close($problems_fh); 234 235 if ($line_count == 0) { 236 # No problems at all, leave a comment message: 237 open($problems_fh, ">$problems_file") || 238 exiter(nofile($problems_file, $!)); 239 print $problems_fh "# NO_PROBLEMS_DETECTED\n"; 240 close($problems_fh); 241 } 242 243 if ($problem_count == 0) { 244 $result_list_hash{'passed'} .= "$object|"; 245 return; 246 } 247 248 if ($incomplete_count == $problem_count) { 249 $result_list_hash{'incomplete'} .= "$object|"; 250 } else { 251 $result_list_hash{'failed'} .= "$object|"; 252 } 253 254 my $m; 255 256 if ($m = $problems{'private_syms'}) { 257 $result_list_hash{'private_syms'} .= "$object|"; 258 $result_msg{$object} .= "$m " . 259 gettext("private symbols") . "; "; 260 } 261 262 if ($m = $problems{'unbound_syms'}) { 263 $result_list_hash{'unbound_syms'} .= "$object|"; 264 $result_msg{$object} .= "$m " . 265 gettext("unbound symbols") . "; "; 266 267 # add this case to the warnings output at end of report. 268 my $tag = 'unbound symbols'; 269 $warnings_found{$tag} .= "$object|"; 270 271 if (! exists($warnings_desc{$tag})) { 272 my $desc = gettext("unbound symbols"); 273 $warnings_desc{$tag} = $desc; 274 } 275 } 276 277 if ($m = $problems{'unrecognized_syms'}) { 278 $result_list_hash{'unrecognized_syms'} .= "$object|"; 279 $result_msg{$object} .= "$m " . 280 gettext("unrecognized symbols") . "; "; 281 282 # Add this case to the warnings output at end of report. 283 my $tag = 'unrecognized symbols'; 284 $warnings_found{$tag} .= "$object|"; 285 286 if (! exists($warnings_desc{$tag})) { 287 my $desc = gettext("unrecognized symbols"); 288 $warnings_desc{$tag} = $desc; 289 } 290 } 291 292 if ($m = $problems{'static_linking'}) { 293 $result_list_hash{'static_linking'} .= "$object|"; 294 $m =~ s/,\s*$//; 295 $result_msg{$object} .= sprintf(gettext( 296 "statically linked with %s"), $m) . "; "; 297 298 # Add this case to the warnings output at end of report. 299 my $tag = 'statically linked'; 300 $warnings_found{$tag} .= "$object|"; 301 302 if (! exists($warnings_desc{$tag})) { 303 my $desc = 304 gettext("static linking of Solaris libraries"); 305 $warnings_desc{$tag} = $desc; 306 } 307 } 308 309 if ($problems{'completely_static'}) { 310 $result_list_hash{'completely_static'} .= "$object|"; 311 $result_msg{$object} .= 312 gettext("completely statically linked") . "; "; 313 314 # Add this case to the warnings output. 315 my $tag = gettext("completely statically linked"); 316 $warnings_found{$tag} .= "$object|"; 317 318 my $desc = 319 gettext("complete static linking of Solaris libraries"); 320 if (! exists($warnings_desc{$tag})) { 321 $warnings_desc{$tag} = $desc; 322 } 323 324 } elsif ($m = $problems{'no_dynamic_bindings'}) { 325 # 326 # Note we skip this error if it is completely static. 327 # The app could technically be SUID as well. 328 # 329 330 $result_list_hash{'no_dynamic_bindings'} .= "$object|"; 331 $m =~ s/,\s*$//; 332 $m = " : $m"; 333 $m =~ s/ : NO_SYMBOL_BINDINGS_FOUND//; 334 $m =~ s/^ :/:/; 335 $result_msg{$object} .= 336 gettext("no bindings found") . "$m; "; 337 } 338 339 if ($m = $problems{'scoped_symbols'}) { 340 $m =~ s/[,\s]*$//; 341 $result_list_hash{'scoped_symbols'} .= "$object|"; 342 $c = scalar(my @a = split(' ', $m)); 343 344 $result_msg{$object} .= "$c " . 345 gettext("demoted (removed) private symbols") . ": $m; "; 346 347 # Add this case to the warnings output. 348 my $tag = 'scoped symbols'; 349 $warnings_found{$tag} .= "$object|"; 350 351 my $desc = gettext( 352 "dependency on demoted (removed) private Solaris symbols"); 353 if (! exists($warnings_desc{$tag})) { 354 $warnings_desc{$tag} = $desc; 355 } 356 } 357 358 if ($m = $problems{'warnings'}) { 359 foreach $w (split(/\|/, $m)) { 360 next if ($w =~ /^\s*$/); 361 362 $c = $w; 363 if (defined($warnings_desc{$c})) { 364 $c = $warnings_desc{$c}; 365 $c = gettext($c); 366 } 367 $c =~ s/;//g; 368 $result_msg{$object} .= "$c; "; 369 $warnings_found{$w} .= "$object|"; 370 } 371 } 372 373 $result_msg{$object} =~ s/;\s+$//; 374} 375 376# 377# Create the top level roll-up report. 378# 379sub print_report 380{ 381 # Count the number of passed, failed and total binary objects: 382 my(@a); 383 my($r_passed, $r_incomp, $r_failed); 384 if (exists($result_list_hash{'passed'})) { 385 $r_passed = $result_list_hash{'passed'}; 386 } else { 387 $r_passed = ''; 388 } 389 if (exists($result_list_hash{'incomplete'})) { 390 $r_incomp = $result_list_hash{'incomplete'}; 391 } else { 392 $r_incomp = ''; 393 } 394 if (exists($result_list_hash{'failed'})) { 395 $r_failed = $result_list_hash{'failed'}; 396 } else { 397 $r_failed = ''; 398 } 399 my $n_passed = scalar(@a = split(/\|/, $r_passed)); 400 my $n_incomp = scalar(@a = split(/\|/, $r_incomp)); 401 my $n_failed = scalar(@a = split(/\|/, $r_failed)); 402 my $n_checked = $n_passed + $n_incomp + $n_failed; 403 404 my ($summary_result, $msg, $output, $object); 405 406 407 if ($n_checked == 0) { 408 $summary_result = $text{'Summary_Result_None_Checked'}; 409 } elsif ($n_failed > 0) { 410 $summary_result = $text{'Summary_Result_Some_Failed'}; 411 } elsif ($n_incomp > 0) { 412 $summary_result = $text{'Summary_Result_Some_Incomplete'}; 413 } else { 414 $summary_result = $text{'Summary_Result_All_Passed'}; 415 } 416 417 # place the info in problem count file: 418 my $cnt_file = "$working_dir/ProblemCount"; 419 my $pcount_fh = do { local *FH; *FH }; 420 if (! open($pcount_fh, ">$cnt_file")) { 421 exiter(nofile($cnt_file, $!)); 422 } 423 424 print $pcount_fh "$n_failed / $n_checked binary_objects_had_problems\n"; 425 print $pcount_fh 426 "$n_incomp / $n_checked could_not_be_completely_checked\n"; 427 428 print $pcount_fh "NO_PROBLEMS_LIST: $r_passed\n"; 429 print $pcount_fh "INCOMPLETE_LIST: $r_incomp\n"; 430 print $pcount_fh "PROBLEMS_LIST: $r_failed\n"; 431 close($pcount_fh); 432 433 # 434 # Set the overall result code. 435 # This is used to communicate back to the appcert script to 436 # indicate how it should exit(). The string must start with the 437 # exit number, after which a message may follow. 438 # 439 440 if ($n_checked == 0) { 441 overall_result_code("3 => nothing_checked"); 442 } elsif ($n_failed > 0) { 443 overall_result_code("2 => some_problems_detected($n_failed)"); 444 } elsif ($n_incomp > 0) { 445 overall_result_code("1 => " . 446 "some_binaries_incompletely_checked($n_incomp)"); 447 } else { 448 overall_result_code("0 => no_problems_detected"); 449 } 450 451 my ($sp0, $sp, $sf, $si); # PASS & FAIL spacing tags. 452 $sp0 = ' '; 453 if ($batch_report) { 454 $sp = 'PASS '; 455 $sf = 'FAIL '; 456 $si = 'INC '; 457 } else { 458 $sp = $sp0; 459 $sf = $sp0; 460 $si = $sp0; 461 } 462 463 464 $msg = sprintf(gettext("Summary: %s"), $summary_result) . "\n\n"; 465 my $format = gettext("A total of %d binary objects were examined."); 466 $msg .= sprintf($format, $n_checked) . "\n\n\n"; 467 $output .= $msg; 468 469 my $fmt1 = gettext( 470 "The following (%d of %d) components had no problems detected:"); 471 472 if ($n_passed > 0) { 473 $output .= sprintf($fmt1, $n_passed, $n_checked); 474 $output .= "\n\n"; 475 476 foreach $object (split(/\|/, $r_passed)) { 477 $output .= "${sp}$object\n"; 478 } 479 $output .= "\n"; 480 } 481 482 my $fmt2 = gettext( 483 "The following (%d of %d) components had no problems detected,\n" . 484 " but could not be completely checked:"); 485 486 if ($n_incomp > 0) { 487 $output .= sprintf($fmt2, $n_incomp, $n_checked); 488 $output .= "\n\n"; 489 490 foreach $object (split(/\|/, $r_incomp)) { 491 $msg = $result_msg{$object}; 492 $output .= "${si}$object\t($msg)\n"; 493 } 494 $output .= "\n"; 495 } 496 497 my $fmt3 = gettext( 498 "The following (%d of %d) components have potential " . 499 "stability problems:"); 500 if ($n_failed > 0) { 501 $output .= sprintf($fmt3, $n_failed, $n_checked); 502 $output .= "\n\n"; 503 504 foreach $object (split(/\|/, $r_failed)) { 505 $msg = $result_msg{$object}; 506 $output .= "${sf}$object\t($msg)\n"; 507 } 508 $output .= "\n"; 509 } 510 511 $output .= "\n" . get_summary(); 512 513 $output .= "\n" . get_warnings(); 514 515 my $report_file = "$working_dir/Report"; 516 my $report_fh = do { local *FH; *FH }; 517 open($report_fh, ">$report_file") || 518 exiter(nofile($report_file, $!)); 519 520 print $report_fh $output; 521 close($report_fh); 522 system($cmd_more, $report_file); 523} 524 525# 526# Collects all of the warnings issued for the binaries that were 527# checked. Returns the warning text that will go into the roll-up 528# report. 529# 530sub get_warnings 531{ 532 my ($w, $c, $output, $count); 533 534 if (! %warnings_found) { 535 return ''; # appends null string to output text 536 } 537 538 $output = gettext("Summary of various warnings:") . "\n\n"; 539 my(@a); 540 foreach $w (keys(%warnings_found)) { 541 $warnings_found{$w} =~ s/\|+$//; 542 $count = scalar(@a = split(/\|/, $warnings_found{$w})); 543 $c = $w; 544 if (defined($warnings_desc{$c})) { 545 $c = $warnings_desc{$c}; 546 } 547 $c = gettext($c); 548 $output .= " - $c " . sprintf(gettext( 549 "(%d binaries)\n"), $count); 550 $output .= "\n"; 551 552 } 553 $output .= "\n"; 554 555 return $output; 556} 557 558# 559# Computes the summary information for each binary object that was 560# checked. Returns the text that will go into the roll-up report. 561# 562sub get_summary 563{ 564 my ($dir, $file); 565 my (%lib_private, %libsym_private); 566 my (%libapp, %libapp_private); 567 568 my ($bin, $arch, $direct, $lib, $class, $sym); 569 570 while (defined($dir = next_dir_name())) { 571 572 # This is where the public symbol list is: 573 $file = "$dir/check.dynamic.public"; 574 575 my %app_public; 576 my %app_sym_public; 577 my %app_private; 578 my %app_sym_private; 579 580 if (-s $file) { 581 my $publics_fh = do { local *FH; *FH }; 582 open($publics_fh, "<$file") || 583 exiter(nofile($file, $!)); 584 585 while (<$publics_fh>) { 586 next if (/^\s*#/); 587 chomp; 588 ($bin, $arch, $direct, $lib, $class, $sym) = 589 split(/\|/, $_); 590 591 $libapp{"$lib|$bin"}++; 592 593 $app_public{$lib}++; 594 $app_sym_public{"$lib|$sym"}++; 595 } 596 close($publics_fh); 597 } 598 599 # This is where the private symbol list is: 600 $file = "$dir/check.dynamic.private"; 601 602 if (-s $file) { 603 my $privates_fh = do { local *FH; *FH }; 604 open($privates_fh, "<$file") || 605 exiter(nofile($file, $!)); 606 607 while (<$privates_fh>) { 608 next if (/^\s*#/); 609 chomp; 610 ($bin, $arch, $direct, $lib, $class, $sym) = 611 split(/\|/, $_); 612 613 $lib_private{$lib}++; 614 $libsym_private{"$lib|$sym"}++; 615 $libapp_private{"$lib|$bin"}++; 616 $libapp{"$lib|$bin"}++; 617 618 $app_private{$lib}++; 619 $app_sym_private{"$lib|$sym"}++; 620 } 621 close($privates_fh); 622 } 623 624 write_app_summary($dir, \%app_public, \%app_sym_public, 625 \%app_private, \%app_sym_private); 626 } 627 628 my ($app_total, $app_private_total); 629 my ($key, $lib2, $app2, $sym2); 630 my $val; 631 my $text; 632 633 foreach $lib (sort(keys(%lib_private))) { 634 635 $app_total = 0; 636 foreach $key (keys(%libapp)) { 637 ($lib2, $app2) = split(/\|/, $key); 638 $app_total++ if ($lib eq $lib2); 639 } 640 641 $app_private_total = 0; 642 foreach $key (keys(%libapp_private)) { 643 ($lib2, $app2) = split(/\|/, $key); 644 $app_private_total++ if ($lib eq $lib2); 645 } 646 647 my @list; 648 while (($key, $val) = each(%libsym_private)) { 649 ($lib2, $sym2) = split(/\|/, $key); 650 next unless ($lib eq $lib2); 651 push(@list, "$sym2 $val"); 652 653 } 654 655 $text .= private_format($lib, $app_total, 656 $app_private_total, @list); 657 } 658 659 if (! defined($text)) { 660 return ''; # appends null string to output report. 661 } 662 return $text; 663} 664 665# 666# Given the symbols and counts of private symbols used by all binaries 667# that were checked, returns a pretty-printed format table of the 668# symbols. This text goes into the roll-up report and the summary.dynamic 669# file. 670# 671sub private_format 672{ 673 my ($lib, $tot, $priv, @list) = @_; 674 675 my (@sorted) = sort_on_count(@list); 676 my $formatted = list_format(' ', @sorted); 677 678 my $text; 679 my $libbase = basename($lib); 680 681 $text = sprintf(gettext( 682 "Summary of Private symbol use in %s\n"), $lib); 683 my $fmt = 684 gettext("%d binaries used %s, %d of these used private symbols"); 685 $text .= sprintf($fmt, $tot, $libbase, $priv); 686 $text .= "\n\n$formatted\n"; 687 688 return $text; 689} 690 691# 692# Given the public/private symbol and library usage information for a 693# binary object, creates an output file with this information formatted 694# in tables. 695# 696sub write_app_summary 697{ 698 my ($dir, $public, $sym_public, $private, $sym_private) = @_; 699 700 my $outfile = "$dir/summary.dynamic"; 701 702 my $summary_fh = do { local *FH; *FH }; 703 open($summary_fh, ">$outfile") || 704 exiter(nofile($outfile, $!)); 705 706 my $path_to_object = dir_name_to_path($dir); 707 708 709 my ($tmp1, $tmp2, $tmp3); 710 711 $tmp1 = gettext("ABI SYMBOL USAGE SUMMARY REPORT"); 712 $tmp2 = '*' x length($tmp1); 713 714 print $summary_fh "$tmp2\n$tmp1\n$tmp2\n\n"; 715 716 print $summary_fh " ", sprintf(gettext( 717 "Binary Object: %s\n"), $path_to_object); 718 719 my $uname_a = `$cmd_uname -a`; 720 print $summary_fh " ", sprintf(gettext("System: %s\n"), $uname_a); 721 722 $tmp1 = gettext("References to shared objects in the Solaris ABI"); 723 $tmp2 = '*' x length($tmp1); 724 725 print $summary_fh "$tmp2\n$tmp1\n$tmp2\n\n"; 726 727 728 my (%libs, $lib, $maxlen, $len); 729 $maxlen = 0; 730 731 foreach $lib (keys(%$public), keys(%$private)) { 732 $len = length($lib); 733 $maxlen = $len if ($len > $maxlen); 734 $libs{$lib} = 1; 735 } 736 737 if (! %libs) { 738 my $str = gettext( 739 " NONE FOUND. Possible explanations:\n" . 740 " - the dynamic profiling failed, see ldd(1), ld.so.1(1)\n" . 741 " - the object is SUID or SGID\n" . 742 " - the object is completely statically linked.\n" 743 ); 744 print $summary_fh $str, "\n"; 745 close($summary_fh); 746 return; 747 } 748 749 foreach $lib (sort(keys(%libs))) { 750 print $summary_fh " $lib\n"; 751 } 752 print $summary_fh "\n"; 753 754 my ($len1, $len2, $len3); 755 my $heading = ' ' . gettext("Library"); 756 $heading .= ' ' x ($maxlen + 6 - length($heading)); 757 $len1 = length($heading) - 2; 758 my $public_str = gettext("Public"); 759 $len2 = length($public_str); 760 my $private_str = gettext("Private"); 761 $len3 = length(" $private_str"); 762 $heading .= "$public_str $private_str"; 763 $tmp3 = $heading; 764 $tmp3 =~ s/\S/-/g; 765 766 $tmp1 = gettext("Symbol usage statistics (summary by shared object)"); 767 $tmp2 = '*' x length($tmp1); 768 769 print $summary_fh "$tmp2\n$tmp1\n$tmp2\n\n"; 770 print $summary_fh "$heading\n"; 771 print $summary_fh "$tmp3\n"; 772 773 my ($pub, $priv, $str); 774 foreach $lib (sort(keys(%libs))) { 775 $pub = $public->{$lib}; 776 $priv = $private->{$lib}; 777 778 $pub = 0 if (! defined($pub)); 779 $priv = 0 if (! defined($priv)); 780 781 $str = ' '; 782 $str .= sprintf("%-${len1}s", $lib); 783 $str .= sprintf("%${len2}s", $pub); 784 $str .= sprintf("%${len3}s", $priv); 785 print $summary_fh $str, "\n"; 786 } 787 print $summary_fh "\n"; 788 789 $tmp1 = gettext("Symbol usage (detailed inventory by shared object)"); 790 $tmp2 = '*' x length($tmp1); 791 792 print $summary_fh "$tmp2\n$tmp1\n$tmp2\n\n"; 793 794 my (@pub, @priv, $lib2, $sym2, $text, $key); 795 foreach $lib (sort(keys(%libs))) { 796 @pub = (); 797 @priv = (); 798 799 foreach $key (keys(%$sym_public)) { 800 next unless (index($key, $lib) == 0); 801 ($lib2, $sym2) = split(/\|/, $key, 2); 802 next unless ($lib2 eq $lib); 803 push(@pub, $sym2); 804 } 805 foreach $key (keys(%$sym_private)) { 806 next unless (index($key, $lib) == 0); 807 ($lib2, $sym2) = split(/\|/, $key, 2); 808 next unless ($lib2 eq $lib); 809 push(@priv, $sym2); 810 } 811 812 next if (! @pub && ! @priv); 813 814 my $fmt = gettext("Symbols in %s Directly Referenced"); 815 $text = sprintf($fmt, $lib); 816 817 if (@pub) { 818 $lib2 = scalar(@pub); 819 $text .= sprintf(gettext( 820 " %d public symbols are used:\n"), $lib2); 821 $text .= list_format(' ', sort(@pub)); 822 $text .= "\n"; 823 } 824 if (@priv) { 825 $lib2 = scalar(@priv); 826 $text .= sprintf(gettext( 827 " %d private symbols are used:\n"), $lib2); 828 $text .= list_format(' ', sort(@priv)); 829 $text .= "\n"; 830 } 831 832 print $summary_fh $text; 833 } 834 close($summary_fh); 835} 836