view release on metacpan or  search on metacpan

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN

package Acme::AsciiArtinator;
use Carp;
use base 'Exporter';
use strict;
use warnings;
our $VERSION = '0.04';
our @EXPORT = qw(asciiartinate);
$| = 1;

my $DEBUG = 0;

#############################################################################

#
# run ASCII Artinization on a picture and a code string.
#
sub asciiartinate {
  my %opts = @_;
  if (@_ == 1 && ref $_[0] eq "HASH") {
    %opts = @{$_[0]};
  }

  my ($PIC, $CODE, $OUTPUT);

  if (defined $opts{"debug"} && $opts{"debug"}) {
    $DEBUG = 1;
  }

  if (defined $opts{"art_file"}) {
    my $fh;
    local $/ = undef;
    open($fh, "<", $opts{"art_file"}) || croak "Invalid  art_file  specification: $!\n";
    $PIC = <$fh>;
    close $fh;
  } elsif (defined $opts{"art_string"}) {
    $PIC = $opts{"art_string"};
  } elsif (defined $opts{"art"}) {
    $PIC = $opts{"art"};
  } else {
    croak "Invalid spec. Must specify  art, art_file, or  art_string \n";
  }
  $Acme::AsciiArtinator::PIC = $PIC;

  if (defined $opts{"code_file"}) {
    my $fh;
    local $/ = undef;
    open($fh, "<", $opts{"code_file"}) || croak "Invalid  code_file  specification: $!\n";
    $CODE = <$fh>;
    close $fh;
  } elsif ($opts{"code_string"}) {
    $CODE = $opts{"code_string"};
  } elsif ($opts{"code"}) {
    $CODE = $opts{"code"};
  } else {
    croak "Invalid spec. Must specify  code, code_file,  or  code_string \n";
  }

  if (defined $opts{"output"}) {
    $OUTPUT = $opts{"output"};
  } else {
    print STDERR "Output will go to \"ascii-art.pl\"\n" if $DEBUG;
    $OUTPUT = "ascii-art.pl";
  }

  if (defined $opts{"compile-check"}) {
    my $fh;
    open($fh, ">", "ascii-art.$$.pl");
    print $fh $CODE;
    close $fh;

    my $c1 = &compile_check("ascii-art.$$.pl");
    unlink "ascii-art.$$.pl";
    if ($c1 > 0) {
      croak "Initial code in ",$opts{"code"},$opts{"code_string"},
	    $opts{"code_file"}," does not compile!\n";
    }
  }

  my $ntest = 1;
  while (defined $opts{"test_argv$ntest"} || defined $opts{"test_input$ntest"}) {
    my (@test_argv, @test_stdin) = ();

    @test_argv = @{$opts{"test_argv$ntest"}} if defined $opts{"test_argv$ntest"};
    @test_stdin = @{$opts{"test_input$ntest"}} if defined $opts{"test_input$ntest"};
    my $fh;
    if (open($fh, ">", "ascii-art-test-$ntest-$$.pl")) {
      print $fh $CODE;
      close $fh;

      my $output = "";
      if (defined $opts{"test_input$ntest"}) {
	open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
	print $fh @test_stdin;
	close $fh;
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin\n} if $DEBUG;
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin};
	unlink "ascii-art-test-$ntest-$$.stdin";
      } else {
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv\n};
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv};
      }
      print "Ran pre-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";

      $Acme::AsciiArtinator::TestOutput[$ntest] = $output;
      unlink "ascii-art-test-$ntest-$$.pl";
    } else {