Update card test generation and card info templating

* now accepts lower case name matching
* partial matching also works with confirmation with multiple matches
This commit is contained in:
jmlundeen 2025-10-26 15:47:41 -05:00
parent 45e43fabd4
commit 5bbcda3d4e
2 changed files with 136 additions and 24 deletions

View file

@ -2,6 +2,6 @@
[=$cardName=] [=$cardName=]
[=$manaCost=] [=$manaCost=]
[=$typeLine=] [=$typeLine=]
[=$abilities=][= $powerToughness ? "\n $powerToughness" : "" =] [=$abilities=][=$loyalty ? "\n Loyalty:$loyalty" : "" =][=$powerToughness ? "\n $powerToughness" : "" =]
*/ */
private static final String [=$classNameLower=] = "[=$cardName=]"; private static final String [=$classNameLower=] = "[=$cardName=]";

View file

@ -11,7 +11,6 @@ You can add as many additional cards as you like.
You can also call the script without arguments and it will prompt you for card names You can also call the script without arguments and it will prompt you for card names
=cut =cut
use Text::Template; use Text::Template;
use strict; use strict;
use File::Path qw(make_path); use File::Path qw(make_path);
@ -40,13 +39,88 @@ sub fixCost {
$string; $string;
} }
# Resolve a user-provided card name to the canonical card key in %cards.
# Tries:
# 1) exact key
# 2) case-insensitive exact match
# 3) case-insensitive substring match (if single match => use it, if multiple => warn and return undef)
sub resolveCardName {
my ($input) = @_;
return undef unless defined $input;
# trim whitespace
$input =~ s/^\s+|\s+$//g;
return $input if exists $cards{$input};
my $lc_input = lc $input;
# case-insensitive exact
foreach my $k (keys %cards) {
return $k if lc($k) eq $lc_input;
}
# substring (partial) matches
my @matches = grep { index(lc($_), $lc_input) != -1 } keys %cards;
if (@matches == 1) {
return $matches[0];
} elsif (@matches > 1) {
@matches = sort @matches;
# If not interactive, don't block; print candidates and return undef
unless (-t STDIN) {
warn "Multiple matches found for '$input' (non-interactive):\n";
foreach my $m (@matches) { warn " $m\n"; }
warn "Please be more specific.\n";
return undef;
}
print "Multiple matches found for '$input':\n";
my $i = 0;
foreach my $m (@matches) {
$i++;
print " $i) $m\n";
}
while (1) {
print "Select a number (1-$i) or 0 to cancel: ";
my $choice = <STDIN>;
unless (defined $choice) { print "\nNo selection (EOF). Skipping.\n"; return undef; }
chomp $choice;
$choice =~ s/^\s+|\s+$//g;
# numeric choice
if ($choice =~ /^\d+$/) {
my $num = int($choice);
if ($num == 0) {
return undef;
} elsif ($num >= 1 && $num <= $i) {
return $matches[$num - 1];
}
} else {
# try exact name match among candidates (case-insensitive)
foreach my $m (@matches) {
return $m if lc($m) eq lc($choice);
}
}
print "Invalid selection, please try again.\n";
}
}
return undef;
}
sub generateCardInfo { sub generateCardInfo {
my ($cardName, $infoTemplate) = @_; my ($cardName, $infoTemplate) = @_;
# attempt to resolve loosely if direct lookup fails
if (!exists $cards{$cardName}) { if (!exists $cards{$cardName}) {
my $resolved = resolveCardName($cardName);
if (!defined $resolved) {
warn "Card name doesn't exist: $cardName (skipping)\n"; warn "Card name doesn't exist: $cardName (skipping)\n";
return ""; return "";
} }
$cardName = $resolved;
}
my %vars; my %vars;
$vars{'classNameLower'} = lcfirst(toCamelCase($cardName)); $vars{'classNameLower'} = lcfirst(toCamelCase($cardName));
@ -61,17 +135,30 @@ sub generateCardInfo {
$vars{'manaCost'} = $card[4]; $vars{'manaCost'} = $card[4];
$vars{'typeLine'} = $card[5]; $vars{'typeLine'} = $card[5];
my $cardAbilities = $card[8]; # Check if this is a planeswalker
my $isPlaneswalker = $card[5] =~ /Planeswalker/i;
my $cardAbilities;
if ($isPlaneswalker) {
# For planeswalkers: field 6 is loyalty, field 7 is abilities
$vars{'loyalty'} = $card[6] if $card[6]; # loyalty
$cardAbilities = $card[7];
} else {
# For non-planeswalkers: field 6/7 is power/toughness, field 8 is abilities
if ($card[6]) {
$vars{'powerToughness'} = "$card[6]/$card[7]";
}
$cardAbilities = $card[8];
}
my @abilities = split(/\$/, $cardAbilities); my @abilities = split(/\$/, $cardAbilities);
my $abilitiesFormatted = join("\n ", @abilities); my $abilitiesFormatted = join("\n ", @abilities);
$vars{'abilities'} = $abilitiesFormatted; $vars{'abilities'} = $abilitiesFormatted;
if ($card[6]) {
$vars{'powerToughness'} = "$card[6]/$card[7]"
}
return $infoTemplate->fill_in(HASH => \%vars); return $infoTemplate->fill_in(HASH => \%vars);
} }
my $author; my $author;
if (-e $authorFile) { if (-e $authorFile) {
open(DATA, $authorFile) || die "can't open $authorFile : $!"; open(DATA, $authorFile) || die "can't open $authorFile : $!";
@ -110,7 +197,7 @@ while (my $line = <DATA>) {
} }
close(DATA); close(DATA);
# Get card names from arguments # Get card names from arguments or prompt
my @cardNames = @ARGV; my @cardNames = @ARGV;
if (@cardNames == 0) { if (@cardNames == 0) {
print 'Enter a card name: '; print 'Enter a card name: ';
@ -127,17 +214,27 @@ if (@cardNames == 0) {
} }
} }
# Trim whitespace for all inputs
foreach my $i (0..$#cardNames) {
$cardNames[$i] =~ s/^\s+|\s+$//g if defined $cardNames[$i];
}
# Main card is the first one # Main card is the first one
my $mainCardName = $cardNames[0]; my $mainCardNameInput = $cardNames[0];
my @additionalCards = @cardNames[1..$#cardNames];
# Resolve main card with loose matching
my $resolvedMain = resolveCardName($mainCardNameInput);
if (!defined $resolvedMain) {
die "Card name doesn't exist or is ambiguous: $mainCardNameInput\n";
}
my $mainCardName = $resolvedMain;
my @additionalCardsInput = ();
if (@cardNames > 1) {
@additionalCardsInput = @cardNames[1..$#cardNames];
}
if (!exists $cards{$mainCardName}) { if (!exists $cards{$mainCardName}) {
my $possible;
foreach $possible (sort keys(%cards)) {
if ($possible =~ m/$mainCardName/img && $mainCardName =~ m/..../) {
print("Did you mean $possible?\n");
}
}
die "Card name doesn't exist: $mainCardName\n"; die "Card name doesn't exist: $mainCardName\n";
} }
@ -153,7 +250,17 @@ $vars{'classNameLower'} = lcfirst(toCamelCase($mainCardName));
$vars{'cardNameFirstLetter'} = lc substr($mainCardName, 0, 1); $vars{'cardNameFirstLetter'} = lc substr($mainCardName, 0, 1);
foreach my $setName (keys %{$cards{$originalName}}) { foreach my $setName (keys %{$cards{$originalName}}) {
if (exists $sets{$setName}) {
$setCode = lc($sets{$setName}); $setCode = lc($sets{$setName});
last; # Use the first valid set found
}
}
# Fallback if no valid set code was found
unless (defined $setCode) {
warn "Warning: No valid set code found for card '$mainCardName'. Using 'unk' as fallback.\n";
warn "Available sets for this card: " . join(", ", keys %{$cards{$originalName}}) . "\n";
$setCode = 'unk';
} }
# Check if card is already implemented # Check if card is already implemented
@ -177,10 +284,15 @@ $vars{'setCode'} = $setCode;
# Generate main card info # Generate main card info
my $allCardInfo = generateCardInfo($mainCardName, $infoTemplate); my $allCardInfo = generateCardInfo($mainCardName, $infoTemplate);
# Generate additional card info templates # Generate additional card info templates (resolve each loosely)
foreach my $additionalCard (@additionalCards) { foreach my $additionalCardInput (@additionalCardsInput) {
my $additionalInfo = generateCardInfo($additionalCard, $infoTemplate); my $resolved = resolveCardName($additionalCardInput);
if (defined $additionalInfo) { if (!defined $resolved) {
warn "Skipping additional card (not found or ambiguous): $additionalCardInput\n";
next;
}
my $additionalInfo = generateCardInfo($resolved, $infoTemplate);
if (defined $additionalInfo && $additionalInfo ne '') {
$allCardInfo .= "\n\n" . $additionalInfo; $allCardInfo .= "\n\n" . $additionalInfo;
} }
} }
@ -193,6 +305,6 @@ print CARD $result;
close CARD; close CARD;
print "$fileName\n"; print "$fileName\n";
if (@additionalCards > 0) { if (@additionalCardsInput > 0) {
print "Additional cards included: " . join(", ", @additionalCards) . "\n"; print "Additional cards included: " . join(", ", map { resolveCardName($_) // $_ } @additionalCardsInput) . "\n";
} }