RetroZilla/config/make-chromelist.pl

164 lines
5.4 KiB
Perl

#!/usr/bin/perl -w
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla 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/MPL/
#
# 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 the Chrome/CVS Location Matcher.
#
# The Initial Developer of the Original Code is
# Gervase Markham.
# Portions created by the Initial Developer are Copyright (C) 2001
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****
# Version 0.5
#
# This file creates a large list of the mappings between chrome path and CVS
# paths which are recorded in the jar.mn files throughout the tree. This list
# is shipped with builds to make it easier for people to create chrome patches
# using them.
use Fcntl qw(:DEFAULT :flock);
use File::Basename;
use Cwd;
use mozLock;
# This is necessary because this module is not present in Perl versions less
# than 5.004_05.
eval q{use File::Spec};
exit if $@;
# This file takes two parameters - the jar file to process, and the chrome
# directory we are compiling into.
my ($chrome, $jar, $flock) = @ARGV;
my $nofilelocks = $flock ? ($flock eq "-l") : 0;
# OS setup - which chrome does your OS use?
#
# The $^O variable contains some representation of what OS you are on.
# Find its value on your platform by running the following command:
# perl -e 'print $^O . "\n";'
# and set the relevant booleans accordingly depending on what
# chrome your platform uses. There are currently three sorts of chrome:
# win, mac, and unix.
my $win32 = ($^O =~ /((MS)?win32)|msys|cygwin|os2/i) ? 1 : 0;
my $macos = ($^O =~ /MacOS|darwin/i) ? 1 : 0;
my $unix = !($win32 || $macos) ? 1 : 0;
# Testing only - generate chromelist.txt for other platforms
# $macos = 1;
# $unix = 0;
my $chromelist = File::Spec->catfile($chrome, "chromelist.txt");
my $lockfile = $chromelist . ".lck";
mozLock($lockfile) unless $nofilelocks;
open(BIGLIST, ">>" . $chromelist) or die "Can't open chromelist.txt";
open(JARFILE, "<$jar");
# Find the absolute directory the jar.mn file is in
my $stub = File::Spec->catdir(getcwd(), dirname($jar));
# Convert back to Unix-style directory names for the CVS version
if ($macos) { $stub =~ tr|:|/|; }
if ($win32) { $stub =~ tr|\\|/|; }
# Turn the absolute path into a relative path inside the CVS tree
$stub =~ s|.*mozilla/?||;
my $jarfilename = "";
while (<JARFILE>)
{
# Tidy up the line
chomp;
s/^[\s|\+]+//; # Some lines have a + sign before them
s/\s+$//;
# There's loads of things we aren't interested in
next if m/^\s*#/; # Comments
next if m/^$/; # Blank lines
next if m/\.gif\)\s*$/i; # Graphics
next if m/\.png\)\s*$/i;
next if m/\.jpe?g\)\s*$/i;
next if ($stub =~ m|/win/|) and !$win32;
next if ($stub =~ m|/unix/|) and !$unix;
next if ($stub =~ m|/mac/|) and !$macos;
if (m/\s*(.*)\.jar:/) # e.g. "comm.jar:"
{
$jarfilename = $1;
next;
}
# Split up the common format, which is e.g.:
# messenger/skin/fred/foo.xul (xpfe/barney/wilma/foo.xul)
m/(.*)\s+\((.*)\)/;
my $chromefile = $1;
my $cvsfile = $2;
# Deal with those jar.mns which have just a single line,
# implying that the file is in the current directory.
if (!$1 || $1 eq "")
{
$chromefile = File::Spec::Unix->canonpath("$jarfilename/$_");
# match / 0 or 1 time and all chars except / to the end of the string.
# this is so it can also handle the case where a file is located in the
# root of the base directory (e.g. icon.png).
$_ =~ /\/?([^\/]*?)$/;
$cvsfile = File::Spec::Unix->canonpath($1);
} else {
$chromefile = File::Spec::Unix->canonpath("$jarfilename/$chromefile");
$cvsfile = File::Spec::Unix->canonpath($cvsfile);
}
# Convert to platform-specific separator for the chrome version.
# This permits easy grepping of the file for a given path.
if ($macos) { $chromefile =~ tr|/|:|; }
if ($win32) { $chromefile =~ tr|/|\\|; }
# Deal with leading slashes, if there is one we do not need
# to add the stub and need to remove that slash
if ($cvsfile =~ m|^/|) {
$cvsfile =~ s/^\///;
$cvsfile = File::Spec::Unix->catfile($cvsfile);
} else {
$cvsfile = File::Spec::Unix->catfile($stub, $cvsfile);
}
print BIGLIST "$chromefile ($cvsfile)\n";
}
mozUnlock($lockfile) unless $nofilelocks;
exit(0);