| 1 | # git-gui object database management support |
| 2 | # Copyright (C) 2006, 2007 Shawn Pearce |
| 3 | |
| 4 | proc do_stats {} { |
| 5 | set fd [git_read [list count-objects -v]] |
| 6 | while {[gets $fd line] > 0} { |
| 7 | if {[regexp {^([^:]+): (\d+)$} $line _ name value]} { |
| 8 | set stats($name) $value |
| 9 | } |
| 10 | } |
| 11 | close $fd |
| 12 | |
| 13 | set packed_sz 0 |
| 14 | foreach p [glob -directory [gitdir objects pack] \ |
| 15 | -type f \ |
| 16 | -nocomplain -- *] { |
| 17 | incr packed_sz [file size $p] |
| 18 | } |
| 19 | if {$packed_sz > 0} { |
| 20 | set stats(size-pack) [expr {$packed_sz / 1024}] |
| 21 | } |
| 22 | |
| 23 | set w .stats_view |
| 24 | Dialog $w |
| 25 | wm withdraw $w |
| 26 | wm geometry $w "+[winfo rootx .]+[winfo rooty .]" |
| 27 | |
| 28 | ttk::frame $w.buttons |
| 29 | ttk::button $w.buttons.close -text [mc Close] \ |
| 30 | -default active \ |
| 31 | -command [list destroy $w] |
| 32 | ttk::button $w.buttons.gc -text [mc "Compress Database"] \ |
| 33 | -default normal \ |
| 34 | -command "destroy $w;do_gc" |
| 35 | pack $w.buttons.close -side right |
| 36 | pack $w.buttons.gc -side left |
| 37 | pack $w.buttons -side bottom -fill x -pady 10 -padx 10 |
| 38 | |
| 39 | ttk::labelframe $w.stat -text [mc "Database Statistics"] |
| 40 | foreach s { |
| 41 | {count {mc "Number of loose objects"}} |
| 42 | {size {mc "Disk space used by loose objects"} { KiB}} |
| 43 | {in-pack {mc "Number of packed objects"}} |
| 44 | {packs {mc "Number of packs"}} |
| 45 | {size-pack {mc "Disk space used by packed objects"} { KiB}} |
| 46 | {prune-packable {mc "Packed objects waiting for pruning"}} |
| 47 | {garbage {mc "Garbage files"}} |
| 48 | } { |
| 49 | set name [lindex $s 0] |
| 50 | set label [eval [lindex $s 1]] |
| 51 | if {[catch {set value $stats($name)}]} continue |
| 52 | if {[llength $s] > 2} { |
| 53 | set value "$value[lindex $s 2]" |
| 54 | } |
| 55 | |
| 56 | ttk::label $w.stat.l_$name -text [mc "%s:" $label] -anchor w |
| 57 | ttk::label $w.stat.v_$name -text $value -anchor w |
| 58 | grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5} |
| 59 | } |
| 60 | pack $w.stat -pady 10 -padx 10 |
| 61 | |
| 62 | bind $w <Visibility> "grab $w; focus $w.buttons.close" |
| 63 | bind $w <Key-Escape> [list destroy $w] |
| 64 | bind $w <Key-Return> [list destroy $w] |
| 65 | wm title $w [mc "%s (%s): Database Statistics" [appname] [reponame]] |
| 66 | wm deiconify $w |
| 67 | tkwait window $w |
| 68 | } |
| 69 | |
| 70 | proc do_gc {} { |
| 71 | set w [console::new {gc} [mc "Compressing the object database"]] |
| 72 | console::chain $w { |
| 73 | {exec git pack-refs --prune} |
| 74 | {exec git reflog expire --all} |
| 75 | {exec git repack -a -d -l} |
| 76 | {exec git rerere gc} |
| 77 | } |
| 78 | } |
| 79 | |
| 80 | proc do_fsck_objects {} { |
| 81 | set w [console::new {fsck-objects} \ |
| 82 | [mc "Verifying the object database with fsck-objects"]] |
| 83 | set cmd [list git fsck-objects] |
| 84 | lappend cmd --full |
| 85 | lappend cmd --cache |
| 86 | lappend cmd --strict |
| 87 | console::exec $w $cmd |
| 88 | } |
| 89 | |
| 90 | proc hint_gc {} { |
| 91 | set ndirs 1 |
| 92 | set limit 8 |
| 93 | if {[is_Windows]} { |
| 94 | set ndirs 4 |
| 95 | set limit 1 |
| 96 | } |
| 97 | |
| 98 | set count [llength [glob \ |
| 99 | -nocomplain \ |
| 100 | -- \ |
| 101 | [gitdir objects 4\[0-[expr {$ndirs-1}]\]/*]]] |
| 102 | |
| 103 | if {$count >= $limit * $ndirs} { |
| 104 | set objects_current [expr {$count * 256/$ndirs}] |
| 105 | if {[ask_popup \ |
| 106 | [mc "This repository currently has approximately %i loose objects. |
| 107 | |
| 108 | To maintain optimal performance it is strongly recommended that you compress the database. |
| 109 | |
| 110 | Compress the database now?" $objects_current]] eq yes} { |
| 111 | do_gc |
| 112 | } |
| 113 | } |
| 114 | } |