source: trunk/base/src/port/portmirror.tcl @ 29191

Last change on this file since 29191 was 29191, checked in by jmpp@…, 12 years ago

API change:

  • move ui_isset and global_option_isset procs that are found in every single macports1.0 client into macports1.0 itself, sparing the clients from implementing them repeatedly;
  • change their prototypes to require the arrays as arguments, so that the library clients can still set and fill them up as desired;
  • update every macports1.0 client in our tree to use this new API (this expands to the port, portindex and portmirror scripts in the base/src/port, do let me know of I'm missing any).

PS: The purpose of this commit is to further simplify macports1.0 scripting, so that a client is not forced to do all the UI initialization plumbing.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.5 KB
Line 
1#!/bin/sh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:et:sw=4:ts=4:sts=4
3exec @TCLSH@ "$0" "$@"
4
5# Updates the distfiles to current distfiles by deleting old stuff.
6# Uses the database.
7# $Id: portmirror.tcl 29191 2007-09-17 07:55:36Z jmpp@macports.org $
8
9catch {source \
10    [file join "@TCL_PACKAGE_DIR@" macports1.0 macports_fastload.tcl]}
11package require macports
12package require Pextlib
13
14# Globals
15global distfiles_filemap
16array set ui_options        [list]
17array set global_options    [list]
18array set global_variations [list]
19
20# Pass global options into mportinit
21mportinit ui_options global_options global_variations
22
23# UI Instantiations
24# ui_options(ports_debug) - If set, output debugging messages.
25# ui_options(ports_verbose) - If set, output info messages (ui_info)
26# ui_options(ports_quiet) - If set, don't output "standard messages"
27
28
29# UI Callback
30proc ui_prefix {priority} {
31    switch $priority {
32        debug {
33            return "DEBUG: "
34        }
35        error {
36            return "Error: "
37        }
38        warn {
39            return "Warning: "
40        }
41        default {
42            return ""
43        }
44    }
45}
46
47proc ui_channels {priority} {
48    switch $priority {
49        debug {
50            if {[macports::ui_isset ui_options ports_debug]} {
51                return {stderr}
52            } else {
53                return {}
54            }
55        }
56        info {
57            if {[macports::ui_isset ui_options ports_verbose]} {
58                return {stdout}
59            } else {
60                return {}
61            }
62        }
63        msg {
64            if {[macports::ui_isset ui_options ports_quiet]} {
65                return {}
66            } else {
67                return {stdout}
68            }
69        }
70        error {
71            return {stderr}
72        }
73        default {
74            return {stdout}
75        }
76    }
77}
78
79# Iterate on dist files.
80#
81# func:     function to call on every dist file (it is passed
82#           the path as its parameter)
83# root:     the directory with all the dist files (full path).
84proc iterate_distfiles_r {func root} {
85    foreach item [readdir $root] {
86        set pathToItem [file join $root $item]
87        if {[file isdirectory $pathToItem]} {
88            iterate_distfiles_r $func $pathToItem
89        } else {
90            $func $pathToItem
91        }
92    }
93}
94
95# Iterate on dist files.
96#
97# func:     function to call on every dist file (it is passed
98#           the path as its parameter)
99proc iterate_distfiles {func} {
100    global macports::portdbpath
101    iterate_distfiles_r $func [file join ${macports::portdbpath} distfiles]
102}
103
104# Check if the file is in the map and delete it otherwise.
105proc iterate_walker {path} {
106    global distfiles_filemap
107    if {![filemap exists distfiles_filemap $path]} {
108        puts "deleting $path"
109        file delete -force $path
110    }
111}
112
113# Open the database
114proc open_database args {
115    global macports::portdbpath distfiles_filemap
116    set path [file join ${macports::portdbpath} distfiles_mirror.db]
117    if {[file exists $path]} {
118        filemap open distfiles_filemap $path readonly
119    } else {
120        return -code error "The database doesn't exist at <$path>"
121    }
122}
123
124# Close the database
125proc close_database args {
126    global distfiles_filemap
127    filemap close distfiles_filemap
128}
129
130# Standard procedures
131proc print_usage args {
132    global argv0
133    puts "Usage: $argv0"
134}
135
136if {[expr $argc > 0]} {
137    print_usage
138    exit 1
139}
140
141# Open the database.
142open_database
143
144# Iterate on the files, deleting them.
145iterate_distfiles iterate_walker
146
147# Close the database
148close_database
Note: See TracBrowser for help on using the repository browser.