view release on metacpan or  search on metacpan

lib/App/Tarotplane/Cards.pm  view on Meta::CPAN

package App::Tarotplane::Cards;
our $VERSION = '2.02';
use 5.016;
use strict;
use warnings;

use List::Util qw(shuffle);

use constant {
    CARD_TERM => 0,
    CARD_DEF  => 1,
};

sub _read_cardfile {

    my $file = shift;

    my @cards;

    my $fh;
    if ($file eq '-') {
        $fh = *STDIN;
    } else {
        open $fh, '<', $file or die "Could not open $file: $!\n";
    }

    my $card = {};

    my $cn = 1;

    my $state = CARD_TERM;

    my $l = '';
    while (defined $l) {

        $l = readline $fh;

        if (not defined $l or $l eq "%\n") {

            # Blank cards are okay
            next if not defined $card->{Term};

            die "No definition for card #$cn in $file\n"
                unless $state == CARD_DEF;

            # Trim leading/trailing whitespace
            $card->{Term}       =~ s/^\s+|\s+$//g;
            $card->{Definition} =~ s/^\s+|\s+$//g;

            # Truncate whitespace
            $card->{Term}       =~ s/\s+/ /g;
            $card->{Definition} =~ s/\s+/ /g;

            ## Now interpret some escape codes
            # '\:' -> ':'
            $card->{Term}       =~ s/\\:/:/g;
            $card->{Definition} =~ s/\\:/:/g;

            # '\n' -> line break
            $card->{Term}       =~ s/\\n/\n/g;
            $card->{Definition} =~ s/\\n/\n/g;

            # No longer need '\\' substitution null byte
            $card->{Term}       =~ s/\0//g;
            $card->{Definition} =~ s/\0//g;

            push @cards, $card;
            $card = {};
            $state = CARD_TERM;

            $cn++;

            next;

        }

        # Skip comments and blanks
        my $first = substr $l, 0, 1;
        next if $first eq '#' or $first eq "\n";

        # Substitute '\\' now so that '\\:' does not count as an escaped colon.
        # The null byte is added so that the subsequent substitutions do not
        # try to replace any '\\' escaped backslash.
        $l =~ s/\\\\/\\\0/g;

        if ($state == CARD_TERM) {
            # Does card contain non-escaped colon?
            if ($l =~ /(^|[^\\]):/) {
                my (undef,
                    $te,
                    $de
                ) = split(/(^.*[^\\]):/, $l, 2);
                $card->{Term}       .= $te || '';
                $card->{Definition} .= $de || '';
                $state = CARD_DEF;
            } else {
                $card->{Term} .= $l;
            }
        } else {
            $card->{Definition} .= $l;
        }

    }

    close $fh unless $fh eq *STDIN;

    die "No cards found in $file\n" unless @cards;

    return @cards;

}

sub new {

    my $class = shift;
    my @files = @_;

    my $self = {
        Cards   => [],
        CardNum => 0,
    };

    foreach my $f (@files) {

        my @cards = _read_cardfile($f);

        push @{$self->{Cards}}, @cards;
        $self->{CardNum} += scalar @cards;

    }

    bless $self, $class;
    return $self;

}

sub get {

    my $self = shift;
    my $get  = shift;

    if (defined $self->{$get}) {
        return $self->{$get};
    }

    return undef;