461 lines
12 KiB
PowerShell
461 lines
12 KiB
PowerShell
[CmdletBinding()]
|
|
param(
|
|
[ValidateSet("Status", "Restore", "Snapshot", "SyncToLibrary")]
|
|
[string]$Mode = "Status",
|
|
|
|
[string]$Root = "C:\Diagnostik\formr",
|
|
|
|
[string]$Rscript = "C:\Program Files\R\R-4.6.0\bin\x64\Rscript.exe",
|
|
|
|
[switch]$IncludeNestedProjects
|
|
)
|
|
|
|
$ErrorActionPreference = "Stop"
|
|
|
|
function Write-Log {
|
|
param(
|
|
[Parameter(Mandatory)]
|
|
[AllowEmptyString()]
|
|
[string]$Message,
|
|
|
|
[switch]$Initialize
|
|
)
|
|
|
|
$maxAttempts = 10
|
|
|
|
for ($attempt = 1; $attempt -le $maxAttempts; $attempt++) {
|
|
try {
|
|
if ($Initialize) {
|
|
Set-Content -LiteralPath $logFile -Value $Message -Encoding UTF8 -ErrorAction Stop
|
|
}
|
|
else {
|
|
Add-Content -LiteralPath $logFile -Value $Message -Encoding UTF8 -ErrorAction Stop
|
|
}
|
|
return
|
|
}
|
|
catch [System.IO.IOException] {
|
|
if ($attempt -eq $maxAttempts) {
|
|
Write-Warning "Logdatei konnte nach $maxAttempts Versuchen nicht beschrieben werden: $logFile"
|
|
Write-Warning $_.Exception.Message
|
|
return
|
|
}
|
|
|
|
Start-Sleep -Milliseconds (100 * $attempt)
|
|
}
|
|
}
|
|
}
|
|
|
|
$timestamp = Get-Date -Format "yyyyMMdd_HHmmss"
|
|
$logFile = Join-Path $Root "renv_${Mode}_${timestamp}_PID${PID}.log"
|
|
|
|
if (-not (Test-Path -LiteralPath $Rscript -PathType Leaf)) {
|
|
throw "Rscript wurde nicht gefunden: $Rscript"
|
|
}
|
|
|
|
if (-not (Test-Path -LiteralPath $Root -PathType Container)) {
|
|
throw "Stammverzeichnis wurde nicht gefunden: $Root"
|
|
}
|
|
|
|
function ConvertTo-RString {
|
|
param([Parameter(Mandatory)][string]$Value)
|
|
|
|
return $Value.Replace("\", "/").Replace("'", "\'")
|
|
}
|
|
|
|
function Invoke-RenvProject {
|
|
param(
|
|
[Parameter(Mandatory)][string]$Project,
|
|
[Parameter(Mandatory)][string]$Action
|
|
)
|
|
|
|
$projectR = ConvertTo-RString -Value $Project
|
|
|
|
$actionCode = switch ($Action) {
|
|
"Status" {
|
|
@'
|
|
# Nur prüfen
|
|
'@
|
|
}
|
|
"Restore" {
|
|
@'
|
|
renv::restore(project = project, prompt = FALSE)
|
|
'@
|
|
}
|
|
"Snapshot" {
|
|
@'
|
|
lockfile <- file.path(project, "renv.lock")
|
|
backup <- paste0(lockfile, ".bak_", format(Sys.time(), "%Y%m%d_%H%M%S"))
|
|
if (file.exists(lockfile)) {
|
|
file.copy(lockfile, backup, overwrite = FALSE)
|
|
message("Lockfile-Backup: ", backup)
|
|
}
|
|
renv::snapshot(project = project, prompt = FALSE)
|
|
'@
|
|
}
|
|
"SyncToLibrary" {
|
|
@'
|
|
initial_status <- renv::status(project = project)
|
|
|
|
if (isTRUE(initial_status$synchronized)) {
|
|
message("Projekt ist bereits synchron; keine Änderung.")
|
|
} else {
|
|
library_path <- renv::paths$library(project = project)
|
|
|
|
# Unvollständige Paketordner und Installationsreste entfernen.
|
|
if (dir.exists(library_path)) {
|
|
entries <- list.dirs(
|
|
library_path,
|
|
full.names = TRUE,
|
|
recursive = FALSE
|
|
)
|
|
|
|
invalid <- entries[
|
|
grepl("^00LOCK", basename(entries)) |
|
|
!file.exists(file.path(entries, "DESCRIPTION"))
|
|
]
|
|
|
|
invalid <- unique(invalid)
|
|
|
|
if (length(invalid)) {
|
|
message(
|
|
"Entferne unvollständige Paketordner: ",
|
|
paste(basename(invalid), collapse = ", ")
|
|
)
|
|
|
|
unlink(
|
|
invalid,
|
|
recursive = TRUE,
|
|
force = TRUE
|
|
)
|
|
}
|
|
}
|
|
|
|
# Direkte Projektabhängigkeiten aus dem Code.
|
|
dependencies <- renv::dependencies(
|
|
path = project,
|
|
progress = FALSE,
|
|
errors = "reported"
|
|
)
|
|
|
|
direct_packages <- sort(
|
|
unique(stats::na.omit(dependencies$Package))
|
|
)
|
|
|
|
# Zusätzlich alle im Lockfile dokumentierten Pakete berücksichtigen.
|
|
lockfile_path <- file.path(project, "renv.lock")
|
|
lock_packages <- character()
|
|
|
|
if (file.exists(lockfile_path)) {
|
|
lock <- renv::lockfile_read(lockfile_path)
|
|
lock_packages <- names(lock$Packages)
|
|
}
|
|
|
|
base_packages <- rownames(
|
|
installed.packages(priority = "base")
|
|
)
|
|
|
|
target_packages <- sort(unique(c(
|
|
direct_packages,
|
|
lock_packages
|
|
)))
|
|
|
|
target_packages <- setdiff(
|
|
target_packages,
|
|
base_packages
|
|
)
|
|
|
|
valid_installed_packages <- function() {
|
|
if (!dir.exists(library_path)) {
|
|
return(character())
|
|
}
|
|
|
|
dirs <- list.dirs(
|
|
library_path,
|
|
full.names = TRUE,
|
|
recursive = FALSE
|
|
)
|
|
|
|
basename(
|
|
dirs[file.exists(file.path(dirs, "DESCRIPTION"))]
|
|
)
|
|
}
|
|
|
|
missing <- setdiff(
|
|
target_packages,
|
|
valid_installed_packages()
|
|
)
|
|
|
|
# Fehlende Pakete einzeln installieren. Fehlgeschlagene Pakete werden
|
|
# mehrfach versucht, damit zuerst installierte Abhängigkeiten später
|
|
# abhängige Pakete ermöglichen.
|
|
max_passes <- 3L
|
|
failed <- missing
|
|
|
|
if (length(failed)) {
|
|
for (pass in seq_len(max_passes)) {
|
|
message(
|
|
"Installationsdurchgang ",
|
|
pass,
|
|
" von ",
|
|
max_passes,
|
|
": ",
|
|
paste(failed, collapse = ", ")
|
|
)
|
|
|
|
next_failed <- character()
|
|
|
|
for (package in failed) {
|
|
message("Installiere Paket: ", package)
|
|
|
|
ok <- tryCatch(
|
|
{
|
|
renv::install(
|
|
packages = package,
|
|
project = project,
|
|
rebuild = TRUE,
|
|
prompt = FALSE
|
|
)
|
|
TRUE
|
|
},
|
|
error = function(error) {
|
|
message(
|
|
"Installation fehlgeschlagen für ",
|
|
package,
|
|
": ",
|
|
conditionMessage(error)
|
|
)
|
|
FALSE
|
|
}
|
|
)
|
|
|
|
if (!isTRUE(ok)) {
|
|
next_failed <- c(next_failed, package)
|
|
}
|
|
}
|
|
|
|
failed <- unique(next_failed)
|
|
|
|
# Pakete können als Abhängigkeiten anderer Installationen
|
|
# erfolgreich hinzugekommen sein.
|
|
failed <- setdiff(
|
|
failed,
|
|
valid_installed_packages()
|
|
)
|
|
|
|
if (!length(failed)) {
|
|
break
|
|
}
|
|
}
|
|
}
|
|
|
|
still_missing <- setdiff(
|
|
target_packages,
|
|
valid_installed_packages()
|
|
)
|
|
|
|
if (length(still_missing)) {
|
|
stop(
|
|
"Nach mehreren Installationsdurchgängen fehlen weiterhin: ",
|
|
paste(still_missing, collapse = ", "),
|
|
". Kein Snapshot durchgeführt."
|
|
)
|
|
}
|
|
|
|
# Vor dem Snapshot Lockfile sichern.
|
|
backup <- paste0(
|
|
lockfile_path,
|
|
".bak_",
|
|
format(Sys.time(), "%Y%m%d_%H%M%S")
|
|
)
|
|
|
|
if (file.exists(lockfile_path)) {
|
|
copied <- file.copy(
|
|
lockfile_path,
|
|
backup,
|
|
overwrite = FALSE
|
|
)
|
|
|
|
if (!isTRUE(copied)) {
|
|
stop(
|
|
"Lockfile-Backup konnte nicht erstellt werden: ",
|
|
backup
|
|
)
|
|
}
|
|
|
|
message("Lockfile-Backup: ", backup)
|
|
}
|
|
|
|
# Snapshot führt zusätzlich eine transitive Vorabvalidierung durch.
|
|
# Bei einem Fehler bleibt das Backup erhalten und das Projekt wird
|
|
# nicht als erfolgreich markiert.
|
|
message("Aktualisiere renv.lock.")
|
|
renv::snapshot(
|
|
project = project,
|
|
prompt = FALSE
|
|
)
|
|
}
|
|
'@
|
|
}
|
|
}
|
|
|
|
$rCode = @"
|
|
options(
|
|
repos = c(CRAN = "https://cloud.r-project.org"),
|
|
renv.config.auto.snapshot = FALSE
|
|
)
|
|
|
|
project <- '$projectR'
|
|
message("Projekt: ", project)
|
|
message("R-Version: ", R.version.string)
|
|
|
|
$actionCode
|
|
|
|
status <- renv::status(project = project)
|
|
if (!isTRUE(status`$synchronized)) {
|
|
message("ERGEBNIS: NICHT SYNCHRON")
|
|
quit(save = "no", status = 10L)
|
|
}
|
|
|
|
message("ERGEBNIS: SYNCHRON")
|
|
quit(save = "no", status = 0L)
|
|
"@
|
|
|
|
$tempRFile = Join-Path ([System.IO.Path]::GetTempPath()) (
|
|
"renv_{0}_{1}.R" -f ([System.IO.Path]::GetRandomFileName()), $PID
|
|
)
|
|
|
|
try {
|
|
# R-Code nicht mit -e übergeben. Unter Windows können dabei Anführungszeichen
|
|
# verloren gehen, sodass z. B. C:/Users/... als ungequoteter R-Code ankommt.
|
|
$utf8NoBom = New-Object System.Text.UTF8Encoding($false)
|
|
[System.IO.File]::WriteAllText($tempRFile, $rCode, $utf8NoBom)
|
|
|
|
$stdoutFile = Join-Path ([System.IO.Path]::GetTempPath()) (
|
|
"renv_stdout_{0}_{1}.txt" -f ([System.IO.Path]::GetRandomFileName()), $PID
|
|
)
|
|
$stderrFile = Join-Path ([System.IO.Path]::GetTempPath()) (
|
|
"renv_stderr_{0}_{1}.txt" -f ([System.IO.Path]::GetRandomFileName()), $PID
|
|
)
|
|
|
|
Push-Location -LiteralPath $Project
|
|
try {
|
|
$process = Start-Process `
|
|
-FilePath $Rscript `
|
|
-ArgumentList @("--no-save", "--no-restore", $tempRFile) `
|
|
-WorkingDirectory $Project `
|
|
-RedirectStandardOutput $stdoutFile `
|
|
-RedirectStandardError $stderrFile `
|
|
-NoNewWindow `
|
|
-Wait `
|
|
-PassThru
|
|
|
|
$exitCode = $process.ExitCode
|
|
|
|
$output = @()
|
|
if (Test-Path -LiteralPath $stdoutFile) {
|
|
$output += Get-Content -LiteralPath $stdoutFile -ErrorAction SilentlyContinue
|
|
}
|
|
if (Test-Path -LiteralPath $stderrFile) {
|
|
$output += Get-Content -LiteralPath $stderrFile -ErrorAction SilentlyContinue
|
|
}
|
|
}
|
|
finally {
|
|
Pop-Location
|
|
Remove-Item -LiteralPath $stdoutFile -Force -ErrorAction SilentlyContinue
|
|
Remove-Item -LiteralPath $stderrFile -Force -ErrorAction SilentlyContinue
|
|
}
|
|
}
|
|
finally {
|
|
Remove-Item -LiteralPath $tempRFile -Force -ErrorAction SilentlyContinue
|
|
}
|
|
|
|
foreach ($line in $output) {
|
|
$text = [string]$line
|
|
Write-Host $text
|
|
Write-Log -Message $text
|
|
}
|
|
|
|
return $exitCode
|
|
}
|
|
|
|
$searchDepth = if ($IncludeNestedProjects) { 20 } else { 1 }
|
|
|
|
$projects = Get-ChildItem -LiteralPath $Root -Directory |
|
|
Where-Object {
|
|
Test-Path -LiteralPath (Join-Path $_.FullName "renv.lock") -PathType Leaf
|
|
}
|
|
|
|
if ($IncludeNestedProjects) {
|
|
$projects = Get-ChildItem -LiteralPath $Root -Directory -Recurse -Depth $searchDepth |
|
|
Where-Object {
|
|
Test-Path -LiteralPath (Join-Path $_.FullName "renv.lock") -PathType Leaf
|
|
}
|
|
}
|
|
|
|
$projects = $projects | Sort-Object FullName -Unique
|
|
|
|
if (-not $projects) {
|
|
throw "Keine Projekte mit renv.lock unter '$Root' gefunden."
|
|
}
|
|
|
|
Write-Log -Message "Start: $(Get-Date -Format 'yyyy-MM-dd HH:mm:ss')" -Initialize
|
|
Write-Log -Message "Modus: $Mode"
|
|
Write-Log -Message "Rscript: $Rscript"
|
|
Write-Log -Message "Projekte: $($projects.Count)"
|
|
|
|
$results = foreach ($project in $projects) {
|
|
Write-Host ""
|
|
Write-Host ("=" * 78)
|
|
Write-Host "[$Mode] $($project.FullName)"
|
|
Write-Host ("=" * 78)
|
|
|
|
Write-Log -Message "`r`n[$Mode] $($project.FullName)"
|
|
|
|
try {
|
|
$code = Invoke-RenvProject -Project $project.FullName -Action $Mode
|
|
|
|
[pscustomobject]@{
|
|
Project = $project.Name
|
|
Path = $project.FullName
|
|
Result = switch ($code) {
|
|
0 { "Synchron" }
|
|
10 { "Nicht synchron" }
|
|
default { "Fehler, Exitcode $code" }
|
|
}
|
|
ExitCode = $code
|
|
}
|
|
}
|
|
catch {
|
|
$message = $_.Exception.Message
|
|
Write-Warning $message
|
|
Write-Log -Message "FEHLER: $message"
|
|
|
|
[pscustomobject]@{
|
|
Project = $project.Name
|
|
Path = $project.FullName
|
|
Result = "PowerShell-Fehler"
|
|
ExitCode = 99
|
|
}
|
|
}
|
|
}
|
|
|
|
Write-Host ""
|
|
Write-Host "Zusammenfassung"
|
|
$results | Format-Table Project, Result, ExitCode -AutoSize
|
|
|
|
$csvFile = [System.IO.Path]::ChangeExtension($logFile, ".csv")
|
|
$results | Export-Csv -LiteralPath $csvFile -NoTypeInformation -Encoding UTF8
|
|
|
|
Write-Host ""
|
|
Write-Host "Log: $logFile"
|
|
Write-Host "CSV: $csvFile"
|
|
|
|
if ($results.ExitCode -contains 99 -or ($results.ExitCode | Where-Object { $_ -notin 0, 10 })) {
|
|
exit 1
|
|
}
|
|
|
|
if ($results.ExitCode -contains 10) {
|
|
exit 10
|
|
}
|
|
|
|
exit 0
|