Backup

Check-in [528ecddc14]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Extended sfpull to be able to deal with multiple repositories in a project. Also fixed the bug where it might try to use a repository type not used by the project (class=disabled in the HTML).
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:528ecddc144942d7b27e2c85e3c1dca0c08704ab
User & Date: aku 2011-02-18 18:35:27
Context
2011-02-28
20:05
Added the new fossil repositories for Tcl/Tk core, tdbc, and tclws check-in: 14b3c7db8d user: aku tags: trunk
2011-02-18
18:35
Extended sfpull to be able to deal with multiple repositories in a project. Also fixed the bug where it might try to use a repository type not used by the project (class=disabled in the HTML). check-in: 528ecddc14 user: aku tags: trunk
2011-02-14
18:49
Added support for mercurial repositories, and demo set of such. check-in: 0a5de9df32 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to bin/sfpull.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
..
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

















115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
303
304
305
306
307
308
309
















310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
...
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
...
527
528
529
530
531
532
533


534





535
536
537
538
539
540
541
542
543
544
545
546
proc main {} {
    initialize;# Required for verify_project, in the commandline.
    if {![commandline]} usage
    save_config \
	[pull_attachments [pull_tracker]] \
	[pull_mailinglists] \
	[pull_website] \
	[pull_repository]
    return
}

