#===========================================================================
#
# SCF: a parsed site file.

package Sitescooper::SCF;

require Exporter;
use Carp;

@ISA = qw(Exporter);
@EXPORT= qw();
$VERSION = "0.1";
sub Version { $VERSION; }
use strict;

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

sub new {
  my ($class, $scoop) = @_;
  $class = ref($class) || $class;

  my $self = {
    'scoop'			=> $scoop,
    'active'			=> undef,
    'levels'			=> undef,
    'site_file_url'		=> undef,

    'top_level_extra_urls'	=> undef,
    'story_extra_urls'		=> undef,
    'links_extra_urls'		=> { },

    'grep'			=> 0,

    'sizelimit'			=> undef,
    'min_pages'			=> undef,
    'name'			=> undef,
    'site_defined_at'		=> undef,
    'site_format'		=> undef,
    'links_start'		=> { },
    'links_end'			=> { },
    'links_incl_start'		=> { },
    'links_incl_end'		=> { },
    'story_start'		=> undef,
    'story_end'			=> undef,
    'story_incl_start'		=> 0,
    'story_incl_end'		=> 0,
    'links_limit_to'		=> { },
    'story_limit_to'		=> undef,
    'def_story_limit_to'	=> undef,
    'links_print'		=> { },
    'links_trim'		=> { },
    'story_skip'		=> undef,
    'links_skip'		=> { },
    'story_diff'		=> undef,
    'links_diff'		=> { },
    'story_follow_links'	=> undef,
    'links_follow_links'	=> { },
    'story_lifetime'		=> undef,
    'story_postproc'		=> undef,
    'story_preproc'		=> undef,
    'url_preproc'		=> undef,
    'image_process'		=> undef,

    # cacheable setting has 3 values:
    #  0 = static, 1 = dynamic, undef = use heuristics
    'story_cacheable'		=> undef,
    'links_cacheable'		=> { },

    'printable_sub'		=> undef,
    'use_alt_tags'		=> undef,
    'head_pat'			=> undef,
    'story_use_table_smarts'	=> undef,
    'links_use_table_smarts'	=> undef,
    'story_html_header'		=> undef,
    'story_html_footer'		=> undef,
    'rights'			=> undef,
    'need_login_url'		=> undef,
    'eval_code'			=> undef,
    'image_only_site'		=> undef,
    'image_max_width'		=> undef,
    'ignore_profiles'		=> undef,
    'table_render'		=> undef,

    'url_regexp_cache'		=> { }
  };

  bless ($self, $class);
  $self;
}

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

