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

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

Whitespace changes only.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.6 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 29189 2007-09-17 07:32: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# ui_options accessor
29proc ui_isset {val} {
30    global ui_options
31    if {[info exists ui_options($val)]} {
32    if {$ui_options($val) == "yes"} {
33        return 1
34    }
35    }
36    return 0
37}
38
39# UI Callback
40proc ui_prefix {priority} {
41    switch $priority {
42        debug {
43            return "DEBUG: "
44        }
45        error {
46            return "Error: "
47        }
48        warn {
49            return "Warning: "
50        }
51        default {
52            return ""
53        }
54    }
55}
56
57proc ui_channels {priority} {
58    switch $priority {
59        debug {
60            if {[ui_isset ports_debug]} {
61                return {stderr}
62            } else {
63                return {}
64            }
65        }
66        info {
67            if {[ui_isset ports_verbose]} {
68                return {stdout}
69            } else {
70                return {}
71            }
72        }
73        msg {
74            if {[ui_isset ports_quiet]} {
75                return {}
76            } else {
77                return {stdout}
78            }
79        }
80        error {
81            return {stderr}
82        }
83        default {
84            return {stdout}
85        }
86    }
87}
88
89# Iterate on dist files.
90#
91# func:     function to call on every dist file (it is passed
92#           the path as its parameter)
93# root:     the directory with all the dist files (full path).
94proc iterate_distfiles_r {func root} {
95    foreach item [readdir $root] {
96        set pathToItem [file join $root $item]
97        if {[file isdirectory $pathToItem]} {
98            iterate_distfiles_r $func $pathToItem
99        } else {
100            $func $pathToItem
101        }
102    }
103}
104
105# Iterate on dist files.
106#
107# func:     function to call on every dist file (it is passed
108#           the path as its parameter)
109proc iterate_distfiles {func} {
110    global macports::portdbpath
111    iterate_distfiles_r $func [file join ${macports::portdbpath} distfiles]
112}
113
114# Check if the file is in the map and delete it otherwise.
115proc iterate_walker {path} {
116    global distfiles_filemap
117    if {![filemap exists distfiles_filemap $path]} {
118        puts "deleting $path"
119        file delete -force $path
120    }
121}
122
123# Open the database
124proc open_database args {
125    global macports::portdbpath distfiles_filemap
126    set path [file join ${macports::portdbpath} distfiles_mirror.db]
127    if {[file exists $path]} {
128        filemap open distfiles_filemap $path readonly
129    } else {
130        return -code error "The database doesn't exist at <$path>"
131    }
132}
133
134# Close the database
135proc close_database args {
136    global distfiles_filemap
137    filemap close distfiles_filemap
138}
139
140# Standard procedures
141proc print_usage args {
142    global argv0
143    puts "Usage: $argv0"
144}
145
146if {[expr $argc > 0]} {
147    print_usage
148    exit 1
149}
150
151# Open the database.
152open_database
153
154# Iterate on the files, deleting them.
155iterate_distfiles iterate_walker
156
157# Close the database
158close_database
Note: See TracBrowser for help on using the repository browser.