source: trunk/base/src/images_to_archives.tcl @ 81464

Last change on this file since 81464 was 81464, checked in by jmr@…, 9 years ago

add progress output to images_to_archives.tcl (#30347)

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 5.8 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 81464 2011-07-31 09:26:50Z jmr@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 xpkg 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            file mkdir $targetdir
96            set contents [$iref imagefiles]
97        }
98        set newlocation [file join $targetdir $archivename]
99
100        if {$found} {
101            file rename $oldarchivefullpath $newlocation
102        } elseif {$installtype == "image"} {
103            # create archive from image dir
104            system "cd $location && $tarcmd -cjf $newlocation * > ${targetdir}/error.log 2>&1"
105            file delete -force ${targetdir}/error.log
106        } else {
107            # direct mode, create archive from installed files
108            # we tell tar to read filenames from a file so as not to run afoul of command line length limits
109            set fd [open ${targetdir}/tarlist w]
110            foreach entry $contents {
111                puts $fd $entry
112            }
113            close $fd
114            system "$tarcmd -cjf $newlocation -T ${targetdir}/tarlist > ${targetdir}/error.log 2>&1"
115            file delete -force ${targetdir}/tarlist ${targetdir}/error.log
116        }
117
118        lappend archived_list [list $installtype $iref $location $newlocation]
119    }
120}
121
122set archived_len [llength $archived_list]
123set counter 0
124
125registry::write {
126    foreach archived $archived_list {
127        incr counter
128        ui_msg "Updating registry: ${counter} of ${archived_len}"
129        set installtype [lindex $archived 0]
130        set iref [lindex $archived 1]
131        set newlocation [lindex $archived 3]
132   
133        if {$installtype == "direct"} {
134            # change receipt to image
135            $iref installtype image
136            $iref state imaged
137            $iref activate [$iref imagefiles]
138            $iref state installed
139        }
140   
141        # set the new location in the registry and delete the old dir
142        $iref location $newlocation
143    }
144}
145
146set counter 0
147foreach archived $archived_list {
148    incr counter
149    set location [lindex $archived 2]
150    ui_msg "Deleting ${counter} of ${archived_len}: ${location}"
151    if {$location != "" && [file isdirectory $location]} {
152        if {[catch {file delete -force $location} result]} {
153            ui_warn "Failed to delete ${location}: $result"
154        }
155    }
156}
157
158exit 0
Note: See TracBrowser for help on using the repository browser.