# Copyright (c) 2023 Yuki Kimoto
# MIT License

class File::Spec::Instance::Win32 extends File::Spec::Instance::Unix {
  version_from File::Spec;
  
  use Re;
  use StringList;
  use Array;
  use Cwd;
  
  our $DRIVE_RX_STRING : string;
  our $UNC_RX_STRING : string;
  our $VOL_RX_STRING : string;
  
  INIT {
    $DRIVE_RX_STRING = "[a-zA-Z]:";
    $UNC_RX_STRING = "(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+";
    $VOL_RX_STRING = "(?:$DRIVE_RX_STRING|$UNC_RX_STRING)";
  }
  
  # Class Methods
  static method new : File::Spec::Instance::Win32 () {
    
    my $self = new File::Spec::Instance::Win32;
    
    return $self;
  }
  
  # Instance Methods
  method devnull : string () {
    return "nul";
  }
  
  method rootdir : string () {
    return "\\";
  }

  method tmpdir : string () {
    
    my $env_tmpdir = Sys->env("TMPDIR");
    my $env_temp = Sys->env("TEMP");
    my $env_tmp = Sys->env("TMP");
    my $dirlist = [
      $env_tmpdir,
      $env_temp,
      $env_tmp,
      "SYS:/temp",
      "C:\system\temp",
      "C:/temp",
      "/tmp",
      "/",
    ];

    my $tmpdir = $self->_tmpdir($dirlist);
    return $tmpdir;
  }
  
  method file_name_is_absolute : int ($path : string) {
    
    my $is_abs = 0;
    if (my $match = Re->m($path, "^($VOL_RX_STRING)")) {
      my $vol = $match->cap1;
      
      if (Re->m($vol, "^$UNC_RX_STRING")) {
        $is_abs = 2;
      }
      else {
        if (Re->m($path, "^$DRIVE_RX_STRING[\\\\/]")) {
          $is_abs = 2;
        }
      }
    }
    else {
      if (Re->m($path, "^[\\\\/]")) {
        $is_abs = 1;
      }
    }
    
    return $is_abs;
  }

  method file_name_is_root : int ($path : string) {
    
    my $is_root = 0;
    if (my $match = Re->m($path, "^($VOL_RX_STRING)")) {
      my $vol = $match->cap1;
      
      if (Re->m($vol, "^$UNC_RX_STRING([\\\\/])?\z")) {
        $is_root = 2;
      }
      else {
        if (Re->m($path, "^$DRIVE_RX_STRING[\\\\/]\z")) {
          $is_root = 2;
        }
      }
    }
    else {
      if (Re->m($path, "^[\\\\/]\z")) {
        $is_root = 1;
      }
    }
    
    return $is_root;
  }

  method path : string[] () {
    
    my $env_path = Sys->env("PATH");
    unless ($env_path) {
      return new string[0];
    }
    
    my $pathes = Fn->split(";", $env_path);
    
    my $pathes_list = StringList->new;
    for (my $i = 0; $i < @$pathes; $i++) {
      my $path = $pathes->[$i];
      my $path_ref = [$path];
      Re->s($path_ref, "\"", "");
      $path = $path_ref->[0];
      if (length $path) {
        $pathes_list->push($path);
      }
    }
    $pathes_list->unshift(".");
    $pathes = $pathes_list->to_array;
    
    return $pathes;
  }
  
  method splitpath : string[] ($path : string, $nofile : int = 0) {
    
    my $volume = "";
    my $directory = "";
    my $file = "";
    
    if (my $match = Re->m($path, ["^($VOL_RX_STRING?)(.*)", "s"])) {
      $volume = $match->cap1;
      my $rest = $match->cap2;
      
      if ($nofile) {
        $directory = $rest;
      }
      else {
        if (my $match = Re->m($rest, ["^((?:.*[\\\\/](?:\.\.?\z)?)?)([^\\\\/]*)", "s"])) {
          $directory = $match->cap1;
          $file      = $match->cap2;
        }
      }
    }
    
    return [$volume, $directory, $file];
  }
  
