After an evaluation, GNOME has moved from Bugzilla to GitLab. Learn more about GitLab.
No new issues can be reported in GNOME Bugzilla anymore.
To report an issue in a GNOME project, go to GNOME GitLab.
Do not go to GNOME Gitlab for: Bluefish, Doxygen, GnuCash, GStreamer, java-gnome, LDTP, NetworkManager, Tomboy.
Bug 157232 - Crashes when I attempt to open a perl script
Crashes when I attempt to open a perl script
Status: RESOLVED DUPLICATE of bug 151715
Product: gedit
Classification: Applications
Component: general
2.6.x
Other All
: High critical
: ---
Assigned To: Gedit maintainers
gedit QA volunteers
Depends on:
Blocks:
 
 
Reported: 2004-11-03 13:58 UTC by Rob Manning
Modified: 2004-12-22 21:47 UTC
See Also:
GNOME target: ---
GNOME version: 2.5/2.6



Description Rob Manning 2004-11-03 13:58:49 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

Thread 1 (Thread -151129440 (LWP 3616))

  • #0 _dl_sysinfo_int80
    from /lib/ld-linux.so.2
  • #1 __waitpid_nocancel
    from /lib/tls/libpthread.so.0
  • #2 libgnomeui_module_info_get
    from /usr/lib/libgnomeui-2.so.0
  • #3 <signal handler called>
  • #4 gtk_file_system_module_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #5 shortcuts_model_filter_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #6 gtk_tree_model_sort_new_with_model
    from /usr/lib/libgtk-x11-2.0.so.0
  • #7 gtk_tree_model_sort_new_with_model
    from /usr/lib/libgtk-x11-2.0.so.0
  • #8 gtk_tree_model_sort_new_with_model
    from /usr/lib/libgtk-x11-2.0.so.0
  • #9 gtk_marshal_VOID__UINT_STRING
    from /usr/lib/libgtk-x11-2.0.so.0
  • #10 g_closure_invoke
    from /usr/lib/libgobject-2.0.so.0
  • #11 g_signal_emit_by_name
    from /usr/lib/libgobject-2.0.so.0
  • #12 g_signal_emit_valist
    from /usr/lib/libgobject-2.0.so.0
  • #13 g_signal_emit
    from /usr/lib/libgobject-2.0.so.0
  • #14 gtk_tree_model_row_inserted
    from /usr/lib/libgtk-x11-2.0.so.0
  • #15 gtk_file_system_module_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #16 g_cclosure_marshal_VOID__POINTER
    from /usr/lib/libgobject-2.0.so.0
  • #17 g_closure_invoke
    from /usr/lib/libgobject-2.0.so.0
  • #18 g_signal_emit_by_name
    from /usr/lib/libgobject-2.0.so.0
  • #19 g_signal_emit_valist
    from /usr/lib/libgobject-2.0.so.0
  • #20 g_signal_emit_by_name
    from /usr/lib/libgobject-2.0.so.0
  • #21 gtk_file_system_gnome_vfs_new
    from /usr/lib/gtk-2.0/2.4.0/filesystems/libgnome-vfs.so
  • #22 gtk_file_system_get_folder
    from /usr/lib/libgtk-x11-2.0.so.0
  • #23 gtk_file_system_module_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #24 shortcuts_model_filter_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #25 shortcuts_model_filter_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #26 gtk_file_chooser_get_current_folder_uri
    from /usr/lib/libgtk-x11-2.0.so.0
  • #27 shortcuts_model_filter_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #28 gtk_file_chooser_get_current_folder_uri
    from /usr/lib/libgtk-x11-2.0.so.0
  • #29 shortcuts_model_filter_get_type
    from /usr/lib/libgtk-x11-2.0.so.0
  • #30 gtk_file_chooser_get_current_folder_uri
    from /usr/lib/libgtk-x11-2.0.so.0
  • #31 gtk_file_chooser_set_current_folder_uri
    from /usr/lib/libgtk-x11-2.0.so.0
  • #32 bonobo_mdi_save_state
  • #33 bonobo_mdi_save_state
  • #34 gedit_file_selector_open_multi
  • #35 gedit_file_open
  • #36 ??
  • #37 TC_GNOME_Gedit_Application_struct
  • #38 ??
  • #39 ??
  • #40 ??
    from /usr/lib/libbonoboui-2.so.0
  • #41 ??
  • #42 gedit_cmd_file_open
  • #43 ??
  • #44 ??
  • #0 _dl_sysinfo_int80
    from /lib/ld-linux.so.2

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;
Comment 1 Paolo Borelli 2004-11-03 14:06:07 UTC

*** This bug has been marked as a duplicate of 151715 ***