sub set_defaults
{
  my ($self, $url, $confline) = @_;

  $self->{site_defined_at} = $confline;
  $self->{active} = 1;           # active by default
  $self->{url} = $url;
  $self->{name} = $url;
  # $self->{head_pat} = '(?i)<title>(.*?)</title>';
  $self->{'grep'} = $self->{scoop}->{cf}->{grepmode};
  $self->{min_pages} = undef;
  $self->{levels} = -1;		# 1-level site, just 1 story by default
  $self->{top_level_extra_urls} = '';    # no extra URLs
  $self->{story_extra_urls} = '';        # no extra URLs
  $self->{story_lifetime} = 90;  # dont scoop stories older than 3 months
  $self->{links_trim}->{0} = 1024;       # trim after last href + 1024 chars (contents)
  $self->{links_trim}->{1} = 1024;       # trim after last href + 1024 chars (issue)
  $self->{image_max_width} = 300;
  $self->{image_only_site} = 0;

  # default limit: to articles at the same site
  # we don't set story_limit_to itself, as otherwise sites cannot fall
  # through to LayoutURLs to define the StoryURL.
  $url =~ m,^((http|file)://[^/]*/),i;
  if (defined $1) {
    $self->{def_story_limit_to} = $1.'.*';
  } else {
    $self->{scoop}->sitewarn_file_line ($confline,
                    "Unsupported URL protocol for URL '".$url."'.\n");
  }
}

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

sub load_site_file
{
  my ($self) = @_;

  my $url = $self->{site_file_url};
  if (!defined $url) { return; }

  delete $self->{site_file_url};		# only try this once

  my $req = new HTTP::Request ('GET', $url);
  my $resp = $self->{scoop}->{useragent}->request_handle_cookie_redirects
  		($self->{scoop}->{cookie_jar}, $req);

  if (defined($resp->content_type) &&
      $resp->content_type ne '' &&
      $resp->content_type !~ /^(text\/|multipart\/)/)
  {
    $self->{scoop}->sitewarn_file_line ("$url:0",
    		"Non-text content type: ".$resp->content_type);
    return;
  }

  if (!$resp->is_success()) {
    $self->{scoop}->sitewarn_file_line ("$url:0",
    		"HTTP GET failed: ".$resp->status_line);
    return;
  }

  my $text = $resp->content();
  my @conf = ();
  my @conflines = ();
  my $line = 0;
  foreach my $line (split (/\n/, $text)) {
    push (@conf, $line);
    push (@conflines, "$url:$line"); $line++;
  }

  $self->{scoop}->dbg ("Scooping site from URL \"$url\".");
  $self->{scoop}->parse_conf_with_lines (\@conf, \@conflines);
}

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

sub get_story_param
{
  my ($self, $parmname, $url) = @_;

  if (!defined $parmname || !defined $url || !defined $self) {
    carp "get_layout_param with undefined arg: $parmname $url ".
				(defined $self ? "self==def" : "self==undef");
    return undef;
  }

  my $pat;
  my $layitem;
  my $scoop = $self->{scoop};

  if ($scoop->{scfs}->{have_exceptions} || $scoop->{scfs}->{have_layouts}) { study $url; }

  # This code originally used eval to interpolate the name of the
  # parameter appropriately. It now uses symbolic references,
  # resulting in a massive speedup (1/10th of the time previously
  # spent in this method!)

  # Highest priority, check for an ExceptionURL rule.
  if ($scoop->{scfs}->{have_exceptions}) {
    foreach $pat (@{$scoop->{scfs}->{exception_order}}) {
      next unless ($self->match_url ($url, $pat));
      $layitem = ${$scoop->{scfs}->{exceptions}}{$pat};
      if (defined $layitem->{$parmname}) {
        return $layitem->{$parmname};
      }
    }
  }

  # check for a parameter defined in the site file for this site.
  if (defined $self->{$parmname}) {
    return $self->{$parmname};
  }

  # nope -- now check the layouts.
  if ($scoop->{scfs}->{have_layouts}) {
    foreach $pat (@{$scoop->{scfs}->{layout_order}}) {             # perky! ;)
      next unless ($self->match_url ($url, $pat));
      $layitem = ${$scoop->{scfs}->{layouts}}{$pat};
      if (defined $layitem->{${parmname}}) {
        return $layitem->{${parmname}};
      }
    }
  }

  undef;
}

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

sub get_links_param
{
  my ($self, $parmname, $url, $level) = @_;

  if (!defined $parmname || !defined $url || !defined $self) {
    carp "get_layout_param with undefined arg: $parmname $url ".
				(defined $self ? "self==def" : "self==undef");
    return undef;
  }

  my $pat;
  my $layitem;
  my $scoop = $self->{scoop};

  if ($scoop->{scfs}->{have_exceptions} || $scoop->{scfs}->{have_layouts}) { study $url; }

  # This code originally used eval to interpolate the name of the
  # parameter appropriately. It now uses symbolic references,
  # resulting in a massive speedup (1/10th of the time previously
  # spent in this method!)

  # Highest priority, check for an ExceptionURL rule.
  if ($scoop->{scfs}->{have_exceptions}) {
    foreach $pat (@{$scoop->{scfs}->{exception_order}}) {
      next unless ($self->match_url ($url, $pat));
      $layitem = ${$scoop->{scfs}->{exceptions}}{$pat};
      if (defined $layitem->{$parmname}->{$level}) {
        return $layitem->{$parmname}->{$level};
      }
    }
  }

  # check for a parameter defined in the site file for this site.
  if (defined $self->{$parmname}->{$level}) {
    return $self->{$parmname}->{$level};
  }

  # nope -- now check the layouts.
  if ($scoop->{scfs}->{have_layouts}) {
    foreach $pat (@{$scoop->{scfs}->{layout_order}}) {             # perky! ;)
      next unless ($self->match_url ($url, $pat));
      $layitem = ${$scoop->{scfs}->{layouts}}{$pat};
      if (defined $layitem->{$parmname}->{$level}) {
        return $layitem->{$parmname}->{$level};
      }
    }
  }

  undef;
}

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

sub ParseConfigLine {
  my ($self, $scoop, $line, $confline) = @_;
  local ($_) = $line;

  /^Name: (.*)$/ and ($self->{name} = $1), return 1;
  /^Description: (.*)$/ and return 1;	# we don't use it!
  /^AuthorName: (.*)$/ and return 1;	# we don't use it!
  /^AuthorE[mM]ail: (.*)$/ and return 1;	# we don't use it!

  /^SiteFileURL: (.*)$/ and
  	($self->{site_file_url} = $self->expand_url_magic ($1)), return 1;

  /^Active: (.*)$/ and ($self->{active} = $1+0), return 1;
  /^Grep: (.*)$/ and ($self->{'grep'} = $1+0), return 1;
  /^SizeLimit: (\d+)\s*[Kk]*$/ and ($self->{sizelimit} = $1+0), return 1;
  /^MinPages: (\d+)$/ and ($self->{min_pages} = $1+0), return 1;
  /^Levels: (.*)$/ and ($self->{levels} = $1-2), return 1;
  /^AddURL: (.*)$/ and
  	($self->{top_level_extra_urls} .= ' '.$self->expand_url_magic ($1)), return 1;
  /^RequireCookie: (.*)$/ and ($self->{req_cookie} = $1), return 1;
  /^RequireEnvVariable: (.*)$/ and ($self->{req_env} = $1), return 1;
  /^Rights: (.*)$/ and ($self->{rights} = $1), return 1;
  /^TableRender: (.*)$/ and ($self->{table_render} = $1), return 1;

  /^Level(\d+)LinksStart: (.*)$/ and
  	($self->{links_start}->{$1-2} = $2), return 1;
  /^Level(\d+)LinksEnd: (.*)$/ and
  	($self->{links_end}->{$1-2} = $2), return 1;
  /^Level(\d+)LinksIncludeStartPattern: (.*)$/ and
  	($self->{links_incl_start}->{$1-2} = $2+0), return 1;
  /^Level(\d+)LinksIncludeEndPattern: (.*)$/ and
  	($self->{links_incl_end}->{$1-2} = $2+0), return 1;
  /^Level(\d+)Print: (.*)$/ and
  	($self->{links_print}->{$1-2} = $2+0), return 1;
  /^Level(\d+)TrimAfterLinks: (.*)$/ and
  	($self->{links_trim}->{$1-2} = $2+0), return 1;
  /^Level(\d+)Cache?able: (.*)$/ and
  	($self->{links_cacheable}->{$1-2} = $2+0), return 1;
  /^Level(\d+)Diff: (.*)$/ and
  	($self->{links_diff}->{$1-2} = $2+0), return 1;
  /^Level(\d+)UseTableSmarts: (.*)$/ and
  	($self->{links_use_table_smarts}->{$1-2} = $2+0), return 1;
  /^Level(\d+)FollowLinks: (.*)$/ and
  	($self->{links_follow_links}->{$1-2} = $2+0), return 1;
  if (/^Level(\d+)AddURL: (.*)$/) {
    $self->{links_extra_urls}->{$1-2} .= ' '.$self->expand_url_magic ($2);
    return 1;
  }
  if (/^Level(\d+)SkipURL: (.*)$/) {
    my $lev = $1;
    my $pat = $2;
    $pat = $self->expand_url_magic ($pat);
    $self->{links_skip}->{$lev-2} =
	  $self->{scoop}->AddRegexpToSet ($self->{links_skip}->{$lev-2}, $pat);
    return 1;
  }

  if (/^Level(\d+)URL: (.*)$/) {
    my $lev = $1;
    my $pat = $2;
    $pat = $self->expand_url_magic ($pat);
    $self->{links_limit_to}->{$lev-2} =
	  $self->{scoop}->AddRegexpToSet ($self->{links_limit_to}->{$lev-2}, $pat);
    return 1;
  }

  /^IssueLinksStart: (.*)$/ and
  	($self->{links_start}->{1} = $1), return 1;
  /^IssueLinksEnd: (.*)$/ and
  	($self->{links_end}->{1} = $1), return 1;
  /^IssueLinksIncludeStartPattern: (.*)$/ and
  	($self->{links_incl_start}->{1} = $1+0), return 1;
  /^IssueLinksIncludeEndPattern: (.*)$/ and
  	($self->{links_incl_end}->{1} = $1+0), return 1;
  /^IssuePrint: (.*)$/ and
  	($self->{links_print}->{1} = $1+0), return 1;
  /^IssueTrimAfterLinks: (.*)$/ and
  	($self->{links_trim}->{1} = $1+0), return 1;
  /^IssueCache?able: (.*)$/ and
  	($self->{links_cacheable}->{1} = $1+0), return 1;
  /^IssueDiff: (.*)$/ and
  	($self->{links_diff}->{1} = $1+0), return 1;
  /^IssueUseTableSmarts: (.*)$/ and
  	($self->{links_use_table_smarts}->{1} = $1+0), return 1;
  /^IssueFollowLinks: (.*)$/ and
  	($self->{links_follow_links}->{1} = $1+0), return 1;
  if (/^IssueAddURL: (.*)$/) {
    $self->{links_extra_urls}->{1} .= ' '.$self->expand_url_magic ($1);
    return 1;
  }
  if (/^IssueSkipURL: (.*)$/) {
    my $pat = $1;
    $pat = $self->expand_url_magic ($pat);
    $self->{links_skip}->{1} =
	      $self->{scoop}->AddRegexpToSet ($self->{links_skip}->{1}, $pat);
    return 1;
  }

  # Normally Issue-level stuff is the highest level, so this would seem to
  # be irrelevant as we never would have to decide whether a URL is the
  # issues page since it's provided in the site file. However the
  # IssueFollowLinks parameter provides a need for this.
  if (/^IssueURL: (.*)$/) {
    my $pat = $1;
    $pat = $self->expand_url_magic ($pat);
    $self->{links_limit_to}->{1} =
	      $self->{scoop}->AddRegexpToSet ($self->{links_limit_to}->{1}, $pat);
    return 1;
  }

  if (/^ContentsFormat: (.*)$/) {
    my $fmt = $1;
    if ($fmt eq 'rss') {
      # set up defaults for a Rich Site Summary site.
      # cf. http://my.netscape.com/publish/
      $self->{site_format} = 'rss';
      $self->{links_start}->{0} = '(<rdf:RDF|<rss version=|<scriptingNews)';
      $self->{links_end}->{0} = '(</rdf:RDF>|</rss>|</scriptingNews>)';
      $self->{links_diff}->{0} = 1;
      $self->{levels} = 0;

    } elsif ($fmt eq 'html') {
      # the default -- do nothing.

    } else {
      $self->{scoop}->sitewarn_file_line ($confline,
      			"Unrecognised ContentsFormat: $_\n");
    }
    return 1;
  }

  /^ContentsStart: (.*)$/ and
  	($self->{links_start}->{0} = $1), return 1;
  /^ContentsEnd: (.*)$/ and
  	($self->{links_end}->{0} = $1), return 1;
  /^ContentsIncludeStartPattern: (.*)$/ and
  	($self->{links_incl_start}->{0} = $1+0), return 1;
  /^ContentsIncludeEndPattern: (.*)$/ and
  	($self->{links_incl_end}->{0} = $1+0), return 1;
  /^ContentsPrint: (.*)$/ and
  	($self->{links_print}->{0} = $1+0), return 1;
  /^ContentsTrimAfterLinks: (.*)$/ and
  	($self->{links_trim}->{0} = $1+0), return 1;
  /^ContentsCache?able: (.*)$/ and
  	($self->{links_cacheable}->{0} = $1+0), return 1;
  if (/^ContentsSkipURL: (.*)$/) {
    my $pat = $1;
    $pat = $self->expand_url_magic ($pat);
    $self->{links_skip}->{0} =
	  $self->{scoop}->AddRegexpToSet ($self->{links_skip}->{0}, $pat);
    return 1;
  }
  /^ContentsDiff: (.*)$/ and
  	($self->{links_diff}->{0} = $1+0), return 1;
  /^ContentsUseTableSmarts: (.*)$/ and
  	($self->{links_use_table_smarts}->{0} = $1+0), return 1;
  /^ContentsFollowLinks: (.*)$/	and
  	($self->{links_follow_links}->{0} = $1+0), return 1;
  if (/^ContentsAddURL: (.*)$/) {
    $self->{links_extra_urls}->{0} .= ' '.$self->expand_url_magic ($1);
    return 1;
  }

  if (/^ContentsURL: (.*)$/) {
    my $pat = $self->expand_url_magic ($1);
    $self->{links_limit_to}->{0} =
	      $self->{scoop}->AddRegexpToSet ($self->{links_limit_to}->{0}, $pat);
    return 1;
  }

  /^StoryStart: (.*)$/	and ($self->{story_start} = $1), return 1;
  /^StoryEnd: (.*)$/		and ($self->{story_end} = $1), return 1;
  /^StoryIncludeStartPattern: (.*)$/
  		and ($self->{story_incl_start} = $1+0), return 1;
  /^StoryIncludeEndPattern: (.*)$/
  		and ($self->{story_incl_end} = $1+0), return 1;
  /^StoryCache?able: (.*)$/	and ($self->{story_cacheable} = $1+0), return 1;
  /^StoryDiff: (.*)$/		and ($self->{story_diff} = $1+0), return 1;
  if (/^StorySkipURL: (.*)$/) {
    my $pat = $1;
    $pat = $self->expand_url_magic ($pat);
    $self->{story_skip} = $self->{scoop}->AddRegexpToSet ($self->{story_skip}, $pat);
    return 1;
  }
  /^StoryHeadline: (.*)$/	and ($self->{head_pat} = $1), return 1;
  /^StoryToPrintableSub: (.*)$/	and ($self->{printable_sub} = $1), return 1;
  /^(Story|)UseTableSmarts: (.*)$/ and
  	($self->{story_use_table_smarts} = $2+0), return 1;
  /^StoryFollowLinks: (.*)$/	and ($self->{story_follow_links} = $1+0), return 1;
  /^StoryLifetime: (.*)$/	and ($self->{story_lifetime} = $1+0), return 1;
  /^StoryHTMLHeader: (.*)$/ and ($self->{story_html_header} = $1), return 1;
  /^StoryHTMLFooter: (.*)$/ and ($self->{story_html_footer} = $1), return 1;
  if (/^StoryAddURL: (.*)$/) {
    $self->{story_extra_urls} .= ' '.$self->expand_url_magic ($1);
    return 1;
  }

  if (/^UseAltTagForURL: (.*)$/) {
    my $pat = $self->expand_url_magic ($1);
    $self->{use_alt_tags} = $self->{scoop}->AddRegexpToSet ($self->{use_alt_tags}, $pat);
    return 1;
  }

  if (/^NeedLoginURL: (.*)$/) {
    my $pat = $self->expand_url_magic ($1);
    $self->{need_login_url} = $self->{scoop}->AddRegexpToSet ($self->{need_login_url}, $pat);
    return 1;
  }

  if (/^StoryURL: (.*)$/) {
    my $pat = $self->expand_url_magic ($1);
    $self->{story_limit_to} = $self->{scoop}->AddRegexpToSet ($self->{story_limit_to}, $pat);
    return 1;
  }

  /^ImageCache?able: (.*)$/	and ($self->{image_cacheable} = $1+0), return 1;

  if (/^ImageURL: (.*)$/) {
    my $pat = $self->expand_url_magic ($1);
    $self->{imageurl} = $self->{scoop}->AddRegexpToSet ($self->{imageurl}, $pat);
    return 1;
  }

  # used to get image only sites... (thx to kld)
  if (/^ImageOnlySite: (.*)$/) {
    $self->{image_only_site} = 1;
    return 1;
  }

  if (/^ImageScaleToMaxWidth: (.*)$/) {
    $self->{image_max_width} = $1+0;
    return 1;
  }

  if (/^IgnoreProfiles: (.*)$/) {
    $self->{ignore_profiles} = $1+0;
    return 1;
  }

  if (/^(URL)Process: (.*)$/) {
    my $type = $1;
    my $val = $2;
    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = $type;
      $self->{postprocval} = $val;
    } else {
      if ($type eq 'URL') { $self->{url_preproc} = $val; }
    }
    return 1;
  }

  if (/^(Story)PostProcess: (.*)$/) {
    my $type = $1;
    my $val = $2;
    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = $type;
      $self->{postprocval} = $val;
    } else {
      if ($type eq 'Story') { $self->{story_postproc} = $val; }
    }
    return 1;
  }

  if (/^EvaluatePerl: (.*)$/) {
    my $val = $2;

    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = "Eval";
      $self->{postprocval} = $val;
    } else {
      $self->{eval_code} = $val;
    }
    return 1;
  }

  if (/^(Contents|Issue|Level\d+)HTMLPreProcess: (.*)$/) {
    my $type = $1;
    my $val = $2;

    my $lev;
    ($type eq 'Contents') &&	($lev = 0);
    ($type eq 'Issue') &&	($lev = 1);
    ($type =~ /Level(\d+)/) && ($lev = $1-2);

    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = "level $lev LinksPre";
      $self->{postprocval} = $val;
    } else {
      $self->{links_preproc}->{$lev} = $val;
    }
    return 1;
  }

  if (/^StoryHTMLPreProcess: (.*)$/) {
    my $type = 'StoryPre';
    my $val = $1;
    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = $type;
      $self->{postprocval} = $val;
    } else {
      if ($type eq 'StoryPre') { $self->{story_preproc} = $val; }
    }
    return 1;
  }

  if (/^ImageProcess: (.*)$/) {
    my $type = 'Image';
    my $val = $1;
    if ($val =~ s/^\{//) #}
    {
      $self->{postproctype} = $type;
      $self->{postprocval} = $val;
    } else {
      if ($type eq 'Image') { $self->{image_process} = $val; }
    }
    return 1;
  }
  undef;
}

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

sub ParseConfigScopedLine {
  my ($self, $scoop, $line, $confline) = @_;
  local ($_) = $line;

  if (defined $self->{postproctype}) {
    $self->{postprocval} .= $_;

    # see if it's the end of the postproc statement scope
    my $x = $self->{postprocval}; 1 while ($x =~ s/\{[^\{\}]*\}//gs);    #{

    if ($x =~ /\}\s*$/)		# an unmatched close-tag
    {			#{
      $self->{postprocval} =~ /^(.*)\}\s*$/; $_ = $1;

      if ($self->{postproctype} eq 'Story') {
	$self->{story_postproc} = $_;
      }
      elsif ($self->{postproctype} eq 'StoryPre') {
	$self->{story_preproc} = $_;
      }
      elsif ($self->{postproctype} eq 'Image') {
	$self->{image_process} = $_;
      }
      elsif ($self->{postproctype} =~ /level (\d+) LinksPre/) {
	my $lev = $1;
	$self->{links_preproc}->{$lev} = $_;
      }
      elsif ($self->{postproctype} eq 'URL') {
	$self->{url_preproc} = $_;
      }
      elsif ($self->{postproctype} eq 'Eval') {
	$self->{eval_code} = $_;
      }
      else { die "unknown postprocval $self->{postproctype}"; }

      $self->{postprocval} = undef;
      $self->{postproctype} = undef;
    }
    return 1;
  }
  undef;
}

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

sub is_in_scoped_statement {
  my $self = shift;

  return (defined $self->{postproctype});
}

sub scoped_statement_type {
  my $self = shift;

  return ($self->{postproctype}."Process");
}

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

sub match_url {
  my ($self, $url, $pat) = @_;
  $self->{scoop}->match_url ($self->{url_regexp_cache}, $url, $pat);
}

sub expand_url_magic {
  my ($self, $url) = @_;

  $url = $self->{scoop}->AddHostToURL ($self->{url}, $url);
  $url = $self->{scoop}->expand_url_magic($url);
  return $url;
}

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

1;