  method splitdir : string[] ($path : string) {
    my $dirs = Re->split("[\\\\/]", $path, -1);
    
    return $dirs;
  }

  private method _canon_cat : string ($parts : string[]) {
    my $first = $parts->[0];
    
    my $volume = (string)undef;
    
    # drive letter - (C:)
    my $match = Re->m($first, "\A([A-Za-z]:)([\\\\/]?)");
    my $first_ref = [$first];
    Re->s($first_ref, "\A([A-Za-z]:)([\\\\/]?)", "");
    $first = $first_ref->[0];
    if ($match) {
      $volume = Fn->ucfirst($match->cap1);
      if (length $match->cap2) {
        $volume .= "\\";
      }
    }
    else {
      my $first_ref = [$first];
      my $replace_info = Re->s($first_ref, ["\A(?:\\\\\\\\|//)([^\\\\/]+)(?:[\\\\/]([^\\\\/]+))?[\\\\/]?", "s"], "");
      $first = $first_ref->[0];
      
      # UNC volume (\\192.168.201.101)
      if ($replace_info) {
        my $match = $replace_info->match;
        $volume = "\\\\" . $match->cap1;
        if ($match->cap2) {
          $volume .= "\\" . $match->cap2;
        }
        $volume .= "\\";
      }
      else {
        my $first_ref = [$first];
        my $replace_info = Re->s($first_ref, "\A[\\\\/]", "");
        $first = $first_ref->[0];
        
        # root dir (\foo)
        if ($replace_info) {
          $volume = "\\";
        }
        else {
          $volume = "";
        }
      }
    }
    
    $parts->[0] = $first;
    
    my $path = Fn->join("\\", $parts);
    
    my $path_ref = [$path];
    
    # /+ to \
    Re->s($path_ref, ["/+", "g"], "\\");
    
    # \+ to \
    Re->s($path_ref, ["\\\\+", "g"], "\\");
    
    # xx\.\.\yy --> xx\yy
    Re->s($path_ref, ["(?:(?:\A|\\\\)\.(?:\\\\\.)*(?:\\\\|\z))+", "g"], "\\");
    
    $path = $path_ref->[0];
    
    # xx\yy\..\zz --> xx\zz
    my $parts_list = StringList->new;
    $parts = Fn->split("\\", $path);
    for (my $i = 0; $i < @$parts; $i++) {
      my $part = $parts->[$i];
      if ($part eq "..") {
        if ($parts_list->length > 0) {
          my $before_part = $parts_list->get($parts_list->length - 1);
          unless ($before_part eq "..") {
            $parts_list->pop;
            next;
          }
        }
      }
      $parts_list->push($part);
    }
    $parts = $parts_list->to_array;
    $path = Fn->join("\\", $parts);
    
    # \xx --> xx
    
    $path_ref->[0] = $path;
    
    Re->s($path_ref, ["\A\\\\", "g"], "");
    
    # xx\ --> xx
    Re->s($path_ref, ["\\\\\z", "g"], "");
    
    $path = $path_ref->[0];
    
    if (Re->m($volume, "\\\\\z")) {
      # <vol>\.. --> <vol>\
      $path_ref->[0] = $path;
      Re->s($path_ref, "\A\.\.(?:\\\\\.\.)*(?:\\\\|\z)", "");
      $path = $path_ref->[0];
      
      # \\HOST\SHARE\ --> \\HOST\SHARE
      my $match = Re->m($volume, ["\A(\\\\\\\\.*)\\\\\z", "s"]);
      if (!length $path && $match) {
        $path = $match->cap1;
        return $path;
      }
    }
    
    if (length $path || length $volume) {
      $path = $volume . $path;
    }
    else {
      $path = ".";
    }
    
    return $path;
  }
  
  method canonpath : string ($path : string) {
    
    unless ($path) {
      die "The \$path must be defined";
    }
    
    unless (length $path) {
      return $path;
    }
    
    my $canonpath = $self->_canon_cat([$path]);
    
    return $canonpath;
  }

