source: branches/gsoc11-statistics/base/src/images_to_archives.tcl @ 140222

Last change on this file since 140222 was 105085, checked in by snc@…, 7 years ago

merge from trunk

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 5.9 KB
Line 
1#!/usr/bin/env tclsh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
3# $Id: images_to_archives.tcl 105085 2013-04-09 18:46:31Z snc@macports.org $
4
5# convert existing port image directories into compressed archive versions
6# Takes one argument, which should be TCL_PACKAGE_DIR.
7
8source [file join [lindex $argv 0] macports1.0 macports_fastload.tcl]
9package require macports 1.0
10package require registry 1.0
11package require registry2 2.0
12package require Pextlib 1.0
13
14umask 022
15
16array set ui_options {ports_verbose yes}
17
18mportinit ui_options
19
20# always converting to tbz2 should be fine as both these programs are
21# needed elsewhere and assumed to be available
22set tarcmd [macports::findBinary tar ${macports::autoconf::tar_path}]
23set bzip2cmd [macports::findBinary bzip2 ${macports::autoconf::bzip2_path}]
24
25if {[catch {set ilist [registry::installed]}]} {
26    # no ports installed
27    puts "No ports installed to convert."
28    exit 0
29}
30
31puts "This could take a while..."
32
33# list of ports we successfully create an archive of, to be used to update
34# the registry only after we know all creation attempts were successful.
35set archived_list {}
36set installed_len [llength $ilist]
37set counter 0
38
39foreach installed $ilist {
40    incr counter
41    set iname [lindex $installed 0]
42    set iversion [lindex $installed 1]
43    set irevision [lindex $installed 2]
44    set ivariants [lindex $installed 3]
45    set iepoch [lindex $installed 5]
46    set iref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
47    set installtype [registry::property_retrieve $iref installtype]
48    if {$installtype == "image"} {
49        set location [registry::property_retrieve $iref location]
50        if {$location == "0"} {
51            set location [registry::property_retrieve $iref imagedir]
52        }
53    } else {
54        set location ""
55    }
56
57    if {$location == "" || ![file isfile $location]} {
58        # no image archive present, so make one
59        set archs [registry::property_retrieve $iref archs]
60        if {$archs == "" || $archs == "0"} {
61            set archs ${macports::os_arch}
62        }
63        # look for any existing archive in the old location
64        set oldarchiverootname "${iname}-${iversion}_${irevision}${ivariants}.[join $archs -]"
65        set archivetype tbz2
66        set oldarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}_${macports::os_major}]
67        set olderarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}]
68        if {[llength $archs] == 1} {
69            set oldarchivedir [file join $oldarchivedir $archs $iname]
70            set olderarchivedir [file join $olderarchivedir $archs]
71        } else {
72            set oldarchivedir [file join $oldarchivedir universal $iname]
73            set olderarchivedir [file join $olderarchivedir universal]
74        }
75        set found 0
76        foreach adir [list $oldarchivedir $olderarchivedir] {
77            foreach type {tbz2 tbz tgz tar txz tlz xar zip cpgz cpio} {
78                set oldarchivefullpath "[file join $adir $oldarchiverootname].${type}"
79                if {[file isfile $oldarchivefullpath]} {
80                    set found 1
81                    set archivetype $type
82                    break
83                }
84            }
85            if {$found} {break}
86        }
87
88        # compute new name and location of archive
89        set archivename "${iname}-${iversion}_${irevision}${ivariants}.${macports::os_platform}_${macports::os_major}.[join $archs -].${archivetype}"
90        ui_msg "Processing ${counter} of ${installed_len}: ${archivename}"
91        if {$installtype == "image"} {
92            set targetdir [file dirname $location]
93        } else {
94            set targetdir [file join ${macports::registry.path} software ${iname}]
95        }
96        if {$location == "" || ![file isdirectory $location]} {
97            set contents [$iref imagefiles]
98        }
99        file mkdir $targetdir
100        set newlocation [file join $targetdir $archivename]
101
102        if {$found} {
103            file rename $oldarchivefullpath $newlocation
104        } elseif {$installtype == "image" && [file isdirectory $location]} {
105            # create archive from image dir
106            system -W $location "$tarcmd -cjf $newlocation * > ${targetdir}/error.log 2>&1"
107            file delete -force ${targetdir}/error.log
108        } else {
109            # direct mode (or missing image dir), create archive from installed files
110            # we tell tar to read filenames from a file so as not to run afoul of command line length limits
111            set fd [open ${targetdir}/tarlist w]
112            foreach entry $contents {
113                puts $fd $entry
114            }
115            close $fd
116            system "$tarcmd -cjf $newlocation -T ${targetdir}/tarlist > ${targetdir}/error.log 2>&1"
117            file delete -force ${targetdir}/tarlist ${targetdir}/error.log
118        }
119
120        lappend archived_list [list $installtype $iref $location $newlocation]
121    }
122}
123
124set archived_len [llength $archived_list]
125set counter 0
126
127registry::write {
128    foreach archived $archived_list {
129        incr counter
130        ui_msg "Updating registry: ${counter} of ${archived_len}"
131        set installtype [lindex $archived 0]
132        set iref [lindex $archived 1]
133        set newlocation [lindex $archived 3]
134   
135        if {$installtype == "direct"} {
136            # change receipt to image
137            $iref installtype image
138            $iref state imaged
139            $iref activate [$iref imagefiles]
140            $iref state installed
141        }
142   
143        # set the new location in the registry and delete the old dir
144        $iref location $newlocation
145    }
146}
147
148set counter 0
149foreach archived $archived_list {
150    incr counter
151    set location [lindex $archived 2]
152    ui_msg "Deleting ${counter} of ${archived_len}: ${location}"
153    if {$location != "" && [file isdirectory $location]} {
154        if {[catch {file delete -force $location} result]} {
155            ui_warn "Failed to delete ${location}: $result"
156        }
157    }
158}
159
160exit 0
Note: See TracBrowser for help on using the repository browser.