source: branches/gsoc13-tests/src/images_to_archives.tcl @ 139170

Last change on this file since 139170 was 105002, checked in by afb@…, 7 years ago

Remove support for the xml metadata and the xpkg package archives

Doesn't make much sense now it has been moved from archive to install,
and the corresponding xpkg binary package support was never implemented.
Now that the source packages are removed, lose the binary packages too.
Future attempts are more likely to used a tar-based format, than a xar.

  • 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 105002 2013-04-07 12:15:15Z afb@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.