Changeset 88376


Ignore:
Timestamp:
Dec 30, 2011, 12:17:49 AM (9 years ago)
Author:
cal@…
Message:

Merge from /branches/gsoc11-rev-upgrade

Location:
trunk/base
Files:
31 edited
10 copied

Legend:

Unmodified
Added
Removed
  • trunk/base

  • trunk/base/configure

    r81642 r88376  
    680680TAR_Q
    681681SED_EXT
     682SWIG
    682683OPEN
    683684XAR
     
    845846XAR
    846847OPEN
     848SWIG
    847849OBJCPP
    848850CPP'
     
    15311533  XAR         path to xar command
    15321534  OPEN        path to open command
     1535  SWIG        path to swig command
    15331536  OBJCPP      Objective C preprocessor
    15341537  CPP         C preprocessor
     
    57855788
    57865789
     5790# Extract the first word of "swig", so it can be a program name with args.
     5791set dummy swig; ac_word=$2
     5792{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
     5793$as_echo_n "checking for $ac_word... " >&6; }
     5794if ${ac_cv_path_SWIG+:} false; then :
     5795  $as_echo_n "(cached) " >&6
     5796else
     5797  case $SWIG in
     5798  [\\/]* | ?:[\\/]*)
     5799  ac_cv_path_SWIG="$SWIG" # Let the user override the test with a path.
     5800  ;;
     5801  *)
     5802  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
     5803for as_dir in $PATH
     5804do
     5805  IFS=$as_save_IFS
     5806  test -z "$as_dir" && as_dir=.
     5807    for ac_exec_ext in '' $ac_executable_extensions; do
     5808  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
     5809    ac_cv_path_SWIG="$as_dir/$ac_word$ac_exec_ext"
     5810    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
     5811    break 2
     5812  fi
     5813done
     5814  done
     5815IFS=$as_save_IFS
     5816
     5817  test -z "$ac_cv_path_SWIG" && ac_cv_path_SWIG="$PATH:/usr/local/bin"
     5818  ;;
     5819esac
     5820fi
     5821SWIG=$ac_cv_path_SWIG
     5822if test -n "$SWIG"; then
     5823  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $SWIG" >&5
     5824$as_echo "$SWIG" >&6; }
     5825else
     5826  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
     5827$as_echo "no" >&6; }
     5828fi
     5829
     5830
    57875831
    57885832# Define some precious variables allowing user to override PATH for some programs
     5833
    57895834
    57905835
     
    97419786
    97429787# Output
    9743 ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/base.mtree doc/prefix.mtree doc/macosx.mtree doc/macports.conf doc/pubkeys.conf portmgr/freebsd/Makefile src/Makefile src/macports1.0/macports_autoconf.tcl src/port1.0/port_autoconf.tcl src/registry2.0/registry_autoconf.tcl src/programs/Makefile src/macports1.0/macports_fastload.tcl setupenv.bash"
     9788ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/base.mtree doc/prefix.mtree doc/macosx.mtree doc/macports.conf doc/pubkeys.conf portmgr/freebsd/Makefile src/Makefile src/machista1.0/Makefile src/macports1.0/macports_autoconf.tcl src/port1.0/port_autoconf.tcl src/registry2.0/registry_autoconf.tcl src/programs/Makefile src/macports1.0/macports_fastload.tcl setupenv.bash"
    97449789
    97459790
     
    1046110506    "portmgr/freebsd/Makefile") CONFIG_FILES="$CONFIG_FILES portmgr/freebsd/Makefile" ;;
    1046210507    "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;;
     10508    "src/machista1.0/Makefile") CONFIG_FILES="$CONFIG_FILES src/machista1.0/Makefile" ;;
    1046310509    "src/macports1.0/macports_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/macports1.0/macports_autoconf.tcl" ;;
    1046410510    "src/port1.0/port_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/port1.0/port_autoconf.tcl" ;;
  • trunk/base/configure.ac

    r81642 r88376  
    127127AC_PATH_PROG(XAR, [xar], [])
    128128AC_PATH_PROG(OPEN, [open], [])
     129AC_PATH_PROG(SWIG, [swig], [$PATH:/usr/local/bin])
    129130
    130131# Define some precious variables allowing user to override PATH for some programs
     
    145146AC_ARG_VAR(XAR, [path to xar command])
    146147AC_ARG_VAR(OPEN, [path to open command])
     148AC_ARG_VAR(SWIG, [path to swig command])
    147149
    148150MP_SED_EXTENDED_REGEXP
     
    369371        portmgr/freebsd/Makefile
    370372        src/Makefile
     373        src/machista1.0/Makefile
    371374        src/macports1.0/macports_autoconf.tcl
    372375        src/port1.0/port_autoconf.tcl
  • trunk/base/doc/port.1

    r79593 r88376  
    493493variants; you can either specify --enforce-variants, or deactivate the port and reinstall it
    494494with different variants.
     495.Pp
     496After the upgrade MacPorts will automatically run \fBrev-upgrade\fP to check for
     497broken ports that need to be rebuilt. If there are known problems with
     498\fBrev-upgrade\fP or other reasons why you would want to avoid running this
     499step, you can disable it by running \fBport upgrade\fP with the
     500\fB--no-rev-upgrade\fP switch:
     501.Pp
     502.Dl "port upgrade --no-rev-upgrade outdated"
     503.Ss rev-upgrade
     504Manually check for broken binaries and rebuild ports containing broken binaries.
     505\fBrev-upgrade\fP is usually automatically run after each upgrade, unless you
     506specify the \fB--no-rev-upgrade\fP option.
     507.Pp
     508\fBrev-upgrade\fP can run more checks against a special loadcommand in Mach-O
     509binaries that should always be referencing the file itself. This check is most
     510helpful for maintainers to check whether their ports have been built correctly.
     511It is disabled by default and can be enabled by passing \fB--id-loadcmd-check\fP
     512to \fBrev-upgrade\fP.
    495513.Ss clean
    496514Clean the files used for building
  • trunk/base/portmgr/fedora/macports.spec

  • trunk/base/src/Makefile.in

    r63398 r88376  
    66                        pextlib1.0 \
    77                        registry2.0 \
    8                         darwintracelib1.0
     8                        darwintracelib1.0 \
     9                        machista1.0
    910SUBDIR=         ${TCLPKG} port programs
    1011
  • trunk/base/src/cregistry/Makefile

    r66448 r88376  
    11# $Id$
    22
    3 OBJS = registry.o entry.o sql.o vercomp.o
     3OBJS = registry.o entry.o sql.o vercomp.o util.o file.o
    44STLIB_NAME = cregistry.a
    55RANLIB = ranlib
  • trunk/base/src/cregistry/entry.c

    r84481 r88376  
    3535#include "registry.h"
    3636#include "sql.h"
    37 
     37#include "util.h"
     38
     39#include <sqlite3.h>
     40#include <stdlib.h>
    3841#include <string.h>
    39 #include <stdlib.h>
    40 #include <sqlite3.h>
    4142
    4243/*
     
    5455 *       with as integers.
    5556 *
    56  * TODO: move the utility functions to util.h or something. Not important until
    57  *       there are more types in the registry than entry, though.
    58  *
    5957 * TODO: considering a "weak" flag in registry.files. The meaning of this would
    6058 *       be "I wish for my version of this file to be activated when I am, but
     
    7068
    7169/**
    72  * Concatenates `src` to string `dst`. Simple concatenation. Only guaranteed to
    73  * work with strings that have been allocated with `malloc`. Amortizes cost of
    74  * expanding string buffer for O(N) concatenation and such. Uses `memcpy` in
    75  * favor of `strcpy` in hopes it will perform a bit better.
    76  *
    77  * @param [in,out] dst       a reference to a null-terminated string
    78  * @param [in,out] dst_len   number of characters currently in `dst`
    79  * @param [in,out] dst_space number of characters `dst` can hold
    80  * @param [in] src           string to concatenate to `dst`
    81  */
    82 static int reg_strcat(char** dst, size_t* dst_len, size_t* dst_space, char* src) {
    83     size_t src_len = strlen(src);
    84     size_t result_len = *dst_len + src_len;
    85     if (result_len > *dst_space) {
    86         char* new_dst;
    87         *dst_space *= 2;
    88         if (*dst_space < result_len) {
    89             *dst_space = result_len;
    90         }
    91         new_dst = realloc(*dst, *dst_space * sizeof(char) + 1);
    92         if (!new_dst)
    93             return 0;
    94         else
    95             *dst = new_dst;
    96     }
    97     memcpy(*dst + *dst_len, src, src_len+1);
    98     *dst_len = result_len;
    99     return 1;
    100 }
    101 
    102 /**
    103  * Appends element `src` to the list `dst`. It's like `reg_strcat`, except `src`
    104  * represents a single element and not a sequence of `char`s.
    105  *
    106  * @param [in,out] dst       a reference to a list of pointers
    107  * @param [in,out] dst_len   number of elements currently in `dst`
    108  * @param [in,out] dst_space number of elements `dst` can hold
    109  * @param [in] src           elements to append to `dst`
    110  */
    111 static int reg_listcat(void*** dst, int* dst_len, int* dst_space, void* src) {
    112     if (*dst_len == *dst_space) {
    113         void** new_dst;
    114         *dst_space *= 2;
    115         new_dst = realloc(*dst, *dst_space * sizeof(void*));
    116         if (!new_dst)
    117             return 0;
    118         else
    119             *dst = new_dst;
    120     }
    121     (*dst)[*dst_len] = src;
    122     (*dst_len)++;
    123     return 1;
    124 }
    125 
    126 /**
    127  * Returns an expression to use for the given strategy. This should be passed as
    128  * the `fmt` argument of `sqlite3_mprintf`, with the key and value following.
    129  *
    130  * @param [in] strategy a strategy (one of the `reg_strategy_*` constants)
    131  * @param [out] errPtr  on error, a description of the error that occurred
    132  * @return              a sqlite3 expression if success; NULL if failure
    133  */
    134 static char* reg_strategy_op(reg_strategy strategy, reg_error* errPtr) {
    135     switch (strategy) {
    136         case reg_strategy_exact:
    137             return "%q = '%q'";
    138         case reg_strategy_glob:
    139             return "%q GLOB '%q'";
    140         case reg_strategy_regexp:
    141             return "REGEXP(%q, '%q')";
    142         default:
    143             errPtr->code = REG_INVALID;
    144             errPtr->description = "invalid matching strategy specified";
    145             errPtr->free = NULL;
    146             return NULL;
    147     }
    148 }
    149 
    150 /**
    15170 * Converts a `sqlite3_stmt` into a `reg_entry`. The first column of the stmt's
    15271 * row must be the id of an entry; the second either `SQLITE_NULL` or the
     
    16079 */
    16180static int reg_stmt_to_entry(void* userdata, void** entry, void* stmt,
    162         reg_error* errPtr UNUSED) {
     81        void* calldata UNUSED, reg_error* errPtr UNUSED) {
    16382    int is_new;
    16483    reg_registry* reg = (reg_registry*)userdata;
     
    263182    sqlite3_stmt* stmt = NULL;
    264183    reg_entry* entry = NULL;
     184    int lower_bound = 0;
    265185    char* query;
    266186    if (strlen(epoch) > 0) {
     
    287207            switch (r) {
    288208                case SQLITE_ROW:
    289                     reg_stmt_to_entry(reg, (void**)&entry, stmt, errPtr);
     209                    reg_stmt_to_entry(reg, (void**)&entry, stmt, &lower_bound, errPtr);
    290210                    break;
    291211                case SQLITE_DONE:
     
    417337
    418338/**
    419  * Convenience method for returning all objects of a given type from the
    420  * registry.
    421  *
    422  * @param [in] reg       registry to select objects from
    423  * @param [in] query     the select query to execute
    424  * @param [in] query_len length of the query (or -1 for automatic)
    425  * @param [out] objects  the objects selected
    426  * @param [in] fn        a function to convert sqlite3_stmts to the desired type
    427  * @param [in] del       a function to delete the desired type of object
    428  * @param [out] errPtr   on error, a description of the error that occurred
    429  * @return               the number of objects if success; negative if failure
    430  */
    431 static int reg_all_objects(reg_registry* reg, char* query, int query_len,
    432         void*** objects, cast_function* fn, free_function* del,
    433         reg_error* errPtr) {
    434     void** results = malloc(10*sizeof(void*));
    435     int result_count = 0;
    436     int result_space = 10;
    437     sqlite3_stmt* stmt = NULL;
    438     if (!results || !fn) {
    439         return -1;
    440     }
    441     if (sqlite3_prepare(reg->db, query, query_len, &stmt, NULL) == SQLITE_OK) {
    442         int r;
    443         reg_entry* entry;
    444         do {
    445             r = sqlite3_step(stmt);
    446             switch (r) {
    447                 case SQLITE_ROW:
    448                     if (fn(reg, (void**)&entry, stmt, errPtr)) {
    449                         if (!reg_listcat(&results, &result_count, &result_space, entry)) {
    450                             r = SQLITE_ERROR;
    451                         }
    452                     } else {
    453                         r = SQLITE_ERROR;
    454                     }
    455                     break;
    456                 case SQLITE_DONE:
    457                 case SQLITE_BUSY:
    458                     break;
    459                 default:
    460                     reg_sqlite_error(reg->db, errPtr, query);
    461                     break;
    462             }
    463         } while (r == SQLITE_ROW || r == SQLITE_BUSY);
    464         sqlite3_finalize(stmt);
    465         if (r == SQLITE_DONE) {
    466             *objects = results;
    467             return result_count;
    468         } else if (del) {
    469             int i;
    470             for (i=0; i<result_count; i++) {
    471                 del(NULL, results[i]);
    472             }
    473         }
    474     } else {
    475         if (stmt) {
    476             sqlite3_finalize(stmt);
    477         }
    478         reg_sqlite_error(reg->db, errPtr, query);
    479     }
    480     free(results);
    481     return -1;
    482 }
    483 
    484 /**
    485339 * Type-safe version of `reg_all_objects` for `reg_entry`.
    486340 *
     
    494348static int reg_all_entries(reg_registry* reg, char* query, int query_len,
    495349        reg_entry*** objects, reg_error* errPtr) {
     350    int lower_bound = 0;
    496351    return reg_all_objects(reg, query, query_len, (void***)objects,
    497             reg_stmt_to_entry, NULL, errPtr);
     352            reg_stmt_to_entry, &lower_bound, NULL, errPtr);
    498353}
    499354
     
    641496    sqlite3_stmt* stmt = NULL;
    642497    char* query = "SELECT id FROM registry.files WHERE actual_path=? AND active";
     498    int lower_bound = 0;
    643499    if ((sqlite3_prepare(reg->db, query, -1, &stmt, NULL) == SQLITE_OK)
    644500            && (sqlite3_bind_text(stmt, 1, path, -1, SQLITE_STATIC)
     
    650506                case SQLITE_ROW:
    651507                    result = reg_stmt_to_entry(reg, (void**)entry, stmt,
    652                             errPtr);
     508                            &lower_bound, errPtr);
    653509                    break;
    654510                case SQLITE_DONE:
  • trunk/base/src/cregistry/entry.h

    r65381 r88376  
    3636
    3737#include <sqlite3.h>
    38 
    39 typedef enum {
    40     reg_strategy_exact = 1,
    41     reg_strategy_glob = 2,
    42     reg_strategy_regexp = 3
    43 } reg_strategy;
    4438
    4539typedef struct {
  • trunk/base/src/cregistry/registry.c

    r84316 r88376  
    22 * registry.c
    33 * $Id$
     4 * vim:expandtab:tw=80
    45 *
    56 * Copyright (c) 2007 Chris Pickel <sfiera@macports.org>
     
    3233
    3334#include "entry.h"
     35#include "file.h"
    3436#include "sql.h"
    3537
     
    215217                            Tcl_InitHashTable(&reg->open_entries,
    216218                                    sizeof(sqlite_int64)/sizeof(int));
     219                            Tcl_InitHashTable(&reg->open_files,
     220                                    TCL_STRING_KEYS);
    217221                            reg->status |= reg_attached;
    218222                            result = 1;
     
    225229                }
    226230            } while (r == SQLITE_BUSY);
     231
     232            if (result) {
     233                result &= update_db(reg->db, errPtr);
     234            }
    227235        } else {
    228236            reg_sqlite_error(reg->db, errPtr, query);
     
    276284                    }
    277285                    Tcl_DeleteHashTable(&reg->open_entries);
     286                    for (curr = Tcl_FirstHashEntry(&reg->open_files, &search);
     287                            curr != NULL; curr = Tcl_NextHashEntry(&search)) {
     288                        reg_file* file = Tcl_GetHashValue(curr);
     289
     290                        free(file->proc);
     291                        free(file->key.path);
     292                        free(file);
     293                    }
     294                    Tcl_DeleteHashTable(&reg->open_files);
    278295                    reg->status &= ~reg_attached;
    279296                    result = 1;
  • trunk/base/src/cregistry/registry.h

    r70608 r88376  
    11/*
    22 * registry.h
     3 * vim:tw=80:expandtab
    34 * $Id$
    45 *
     
    5758
    5859typedef int (cast_function)(void* userdata, void** dst, void* src,
    59         reg_error* errPtr);
     60        void* calldata, reg_error* errPtr);
    6061typedef void (free_function)(void* userdata, void* item);
    6162
     
    7172    int status;
    7273    Tcl_HashTable open_entries;
     74    Tcl_HashTable open_files;
    7375} reg_registry;
    7476
  • trunk/base/src/cregistry/sql.c

    r68675 r88376  
    3535#include "vercomp.h"
    3636
     37#include <sqlite3.h>
     38#include <string.h>
    3739#include <tcl.h>
    38 #include <sqlite3.h>
    3940#include <time.h>
    4041
     
    109110        /* metadata table */
    110111        "CREATE TABLE registry.metadata (key UNIQUE, value)",
    111         "INSERT INTO registry.metadata (key, value) VALUES ('version', 1.000)",
     112        "INSERT INTO registry.metadata (key, value) VALUES ('version', 1.100)",
    112113        "INSERT INTO registry.metadata (key, value) VALUES ('created', strftime('%s', 'now'))",
    113114
     
    131132        /* file map */
    132133        "CREATE TABLE registry.files (id INTEGER, path TEXT, actual_path TEXT, "
    133             "active INT, mtime DATETIME, md5sum TEXT, editable INT, "
     134            "active INT, mtime DATETIME, md5sum TEXT, editable INT, binary BOOL, "
    134135            "FOREIGN KEY(id) REFERENCES ports(id))",
    135136        "CREATE INDEX registry.file_port ON files (id)",
    136137        "CREATE INDEX registry.file_path ON files(path)",
    137138        "CREATE INDEX registry.file_actual ON files(actual_path)",
     139        "CREATE INDEX registry.file_binary ON files(binary)",
    138140
    139141        /* dependency map */
     
    149151
    150152/**
     153 * Updates the database if necessary. This function queries the current database version
     154 * from the metadata table and executes SQL to update the schema to newer versions if needed.
     155 * After that, this function updates the database version number
     156 *
     157 * @param [in] db      database to update
     158 * @param [out] errPtr on error, a description of the error that occurred
     159 * @return             true if success; false if failure
     160 */
     161int update_db(sqlite3* db, reg_error* errPtr) {
     162    const char* version;
     163    char* query = "SELECT value FROM registry.metadata WHERE key = 'version'";
     164    sqlite3_stmt *stmt = NULL;
     165
     166    if ((sqlite3_prepare(db, query, -1, &stmt, NULL) != SQLITE_OK)
     167            || (sqlite3_step(stmt) != SQLITE_ROW)) {
     168        goto reg_err_out;
     169    }
     170    if (NULL == (version = (const char *)sqlite3_column_text(stmt, 0))) {
     171        goto reg_err_out;
     172    }
     173    /* can't call rpm_vercomp directly, because it is static, but can call sql_version */
     174    if (sql_version(NULL, strlen(version), version, strlen("1.1"), "1.1") < 0) {
     175        /* conversion necessary, add binary field and index to files table */
     176        static char* version_1_1_queries[] = {
     177            "BEGIN",
     178
     179            "ALTER TABLE registry.files ADD COLUMN binary BOOL",
     180            "CREATE INDEX registry.file_binary ON files(binary)",
     181
     182            "UPDATE registry.metadata SET value = '1.100' WHERE key = 'version'",
     183
     184            "COMMIT"
     185        };
     186
     187        if (!do_queries(db, version_1_1_queries, errPtr)) {
     188            goto err_out;
     189        }
     190
     191        /* TODO: Walk the file tree and set the binary field */
     192    }
     193    sqlite3_finalize(stmt);
     194    return 1;
     195
     196reg_err_out:
     197    reg_sqlite_error(db, errPtr, query);
     198err_out:
     199    sqlite3_finalize(stmt);
     200    return 0;
     201}
     202
     203/**
    151204 * Initializes database connection. This function creates all the temporary
    152205 * tables used by the registry. It also registers the user functions and
  • trunk/base/src/cregistry/sql.h

    r65381 r88376  
    3939int create_tables(sqlite3* db, reg_error* errPtr);
    4040int init_db(sqlite3* db, reg_error* errPtr);
     41int update_db(sqlite3* db, reg_error* errPtr);
    4142
    4243#endif /* _SQL_H */
  • trunk/base/src/macports1.0/macports.tcl

    r87281 r88376  
    3838package require macports_index 1.0
    3939package require macports_util 1.0
     40package require machista 1.0
    4041
    4142namespace eval macports {
     
    7071    variable port_phases "any fetch checksum"
    7172    variable current_phase "main"
     73
     74    variable ui_prefix "---> "
    7275}
    7376
     
    17031706        }
    17041707
    1705         ui_msg -nonewline "---> Computing dependencies for [_mportkey $mport subport]"
     1708        ui_msg -nonewline "$macports::ui_prefix Computing dependencies for [_mportkey $mport subport]"
    17061709        if {[macports::ui_isset ports_debug]} {
    17071710            # play nice with debug messages
     
    17231726        # print the dep list
    17241727        if {[llength $dlist] > 0} {
    1725             set depstring "---> Dependencies to be installed:"
     1728            set depstring "$macports::ui_prefix Dependencies to be installed:"
    17261729            foreach ditem $dlist {
    17271730                append depstring " [ditem_key $ditem provides]"
     
    29702973
    29712974    # sync the MacPorts sources
    2972     ui_msg "---> Updating MacPorts base sources using rsync"
     2975    ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
    29732976    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
    29742977       return -code error "Error synchronizing MacPorts sources: $result"
     
    30433046    # syncing ports tree.
    30443047    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
    3045         ui_msg "---> Updating the ports tree"
     3048        ui_msg "$macports::ui_prefix Updating the ports tree"
    30463049        if {$comp > 0} {
    30473050            # updated portfiles potentially need new base to parse - tell sync to try to
     
    30563059    if {$use_the_force_luke == "yes" || $comp > 0} {
    30573060        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
    3058             ui_msg "---> MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
     3061            ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
    30593062        } else {
    3060             ui_msg "---> MacPorts base is outdated, installing new version $macports_version_new"
     3063            ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
    30613064
    30623065            # get installation user/group and permissions
     
    31083111        }
    31093112    } elseif {$comp < 0} {
    3110         ui_msg "---> MacPorts base is probably trunk or a release candidate"
     3113        ui_msg "$macports::ui_prefix MacPorts base is probably trunk or a release candidate"
    31113114    } else {
    3112         ui_msg "---> MacPorts base is already the latest version"
     3115        ui_msg "$macports::ui_prefix MacPorts base is already the latest version"
    31133116    }
    31143117
     
    31593162        unset -nocomplain macports::global_options(ports_nodeps)
    31603163    }
     3164
    31613165    return $status
    31623166}
     
    31753179    if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
    31763180        set is_dryrun yes
     3181    }
     3182
     3183    # Is this a rev-upgrade-called run?
     3184    set is_revupgrade no
     3185    if {[macports::global_option_isset ports_revupgrade]} {
     3186        set is_revupgrade yes
     3187    }
     3188    set is_revupgrade_second_run no
     3189    if {[macports::global_option_isset ports_revupgrade_second_run]} {
     3190        set is_revupgrade_second_run yes
    31773191    }
    31783192
     
    33703384    # at this point we need to check if a different port will be replacing this one
    33713385    if {[info exists portinfo(replaced_by)] && ![info exists options(ports_upgrade_no-replace)]} {
    3372         ui_msg "---> $portname is replaced by $portinfo(replaced_by)"
     3386        ui_msg "$macports::ui_prefix $portname is replaced by $portinfo(replaced_by)"
    33733387        if {[catch {mportlookup $portinfo(replaced_by)} result]} {
    33743388            global errorInfo
     
    34323446            ui_debug "platform mismatch ... upgrading!"
    34333447            set build_override 1
     3448        } elseif {$is_revupgrade_second_run} {
     3449            set build_override 1
     3450        } elseif {$is_revupgrade} {
     3451            # in the first run of rev-upgrade, only activate possibly already existing files and check for missing dependencies
     3452            set will_install yes
    34343453        } else {
    34353454            if {[info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) != $oldvariant} {
     
    34483467    set will_build no
    34493468    # avoid building again unnecessarily
    3450     if {$will_install && ([info exists options(ports_upgrade_force)] || $build_override == 1
    3451         || ![registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)])} {
     3469    if {$will_install &&
     3470        ([info exists options(ports_upgrade_force)]
     3471            || $build_override == 1
     3472            || ![registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)])} {
    34523473        set will_build yes
    34533474    }
    34543475
    34553476    # first upgrade dependencies
    3456     if {![info exists options(ports_nodeps)]} {
     3477    if {![info exists options(ports_nodeps)] && !$is_revupgrade} {
    34573478        set status [_upgrade_dependencies portinfo depscache variationslist options $will_build]
    34583479        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
     
    38113832    }
    38123833}
     3834
     3835proc macports::revupgrade {opts} {
     3836    set run_loop 1
     3837    array set broken_port_counts {}
     3838    while {$run_loop == 1} {
     3839        set run_loop [revupgrade_scanandrebuild broken_port_counts $opts]
     3840    }
     3841    return 0;
     3842}
     3843
     3844# returns 1 if ports were rebuilt and revupgrade_scanandrebuild should be called again
     3845proc revupgrade_scanandrebuild {broken_port_counts_name opts} {
     3846    upvar $broken_port_counts_name broken_port_counts
     3847    array set options $opts
     3848
     3849    set files [registry::file search active 1 binary -null]
     3850    if {[llength $files] > 0} {
     3851        set files_count [llength $files]
     3852        registry::write {
     3853            try {
     3854                ui_msg -nonewline "$macports::ui_prefix Updating database of binaries"
     3855                set i 1
     3856                foreach f $files {
     3857                    if {![macports::ui_isset ports_debug]} {
     3858                        ui_msg -nonewline "\r$macports::ui_prefix Updating database of binaries: [expr $i * 100 / $files_count]%"
     3859                        flush stdout
     3860                    }
     3861                    ui_debug "Updating binary flag for file $i of [llength $files]: [$f path]"
     3862                    incr i
     3863                    $f binary [fileIsBinary [$f path]]
     3864                }
     3865            } catch {*} {
     3866                ui_error "Updating database of binaries failed"
     3867                throw
     3868            }
     3869        }
     3870        ui_msg ""
     3871    }
     3872
     3873    set broken_files {};
     3874    set binaries [registry::file search active 1 binary 1]
     3875    ui_msg -nonewline "$macports::ui_prefix Scanning binaries for linking errors"
     3876    if {[llength $binaries] > 0} {
     3877        set handle [machista::create_handle]
     3878        if {$handle == "NULL"} {
     3879            error "Error creating libmachista handle"
     3880        }
     3881        array unset files_warned_about
     3882        array set files_warned_about [list]
     3883
     3884        set i 1
     3885        set binary_count [llength $binaries]
     3886        foreach b $binaries {
     3887            if {![macports::ui_isset ports_debug]} {
     3888                ui_msg -nonewline "\r$macports::ui_prefix Scanning binaries for linking errors: [expr $i * 100 / $binary_count]%"
     3889                flush stdout
     3890            }
     3891            #ui_debug "$i/[llength $binaries]: [$b path]"
     3892            incr i
     3893
     3894            set resultlist [machista::parse_file $handle [$b path]]
     3895            set returncode [lindex $resultlist 0]
     3896            set result     [lindex $resultlist 1]
     3897
     3898            if {$returncode != $machista::SUCCESS} {
     3899                if {$returncode == $machista::EMAGIC} {
     3900                    # not a Mach-O file
     3901                    # ignore silently, these are only static libs anyway
     3902                    #ui_debug "Error parsing file [$b path]: [machista::strerror $returncode]"
     3903                } else {
     3904                    if {![macports::ui_isset ports_debug]} {
     3905                        ui_msg ""
     3906                    }
     3907                    ui_warn "Error parsing file [$b path]: [machista::strerror $returncode]"
     3908                }
     3909                continue;
     3910            }
     3911
     3912            set architecture [$result cget -mt_archs]
     3913            while {$architecture != "NULL"} {
     3914                if {[info exists options(ports_rev-upgrade_id-loadcmd-check)] && $options(ports_rev-upgrade_id-loadcmd-check) == "yes"} {
     3915                    if {[$architecture cget -mat_install_name] != "NULL" && [$architecture cget -mat_install_name] != ""} {
     3916                        # check if this lib's install name actually refers to this file itself
     3917                        # if this is not the case software linking against this library might have erroneous load commands
     3918                        if {0 == [catch {set idloadcmdpath [revupgrade_handle_special_paths [$b path] [$architecture cget -mat_install_name]]}]} {
     3919                            if {[string index $idloadcmdpath 0] != "/"} {
     3920                                set port [registry::entry owner [$b path]]
     3921                                if {$port != ""} {
     3922                                    set portname [$port name]
     3923                                } else {
     3924                                    set portname "<unknown-port>"
     3925                                }
     3926                                if {![macports::ui_isset ports_debug]} {
     3927                                    ui_msg ""
     3928                                }
     3929                                ui_warn "ID load command in [$b path], arch [machista::get_arch_name [$architecture cget -mat_arch]] (belonging to port $portname) contains relative path"
     3930                            } elseif {![file exists $idloadcmdpath]} {
     3931                                set port [registry::entry owner [$b path]]
     3932                                if {$port != ""} {
     3933                                    set portname [$port name]
     3934                                } else {
     3935                                    set portname "<unknown-port>"
     3936                                }
     3937                                if {![macports::ui_isset ports_debug]} {
     3938                                    ui_msg ""
     3939                                }
     3940                                ui_warn "ID load command in [$b path], arch [machista::get_arch_name [$architecture cget -mat_arch]] refers to non-existant file $idloadcmdpath"
     3941                                ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
     3942                            } else {
     3943   
     3944                                set hash_this [sha256 file [$b path]]
     3945                                set hash_idloadcmd [sha256 file $idloadcmdpath]
     3946   
     3947                                if {$hash_this != $hash_idloadcmd} {
     3948                                    set port [registry::entry owner [$b path]]
     3949                                    if {$port != ""} {
     3950                                        set portname [$port name]
     3951                                    } else {
     3952                                        set portname "<unknown-port>"
     3953                                    }
     3954                                    if {![macports::ui_isset ports_debug]} {
     3955                                        ui_msg ""
     3956                                    }
     3957                                    ui_warn "ID load command in [$b path], arch [machista::get_arch_name [$architecture cget -mat_arch]] refers to file $idloadcmdpath, which is a different file"
     3958                                    ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
     3959                                }
     3960                            }
     3961                        }
     3962                    }
     3963                }
     3964                set loadcommand [$architecture cget -mat_loadcmds]
     3965
     3966                while {$loadcommand != "NULL"} {
     3967                    if {0 != [catch {set filepath [revupgrade_handle_special_paths [$b path] [$loadcommand cget -mlt_install_name]]}]} {
     3968                        set loadcommand [$loadcommand cget -next]
     3969                        continue;
     3970                    }
     3971
     3972                    set libresultlist [machista::parse_file $handle $filepath]
     3973                    set libreturncode [lindex $libresultlist 0]
     3974                    set libresult     [lindex $libresultlist 1]
     3975
     3976                    if {$libreturncode != $machista::SUCCESS} {
     3977                        if {![info exists files_warned_about($filepath)]} {
     3978                            if {![macports::ui_isset ports_debug]} {
     3979                                ui_msg ""
     3980                            }
     3981                            ui_warn "Could not open $filepath: [machista::strerror $libreturncode]"
     3982                            set files_warned_about($filepath) yes
     3983                        }
     3984                        if {$libreturncode == $machista::EFILE} {
     3985                            ui_debug "Marking [$b path] as broken"
     3986                            lappend broken_files [$b path]
     3987                        }
     3988                        set loadcommand [$loadcommand cget -next]
     3989                        continue;
     3990                    }
     3991
     3992                    set libarchitecture [$libresult cget -mt_archs]
     3993                    set libarch_found false;
     3994                    while {$libarchitecture != "NULL"} {
     3995                        if {[$architecture cget -mat_arch] != [$libarchitecture cget -mat_arch]} {
     3996                            set libarchitecture [$libarchitecture cget -next]
     3997                            continue;
     3998                        }
     3999
     4000                        if {[$loadcommand cget -mlt_version] != [$libarchitecture cget -mat_version] && [$loadcommand cget -mlt_comp_version] > [$libarchitecture cget -mat_comp_version]} {
     4001                            if {![macports::ui_isset ports_debug]} {
     4002                                ui_msg ""
     4003                            }
     4004                            ui_warn "Incompatible library version of file [$loadcommand cget -mlt_install_name]: Expected [$loadcommand cget -mlt_comp_version], but got [$libarchitecture cget -mat_comp_version]"
     4005                            ui_debug "Marking [$b path] as broken"
     4006                            lappend broken_files [$b path]
     4007                        }
     4008
     4009                        set libarch_found true;
     4010                        break;
     4011                    }
     4012
     4013                    if {$libarch_found == false} {
     4014                        ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file $filepath"
     4015                        if {[path_is_in_prefix $filepath]} {
     4016                            ui_debug "Marking [$b path] as broken"
     4017                            lappend broken_files [$b path]
     4018                        } else {
     4019                            ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file outside prefix referenced from [$b path]"
     4020                            # ui_debug "   How did you get that compiled anyway?"
     4021                        }
     4022                    }
     4023                    set loadcommand [$loadcommand cget -next]
     4024                }
     4025
     4026                set architecture [$architecture cget -next]
     4027            }
     4028        }
     4029        ui_msg ""
     4030
     4031        machista::destroy_handle $handle
     4032
     4033        if {[llength $broken_files] == 0} {
     4034            ui_msg "$macports::ui_prefix No broken files found. :)"
     4035            return 0;
     4036        }
     4037        ui_msg "$macports::ui_prefix Found [llength $broken_files] broken file(s), matching files to ports"
     4038        set broken_ports {}
     4039        set broken_files [lsort -unique $broken_files]
     4040        foreach file $broken_files {
     4041            set port [registry::entry owner $file]
     4042            if {$port == ""} {
     4043                ui_error "Broken file $file doesn't belong to any port."
     4044            }
     4045            lappend broken_ports $port
     4046        }
     4047        set broken_ports [lsort -unique $broken_ports]
     4048
     4049        foreach port $broken_ports {
     4050            if {![info exists broken_port_counts([$port name])]} {
     4051                set broken_port_counts([$port name]) 0
     4052            }
     4053            incr broken_port_counts([$port name])
     4054            if {$broken_port_counts([$port name]) > 3} {
     4055                ui_error "Port [$port name] is still broken after rebuiling it more than 3 times. You might want to file a bug for this."
     4056                error "Port [$port name] still broken after rebuilding [expr $broken_port_counts([$port name]) - 1] time(s)"
     4057            }
     4058        }
     4059
     4060        ui_msg "$macports::ui_prefix Found [llength $broken_ports] broken port(s), determining rebuild order"
     4061        # broken_ports are the nodes in our graph
     4062        # now we need adjacents
     4063        foreach port $broken_ports {
     4064            # initialize with empty list
     4065            set adjlist($port) {}
     4066            set revadjlist($port) {}
     4067        }
     4068
     4069        array set visited {}
     4070        foreach port $broken_ports {
     4071            # stack of broken nodes we've come across
     4072            set stack {}
     4073            lappend stack $port
     4074
     4075            # build graph
     4076            if {![info exists visited($port)]} {
     4077                revupgrade_buildgraph $port stack adjlist revadjlist visited
     4078            }
     4079        }
     4080
     4081        set unsorted_ports $broken_ports
     4082        set topsort_ports {}
     4083        while {[llength $unsorted_ports] > 0} {
     4084            foreach port $unsorted_ports {
     4085                if {[llength $adjlist($port)] == 0} {
     4086                    # this node has no further dependencies
     4087                    # add it to topsorted list
     4088                    lappend topsort_ports $port
     4089                    # remove from unsorted list
     4090                    set index [lsearch -exact $unsorted_ports $port]
     4091                    set unsorted_ports [lreplace $unsorted_ports $index $index]
     4092
     4093                    # remove edges
     4094                    foreach target $revadjlist($port) {
     4095                        set index [lsearch -exact $adjlist($target) $port]
     4096                        set adjlist($target) [lreplace $adjlist($target) $index $index]
     4097                    }
     4098                }
     4099            }
     4100        }
     4101
     4102        ui_msg "$macports::ui_prefix Rebuilding in order"
     4103        foreach port $topsort_ports {
     4104            ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
     4105        }
     4106
     4107        # shared depscache for all ports that are going to be rebuilt
     4108        array set depscache {}
     4109        set status 0
     4110        foreach port $topsort_ports {
     4111            if {![info exists depscache(port:[$port name])]} {
     4112
     4113                # convert variations into the format macports::upgrade needs
     4114                set minusvariant [lrange [split [$port negated_variants] "-"] 1 end]
     4115                set plusvariant  [lrange [split [$port variants]         "+"] 1 end]
     4116                set variants     [list]
     4117                foreach v $minusvariant {
     4118                    lappend variants $v "-"
     4119                }
     4120                foreach v $plusvariant {
     4121                    lappend variants $v "+"
     4122                }
     4123                array unset variations
     4124                array set variations $variants
     4125
     4126                # set rev-upgrade options and nodeps if this is not the first run
     4127                set macports::global_options(ports_revupgrade) "yes"
     4128                unset -nocomplain macports::global_options(ports_nodeps)
     4129                unset -nocomplain macports::global_options(ports_revupgrade_second_run)
     4130                unset -nocomplain macports::global_options(ports_source_only)
     4131                if {$broken_port_counts([$port name]) > 1} {
     4132                    set macports::global_options(ports_revupgrade_second_run) yes
     4133                    set macports::global_options(ports_nodeps) yes
     4134                    # build from source only until the buildbot has some method of rev-upgrade, too
     4135                    set macports::global_options(ports_source_only) yes
     4136                }
     4137
     4138                # call macports::upgrade with ports_revupgrade option to rebuild the port
     4139                set status [macports::upgrade [$port name] "port:[$port name]" \
     4140                    [array get variations] [array get macports::global_options] depscache]
     4141                if {$status != 0} {
     4142                    error "Error rebuilding [$port name]"
     4143                }
     4144            }
     4145        }
     4146
     4147        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
     4148            ui_warn "If this was no dry run, rev-upgrade would now run the checks again to find unresolved and newly created problems"
     4149            return 0
     4150        }
     4151        return 1
     4152    }
     4153
     4154    return 0
     4155}
     4156
     4157# Return whether a path is in the macports prefix
     4158# Usage: path_is_in_prefix path_to_test
     4159# Returns true if the path is in the prefix, false otherwise
     4160proc path_is_in_prefix {path} {
     4161    if {[string first $macports::prefix $path] == 0} {
     4162        return yes
     4163    }
     4164    if {[string first $macports::applications_dir $path] == 0} {
     4165        return yes
     4166    }
     4167    return no
     4168}
     4169
     4170# Function to replace macros in loadcommand paths with their proper values (which are usually determined at load time)
     4171# Usage: revupgrade_handle_special_paths name_of_file path_from_loadcommand
     4172# Returns the corrected path on success or an error in case of failure.
     4173# Note that we can't reliably replace @executable_path, because it's only clear when executing a file where it was executed from.
     4174# Replacing @rpath does not work yet, but it might be possible to get it working using the rpath attribute in the file containing the
     4175# loadcommand
     4176proc revupgrade_handle_special_paths {fname path} {
     4177    set corrected_path $path
     4178
     4179    set loaderpath_idx [string first "@loader_path" $corrected_path]
     4180    if {$loaderpath_idx != -1} {
     4181        set corrected_path [string replace $corrected_path $loaderpath_idx $loaderpath_idx+11 [file dirname $fname]]
     4182    }
     4183
     4184    set executablepath_idx [string first "@executable_path" $corrected_path]
     4185    if {$executablepath_idx != -1} {
     4186        ui_debug "Ignoring loadcommand containing @exectuable_path in $fname"
     4187        error "@exectuable_path in loadcommand"
     4188    }
     4189
     4190    set rpath_idx [string first "@rpath" $corrected_path]
     4191    if {$rpath_idx != -1} {
     4192        ui_debug "Ignoring loadcommand containing @rpath in $fname"
     4193        error "@rpath in loadcommand"
     4194    }
     4195
     4196    return $corrected_path
     4197}
     4198
     4199# Recursively build the dependency graph between broken ports
     4200# Usage: revupgrade_buildgraph start_port name_of_stack name_of_adjacency_list name_of_reverse_adjacency_list name_of_visited_map
     4201proc revupgrade_buildgraph {port stackname adjlistname revadjlistname visitedname} {
     4202    upvar $stackname stack
     4203    upvar $adjlistname adjlist
     4204    upvar $revadjlistname revadjlist
     4205    upvar $visitedname visited
     4206
     4207    ui_debug "Processing port [$port name] @[$port epoch]:[$port version]_[$port revision] [$port variants] [$port negated_variants]"
     4208    set dependent_ports [$port dependents]
     4209    foreach dep $dependent_ports {
     4210        if {[info exists visited($dep)]} {
     4211            continue
     4212        }
     4213        set visited($dep) true
     4214        set is_broken_port false
     4215
     4216        if {[info exists adjlist($dep)]} {
     4217            #ui_debug "Dependency [$dep name] is broken, adding edge from [[lindex $stack 0] name] to [$dep name]"
     4218            #ui_debug "Making [$dep name] new head of stack"
     4219            # $dep is one of the broken ports
     4220            # add an edge to the last broken port in the DFS
     4221            lappend revadjlist([lindex $stack 0]) $dep
     4222            lappend adjlist($dep) [lindex $stack 0]
     4223            # make this port the new last broken port by prepending it to the stack
     4224            set stack [linsert $stack 0 $dep]
     4225           
     4226            set is_broken_port true
     4227        }
     4228        revupgrade_buildgraph $dep stack adjlist revadjlist visited
     4229        if {$is_broken_port} {
     4230            #ui_debug "Removing [$dep name] from stack"
     4231            # remove $dep from the stack
     4232            set stack [lrange $stack 1 end]
     4233        }
     4234    }
     4235}
     4236
  • trunk/base/src/pextlib1.0/Pextlib.c

    r82291 r88376  
    4747#include <limits.h>
    4848#include <pwd.h>
     49#include <stdbool.h>
    4950#include <stdint.h>
    5051#include <stdio.h>
     
    5354#include <strings.h>
    5455#include <unistd.h>
     56
     57#ifdef __MACH__
     58#include <mach-o/loader.h>
     59#include <mach-o/fat.h>
     60#endif
    5561
    5662#include <tcl.h>
     
    94100ui_escape(const char *source)
    95101{
    96         char *d, *dest;
    97         const char *s;
    98         size_t dlen;
    99 
    100         s = source;
    101         dlen = strlen(source) * 2 + 1;
    102         d = dest = malloc(dlen);
    103         if (dest == NULL) {
    104                 return NULL;
    105         }
    106         while(*s != '\0') {
    107                 switch(*s) {
    108                         case '\\':
    109                         case '}':
    110                         case '{':
    111                                 *d = '\\';
    112                                 d++;
    113                                 *d = *s;
    114                                 d++;
    115                                 s++;
    116                                 break;
    117                         case '\n':
    118                                 s++;
    119                                 break;
    120                         default:
    121                                 *d = *s;
    122                                 d++;
    123                                 s++;
    124                                 break;
    125                 }
    126         }
    127         *d = '\0';
    128         return dest;
     102    char *d, *dest;
     103    const char *s;
     104    size_t dlen;
     105
     106    s = source;
     107    dlen = strlen(source) * 2 + 1;
     108    d = dest = malloc(dlen);
     109    if (dest == NULL) {
     110        return NULL;
     111    }
     112    while(*s != '\0') {
     113        switch(*s) {
     114            case '\\':
     115            case '}':
     116            case '{':
     117                *d = '\\';
     118                d++;
     119                *d = *s;
     120                d++;
     121                s++;
     122                break;
     123            case '\n':
     124                s++;
     125                break;
     126            default:
     127                *d = *s;
     128                d++;
     129                s++;
     130                break;
     131        }
     132    }
     133    *d = '\0';
     134    return dest;
    129135}
    130136
     
    132138ui_info(Tcl_Interp *interp, char *mesg)
    133139{
    134         const char ui_proc_start[] = "ui_info [subst -nocommands -novariables {";
    135         const char ui_proc_end[] = "}]";
    136         char *script, *string;
    137         size_t scriptlen, len, remaining;
    138         int rval;
    139 
    140         string = ui_escape(mesg);
    141         if (string == NULL)
    142                 return TCL_ERROR;
    143 
    144         len = strlen(string);
    145         scriptlen = sizeof(ui_proc_start) + len + sizeof(ui_proc_end) - 1;
    146         script = malloc(scriptlen);
    147         if (script == NULL)
    148                 return TCL_ERROR;
    149 
    150         memcpy(script, ui_proc_start, sizeof(ui_proc_start));
    151         remaining = scriptlen - sizeof(ui_proc_start);
    152         strncat(script, string, remaining);
    153         remaining -= len;
    154         strncat(script, ui_proc_end, remaining);
    155         free(string);
    156         rval = Tcl_EvalEx(interp, script, -1, 0);
    157         free(script);
    158         return rval;
     140    const char ui_proc_start[] = "ui_info [subst -nocommands -novariables {";
     141    const char ui_proc_end[] = "}]";
     142    char *script, *string;
     143    size_t scriptlen, len, remaining;
     144    int rval;
     145
     146    string = ui_escape(mesg);
     147    if (string == NULL)
     148        return TCL_ERROR;
     149
     150    len = strlen(string);
     151    scriptlen = sizeof(ui_proc_start) + len + sizeof(ui_proc_end) - 1;
     152    script = malloc(scriptlen);
     153    if (script == NULL)
     154        return TCL_ERROR;
     155
     156    memcpy(script, ui_proc_start, sizeof(ui_proc_start));
     157    remaining = scriptlen - sizeof(ui_proc_start);
     158    strncat(script, string, remaining);
     159    remaining -= len;
     160    strncat(script, ui_proc_end, remaining);
     161    free(string);
     162    rval = Tcl_EvalEx(interp, script, -1, 0);
     163    free(script);
     164    return rval;
    159165}
    160166
    161167int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
    162168{
    163         char *pattern, *string, *res;
    164         int range[2];
    165         Tcl_Obj *tcl_result;
    166 
    167         if (objc != 3) {
    168                 Tcl_WrongNumArgs(interp, 1, objv, "string pattern");
    169                 return TCL_ERROR;
    170         }
    171 
    172         string = Tcl_GetString(objv[1]);
    173         pattern = Tcl_GetString(objv[2]);
    174         res = strsed(string, pattern, range);
    175         if (!res) {
    176                 Tcl_SetResult(interp, "strsed failed", TCL_STATIC);
    177                 return TCL_ERROR;
    178         }
    179         tcl_result = Tcl_NewStringObj(res, -1);
    180         Tcl_SetObjResult(interp, tcl_result);
    181         free(res);
    182         return TCL_OK;
     169    char *pattern, *string, *res;
     170    int range[2];
     171    Tcl_Obj *tcl_result;
     172
     173    if (objc != 3) {
     174        Tcl_WrongNumArgs(interp, 1, objv, "string pattern");
     175        return TCL_ERROR;
     176    }
     177
     178    string = Tcl_GetString(objv[1]);
     179    pattern = Tcl_GetString(objv[2]);
     180    res = strsed(string, pattern, range);
     181    if (!res) {
     182        Tcl_SetResult(interp, "strsed failed", TCL_STATIC);
     183        return TCL_ERROR;
     184    }
     185    tcl_result = Tcl_NewStringObj(res, -1);
     186    Tcl_SetObjResult(interp, tcl_result);
     187    free(res);
     188    return TCL_OK;
    183189}
    184190
    185191int ExistsuserCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
    186192{
    187         Tcl_Obj *tcl_result;
    188         struct passwd *pwent;
    189         char *user;
    190 
    191         if (objc != 2) {
    192                 Tcl_WrongNumArgs(interp, 1, objv, "user");
    193                 return TCL_ERROR;
    194         }
    195 
    196         user = strdup(Tcl_GetString(objv[1]));
    197         if (isdigit(*(user)))
    198                 pwent = getpwuid(strtol(user, 0, 0));
    199         else
    200                 pwent = getpwnam(user);
    201         free(user);
    202 
    203         if (pwent == NULL)
    204                 tcl_result = Tcl_NewIntObj(0);
    205         else
    206                 tcl_result = Tcl_NewIntObj(pwent->pw_uid);
    207 
    208         Tcl_SetObjResult(interp, tcl_result);
    209         return TCL_OK;
     193    Tcl_Obj *tcl_result;
     194    struct passwd *pwent;
     195    char *user;
     196
     197    if (objc != 2) {
     198        Tcl_WrongNumArgs(interp, 1, objv, "user");
     199        return TCL_ERROR;
     200    }
     201
     202    user = strdup(Tcl_GetString(objv[1]));
     203    if (isdigit(*(user)))
     204        pwent = getpwuid(strtol(user, 0, 0));
     205    else
     206        pwent = getpwnam(user);
     207    free(user);
     208
     209    if (pwent == NULL)
     210        tcl_result = Tcl_NewIntObj(0);
     211    else
     212        tcl_result = Tcl_NewIntObj(pwent->pw_uid);
     213
     214    Tcl_SetObjResult(interp, tcl_result);
     215    return TCL_OK;
    210216}
    211217
    212218int ExistsgroupCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
    213219{
    214         Tcl_Obj *tcl_result;
    215         struct group *grent;
    216         char *group;
    217 
    218         if (objc != 2) {
    219                 Tcl_WrongNumArgs(interp, 1, objv, "groupname");
    220                 return TCL_ERROR;
    221         }
    222 
    223         group = strdup(Tcl_GetString(objv[1]));
    224         if (isdigit(*(group)))
    225                 grent = getgrgid(strtol(group, 0, 0));
    226         else
    227                 grent = getgrnam(group);
    228         free(group);
    229 
    230         if (grent == NULL)
    231                 tcl_result = Tcl_NewIntObj(0);
    232         else
    233                 tcl_result = Tcl_NewIntObj(grent->gr_gid);
    234 
    235         Tcl_SetObjResult(interp, tcl_result);
    236         return TCL_OK;
     220    Tcl_Obj *tcl_result;
     221    struct group *grent;
     222    char *group;
     223
     224    if (objc != 2) {
     225        Tcl_WrongNumArgs(interp, 1, objv, "groupname");
     226        return TCL_ERROR;
     227    }
     228
     229    group = strdup(Tcl_GetString(objv[1]));
     230    if (isdigit(*(group)))
     231        grent = getgrgid(strtol(group, 0, 0));
     232    else
     233        grent = getgrnam(group);
     234    free(group);
     235
     236    if (grent == NULL)
     237        tcl_result = Tcl_NewIntObj(0);
     238    else
     239        tcl_result = Tcl_NewIntObj(grent->gr_gid);
     240
     241    Tcl_SetObjResult(interp, tcl_result);
     242    return TCL_OK;
    237243}
    238244
     
    242248int NextuidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
    243249{
    244         Tcl_Obj *tcl_result;
    245         int cur;
    246 
    247         cur = MIN_USABLE_UID;
    248 
    249         while (getpwuid(cur) != NULL) {
    250                 cur++;
    251         }
    252 
    253         tcl_result = Tcl_NewIntObj(cur);
    254         Tcl_SetObjResult(interp, tcl_result);
    255         return TCL_OK;
     250    Tcl_Obj *tcl_result;
     251    int cur;
     252
     253    cur = MIN_USABLE_UID;
     254
     255    while (getpwuid(cur) != NULL) {
     256        cur++;
     257    }
     258
     259    tcl_result = Tcl_NewIntObj(cur);
     260    Tcl_SetObjResult(interp, tcl_result);
     261    return TCL_OK;
    256262}
    257263
     
    259265int NextgidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
    260266{
    261         Tcl_Obj *tcl_result;
    262         int cur;
    263 
    264         cur = MIN_USABLE_GID;
    265 
    266         while (getgrgid(cur) != NULL) {
    267                 cur++;
    268         }
    269 
    270         tcl_result = Tcl_NewIntObj(cur);
    271         Tcl_SetObjResult(interp, tcl_result);
    272         return TCL_OK;
     267    Tcl_Obj *tcl_result;
     268    int cur;
     269
     270    cur = MIN_USABLE_GID;
     271
     272    while (getgrgid(cur) != NULL) {
     273        cur++;
     274    }
     275
     276    tcl_result = Tcl_NewIntObj(cur);
     277    Tcl_SetObjResult(interp, tcl_result);
     278    return TCL_OK;
    273279}
    274280
    275281int UmaskCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
    276282{
    277         Tcl_Obj *tcl_result;
    278         char *tcl_mask, *p;
    279         const size_t stringlen = 5; /* 4 digits & \0 */
    280         int i;
    281         mode_t *set;
    282         mode_t newmode;
    283         mode_t oldmode;
    284 
    285         if (objc != 2) {
    286                 Tcl_WrongNumArgs(interp, 1, objv, "mode");
    287                 return TCL_ERROR;
    288         }
    289 
    290         tcl_mask = Tcl_GetString(objv[1]);
    291         if ((set = setmode(tcl_mask)) == NULL) {
    292                 Tcl_SetResult(interp, "Invalid umask mode", TCL_STATIC);
    293                 return TCL_ERROR;
    294         }
    295 
    296         newmode = getmode(set, 0);
    297         free(set);
    298 
    299         oldmode = umask(newmode);
    300 
    301         tcl_mask = calloc(1, stringlen); /* 4 digits & \0 */
    302         if (!tcl_mask) {
    303                 return TCL_ERROR;
    304         }
    305 
    306         /* Totally gross and cool */
    307         p = tcl_mask + stringlen - 1;
    308         for (i = stringlen - 1; i > 0; i--) {
    309                 p--;
    310                 *p = (oldmode & 7) + '0';
    311                 oldmode >>= 3;
    312         }
    313 
    314         tcl_result = Tcl_NewStringObj(p, -1);
    315         free(tcl_mask);
    316 
    317         Tcl_SetObjResult(interp, tcl_result);
    318         return TCL_OK;
     283    Tcl_Obj *tcl_result;
     284    char *tcl_mask, *p;
     285    const size_t stringlen = 5; /* 4 digits & \0 */
     286    int i;
     287    mode_t *set;
     288    mode_t newmode;
     289    mode_t oldmode;
     290
     291    if (objc != 2) {
     292        Tcl_WrongNumArgs(interp, 1, objv, "mode");
     293        return TCL_ERROR;
     294    }
     295
     296    tcl_mask = Tcl_GetString(objv[1]);
     297    if ((set = setmode(tcl_mask)) == NULL) {
     298        Tcl_SetResult(interp, "Invalid umask mode", TCL_STATIC);
     299        return TCL_ERROR;
     300    }
     301
     302    newmode = getmode(set, 0);
     303    free(set);
     304
     305    oldmode = umask(newmode);
     306
     307    tcl_mask = calloc(1, stringlen); /* 4 digits & \0 */
     308    if (!tcl_mask) {
     309        return TCL_ERROR;
     310    }
     311
     312    /* Totally gross and cool */
     313    p = tcl_mask + stringlen - 1;
     314    for (i = stringlen - 1; i > 0; i--) {
     315        p--;
     316        *p = (oldmode & 7) + '0';
     317        oldmode >>= 3;
     318    }
     319
     320    tcl_result = Tcl_NewStringObj(p, -1);
     321    free(tcl_mask);
     322
     323    Tcl_SetObjResult(interp, tcl_result);
     324    return TCL_OK;
    319325}
    320326
     
    465471}
    466472
     473#ifdef __MACH__
     474/**
     475 * Tcl function to determine whether a file given by path is binary (in terms of being Mach-O)
     476 * Defined on Mac-Systems only, because the necessary headers are only available there.
     477 *
     478 * Synopsis: fileIsBinary filename
     479 */
     480static int fileIsBinaryCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
     481    const char *path;
     482    FILE *file;
     483    uint32_t magic;
     484    struct stat st;
     485
     486    if (objc != 2) {
     487        Tcl_WrongNumArgs(interp, 1, objv, "filename");
     488        return TCL_ERROR;
     489    }
     490
     491    path = Tcl_GetString(objv[1]);
     492    if (-1 == lstat(path, &st)) {
     493        /* an error occured */
     494        Tcl_SetErrno(errno);
     495        Tcl_ResetResult(interp);
     496        Tcl_AppendResult(interp, "lstat(", path, "):", (char *)Tcl_PosixError(interp), NULL);
     497        return TCL_ERROR;
     498    }
     499    if (!S_ISREG(st.st_mode)) {
     500        /* not a regular file, haven't seen directories which are binaries yet */
     501        Tcl_SetObjResult(interp, Tcl_NewBooleanObj(false));
     502        return TCL_OK;
     503    }
     504    if (NULL == (file = fopen(path, "r"))) {
     505        Tcl_SetErrno(errno);
     506        Tcl_ResetResult(interp);
     507        Tcl_AppendResult(interp, "fopen(", path, "): ", (char *)Tcl_PosixError(interp), NULL);
     508        return TCL_ERROR;
     509    }
     510    if (1 != fread(&magic, sizeof(uint32_t), 1, file)) {
     511        if (feof(file)) {
     512            fclose(file);
     513            /* file is shorter than 4 byte, probably not a binary */
     514            Tcl_SetObjResult(interp, Tcl_NewBooleanObj(false));
     515            return TCL_OK;
     516        }
     517        /* error while reading */
     518        Tcl_SetErrno(errno);
     519        Tcl_ResetResult(interp);
     520        Tcl_AppendResult(interp, "fread(&magic, 4, 1, ", path, "): ", (char *)Tcl_PosixError(interp), NULL);
     521        fclose(file);
     522        return TCL_ERROR;
     523    }
     524    if (magic == MH_MAGIC || magic == MH_MAGIC_64) {
     525        fclose(file);
     526        /* this is a mach-o file */
     527        Tcl_SetObjResult(interp, Tcl_NewBooleanObj(true));
     528        return TCL_OK;
     529    }
     530    if (magic == htonl(FAT_MAGIC)) {
     531        uint32_t archcount;
     532        /* either universal binary or java class (FAT_MAGIC == 0xcafebabe)
     533           see /use/share/file/magic/cafebabe for an explanation of what I'm doing here */
     534        if (1 != fread(&archcount, sizeof(uint32_t), 1, file)) {
     535            if (feof(file)) {
     536                fclose(file);
     537                /* file shorter than 8 byte, probably not a binary either */
     538                Tcl_SetObjResult(interp, Tcl_NewBooleanObj(false));
     539                return TCL_OK;
     540            }
     541            /* error while reading */
     542            Tcl_SetErrno(errno);
     543            Tcl_ResetResult(interp);
     544            Tcl_AppendResult(interp, "fread(&archcount, 4, 1, ", path, "): ", (char *)Tcl_PosixError(interp), NULL);
     545            fclose(file);
     546            return TCL_ERROR;
     547        }
     548
     549        /* universal binary header is always big endian */
     550        archcount = ntohl(archcount);
     551        if (archcount > 0 && archcount < 20) {
     552            fclose(file);
     553            /* universal binary */
     554            Tcl_SetObjResult(interp, Tcl_NewBooleanObj(true));
     555            return TCL_OK;
     556        }
     557
     558        fclose(file);
     559        /* probably java class */
     560        Tcl_SetObjResult(interp, Tcl_NewBooleanObj(false));
     561        return TCL_OK;
     562    }
     563    fclose(file);
     564
     565    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(false));
     566    return TCL_OK;
     567}
     568#endif
     569
    467570int Pextlib_Init(Tcl_Interp *interp)
    468571{
    469         if (Tcl_InitStubs(interp, "8.4", 0) == NULL)
    470                 return TCL_ERROR;
     572    if (Tcl_InitStubs(interp, "8.4", 0) == NULL)
     573        return TCL_ERROR;
    471574
    472575        Tcl_CreateObjCommand(interp, "system", SystemCmd, NULL, NULL);
     
    502605        Tcl_CreateObjCommand(interp, "lchown", lchownCmd, NULL, NULL);
    503606        Tcl_CreateObjCommand(interp, "realpath", RealpathCmd, NULL, NULL);
    504 
    505         Tcl_CreateObjCommand(interp, "readline", ReadlineCmd, NULL, NULL);
    506         Tcl_CreateObjCommand(interp, "rl_history", RLHistoryCmd, NULL, NULL);
    507 
    508         Tcl_CreateObjCommand(interp, "getuid", getuidCmd, NULL, NULL);
    509         Tcl_CreateObjCommand(interp, "geteuid", geteuidCmd, NULL, NULL);
    510         Tcl_CreateObjCommand(interp, "getgid", getgidCmd, NULL, NULL);
    511         Tcl_CreateObjCommand(interp, "getegid", getegidCmd, NULL, NULL);
    512         Tcl_CreateObjCommand(interp, "setuid", setuidCmd, NULL, NULL);
    513         Tcl_CreateObjCommand(interp, "seteuid", seteuidCmd, NULL, NULL);
    514         Tcl_CreateObjCommand(interp, "setgid", setgidCmd, NULL, NULL);
    515         Tcl_CreateObjCommand(interp, "setegid", setegidCmd, NULL, NULL);
    516         Tcl_CreateObjCommand(interp, "name_to_uid", name_to_uidCmd, NULL, NULL);
    517         Tcl_CreateObjCommand(interp, "uid_to_name", uid_to_nameCmd, NULL, NULL);
    518         Tcl_CreateObjCommand(interp, "uname_to_gid", uname_to_gidCmd, NULL, NULL);
    519         Tcl_CreateObjCommand(interp, "name_to_gid", name_to_gidCmd, NULL, NULL);
    520         Tcl_CreateObjCommand(interp, "gid_to_name", gid_to_nameCmd, NULL, NULL);
    521 
    522         Tcl_CreateObjCommand(interp, "tracelib", TracelibCmd, NULL, NULL);
    523         Tcl_CreateObjCommand(interp, "isatty", IsattyCmd, NULL, NULL);
    524         Tcl_CreateObjCommand(interp, "term_get_size", TermGetSizeCmd, NULL, NULL);
    525 
    526         if (Tcl_PkgProvide(interp, "Pextlib", "1.0") != TCL_OK)
    527                 return TCL_ERROR;
    528 
    529         return TCL_OK;
    530 }
     607#ifdef __MACH__
     608    Tcl_CreateObjCommand(interp, "fileIsBinary", fileIsBinaryCmd, NULL, NULL);
     609#endif
     610
     611    Tcl_CreateObjCommand(interp, "readline", ReadlineCmd, NULL, NULL);
     612    Tcl_CreateObjCommand(interp, "rl_history", RLHistoryCmd, NULL, NULL);
     613
     614    Tcl_CreateObjCommand(interp, "getuid", getuidCmd, NULL, NULL);
     615    Tcl_CreateObjCommand(interp, "geteuid", geteuidCmd, NULL, NULL);
     616    Tcl_CreateObjCommand(interp, "getgid", getgidCmd, NULL, NULL);
     617    Tcl_CreateObjCommand(interp, "getegid", getegidCmd, NULL, NULL);
     618    Tcl_CreateObjCommand(interp, "setuid", setuidCmd, NULL, NULL);
     619    Tcl_CreateObjCommand(interp, "seteuid", seteuidCmd, NULL, NULL);
     620    Tcl_CreateObjCommand(interp, "setgid", setgidCmd, NULL, NULL);
     621    Tcl_CreateObjCommand(interp, "setegid", setegidCmd, NULL, NULL);
     622    Tcl_CreateObjCommand(interp, "name_to_uid", name_to_uidCmd, NULL, NULL);
     623    Tcl_CreateObjCommand(interp, "uid_to_name", uid_to_nameCmd, NULL, NULL);
     624    Tcl_CreateObjCommand(interp, "uname_to_gid", uname_to_gidCmd, NULL, NULL);
     625    Tcl_CreateObjCommand(interp, "name_to_gid", name_to_gidCmd, NULL, NULL);
     626    Tcl_CreateObjCommand(interp, "gid_to_name", gid_to_nameCmd, NULL, NULL);
     627
     628    Tcl_CreateObjCommand(interp, "tracelib", TracelibCmd, NULL, NULL);
     629    Tcl_CreateObjCommand(interp, "isatty", IsattyCmd, NULL, NULL);
     630    Tcl_CreateObjCommand(interp, "term_get_size", TermGetSizeCmd, NULL, NULL);
     631
     632    if (Tcl_PkgProvide(interp, "Pextlib", "1.0") != TCL_OK)
     633        return TCL_ERROR;
     634
     635    return TCL_OK;
     636}
  • trunk/base/src/pextlib1.0/sha2.c

  • trunk/base/src/pextlib1.0/sha2.h

  • trunk/base/src/pextlib1.0/sha256cmd.c

  • trunk/base/src/pextlib1.0/sha256cmd.h

  • trunk/base/src/port/port.tcl

    r88185 r88376  
    25732573        return 1
    25742574    }
     2575
    25752576    # shared depscache for all ports in the list
    25762577    array set depscache {}
     
    25882589    if {$status != 0} {
    25892590        print_tickets_url
    2590     }
    2591 
     2591    } else {
     2592        array set options $opts
     2593        if {![info exists options(ports_upgrade_no-rev-upgrade)]} {
     2594            set status [action_revupgrade $action $portlist $opts]
     2595        }
     2596    }
     2597
     2598    return $status
     2599}
     2600
     2601proc action_revupgrade { action portlist opts } {
     2602    set status [macports::revupgrade $opts]
     2603    if {$status != 0} {
     2604        print_tickets_url
     2605    }
    25922606    return $status
    25932607}
     
    39853999    \
    39864000    upgrade     [list action_upgrade        [ACTION_ARGS_PORTS]] \
     4001    rev-upgrade [list action_revupgrade     [ACTION_ARGS_NONE]] \
    39874002    \
    39884003    version     [list action_version        [ACTION_ARGS_NONE]] \
     
    41474162    select      {list set show}
    41484163    log         {{phase 1} {level 1}}
    4149     upgrade     {force enforce-variants no-replace}
     4164    upgrade     {force enforce-variants no-replace no-rev-upgrade}
     4165    rev-upgrade {id-loadcmd-check}
    41504166}
    41514167
     
    41534169# Checks whether the given option is valid
    41544170#
    4155 # œparam action for which action
     4171# @param action for which action
    41564172# @param option the prefix of the option to check
    41574173# @return list of pairs {name argc} for all matching options
  • trunk/base/src/port1.0/port_autoconf.tcl.in

    r81171 r88376  
    6969        variable tar_q "@TAR_Q@"
    7070        variable hdiutil_path "@HDIUTIL@"
     71        variable swig_path "@SIWG@"
    7172        variable have_launchd "@HAVE_LAUNCHD@"
    7273        variable launchctl_path "@LAUNCHCTL@"
  • trunk/base/src/registry2.0/Makefile

    r79782 r88376  
    44OBJS = registry.o util.o \
    55        entry.o entryobj.o \
     6        file.o fileobj.o \
    67        ../cregistry/cregistry.a
    78        #graph.o graphobj.o
  • trunk/base/src/registry2.0/entry.c

    r70608 r88376  
    3636#include <sqlite3.h>
    3737
     38#include <cregistry/util.h>
     39
    3840#include "entry.h"
    3941#include "entryobj.h"
     
    113115        if (entry != NULL) {
    114116            Tcl_Obj* result;
    115             if (entry_to_obj(interp, &result, entry, &error)) {
     117            if (entry_to_obj(interp, &result, entry, NULL, &error)) {
    116118                Tcl_SetObjResult(interp, result);
    117119                return TCL_OK;
     
    193195        if (entry != NULL) {
    194196            Tcl_Obj* result;
    195             if (entry_to_obj(interp, &result, entry, &error)) {
     197            if (entry_to_obj(interp, &result, entry, NULL, &error)) {
    196198                Tcl_SetObjResult(interp, result);
    197199                return TCL_OK;
     
    210212static int entry_close(Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
    211213    if (objc != 3) {
    212         Tcl_WrongNumArgs(interp, 1, objv, "delete entry");
     214        Tcl_WrongNumArgs(interp, 1, objv, "close entry");
    213215        return TCL_ERROR;
    214216    } else {
     
    456458            } else {
    457459                Tcl_Obj* result;
    458                 if (entry_to_obj(interp, &result, entry, &error)) {
     460                if (entry_to_obj(interp, &result, entry, NULL, &error)) {
    459461                    Tcl_SetObjResult(interp, result);
    460462                    return TCL_OK;
  • trunk/base/src/registry2.0/portimage.tcl

    r84170 r88376  
    8989    }
    9090    if {![info exists registry_open]} {
    91         registry::open [file join ${macports::registry.path} registry registry.db]
     91        registry::open [::file join ${macports::registry.path} registry registry.db]
    9292        set registry_open yes
    9393    }
     
    117117            return -code error "Image error: ${name} @${specifier} not installed as an image."
    118118        }
    119         if {![file isfile $location]} {
     119        if {![::file isfile $location]} {
    120120            return -code error "Image error: Can't find image file $location"
    121121        }
     
    159159    }
    160160    if {![info exists registry_open]} {
    161         registry::open [file join ${macports::registry.path} registry registry.db]
     161        registry::open [::file join ${macports::registry.path} registry registry.db]
    162162        set registry_open yes
    163163    }
     
    250250## @return 1 if file needs to be explicitly deleted if we have to roll back, 0 otherwise
    251251proc _activate_file {srcfile dstfile} {
    252     if {[catch {set filetype [file type $srcfile]} result]} {
     252    if {[catch {set filetype [::file type $srcfile]} result]} {
    253253        # this can happen if the archive was built on case-sensitive and we're case-insensitive
    254254        # we know any existing dstfile is ours because we checked for conflicts earlier
     
    265265            ui_debug "activating directory: $dstfile"
    266266            # Don't do anything if the directory already exists.
    267             if { ![file isdirectory $dstfile] } {
    268                 file mkdir $dstfile
     267            if { ![::file isdirectory $dstfile] } {
     268                ::file mkdir $dstfile
    269269                # fix attributes on the directory.
    270270                if {[getuid] == 0} {
    271                     eval file attributes {$dstfile} [file attributes $srcfile]
     271                    eval ::file attributes {$dstfile} [::file attributes $srcfile]
    272272                } else {
    273273                    # not root, so can't set owner/group
    274                     eval file attributes {$dstfile} -permissions [file attributes $srcfile -permissions]
     274                    eval ::file attributes {$dstfile} -permissions [::file attributes $srcfile -permissions]
    275275                }
    276276                # set mtime on installed element
    277                 file mtime $dstfile [file mtime $srcfile]
     277                ::file mtime $dstfile [::file mtime $srcfile]
    278278            }
    279279            return 0
     
    281281        default {
    282282            ui_debug "activating file: $dstfile"
    283             file rename $srcfile $dstfile
     283            ::file rename $srcfile $dstfile
    284284            return 1
    285285        }
     
    291291proc extract_archive_to_tmpdir {location} {
    292292    global macports::registry.path
    293     set extractdir [mkdtemp [file dirname $location]/mpextractXXXXXXXX]
     293    set extractdir [mkdtemp [::file dirname $location]/mpextractXXXXXXXX]
    294294    set startpwd [pwd]
    295295
     
    306306        set unarchive.args {}
    307307        set unarchive.pipe_cmd ""
    308         set unarchive.type [file extension $location]
     308        set unarchive.type [::file extension $location]
    309309        switch -regex ${unarchive.type} {
    310310            cp(io|gz) {
     
    414414        system $cmdstring
    415415    } catch {*} {
    416         file delete -force $extractdir
     416        ::file delete -force $extractdir
    417417        throw
    418418    } finally {
     
    452452                # figure out if the source file exists (file exists will return
    453453                # false for symlinks on files that do not exist)
    454                 if { [catch {file lstat $srcfile dummystatvar}] } {
     454                if { [catch {::file lstat $srcfile dummystatvar}] } {
    455455                    throw registry::image-error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port [$port name]."
    456456                }
     
    475475                        # files to a backup file, both in the filesystem and in the
    476476                        # registry
    477                         if { ![catch {file type $file}] } {
     477                        if { ![catch {::file type $file}] } {
    478478                            set bakfile "${file}${baksuffix}"
    479479                            ui_warn "File $file already exists.  Moving to: $bakfile."
    480                             file rename -force -- $file $bakfile
     480                            ::file rename -force -- $file $bakfile
    481481                            lappend backups $file
    482482                        }
     
    491491                        if { $owner != {} && $owner != $port } {
    492492                            throw registry::image-error "Image error: $file is being used by the active [$owner name] port.  Please deactivate this port first, or use 'port -f activate [$port name]' to force the activation."
    493                         } elseif { $owner == {} && ![catch {file type $file}] } {
     493                        } elseif { $owner == {} && ![catch {::file type $file}] } {
    494494                            throw registry::image-error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port [$port name]. Use 'port -f activate [$port name]' to force the activation."
    495495                        }
     
    505505                # we'll set the directory attributes properly for all
    506506                # directories.
    507                 set directory [file dirname $file]
     507                set directory [::file dirname $file]
    508508                while { [lsearch -exact $files $directory] == -1 } {
    509509                    lappend files $directory
    510                     set directory [file dirname $directory]
     510                    set directory [::file dirname $directory]
    511511                }
    512512
     
    556556        # of this in the registry.
    557557        foreach file $backups {
    558             file rename -force -- "${file}${baksuffix}" $file
     558            ::file rename -force -- "${file}${baksuffix}" $file
    559559        }
    560560        # reactivate deactivated ports
     
    565565        }
    566566        # remove temp image dir
    567         file delete -force $extracted_dir
     567        ::file delete -force $extracted_dir
    568568        throw
    569569    }
    570     file delete -force $extracted_dir
     570    ::file delete -force $extracted_dir
    571571}
    572572
     
    577577
    578578proc _deactivate_file {dstfile} {
    579     if {[catch {file type $dstfile} filetype]} {
     579    if {[catch {::file type $dstfile} filetype]} {
    580580        ui_debug "$dstfile does not exist"
    581581        return
     
    590590            if {![info exists precious_dirs($dstfile)]} {
    591591                ui_debug "deactivating directory: $dstfile"
    592                 file delete -- $dstfile
     592                ::file delete -- $dstfile
    593593            } else {
    594594                ui_debug "directory $dstfile does not belong to us"
     
    599599    } else {
    600600        ui_debug "deactivating file: $dstfile"
    601         file delete -- $dstfile
     601        ::file delete -- $dstfile
    602602    }
    603603}
     
    607607
    608608    foreach file $imagefiles {
    609         if { [file exists $file] || (![catch {file type $file}] && [file type $file] == "link") } {
     609        if { [::file exists $file] || (![catch {::file type $file}] && [::file type $file] == "link") } {
    610610            # Normalize the file path to avoid removing the intermediate
    611611            # symlinks (remove the empty directories instead)
     
    618618            # The custom realpath proc is necessary because file normalize
    619619            # does not resolve symlinks on OS X < 10.6
    620             set directory [realpath [file dirname $file]]
    621             lappend files [file join $directory [file tail $file]]
     620            set directory [realpath [::file dirname $file]]
     621            lappend files [::file join $directory [::file tail $file]]
    622622
    623623            # Split out the filename's subpaths and add them to the image list
     
    625625            while { [lsearch -exact $files $directory] == -1 } {
    626626                lappend files $directory
    627                 set directory [file dirname $directory]
     627                set directory [::file dirname $directory]
    628628            }
    629629        } else {
  • trunk/base/src/registry2.0/portuninstall.tcl

    r79593 r88376  
    216216        # Try to delete the port's image dir; will fail if there are more image
    217217        # files so just ignore the failure
    218         catch {file delete [file dirname $imagefile]}
     218        catch {file delete [::file dirname $imagefile]}
    219219
    220220        registry::entry delete $port
  • trunk/base/src/registry2.0/receipt_flat.tcl

    r79593 r88376  
    7676    # regex match case
    7777    if {$portversion == 0} {
    78         set x [glob -nocomplain -directory [file join ${macports::registry.path} receipts] -- ${portname}-*]
     78        set x [glob -nocomplain -directory [::file join ${macports::registry.path} receipts] -- ${portname}-*]
    7979        if {[string length $x]} {
    8080            set matchfile [lindex $x 0]
     
    8585        }
    8686    } else {
    87         set matchfile [file join ${macports::registry.path} receipts ${portname}-${portversion}]
     87        set matchfile [::file join ${macports::registry.path} receipts ${portname}-${portversion}]
    8888    }
    8989
     
    9393    }
    9494
    95     if {[file exists $matchfile] || [file exists ${matchfile}.bz2]} {
     95    if {[::file exists $matchfile] || [::file exists ${matchfile}.bz2]} {
    9696                return $matchfile
    9797    }
     
    111111        }
    112112
    113         set receipt_path [file join ${macports::registry.path} receipts ${name}]
     113        set receipt_path [::file join ${macports::registry.path} receipts ${name}]
    114114
    115115        # If the receipt path ${name} doesn't exist, then the receipt probably is
    116116        # in the old HEAD format.
    117         if { ![file isdirectory $receipt_path] } {
     117        if { ![::file isdirectory $receipt_path] } {
    118118                set receipt_file [get_head_entry_receipt_path $name $version]
    119119               
     
    128128                # Extract the version from the path.
    129129                if { $version == "" } {
    130                         set theFileName [file tail $receipt_file]
     130                        set theFileName [::file tail $receipt_file]
    131131                        regexp "^$name-(.*)\$" $theFileName match version
    132132                }
     
    138138                        set x [glob -nocomplain -directory ${receipt_path} *]
    139139                        if { [string length $x] } {
    140                                 set v [lindex [file split [lindex $x 0]] end]
     140                                set v [lindex [::file split [lindex $x 0]] end]
    141141                                regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} $v match version revision variants
    142142                        } else {
     
    149149                }
    150150       
    151                 set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
    152        
    153                 set receipt_file [file join ${receipt_path} receipt]
    154         }
    155 
    156         if { [file exists ${receipt_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
     151                set receipt_path [::file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
     152       
     153                set receipt_file [::file join ${receipt_path} receipt]
     154        }
     155
     156        if { [::file exists ${receipt_file}.bz2] && [::file exists ${registry::autoconf::bzip2_path}] } {
    157157                set receipt_file ${receipt_file}.bz2
    158158                set receipt_contents [exec ${registry::autoconf::bzip2_path} -d -c ${receipt_file}]
    159         } elseif { [file exists ${receipt_file}] } {
     159        } elseif { [::file exists ${receipt_file}] } {
    160160                set receipt_handle [open ${receipt_file} r]
    161161                set receipt_contents [read $receipt_handle]
     
    178178               
    179179                # move the old receipt
    180                 set convertedDirPath [file join ${macports::registry.path} receipts_converted]
     180                set convertedDirPath [::file join ${macports::registry.path} receipts_converted]
    181181                file mkdir $convertedDirPath
    182182                file rename -- $receipt_file $convertedDirPath
     
    275275                if {[llength $file]} {
    276276                        set theFilePath [lindex $file 0]
    277                         if {[file isfile $theFilePath]} {
    278                                 set previousPort [file_registered $theFilePath]
     277                        if {[::file isfile $theFilePath]} {
     278                                set previousPort [::file_registered $theFilePath]
    279279                                if {$previousPort != 0} {
    280280                                        ui_warn "Conflict detected for file $theFilePath between $previousPort and $name."
     
    283283                                        ui_warn "An error occurred while adding $theFilePath to the file_map database."
    284284                                }
    285                         } elseif {![file exists $theFilePath]} {
     285                        } elseif {![::file exists $theFilePath]} {
    286286                                ui_warn "Port $name refers to $theFilePath which doesn't exist."
    287287                        }
     
    315315        set receipt_contents [array get receipt_$ref]
    316316
    317         set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
    318         set receipt_file [file join ${receipt_path} receipt]
    319 
    320         if { ![file isdirectory ${receipt_path}] } {
     317        set receipt_path [::file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
     318        set receipt_file [::file join ${receipt_path} receipt]
     319
     320        if { ![::file isdirectory ${receipt_path}] } {
    321321                file mkdir ${receipt_path}
    322322        }
     
    327327        close $receipt_handle
    328328
    329         if { [file exists ${receipt_file}] } {
     329        if { [::file exists ${receipt_file}] } {
    330330                file delete -force -- "${receipt_file}"
    331         } elseif { [file exists ${receipt_file}.bz2] } {
     331        } elseif { [::file exists ${receipt_file}.bz2] } {
    332332                file delete -force -- "${receipt_file}.bz2"
    333333        }
     
    335335        file rename -force -- "${receipt_file}.tmp" "${receipt_file}"
    336336
    337         if { [file exists ${receipt_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
     337        if { [::file exists ${receipt_file}] && [::file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
    338338                system "${registry::autoconf::bzip2_path} -f ${receipt_file}"
    339339        }
     
    346346        global macports::registry.path
    347347
    348         set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
    349         set receipt_file [file join ${receipt_path} receipt]
    350 
    351         if { [file exists $receipt_file] } {
     348        set receipt_path [::file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
     349        set receipt_file [::file join ${receipt_path} receipt]
     350
     351        if { [::file exists $receipt_file] } {
    352352                return 1
    353         } elseif { [file exists ${receipt_file}.bz2] } {
     353        } elseif { [::file exists ${receipt_file}.bz2] } {
    354354                return 1
    355355        }
     
    362362        global macports::registry.path
    363363
    364         set receipt_path [file join ${macports::registry.path} receipts ${name}]
     364        set receipt_path [::file join ${macports::registry.path} receipts ${name}]
    365365
    366366        if {[llength [glob -nocomplain -directory $receipt_path */receipt{,.bz2}]] > 0} {
     
    418418        }
    419419
    420         set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
    421         if { [file exists ${receipt_path}] } {
     420        set receipt_path [::file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
     421        if { [::file exists ${receipt_path}] } {
    422422                # remove port receipt directory
    423423                ui_debug "deleting directory: ${receipt_path}"
    424424                file delete -force -- ${receipt_path}
    425425                # remove port receipt parent directory (if empty)
    426                 set receipt_dir [file join ${macports::registry.path} receipts ${name}]
    427                 if { [file isdirectory ${receipt_dir}] } {
     426                set receipt_dir [::file join ${macports::registry.path} receipts ${name}]
     427                if { [::file isdirectory ${receipt_dir}] } {
    428428                        # 0 item means empty.
    429429                        if { [llength [readdir ${receipt_dir}]] == 0 } {
     
    450450        global macports::registry.path
    451451
    452         set query_path [file join ${macports::registry.path} receipts]
     452        set query_path [::file join ${macports::registry.path} receipts]
    453453       
    454454        if { $name == "" } {
    455                 set query_path [file join ${query_path} *]
     455                set query_path [::file join ${query_path} *]
    456456                if { $version == "" } {
    457                         set query_path [file join ${query_path} *]
     457                        set query_path [::file join ${query_path} *]
    458458                }
    459459                # [PG] Huh?
     
    463463            # correct case on a case-insensitive FS, we have to list the directory and
    464464            # compare against each entry.
    465             set name_path [file join ${query_path} *]
     465            set name_path [::file join ${query_path} *]
    466466            set name_entries [glob -nocomplain -types d ${name_path}]
    467467            foreach entry $name_entries {
    468                 set basename [file tail $entry]
     468                set basename [::file tail $entry]
    469469                if {[string equal -nocase $basename $name]} {
    470470                    set name $basename
     
    472472                }
    473473            }
    474                 set query_path [file join ${query_path} ${name}]
     474                set query_path [::file join ${query_path} ${name}]
    475475                if { $version != "" } {
    476                         set query_path [file join ${query_path} ${version}]
     476                        set query_path [::file join ${query_path} ${version}]
    477477                } else {
    478                         set query_path [file join ${query_path} *]
     478                        set query_path [::file join ${query_path} *]
    479479                }
    480480        }
     
    483483        set rlist [list]
    484484        foreach p $x {
    485                 if {![file isfile [file join $p receipt.bz2]] && ![file isfile [file join $p receipt]]} {
     485                if {![::file isfile [::file join $p receipt.bz2]] && ![::file isfile [::file join $p receipt]]} {
    486486                        continue
    487487                }
    488488                set plist [list]
    489                 regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} [lindex [file split $p] end] match version revision variants
    490                 lappend plist [lindex [file split $p] end-1]
     489                regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} [lindex [::file split $p] end] match version revision variants
     490                lappend plist [lindex [::file split $p] end-1]
    491491                lappend plist $version
    492492                lappend plist $revision
     
    497497        # append the ports in old HEAD format.
    498498        if { $name == "" } {
    499                 set query_path [file join ${macports::registry.path} receipts *]
    500         } else {
    501                 set query_path [file join ${macports::registry.path} receipts ${name}-*]
     499                set query_path [::file join ${macports::registry.path} receipts *]
     500        } else {
     501                set query_path [::file join ${macports::registry.path} receipts ${name}-*]
    502502        }
    503503    set receiptglob [glob -nocomplain -types f ${query_path}]
    504504    foreach receipt_file $receiptglob {
    505                 set theFileName [file tail $receipt_file]
     505                set theFileName [::file tail $receipt_file]
    506506
    507507        # Remark: these regexes do not always work.
     
    540540        variable file_map
    541541
    542         set receipt_path [file join ${macports::registry.path} receipts]
    543         set map_file [file join ${receipt_path} file_map]
     542        set receipt_path [::file join ${macports::registry.path} receipts]
     543        set map_file [::file join ${receipt_path} file_map]
    544544
    545545        # Don't reopen it (it actually would deadlock us), unless it was open r/o.
     
    547547        if { [info exists file_map] } {
    548548                if { $readonly == 0 } {
    549                         if {[filemap isreadonly file_map]} {
     549                        if {[::filemap isreadonly file_map]} {
    550550                                filemap close file_map
    551551                                filemap open file_map ${map_file}.db
     
    557557        set old_filemap [list]
    558558
    559         if { ![file exists ${map_file}.db] } {
     559        if { ![::file exists ${map_file}.db] } {
    560560                # Convert to new format
    561                 if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
     561                if { [::file exists ${map_file}.bz2] && [::file exists ${registry::autoconf::bzip2_path}] } {
    562562                        set old_filemap [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
    563                 } elseif { [file exists $map_file] } {         
     563                } elseif { [::file exists $map_file] } {               
    564564                        set map_handle [open ${map_file} r]
    565565                        set old_filemap [read $map_handle]
     
    609609        open_file_map 1
    610610
    611         if {[filemap exists file_map $file]} {
    612                 return [filemap get file_map $file]
     611        if {[::filemap exists file_map $file]} {
     612                return [::filemap get file_map $file]
    613613        } else {
    614614                return 0
     
    631631        open_file_map 1
    632632
    633         set files [filemap list file_map $name]
     633        set files [::filemap list file_map $name]
    634634
    635635        if { [llength $files] > 0 } {
     
    642642                        open_entry $name
    643643                       
    644                         set files [filemap list file_map $name]
     644                        set files [::filemap list file_map $name]
    645645                       
    646646                        return $files
     
    663663        open_file_map
    664664
    665         if { [file type $file] == "link" } {
     665        if { [::file type $file] == "link" } {
    666666                ui_debug "Adding link to file_map: $file for: $port"
    667667        } else {
     
    685685        foreach f $files {
    686686                set file [lindex $f 0]
    687                 if { [file type $file] == "link" } {
     687                if { [::file type $file] == "link" } {
    688688                        ui_debug "Adding link to file_map: $file for: $port"
    689689                } else {
     
    744744        variable dep_map
    745745
    746         set receipt_path [file join ${macports::registry.path} receipts]
    747 
    748         set map_file [file join ${receipt_path} dep_map]
    749 
    750         if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
     746        set receipt_path [::file join ${macports::registry.path} receipts]
     747
     748        set map_file [::file join ${receipt_path} dep_map]
     749
     750        if { [::file exists ${map_file}.bz2] && [::file exists ${registry::autoconf::bzip2_path}] } {
    751751                set dep_map [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
    752         } elseif { [file exists ${map_file}] } {
     752        } elseif { [::file exists ${map_file}] } {
    753753                set map_handle [open ${map_file} r]
    754754                set dep_map [read $map_handle]
     
    838838        variable dep_map
    839839
    840         set receipt_path [file join ${macports::registry.path} receipts]
    841 
    842         set map_file [file join ${receipt_path} dep_map]
     840        set receipt_path [::file join ${macports::registry.path} receipts]
     841
     842        set map_file [::file join ${receipt_path} dep_map]
    843843
    844844        set map_handle [open ${map_file}.tmp w 0644]
     
    851851    file rename -- ${map_file}.tmp ${map_file}
    852852
    853         if { [file exists ${map_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
     853        if { [::file exists ${map_file}] && [::file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
    854854                system "${registry::autoconf::bzip2_path} -f ${map_file}"
    855855        }
  • trunk/base/src/registry2.0/receipt_sqlite.tcl

  • trunk/base/src/registry2.0/registry.c

    r70608 r88376  
    3939#include <cregistry/registry.h>
    4040#include <cregistry/entry.h>
    41 
    42 #include "registry.h"
     41#include <cregistry/file.h>
     42
     43#include "entry.h"
     44#include "entryobj.h"
     45#include "file.h"
    4346#include "graph.h"
    4447#include "item.h"
    45 #include "entry.h"
    46 #include "entryobj.h"
     48#include "registry.h"
    4749#include "util.h"
    4850
     
    5557}
    5658
     59/* we don't need delete_file_list and restore_file_list unless we allow deletion
     60   of files via the file interface */
    5761static void delete_entry_list(ClientData list, Tcl_Interp* interp UNUSED) {
    5862    entry_list* curr = *(entry_list**)list;
     
    8185        reg_error* errPtr) {
    8286    reg_entry** entries;
    83     int entry_count = reg_all_open_entries(reg, &entries);
     87    reg_file** files;
     88    int entry_count;
     89    int file_count;
    8490    int i;
     91    entry_count = reg_all_open_entries(reg, &entries);
    8592    if (entry_count == -1) {
    8693        return 0;
     
    9299    }
    93100    free(entries);
     101    file_count = reg_all_open_files(reg, &files);
     102    if (file_count == -1) {
     103        return 0;
     104    }
     105    for (i = 0; i < file_count; i++) {
     106        if (files[i]->proc) {
     107            Tcl_DeleteCommand(interp, files[i]->proc);
     108        }
     109    }
     110    free(files);
    94111    if (!reg_detach(reg, errPtr)) {
    95112        return registry_failed(interp, errPtr);
     
    320337    /* Tcl_CreateObjCommand(interp, "registry::item", item_cmd, NULL, NULL); */
    321338    Tcl_CreateObjCommand(interp, "registry::entry", entry_cmd, NULL, NULL);
     339    Tcl_CreateObjCommand(interp, "registry::file", file_cmd, NULL, NULL);
    322340    if (Tcl_PkgProvide(interp, "registry2", "2.0") != TCL_OK) {
    323341        return TCL_ERROR;
  • trunk/base/src/registry2.0/registry.tcl

    r79593 r88376  
    321321    # and $statvar(mode) tells us that links are links).
    322322    if {![catch {file lstat $fname statvar}]} {
    323         if {[file isfile $fname] && [file type $fname] != "link"} {
     323        if {[::file isfile $fname] && [::file type $fname] != "link"} {
    324324            if {[catch {md5 file $fname} md5sum] == 0} {
    325325                # Create a line that matches md5(1)'s output
     
    348348        foreach file $flist {
    349349                if {[string index $file 0] != "/"} {
    350                         set file [file join $prefix $file]
     350                        set file [::file join $prefix $file]
    351351                }
    352352                lappend rval [fileinfo_for_file $file]
     
    397397        return
    398398    }
    399     set lockpath [file join ${registry.path} registry .registry.lock]
     399    set lockpath [::file join ${registry.path} registry .registry.lock]
    400400    if {![info exists lockfd]} {
    401         if {![file writable [file dirname $lockpath]]} {
     401        if {![::file writable [::file dirname $lockpath]]} {
    402402            # skip locking, registry can't be modified anyway
    403403            return
  • trunk/base/src/registry2.0/util.c

    r66019 r88376  
    3737#include "util.h"
    3838#include "entryobj.h"
     39#include "fileobj.h"
    3940
    4041/**
     
    4647 * `interp create` command, and is intended to generate names for created
    4748 * objects of a similar nature.
    48  *
    49  * TODO: add a int* parameter so that functions which need large numbers of
    50  * unique names can keep track of the lower bound between calls,thereby turning
    51  * N^2 to N. It'll be alchemy for the 21st century.
    52  */
    53 char* unique_name(Tcl_Interp* interp, char* prefix) {
     49 */
     50char* unique_name(Tcl_Interp* interp, char* prefix, int* lower_bound) {
    5451    int result_size = strlen(prefix) + TCL_INTEGER_SPACE + 1;
    5552    char* result = malloc(result_size);
     
    5855    if (!result)
    5956        return NULL;
    60     for (i=0; ; i++) {
     57    if (lower_bound == NULL) {
     58        i = 0;
     59    } else {
     60        i = *lower_bound;
     61    }
     62    for (; ; i++) {
    6163        snprintf(result, result_size, "%s%d", prefix, i);
    6264        if (Tcl_GetCommandInfo(interp, result, &info) == 0) {
    6365            break;
    6466        }
     67    }
     68    if (lower_bound != NULL) {
     69        *lower_bound = i + 1;
    6570    }
    6671    return result;
     
    176181    if (set_object(interp, name, entry, "entry", entry_obj_cmd, NULL,
    177182                errPtr)) {
    178         int size = strlen(name) + 1;
    179         entry->proc = malloc(size*sizeof(char));
     183        entry->proc = strdup(name);
    180184        if (!entry->proc) {
    181185            return 0;
    182186        }
    183         memcpy(entry->proc, name, size);
     187        return 1;
     188    }
     189    return 0;
     190}
     191
     192/**
     193 * Sets a given name to be a file object.
     194 *
     195 * @param [in] interp  Tcl interpreter to create the file within
     196 * @param [in] name    name to associate the given file with
     197 * @param [in] file    file to associate with the given name
     198 * @param [out] errPtr description of error if it couldn't be set
     199 * @return             true if success; false if failure
     200 * @see set_object
     201 */
     202int set_file(Tcl_Interp* interp, char* name, reg_file* file,
     203        reg_error* errPtr) {
     204    if (set_object(interp, name, file, "file", file_obj_cmd, NULL,
     205                errPtr)) {
     206        file->proc = strdup(name);
     207        if (!file->proc) {
     208            return 0;
     209        }
    184210        return 1;
    185211    }
     
    205231}
    206232
    207 /**
    208  * Sets the result of the interpreter to all objects returned by a query.
    209  *
    210  * This function executes `query` on `db` It expects that the query will return
    211  * records of a single column, `rowid`. It will then use `prefix` to construct
    212  * unique names for these records, and call `setter` to construct their proc
    213  * objects. The result of `interp` will be set to a list of all such objects.
    214  *
    215  * If TCL_OK is returned, then a list is in the result. If TCL_ERROR is, then an
    216  * error is there.
    217  */
    218 int all_objects(Tcl_Interp* interp, sqlite3* db, char* query, char* prefix,
    219         set_object_function* setter) {
    220     sqlite3_stmt* stmt;
    221     if (sqlite3_prepare(db, query, -1, &stmt, NULL) == SQLITE_OK) {
    222         Tcl_Obj* result = Tcl_NewListObj(0, NULL);
    223         Tcl_SetObjResult(interp, result);
    224         while (sqlite3_step(stmt) == SQLITE_ROW) {
    225             sqlite_int64 rowid = sqlite3_column_int64(stmt, 0);
    226             char* name = unique_name(interp, prefix);
    227             if (!name) {
    228                 return TCL_ERROR;
    229             }
    230             if (setter(interp, name, rowid) == TCL_OK) {
    231                 Tcl_Obj* element = Tcl_NewStringObj(name, -1);
    232                 Tcl_ListObjAppendElement(interp, result, element);
    233                 free(name);
    234             } else {
    235                 free(name);
    236                 return TCL_ERROR;
    237             }
    238         }
    239         sqlite3_finalize(stmt);
    240         return TCL_OK;
    241     } else {
    242         sqlite3_finalize(stmt);
    243         set_sqlite_result(interp, db, query);
    244         return TCL_ERROR;
    245     }
    246 }
    247 
    248233const char* string_or_null(Tcl_Obj* obj) {
    249234    const char* string = Tcl_GetString(obj);
     
    255240}
    256241
    257 int recast(void* userdata, cast_function* fn, free_function* del, void*** outv,
    258         void** inv, int inc, reg_error* errPtr) {
     242int recast(void* userdata, cast_function* fn, void* castcalldata,
     243        free_function* del, void*** outv, void** inv, int inc,
     244        reg_error* errPtr) {
    259245    void** result = malloc(inc*sizeof(void*));
    260246    int i;
     
    263249    }
    264250    for (i=0; i<inc; i++) {
    265         if (!fn(userdata, &result[i], inv[i], errPtr)) {
     251        if (!fn(userdata, &result[i], inv[i], castcalldata, errPtr)) {
    266252            if (del != NULL) {
    267253                for ( ; i>=0; i--) {
     
    278264
    279265int entry_to_obj(Tcl_Interp* interp, Tcl_Obj** obj, reg_entry* entry,
    280         reg_error* errPtr) {
     266        int* lower_bound, reg_error* errPtr) {
    281267    if (entry->proc == NULL) {
    282         char* name = unique_name(interp, "::registry::entry");
     268        char* name = unique_name(interp, "::registry::entry", lower_bound);
    283269        if (!name) {
    284270            return 0;
     
    294280}
    295281
     282int file_to_obj(Tcl_Interp* interp, Tcl_Obj** obj, reg_file* file,
     283        int* lower_bound, reg_error* errPtr) {
     284    if (file->proc == NULL) {
     285        char* name = unique_name(interp, "::registry::file", lower_bound);
     286        if (!name) {
     287            return 0;
     288        }
     289        if (!set_file(interp, name, file, errPtr)) {
     290            free(name);
     291            return 0;
     292        }
     293        free(name);
     294    }
     295    *obj = Tcl_NewStringObj(file->proc, -1);
     296    return 1;
     297}
     298
    296299int list_entry_to_obj(Tcl_Interp* interp, Tcl_Obj*** objs,
    297300        reg_entry** entries, int entry_count, reg_error* errPtr) {
    298     return recast(interp, (cast_function*)entry_to_obj, NULL, (void***)objs,
    299             (void**)entries, entry_count, errPtr);
     301    int lower_bound = 0;
     302    return recast(interp, (cast_function*)entry_to_obj, &lower_bound, NULL,
     303            (void***)objs, (void**)entries, entry_count, errPtr);
     304}
     305
     306int list_file_to_obj(Tcl_Interp* interp, Tcl_Obj*** objs,
     307        reg_file** files, int file_count, reg_error* errPtr) {
     308    int lower_bound = 0;
     309    return recast(interp, (cast_function*)file_to_obj, &lower_bound, NULL,
     310            (void***)objs, (void**)files, file_count, errPtr);
    300311}
    301312
    302313static int obj_to_string(void* userdata UNUSED, char** string, Tcl_Obj* obj,
    303         reg_error* errPtr UNUSED) {
     314        void* param UNUSED, reg_error* errPtr UNUSED) {
    304315    *string = Tcl_GetString(obj);
    305316    return 1;
     
    308319int list_obj_to_string(char*** strings, Tcl_Obj** objv, int objc,
    309320        reg_error* errPtr) {
    310     return recast(NULL, (cast_function*)obj_to_string, NULL, (void***)strings,
     321    return recast(NULL, (cast_function*)obj_to_string, NULL, NULL, (void***)strings,
    311322            (void**)objv, objc, errPtr);
    312323}
    313324
    314325static int string_to_obj(void* userdata UNUSED, Tcl_Obj** obj, char* string,
    315         reg_error* errPtr UNUSED) {
     326        void* param UNUSED, reg_error* errPtr UNUSED) {
    316327    *obj = Tcl_NewStringObj(string, -1);
    317328    return 1;
     
    324335int list_string_to_obj(Tcl_Obj*** objv, char** strings, int objc,
    325336        reg_error* errPtr) {
    326     return recast(NULL, (cast_function*)string_to_obj, (free_function*)free_obj,
     337    return recast(NULL, (cast_function*)string_to_obj, NULL, (free_function*)free_obj,
    327338            (void***)objv, (void**)strings, objc, errPtr);
    328339}
  • trunk/base/src/registry2.0/util.h

    r28029 r88376  
    3838#include <cregistry/registry.h>
    3939#include <cregistry/entry.h>
     40#include <cregistry/file.h>
    4041
    4142typedef struct {
     
    4647#define END_FLAGS 0
    4748
    48 char* unique_name(Tcl_Interp* interp, char* prefix);
     49char* unique_name(Tcl_Interp* interp, char* prefix, int* lower_bound);
    4950
    5051int parse_flags(Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[], int* start,
     
    5758int set_entry(Tcl_Interp* interp, char* name, reg_entry* entry,
    5859        reg_error* errPtr);
     60int set_file(Tcl_Interp* interp, char* name, reg_file* file,
     61        reg_error* errPtr);
    5962
    6063void set_sqlite_result(Tcl_Interp* interp, sqlite3* db, const char* query);
    6164
    62 typedef int set_object_function(Tcl_Interp* interp, char* name,
    63         sqlite_int64 rowid);
    64 int all_objects(Tcl_Interp* interp, sqlite3* db, char* query, char* prefix,
    65         set_object_function* setter);
    66 
    6765const char* string_or_null(Tcl_Obj* obj);
    6866
    69 int recast(void* userdata, cast_function* fn, free_function* del, void*** outv,
    70         void** inv, int inc, reg_error* errPtr);
     67int recast(void* userdata, cast_function* fn, void* castcalldata,
     68        free_function* del, void*** outv, void** inv, int inc,
     69        reg_error* errPtr);
    7170
    7271int entry_to_obj(Tcl_Interp* interp, Tcl_Obj** obj, reg_entry* entry,
    73         reg_error* errPtr);
     72        int* lower_bound, reg_error* errPtr);
    7473int list_entry_to_obj(Tcl_Interp* interp, Tcl_Obj*** objs,
    7574        reg_entry** entries, int entry_count, reg_error* errPtr);
     75int file_to_obj(Tcl_Interp* interp, Tcl_Obj** ibj, reg_file* file,
     76        int* lower_bound, reg_error* errPtr);
     77int list_file_to_obj(Tcl_Interp* interp, Tcl_Obj*** objs,
     78        reg_file** files, int file_count, reg_error* errPtr);
    7679
    7780void free_strings(void* userdata UNUSED, char** strings, int count);
Note: See TracChangeset for help on using the changeset viewer.