#!/usr/local/bin/perl
# Last Modified Time-stamp: "2019-06-14 02:29:46 MDT"
#
#  Here's hoping that the search screen will show new items,
#  even if there's old items mixed in.
#  (What order is the search screen showing them in?
#     In just database SKU order?)
#
#     -- sburke@cpan.org, 2015-05-07
#
#
# Fun fact: Until 2015-05-07, this feed had been dead since 2009!
#            ...and yet was constantly being polled on my server!
#
#--------------------------------------------------------------------------------
BEGIN { binmode($_, ":utf8") foreach *STDIN, *STDOUT, *STDERR; }
use utf8;
use strict;
use constant DEBUG => $ENV{'MAILTO'} ? 0 : 0;

#sub XML::RSS::SimpleGen::DEBUG () {6};
$| = 1;
use XML::RSS::SimpleGen 12;

DEBUG and print "HELLO from ", __FILE__, " at DEBUG level ", DEBUG, "!\n\n";



my $url = "https://www.newyorker.com/cartoons";
my $url_per_issue = "https://www.newyorker.com/cartoons/issue-cartoons";
rss_new(
  $url,
  "New Yorker Cartoons!",
);
rss_thrice_daily();
rss_language("en-US");
rss_webmaster('sburke@cpan.org');
rss_self_url(      "http://interglacial.com/rss/new_yorker_cartoon.rss" );
rss_generator_url( "http://interglacial.com/rss/new_yorker_cartoon.pl"  );
rss_livejournal( 'newyorkertoon' );

my $save_file    = "new_yorker_cartoon.rss";
#my $history_file = "new_yorker_cartoon.dat";
my $max_days_unchanged_time = 4;

#rss_history_file($history_file) if $history_file;


my $search_url = "https://www.newyorker.com/cartoons";


Main();
exit;

#----------------------------------------------------------------------------



#----------------------------------------------------------------------------

