package OLLM::State;

use v5.30;
use strict;
use warnings;

use Cwd qw(abs_path);
use Digest::SHA qw(sha256_hex);
use File::Basename qw(dirname);
use File::Copy qw(copy);
use File::Find qw(find);
use File::Path qw(make_path);
use File::Spec;
use Fcntl qw(:flock);
use JSON::PP;
use Time::HiRes qw(time);

use OLLM::BuildFile;
use OLLM::Digest;
use OLLM::Path;
use OLLM::StateLock;
use OLLM::Version qw($VERSION);
our $SCHEMA = 1;
my $attempt_counter = 0;

sub start_attempt {
  my ($class, $spec) = @_;
  my $lock = _state_lock($spec);
  my $known = $class->known_unit_id($spec);
  $spec->{unit_id} = $known if defined $known;
  $spec->{generation_id} = sha256_hex(join "\0",
    $spec->{job_id}, $$, ++$attempt_counter, time(), rand(),
  );
  $class->write_registry($spec);
  return $spec->{generation_id};
}

sub known_unit_id {
  my ($class, $spec) = @_;
  my %found;
  for my $result ($class->_current_results($spec)) {
    next if ($result->{physical_unit} // '') ne $spec->{physical_unit};
    $found{$result->{unit_id}} = 1;
  }
  my @ids = sort keys %found;
  die "physical unit '$spec->{physical_unit}' is associated with more than "
    . "one logical unit-id in promoted state: " . join(', ', @ids) . "\n"
    if @ids > 1;
  return $ids[0];
}

sub write_registry {
  my ($class, $spec) = @_;
  my @lines = ('% Generated by OLLM. Do not edit.');
  my @results = sort {
       $a->{unit_id} cmp $b->{unit_id}
    || $a->{doctype} cmp $b->{doctype}
    || $a->{language} cmp $b->{language}
  } $class->_current_results($spec);
  my (%physical, %logical);
  for my $result (@results) {
    next if ($result->{unit_role} // '') eq 'i';
    my ($physical, $unit) = @{$result}{qw(physical_unit unit_id)};
    die "physical unit '$physical' has conflicting logical identities\n"
      if exists($physical{$physical}) && $physical{$physical} ne $unit;
    die "logical unit '$unit' belongs to more than one physical unit\n"
      if exists($logical{$unit}) && $logical{$unit} ne $physical;
    $physical{$physical} = $unit;
    $logical{$unit} = $physical;
  }
  for my $physical (sort keys %physical) {
    push @lines,
      '\\OsgLectureSeriesUnit{physical={' . _tex_value($physical)
      . '},unit={' . _tex_value($physical{$physical}) . '}}';
  }
  for my $result (@results) {
    next if ($result->{unit_role} // '') eq 'i';
    my $generation = $class->_generation_directory($spec, $result);
    my $aux = File::Spec->catfile($generation, 'reference.osgref.aux');
    my $pdf = File::Spec->catfile($generation, 'document.pdf');
    # latexmk is told to skip the generation-specific lines below when it
    # hashes this file (see Executor::command_for_spec).  What a document
    # really depends on is the content other documents export, so that is
    # recorded in a comment latexmk does hash.  The document's own entry is
    # left out: its export changes with every build of itself.
    push @lines,
      '% export ' . join(' ',
        _tex_value($result->{unit_id}), $result->{doctype},
        $result->{language}, _export_digest($aux, $result->{generation_id}),
      )
      if ($result->{job_id} // '') ne ($spec->{job_id} // '');
    push @lines,
      '\\OsgLectureReferenceDocument{',
      '  unit={' . _tex_value($result->{unit_id}) . '},',
      '  type={' . _tex_value($result->{doctype}) . '},',
      '  lang={' . _tex_value($result->{language}) . '},',
      '  generation={' . _tex_value($result->{generation_id}) . '},',
      '  aux={' . _tex_value($aux) . '},',
      '  pdf={' . _tex_value($pdf) . '}',
      '}';
  }
  push @lines, '';
  my $path = File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgrefs.tex",
  );
  OLLM::BuildFile->write_atomic($path, join("\n", @lines));
  $spec->{reference_registry} = $path;
  return $path;
}

sub promote {
  my ($class, $spec) = @_;
  my $lock = _state_lock($spec);
  my $result_path = File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgresult.aux",
  );
  my $reference_path = File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgref.aux",
  );
  my $used_path = File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgref-used.aux",
  );
  my $result = _read_result($result_path);
  _validate_result($spec, $result);
  _validate_reference($spec, $result, $reference_path)
    if ($spec->{unit_role} // '') ne 'i';
  my $dependencies = _read_dependencies($spec, $used_path);
  die "build artifact is missing or empty: $spec->{artifact}\n"
    if !-f $spec->{artifact} || !-s _;

  my $projection = $class->_projection_directory($spec, $result);
  my $generations = File::Spec->catdir($projection, 'generations');
  _prepare_directory($generations, $spec->{project_root});
  my $final = File::Spec->catdir(
    $generations, $spec->{generation_id},
  );
  die "generation already exists: $final\n" if -e $final;
  my $temporary = File::Spec->catdir(
    $generations, '.pending-' . substr($spec->{generation_id}, 0, 12) . "-$$",
  );
  mkdir $temporary or die "cannot create pending generation '$temporary': $!\n";
  eval {
    if (($spec->{unit_role} // '') ne 'i') {
      copy($reference_path, File::Spec->catfile(
        $temporary, 'reference.osgref.aux',
      )) or die "cannot copy reference export: $!\n";
    }
    copy($spec->{artifact}, File::Spec->catfile(
      $temporary, 'document.pdf',
    )) or die "cannot copy document artifact: $!\n";
    my $record = {
      schema           => $SCHEMA,
      generation_id    => $spec->{generation_id},
      job_id           => $spec->{job_id},
      series_id        => $spec->{series_id},
      unit_id          => $result->{unit_id},
      physical_unit    => $spec->{physical_unit},
      physical_number  => $spec->{physical_number},
      unit_role        => $spec->{unit_role},
      unit_scope       => $spec->{unit_scope},
      target           => $spec->{target},
      doctype          => $spec->{doctype},
      language         => $spec->{language},
      source           => $spec->{source},
      shell_escape     => $spec->{shell_escape},
      bundle_preset    => $spec->{bundle_preset},
      structure_signature => $spec->{structure_signature},
      project_config_signature => $spec->{project_config_signature},
      document_metadata_signature => $spec->{document_metadata}
        ? $spec->{document_metadata}{signature} : undef,
      config_signature => $spec->{config_signature},
      dependencies     => $dependencies,
      chapter          => $result->{chapter},
      ordinal          => $result->{ordinal},
    };
    my $json = JSON::PP->new->canonical->pretty->encode($record);
    OLLM::BuildFile->write_atomic(
      File::Spec->catfile($temporary, 'result.json'), $json,
    );
    rename $temporary, $final
      or die "cannot publish generation '$final': $!\n";
    my $current = join '',
      '% Generated by OLLM. Do not edit.', "\n",
      '\\OsgLectureCurrent{', $SCHEMA, '}{',
      $spec->{generation_id}, '}', "\n";
    OLLM::BuildFile->write_atomic(
      File::Spec->catfile($projection, 'current.tex'), $current,
    );
    1;
  } or do {
    my $error = $@ || 'unknown promotion error';
    _remove_pending($temporary) if -d $temporary;
    die $error;
  };
  return $final;
}

sub _state_lock {
  my ($spec) = @_;
  return OLLM::StateLock::acquire($spec->{project_root});
}

sub _current_results {
  my ($class, $spec) = @_;
  my $series = $class->_series_directory($spec);
  return () if !-d $series;
  my @current;
  find(
    {
      no_chdir => 1,
      wanted => sub {
        push @current, $File::Find::name
          if $File::Find::name =~ /(?:\A|[\\\/])current[.]tex\z/
            && -f $File::Find::name;
      },
    },
    $series,
  );
  my @results;
  for my $current (sort @current) {
    open my $handle, '<:raw', $current
      or die "cannot read state pointer '$current': $!\n";
    local $/;
    my $content = <$handle>;
    close $handle or die "cannot close state pointer '$current': $!\n";
    $content =~
      /\\OsgLectureCurrent\{(\d+)\}\{([0-9a-f]{64})\}/
      or die "invalid state pointer '$current'\n";
    die "unsupported state pointer schema '$1' in '$current'\n"
      if $1 != $SCHEMA;
    my $result_path = File::Spec->catfile(
      dirname($current), 'generations', $2, 'result.json',
    );
    open my $result_handle, '<:raw', $result_path
      or die "cannot read promoted result '$result_path': $!\n";
    local $/;
    my $json = <$result_handle>;
    close $result_handle
      or die "cannot close promoted result '$result_path': $!\n";
    my $result = eval { JSON::PP->new->decode($json) };
    die "invalid promoted result '$result_path': $@\n" if !$result;
    die "state pointer '$current' and result generation disagree\n"
      if ($result->{generation_id} // '') ne $2;
    push @results, $result;
  }
  return @results;
}

sub _series_directory {
  my ($class, $spec) = @_;
  return File::Spec->catdir(
    $spec->{project_root}, '.osglecture', 'state', $spec->{series_id},
  );
}

sub _projection_directory {
  my ($class, $spec, $result) = @_;
  my $identity = ($result->{unit_role} // '') eq 'i'
    ? 'integration:' . ($result->{physical_unit} // '')
    : $result->{unit_id};
  return File::Spec->catdir(
    $class->_series_directory($spec),
    'unit-' . sha256_hex($identity),
    $result->{doctype}, $result->{language},
  );
}

sub _generation_directory {
  my ($class, $spec, $result) = @_;
  return File::Spec->catdir(
    $class->_projection_directory($spec, $result),
    'generations', $result->{generation_id},
  );
}

sub dependency_status {
  my ($class, $spec, $dependency, $target) = @_;
  return 'missing' if !$target;
  my $used = $dependency->{target_generation} // '';
  if (($dependency->{kind} // '') eq 'external-reference') {
    my $label = $dependency->{label} // '';
    my $current = $class->_export_label($spec, $target, $label);
    return 'label-missing' if !defined $current;
    return 'current' if $used ne '' && $used eq ($target->{generation_id} // '');
    return 'stale' if $used eq '';
    my %old = (%$target, generation_id => $used);
    my $previous = $class->_export_label($spec, \%old, $label);
    return defined($previous) && $previous eq $current ? 'current' : 'stale';
  }
  if (($dependency->{kind} // '') eq 'integration') {
    return 'current' if $used ne '' && $used eq ($target->{generation_id} // '');
    return 'stale' if $used eq '';
    my %old = (%$target, generation_id => $used);
    my $old = File::Spec->catfile($class->_generation_directory($spec, \%old), 'document.pdf');
    my $new = File::Spec->catfile($class->_generation_directory($spec, $target), 'document.pdf');
    return 'stale' if !-f $old || !-f $new;
    return _file_digest($old) eq _file_digest($new) ? 'current' : 'stale';
  }
  return 'stale';
}

sub _export_label {
  my ($class, $spec, $result, $label) = @_;
  my $path = File::Spec->catfile(
    $class->_generation_directory($spec, $result), 'reference.osgref.aux',
  );
  return if !-f $path;
  open my $handle, '<:raw', $path or die "cannot read reference export '$path': $!\n";
  while (my $line = <$handle>) {
    if ($line =~ /\A\\newlabel\{\Q$label\E\}\{/) {
      close $handle or die "cannot close reference export '$path': $!\n";
      $line =~ s/[\r\n]+\z//;
      return $line;
    }
  }
  close $handle or die "cannot close reference export '$path': $!\n";
  return;
}

# Digest of a promoted reference export without its generation id, which is
# the only part that differs between two builds of unchanged sources.
sub _export_digest {
  my ($path, $generation_id) = @_;
  open my $handle, '<:raw', $path or return 'missing';
  local $/;
  my $content = <$handle>;
  close $handle or die "cannot close reference export '$path': $!\n";
  $content =~ s/\Q$generation_id\E//g if defined $generation_id;
  return sha256_hex($content);
}

# After a successful latexmk run: did LaTeX actually run for this attempt?
# Returns 'built' if the result carries this attempt's generation id,
# 'current' if latexmk found nothing to do and the result on disk is the
# promoted generation, and 'unpromoted' if it is an older result that was
# never promoted (an interrupted earlier build).
sub attempt_outcome {
  my ($class, $spec) = @_;
  my $lock = _state_lock($spec);
  my $result = _read_result(File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgresult.aux",
  ));
  return 'built'
    if ($result->{generation_id} // '') eq ($spec->{generation_id} // '');
  my $current = File::Spec->catfile(
    $class->_projection_directory($spec, $result), 'current.tex',
  );
  open my $handle, '<:raw', $current or return 'unpromoted';
  local $/;
  my $content = <$handle>;
  close $handle or die "cannot close state pointer '$current': $!\n";
  my ($promoted) = $content =~ /\\OsgLectureCurrent\{\d+\}\{([0-9a-f]{64})\}/;
  return defined($promoted) && $promoted eq $result->{generation_id}
    ? 'current' : 'unpromoted';
}

sub _file_digest {
  my ($path) = @_;
  return OLLM::Digest::sha256_hex_of_file($path);
}

sub _read_result {
  my ($path) = @_;
  open my $handle, '<:raw', $path
    or die "LaTeX result file is missing: $path\n";
  local $/;
  my $content = <$handle>;
  close $handle or die "cannot close LaTeX result '$path': $!\n";
  my @match = $content =~
    /\\OsgLectureResult
      \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}
      \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}/x;
  die "invalid LaTeX result envelope in '$path'\n" if !@match;
  my ($chapter, $ordinal) = $content =~
    /\\OsgLectureDeploymentResult\{([^{}]*)\}\{([^{}]*)\}/;
  # \OsgLectureHandoutResult is only ever written for a handout build (see
  # osglecture.dtx __osglecture_result_write:); every other doctype's result
  # file simply lacks the line, hence the optional match and empty fallback
  # rather than treating its absence as invalid. Its second field reports
  # whether tagging was actually active in that build (tag_if_active:,
  # false whenever the profile forbids \DocumentMetadata outright, e.g.
  # beamer, or the author has it switched off) -- Executor uses it to pick
  # between a tagpax-based and a plain pdfpages-based imposition, since
  # tagpax has nothing to import from an untagged PDF.
  my ($handout_layout, $handout_tagging) = $content =~
    /\\OsgLectureHandoutResult\{([^{}]*)\}\{([^{}]*)\}/;
  return {
    schema        => $match[0],
    generation_id => $match[1],
    job_id        => $match[2],
    series_id     => $match[3],
    unit_id       => $match[4],
    physical_unit => $match[5],
    unit_role     => $match[6],
    doctype       => $match[7],
    language      => $match[8],
    chapter       => defined($chapter) ? $chapter : '',
    ordinal       => defined($ordinal) ? $ordinal : '',
    handout_layout => defined($handout_layout) ? $handout_layout : '',
    handout_tagging => defined($handout_tagging) && $handout_tagging eq 'true' ? 1 : 0,
  };
}

# Public accessor for callers (namely Executor) that need to inspect a
# freshly-built result before deciding whether to promote it -- e.g. to
# detect a requested handout imposition and swap the artifact beforehand.
# Kept separate from promote() itself so State stays a pure file/generation
# manager and never has to know how to run a second latexmk pass.
sub read_result {
  my ($class, $spec) = @_;
  my $result_path = File::Spec->catfile(
    $spec->{build_directory}, "$spec->{job_id}.osgresult.aux",
  );
  my $result = _read_result($result_path);
  _validate_result($spec, $result);
  return $result;
}

sub _validate_result {
  my ($spec, $result) = @_;
  die "unsupported LaTeX result schema '$result->{schema}'\n"
    if $result->{schema} != $SCHEMA;
  for my $field (qw(generation_id job_id series_id physical_unit unit_role
                    doctype language)) {
    die "LaTeX result $field '$result->{$field}' does not match BuildSpec "
      . "'$spec->{$field}'\n"
      if ($result->{$field} // '') ne ($spec->{$field} // '');
  }
  die "invalid logical unit-id '$result->{unit_id}' in LaTeX result\n"
    if ($spec->{unit_role} // '') ne 'i'
      && ($result->{unit_id} !~ /\A[^\s,=]+\z/
        || index($result->{unit_id}, '...') >= 0);
  die "integration result must not declare a logical unit-id\n"
    if ($spec->{unit_role} // '') eq 'i' && $result->{unit_id} ne '';
  die "LaTeX result ordinal '$result->{ordinal}' does not match BuildSpec "
    . "'$spec->{logical_ordinal}'\n"
    if ($result->{ordinal} // '') ne ($spec->{logical_ordinal} // '');
  die "LaTeX result unit-id '$result->{unit_id}' conflicts with known "
    . "unit-id '$spec->{unit_id}'\n"
    if defined($spec->{unit_id}) && $spec->{unit_id} ne $result->{unit_id};
}

sub _validate_reference {
  my ($spec, $result, $path) = @_;
  open my $handle, '<:raw', $path
    or die "reference export is missing: $path\n";
  local $/;
  my $content = <$handle>;
  close $handle or die "cannot close reference export '$path': $!\n";
  my @match = $content =~
    /\\OsgLectureReferenceExport
      \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}
      \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}/x;
  die "invalid reference-export envelope in '$path'\n" if !@match;
  my @expected = (
    $SCHEMA, $spec->{generation_id}, $spec->{job_id}, $spec->{series_id},
    $result->{unit_id}, $spec->{doctype}, $spec->{language},
  );
  for my $index (0 .. $#expected) {
    die "reference-export envelope does not match the current build\n"
      if $match[$index] ne $expected[$index];
  }
}

sub _read_dependencies {
  my ($spec, $path) = @_;
  return [] if !-f $path;
  open my $handle, '<:raw', $path
    or die "cannot read reference-use file '$path': $!\n";
  my @dependencies;
  while (my $line = <$handle>) {
    if ($line =~ /\\OsgLectureIntegrationUse/) {
      my @match = $line =~
        /\\OsgLectureIntegrationUse
          \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}/x;
      die "invalid integration-use record in '$path'\n" if !@match;
      die "integration-use generation does not match the current build\n"
        if $match[0] ne $spec->{generation_id};
      push @dependencies, {
        kind => 'integration', target_generation => $match[1],
        unit_id => $match[2], doctype => $match[3], language => $match[4],
      };
      next;
    }
    next if $line !~ /\\OsgLectureReferenceUse/;
    my @match = $line =~
      /\\OsgLectureReferenceUse
        \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}
        \{([^{}]*)\}\{([^{}]*)\}\{([^{}]*)\}/x;
    die "invalid reference-use record in '$path'\n" if !@match;
    die "reference-use generation does not match the current build\n"
      if $match[0] ne $spec->{generation_id};
    push @dependencies, {
      kind     => 'external-reference',
      target_generation => $match[1],
      unit_id  => $match[2],
      doctype  => $match[3],
      language => $match[4],
      label    => $match[5],
      property => $match[6],
    };
  }
  close $handle or die "cannot close reference-use file '$path': $!\n";
  return \@dependencies;
}

sub _prepare_directory {
  my ($path, $project_root) = @_;
  my $root = abs_path($project_root)
    // die "project root not found: $project_root\n";
  my $ancestor = $path;
  while (!-e $ancestor) {
    my $parent = dirname($ancestor);
    die "cannot find state-directory ancestor for '$path'\n"
      if $parent eq $ancestor;
    $ancestor = $parent;
  }
  my $canonical = abs_path($ancestor)
    // die "cannot resolve state-directory ancestor '$ancestor'\n";
  OLLM::Path::require_within(
    $canonical, $root,
    "state directory '$path' resolves outside project root '$root'",
  );
  make_path($path);
}

sub _remove_pending {
  my ($path) = @_;
  return if !-d $path;
  opendir my $handle, $path or return;
  my @files = grep { $_ ne '.' && $_ ne '..' } readdir $handle;
  closedir $handle;
  unlink File::Spec->catfile($path, $_) for @files;
  rmdir $path;
}

sub _tex_value {
  my ($value) = @_;
  $value //= '';
  $value =~ s{\\}{/}g;
  die "value '$value' cannot be represented safely in a TeX registry\n"
    if $value =~ /[{}%#\r\n]/;
  return $value;
}

1;