Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
461
#alt_skripte/update-renv-projects-v7.ps1
Normal file
461
#alt_skripte/update-renv-projects-v7.ps1
Normal file
|
|
@ -0,0 +1,461 @@
|
|||
[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
|
||||
Loading…
Add table
Add a link
Reference in a new issue