sub Main {
  my @divs;
  my $start_time = time();
  
  DEBUG and print "Getting $search_url at ", scalar(localtime($start_time)), "...\n";
  my  $gotten = get_url( $search_url );

  {
    # make the document just the pure javascript sections
    my(@chunks);
    while( $gotten =~ m/<script\b.*?> (.*?)  <\/script\s*>/gismx ) {
      push @chunks, $1;
    }
    $gotten = join "\n\n", @chunks if @chunks > 2;
  }

  my(@records);
  {
    my $record_start = qr/(,"canonicalUrl":)/;
    $gotten =~ s/$record_start/\e\e\e$1/g;
    @records = split "\e\e\e", $gotten;
    @records = grep $_ =~ $record_start, @records;
    for(@records) { s/,"social":\{.+//; }

    $gotten = join "\n\n\n", @records; # for future ref

  }

  #$gotten =~ s/\}/\}\n/g;

  #$gotten =~ s/(href=\")/\n\n $1/g;

  DEBUG and print "Got\n ", length($gotten), " bytes from\n $search_url\n after ", 
     time() - $start_time, " seconds\n\n"
  ;

  rss_item_limit(100);

DEBUG > 3 and print "GOTTEN: ~~~\n\n$gotten~~\n\n";

  my @urls_gotten;
  my %seen_url;
  my %url2caption;
  my %url2image_url;
  my %url2pubdate;

DEBUG and print "Now scanning the ", scalar(@records), " records...\n";

 Record:
  foreach my $record (@records) {
    my( $url, $caption, $img_src, $pubdate );

    DEBUG > 3 and print "Considering record: <<\n$record\n>>\n";
    if($record =~
      qr!
          \A
          ,
          \"canonicalUrl\"
          :\"
             (
               https:
	         \/\/
		   (?: www\. )?
	           newyorker\.com/cartoon/.*?
             )
          \",
        !x
    ) {
      $url = $1;
      DEBUG and print "  Got record's URL: $url\n";
    } else {
      DEBUG and print
	"No cartoony URL in record {...",
        length($record), " bytes",
        "...}\n Skipping.\n",
      ;
      next Record;
    }

    if($record =~ 
      qr!
          \"caption\"
          : \" (.*?) \"
          ,
        !x
    ) {
      $caption = $1;
      DEBUG and print "  Got record's caption: $caption\n";
    } else {
      DEBUG and print "  Hm, no caption.\n";
    }

    if($record =~
       qr!
          \"imageUrl\"
          : \"
	    (
	      https?:// .*? [^\"\ \<\>\{\}]{20,250}
	    )
	  \"
         !x
         # Like "imageUrl":"https://media.newyorker.com/cartoons/5a66276944377923a90ad222/16:9/w_1200,h_630,c_limit/DC012218.jpg",
    ) { 
      $img_src = $1;
      DEBUG and print "  Got image source: $img_src\n";
    } else {
      next Record;
    }

    if($record =~
       qr!
          \"pubDate\"
          : \" ( [^\"\{\}\[\]\<\>]{5,40} ) \"  # like "January 19, 2018"
         !x
    ) {
      $pubdate = $1;
      DEBUG and print "  Got pubdate: $pubdate\n";
    } else {
      next Record;
    }


    DEBUG and print
      " So, Snared: <url:", $url // "?",
      "> <caption:",   $caption // "~", 
      "> <source:",    $img_src // "~", 
      ">\n\n";
    $url = json_unescape($url);
    $caption = json_unescape($caption);

    push @urls_gotten, $url unless $seen_url{$url};
    $seen_url{$url}++;

    $url2image_url{$url} ||= $img_src;
    $url2caption{$url}   ||= $caption;
    $url2pubdate{$url}   ||= $pubdate;
  }

  DEBUG and print "\n\nDone scanning records.\n";

  DEBUG and print "Number of gottens: ", scalar( keys %seen_url ), "\n";

  if(DEBUG > 1) {
    foreach (@urls_gotten) { print " $_\n"; }
    print "\n";
  }

  DEBUG  > 10 and do { print "-Bailing-\n"; exit; };

  while( scalar @urls_gotten ) {
    $url = shift @urls_gotten;
    my $caption   = $url2caption{   $url };
    my $image_url = $url2image_url{ $url };
    my $pubdate = $url2pubdate{$url};

    # To make sure there's a caption...
    #
    my $maybe_br_and_pubdate = "";

    if($pubdate) {
      $maybe_br_and_pubdate = "&lt;br&gt;$pubdate";
    }

    if($caption) {
      ;
    } else {
      $caption = $url;
      if($url =~ qr@/([^/]+)\z@ ) { # It should match.
	$caption = $1;
	$caption =~ s<-updated><>;
	$caption =~ s<jpg><>;
	my $pub = $pubdate;
	if($pub) {
	  $pub .= "- $pub - ";
	} else {
	  $pub ="";
	}
	
	$caption = "[Cartoon $pub$caption]";
      }
    }


    my $data = $caption;
    my $caption_and_that;
    $caption_and_that =
      "&lt;img src=\"$image_url\" &gt; &lt;br&gt; $caption$maybe_br_and_pubdate"
     if $image_url;

    DEBUG and print "Logging RSS item:\n",
      "\t u:\t$url\n",
      "\t c:\t$caption\n",  # title, actually
      "\t txt:\t$caption_and_that\n",
      "\n",
    ;
    rss_item($url, $caption, $caption_and_that);

  }

  Get_Per_Issue_Items();

  
  my $count = rss_item_count;
  $count >= 3 or die "\n\n$0: $count items found at $search_url ?!\n\n{{\n$gotten\n}}\n\nAborting";
  DEBUG and print "Wrote ", rss_item_count(), " items.\n";
  DEBUG and print "Saving to $save_file\n";
  rss_save($save_file, $max_days_unchanged_time);
  DEBUG and print "Wrote ", -s $save_file, " bytes.\n";
  DEBUG and print "Done at ", scalar(localtime), ".\n";
  DEBUG and print "Wrote ", rss_item_count(), " items.\n";

  return;
}

#===========================================================================

sub url_base_from_url {
  my($url) = @_;
  return "" unless $url;

  if( $url =~ 
    m!
      \A ( https?:// [^ \#\?/:]+ ) /
     !xi
  ) {
    my $url_base = $1 // "?url?";
    DEBUG and print "URL Base from $url\n is:", $url_base, "\n";
    return $url_base;
  }

  print "No URL Base in $url ?!?\n";
  return "";
}


#===========================================================================

sub Get_Per_Issue_Items {
  ;
  my $url = $url_per_issue;
  DEBUG and print "\n\nHELLO from Get_Per_Issue_Items!\n";
  DEBUG and print "\n****\nGetting $url ...\n";

  my $url_base = url_base_from_url($url);
  DEBUG and print "URL_Base: $url_base\n";
  
  my $gotten = get_url($url);
  my $orig_size = length($gotten);
  DEBUG and print "Got ", length($gotten), " bytes from $url\n";

  $gotten =~
    s/></>\n</g
  ;
  $gotten =~ s@<script.*?>.*?</script>@@gism;
  $gotten =~ s@<svg.*?>.*?</svg>@@gism;
  $gotten =
    join "\n",
    grep {;
	  $_ !~ qr/\bdata:image/i
	  and
	  $_ !~ qr/<(picture|path|g|section|meta)\b/i # source|

	  #and
	  #$_ !~ qr/<path/
	}
    split m/[\cm\cj]+/,
    $gotten
  ;
  $gotten =~ s@<(path|g)\b@@;

  my $trimmed_length = length $gotten;

  while( $gotten =~
    s@(</div>)[ \t\cm\cj]+(</div)@$1$2@g
        # Compact adjacent </div>...</div> until you can't
  ) {
    ;
  }

DEBUG > 0 and print "GOTTEN is whittled to $trimmed_length bytes...\n";
DEBUG > 0 and print "GOTTEN: ~~~\n\n$gotten~~\n\n";

  my @records;
  while( $gotten =~
   m@
      (
      <li \b [^<>\cm\cj]+ \s*>
      (.*?)
      </li>
      )
    @gismx
  ) {
    my($r) = ($1 // '?1?');
    next unless $r =~ m/<h4/i;
    $r =~ s/<\/picture>.+//gism
      or die "Couldn't kill </picture>.+ in:\n{{\n$r\n}}\n\n";
    push @records, $r;
    DEBUG and print "Record ", scalar(@records), ":\n{{$r}}\n\n\n";
  }

  die "Not enough records (only ", scalar(@records), ") in gotten {{$gotten}}\n"
    unless @records > 4;

  die "Too many records (", scalar(@records), " records) in gotten {{$gotten}}\n"
    if @records > 12;

  DEBUG and print " Got", scalar @records, " records from $url\n\n\n";

  Loop_Over_Records(\@records, $url_base);

  ;
  return;
}

#============================================================================

sub Loop_Over_Records {
  my($recs_r, $url_base) = @_;

  my $rss_count = rss_item_count;

 Record_To_Scan:
  foreach my $r (@$recs_r) {
    #DEBUG and print "Record to scan: {{\n$r\n}}\n\n";

    $r =~
      #s/
      #( \s+ )
      #\b
      #class="[^\"<> \t\n\r]*"
      #( \s+ | > )
      #/$1/gismx

      s/
	 (?: \s+ )
	 (?:
	   class="[^\"<>]*"
	 )
	 
       //gismx
      or die "Can't match any class=\"...\" things in \$r\n"
    ;
    $r =~ s/\s+>/>/g;

    DEBUG and print "\n\n////Record to scan: {{\n$r\n}}\n\n";
    # NOW LET'S ROCK!

    my($title, $link_url, $image_url);


#<source media="(min-width: 1280px)" srcSet="https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_280,c_limit/181022_a22238.jpg, https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_560,c_limit/181022_a22238.jpg 2x"/>
#<source media="(min-width: 1024px)" srcSet="https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_223,c_limit/181022_a22238.jpg, https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_446,c_limit/181022_a22238.jpg 2x"/>
#<source media="(min-width: 768px)" srcSet="https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_172,c_limit/181022_a22238.jpg, https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_344,c_limit/181022_a22238.jpg 2x"/>
#<source srcSet="https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_116,c_limit/181022_a22238.jpg, https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_232,c_limit/181022_a22238.jpg 2x"/>
#<img alt="" src="https://media.newyorker.com/cartoons/5bbff3ca25cbcf2d7f5b77e1/4:3/w_116,c_limit/181022_a22238.jpg" title=""/>


    if(
      $r =~
      
      m@
	 <a
	 \s+
	 href="(/cartoons/issue-cartoons/cartoons-from-the-[-a-z0-9]{5,30}-issue)" #1
	 >
         \s+
	 <h4>
	 (                               #2
	   [, a-zA-Z0-9]{5,40}
	   Issue
	 )
	 \s*
	 </h4>

	 (?:
	   .*? # skipping aaaall kinds of stuff
	   <img
	   \b
	   [^<>]*?
	   \b
	   src="
	     (           # 3
	       https?:
	       //
	       [^<>\" ]+
	       # .*?
	     )
           "
	 )
	   
      @ismx
    ) {
      ($link_url, $title, $image_url) = ( 
					 $1 // "",
					 $2 // "",
					 $3 // $4 // "",
      );

      $link_url = $url_base . $link_url;
      DEBUG and print
       "R:\n title: $title\n link_url: $link_url\n image_url: $image_url\n}}}\n\n";

      if($image_url =~ m<\bw_560\b>) {
	# we have a good size, no point in looking for better
      } else {
       Possibly_Better_Size:
        foreach my $size (qw( w_560 w_446 w_344)) {
	  my  $possible_better_url = $image_url;
	  if( $possible_better_url =~ s<w_\d\d\d,><$size,> ) {
	    my $qm = quotemeta $possible_better_url;
	    $qm = qr/$qm/;
	    if($r =~ $qm) {
	      DEBUG and print "||I found $possible_better_url in this record, so I'm switching to that\n";
	      $image_url = $possible_better_url;
	      last Possibly_Better_Size;
	    } else {
	      DEBUG and print "||Couldn't find a $possible_better_url in the record\n";
	    }
	  } else {
	    DEBUG and print "|| I can't tweak $possible_better_url to use $size!?\n";
	  }
	}
      }

    } else {
      DEBUG and print "No item-etc in that record\n\n\n";
      next Record_To_Scan;
    }

    my $caption_and_that =
        "&lt;img src=\"$image_url\""
      . "&gt; "
      . "&lt;br&gt; $title"
      . "&lt;br&gt; "
     if $image_url
    ;

    DEBUG and print "RSS_Item {$link_url} {$title} {$caption_and_that}\n";

    rss_item($link_url, $title, $caption_and_that);
    #rss_item($url, "Guh");

    DEBUG and print "Item count now: ", rss_item_count(), "\n";

    DEBUG > 2 and print "~~~~~~~\nRSS SO FAR:\n", rss_as_string(), "\n~~~~~~\n";
  }

  DEBUG and print "Bye from Get_Per_Issue_Items\n\n";

  ;
  return;
}


#===========================================================================

sub json_unescape {
  my($n) = @_;
  return undef unless defined $n;
  my $orig_n = $n;
  $n =~ s/\\u([a-fA-F0-9]{4})/chr(hex($1))/eg;
  if(DEBUG and $n ne $orig_n) { print "CHAR\t$orig_n ->\n\t$n\n"; }
  return $n;
}

#===========================================================================
use URI;
sub decode_mailto_url {
  my($n) = @_;
   #  mailto:?subject=From%20newyorker.com:%20&amp;body=%0D%0Ahttps%3A%2F%2Fwww.newyorker.com%2Fcartoon%2Fdc012418jpg
   #          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  DEBUG and print "Mailto URL: $n\n";
  my(@parts) =
    split
     #qr/&\(&amp;\)?/,
     qr/&/,
     $n || ''
  ;
  return unless @parts;
  #DEBUG and print "NUMBER OF PARTS: ", scalar(@parts), "\n";
  #DEBUG and print "\n\n THE PARTS:", map( "\t$_\n", @parts), "\n";

  @parts = grep 
    grep {;
      $_ =~ s/\Abody=// # true if this succeeds, otherwise skipped
    }
    @parts;
  ;
  my(@main_parts);

  use URI::Escape;    

  my($text,$url);
  foreach my $part (@parts) {
    $part = uri_unescape( $part );
    $part =~ s<\A[\cm\cj]+><>;
    $part =~ s<[\cm\cj]+\z><>;
    #next unless $part =~ s<\Abody=>;
    DEBUG and print " INTERESTING Part:{$part}\n";
    $part =~ s<[\cm\cj]*><>; # trailing trailing thing
    if($part =~
       qr<
         \A(.*?)\cm\cj
         (https://.*?)
         \z
       >ix
    ) {
      DEBUG and print "\tTitle: $1\n\tURL: $2\n";
      ($text, $url) = ($1,$2);
    }
  }



  #return unless @main_parts;
}



#===========================================================================

#===========================================================================
__END__
