GNOME Bugzilla – Bug 157232
Crashes when I attempt to open a perl script
Last modified: 2004-12-22 21:47:04 UTC
Steps to reproduce: Steps to reproduce the crash: 1. Open the script in GEdit (it crashed when I attempted to open a second perl script in another tab) 2. Re-launch GEdit. 3. Click on open "previously opened" list for the first script (now it crashes GEdit as well - I don't get to the second script anymore) Expected Results: I made no modifications to either script - thank goodness! The app obviously should not crash after loading and highlighting the script. How often does this happen? Was happening every time this morning Stack trace: Backtrace was generated from '/usr/bin/gedit' (no debugging symbols found)...Using host libthread_db library "/lib/tls/libthread_db.so.1". (no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...[Thread debugging using libthread_db enabled] [New Thread -151129440 (LWP 3616)] [New Thread 14908336 (LWP 3619)] [Thread debugging using libthread_db enabled] [New Thread -151129440 (LWP 3616)] [New Thread 14908336 (LWP 3619)] [Thread debugging using libthread_db enabled] [New Thread -151129440 (LWP 3616)] [New Thread 14908336 (LWP 3619)] [New Thread 15592368 (LWP 3618)] [New Thread 26495920 (LWP 3617)] (no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...0x0012e7a2 in _dl_sysinfo_int80 () from /lib/ld-linux.so.2
+ Trace 51605
Thread 1 (Thread -151129440 (LWP 3616))
Other information: Oh, BTW here is the first script I attempted to load: #! /usr/bin/perl use File::Find; use File::Spec; use File::Copy; use File::Path; use Cwd; use Env qw(CVSWORK); die "Please set the environment variable CVSWORK\n" if !defined $CVSWORK; push @INC,File::Spec->catfile($CVSWORK,'build_util','Makefile_Maker'); $SIG{INT} = \&quitme; $build_lock_file="$CVSWORK/build_util/AutoBuild/build_lock"; if (! -e $build_lock_file) { open(LOCK_FILE,"> $build_lock_file") || die "Couldn't create build lock file: $build_lock_file: $!\n"; close(LOCK_FILE); } else { die "Build already in progress. Try again later.\n"; } $DEBUG=0; $DEBUG_DETAILS=0;; $DEBUG_DETAILS_OBF=0; $OBFDIR='/opt/ouyasafe-1.3'; $CLASSPATH=$ENV{CLASSPATH}; $JARNAME=getJarName(); $JAR=$JARNAME.'.jar'; $make_dir = cwd(); $obfuscation_dir = File::Spec->catfile($make_dir,'obfuscated'); $product_dir = ""; $cvs_module = getCVSModule($obfuscation_dir); %dir_seen; $from = shift; getFromTag(); $to = getCurrentTag(); print "Using $to as the patch tag\n"; $patchjar = shift; if (!defined $patchjar) { print "What should the patch jar filename be?[$to.jar]\n"; $patchjar = <STDIN>; chomp($patchjar); if ($patchjar =~ /^$/) { $patchjar = "$to.jar"; } } print "Checking to see if any files have changed from tag $from to tag $to ..."; checkForFileChanges(); # Can no longer do this until all customers have the consolidated wig.jar #print "Updating module to CVS tag $to\n"; # #`cvs update -C -d -r $to` || die "Update failed because there is no such tag: $!\n"; print "Making all module sub-level makefiles\n"; callSubMakeMaker(); print "Making top-level Makefile in $make_dir\n"; callMakeMaker(); print "Building class files\n"; doMakeBuild(); doSetBuildDate(); doMakeVersion(); copyClassFiles(); obfuscateClassFiles(); getManifestFile(); makeObfuscatedJarFile(); print "\nBuilding patch file $patchjar which will contain differences\n"; print " between CVS tag: $from\n"; print " and CVS tag: $to\n\n"; buildPatchJar(); print "Saving jar $patchjar in $obfuscation_dir\n"; savePatchJarInObfuscationDir(); showPatchJarContents($patchjar); print "\n\nCheck the output above to ensure that the cvs patch tag is correct.\n"; print "If it is not then make changes to Version.java and commit them then re-run make_patch.pl\n"; clean_up_locks(); sub buildPatchJar { @output = `cvs rdiff -s -r$from -r$to $cvs_module/tcs 2>/dev/null`; # This stores the filenames of all files that are returned from # the rdiff command using the two tags (original tag and patch tag.) @rdiff_files = (); # This stores the names(minus extension) of the files that have # changed that will be used to extract the class files from the # obfuscated jar later. @class_names = (); @patched_files = (); @patch_classes = (); foreach $line (@output) { # skip removed classes next if ($line =~ /is\sremoved;/); @parts = split / /,$line; push @rdiff_files, $parts[1]; } foreach $line (@rdiff_files) { @line_parts = split /\//, $line; $class = $line_parts[$#line_parts]; chomp($class); @class_parts = split /\./, $class; push @class_names, $class_parts[0]; @package_parts = split /tcs/, $line; $patch_file = "tcs" . $package_parts[1]; push @patched_files, $patch_file; } foreach $class (@patched_files) { print "class before substitution: $class " if $DEBUG; $class =~ s/\.java/\.class/; print "class after substitution: $class\n" if $DEBUG; push @patch_classes, $class; } print "patch_classes looks like @patch_classes before looking for inner classes\n"; find ({wanted => \&wanted, no_chdir => 1}, 'tcs'); chdir("/tmp"); foreach $line (@patch_classes) { next unless $line =~ /\.class/; print "jar -xvf $obfuscation_dir/$JAR $line\n"; if ($line =~ /\$/) { @parts = split /\$/,$line; $line = $parts[0] . '$*'; } if (! `jar -xvf $obfuscation_dir/$JAR $line`) { print "Failed to extract $line from $obfuscation_dir/$JAR - check to ensure that this class was actually built.\n"; quitme(); } } } sub callMakeMaker { print "make_patch.make_maker started\n"; my $make_results = `perl $CVSWORK/build_util/Makefile_Maker/make_maker.pl`; print "\nmake_results:\n$make_results\n" if $DEBUG_DETAILS; } sub callSubMakeMaker { # This builds all sub-level makefiles in all modules. print "make_patch.submake_maker started\n"; my $submake_results = `perl $CVSWORK/build_util/Makefile_Maker/submake_maker.pl`; print "\nsubmake_results:\n$submake_results\n" if $DEBUG_DETAILS; } sub checkForFileChanges { my @output = `cvs rdiff -s -r$from -r$to $cvs_module/tcs 2>/dev/null`; while (scalar(@output) == 0) { print "Sorry, there are no modified file between the tags $to and $from\n"; print "Check the tags for spelling.\n\n"; $to = getCurrentTag(); undef $from; getFromTag(); @output = `cvs rdiff -s -r$from -r$to $cvs_module/tcs 2>/dev/null`; } print "Changes detected\n\n"; } sub clean_up_locks { unlink($build_lock_file); } sub copyClassFiles { if ( -d './obfuscated' ) { print "Removing subdirectory tree obfuscated in current directory " . cwd() . "\n"; rmtree('obfuscated') || die "Unable to remove obfuscated directory: $!\n"; } mkdir('./obfuscated',0755) || die "Unable to created obfuscated directory: $!\n"; print "Copying .class files\n"; find({ wanted => \&doRecursiveCopyClassFiles, no_chdir => 1}, './tcs'); } sub die { my $message = shift; clean_up_locks(); print $message; exit(1); } sub doMakeBuild { open(BUILDOUT, "make build 2>&1 |") or die "can't fork: $!"; while (<BUILDOUT>) { # Discard Useless output from make which only clutters status. next if (/Entering directory|Leaving directory|Nothing to be done/); next if (/^cd|^rm/); # print an abbreviated "Compiling <java filename>" my @parts = split; if (/^javac/) { print "Compiling $parts[$#parts]\n"; } elsif(/rmic\s/) { print "Compiling RMI Stubs/Skels for $parts[$#parts]\n"; } else { # Print any errors that javac reports. print; } # Halt patch build if unable to compile everything if (/^make\:\s\*\*\*/) { print "Unable to complete build\n"; quitme(); } } close(BUILDOUT); } sub doMakeVersion { print "Rebuilding Version.class\n"; find(\&makeVersion , 'tcs'); } sub doRecursiveCopyClassFiles { $cur_dir = $File::Find::dir; $cur_file = $File::Find::name; if ( $dir_seen{$cur_dir} != 1 && $cur_dir !~ /\/CVS$/) { $dir_seen{$cur_dir}=1; $cur_dir =~ s/\.//; $whole_path = $make_dir . "/obfuscated" . $cur_dir; #print "Making directory: $whole_path". "\n"; mkdir($whole_path, 0755); } return unless ($cur_file =~ /\.class$/); $cur_file =~ s/\.\///; $source_file = File::Spec->catfile($make_dir,$cur_file); $target_file = File::Spec->catfile($make_dir,'obfuscated',$cur_file); print "Copying file: $source_file To file: $target_file\n" if DEBUG_DETAILS_OBF; copy($source_file,$target_file) || die "Couldn't copy $source to $target: $!\n"; } sub doSetBuildDate { if ($DEBUG) { print "Deferring force commit of Version.java in DEBUG mode.\n"; return; } print "Setting Build date and time stamp in Version.java\n"; `cvs update -A ./setbuilddate.sh`; if ( ! -x 'setbuilddate.sh' ) { `chmod 755 ./setbuilddate.sh`; } if ( ! -f 'setbuilddate.sh' || ! -x 'setbuilddate.sh' ) { die "Couldn't execute ./setbuilddate.sh. Please rectify then run make_patch.pl again."; } open(SETBUILDDATE_OUT,"setbuilddate.sh 2>&1 |") or die "can't fork: $!"; while (<SETBUILDDATE_OUT>) { print; if (/error/) { print "Unable to set build date on Version.java\n"; quitme(); } if (/commit aborted/) { print "Unable to set build date on Version.java\n"; quitme(); } } } sub getBuildTagForRev { my $filename = shift; my $pattern = $filename; my $result; $pattern =~ s/\./\_/; my $rev = shift; print "Attempting to get the deploy tag for rev: $rev\n" if $DEBUG; my $cmd = 'cvs log ' . $filename . ' | grep "' . $rev . '$' . '"'; print "Running cmd: $cmd\n" if $DEBUG; my @lines = `$cmd`; foreach (@lines) { if (/$pattern/) { my @parts = split /\:/,$_; $parts[0] =~ s/\s//g; $result = $parts[0]; last; } } return $result; } # Is there a stick tag already on the Makefile? If so we'll assume # that the user wants to use that tag as the patch tag. If not, prompt # the user for one until they enter one or Ctrl-C. sub getCurrentTag { $result = ""; @cvs_status_output = `cvs status Makefile`; foreach $line (@cvs_status_output) { if ($line =~ /Sticky Tag\:/) { print $line if $DEBUG; @parts = split /\s+/, $line; $result = $parts[3]; } } if ($result eq "" || $result eq "(none)" ) { print "No Sticky Tag detected on $cvs_module/Makefile! I can't tell which patch you're trying to build !\n"; } while (!defined $result || $result eq "(none)" || $result =~ /^$/) { print "What is the CVS tag of the patched version?\n"; $result = <STDIN>; chomp($result); } return $result; } sub getCVSModule { my $obf_dir = shift; @parts = split /smswebgw\//, $obf_dir; my $module_obf_dir = $parts[1]; @parts = split /\//, $module_obf_dir; $product_dir = $parts[0]; return "smswebgw/" . $parts[0]; } sub getDeployTag { my $jar_name = shift; my $rev = getStickyTagRev($jar_name); return getBuildTagForRev($jar_name,$rev); } sub getFromTag { my $deploy_tag=""; if (-e $JAR) { $deploy_tag = getDeployTag($JAR); } while (!defined $from || $from =~ /^$/) { print "What is the CVS tag of the deployed version?[$deploy_tag]\n"; $from = <STDIN>; chomp($from); if ($from =~ /^$/) { $from = $deploy_tag; } } } # Returns the name or what should be the name of the jar that # is built when as a result of the obfuscation step. This is # normally named the same as the obfuscation file. There is # only one obfuscation file in each application directory. sub getJarName { opendir(DIR,'.'); my @obj_filenames = grep { /\.obf$/ } readdir (DIR); closedir(DIR); my $result = $obj_filenames[0]; $result =~ s/\.obf//; return $result; } # The manifest.info file is the file which is fed into the jar command # so that the correct class is used when running `java -jar <jarfile>`. # For our purposes this is simply the file whose main method when invoked # spits out the version information to standard out then exits.(Namely # Version.class. This ensures that we get the latest version - should # only be one version - since this is a relatively new addition to the # jar building process. If not found execution terminates and the user # must correct the missing manifest.info issue. sub getManifestFile { print "Retrieving latest version of manifest information file\n"; `cvs update -A manifest.info`; die "Unable to retrieve manifest information file: $!\n" if (! -e "manifest.info"); } sub getStickyTagRev { my $filename = shift; print "Attempting to find sticky tag for $filename\n" if $DEBUG; $status = `cvs status $filename | grep "Sticky Tag"`; print $status if $DEBUG; my @parts = split /\:/,$status; $parts[2] =~ s/\s|\n|\)//g; my @parts2 = split /\./,$parts[2]; return "1.$parts2[1]"; } sub makeObfuscatedJarFile { print "Making Obfuscated Jar File\n"; chdir("./obfuscated") || die "Couldn't chdir to obfuscated.\n"; `jar cmf ../manifest.info $JAR tcs/` } # This assumes we're in the correct directory if the # file argument is Version.java in order to do a # make Version.class. sub makeVersion { if ($_ =~ /Version\.java/) { `make Version.class`; } } # Runs the obfuscator on the obfuscation project file found in the # current directory. This works on the class files found in the obfuscated # subdirectory overwriting them with obfuscated versions of the class files. sub obfuscateClassFiles { print "Obfuscating\n"; my $obf_out = "patch_obf.out"; my $obf_err = "patch_obf.err"; my $obfuscation_cmd = "java -Xms512M -Xmx512m -classpath ". '`echo $CLASSPATH`' . ":$OBFDIR/ouyasafe.jar:$OBFDIR/swingall.jar ouyasoft.Javasafe $JARNAME.obf"; print "Running obfuscation command: $obfuscation_cmd\n"; $obfuscation_cmd .= ">$obf_out 2>$obf_err"; my $results = `$obfuscation_cmd`; print "$results\n" if DEBUG_DETAILS_OBF; print "Obfuscation done\n"; } sub quitme { clean_up_locks(); warn "\aThe long habit of living indisposeth us for dying. - Sir Thomas Browne\n"; exit(1); } sub savePatchJarInObfuscationDir { `jar -cmf $obfuscation_dir/../manifest.info $patchjar tcs`; copy("/tmp/$patchjar","$obfuscation_dir/$patchjar"); rmtree('/tmp/tcs',0,0); unlink("/tmp/$patchjar"); chdir($obfuscation_dir); } sub showPatchJarContents { my $patchjar = shift; my @output = `java -jar $patchjar`; foreach $line (@output) { print $line . "\n"; } } sub wanted { foreach my $class (@class_names) { if ($File::Find::name =~ /\/$class\$/) { push @patch_classes, $File::Find::name; } else { print "$File::Find::name does not contain /$class\n" if $DEBUG_DETAILS; } } } Oh, and here is the second script: #! d:\perl\bin\perl # This script is an attempt to write a recursive search script # to auto-generate Makefiles for directories that contain source files. # It will generate the CLASSPATH for the Makefile based on the # import statements found in the java source code in all modules listed # in "module.properties" file. It will use package_mappings.txt under smswebgw/testjars # and smswebgw/thirdparty to tell which jars contain the imported classes. # It works in two stages. In the # first stage it will create or modify a temporary file called # cp.tmp in the smswebgw directory which will be used to store the # CLASSPATH components as they are discovered. In the second stage # it will read this file and use Makefile.tmpl to create a new Makefile # in each subdirectory that contains .java files. This will replace # all existing sub-level Makefiles (under tcs/) in all modules listed # in "modules.properties" or "module.properties.internal" file. # # With regard to compiling RMI stubs/skels this script looks for java # source that "extends UnicastRemoteObject". If it finds any it records # this finding in a file called rmi.tmp in the package directory the source is # located in on the first pass. In the second stage it looks for these rmi.tmp # files reads them in and adds the appropriate rmi target to the Makefile. It # then deletes these files.(Deletion can be turned off by setting CLEANUP=0). # The top-level Makefile building script called make_maker.pl will detect the # rmi targets and add the appropriate $(MAKE) rmi to the top-level rmi target # which is called after build if any rmi targets exist. use Env qw(CVSWORK); # CVSWORK environment variable should be pathname to directory that contains smswebgw. use File::Find; use File::Spec; use Text::Template; use Time::Local; my $SUBMAKE_DEBUG = 0; my $SUBMAKE_DEBUG_DETAILS = 0; %package_map_hash; $CLASSPATH_SEPERATOR = ':'; $CLASSPATH = '$(JAVA_HOME)/lib/classes.zip'; $RMI = ''; # This determines whether to remove any temporary files generated by the script. $CLEANUP=0; # This is the name of the file that stores rmi classes in stage 1. $rmi_tmp_file = 'rmi.tmp'; # This stores each of the resolved paths required to build the final CLASSPATH. %classpath_hash; die "Please set the environment variable CVSWORK\n" if !defined $CVSWORK; # If "-patch" is specified as the argument to this script, the package_mappings.txt # files that are created aren't committed to the trunk. Building a patch is akin to # going back in time, and we don't necessarily have the same jars today that we had # once upon a time. # If "-internal" is specified as the argument to this script, the package_mappigs.txt # files that are created aren't committed to the trunk. Internal builds are not # deployed to our customers. my $option=shift; print "b1 true " if ((! defined $option)&& $SUBMAKE_DEBUG); print "b2 true " if (($option =~ /^-patch/)&& $SUBMAKE_DEBUG); print "b3 true " if (($option =~ /^-internal/i)&& $SUBMAKE_DEBUG); print "b4 true\n" if (((! defined $option) || ($option =~ /^-internal/i) || ($option =~ /^-patch/i))&& $SUBMAKE_DEBUG); print "option=$option! \n" if $SUBMAKE_DEBUG; my $patch = ''; my $internal = 0; die "options = -patch or -internal, build stopped" unless ((! defined $option) || ($option =~ /^-internal/i) || ($option =~ /^-patch/i)); if ($option =~ m/^-patch/i) { $patch = '-patch'; } elsif ($option =~ m/^-internal/i) { $internal = 1; } $tcs_pm = File::Spec->catfile($CVSWORK,'smswebgw','testjars','package_mappings.txt'); $tp_pm = File::Spec->catfile($CVSWORK,'smswebgw','thirdparty','package_mappings.txt'); # The Makefile template that serves as the basis for every sub-level Makefile. # Typically the only thing that changes is the classpath and the creation date. $makefile_template = new Text::Template ( SOURCE => File::Spec->catfile($CVSWORK,'build_util','Makefile_Maker','Makefile.tmpl') ) or die "Couldn't make template: $Text::Template::ERROR; aborting"; # List of the modules to build. if ($internal == 1) { @build_modules = getModules(File::Spec->catfile($CVSWORK,'build_util','Makefile_Maker', 'module.properties.internal')); } else { @build_modules = getModules(File::Spec->catfile($CVSWORK,'build_util','Makefile_Maker', 'module.properties')); } # hash mapping of jars and the module directory they live in. This is done # so that the source may be used instead of the jar file, since a jar containing # the latest changes to the source may no be available yet - at least not until # after all builds are complete - :) %jar2dir_map = getJar2DirMappings(File::Spec->catfile($CVSWORK,'build_util','Makefile_Maker','jar2dir_mappings.properties')); # This stores the directory of the module whose Makefiles are currently being written. This # is kind of a hack to fix the lack of foresight I had regarding relying only on the import # statements to build the CLASSPATH. I was forgetting that package-level access requires no # import, but does need the path that the source files themselves are in to be included in the # CLASSPATH. Use of the variable will ensure that the current module's path is included at the # beginning of the CLASSPATH variable in each sub-level Makefile. $current_module_path; $rmi_module_path; setupPackageMapHash(); print "Preparing modules for first stage\n"; foreach $module (@build_modules) { $path = File::Spec->catfile($CVSWORK,'smswebgw',$module); find (\&removePreviousTmpFiles, $path); # Oops, it just occurred to me that this would hurt my ability to # use this script when preparing a patch. #chdir($path) or die "Couldn't change directory to $path: $!\n"; #`cvs update -A -d -P tcs`; } foreach $module (@build_modules) { $path = File::Spec->catfile($CVSWORK,'smswebgw',$module); print "Parsing source files for $path\n"; find (\&wanted, $path); } fixClasspathHash(); replaceMachineSpecificPathWithCVSWORKAlias(); open (CP_FILE,"> " . File::Spec->catfile($CVSWORK,'smswebgw','cp.tmp') ); foreach $classpath (keys %classpath_hash) { print CP_FILE "$classpath\n"; $CLASSPATH .= ":$classpath"; } close(CP_FILE); $TIME = localtime(); foreach $module (@build_modules) { $rmi_module_path = "\$(CVSWORK)/smswebgw/$module"; $current_module_path = File::Spec->catfile($CVSWORK,'smswebgw',$module); $path = File::Spec->catfile($current_module_path,'tcs'); print "Writing Makefiles in $path\n"; find(\&writeMakefiles,$path); } # This is pedantic, but I just hate seeing unecessary duplication in the classpath brought # on by the fact that our resolution is at the jar level, but we have "live" packages # which contain classes that are stored in *different* jars. ARRRRGGH!!!! sub fixClasspathHash { foreach (keys %classpath_hash) { next unless /\n/; my @parts = split /\n/; #print "Deleting entry - $_ - from classpath_hash\n"; delete($classpath_hash{$_}); foreach my $part (@parts) { #print "Adding entry - $part - to classpath_hash\n"; $classpath_hash{$part} = 1; } } } # This modifies the CLASSPATH components that will end up in cp.tmp # so that instead of looking like /build/manningr/projects/smswebgw/... # the CVSWORK alias is used instead so each component looks like # $CVSWORK/smswebgw/... sub replaceMachineSpecificPathWithCVSWORKAlias { foreach (keys %classpath_hash) { my $new_path = CVSWORKify($_); delete($classpath_hash{$_}); $classpath_hash{$new_path} = 1; } } sub CVSWORKify { my $path = shift; print "path=$path\n" if $SUBMAKE_DEBUG_DETAILS; my @path_parts = split /smswebgw/,$path; return '$(CVSWORK)/smswebgw' . $path_parts[1]; } sub writeMakefiles { return unless (/^Makefile$/); #print "Writing $File::Find::name\n"; if (-e $rmi_tmp_file) { $RMI = "#### RMI skel and stub\nrmi:\n"; my $rmi_action = "\t" . '$(RMIC) $(RMI_OPTIONS) $(JAVAC_FLAGS)'; foreach (getRMIClasses()) { $RMI .= "$rmi_action $_"; } unlink($rmi_tmp_file) if $CLEANUP; } else { $RMI = ''; } $CLASSPATH_ORIG = $CLASSPATH; $CLASSPATH = CVSWORKify($current_module_path) . $CLASSPATH_SEPERATOR . $CLASSPATH; open(MAKEFILE,'> Makefile'); print MAKEFILE $makefile_template->fill_in(DELIMITERS => ['[@--' , '--@]' ]); close(MAKEFILE); $CLASSPATH = $CLASSPATH_ORIG; } sub getRMIClasses { open(RMI_FILE,$rmi_tmp_file); my @result = <RMI_FILE>; close(RMI_FILE); return @result; } sub getModules { my $modules_file = shift; print "modules_file=$modules_file\n" if $SUBMAKE_DEBUG_DETAILS; open(FILE,$modules_file) or die "Couldn't locate file $modules_file!\n"; my @lines = <FILE>; close(FILE); my @result; foreach (@lines) { next if /^\#/; # skip newlines s/\n//g; # strip newlines push @result, $_; } return @result; } sub getJar2DirMappings { my $mapping_file = shift; print "mapping_file=$mapping_file\n" if $SUBMAKE_DEBUG_DETAILS; open(FILE,$mapping_file) or die "Couldn't locate file $mapping_file!\n"; my @lines = <FILE>; my %result; foreach (@lines) { next if /^\#/; s/\n//; my @parts = split /\=/; $result{$parts[0]} = $parts[1]; } close(FILE); return %result; } sub removePreviousTmpFiles { if (-e $rmi_tmp_file) { unlink $rmi_tmp_file; } } sub setupPackageMapHash { print "Generating package_mappings.txt in testjars\n"; `perl $CVSWORK/build_util/Makefile_Maker/package_map_builder.pl testjars $patch`; print "Generating package_mappings.txt in thirdparty\n"; `perl $CVSWORK/build_util/Makefile_Maker/package_map_builder.pl thirdparty $patch`; open(TCS_PM, $tcs_pm); my @lines = <TCS_PM>; close(TCS_PM); my ($volume,$tcs_dir, $file) = File::Spec->splitpath($tcs_pm); foreach $line (@lines) { $line =~ s/\n$//; my @parts = split /\=/, $line; my @jar_parts = split /\+/,$parts[1]; foreach my $jar (@jar_parts) { if (exists $jar2dir_map{$jar}) { $jar = File::Spec->catfile($CVSWORK,'smswebgw',$jar2dir_map{$jar}); } else { $jar = File::Spec->catfile($volume,$tcs_dir,$jar); } } my $sub_classpath = join("\n",@jar_parts); $package_map_hash{$parts[0]} = $sub_classpath; } open(TP_PM, $tp_pm); @lines = <TP_PM>; close(TP_PM); my ($volume,$tp_dir, $file) = File::Spec->splitpath($tp_pm); foreach $line (@lines) { $line =~ s/\n$//; my @parts = split /\=/, $line; my @jar_parts = split /\+/,$parts[1]; foreach my $jar (@jar_parts) { $jar = File::Spec->catfile($volume,$tp_dir,$jar); } my $sub_classpath = join("\n",@jar_parts); $package_map_hash{$parts[0]} = $sub_classpath; } print "package_map_hash has " . scalar(keys %package_map_hash) . " entries\n"; } sub recordRMI { my $package_declaration = shift; print "package_declaration=$package_declaration\n" if $SUBMAKE_DEBUG_DETAILS; my $filename = shift; print "filename=$filename\n" if $SUBMAKE_DEBUG_DETAILS; my $line = shift; print "line=$line\n" if $SUBMAKE_DEBUG_DETAILS; return if ($package_declaration eq "notfound"); # remote object signature must be present in a public class definition return unless ($line =~ /^\s*public\s+.*class\s+.*extends\s+UnicastRemoteObject/); # abstract class => non-rmi compilable class #return if ($line =~ /abstract/); if (-e $rmi_tmp_file) { open(RMI_FILE,">> $rmi_tmp_file"); } else { open(RMI_FILE,"> $rmi_tmp_file"); } $package_declaration =~ s/\s+/\|/g; $filename =~ s/\.java//; my ($declarator,$package) = split /\|/,$package_declaration; $package =~ s/\;/\./; print RMI_FILE $package . $filename . "\n"; close(RMI_FILE); } sub wanted { return unless (/\.java$/); # Have to make sure a Makefile is present so that the optimization in writeMakefiles works. # Otherwise no Makefile is written if none is present. if (/\.java$/) { `touch Makefile`; } #print "Examining java file: $File::Find::name\n"; open(JAVAFILE,$_); my @lines = <JAVAFILE>; close(JAVAFILE); my $package_declaration = "notfound"; foreach $line (@lines) { $package_declaration = $line if $line =~ /^\s*package\s+/; recordRMI($package_declaration,$_,$line); my $is_package_import = 0; next if ($line =~ /^import\s+java\.|^import\s+javax\.swing|^import\s+org\.omg/); # this should be a litte more flexible. if ($line =~ /^import\s+/) { $line =~ s/\s+/\|/g; my @parts = split /\|/, $line; #print "Modified line is: $line\n"; my $package_part = $parts[1]; if (scalar(@parts)) { if ($package_part =~ /\.\*/) { $is_package_import = 1; } $package_part =~ s/\;|\s|\n|\.\*//g } if (exists $package_map_hash{$package_part}) { #print "Found package $package_part located in $package_map_hash{$package_part}\n"; $classpath_hash{$package_map_hash{$package_part}} = 1; } else { #print "Warning! Unable to locate $package_part package in any jar file.\n"; # OK This is really bad here. Here's why: Stripping off the last part without # knowing it is truly a class name is problematic because it yields false positives. # An example is what if you have tcs.ain.networkmgmt. You strip off the last part # and now it's tcs.ain. Well now you're probably will not find the tcs.ain.networkmgmt # classes in the same jar that contains tcs.ain classes, so the classpath will be # incomplete. A suggestion: Check the last part to see if it is a "class-like" name # (i.e. it has capital first letter.) Otherwise it looks like we'll be stuck storing # the class name in package_mappings.txt as the lowest common denominator. That will # suck because we'll then have to treat each import like it specifies a class, then # if that fails try stripping the last part of all class names in package_mappings.txt # Or maybe we could build two hashes, one to store packages and one to store class # names - along with their packages? Yikes this is really getting complicated... # Ooh, I know, we only assume that the import specifies a class if it does not end # in a .* - I think we have a winner. # Is the last part of the package is a class name? if ($is_package_import) { print "********** I cannot locate the package $package_part imported from $File::Find::name in any jar file ***********\n"; } my @package_parts = split /\./,$package_part; my $classname = pop(@package_parts); my $new_package = join('.',@package_parts); if (exists $package_map_hash{$new_package}) { #print "This was due to the last part of package $package_part is actually a class name: $classname\n"; #print "Located new package in $new_package\n"; $classpath_hash{$package_map_hash{$new_package}} = 1; } else { print "********** OK, I really cannot locate $new_package from $File::Find::name in any jar file ***********\n"; } } } } close(FILE); } 1;
*** This bug has been marked as a duplicate of 151715 ***