proc commandline {} {
    global argv
    if {[llength $argv] != 4} { return 0 }

................................................................................
proc save_config {tracker mlists website repository} {
    # tracker    = name of the tracker XML file
    # website    = name of the website directory, if any.
    # repository = name of repository directory.
    # mlists ... = lists containing the names of all project mailing
    #              lists, if any.

    global thedestination theproject thepid therepotype theuser

    foreach {tracker attachments} $tracker break

    set tmp {}
    foreach {name archive} $mlists {
	lappend tmp $name [JsonString $archive]
    }
    set mlists $tmp

    file mkdir $thedestination
    array set config { aligned 1 indented 1 }

















    fileutil::writeFile $thedestination/Configuration \
	[JsonObject \
	     configuration-version [JsonString 1] \
	     project        [JsonString $theproject] \
	     origin         [JsonString SourceForge] \
	     origin-url     [JsonString http://sourceforge.net/projects/$theproject] \
	     origin-id      [JsonString $thepid] \
	     exporter       [JsonString $theuser] \
	     tracker        [JsonString $tracker] \
	     attachments    [JsonString $attachments] \
	     mailinglists   [JsonObjectDict $mlists] \
	     website        [JsonString $website] \
	     repository     [JsonObject \
				 type  [JsonString $therepotype] \
				 where [JsonString $repository] \
				] \
	     ]\n
    return
}

proc pull_tracker {} {
    global thepid
    variable attachments
................................................................................
    log_barber_pole_done

    # Get rid of the temp configuration.
    file delete $config
    return $dst
}

















proc pull_repository {} {
    global therepotype theproject thedestination

    log Retrieving project $therepotype repository...

    # Note: This is the only part of the project where no
    # authentication is required. I.e. this is something anybody can
    # do, for any project.

    if {$therepotype eq "svn"} {
	set root $therepotype
    } else {
	# cvs, hg, git, bzr
	set root ${therepotype}root
    }

    set src ${theproject}.${therepotype}.sourceforge.net::$root/$theproject/*
    set dst Repository

    file mkdir $thedestination

    log_barber_pole_start
    exp_log_user 0
    exp_spawn rsync -avP $src $thedestination/$dst
    expect {
	"*\r" {
	    log_barber_pole
................................................................................
	}
    }
}

# ### ### ### ######### ######### #########

proc verify_project {} {
    global theproject thepid therepotype

    set url http://sourceforge.net/projects/$theproject/

    puts "Get project id of $url..."

    set token [http::geturl $url]
    set data  [http::data $token]
................................................................................
    # HTML. It is however a page requiring login.

    set url  https://sourceforge.net/project/admin/public_info.php?group_id=$thepid
    set tmp  [pull-with-cookie-login $url public_info.html]
    set data [fileutil::cat $tmp]

    set pattern "scm/\\?type=(\[^&\]+)"


    if {![regexp $pattern $data -> therepotype]} {





	log "Project $theproject : Unable to determine repository type"
	return -code error FAIL/type
    }

    log "Project $theproject = $thepid ($therepotype)"
    return
}

proc pull-with-cookie-login {url file} {
    global thedestination

    variable thecookies







|







 







|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












|
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|

|





|
|


|


|
<

|







 







|







 







>
>
|
>
>
>
>
>
|
|


|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
..
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144



145
146
147
148
149
150
151
...
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364
365
...
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
...
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
proc main {} {
    initialize;# Required for verify_project, in the commandline.
    if {![commandline]} usage
    save_config \
	[pull_attachments [pull_tracker]] \
	[pull_mailinglists] \
	[pull_website] \
	[pull_repositories]
    return
}

proc commandline {} {
    global argv
    if {[llength $argv] != 4} { return 0 }

................................................................................
proc save_config {tracker mlists website repository} {
    # tracker    = name of the tracker XML file
    # website    = name of the website directory, if any.
    # repository = name of repository directory.
    # mlists ... = lists containing the names of all project mailing
    #              lists, if any.

    global thedestination theproject thepid therepotypes theuser

    foreach {tracker attachments} $tracker break

    set tmp {}
    foreach {name archive} $mlists {
	lappend tmp $name [JsonString $archive]
    }
    set mlists $tmp

    file mkdir $thedestination
    array set config { aligned 1 indented 1 }

    if {[llength $therepotypes] == 1} {
	set repository [JsonObject \
			    type  [JsonString [lindex $therepotypes 0]] \
			    where [JsonString $repository]]
    } elseif {[llength $therepotypes]} {
	set dict {}
	foreach r $therepotypes {
	    lappend dict $r [JsonString $repository/$r]
	}	
	set repository [JsonObject \
			    types [JsonString $therepotypes] \
			    where [JsonObjectDict $dict]]
    } else {
	set repository {}
    }

    fileutil::writeFile $thedestination/Configuration \
	[JsonObject \
	     configuration-version [JsonString 1] \
	     project        [JsonString $theproject] \
	     origin         [JsonString SourceForge] \
	     origin-url     [JsonString http://sourceforge.net/projects/$theproject] \
	     origin-id      [JsonString $thepid] \
	     exporter       [JsonString $theuser] \
	     tracker        [JsonString $tracker] \
	     attachments    [JsonString $attachments] \
	     mailinglists   [JsonObjectDict $mlists] \
	     website        [JsonString $website] \
	     repository     $repository \



	     ]\n
    return
}

proc pull_tracker {} {
    global thepid
    variable attachments
................................................................................
    log_barber_pole_done

    # Get rid of the temp configuration.
    file delete $config
    return $dst
}

proc pull_repositories {} {
    global therepotypes

    set dst Repository

    if {[llength $therepotypes] == 1} {
	pull_repository [lindex $therepotypes 0] $dst
    } else {
	foreach t $therepotypes {
	    pull_repository $t $dst/$t
	}
    }

    return $dst
}

proc pull_repository {type dst} {
    global theproject thedestination

    log Retrieving project $type repository...

    # Note: This is the only part of the project where no
    # authentication is required. I.e. this is something anybody can
    # do, for any project.

    if {$type eq "svn"} {
	set root $type
    } else {
	# cvs, hg, git, bzr
	set root ${type}root
    }

    set src ${theproject}.${type}.sourceforge.net::$root/$theproject/*


    file mkdir [file dirname $thedestination/$dst]

    log_barber_pole_start
    exp_log_user 0
    exp_spawn rsync -avP $src $thedestination/$dst
    expect {
	"*\r" {
	    log_barber_pole
................................................................................
	}
    }
}

# ### ### ### ######### ######### #########

proc verify_project {} {
    global theproject thepid therepotypes

    set url http://sourceforge.net/projects/$theproject/

    puts "Get project id of $url..."

    set token [http::geturl $url]
    set data  [http::data $token]
................................................................................
    # HTML. It is however a page requiring login.

    set url  https://sourceforge.net/project/admin/public_info.php?group_id=$thepid
    set tmp  [pull-with-cookie-login $url public_info.html]
    set data [fileutil::cat $tmp]

    set pattern "scm/\\?type=(\[^&\]+)"
    set therepotypes {}
    foreach line [split $data \n] {
	if {![regexp $pattern $line -> repotype]} continue
	if {[regexp disabled $line]} continue
	lappend therepotypes $repotype
    }

    if {![llength $therepotypes]} {
	log "Project $theproject = $thepid (WARNING No repositories found)"
	#return -code error FAIL/type
    }

    log "Project $theproject = $thepid ($therepotypes)"
    return
}

proc pull-with-cookie-login {url file} {
    global thedestination

    variable thecookies