All pastes #644944 Raw Edit

rrformat.pl

public text v1 · immutable
#644944 ·published 2007-08-04 00:29 UTC
rendered paste body
#!/usr/bin/perl

use strict;
use warnings;

###
# $rejects is the filename of the file containing cardnames to output, in the form of one full cardname per line
# $cards is the main card database, in the form of a Sistance-esv file
# $final is the output file, in a format readable for http://krypt0s.abcb.org/~nwguild/cgi-bin/ndpatch/
###
my $rejects = 'rejects';
my $cards = 'cdb';
my $final = 'ndrejects';


###
# Get the card files
###
open( REJECTS, "$rejects") or die "Couldn't open rejects file! $!\n";
my @rejects = <REJECTS>;
close REJECTS;

open( CARDDB, "$cards") or die "Couldn't open carddb file! $!\n";
my @cdb = <CARDDB>;
close CARDDB;

###
# getcolor() takes a string (ie, mana cost) and returns the color of the card,
# Which is one of White, Blue, Black, Red, Green, Multicolor, or Land
###
sub getcolor {
	my $card = shift;
	my $mana = $card->{mana};
	my $color;

	if ("$mana" eq '') { $color = 'L' } 			# Land
	elsif ("$mana" =~ /[WUBRG]{2}/) { $color = 'M' }	# Multicolor
	elsif ("$mana" =~ /W/) { $color = 'W' }			# White
	elsif ("$mana" =~ /U/) { $color = 'U' }			# Blue
	elsif ("$mana" =~ /B/) { $color = 'B' }			# Black
	elsif ("$mana" =~ /R/) { $color = 'R' }			# Red
	elsif ("$mana" =~ /G/) { $color = 'G' }			# Green
	elsif ("$mana" =~ /\d+/) { $color = 'A' }		# Artifact
	else { print "This card's entry for mana is malformed: $card->{name}\n" }

	return "$color";
}

###
# Parse the cdb input file into a more usable form.
###
my %carddb;
foreach my $card (@cdb) {
	chomp $card;
	my ($name, $mana, $type, $pt, $text, $rarity) = split(/\s*=\s*/, $card);
	$name =~ s/^\s+//;
	$carddb{"$name"} = {
		name	=> "$name", 	# This isn't as redundant as it seems
		mana	=> "$mana",
		type	=> "$type",
		pt	=> "$pt",
		text	=> "$text",
#		rarity	=> "$rarity",	# This line is here solely for people to tinker with the script
		rarity 	=> '+',		# Remove this line and uncomment the other if you want to play around. You'll probably need to write a getrarity() function
		color	=> undef,
	};

}

###
# Now we'll create the final DB of reject cards.
###
open( 	DBFILE, ">$final" ) or die "Cannot open DBFILE! $!\n";
foreach my $reject (@rejects) {
	chomp $reject;
	# Smooth out the rough parts in the entry
	if (exists($carddb{"$reject"})) {
		$carddb{"$reject"}->{'color'} = getcolor( $carddb{"$reject"} );
		# set pt to null if the card doesn't have one
		if ("$carddb{$reject}->{pt}" eq '/') { $carddb{"$reject"}->{'pt'} = '' }
		print	DBFILE "$carddb{$reject}->{name}|$carddb{$reject}->{rarity}|$carddb{$reject}->{color}|$carddb{$reject}->{mana}|$carddb{$reject}->{type}|$carddb{$reject}->{text}|$carddb{$reject}->{pt}\r\n";
	}
	
}
close(	DBFILE );

###
# Specification for the netdraft patch writer follows:
#
# The format for the input file is: CARDNAME|CARD RARITY|CARD COLOR|CASTING COST|CARD TYPE|CARD TEXT|POWER/TOUGHNESS
# There should be one card per line of the input file
# The field for card rarity should be only one character: - FOR COMMONS, = FOR UNCOMMONS, AND + FOR RARES
# The field for card color should be only one character: U, B, W, G, R, A, L, M (BLUE, BLACK, WHITE, GREEN, RED, ARTIFACT, LAND, MULTICOLOR)
# Example record: Angelic Wall|-|W|1W|Creature - Wall|(Walls can't attack)|0/4
# Make sure the last line of the input file is followed by a carriage return. 
###