Ignore:
Timestamp:
Dec 31, 2011, 5:05:20 PM (9 years ago)
Author:
derek@…
Message:

statistics: Merge from trunk

Location:
branches/gsoc11-statistics/base
Files:
33 edited
9 copied

Legend:

Unmodified
Added
Removed
  • branches/gsoc11-statistics/base

  • branches/gsoc11-statistics/base/src/Makefile.in

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

    r66448 r88412  
    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
  • branches/gsoc11-statistics/base/src/cregistry/entry.c

    r84763 r88412  
    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:
  • branches/gsoc11-statistics/base/src/cregistry/entry.h

    r65381 r88412  
    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 {
  • branches/gsoc11-statistics/base/src/cregistry/registry.c

    r84763 r88412  
    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;
  • branches/gsoc11-statistics/base/src/cregistry/registry.h

    r70608 r88412  
    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
  • branches/gsoc11-statistics/base/src/cregistry/sql.c

    r68675 r88412  
    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            NULL
     186        };
     187
     188        if (!do_queries(db, version_1_1_queries, errPtr)) {
     189            goto err_out;
     190        }
     191
     192        /* TODO: Walk the file tree and set the binary field */
     193    }
     194    sqlite3_finalize(stmt);
     195    return 1;
     196
     197reg_err_out:
     198    reg_sqlite_error(db, errPtr, query);
     199err_out:
     200    sqlite3_finalize(stmt);
     201    return 0;
     202}
     203
     204/**
    151205 * Initializes database connection. This function creates all the temporary
    152206 * tables used by the registry. It also registers the user functions and
  • branches/gsoc11-statistics/base/src/cregistry/sql.h

    r65381 r88412  
    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 */
  • branches/gsoc11-statistics/base/src/macports1.0/macports.tcl

    r84763 r88412  
    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
     
    16331636}
    16341637
    1635 ### _mportconflictsinstalled is private; may change without notice
    1636 
    1637 # Determine if the port, per the conflicts option, has any conflicts with
    1638 # what is installed.
     1638### _mporterrorifconflictsinstalled is private; may change without notice
     1639
     1640# Determine if the port, per the conflicts option, has any conflicts
     1641# with what is installed. If it does, raises an error unless force
     1642# option is set.
    16391643#
    16401644# mport   the port to check for conflicts
    1641 # Returns a list of which installed ports conflict, or an empty list if none
    1642 proc _mportconflictsinstalled {mport conflictinfo} {
     1645proc _mporterrorifconflictsinstalled {mport} {
    16431646    set conflictlist {}
    1644     if {[llength $conflictinfo] > 0} {
     1647    array set portinfo [mportinfo $mport]
     1648
     1649    if {[info exists portinfo(conflicts)] &&
     1650        [llength $portinfo(conflicts)] > 0} {
    16451651        ui_debug "Checking for conflicts against [_mportkey $mport subport]"
    1646         foreach conflictport ${conflictinfo} {
     1652        foreach conflictport $portinfo(conflicts) {
    16471653            if {[_mportispresent $mport port:${conflictport}]} {
    16481654                lappend conflictlist $conflictport
     
    16531659    }
    16541660
    1655     return $conflictlist
    1656 }
    1657 
     1661    if {[llength ${conflictlist}] != 0} {
     1662        if {[macports::global_option_isset ports_force]} {
     1663            ui_warn "Force option set; installing $portinfo(name) despite conflicts with: ${conflictlist}"
     1664        } else {
     1665            if {![macports::ui_isset ports_debug]} {
     1666                ui_msg ""
     1667            }
     1668            return -code error "Can't install $portinfo(name) because conflicting ports are installed: ${conflictlist}"
     1669        }
     1670    }
     1671}
    16581672
    16591673### _mportexec is private; may change without notice
     
    17341748        }
    17351749
    1736         ui_msg -nonewline "---> Computing dependencies for [_mportkey $mport subport]"
     1750        ui_msg -nonewline "$macports::ui_prefix Computing dependencies for [_mportkey $mport subport]"
    17371751        if {[macports::ui_isset ports_debug]} {
    17381752            # play nice with debug messages
     
    17541768        # print the dep list
    17551769        if {[llength $dlist] > 0} {
    1756             set depstring "---> Dependencies to be installed:"
     1770            set depstring "$macports::ui_prefix Dependencies to be installed:"
    17571771            foreach ditem $dlist {
    17581772                append depstring " [ditem_key $ditem provides]"
     
    17811795        foreach ditem $dlist {
    17821796            mportclose $ditem
     1797        }
     1798    } else {
     1799        # No dependencies, but we still need to check for conflicts.
     1800        if {$target == "" || $target == "install" || $target == "activate"} {
     1801            _mporterrorifconflictsinstalled $mport
    17831802        }
    17841803    }
     
    20002019            {^file$} {
    20012020                set portdir [macports::getportdir $source]
    2002                 if {[file exists $portdir/.svn]} {
    2003                     set svn_commandline "[macports::findBinary svn] update --non-interactive ${portdir}"
     2021                set svn_cmd ""
     2022                catch {set svn_cmd [macports::findBinary svn]}
     2023                if {$svn_cmd != "" && ([file exists $portdir/.svn] || ![catch {exec $svn_cmd info $portdir > /dev/null 2>@1}])} {
     2024                    set svn_commandline "$svn_cmd update --non-interactive ${portdir}"
    20042025                    ui_debug $svn_commandline
    20052026                    if {
     
    26572678    }
    26582679   
    2659     if {[info exists portinfo(conflicts)] && ($target == "" || $target == "install" || $target == "activate")} {
    2660         set conflictports [_mportconflictsinstalled $mport $portinfo(conflicts)]
    2661         if {[llength ${conflictports}] != 0} {
    2662             if {[macports::global_option_isset ports_force]} {
    2663                 ui_warn "Force option set; installing $portinfo(name) despite conflicts with: ${conflictports}"
    2664             } else {
    2665                 if {![macports::ui_isset ports_debug]} {
    2666                     ui_msg ""
    2667                 }
    2668                 return -code error "Can't install $portinfo(name) because conflicting ports are installed: ${conflictports}"
    2669             }
    2670         }
     2680    if {$target == "" || $target == "install" || $target == "activate"} {
     2681        _mporterrorifconflictsinstalled $mport
    26712682    }
    26722683
     
    27592770                    set check_archs 0
    27602771                }
    2761                 lappend options subport $dep_portname
     2772                lappend options subport $dep_portinfo(name)
    27622773                # Figure out the depport. Check the open_mports list first, since
    27632774                # we potentially leak mport references if we mportopen each time,
     
    30043015
    30053016    # sync the MacPorts sources
    3006     ui_msg "---> Updating MacPorts base sources using rsync"
     3017    ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
    30073018    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
    30083019       return -code error "Error synchronizing MacPorts sources: $result"
     
    30773088    # syncing ports tree.
    30783089    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
    3079         ui_msg "---> Updating the ports tree"
     3090        ui_msg "$macports::ui_prefix Updating the ports tree"
    30803091        if {$comp > 0} {
    30813092            # updated portfiles potentially need new base to parse - tell sync to try to
     
    30903101    if {$use_the_force_luke == "yes" || $comp > 0} {
    30913102        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
    3092             ui_msg "---> MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
     3103            ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
    30933104        } else {
    3094             ui_msg "---> MacPorts base is outdated, installing new version $macports_version_new"
     3105            ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
    30953106
    30963107            # get installation user/group and permissions
     
    31423153        }
    31433154    } elseif {$comp < 0} {
    3144         ui_msg "---> MacPorts base is probably trunk or a release candidate"
     3155        ui_msg "$macports::ui_prefix MacPorts base is probably trunk or a release candidate"
    31453156    } else {
    3146         ui_msg "---> MacPorts base is already the latest version"
     3157        ui_msg "$macports::ui_prefix MacPorts base is already the latest version"
    31473158    }
    31483159
     
    31933204        unset -nocomplain macports::global_options(ports_nodeps)
    31943205    }
     3206
    31953207    return $status
    31963208}
     
    32003212    global macports::global_variations
    32013213    array set options $optionslist
    3202     set options(subport) $portname
    32033214
    32043215    if {![string match "" $depscachename]} {
     
    32103221    if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
    32113222        set is_dryrun yes
     3223    }
     3224
     3225    # Is this a rev-upgrade-called run?
     3226    set is_revupgrade no
     3227    if {[macports::global_option_isset ports_revupgrade]} {
     3228        set is_revupgrade yes
     3229    }
     3230    set is_revupgrade_second_run no
     3231    if {[macports::global_option_isset ports_revupgrade_second_run]} {
     3232        set is_revupgrade_second_run yes
    32123233    }
    32133234
     
    32283249    # set portname again since the one we were passed may not have had the correct case
    32293250    set portname $portinfo(name)
     3251    set options(subport) $portname
    32303252
    32313253    set ilist {}
     
    34043426    # at this point we need to check if a different port will be replacing this one
    34053427    if {[info exists portinfo(replaced_by)] && ![info exists options(ports_upgrade_no-replace)]} {
    3406         ui_msg "---> $portname is replaced by $portinfo(replaced_by)"
     3428        ui_msg "$macports::ui_prefix $portname is replaced by $portinfo(replaced_by)"
    34073429        if {[catch {mportlookup $portinfo(replaced_by)} result]} {
    34083430            global errorInfo
     
    34663488            ui_debug "platform mismatch ... upgrading!"
    34673489            set build_override 1
     3490        } elseif {$is_revupgrade_second_run} {
     3491            set build_override 1
     3492        } elseif {$is_revupgrade} {
     3493            # in the first run of rev-upgrade, only activate possibly already existing files and check for missing dependencies
     3494            set will_install yes
    34683495        } else {
    34693496            if {[info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) != $oldvariant} {
     
    34823509    set will_build no
    34833510    # avoid building again unnecessarily
    3484     if {$will_install && ([info exists options(ports_upgrade_force)] || $build_override == 1
    3485         || ![registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)])} {
     3511    if {$will_install &&
     3512        ([info exists options(ports_upgrade_force)]
     3513            || $build_override == 1
     3514            || ![registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)])} {
    34863515        set will_build yes
    34873516    }
    34883517
    34893518    # first upgrade dependencies
    3490     if {![info exists options(ports_nodeps)]} {
     3519    if {![info exists options(ports_nodeps)] && !$is_revupgrade} {
    34913520        set status [_upgrade_dependencies portinfo depscache variationslist options $will_build]
    34923521        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
     
    38453874    }
    38463875}
     3876
     3877proc macports::revupgrade {opts} {
     3878    set run_loop 1
     3879    array set broken_port_counts {}
     3880    while {$run_loop == 1} {
     3881        set run_loop [revupgrade_scanandrebuild broken_port_counts $opts]
     3882    }
     3883    return 0;
     3884}
     3885
     3886# returns 1 if ports were rebuilt and revupgrade_scanandrebuild should be called again
     3887proc revupgrade_scanandrebuild {broken_port_counts_name opts} {
     3888    upvar $broken_port_counts_name broken_port_counts
     3889    array set options $opts
     3890
     3891    set files [registry::file search active 1 binary -null]
     3892    if {[llength $files] > 0} {
     3893        set files_count [llength $files]
     3894        registry::write {
     3895            try {
     3896                ui_msg -nonewline "$macports::ui_prefix Updating database of binaries"
     3897                set i 1
     3898                foreach f $files {
     3899                    if {![macports::ui_isset ports_debug]} {
     3900                        ui_msg -nonewline "\r$macports::ui_prefix Updating database of binaries: [expr $i * 100 / $files_count]%"
     3901                        flush stdout
     3902                    }
     3903                    ui_debug "Updating binary flag for file $i of [llength $files]: [$f path]"
     3904                    incr i
     3905                    $f binary [fileIsBinary [$f path]]
     3906                }
     3907            } catch {*} {
     3908                ui_error "Updating database of binaries failed"
     3909                throw
     3910            }
     3911        }
     3912        ui_msg ""
     3913    }
     3914
     3915    set broken_files {};
     3916    set binaries [registry::file search active 1 binary 1]
     3917    ui_msg -nonewline "$macports::ui_prefix Scanning binaries for linking errors"
     3918    if {[llength $binaries] > 0} {
     3919        set handle [machista::create_handle]
     3920        if {$handle == "NULL"} {
     3921            error "Error creating libmachista handle"
     3922        }
     3923        array unset files_warned_about
     3924        array set files_warned_about [list]
     3925
     3926        set i 1
     3927        set binary_count [llength $binaries]
     3928        foreach b $binaries {
     3929            if {![macports::ui_isset ports_debug]} {
     3930                ui_msg -nonewline "\r$macports::ui_prefix Scanning binaries for linking errors: [expr $i * 100 / $binary_count]%"
     3931                flush stdout
     3932            }
     3933            #ui_debug "$i/[llength $binaries]: [$b path]"
     3934            incr i
     3935
     3936            set resultlist [machista::parse_file $handle [$b path]]
     3937            set returncode [lindex $resultlist 0]
     3938            set result     [lindex $resultlist 1]
     3939
     3940            if {$returncode != $machista::SUCCESS} {
     3941                if {$returncode == $machista::EMAGIC} {
     3942                    # not a Mach-O file
     3943                    # ignore silently, these are only static libs anyway
     3944                    #ui_debug "Error parsing file [$b path]: [machista::strerror $returncode]"
     3945                } else {
     3946                    if {![macports::ui_isset ports_debug]} {
     3947                        ui_msg ""
     3948                    }
     3949                    ui_warn "Error parsing file [$b path]: [machista::strerror $returncode]"
     3950                }
     3951                continue;
     3952            }
     3953
     3954            set architecture [$result cget -mt_archs]
     3955            while {$architecture != "NULL"} {
     3956                if {[info exists options(ports_rev-upgrade_id-loadcmd-check)] && $options(ports_rev-upgrade_id-loadcmd-check) == "yes"} {
     3957                    if {[$architecture cget -mat_install_name] != "NULL" && [$architecture cget -mat_install_name] != ""} {
     3958                        # check if this lib's install name actually refers to this file itself
     3959                        # if this is not the case software linking against this library might have erroneous load commands
     3960                        if {0 == [catch {set idloadcmdpath [revupgrade_handle_special_paths [$b path] [$architecture cget -mat_install_name]]}]} {
     3961                            if {[string index $idloadcmdpath 0] != "/"} {
     3962                                set port [registry::entry owner [$b path]]
     3963                                if {$port != ""} {
     3964                                    set portname [$port name]
     3965                                } else {
     3966                                    set portname "<unknown-port>"
     3967                                }
     3968                                if {![macports::ui_isset ports_debug]} {
     3969                                    ui_msg ""
     3970                                }
     3971                                ui_warn "ID load command in [$b path], arch [machista::get_arch_name [$architecture cget -mat_arch]] (belonging to port $portname) contains relative path"
     3972                            } elseif {![file exists $idloadcmdpath]} {
     3973                                set port [registry::entry owner [$b path]]
     3974                                if {$port != ""} {
     3975                                    set portname [$port name]
     3976                                } else {
     3977                                    set portname "<unknown-port>"
     3978                                }
     3979                                if {![macports::ui_isset ports_debug]} {
     3980                                    ui_msg ""
     3981                                }
     3982                                ui_warn "ID load command in [$b path], arch [machista::get_arch_name [$architecture cget -mat_arch]] refers to non-existant file $idloadcmdpath"
     3983                                ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
     3984                            } else {
     3985   
     3986                                set hash_this [sha256 file [$b path]]
     3987                                set hash_idloadcmd [sha256 file $idloadcmdpath]
     3988   
     3989                                if {$hash_this != $hash_idloadcmd} {
     3990                                    set port [registry::entry owner [$b path]]
     3991                                    if {$port != ""} {
     3992                                        set portname [$port name]
     3993                                    } else {
     3994                                        set portname "<unknown-port>"
     3995                                    }
     3996                                    if {![macports::ui_isset ports_debug]} {
     3997                                        ui_msg ""
     3998                                    }
     3999                                    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"
     4000                                    ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
     4001                                }
     4002                            }
     4003                        }
     4004                    }
     4005                }
     4006                set loadcommand [$architecture cget -mat_loadcmds]
     4007
     4008                while {$loadcommand != "NULL"} {
     4009                    if {0 != [catch {set filepath [revupgrade_handle_special_paths [$b path] [$loadcommand cget -mlt_install_name]]}]} {
     4010                        set loadcommand [$loadcommand cget -next]
     4011                        continue;
     4012                    }
     4013
     4014                    set libresultlist [machista::parse_file $handle $filepath]
     4015                    set libreturncode [lindex $libresultlist 0]
     4016                    set libresult     [lindex $libresultlist 1]
     4017
     4018                    if {$libreturncode != $machista::SUCCESS} {
     4019                        if {![info exists files_warned_about($filepath)]} {
     4020                            if {![macports::ui_isset ports_debug]} {
     4021                                ui_msg ""
     4022                            }
     4023                            ui_warn "Could not open $filepath: [machista::strerror $libreturncode]"
     4024                            set files_warned_about($filepath) yes
     4025                        }
     4026                        if {$libreturncode == $machista::EFILE} {
     4027                            ui_debug "Marking [$b path] as broken"
     4028                            lappend broken_files [$b path]
     4029                        }
     4030                        set loadcommand [$loadcommand cget -next]
     4031                        continue;
     4032                    }
     4033
     4034                    set libarchitecture [$libresult cget -mt_archs]
     4035                    set libarch_found false;
     4036                    while {$libarchitecture != "NULL"} {
     4037                        if {[$architecture cget -mat_arch] != [$libarchitecture cget -mat_arch]} {
     4038                            set libarchitecture [$libarchitecture cget -next]
     4039                            continue;
     4040                        }
     4041
     4042                        if {[$loadcommand cget -mlt_version] != [$libarchitecture cget -mat_version] && [$loadcommand cget -mlt_comp_version] > [$libarchitecture cget -mat_comp_version]} {
     4043                            if {![macports::ui_isset ports_debug]} {
     4044                                ui_msg ""
     4045                            }
     4046                            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]"
     4047                            ui_debug "Marking [$b path] as broken"
     4048                            lappend broken_files [$b path]
     4049                        }
     4050
     4051                        set libarch_found true;
     4052                        break;
     4053                    }
     4054
     4055                    if {$libarch_found == false} {
     4056                        ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file $filepath"
     4057                        if {[path_is_in_prefix $filepath]} {
     4058                            ui_debug "Marking [$b path] as broken"
     4059                            lappend broken_files [$b path]
     4060                        } else {
     4061                            ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file outside prefix referenced from [$b path]"
     4062                            # ui_debug "   How did you get that compiled anyway?"
     4063                        }
     4064                    }
     4065                    set loadcommand [$loadcommand cget -next]
     4066                }
     4067
     4068                set architecture [$architecture cget -next]
     4069            }
     4070        }
     4071        ui_msg ""
     4072
     4073        machista::destroy_handle $handle
     4074
     4075        if {[llength $broken_files] == 0} {
     4076            ui_msg "$macports::ui_prefix No broken files found. :)"
     4077            return 0;
     4078        }
     4079        ui_msg "$macports::ui_prefix Found [llength $broken_files] broken file(s), matching files to ports"
     4080        set broken_ports {}
     4081        set broken_files [lsort -unique $broken_files]
     4082        foreach file $broken_files {
     4083            set port [registry::entry owner $file]
     4084            if {$port == ""} {
     4085                ui_error "Broken file $file doesn't belong to any port."
     4086            }
     4087            lappend broken_ports $port
     4088        }
     4089        set broken_ports [lsort -unique $broken_ports]
     4090
     4091        foreach port $broken_ports {
     4092            if {![info exists broken_port_counts([$port name])]} {
     4093                set broken_port_counts([$port name]) 0
     4094            }
     4095            incr broken_port_counts([$port name])
     4096            if {$broken_port_counts([$port name]) > 3} {
     4097                ui_error "Port [$port name] is still broken after rebuiling it more than 3 times. You might want to file a bug for this."
     4098                error "Port [$port name] still broken after rebuilding [expr $broken_port_counts([$port name]) - 1] time(s)"
     4099            }
     4100        }
     4101
     4102        ui_msg "$macports::ui_prefix Found [llength $broken_ports] broken port(s), determining rebuild order"
     4103        # broken_ports are the nodes in our graph
     4104        # now we need adjacents
     4105        foreach port $broken_ports {
     4106            # initialize with empty list
     4107            set adjlist($port) {}
     4108            set revadjlist($port) {}
     4109        }
     4110
     4111        array set visited {}
     4112        foreach port $broken_ports {
     4113            # stack of broken nodes we've come across
     4114            set stack {}
     4115            lappend stack $port
     4116
     4117            # build graph
     4118            if {![info exists visited($port)]} {
     4119                revupgrade_buildgraph $port stack adjlist revadjlist visited
     4120            }
     4121        }
     4122
     4123        set unsorted_ports $broken_ports
     4124        set topsort_ports {}
     4125        while {[llength $unsorted_ports] > 0} {
     4126            foreach port $unsorted_ports {
     4127                if {[llength $adjlist($port)] == 0} {
     4128                    # this node has no further dependencies
     4129                    # add it to topsorted list
     4130                    lappend topsort_ports $port
     4131                    # remove from unsorted list
     4132                    set index [lsearch -exact $unsorted_ports $port]
     4133                    set unsorted_ports [lreplace $unsorted_ports $index $index]
     4134
     4135                    # remove edges
     4136                    foreach target $revadjlist($port) {
     4137                        set index [lsearch -exact $adjlist($target) $port]
     4138                        set adjlist($target) [lreplace $adjlist($target) $index $index]
     4139                    }
     4140                }
     4141            }
     4142        }
     4143
     4144        ui_msg "$macports::ui_prefix Rebuilding in order"
     4145        foreach port $topsort_ports {
     4146            ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
     4147        }
     4148
     4149        # shared depscache for all ports that are going to be rebuilt
     4150        array set depscache {}
     4151        set status 0
     4152        foreach port $topsort_ports {
     4153            if {![info exists depscache(port:[$port name])]} {
     4154
     4155                # convert variations into the format macports::upgrade needs
     4156                set minusvariant [lrange [split [$port negated_variants] "-"] 1 end]
     4157                set plusvariant  [lrange [split [$port variants]         "+"] 1 end]
     4158                set variants     [list]
     4159                foreach v $minusvariant {
     4160                    lappend variants $v "-"
     4161                }
     4162                foreach v $plusvariant {
     4163                    lappend variants $v "+"
     4164                }
     4165                array unset variations
     4166                array set variations $variants
     4167
     4168                # set rev-upgrade options and nodeps if this is not the first run
     4169                set macports::global_options(ports_revupgrade) "yes"
     4170                unset -nocomplain macports::global_options(ports_nodeps)
     4171                unset -nocomplain macports::global_options(ports_revupgrade_second_run)
     4172                unset -nocomplain macports::global_options(ports_source_only)
     4173                if {$broken_port_counts([$port name]) > 1} {
     4174                    set macports::global_options(ports_revupgrade_second_run) yes
     4175                    set macports::global_options(ports_nodeps) yes
     4176                    # build from source only until the buildbot has some method of rev-upgrade, too
     4177                    set macports::global_options(ports_source_only) yes
     4178                }
     4179
     4180                # call macports::upgrade with ports_revupgrade option to rebuild the port
     4181                set status [macports::upgrade [$port name] "port:[$port name]" \
     4182                    [array get variations] [array get macports::global_options] depscache]
     4183                if {$status != 0} {
     4184                    error "Error rebuilding [$port name]"
     4185                }
     4186            }
     4187        }
     4188
     4189        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
     4190            ui_warn "If this was no dry run, rev-upgrade would now run the checks again to find unresolved and newly created problems"
     4191            return 0
     4192        }
     4193        return 1
     4194    }
     4195
     4196    return 0
     4197}
     4198
     4199# Return whether a path is in the macports prefix
     4200# Usage: path_is_in_prefix path_to_test
     4201# Returns true if the path is in the prefix, false otherwise
     4202proc path_is_in_prefix {path} {
     4203    if {[string first $macports::prefix $path] == 0} {
     4204        return yes
     4205    }
     4206    if {[string first $macports::applications_dir $path] == 0} {
     4207        return yes
     4208    }
     4209    return no
     4210}
     4211
     4212# Function to replace macros in loadcommand paths with their proper values (which are usually determined at load time)
     4213# Usage: revupgrade_handle_special_paths name_of_file path_from_loadcommand
     4214# Returns the corrected path on success or an error in case of failure.
     4215# Note that we can't reliably replace @executable_path, because it's only clear when executing a file where it was executed from.
     4216# Replacing @rpath does not work yet, but it might be possible to get it working using the rpath attribute in the file containing the
     4217# loadcommand
     4218proc revupgrade_handle_special_paths {fname path} {
     4219    set corrected_path $path
     4220
     4221    set loaderpath_idx [string first "@loader_path" $corrected_path]
     4222    if {$loaderpath_idx != -1} {
     4223        set corrected_path [string replace $corrected_path $loaderpath_idx $loaderpath_idx+11 [file dirname $fname]]
     4224    }
     4225
     4226    set executablepath_idx [string first "@executable_path" $corrected_path]
     4227    if {$executablepath_idx != -1} {
     4228        ui_debug "Ignoring loadcommand containing @exectuable_path in $fname"
     4229        error "@exectuable_path in loadcommand"
     4230    }
     4231
     4232    set rpath_idx [string first "@rpath" $corrected_path]
     4233    if {$rpath_idx != -1} {
     4234        ui_debug "Ignoring loadcommand containing @rpath in $fname"
     4235        error "@rpath in loadcommand"
     4236    }
     4237
     4238    return $corrected_path
     4239}
     4240
     4241# Recursively build the dependency graph between broken ports
     4242# Usage: revupgrade_buildgraph start_port name_of_stack name_of_adjacency_list name_of_reverse_adjacency_list name_of_visited_map
     4243proc revupgrade_buildgraph {port stackname adjlistname revadjlistname visitedname} {
     4244    upvar $stackname stack
     4245    upvar $adjlistname adjlist
     4246    upvar $revadjlistname revadjlist
     4247    upvar $visitedname visited
     4248
     4249    ui_debug "Processing port [$port name] @[$port epoch]:[$port version]_[$port revision] [$port variants] [$port negated_variants]"
     4250    set dependent_ports [$port dependents]
     4251    foreach dep $dependent_ports {
     4252        if {[info exists visited($dep)]} {
     4253            continue
     4254        }
     4255        set visited($dep) true
     4256        set is_broken_port false
     4257
     4258        if {[info exists adjlist($dep)]} {
     4259            #ui_debug "Dependency [$dep name] is broken, adding edge from [[lindex $stack 0] name] to [$dep name]"
     4260            #ui_debug "Making [$dep name] new head of stack"
     4261            # $dep is one of the broken ports
     4262            # add an edge to the last broken port in the DFS
     4263            lappend revadjlist([lindex $stack 0]) $dep
     4264            lappend adjlist($dep) [lindex $stack 0]
     4265            # make this port the new last broken port by prepending it to the stack
     4266            set stack [linsert $stack 0 $dep]
     4267           
     4268            set is_broken_port true
     4269        }
     4270        revupgrade_buildgraph $dep stack adjlist revadjlist visited
     4271        if {$is_broken_port} {
     4272            #ui_debug "Removing [$dep name] from stack"
     4273            # remove $dep from the stack
     4274            set stack [lrange $stack 1 end]
     4275        }
     4276    }
     4277}
     4278
  • branches/gsoc11-statistics/base/src/pextlib1.0/Pextlib.c

    r82923 r88412  
    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}
  • branches/gsoc11-statistics/base/src/pextlib1.0/curl.c

    r84763 r88412  
    239239                }
    240240
    241 #if LIBCURL_VERSION_NUM == 0x071307
     241#if LIBCURL_VERSION_NUM >= 0x071304 && LIBCURL_VERSION_NUM <= 0x071307
    242242        /* FTP_PROXY workaround for Snow Leopard */
    243243        if (strncmp(theURL, "ftp:", 4) == 0) {
  • branches/gsoc11-statistics/base/src/pextlib1.0/sha2.c

  • branches/gsoc11-statistics/base/src/pextlib1.0/sha2.h

  • branches/gsoc11-statistics/base/src/pextlib1.0/sha256cmd.c

  • branches/gsoc11-statistics/base/src/pextlib1.0/sha256cmd.h

  • branches/gsoc11-statistics/base/src/port/port.tcl

    r84763 r88412  
    335335
    336336
    337 proc add_to_portlist {listname portentry} {
    338     upvar $listname portlist
     337proc entry_for_portlist {portentry} {
    339338    global global_options global_variations
    340339
    341     # The portlist currently has the following elements in it:
     340    # Each portlist entry currently has the following elements in it:
    342341    #   url             if any
    343342    #   name
     
    367366    }
    368367
    369 
    370368    # Form the fully discriminated portname: portname/version_revison+-variants
    371369    set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
    372370   
    373     # Add it to our portlist
    374     lappend portlist [array get port]
     371    return [array get port]
     372}
     373
     374
     375proc add_to_portlist {listname portentry} {
     376    upvar $listname portlist
     377   
     378    # Form portlist entry and add to portlist
     379    lappend portlist [entry_for_portlist $portentry]
    375380}
    376381
     
    687692# Port selection
    688693##########################################
     694proc unique_results_to_portlist {infos} {
     695    set result {}
     696    array unset unique
     697    foreach {name info} $infos {
     698        array unset portinfo
     699        array set portinfo $info
     700       
     701        array unset entry
     702        array set entry [entry_for_portlist [list url $portinfo(porturl) name $name]]
     703        if {[info exists unique($entry(fullname))]} continue
     704        set unique($entry(fullname)) 1
     705        lappend result [array get entry]
     706    }
     707    return $result
     708}
     709
     710
    689711proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
    690712    if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
     
    693715        fatal "search for portname $pattern failed: $result"
    694716    }
    695 
    696     set results {}
    697     foreach {name info} $res {
    698         array unset portinfo
    699         array set portinfo $info
    700 
    701         #set variants {}
    702         #if {[info exists portinfo(variants)]} {
    703         #   foreach variant $portinfo(variants) {
    704         #       lappend variants $variant "+"
    705         #   }
    706         #}
    707         # For now, don't include version or variants with all ports list
    708         #"$portinfo(version)_$portinfo(revision)"
    709         #$variants
    710         add_to_portlist results [list url $portinfo(porturl) name $name]
    711     }
    712 
     717    set results [unique_results_to_portlist $res]
     718   
    713719    # Return the list of all ports, sorted
    714720    return [portlist_sort $results]
     
    725731            fatal "listing all ports failed: $result"
    726732        }
    727         set results {}
    728         foreach {name info} $res {
    729             array unset portinfo
    730             array set portinfo $info
    731             add_to_portlist results [list url $portinfo(porturl) name $name]
    732         }
    733 
     733        set results [unique_results_to_portlist $res]
    734734        set all_ports_cache [portlist_sort $results]
    735735    }
     
    10521052
    10531053    # open portfile
    1054     if {[catch {set mport [mportopen $porturl [list subport $portname] [array get global_variations]]} result]} {
     1054    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
    10551055        ui_debug "$::errorInfo"
    10561056        return -code error "Unable to open port: $result"
     
    10981098               
    10991099                    # open its portfile
    1100                     if {[catch {set mport [mportopen $porturl [list subport $depname] [array get global_variations]]} result]} {
     1100                    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
    11011101                        ui_debug "$::errorInfo"
    11021102                        ui_error "Unable to open port: $result"
     
    11691169        }
    11701170    }
    1171 
     1171   
    11721172    return $result
    11731173}
     
    14381438
    14391439
    1440 proc opUnion { a b } {
     1440proc unique_entries { entries } {
     1441    # Form the list of all the unique elements in the list a,
     1442    # considering only the port fullname, and taking the first
     1443    # found element first
    14411444    set result {}
    1442    
    1443     # Walk through both lists a and b, adding to result only unique ports
    14441445    array unset unique
    1445     foreach item [concat $a $b] {
     1446    foreach item $entries {
    14461447        array set port $item
    14471448        if {[info exists unique($port(fullname))]} continue
     
    14491450        lappend result $item
    14501451    }
    1451    
    14521452    return $result
     1453}
     1454
     1455
     1456proc opUnion { a b } {
     1457    # Return the unique elements in the combined two lists
     1458    return [unique_entries [concat $a $b]]
    14531459}
    14541460
     
    14711477    array unset bfull
    14721478    set i 0
    1473     foreach bitem $b {
     1479    foreach bitem [unique_entries $b] {
    14741480        array set port $bitem
    14751481        set bfull($port(fullname)) $i
     
    14781484   
    14791485    # Walk through each item in a, matching against b
    1480     foreach aitem $a {
     1486    foreach aitem [unique_entries $a] {
    14811487        array set port $aitem
    14821488       
     
    18871893        }
    18881894        puts -nonewline $separator
     1895        array unset portinfo
    18891896        # If we have a url, use that, since it's most specific
    18901897        # otherwise try to map the portname to a url
     
    18981905                break_softcontinue "Port $portname not found" 1 status
    18991906            }
    1900             array unset portinfo
    19011907            array set portinfo [lindex $result 1]
    19021908            set porturl $portinfo(porturl)
     
    19151921            }
    19161922            if {![info exists options(subport)]} {
    1917                 set options(subport) $portname
     1923                if {[info exists portinfo(name)]} {
     1924                    set options(subport) $portinfo(name)
     1925                } else {
     1926                    set options(subport) $portname
     1927                }
    19181928            }
    19191929 
     
    22402250    set status 0
    22412251    foreachport $portlist {
     2252        array unset portinfo
    22422253        if {$porturl eq ""} {
    22432254            # Look up the port.
     
    22522263
    22532264            # Retrieve the port's URL.
    2254             array unset portinfo
    22552265            array set portinfo [lindex $result 1]
    22562266            set porturl $portinfo(porturl)
     
    22672277        }
    22682278        if {![info exists options(subport)]} {
    2269             set options(subport) $portname
     2279            if {[info exists portinfo(name)]} {
     2280                set options(subport) $portinfo(name)
     2281            } else {
     2282                set options(subport) $portname
     2283            }
    22702284        }
    22712285
     
    25592573        return 1
    25602574    }
     2575
    25612576    # shared depscache for all ports in the list
    25622577    array set depscache {}
     
    25742589    if {$status != 0} {
    25752590        print_tickets_url
    2576     }
    2577 
     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    }
    25782606    return $status
    25792607}
     
    29102938            set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
    29112939        }
    2912        
     2940
     2941        array unset portinfo
    29132942        # If we have a url, use that, since it's most specific
    29142943        # otherwise try to map the portname to a url
     
    29222951                break_softcontinue "Port $portname not found" 1 status
    29232952            }
    2924             array unset portinfo
    29252953            array set portinfo [lindex $result 1]
    29262954            set porturl $portinfo(porturl)
     
    29412969                break_softcontinue "Portdir $portdir not found" 1 status
    29422970            }
    2943             array unset portinfo
    29442971            array set portinfo [lindex $result 1]
    29452972        }
     
    29562983            }
    29572984            if {![info exists options(subport)]} {
    2958                 set options(subport) $portname
     2985                if {[info exists portinfo(name)]} {
     2986                    set options(subport) $portinfo(name)
     2987                } else {
     2988                    set options(subport) $portname
     2989                }
    29592990            }
    29602991            if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
     
    30363067                    array set portinfo [lindex $result 1]
    30373068                    set porturl $portinfo(porturl)
    3038                     set options(subport) $depname
     3069                    set options(subport) $portinfo(name)
    30393070                   
    30403071                    # open the portfile if requested
     
    34783509    }
    34793510    foreachport $portlist {
     3511        array unset portinfo
    34803512        if {$porturl eq ""} {
    34813513            # look up port
     
    34893521            }
    34903522
    3491             array unset portinfo
    34923523            array set portinfo [lindex $result 1]
    34933524
     
    34983529        if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
    34993530            if {![info exists options(subport)]} {
    3500                 set options(subport) $portname
     3531                if {[info exists portinfo(name)]} {
     3532                    set options(subport) $portinfo(name)
     3533                } else {
     3534                    set options(subport) $portname
     3535                }
    35013536            }
    35023537            if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
     
    39934028    }
    39944029    foreachport $portlist {
     4030        array unset portinfo
    39954031        # If we have a url, use that, since it's most specific
    39964032        # otherwise try to map the portname to a url
     
    40114047                }
    40124048            }
    4013             array unset portinfo
    40144049            array set portinfo [lindex $res 1]
    40154050            set porturl $portinfo(porturl)
     
    40464081        }
    40474082        if {![info exists options(subport)]} {
    4048             set options(subport) $portname
     4083            if {[info exists portinfo(name)]} {
     4084                set options(subport) $portinfo(name)
     4085            } else {
     4086                set options(subport) $portname
     4087            }
    40494088        }
    40504089        if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
     
    41534192    \
    41544193    upgrade     [list action_upgrade        [ACTION_ARGS_PORTS]] \
     4194    rev-upgrade [list action_revupgrade     [ACTION_ARGS_NONE]] \
    41554195    \
    41564196    version     [list action_version        [ACTION_ARGS_NONE]] \
     
    43164356    select      {list set show}
    43174357    log         {{phase 1} {level 1}}
    4318     upgrade     {force enforce-variants no-replace}
     4358    upgrade     {force enforce-variants no-replace no-rev-upgrade}
     4359    rev-upgrade {id-loadcmd-check}
    43194360}
    43204361
     
    43224363# Checks whether the given option is valid
    43234364#
    4324 # œparam action for which action
     4365# @param action for which action
    43254366# @param option the prefix of the option to check
    43264367# @return list of pairs {name argc} for all matching options
  • branches/gsoc11-statistics/base/src/port1.0/port_autoconf.tcl.in

    r82923 r88412  
    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@"
  • branches/gsoc11-statistics/base/src/port1.0/portchecksum.tcl

    r84763 r88412  
    222222    set checksums_str [option checksums]
    223223
     224    # store the calculated checksums to avoid repeated calculations
     225    set sums ""
     226
    224227    # if everything is fine with the syntax, keep on and check the checksum of
    225228    # the distfiles.
     
    240243            }
    241244
     245            if {[llength $all_dist_files] > 1} {
     246                lappend sums $distfile
     247            }
     248
    242249            # check that there is at least one checksum for the distfile.
    243250            if {![info exists checksums_array($distfile)] || [llength $checksums_array($distfile)] < 1} {
    244251                ui_error "[format [msgcat::mc "No checksum set for %s"] $distfile]"
    245252                set fail yes
     253
     254                # no checksums specified; output the default set
     255                foreach type $default_checksum_types {
     256                    lappend sums [format "%-8s%s" $type [calc_$type $fullpath]]
     257                }
     258
    246259            } else {
    247260                # retrieve the list of types/values from the array.
     
    251264                foreach {type sum} $portfile_checksums {
    252265                    set calculated_sum [calc_$type $fullpath]
     266                    lappend sums [format "%-8s%s" $type $calculated_sum]
    253267                    if {[string equal $sum $calculated_sum]} {
    254268                        ui_debug "[format [msgcat::mc "Correct (%s) checksum for %s"] $type $distfile]"
     
    279293
    280294        # Show the desired checksum line for easy cut-paste
    281         set sums ""
    282         foreach distfile $all_dist_files {
    283             if {[llength $all_dist_files] > 1} {
    284                 lappend sums $distfile
    285             }
    286 
    287             set fullpath [file join $distpath $distfile]
    288             if {![file isfile $fullpath] && (!$usealtworkpath && [file isfile "${altprefix}${fullpath}"])} {
    289                 set fullpath "${altprefix}${fullpath}"
    290             }
    291             if {![info exists checksums_array($distfile)] || [llength $checksums_array($distfile)] < 1} {
    292                 # no checksums specified; output the default set
    293                 foreach type $default_checksum_types {
    294                     lappend sums [format "%-8s%s" $type [calc_$type $fullpath]]
    295                 }
    296             } else {
    297                 # output just the types that were already used
    298                 foreach {type sum} $checksums_array($distfile) {
    299                     lappend sums [format "%-8s%s" $type [calc_$type $fullpath]]
    300                 }
    301             }
    302         }
    303295        ui_info "The correct checksum line may be:"
    304296        ui_info [format "%-20s%s" "checksums" [join $sums [format " \\\n%-20s" ""]]]
  • branches/gsoc11-statistics/base/src/port1.0/portconfigure.tcl

    r82923 r88412  
    202202        llvm-gcc-4.2 { set name "Mac OS X llvm-gcc 4.2" }
    203203        clang { set name "Mac OS X clang" }
    204         apple-gcc-3.3 { set name "MacPorts Apple gcc 3.3" }
    205204        apple-gcc-4.0 { set name "MacPorts Apple gcc 4.0" }
    206205        apple-gcc-4.2 { set name "MacPorts Apple gcc 4.2" }
     206        macports-gcc     { set name "MacPorts gcc (port select)" }
    207207        macports-gcc-4.0 { set name "MacPorts gcc 4.0" }
    208208        macports-gcc-4.1 { set name "MacPorts gcc 4.1" }
     
    213213        macports-gcc-4.6 { set name "MacPorts gcc 4.6" }
    214214        macports-llvm-gcc-4.2 { set name "MacPorts llvm-gcc 4.2" }
    215         macports-clang { set name "MacPorts clang" }
     215        macports-clang { set name "MacPorts clang (port select)" }
     216        macports-clang-2.9 { set name "MacPorts clang 2.9" }
     217        macports-clang-3.0 { set name "MacPorts clang 3.0" }
     218        macports-clang-3.1 { set name "MacPorts clang 3.1" }
    216219        default { return -code error "Invalid value for configure.compiler" }
    217220    }
     
    434437            }
    435438        }
    436         apple-gcc-3.3 {
    437             switch -exact ${type} {
    438                 cc  { set ret ${prefix}/bin/gcc-apple-3.3 }
    439                 cpp { set ret ${prefix}/bin/cpp-apple-3.3 }
    440             }
    441         }
    442439        apple-gcc-4.0 {
    443440            switch -exact ${type} {
     
    453450                cpp  { set ret ${prefix}/bin/cpp-apple-4.2 }
    454451                cxx  { set ret ${prefix}/bin/g++-apple-4.2 }
     452            }
     453        }
     454        macports-gcc {
     455            switch -exact ${type} {
     456                cc   { set ret ${prefix}/bin/gcc }
     457                objc { set ret ${prefix}/bin/gcc }
     458                cxx  { set ret ${prefix}/bin/g++ }
     459                cpp  { set ret ${prefix}/bin/cpp }
     460                fc   { set ret ${prefix}/bin/gfortran }
     461                f77  { set ret ${prefix}/bin/gfortran }
     462                f90  { set ret ${prefix}/bin/gfortran }
    455463            }
    456464        }
     
    548556                objc { set ret ${prefix}/bin/clang }
    549557                cxx  { set ret ${prefix}/bin/clang++ }
     558            }
     559        }
     560        macports-clang-2.9 {
     561            switch -exact ${type} {
     562                cc   { set ret ${prefix}/bin/clang-mp-2.9 }
     563                objc { set ret ${prefix}/bin/clang-mp-2.9 }
     564                cxx  { set ret ${prefix}/bin/clang++-mp-2.9 }
     565            }
     566        }
     567        macports-clang-3.0 {
     568            switch -exact ${type} {
     569                cc   { set ret ${prefix}/bin/clang-mp-3.0 }
     570                objc { set ret ${prefix}/bin/clang-mp-3.0 }
     571                cxx  { set ret ${prefix}/bin/clang++-mp-3.0 }
     572            }
     573        }
     574        macports-clang-3.1 {
     575            switch -exact ${type} {
     576                cc   { set ret ${prefix}/bin/clang-mp-3.1 }
     577                objc { set ret ${prefix}/bin/clang-mp-3.1 }
     578                cxx  { set ret ${prefix}/bin/clang++-mp-3.1 }
    550579            }
    551580        }
  • branches/gsoc11-statistics/base/src/port1.0/portlint.tcl

    r84763 r88412  
    293293    global maintainers license homepage master_sites checksums patchfiles
    294294    global depends_fetch depends_extract depends_lib depends_build depends_run distfiles fetch.type
     295    global livecheck.type subport name
    295296   
    296297    global lint_portsystem lint_platforms
     
    502503    }
    503504
    504     if {[string match "unknown" $license]} {
    505         ui_error "$license license"
    506         incr errors
     505    if {$license == "unknown"} {
     506        ui_warn "no license set"
     507        incr warnings
     508    } else {
     509
     510        # If maintainer set license, it must follow correct format
     511
     512        set prev ''
     513        foreach test [split [string map { \{ '' \} ''} $license] '\ '] {
     514            ui_debug "Checking format of license '${test}'"
     515
     516            # space instead of hyphen
     517            if {[string is double -strict $test]} {
     518                ui_error "Invalid license '${prev} ${test}': missing hyphen between ${prev} ${test}"
     519
     520            # missing hyphen
     521            } elseif {![string equal -nocase "X11" $test]} {
     522                foreach subtest [split $test '-'] {
     523                    ui_debug "testing ${subtest}"
     524
     525                    # license names start with letters: versions and empty strings need not apply
     526                    if {[string is alpha -strict [string index $subtest 0]]} {
     527
     528                        # if the last character of license name is a number or plus sign
     529                        # then a hyphen is missing
     530                        set license_end [string index $subtest end]
     531                        if {[string equal "+" $license_end] || [string is integer -strict $license_end]} {
     532                            ui_error "invalid license '${test}': missing hyphen before version"
     533                        }
     534                    }
     535                }
     536            }
     537
     538            # BSD-2 => BSD
     539            if {[string equal -nocase "BSD-2" $test]} {
     540                ui_error "Invalid license '${test}': use BSD instead"
     541            }
     542   
     543            # BSD-3 => BSD
     544            if {[string equal -nocase "BSD-3" $test]} {
     545                ui_error "Invalid license '${test}': use BSD instead"
     546            }
     547   
     548            # BSD-4 => BSD-old
     549            if {[string equal -nocase "BSD-4" $test]} {
     550                ui_error "Invalid license '${test}': use BSD-old instead"
     551            }
     552   
     553            set prev $test
     554        }
     555
     556    }
     557
     558    if {$subport != $name && ${livecheck.type} != "none"} {
     559        ui_warn "livecheck set for subport $subport"
    507560    }
    508561
  • branches/gsoc11-statistics/base/src/port1.0/portlivecheck.tcl

    r82923 r88412  
    170170                    set foundmatch 0
    171171                    while {[gets $chan line] >= 0} {
    172                         if {[regexp $the_re $line matched upver]} {
     172                        set lastoff 0
     173                        while {[regexp -start $lastoff -indices $the_re $line offsets]} {
     174                            regexp -start $lastoff $the_re $line matched upver
    173175                            set foundmatch 1
    174176                            if {$updated_version == 0 || [vercmp $upver $updated_version] > 0} {
     
    176178                            }
    177179                            ui_debug "The regex matched \"$matched\", extracted \"$upver\""
     180                            lassign $offsets firstoff lastoff
    178181                        }
    179182                    }
  • branches/gsoc11-statistics/base/src/port1.0/portutil.tcl

    r84763 r88412  
    400400    }
    401401
     402    # When building, g-ir-scanner should not save its cache to $HOME
     403    # See: https://trac.macports.org/ticket/26783
     404    set ${command}.env_array(GI_SCANNER_DISABLE_CACHE) "1"
     405
    402406    # Debug that.
    403407    ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
     
    782786        lappend PortInfo(subports) $subname
    783787    }
    784     if {$subname == $subport} {
     788    if {[string equal -nocase $subname $subport]} {
    785789        set PortInfo(name) $subname
    786790        uplevel 1 $body
     
    27542758        if {$xcodeversion == "none"} {
    27552759            ui_warn "Xcode does not appear to be installed; most ports will likely fail to build."
     2760            if {[file exists "/Applications/Install XCode.app"]} {
     2761                ui_warn "You downloaded Xcode from the Mac App Store but didn't install it. Run \"Install Xcode\" in the /Applications folder."
     2762            }
    27562763        } elseif {[vercmp $xcodeversion $min] < 0} {
    27572764            ui_error "The installed version of Xcode (${xcodeversion}) is too old to use on the installed OS version. Version $rec or later is recommended on Mac OS X ${macosx_version}."
  • branches/gsoc11-statistics/base/src/registry2.0/Makefile

    r82923 r88412  
    44OBJS = registry.o util.o \
    55        entry.o entryobj.o \
     6        file.o fileobj.o \
    67        ../cregistry/cregistry.a
    78        #graph.o graphobj.o
  • branches/gsoc11-statistics/base/src/registry2.0/entry.c

    r70608 r88412  
    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;
  • branches/gsoc11-statistics/base/src/registry2.0/portimage.tcl

    r84763 r88412  
    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 {
  • branches/gsoc11-statistics/base/src/registry2.0/portuninstall.tcl

    r79672 r88412  
    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
  • branches/gsoc11-statistics/base/src/registry2.0/receipt_flat.tcl

    r79672 r88412  
    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        }
  • branches/gsoc11-statistics/base/src/registry2.0/receipt_sqlite.tcl

  • branches/gsoc11-statistics/base/src/registry2.0/registry.c

    r70608 r88412  
    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;
  • branches/gsoc11-statistics/base/src/registry2.0/registry.tcl

    r79672 r88412  
    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
  • branches/gsoc11-statistics/base/src/registry2.0/util.c

    r66019 r88412  
    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}
  • branches/gsoc11-statistics/base/src/registry2.0/util.h

    r28029 r88412  
    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.