X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2FCommods.pm;h=e63126ace25bb25fa65006d4e028bc4c0154969b;hp=372fe16f51544081e9378d68563a91a5b38868df;hb=1f6f88af87868d6e059be154ed6b56dd9ea7ac6c;hpb=6302552bfa5844eddb7c26386c9995733f0a5174 diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index 372fe16..e63126a 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -22,6 +22,7 @@ package Commods; use IO::File; +use IO::Pipe; use HTTP::Request::Common (); use POSIX; use LWP::UserAgent; @@ -45,13 +46,40 @@ BEGIN { &pipethrough_run_gzip &http_useragent &version_core &http_useragent_string_map &cgipostform &yarrgpostform &cgi_get_caller - &set_ctype_utf8 $masterinfoversion); + &set_ctype_utf8 $masterinfoversion + &source_tarball); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } -our $masterinfoversion= 2; # version we understand +our $masterinfoversion= 2; # version we understand. +# +# To extend the source-info.txt format: +# +# * Commods.pm:parse_info1 +# add code to parse new version +# +# * source-info.txt +# add new information +# +# If new data should NOT be in master-info.txt too: +# +# * update-master-info:process_some_info +# check that code for converting source-info to master-info +# removes the extra info; add code to remove it if necessary +# +# * db-idempotent-populate +# if database schema is extended, add code to copy data +# +# If new data DOES need to be in master-info.txt too: +# +# * Commods.pm:$masterinfoversion +# increment +# +# * update-master-info:process_some_info +# add code to convert new version to old, by removing +# extra info conditionally depending on version our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources; our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ]; @@ -205,6 +233,7 @@ sub fetch_with_rsync ($) { sub parse_info_serverside () { parse_info1('source-info.txt','s',0); + parse_info1('tree-info.txt','t',1); } sub parse_info_serverside_ocean ($) { my ($oceanname) = @_; @@ -409,4 +438,38 @@ sub http_useragent ($) { return $ua; } +sub source_tarball ($$) { + my ($sourcebasedir,$spitoutfn) = @_; + + my $pipe= new IO::Pipe or die $!; + my $pid= fork(); defined $pid or die $!; + if (!$pid) { + $ENV{'YPPSC_YARRG_SRCBASE'}= $sourcebasedir; + $pipe->writer(); + exec '/bin/sh','-c',' + cd -P "$YPPSC_YARRG_SRCBASE" + ( + git-ls-files -z; + git-ls-files -z --others --exclude-from=.gitignore; + if test -d .git; then find .git -print0; fi + ) | ( + cpio -Hustar -o --quiet -0 -R 1000:1000 || \ + cpio -Hustar -o --quiet -0 + ) | gzip + '; + die $!; + } + $pipe->reader(); + + my ($d, $l); + while ($l= read $pipe, $d, 65536) { + $spitoutfn->($d); + } + waitpid $pid,0; + defined $l or die "read pipe $!"; + $pipe->error and die "pipe error $!"; + close $pipe; + # deliberately ignore errors +} + 1;