maps/Info/rewrite_exits.pl

#!/usr/bin/perl
# this will adjust the 'slaying' lines
# in the current directory, and all sub-directories,
# so shuffling maps to new directories is not a problem.
#
# This absolutely depends on each map having a unique name.
# This script should be placed outside of the map directory,
# but you should be inside it when you run it.  Ideally
# in the top-level maps directory.
# 
# Dupes are noted, and not adjusted.
# 

use File::Basename qw( basename );
use vars qw( $MAPBASE );
use strict;
use warnings;

# this is the base directory of the maps.
# The slaying linesthatpointtoothermaps,
# will be re-written as $MAPBASE/filename
$MAPBASE = "/mlab";

my %FILES = ();
my %DUPES = ();
open(FIND, "find ./|");
while (<FIND>) {
        chomp;
        next unless -f;
        next if $_ =~ /editor/;
        my $basename = basename($_);
        if ($FILES{$basename}) {
                unless (exists $DUPES{$basename}) {
                        $DUPES{$basename} = [];
                        push(@{ $DUPES{$basename} }, $FILES{$basename});
                }
                push(@{ $DUPES{$basename} }, $_);
                #warn "DUPE!: $_ => $FILES{$basename}\n";
        }
        else {
                $FILES{$basename} = $_;
        }
}
close(FIND);
foreach my $file (keys %DUPES) {
        delete $FILES{$file};
        print "Dupe filename: $file Sizes:";
        foreach my $x (@{ $DUPES{$file} }) {
                printf " %s", -s $x; # file size
                printf " %s", $x; # file path
        }
        print "\n";
}

foreach my $file (keys %FILES) {
        open(FILE, "<$FILES{$file}");
        my $data = join("", <FILE>);
        close(FILE);

        my $newdata = $data;

        $newdata =~ s/(slaying|final_map)\s+(.+)/mappath($1,$2)/eg;
        if ($newdata ne $data) {
                open(FILE, ">$FILES{$file}");
                print FILE $newdata;
                close(FILE);
        }
        #printf("%s => %s\n", $file, $FILES{$file});
}

sub mappath {
        my ($type,$name) = @_;
        $name =~ s/\s+//g;
        my $file = basename($name);
        my $new = $FILES{$file};
        if ($new) {
                unless ($file =~ /[a-z]/) {
                        print "CASE?: $file\n";
                }
                $new =~ s/^\.\///;
                return "$type $MAPBASE/$new";
        }
        return "$type $name";
}
Revision:	1.1.1.1 (vendor branch)
Committed:	Sat Feb 4 23:55:19 2006 UTC (18 years, 3 months ago) by root
Content type:	text/plain
Branch:	UPSTREAM, MAIN
CVS Tags:	post_fixaltar, last_stable, post_fixaltar2, rel-2_82, rel-2_81, rel-2_80, pre_coinconvert, UPSTREAM_2006_03_15, rel-3_0, rel-2_6, rel-2_7, rel-2_4, rel-2_5, rel-2_2, rel-2_0, rel-2_1, rel-2_72, rel-2_73, rel-2_71, rel-2_76, rel-2_77, rel-2_74, rel-2_75, rel-2_54, rel-2_55, rel-2_56, rel-2_79, UPSTREAM_2006_02_01, rel-2_53, pre_material_cfarch_normalize_run, rel-2_32, pre_fixconverter, post_coinconvert, pre_fixaltar2, pre_map_rename, UPSTREAM_2006_02_22, rel-2_90, rel-2_92, rel-2_93, rel-2_78, post_fixconverter, pre_fixaltar, rel-2_61, rel-2_43, rel-2_42, rel-2_41, HEAD
Changes since 1.1:	+0 -0 lines
Log Message:	Initial Import
#	Content
1	#!/usr/bin/perl
2	# this will adjust the 'slaying' lines
3	# in the current directory, and all sub-directories,
4	# so shuffling maps to new directories is not a problem.
5	#
6	# This absolutely depends on each map having a unique name.
7	# This script should be placed outside of the map directory,
8	# but you should be inside it when you run it. Ideally
9	# in the top-level maps directory.
10	#
11	# Dupes are noted, and not adjusted.
12	#
13
14	use File::Basename qw( basename );
15	use vars qw( $MAPBASE );
16	use strict;
17	use warnings;
18
19	# this is the base directory of the maps.
20	# The slaying linesthatpointtoothermaps,
21	# will be re-written as $MAPBASE/filename
22	$MAPBASE = "/mlab";
23
24	my %FILES = ();
25	my %DUPES = ();
26	open(FIND, "find ./\|");
27	while (<FIND>) {
28	chomp;
29	next unless -f;
30	next if $_ =~ /editor/;
31	my $basename = basename($_);
32	if ($FILES{$basename}) {
33	unless (exists $DUPES{$basename}) {
34	$DUPES{$basename} = [];
35	push(@{ $DUPES{$basename} }, $FILES{$basename});
36	}
37	push(@{ $DUPES{$basename} }, $_);
38	#warn "DUPE!: $_ => $FILES{$basename}\n";
39	}
40	else {
41	$FILES{$basename} = $_;
42	}
43	}
44	close(FIND);
45	foreach my $file (keys %DUPES) {
46	delete $FILES{$file};
47	print "Dupe filename: $file Sizes:";
48	foreach my $x (@{ $DUPES{$file} }) {
49	printf " %s", -s $x; # file size
50	printf " %s", $x; # file path
51	}
52	print "\n";
53	}
54
55	foreach my $file (keys %FILES) {
56	open(FILE, "<$FILES{$file}");
57	my $data = join("", <FILE>);
58	close(FILE);
59
60	my $newdata = $data;
61
62	$newdata =~ s/(slaying\|final_map)\s+(.+)/mappath($1,$2)/eg;
63	if ($newdata ne $data) {
64	open(FILE, ">$FILES{$file}");
65	print FILE $newdata;
66	close(FILE);
67	}
68	#printf("%s => %s\n", $file, $FILES{$file});
69	}
70
71	sub mappath {
72	my ($type,$name) = @_;
73	$name =~ s/\s+//g;
74	my $file = basename($name);
75	my $new = $FILES{$file};
76	if ($new) {
77	unless ($file =~ /[a-z]/) {
78	print "CASE?: $file\n";
79	}
80	$new =~ s/^\.\///;
81	return "$type $MAPBASE/$new";
82	}
83	return "$type $name";
84	}