Changeset e83ccac in tol

Timestamp:

Dec 22, 2011, 4:53:49 PM (15 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

e4c69c1

Parents:

6232734

Message:

refs 1191

• Se lee la información de los paquetes instalados desde info.oza.
• Se adapta el interfaz a la nueva estructura de información
• El estado de los paquetes se muestra dependiendo de la información sincronizada con el servidor "SyncInfo"
• Se añaden opciones para importar/exportar los archivos SyncInfo

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3961 be4846ae-f051-483a-831f-b64e7d08527f

Location:

tolbase/lib/toltk

Files:

• tolpkg.tcl (modified) (3 diffs)
• tolpkg_gui.tcl (modified) (9 diffs)

tolbase/lib/toltk/tolpkg.tcl

@@ -40 +40 @@
   set localRoot [ file normalize \
                       [ toltcl::eval { Text TolPackage::_.localRoot } ] ]
-  set ozaSyncInfo [ file join $localRoot "Client/PackSyncInfo.oza" ]
-  set tolScript [ string map [ list "%O" $ozaSyncInfo ] {
+  set oza [ file join $localRoot "Client/PackSyncInfo.oza" ]
+  if { ![ file exists $oza ] || ![ file readable $oza ] } {
+    return {}
+  }
+  set tolScript [ string map [ list "%O" $oza ] {
     Set { Ois.Load( "%O" )[1] }
   } ]
@@ -78 +81 @@
   set localRoot [ file normalize \
                       [ toltcl::eval { Text TolPackage::_.localRoot } ] ]
-  set ozaSyncInfo [ file join $localRoot "Client/VersSyncInfo.oza" ]
-  set tolScript [ string map [ list "%O" $ozaSyncInfo ] {
+  set oza [ file join $localRoot "Client/VersSyncInfo.oza" ]
+  if { ![ file exists $oza ] || ![ file readable $oza ] } {
+    return {}
+  }
+  set tolScript [ string map [ list "%O" $oza ] {
     Set { Ois.Load( "%O" )[1] }
   } ]
@@ -109 +115 @@
   set pkgsInfo {}
   foreach d $dirs {
-    set check [ file join $clientRoot $d ${d}.oza ]
-    if { [ file exists $check ] } {
-      lappend pkgsInfo [ GetPackageInfoFromOZA $check ]
-    }
+    lappend pkgsInfo [ list $d [ GetLocalPackageInfo $d ] ]
   }
   return $pkgsInfo
+}
+
+proc ::TolPkg::GetLocalPackageInfo { p } {
+  set tolScript [ string map [ list %p $p ] {
+    Set TolPackage::Client::LocalInfo( "%p" );
+  } ]
+  return [ lindex [ toltcl::eval $tolScript -named 1 ] 1 ]
 }
 

tolbase/lib/toltk/tolpkg_gui.tcl

@@ -13 +13 @@
   variable urlmap
   
-  variable localPackageInfo
+  variable packSyncInfo
+  variable versSyncInfo
   variable localVersionInfo
+  variable localMostRecent
+
   variable nodesInfo
-
-  variable localSortedNames
   variable treeParents
 
@@ -631 +632 @@
 }
 
+proc ::TolPkgGUI::ReadPackSyncInfo { } {
+  variable packSyncInfo
+
+  array unset packSyncInfo
+  foreach p [ ::TolPkg::GetPkgSyncInfo ] {
+    array set packSyncInfo $p
+  }
+}
+
+proc ::TolPkgGUI::ReadVersSyncInfo { } {
+  variable versSyncInfo
+
+  array unset versSyncInfo
+  foreach p [ ::TolPkg::GetVersSyncInfo ] {
+    array set versSyncInfo $p
+  }
+}
+
+proc ::TolPkgGUI::ReadLocalVersionInfo { } {
+  variable localVersionInfo
+
+  array unset localVersionInfo
+  foreach pv [ ::TolPkg::GetLocalPackages ] {
+    array set localVersionInfo $pv
+  }
+}
+
+proc ::TolPkgGUI::GetPkgNode { T repo p } {
+  variable treeParents
+  variable nodesInfo
+  variable packSyncInfo
+
+  if { [ info exists treeParents($p) ] } {
+    return treeParents($p)
+  }
+  if { ![ info exists treeParents($repo) ] } {
+    set treeParents($repo) [ $T insert [ list [ list database_1_16 $repo ] "" ] \
+                                    -at end -relative root \
+                                    -button auto ]
+    set nodesInfo($treeParents($repo),type) repo
+  }
+  if { [ info exists packSyncInfo($p) ] } {
+    array set packSync $packSyncInfo($p)
+    set lastlocal $packSync(lastlocal)
+    set lastremote $packSync(lastremote)
+    if { $lastlocal eq "" } {
+      set img "package_down_16"
+      set nodeStatus new
+      set statusLabel "new ($lastremote)"
+    } else {
+      set idx [ CmpVersion $lastremote $lastlocal ]
+      if { $idx <= 0 } {
+        # could be -1 (because of date error)
+        set img "cdr_tick_16"
+        set nodeStatus ok
+        set statusLabel "ok"
+      } else {
+        puts "$lastremote > $lastlocal"
+        set img "software_update_16"
+        set nodeStatus upgrade
+        set statusLabel "upgrade ($lastremote)"
+      }
+    }
+  } else {
+    set img ""
+    set nodeStatus unknown
+    set statusLabel "unknown"
+ }
+  set treeParents($p) [ $T insert [ list [ list $img $p ] [ list $statusLabel ] ] \
+                            -at end -relative $treeParents($repo) \
+                            -button auto ]
+  set nodesInfo($treeParents($p),type) pkg
+  set nodesInfo($treeParents($p),status) $nodeStatus
+}
+
 proc ::TolPkgGUI::FillTreeInfo { T } {
-  variable localPackageInfo
+  variable packSyncInfo
+  variable versSyncInfo
   variable localVersionInfo
   variable treeParents
   variable nodesInfo
+  variable localMostRecent
+
+  array unset treeParents
+  array unset nodesInfo
+  ReadPackSyncInfo
+  ReadVersSyncInfo
+  ReadLocalVersionInfo
 
   $T configure -table no -filter yes -columns {
     { {image text} -tags NAME -label "Name" }
-  }
-
-  foreach p [ ::TolPkg::GetPkgSyncInfo ] {
-    array set localPackageInfo $p
-  }
-  array unset treeParents
-  array unset nodesInfo
+    { {text} -tags STATUS -label "Status" }
+  }
+
   # insert package information
-  foreach p [ array names localPackageInfo ] {
-    array set pkg $localPackageInfo($p)
-    set pkgRepo [ expr { [ string range $pkg(url) end-13 end ] eq "repository.php" ?
-                         $pkg(url) : "$pkg(url)repository.php" } ]
-    if { ![ info exists treeParents($p) ] } {
-      if { ![ info exists treeParents($pkgRepo) ] } {
-        set treeParents($pkgRepo) [ $T insert [ list [ list database_1_16 $pkgRepo ] ] \
-                                        -at end -relative root \
-                                        -button auto ]
-        set nodesInfo($treeParents($pkgRepo),type) repo
-      }
-      set lastremote $pkg(lastremote)
-      set lastlocal $pkg(lastlocal)
-      if { $lastlocal eq "" } {
+  foreach p [ lsort [ array names packSyncInfo ] ] {
+    array unset pkg
+    array set pkg $packSyncInfo($p)
+    set url $pkg(url)
+    set pkgRepo [ expr { [ string range $url end-13 end ] eq "repository.php" ?
+                         $url : "${url}repository.php" } ]
+    GetPkgNode $T $pkgRepo $p
+  }
+  
+  set localVersionNames [ lsort -decreasing -command ::TolPkgGUI::CmpVersion \
+                              [ array names localVersionInfo ] ]
+
+  array unset localMostRecent
+  # insert version information
+  foreach pv $localVersionNames {
+    array unset pkg
+    array set pkg $localVersionInfo($pv)
+    set pkgRoot [ lindex [ split $pv . ] 0 ]
+    set url $pkg(_.autodoc.url)
+    set pkgRepo [ expr { [ string range $url end-13 end ] eq "repository.php" ?
+                         $url : "${url}repository.php" } ]
+    GetPkgNode $T $pkgRepo $pkgRoot 
+
+    if { ![ info exists localMostRecent($pkgRoot) ] } {
+      # will be used in contextual menu
+      set localMostRecent($pkgRoot) $pv
+    }
+    if { [ info exists versSyncInfo($pv) ] } {
+      array set versSync $versSyncInfo($pv)
+      set dateremote $versSync(dateremote)
+      set datelocal $versSync(datelocal)
+      if { $datelocal eq "TheBegin" } {
         set img "package_down_16"
         set nodeStatus new
+        set statusLabel "new"
       } else {
-        set idx [ CmpVersion $lastremote $lastlocal ]
+        set idx [ string compare $dateremote $datelocal ]
         if { $idx <= 0 } {
           # could be -1 (because of date error)
           set img "cdr_tick_16"
           set nodeStatus ok
+          set statusLabel "ok"
         } else {
           set img "software_update_16"
-          set nodeStatus upgrade
+          set nodeStatus update
+          set statusLabel "outdated"
         }
       }
-      set treeParents($p) [ $T insert [ list [ list $img $p ] ] \
-                                -at end -relative $treeParents($pkgRepo) \
-                                -button auto ]
-      set nodesInfo($treeParents($p),type) pkg
-      set nodesInfo($treeParents($p),status) $nodeStatus
-    }
-  }
-  foreach pv [ ::TolPkg::GetVersSyncInfo ] {
-    array set localVersionInfo $pv
-  }
-  set localVersionNames [ lsort -decreasing -command ::TolPkgGUI::CmpVersion \
-                              [ array names localVersionInfo ] ]
-  # insert version information
-  array unset pkg
-  foreach pv $localVersionNames {
-    array set pkg $localVersionInfo($pv)
-    set pkgRoot $pkg(name)
-    set pkgRepo [ expr { [ string range $pkg(url) end-13 end ] eq "repository.php" ?
-                         $pkg(url) : "$pkg(url)repository.php" } ]
-    if { ![ info exists treeParents($pkgRoot) ] } {
-      puts "package root '$pkgRoot' must be already created, creating ..."
-      if { ![ info exists treeParents($pkgRepo) ] } {
-        puts "repository root '$pkgRepo' must be already created, creating ..."
-        set treeParents($pkgRepo) [ $T insert [ list [ list database_1_16 $pkgRepo ] ] \
-                                        -at end -relative root -button auto ]
-        set nodesInfo($treeParents($pkgRepo),type) repo
-      }
-      set treeParents($pkgRoot) [ $T insert [ list [ list {} $pkgRoot ] ] \
-                                      -at end -relative $treeParents($pkgRepo) \
-                                      -button auto ]
-      set nodesInfo($treeParents($pkgRoot),type) pkg
-    }
-    set dateremote $pkg(dateremote)
-    set datelocal $pkg(datelocal)
-    if { $datelocal eq "TheBegin" } {
-      set img "package_down_16"
-      set nodeStatus new
     } else {
-      set idx [ string compare $dateremote $datelocal ]
-      if { $idx <= 0 } {
-        # could be -1 (because of date error)
-        set img "cdr_tick_16"
-        set nodeStatus ok
-      } else {
-        set img "software_update_16"
-        set nodeStatus update
-      }
-    }
-    set nid [ $T insert [ list [ list $img $pv ] ] \
+      set img ""
+      set nodeStatus unknown
+    }
+    set nid [ $T insert [ list [ list $img $pv ] [ list $statusLabel ] ] \
                   -at end -relative $treeParents($pkgRoot) -button auto ]
     set nodesInfo($nid,type) pkgver
     set nodesInfo($nid,status) $nodeStatus
-    foreach d $pkg(dependencies) {
-      set nid [ $T insert [ list [ list back_to_ou_16 $d ] ] \
+    foreach {{} d} $pkg(_.autodoc.dependencies) {
+      set _nid [ $T insert [ list [ list back_to_ou_16 $d ] ] \
                     -at end -relative $nid -button no ]
-      set nodesInfo($nid,type) pkgdep
+      set nodesInfo($_nid,type) pkgdep
     }
   }
@@ -856 +913 @@
 proc ::TolPkgGUI::PostContextMenu { T w } {
   variable nodesInfo
-  variable localPackageInfo
+  variable packSyncInfo
+  variable versSyncInfo
   variable localVersionInfo
+  variable localMostRecent
 
   $w delete 0 end
@@ -868 +927 @@
     lappend selectionInfo($nodesInfo($nid,type)) $nid
   }
-  $w add command  -label "[ mc {Add New} ]..." \
+  $w add command  -label "[ mc {Add New Repository} ]..." \
       -command ::TolPkgGUI::AddNewRepository
   set lenRepo [ llength $selectionInfo(repo) ]
@@ -902 +961 @@
     set pkg [ $T item text $nid 0 ]
     array unset pkgInfo
-    array set pkgInfo $localPackageInfo($pkg)
+    if { [ info exists packSyncInfo($pkg) ] } {
+      array set pkgInfo $packSyncInfo($pkg)
+    } else {
+      set pkgInfo(lastremote) $localMostRecent($pkg)
+    }
     switch -exact $nodesInfo($nid,status) {
       "new" {
@@ -911 +974 @@
       }
       "ok" {
+      }
+      "unknown" {
       }
       default {
@@ -981 +1046 @@
   $w add command -label [ mc "Export all" ] \
       -command [ list ::TolPkgGUI::ExportPackageVersion ]
+  # SyncInfo import/export
+  $w add separator
+  $w add command -label [ mc "Import SyncInfo" ]... \
+      -command [ list ::TolPkgGUI::ImportSyncInfo ]
+  $w add command -label [ mc "Export SyncInfo" ]... \
+      -command [ list ::TolPkgGUI::ExportSyncInfo ]
+  
 }
 
@@ -990 +1062 @@
 
 proc ::TolPkgGUI::SyncServers { } {
+  ::TolPkg::UpdateRepositoryInfo
 }
 
@@ -1004 +1077 @@
 }
 
+proc ::TolPkgGUI::ImportSyncInfo { } {
+}
+
+proc ::TolPkgGUI::ExportSyncInfo { } {
+}
+
+##
+# Export packages --
+#
+# p == "" then the last installed version of every package is
+# exported,
+#
+# [ llength $p ]>0 then all specified package is exported, if some
+# packages is not installed then it is requested from the remote
+# repository.
+#
 proc ::TolPkgGUI::ExportPackageVersion { {p ""} } {
+  
 }