lib/Y/AoC/Task.pm

   1 package Y::AoC::Task;
   2
   3 use v5.36;
   4
   5 use Exporter ('import');
   6 our @EXPORT = qw(t asay bsay);
   7 use Y::AoC qw(red white grey yellow day year);
   8
   9 our $printed_err;
  10 $SIG{__DIE__} = sub($msg) {
  11         $msg =~ s/\A(.*?)( at \S+ )(line \d+)/red($1).$2.white($3)/e
  12                 if -t STDERR && !$printed_err++;
  13         say STDERR $msg;
  14         die "\n";
  15 };
  16
  17 $SIG{__WARN__} = sub($msg) {
  18         $msg =~ s/\A(.*?)( at \S+ )(line \d+)/red($1).$2.white($3)/e
  19                 if -t STDERR && !$printed_err++;
  20         say STDERR $msg;
  21 };
  22
  23 our $in_test;
  24 sub t($subtest = ()) {
  25         $subtest //= '';
  26         $ARGV[0] =~ s/in\.txt/test$subtest.txt/;
  27         $in_test = 1;
  28 }
  29
  30 sub asay(@msg) {
  31         try_submit(1, @msg);
  32 }
  33
  34 sub bsay(@msg) {
  35         try_submit(2, @msg);
  36 }
  37
  38 sub try_submit($part, @msg) {
  39         my $msg = join($, // '', @msg);
  40         my $ans;
  41         $msg =~ s/(\w+)\z/white($ans = $1)/e;
  42
  43         say $msg;
  44
  45         return if $in_test;
  46
  47         my $day = day;
  48         my $year = year;
  49
  50         my $url = "https://adventofcode.com/$year/day/$day/answer";
  51         my $cachefile = "ans-$year-$day-$part-$ans.html";
  52         local $| = 1;
  53         print "\nSubmit $url\nlevel=", white($part), ' answer=',
  54                 white($ans), ' ? [Enter]/[Ctrl-C]: ';
  55
  56         scalar <STDIN>;
  57         eval '{
  58                 local $SIG{__DIE__};
  59                 require Y::AoC::UA;
  60         }';
  61         my $res = Y::AoC::UA::request($url, {
  62                 form => {
  63                         answer => $ans,
  64                         level  => $part,
  65                 },
  66                 cache_to => $cachefile,
  67         });
  68
  69         my $art = $res->find('main > article > p')->join("\n");
  70         if (!$art) {
  71                 say $res->to_string;
  72                 return;
  73         }
  74
  75         $art =~ s/&#39;/'/g;
  76         $art =~ s/(?<=That's )not(?= the right answer)/red($&)/e;
  77         my $ok = $art =~ s/(?<=That's the )(right answer)/yellow($&)/e;
  78         $art =~ s/(gold stars?)/yellow($&)/e;
  79         $art =~ s/(silver star)/grey($&)/e;
  80         Y::AoC::UA::cache_del($cachefile)
  81                 if $msg =~ s/(?<=Please wait ).*?(?= before trying again)/white($&)/e;
  82         $art =~ s/(?<=your answer is )([^\.;]+)/red($&)/e;
  83         $art =~ s/<code>([^<]+)<\/code>/white($1)/e;
  84         $art =~ s/<[^>]+>//g;
  85
  86         if ($ok) {
  87                 system "cp $0 backup/$0-ok-$ans-$part";
  88         }
  89
  90         say $art;
  91 }
  92
  93 1;
  94 __END__
  95 package Y::AoC::UA;
  96
  97 sub new($class, $year, $day) {
  98         eval 'require
  99 }
 100
 101 sub get($ua) {
 102 1;