=head1 NAME B - routines for automating CodeWarrior builds, and some extra-curricular activities related to building Mozilla =head1 SYNOPSIS use Moz; OpenErrorLog(":::BuildLog"); StopForErrors(); $Moz::QUIET = 1; InstallFromManifest(":projects:MANIFEST", $dist_dir); BuildProjectClean(":projects:SomeProject.mcp", "SomeTarget"); MakeAlias(":projects:SomeProject.shlb", $dist_dir); DontStopForErrors(); BuildProject(":projects:SomeOtherProject.mcp", "SomeTarget"); =head1 DESCRIPTION B comprises the routines needed to slap CodeWarrior around, force it to build a sequence of projects, report the results, and a few other things. =cut package Moz; require Exporter; use Mac::Types; use Mac::Events; use Mac::Processes; use File::Copy; @ISA = qw(Exporter); @EXPORT = qw(BuildProject BuildProjectClean OpenErrorLog MakeAlias StopForErrors DontStopForErrors InstallFromManifest InstallResources SetBuildNumber SetAgentString SetTimeBomb Delay ActivateApplication); @EXPORT_OK = qw(CloseErrorLog UseCodeWarriorLib QUIET); use Cwd; use File::Path; use ExtUtils::Manifest 'maniread'; use CodeWarriorLib; sub current_directory() { my $current_directory = cwd(); chop($current_directory) if ( $current_directory =~ m/:$/ ); return $current_directory; } sub full_path_to($) { my ($path) = @_; if ( $path =~ m/^[^:]+$/ ) { $path = ":" . $path; } if ( $path =~ m/^:/ ) { $path = current_directory() . $path; } return $path; } =head2 Setup Pretty much, everything is taken care of for you. However, B does use a little compiled AppleScript library (the file CodeWarriorLib) for some of its communcication with CodeWarrior. If this library isn't in the same directory as "Moz.pm", then you need to tell B where to find it. Call C. This routine is not exported by default, nor are you likely to need it. =cut sub UseCodeWarriorLib($) { # ($CodeWarriorLib) = @_; # $CodeWarriorLib = full_path_to($CodeWarriorLib); } sub activate_CodeWarrior() { #MacPerl::DoAppleScript(<, C The warnings and errors generated in the course of building projects can be logged to a file. Tinderbox uses this facility to show why a remote build failed. Logging is off by default. Start logging at any point in your build process with C. Stop with C. You never need to close the log explicitly, unless you want to just log a couple of projects in the middle of a big list. C is not exported by default. =cut sub CloseErrorLog() { if ( $logging ) { close(ERROR_LOG); $logging = 0; StopForErrors() if $stop_on_1st_error; } } sub OpenErrorLog($) { my ($log_file) = @_; CloseErrorLog(); if ( $log_file ) { $log_file = full_path_to($log_file); open(ERROR_LOG, ">$log_file") || die "Can't open logfile, check the file path.\n"; MacPerl::SetFileInfo("CWIE", "TEXT", $log_file); $log_file =~ m/.+:(.+)/; $recent_errors_file = full_path_to("$1.part"); $logging = 1; } } =head2 Stopping before it's too late - C, C When building a long list of projects, you decide whether to continue building subsequent projects when one fails. By default, your build script will C after the first project that generates an error while building. Change this behavior with C. Re-enable it with C. =cut sub StopForErrors() { $stop_on_1st_error = 1; # Can't stop for errors unless we notice them. # Can't notice them unless we are logging. # If the user didn't explicitly request logging, log to a temporary file. if ( ! $recent_errors_file ) { OpenErrorLog("${TMPDIR}BuildResults"); } } sub DontStopForErrors() { $stop_on_1st_error = 0; } sub log_message($) { if ( $logging ) { my ($message) = @_; print ERROR_LOG $message; } } sub log_message_with_time($) { if ( $logging ) { my ($message) = @_; my $time_stamp = localtime(); log_message("$message ($time_stamp)\n"); } } sub log_recent_errors($) { my ($project_name) = @_; my $found_errors = 0; if ( $logging ) { open(RECENT_ERRORS, "<$recent_errors_file"); while( ) { if ( /^Error/ || /^CouldnŐt find project file/ || /^Link Error/ ) { # if (!$found_errors) # print $_; $found_errors = 1; } print ERROR_LOG $_; } close(RECENT_ERRORS); unlink("$recent_errors_file"); } if ( $stop_on_1st_error && $found_errors ) { print ERROR_LOG "### Build failed.\n"; die "### Errors encountered building \"$project_name\".\n"; } } sub build_project($$$) { my ($project_path, $target_name, $clean_build) = @_; $project_path = full_path_to($project_path); # $project_path =~ m/.+:(.+)/; # my $project_name = $1; log_message_with_time("### Building \"$project_path\""); # Check that the given project exists if (! -e $project_path) { print ERROR_LOG "### Build failed.\n"; die "### Can't find project file \"$project_path\".\n"; } print "Building \"$project_path\[$target_name\]\"\n"; $had_errors = CodeWarriorLib::build_project( $project_path, $target_name, $recent_errors_file, $clean_build ); WaitNextEvent(); # $had_errors = #MacPerl::DoAppleScript(<, C C and C are identical, except that the latter first removes object code. In both, CodeWarrior opens the project if it wasn't already open; builds the given (or else current) target; and finally closes the project, if it wasn't already open. =cut sub BuildProject($;$) { my ($project_path, $target_name) = @_; build_project($project_path, $target_name, 0); } sub BuildProjectClean($;$) { my ($project_path, $target_name) = @_; build_project($project_path, $target_name, 1); } =head2 Miscellaneous C functions like C, except with better argument defaulting and more explicit error messages. =cut sub MakeAlias($$) { my ($old_file, $new_file) = @_; # if the directory to hold $new_file doesn't exist, create it if ( ($new_file =~ m/(.+:)/) && !-d $1 ) { mkpath($1); } # if a leaf name wasn't specified for $new_file, use the leaf from $old_file if ( ($new_file =~ m/:$/) && ($old_file =~ m/.+:(.+)/) ) { $new_file .= $1; } my $message = "Can't create a Finder alias (at \"$new_file\")\n for \"$old_file\"; because "; die "$message \"$old_file\" doesn't exist.\n" unless -e $old_file; die "$message I won't replace an existing (non-alias) file with an alias.\n" if ( -e $new_file && ! -l $new_file ); # now: $old_file exists; $new_file doesn't (or else, is an alias already) if ( -l $new_file ) { # ...then see if it already points to $old_file my $current_target = full_path_to(readlink($new_file)); my $new_target = full_path_to($old_file); return if ( $current_target eq $new_target ); # if the desired alias already exists and points to the right thing, then we're done unlink $new_file; } symlink($old_file, $new_file) || die "$message symlink returned an unexpected error.\n"; } =pod C =cut sub InstallFromManifest($;$$) { my ($manifest_file, $dest_dir, $flat) = @_; $flat = 0 unless defined($flat); # if $flat, all rel. paths in MANIFEST get aliased to the root of $dest_dir $dest_dir ||= ":"; $manifest_file =~ m/(.+):/; my $source_dir = $1; chop($dest_dir) if $dest_dir =~ m/:$/; #Mac::Events->import(); WaitNextEvent(); if ($flat) { print "Doing manifest on \"$manifest_file\" FLAT\n" unless $QUIET; } else { print "Doing manifest on \"$manifest_file\"\n" unless $QUIET; } my $read = maniread(full_path_to($manifest_file)); foreach $file (keys %$read) { next unless $file; $subdir = ":"; if (!$flat && ($file =~ /:.+:/ )) { $subdir = $&; } $file = ":$file" unless $file =~ m/^:/; MakeAlias("$source_dir$file", "$dest_dir$subdir"); } } =pod C =cut # parameters are path to MANIFEST file, destination dir, true (to make copies) or false (to make aliases) sub InstallResources($;$;$) { my ($manifest_file, $dest_dir, $copy_files) = @_; $dest_dir ||= ":"; mkpath($dest_dir) if !-d $dest_dir; $manifest_file =~ m/(.+):/; my $source_dir = $1; chop($dest_dir) if $dest_dir =~ m/:$/; WaitNextEvent(); print "Installing resources from \"$manifest_file\"\n" unless $QUIET; my $read = maniread(full_path_to($manifest_file)); foreach $file (keys %$read) { next unless $file; if ($copy_files) { copy("$source_dir:$file", "$dest_dir:$file"); } else { MakeAlias("$source_dir:$file", "$dest_dir:$file"); } } } sub SetBuildNumber { open (OUTPUT, ">:mozilla:config:build_number") || die "could not open buildnumber"; open (BDATE, "perl :mozilla:config:bdate.pl|"); while () { print OUTPUT $_; } close (BDATE); close (OUTPUT); system ("perl :mozilla:config:aboutime.pl :mozilla:xpfe:appshell:public:nsBuildID.h :mozilla:config:build_number"); system ("perl :mozilla:config:aboutime.pl :mozilla:xpfe:browser:resources:locale:en-US:navigator.dtd :mozilla:config:build_number"); system ("perl :mozilla:config:aboutime.pl :mozilla:xpfe:browser:resources:content:viewSource.xul :mozilla:config:build_number"); } sub SetAgentString { open (BDATE, ":mozilla:config:build_number") || die "could not open buildnumber"; while () { $build_number = $_; } close (BDATE); open (ORIGFILE, ":mozilla:cmd:macfe:restext:custom.r") || die "no original file"; open (OUTPUT, ">:mozilla:cmd:macfe:restext:agent.r") || die "no output file"; chop($build_number); while () { $tempstring = $_; if ($tempstring =~ "\#define VERSION_MAJOR_STR") { $tempstring = "\#define VERSION_MAJOR_STR \"5.0a1-" . $build_number . " Development\"\n"; } print OUTPUT $tempstring; } close (ORIGFILE); close (OUTPUT); unlink (":mozilla:cmd:macfe:restext:custom.r"); rename (":mozilla:cmd:macfe:restext:agent.r", ":mozilla:cmd:macfe:restext:custom.r"); } sub SetTimeBomb($$) { my ($warn_days, $bomb_days) = @_; system("perl :mozilla:config:mac-set-timebomb.pl $warn_days $bomb_days"); } sub Delay($) { my ($delay_seconds) = @_; $now = time; $exit_time = $now + $delay_seconds; while ($exit_time > $now) { $now = time; } } sub ActivateApplication($) { my ($appSignature) = @_; my ($psi, $found); my ($appPSN); $found = 0; foreach $psi (values(%Process)) { if ($psi->processSignature() eq $appSignature) { $appPSN = $psi->processNumber(); $found = 1; last; } } if ($found == 0) { return; } SetFrontProcess($appPSN); while (GetFrontProcess() != $appPSN) { WaitNextEvent(); } } 1; =head1 AUTHORS Scott Collins , Simon Fraser , Chris Yeh =head1 SEE ALSO BuildMozillaDebug.pl (et al), BuildList.pm, CodeWarriorLib (an AppleScript library) =head1 COPYRIGHT The contents of this file are subject to the Netscape Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/NPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is Mozilla Communicator client code, released March 31, 1998. The Initial Developer of the Original Code is Netscape Communications Corporation. Portions created by Netscape are Copyright (C) 1998-1999 Netscape Communications Corporation. All Rights Reserved. Contributor(s): =cut