  method catdir : string ($dir_parts : string[]) {
    
    unless ($dir_parts) {
      die "The \$dir_parts must be defined";
    }
    
    unless (@$dir_parts) {
      return "";
    }
    
    unless (length $dir_parts->[0]) {
      $dir_parts->[0] = "/";
    }
    
    if (Re->m($dir_parts->[0], "^$DRIVE_RX_STRING\z")) {
      $dir_parts->[0] .= "\\";
    }
    
    my $dir = $self->_canon_cat($dir_parts);
    
    return $dir;
  }

  method catfile : string ($dir_parts : string[], $file_base_name : string) {
    
    unless ($dir_parts) {
      die "The \$dir_parts must be defined";
    }
    
    unless ($file_base_name) {
      die "The \$file_base_name must be defined";
    }
    
    if (@$dir_parts) {
      unless (length $dir_parts->[0]) {
        $dir_parts->[0] = "/";
      }
      
      if (Re->m($dir_parts->[0], "^$DRIVE_RX_STRING\z")) {
        $dir_parts->[0] .= "\\";
      }
    }
    
    my $parts_list = StringList->new($dir_parts);
    $parts_list->push($file_base_name);
    my $parts = $parts_list->to_array;
    
    my $file = $self->_canon_cat($parts);
    
    return $file;
  }

  method rel2abs : string ($path : string, $base : string = undef) {
    
    my $is_abs = $self->file_name_is_absolute($path);
    
    my $abs_path = (string)undef;
    
    # Check for volume (should probably document the '2' thing...)
    if ($is_abs == 2) {
      $abs_path = $self->canonpath($path) ;
    }
    elsif ($is_abs) {
      # It's missing a volume, add one
      my $vol_parts = $self->splitpath(Cwd->getcwd);
      my $vol = $vol_parts->[0];
      
      $abs_path = $self->canonpath($vol . $path);
    }
    else {
      if (!$base || $base eq "") {
        my $drive = $self->splitpath($path)->[0];
        if (length $drive) {
          eval { $base = Cwd->getdcwd($drive); };
          if ($@) {
            unless (eval_error_id == basic_type_id Error::System) {
              die $@;
            }
          }
        }
        unless ($base) {
          $base = Cwd->getcwd;
        }
      }
      elsif (!$self->file_name_is_absolute($base)) {
        $base = $self->rel2abs($base) ;
      }
      else {
        $base = $self->canonpath($base) ;
      }
      
      my $path_parts = $self->splitpath($path, 1);
      my $path_dir = $path_parts->[1];
      my $path_base_file = $path_parts->[2];
      
      my $base_parts = $self->splitpath($base, 1);
      my $base_volume = $base_parts->[0];
      my $base_dir = $base_parts->[1];
      
      $path = $self->catpath( 
       $base_volume, 
       $self->catdir([$base_dir, $path_dir]), 
       $path_base_file
      );
      
      $abs_path = $self->canonpath($path);
    }
    
    return $abs_path;
  }
  
  method catpath : string ($volume : string, $directory : string, $file : string) {
    unless ($volume) {
      $volume = "";
    }
    unless ($directory) {
      $directory = "";
    }
    unless ($file) {
      $file = "";
    }
    
    my $path = $volume;
    
    # If it's UNC, make sure the glue separator is there, reusing
    # whatever separator is first in the $volume
    my $v = (string)undef;
    if (my $match = Re->m($path, ["^([\\\\/])[\\\\/][^\\\\/]+[\\\\/][^\\\\/]+\z", "s"])) {
      my $v = $match->cap1;
      if (Re->m($directory, "^[^\\\\/]")) {
        $path .= $v;
      }
    }
    
    $path .= $directory;
    
    # If the volume is not just A:, make sure the glue separator is 
    # there, reusing whatever separator is first in the $volume if possible.
    if (!Re->m($path, ["^[a-zA-Z]:\z", "s"]) && Re->m($path, "[^\\\\/]\z")
        && Re->m($file, "[^\\\\/]"))
    {
      my $sep = "\\";
      my $match = Re->m($path, "([\\\\/])");
      if ($match) {
        $sep = $match->cap1;
      }
      
      $path .= $sep;
    }
    
    $path .= $file;
    
    return $path;
  }
}