source: subversion/applications/utils/packaging/build-cluster.pl @ 18390

Last change on this file since 18390 was 17755, checked in by joerg, 11 years ago

Add Ubuntu jaunty karmic; improve dependency handling(remove version information); remove gpsdrive-data-maps-2.10pre7 from default build;

File size: 54.8 KB
Line 
1#!/usr/bin/perl
2
3=pod
4
5=head1 build-cluster
6
7Build_Cluster is a system to build various Debian Based Packages
8we expect a chroot environment to already be setup in order to
9then be able to do the debuild commands inside these.
10
11
12Show a summary of all results. This also looks for cached results.
13
14=cut
15
16package BuildTask;
17
18use strict;
19use warnings;
20
21use Data::Dumper;
22use File::Basename;
23use File::Copy;
24use File::Find;
25use File::Path;
26use File::Slurp qw( slurp write_file read_file append_file) ;
27use Getopt::Long;
28use Getopt::Std;
29use IO::Select;
30use IO::File;
31use IPC::Open3;
32use Pod::Usage;
33use Symbol;
34
35my $dir_chroot = "/home/chroot";
36my $dir_log = "/home/chroot/log";
37my $dir_svn = "$dir_chroot/svn";
38my $package_result_dir = "$dir_chroot/results";
39my $package_result_upload_dir = "/home/httpd/gpsdrive.de"; #This is the upload Directory
40my $user = "tweety";
41my $DEBUG   = 0;
42my $VERBOSE = 1;
43my $MANUAL=0;
44my $HELP=0;
45my $FORCE=0;
46
47my $do_svn_up=1;
48my $do_svn_co=1;
49my $do_svn_changelog = 1;
50my $do_svn_cp= 1;
51my $do_show_results=0;
52my $do_write_html_results_only=0;
53my $do_chk_dep=1;
54my $do_debuild=1;
55my $RESULTS={};
56
57my $do_fast= 1; # Skip Stuff like debuild clean, ...
58
59delete $ENV{http_proxy};
60delete $ENV{HTTP_PROXY};
61$ENV{LANG}="C";
62$ENV{DEB_BUILD_OPTIONS}="parallel=4";
63
64
65# define Colors
66my $ESC="\033";
67my %COLOR;
68$COLOR{RED}="${ESC}[91m";
69$COLOR{GREEN}="${ESC}[92m";
70$COLOR{YELLOW}="${ESC}[93m";
71$COLOR{BLUE}="${ESC}[94m";
72$COLOR{MAGENTA}="${ESC}[95m";
73$COLOR{CYAN}="${ESC}[96m";
74$COLOR{WHITE}="${ESC}[97m";
75$COLOR{BG_RED}="${ESC}[41m";
76$COLOR{BG_GREEN}="${ESC}[42m";
77$COLOR{BG_YELLOW}="${ESC}[43m";
78$COLOR{BG_BLUE}="${ESC}[44m";
79$COLOR{BG_MAGENTA}="${ESC}[45m";
80$COLOR{BG_CYAN}="${ESC}[46m";
81$COLOR{BG_WHITE}="${ESC}[47m";
82$COLOR{BRIGHT}="${ESC}[01m";
83$COLOR{UNDERLINE}="${ESC}[04m";
84$COLOR{BLINK}="${ESC}[05m";
85$COLOR{REVERSE}="${ESC}[07m";
86$COLOR{NORMAL}="${ESC}[0m";
87
88
89# Platform is a combination of "Distribution - Revision - 32/64Bit"
90#    debian-etch-32
91#    debian-etch-64
92my @available_platforms= qw(
93    debian-squeeze-64   debian-squeeze-32
94    debian-lenny-64     debian-lenny-32
95    ubuntu-hardy-64     ubuntu-hardy-32
96    ubuntu-intrepid-64  ubuntu-intrepid-32
97    ubuntu-jaunty-64    ubuntu-jaunty-32
98    ubuntu-karmic-64    ubuntu-karmic-32
99);
100
101#    ubuntu-gutsy-64    ubuntu-gutsy-32
102
103my @default_platforms= qw(
104    debian-squeeze-64
105    debian-squeeze-32
106    ubuntu-hardy-64
107);
108@default_platforms= @available_platforms;
109
110my @platforms;
111
112my %proj2path=(
113    'gpsdrive-maemo'    => 'gpsdrive/contrib/maemo',
114    'gpsdrive-data-maps'=> 'gpsdrive/data/maps',
115    'gpsdrive'          => 'gpsdrive',
116    'gpsdrive-2.10pre7' => 'gpsdrive-2.10pre7',
117    'gpsdrive-data-maps-2.10pre7'=> 'gpsdrive-2.10pre7/data/maps',
118    'opencarbox'        => 'opencarbox',
119    'mod_tile'          => 'openstreetmap-applications/utils/mod_tile',
120    'osm2pgsql'         => 'openstreetmap-applications/utils/export/osm2pgsql',
121    'merkaartor'        => 'openstreetmap-applications/editors/merkaartor',
122    'josm'              => 'openstreetmap-applications/editors/josm',
123    'osm-utils'         => 'openstreetmap-applications/utils',
124    'osm-mapnik-world-boundaries'       => 'openstreetmap-applications/rendering/mapnik/openstreetmap-mapnik-world-boundaries',
125    'osm-mapnik-data'   => 'openstreetmap-applications/rendering/mapnik/openstreetmap-mapnik-data',
126    'map-icons'         => 'openstreetmap-applications/share/map-icons',
127    'osmosis'           => 'openstreetmap-applications/utils/osmosis/trunk',
128    'gosmore'           => 'openstreetmap-applications/rendering/gosmore',
129
130    'merkaartor-0.12'   => 'openstreetmap-applications/editors/merkaartor-branches/merkaartor-0.12-fixes',
131    'merkaartor-0.11'   => 'openstreetmap-applications/editors/merkaartor-branches/merkaartor-0.11-fixes',
132    'merkaartor-0.13'   => 'openstreetmap-applications/editors/merkaartor-branches/merkaartor-0.13-fixes',
133#    'osm-editor'       => 'openstreetmap-applications/editors/osm-editor',
134    'osm-editor-qt3'    => 'openstreetmap-applications/editors/osm-editor/qt3',
135    'osm-editor-qt4'    => 'openstreetmap-applications/editors/osm-editor/qt4',
136    );
137
138my %proj2debname=(
139    'gpsdrive-maemo'    => 'gpsdrive',
140    'gpsdrive-data-maps'=> 'gpsdrive-data-maps',
141    'gpsdrive'          => 'gpsdrive',
142    'gpsdrive-2.10pre5' => 'gpsdrive',
143    'gpsdrive-2.10pre7' => 'gpsdrive',
144    'gpsdrive-data-maps-2.10pre7'=> 'gpsdrive-data-maps',
145    'opencarbox'        => 'opencarbox',
146    'osm2pgsql'         => 'osm2pgsql',
147    'mod_tile'          => 'libapache2-mod-tile',
148    'merkaartor'        => 'merkaartor',
149    'josm'              => 'openstreetmap-josm',
150    'osm-utils'         => 'openstreetmap-utils',
151    'osm-mapnik-world-boundaries'       => 'openstreetmap-mapnik-world-boundaries',
152    'osm-mapnik-data'   => 'openstreetmap-mapnik-data',
153    'map-icons'         => 'openstreetmap-map-icons',
154    'osmosis'           => 'osmosis',
155    'gosmore'           => 'openstreetmap-gosmore',
156
157    'merkaartor-0.12'   => 'merkaartor-0.12-fixes',
158    'merkaartor-0.11'   => 'merkaartor-0.11-fixes',
159    'merkaartor-0.13'   => 'merkaartor-0.13-fixes',
160#    'osm-editor'       => 'openstreetmap-editor',
161    'osm-editor-qt3'    => 'openstreetmap-editor',
162    'osm-editor-qt4'    => 'openstreetmap-editor',
163    );
164my %package_names=(
165    'gpsdrive'          => [qw(gpsdrive gpsdrive-friendsd gpsdrive-utils)],
166    'gpsdrive-maemo'    => [qw(gpsdrive)],
167    'gpsdrive-data-maps'=> [qw(gpsdrive-data-maps)],
168    'gpsdrive-2.10pre5' => [qw(gpsdrive gpsdrive-friendsd gpsdrive-utils)],
169    'gpsdrive-2.10pre7' => [qw(gpsdrive gpsdrive-friendsd gpsdrive-utils)],
170    'gpsdrive-data-maps-2.10pre7'=> [qw(gpsdrive-data-maps)],
171    'opencarbox'        => [qw(opencarbox)],
172    'mod_tile'          => [qw(libapache2-mod-tile renderd)],
173    'osm2pgsql'         => [qw(osm2pgsql)],
174    'merkaartor'        => [qw(merkaartor)],
175    'josm'              => [qw(openstreetmap-josm)],
176    'osm-utils'         => [qw(openstreetmap-utils openstreetmap-utils-export openstreetmap-utils-filter
177                               openstreetmap-utils-import)],
178    'osm-mapnik-world-boundaries'       => [qw(openstreetmap-mapnik-world-boundaries)],
179    'osm-mapnik-data'   => [qw(openstreetmap-mapnik-data)],
180    'map-icons'         => [qw(openstreetmap-map-icons-classic.big openstreetmap-map-icons-classic.small
181                               openstreetmap-map-icons-info openstreetmap-map-icons-japan-png
182                               openstreetmap-map-icons-japan openstreetmap-map-icons-nickw
183                               openstreetmap-map-icons-square.big openstreetmap-map-icons-square.small-minimal
184                               openstreetmap-map-icons-square.small openstreetmap-map-icons-svg-png
185                               openstreetmap-map-icons-svg-twotone-png openstreetmap-map-icons-svg-twotone
186                               openstreetmap-map-icons-svg openstreetmap-map-icons)],
187    'osmosis'           => [qw(openstreetmap-osmosis)],
188    'gosmore'           => [qw(openstreetmap-gosmore)],
189    'merkaartor-0.12'   => [qw(merkaartor)],
190    'merkaartor-0.11'   => [qw(merkaartor)],
191    'merkaartor-0.13'   => [qw(merkaartor)],
192#    'osm-editor'       => [qw(osm-editor)],
193#    'osm-editor-qt3'   => [qw(osm-editor)],
194#    'osm-editor-qt4'   => [qw(osm-editor)],
195    );
196
197my %NO_BUILD=(
198    'mod_tile'          => qw(ubuntu-intrepid|debian-lenny|ubuntu-hardy),
199    );
200my %svn_repository_url=(
201    'openstreetmap-applications' => 'http://svn.openstreetmap.org/applications',
202    'gpsdrive'                   => 'https://gpsdrive.svn.sourceforge.net/svnroot/gpsdrive/trunk',
203    'opencarbox'                 => 'https://opencarbox.svn.sourceforge.net/svnroot/opencarbox/OpenCarbox/trunk',
204
205    'gpsdrive-2.10pre5'          => 'https://gpsdrive.svn.sourceforge.net/svnroot/gpsdrive/branches/gpsdrive-2.10pre5',
206    'gpsdrive-2.10pre6'          => 'https://gpsdrive.svn.sourceforge.net/svnroot/gpsdrive/branches/gpsdrive-2.10pre6',
207    'gpsdrive-2.10pre7'          => 'https://gpsdrive.svn.sourceforge.net/svnroot/gpsdrive/branches/gpsdrive-2.10pre7',
208    'gpsdrive-data-maps-2.10pre7'          => 'https://gpsdrive.svn.sourceforge.net/svnroot/gpsdrive/branches/gpsdrive-2.10pre7',
209    );
210
211my %svn_update_done;
212
213my @available_proj=  sort keys %package_names;
214my @all_proj = grep { $_ !~ m/osmosis|gpsdrive-maemo|merkaartor|merkaartor-0...|gpsdrive-2.10pre|gpsdrive-data-maps-2.10pre7/ } @available_proj;# |osm-editor-qt4
215
216my @projs;
217#@projs= keys %proj2path;
218my @default_projs=@all_proj;
219#@default_projs=qw( gpsdrive-data-maps gpsdrive map-icons osm-utils);
220#@default_projs=qw( gpsdrive gpsdrive-data-maps map-icons osm-utils merkaartor opencarbox osm2pgsql   );# josm gosmore osmosis
221
222sub usage($);
223
224
225# --------------------------------------------
226# Get Options
227
228my $getopt_result = GetOptions (
229    "debug+"        => \$DEBUG,
230    "verbose+"      => \$VERBOSE,
231    "d+"            => \$DEBUG,
232    "v+"            => \$VERBOSE,
233    'help!'         => \$HELP,
234    'manual!'       => \$MANUAL,
235    'man!'          => \$MANUAL,
236
237    "fast!"         => \$do_fast,
238    "force!"        => \$FORCE,
239    "color!"        => sub { my ($a,$b)=(@_);
240                             if ( ! $b  ) {
241                                 for my $k ( keys %COLOR ) {
242                                     $COLOR{$k}='';
243                                 }
244                             }
245    },
246    "svn!"          => sub { my ($a,$b)=(@_);
247                             $do_svn_up        = $b;
248                             $do_svn_co        = $b;
249                             $do_svn_changelog = $b;
250                             $do_svn_cp        = $b;
251    },
252    "svn-up!"        => \$do_svn_up,
253    "svn-co!"        => \$do_svn_co,
254    "svn-changelog!" => \$do_svn_changelog,
255    "svn-cp!"        => \$do_svn_cp,
256    "dir-chroot=s"   => \$dir_chroot,     
257    "dir-svn"        => \$dir_svn,
258    "dir-package-results" => \$package_result_dir,
259    "user"           => \$user,
260    "check_dependencies!" =>     \$do_chk_dep,
261    "debuild!"        => \$do_debuild,
262
263    "platforms=s"    => sub { my ($a,$b)=(@_);
264                              if ( '*' eq $b ) {
265                                  @platforms= @available_platforms;
266                              } elsif ( $b =~ m/\*/ ) {
267                                  $b =~ s,\*,\.\*,g;
268                                  @platforms= grep { $_ =~ m{$b} } @available_platforms;
269                               } else {
270                                   @platforms = split(',',$b);
271                               }
272},
273    "projects=s"     => sub { my ($a,$b)=(@_);
274                              if ( '*' eq $b ) {
275                                  @projs= @all_proj;
276                              } elsif ( $b =~ m/\*/ ) {
277                                  $b =~ s,\*,\.\*,g;
278                                  @projs= grep { $_ =~ m{$b} } @all_proj;
279                              } else {
280                                  @projs = split(',',$b);
281                              }
282},
283    'show-results'      =>  \$do_show_results,
284    'write-html-results-only!' => \$do_write_html_results_only,
285    );
286
287if ( ! $getopt_result ) {
288    die "Unknown Option\n";
289    usage(0);
290}
291
292usage( $MANUAL )
293    if $MANUAL
294    || $HELP;
295
296# ------------------------------------------------------------------
297# Create a new BuildTask object
298sub new {
299    my $pkg = shift;
300    my $self;
301    $self= {@_};
302    bless $self, $pkg;
303    $self->{section} = 'all' unless $self->{section};
304#    print Dumper(\$self);
305    return $self;
306}
307
308# ------------------------------------------------------------------
309# Debugging output
310sub debug($$$){
311    my $self = shift;
312    my $level = shift;
313    my $msg = shift;
314
315    my $platform = $self->{platform}||'';
316    my $proj     = $self->{proj}||'';
317
318    return
319        unless $DEBUG >= $level;
320
321    my $msg1= '';
322    if (  $DEBUG > 5 ) {
323        $msg1 = "($platform:$proj)";
324    }
325    my ( @msg) = split(/\n/,$msg);
326
327    for my $m ( @msg ) {
328        print STDERR "DEBUG$msg1: $m\n";
329    }
330}
331
332# ------------------------------------------------------------------
333# Set/Get Section for Logging
334sub section($;$){
335    my $self = shift;
336    my $new_section= shift;
337
338    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
339
340    if ( defined ($new_section) ) {
341        $self->{section} = $new_section;
342    }
343    my $section  = $self->{section}||'all';
344    return $section;
345}
346
347# ------------------------------------------------------------------
348# Clear/Remove stored Log msgs
349sub Clear_Log($$$){
350    my $self = shift;
351
352    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
353
354    my $platform = $self->platform();
355    my $proj     = $self->proj();
356    my $section  = $self->section();
357
358    if ( ! -d $dir_log ) {
359        die "Cannot Log, Directory '$dir_log' does not exist\n";
360    }
361    my $dst_dir="$dir_log/$proj/$platform";
362    for my $file ( glob("$dst_dir/*.log*" ) ) {
363        unlink $file;
364    }
365}
366
367# ------------------------------------------------------------------
368# Log a msg
369sub Log($$$){
370    my $self = shift;
371    my $level    = shift;
372    my $msg      = shift;
373
374    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
375
376    my $platform = $self->platform();
377    my $proj     = $self->proj();
378    my $section  = $self->section();
379
380    if ( ! -d $dir_log ) {
381        die "Cannot Log, Directory '$dir_log' does not exist\n";
382    }
383    my $dst_dir="$dir_log/$proj/$platform";
384    if ( ! -d $dst_dir ) {
385        mkpath($dst_dir)
386            or warn "WARNING: Konnte Pfad $dst_dir nicht erzeugen: $!\n";
387    }
388
389    # Normal Log Output
390    my $log_file ="$dst_dir/$section.log"; 
391    append_file(  $log_file, "$msg\n" );
392
393    # Html Log
394    $log_file ="$dst_dir/$section.log.shtml"; 
395    if ( ! -$log_file ) {
396        append_file(  $log_file, "<html>\n<pre>\n" );
397    }
398    my $html_msg=$msg;
399    $html_msg =~ s/\</&lt;/g;
400    $html_msg =~ s/\>/&gt;/g;
401    $html_msg =~ s/^(.*(error|warn|No rule to make target|cannot read directory).*)$/<font color="RED">$1<\/font>/gmi;
402    $html_msg =~ s/^(.*(No package|was not found|No such file or directory|missing ).*)$/<font color="RED">$1<\/font>/gmi;
403    $html_msg =~ s{\033\[0m}{<\/font>}g;
404    $html_msg =~ s{\033\[91m}{<font color="RED">}g;
405    $html_msg =~ s{\033\[92m}{<font color="GREEN">}g;
406    $html_msg =~ s{\033\[94m}{<font color="BLUE">}g;
407    append_file(  $log_file, "$html_msg\n" );
408}
409
410# ------------------------------------------------------------------
411# return the filename for the last_result log File
412sub last_result_file($){
413    my $self       = shift;
414
415    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
416
417    my $platform = $self->platform();
418    my $proj     = $self->proj();
419
420    if ( ! -d $dir_log ) {
421        die "Cannot write Result, Directory '$dir_log' does not exist\n";
422    }
423    my $dst_dir="$dir_log/../last_result";
424    if ( ! -d $dst_dir ) {
425        mkpath($dst_dir)
426            or warn "WARNING: Cannot create Path '$dst_dir': $!\n";
427    }
428
429    my $last_log="$dst_dir/result-$platform-$proj.log";
430    return $last_log;
431                 }
432
433# ------------------------------------------------------------------
434# write or read the last result of a package
435# add caching of last result. This enables not building (successfull) two times the same package.
436sub last_result($;$){
437    my $self       = shift;
438    my $new_result = shift; # success|fail|dependencies
439
440    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
441
442    my $last_log=$self->last_result_file();
443
444    if ( defined($new_result) ) {
445        my $svn_revision = $self->svn_revision_platform();
446        append_file( $last_log , "$new_result: $svn_revision\n" );
447        $self->{last_result}=$new_result;
448    } else {
449        my $last_result;
450        if ( -r "$last_log" ) {
451            my @lines = read_file( $last_log ) ;
452            $last_result = pop(@lines);
453            chomp $last_result;
454        } else {
455            $last_result='';
456        }
457        $self->{last_result}=$last_result;
458        return $last_result;
459    } 
460}
461
462
463# ------------------------------------------------------------------
464# read the last good result of a package
465sub last_good_result($){
466    my $self       = shift;
467
468    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
469
470    my $platform = $self->platform();
471    my $proj     = $self->proj();
472
473    my $last_log=$self->last_result_file();
474
475    my $last_result;
476    if ( -r "$last_log" ) {
477        my @lines = grep { $_ =~ m/success:/ } read_file( $last_log ) ;
478        $last_result = pop(@lines) ||'';
479        chomp $last_result;
480    } else {
481        $last_result='';
482    }
483    $last_result =~ s/.*\:\s*//g;
484    $self->{last_good_result}=$last_result;
485    return $last_result;
486                 };
487
488
489# ------------------------------------------------------------------
490# check if errors already occured
491sub errors($$){
492    my $self = shift;
493    my $msg = shift;
494
495    die "Wrong Reference".ref($self)  unless ref($self) eq "BuildTask";
496
497    return $self->{errors};
498}
499
500
501# ------------------------------------------------------------------
502# Error output
503sub error($$){
504    my $self = shift;
505    my $msg = shift;
506
507    die "Wrong Reference".ref($self)  unless ref($self) eq "BuildTask";
508
509    my $platform = $self->{platform};
510    my $proj     = $self->{proj};
511
512    $self->{errors} .= "\n" if $self->{errors};
513    $self->{errors} .= $msg;
514
515    $self->Log(1,"ERROR: $msg");
516
517    my $msg1 = "($platform:$proj)";
518    my ( @msg ) = split(/\n/,$msg);
519
520    for my $m ( @msg ) {
521        print STDERR "$COLOR{RED}!!!!! ERROR$msg1: $m$COLOR{NORMAL}\n";
522    }
523}
524
525
526# ------------------------------------------------------------------
527# Warning output
528sub warning($$){
529    my $self = shift;
530    my $msg = shift;
531
532    die "Wrong Reference".ref($self)  unless ref($self) eq "BuildTask";
533
534    my $platform = $self->{platform};
535    my $proj     = $self->{proj};
536
537    $self->{warnings}.= $msg;
538    $self->Log(1,"WARNING: $msg");
539
540    my $msg1 = "($platform:$proj)";
541    my ( @msg ) = split(/\n/,$msg);
542
543    for my $m ( @msg ) {
544        print STDERR "$COLOR{RED}!!!!! WARNING:$msg1: $m$COLOR{NORMAL}\n";
545    }
546}
547
548
549# ------------------------------------------------------------------
550# split a single platform sting into seperate variables
551sub split_platform($){
552    my $platform = shift; #     ubuntu-intrepid-64
553    my ($distri,$version,$bits) = split('-',$platform);
554    return($distri,$version,$bits);
555               };
556
557# ------------------------------------------------------------------
558# return platform
559sub platform($){
560    my $self = shift;
561    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
562
563    my $platform = $self->{platform};
564    $platform || die "NO Platform specified";
565    if ( grep { $_ eq $platform } @available_platforms ){
566        return $platform;
567    } elsif ( "independent" eq $platform ) {
568        return $platform;
569    } else {
570        $self->error("Unknown Platform '$self->{platform}' used");
571    }
572}
573
574# ------------------------------------------------------------------
575# return project
576sub proj($){
577    my $self = shift;
578    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
579
580    return $self->{proj} || die "Unknown Proj";
581}
582
583# ------------------------------------------------------------------
584# subpath of the project directory
585# Example: openstreetmap-applications/utils/osmosis
586sub proj_sub_dir($) {
587    my $self = shift;
588    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
589
590    my $platform = $self->platform();
591    my $proj     = $self->proj();
592
593    my $proj_sub_dir=$proj2path{$proj};
594    if ( ! $proj_sub_dir ) {
595        die "Unknown Directory for Project '$proj'"
596    };
597    return  $proj_sub_dir;
598         }
599
600# ------------------------------------------------------------------
601# return the base directory for a specific build
602# Example: /home/chroot/debian-squeeze-64/home/tweety/openstreetmap-applications/utils/osmosis
603sub build_dir($){
604    my $self = shift;
605    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
606
607    my $platform = $self->platform();
608    my $proj_sub_dir = $self->proj_sub_dir();
609   
610    my $build_dir = "$dir_chroot/$platform/home/$user/$proj_sub_dir/";
611    return $build_dir;
612}
613
614
615# ------------------------------------------------------------------
616# Directory where the svn Sourcetree is located for the project
617# Example: /home/chroot/svn/openstreetmap-applications/utils/osmosis
618sub svn_dir_full($){
619    my $self = shift;
620    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
621
622    my $proj_sub_dir = $self->proj_sub_dir();
623    return ("$dir_svn/$proj_sub_dir");
624}
625
626# ------------------------------------------------------------------
627# convert Project name to a svn base Directory
628sub svn_dir_base($){
629    my $self = shift;
630    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
631
632    my $proj     = $self->proj();
633    my $proj_sub_dir = $self->proj_sub_dir();
634
635    my $repository_dir=$proj_sub_dir;
636    $repository_dir=~ s,/.*,,; # First Directory-part only
637    $self->debug(7,"svn_dir_base() --> Repository: $repository_dir");
638    return $repository_dir;
639}
640
641# ------------------------------------------------------------------
642# Execute a command with dchroot in a chroot environment
643sub dchroot($$$){
644    my $self = shift;
645    my $dir       = shift; # Directory inside chroot
646    my $command   = shift; # command to execute
647    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
648
649    my $platform = $self->platform();
650    my $proj     = $self->proj();
651
652    # ERR: I: [debian-squeeze-64 chroot] Running command: "debuild clean"
653
654    return $self->command("dchroot --chroot $platform --directory '/home/$user/$dir' '$command'");
655};
656
657
658# ------------------------------------------------------------------
659# Execute a command
660sub command($$){
661    my $self = shift;
662    my $cmd  = shift;
663    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
664
665    my ($data,$data_out,$data_err)=('','','');
666
667    $self->debug(5, "Command: $cmd");
668
669    my ($infh,$outfh,$errfh);
670    $errfh = gensym();
671    my $pid;
672    eval {
673        $pid = open3($infh, $outfh, $errfh, $cmd);
674    };
675    if ( $@ ) {
676        $self->error("Error running Command $cmd: $@");
677        return;
678    }
679
680    my $sel = new IO::Select;
681    $sel->add($outfh,$errfh);
682
683    while(my @ready = $sel->can_read(1000)) {
684        foreach my $fh (@ready) {
685            my $line;
686            my $len = sysread $fh, $line, 4096;
687            my $len1=length($line);
688            my $chomp_line=$line;
689            chomp($chomp_line);
690            if(not defined $len){
691                $self->error("Error from child: $!");
692                return;
693            } elsif ($len == 0){
694                $sel->remove($fh);
695                next;
696            } else { # we read data alright
697                $self->debug(7,"command: $chomp_line");
698                if ($fh == $outfh ) {
699                    $data_out .= $line;
700                    $data .= $line;
701                } elsif ( $fh == $errfh ) {
702                    $data_err .= $line;
703                    $data .= $line;
704                } else {
705                    die "Shouldn't be here\n";
706                }
707                }
708            }
709    }
710
711    waitpid( $pid, 0);
712    my $rc = $? >> 8;
713    $self->debug(7,"Command: ");
714    $self->debug(7,"Command: $cmd");
715    $self->debug(7,"Command: rc:$rc");
716    $self->debug(7,"Command: ^^^^^^^^^^^^^^^^");
717
718    $self->Log(5,"Command: =====================");
719    $self->Log(5,"Command: $cmd");
720    $self->Log(7,"Command: $data");
721    $self->Log(4,"Command: rc:$rc");
722    $self->Log(7,"Command: ^^^^^^^^^^^^^^^^");
723
724#    $self->debug(7,"Data: $data");
725#    $self->debug(7,"Data_out: $data_out");
726#    $self->debug(7,"Data_err: $data_err");
727
728    return $rc,$data_out,$data_err,$data;
729}
730
731# ------------------------------------------------------------------
732# Get svn revision number and write to svnrevision File
733sub write_svn_revision($){
734    my $self = shift;
735    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
736    $self->section("write_svn_revision");
737
738    my $proj     = $self->proj();
739   
740    $self->debug(5,"write_svn_revision: Proj: $proj");
741 
742    my $repository_dir=$self->svn_dir_full($proj);
743   
744    if ( ! -d "$repository_dir/debian" ) {
745        $self->error("No Debian directory found at '$repository_dir/debian'\n");
746        return -1;
747    }
748    my $svn_revision=`cd $repository_dir; svn info . | grep "Last Changed Rev" | sed 's/Last Changed Rev: //'`;
749    chomp $svn_revision;
750    $self->debug(4,"write_svn_revision: SVN Revision($proj): '$svn_revision'");
751    write_file( "$repository_dir/debian/svnrevision", $svn_revision );
752
753
754    # For josm and all it's plugins write a REVISION File
755    if ( $proj =~ /josm/ ) {
756        for my $dir ( glob( "$repository_dir/*/build.xml"), glob("$repository_dir/*/*/build.xml" ) ) {
757            $dir = dirname($dir);
758            my $build_xml = slurp( "$dir/build.xml" );
759            if ( $build_xml =~ m/exec .*output="REVISION".*executable="svn"/ ) {
760                $self->debug(5,"svn REVISION at $dir");
761                my $svn_revision=`cd $dir; export LANG=C; svn info --xml >REVISION`;
762            } else {
763                $self->debug(5,"no svn REVISION at $dir requested");
764            }           
765        }
766    }
767                   };
768
769# ------------------------------------------------------------------
770# Get the svn-revision from the local stored svnrevision File
771# This reflects the revision checked out for ALL others
772sub svn_revision($) {
773    my $self = shift;
774    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
775 
776    my $proj_sub_dir = $self->proj_sub_dir();
777    return '' unless -r "$dir_svn/$proj_sub_dir/debian/svnrevision";
778    my $svn_revision = slurp( "$dir_svn/$proj_sub_dir/debian/svnrevision" );
779    chomp $svn_revision;
780
781    return $svn_revision;
782             };
783
784# ------------------------------------------------------------------
785# Get the svn-revision from the local stored svnrevision File
786# in the specified platform directory
787sub svn_revision_platform($) {
788    my $self = shift;
789    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
790
791    my $proj       = $self->proj();
792    my $platform   = $self->platform();
793    my $build_dir  = $self->build_dir();
794    my $rev_file="$build_dir/debian/svnrevision";
795    if ( ! -$rev_file ) {
796        warn "Cannot read Revision File for '$platform' '$proj': '$rev_file'\n";
797        return '';
798    }
799
800    my $svn_revision = slurp( $rev_file );
801    $svn_revision =~ s/\s\n//g;
802
803    $self->debug(8,"Revision for '$platform' '$proj': is at '$svn_revision' ");
804   
805    return $svn_revision;
806                      };
807
808
809# ------------------------------------------------------------------
810# Update the svn source tree
811sub svn_update($){
812    my $self = shift;
813    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
814    return -1 if $self->errors();
815
816    $self->section("svn_update");
817
818    my $proj     = $self->proj();
819
820    $self->debug(4,"");
821    $self->debug(4,"-----------");
822    $self->debug(3,"svn Update: Proj: $proj");
823
824    my $proj_sub_dir=$self->svn_dir_base($proj);
825
826    if ( $svn_update_done{$proj_sub_dir} ) {
827        $self->debug(4,"Repository $proj_sub_dir for $proj already updated");
828        return;
829    };
830
831    if ( ! -d "$dir_svn/$proj_sub_dir" ) {
832        $self->debug(3,"Repository $proj_sub_dir for $proj not existing");
833        return 0;
834    }
835
836    $self->debug(3,"svn up $dir_svn/$proj_sub_dir");
837    my ($rc,$out,$err,$out_all) = $self->command("svn up --accept theirs-full $dir_svn/$proj_sub_dir");
838    if ( $rc ) {
839        $self->warning("Error '$rc' in 'svn up $dir_svn/$proj_sub_dir'");
840        $self->warning("Error '$err'");
841    }
842
843    my @out = 
844        grep { $_ !~ m/^(\s*$|Fetching external|External at revision|At revision|Checked out external at revision)/ } split(/\n/,$out);
845    $self->debug(4,"OUT-U: ".join("\n",@out));
846    $self->debug(3,"Counting ".scalar(@out)." Changes while doing svn up");
847    if ( $err =~ m/run 'svn cleanup' to remove locks/ ) {
848        $self->debug(3,"We need a svn cleanup");
849        my ($rc,$out,$err,$out_all) = $self->command("svn cleanup $dir_svn/$proj_sub_dir");
850        if ( $rc) {
851            $self->warning("Error '$rc' in 'svn cleanup $dir_svn/$proj_sub_dir'");
852            $self->warning("Error '$err'");
853        }
854    } 
855#     elsif ( $out !~ m/At revision/ ) {
856#       $self->error("No final Revision in Output Found\n");
857#       return 0;
858#    } 
859
860    if ( $err ) {
861        my $err_out=$err;
862        $self->error("ERR: $err_out\n");
863        return 0;
864    }
865    $svn_update_done{$proj_sub_dir}++;
866           };
867
868# ------------------------------------------------------------------
869# Checkout the svn source tree
870sub svn_checkout($){
871    my $self = shift;
872    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
873    return -1 if $self->errors();
874
875    $self->section("svn_checkout");
876
877    my $proj     = $self->proj();
878
879    $self->debug(4,"");
880    $self->debug(4,"------------");
881    $self->debug(3,"svn Checkout: Proj: $proj");
882
883    my $proj_sub_dir=$self->svn_dir_base($proj);
884
885    if ( $svn_update_done{$proj_sub_dir} ) {
886        $self->debug(4,"Repository $proj_sub_dir for $proj already updated");
887        return;
888    };
889
890    my $url=$svn_repository_url{$proj_sub_dir};
891
892    $self->debug(3,"svn co $url $dir_svn/$proj_sub_dir");
893    my ($rc,$out,$err,$out_all) = $self->command("svn co $url $dir_svn/$proj_sub_dir");
894    my @out = 
895        grep { $_ !~ m/^(\s*$|Fetching external|External at revision|At revision|Checked out external at revision)/ } split(/\n/,$out);
896    $self->debug(4,"OUT-U: ".join("\n",@out));
897    if ( $err ) {
898        $self->warning("WARNING: $err");
899    }
900    $svn_update_done{$proj_sub_dir}++;
901             };
902
903# ------------------------------------------------------------------
904# Update the svn source tree
905sub svn_changelog($){
906    my $self = shift;
907    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
908    return -1 if $self->errors();
909
910    $self->section("svn_changelog");
911
912    my $proj     = $self->proj();
913
914    if ( $DEBUG>1 ) {
915        print STDERR "\n";
916        print STDERR "------------\n";
917        print STDERR "svn Changelog update:\n";
918        print STDERR "Proj: $proj\n";
919    }
920    my $proj_sub_dir = $self->proj_sub_dir();
921    my $debname = $proj2debname{$proj};
922
923    my $command="$dir_svn/openstreetmap-applications/utils/packaging/svn_log2debian_changelog.pl";
924    $command .= " --project_name='$debname' ";
925   
926    if ( $proj =~ m/gpsdrive-[^\.\d]*([\.\d]+pre\d+)(-)?/ ) {
927        $command .= " --prefix=2.10svn --release=$1";
928    } elsif ( $proj =~ m/gpsdrive/ ) {
929        $command .= " --prefix=2.10svn ";
930    };
931    if ( $DEBUG ) {
932        $command .= " --debug ";
933    };
934   
935    my ($rc,$out,$err,$out_all) = $self->command("cd $dir_svn/$proj_sub_dir; $command");
936    if ( $rc) {
937        $self->warning("Error '$rc' in '$command'");
938        $self->warning("Error '$err'");
939    }
940              };
941
942
943# ------------------------------------------------------------------
944# Update a single chroot the svn source tree
945sub svn_copy($$){
946    my $self = shift;
947    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
948    return -1 if $self->errors();
949
950    $self->section("svn_copy");
951
952    my $platform = $self->platform();
953    my $proj     = $self->proj();
954
955    $self->debug( 4, "" );
956    $self->debug( 4, "------------" );
957    $self->debug( 3, "svn Copy($platform,$proj)" );
958    my $proj_sub_dir = $self->proj_sub_dir();
959
960    if ( $do_fast ) {
961        if ( $self->svn_revision() eq $self->svn_revision_platform() ){
962            $self->debug(7,"svn copy already done");   
963#           return 0;
964        }
965    }
966
967    $self->debug(4, "Proj sub dir: '$proj_sub_dir'");
968
969    my $proj_svn_dir = "$dir_svn/$proj_sub_dir/";
970    my $build_dir    = $self->build_dir();
971
972    if ( ! -d "$proj_svn_dir" ) {
973        $self->error("SVN Copy Direcoty $proj_svn_dir not found");
974    }
975
976    find(
977        sub{
978            return if $File::Find::name =~ m,\.svn,;
979            return if $File::Find::name =~ m,\/.#,; # Backup Files from Emacs
980            return if -d $File::Find::name;
981            my $src=$File::Find::name;
982            my $dst=$File::Find::name;
983            $dst=~ s{^$proj_svn_dir}{$build_dir};
984            $self->debug(7,"--------------- missing $dst");
985            $self->debug(7,"SRC: $src");
986            $self->debug(7,"DST: $dst");
987            my $dst_dir=dirname($dst);
988            unless ( -d $dst_dir ) {
989                mkpath($dst_dir) 
990                || $self->error("Cannot create '$dst_dir': $!");
991            };
992            copy($src,$dst)
993                || $self->error("!!!!!!!!!! ERROR: Cannot Copy $src->$dst: $!");
994            #print "File::Find::dir       $File::Find::dir\n";
995            #print "File                  $_              \n";
996#           print "File::Find::name      $File::Find::name \n";
997    },  $proj_svn_dir);
998
999    # ###############
1000    # XXXXXXXXXX TODO
1001    # Remove obsolete Files in the dst_dir
1002    # ###############
1003};
1004
1005
1006
1007# ------------------------------------------------------------------
1008# Update a single chroot with svn source tree and apply the patch for this platform
1009sub apply_patch($){
1010    my $self = shift;
1011    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
1012    return -1 if $self->errors();
1013
1014    $self->section("apply_patch");
1015
1016    my $platform  = $self->platform();
1017    my $proj      = $self->proj();
1018    my $build_dir = $self->build_dir();
1019    my $proj_sub_dir = $self->proj_sub_dir();
1020
1021    my $patch_file="$dir_svn/$proj_sub_dir/debian/$platform.patch";
1022    if ( -$patch_file) {
1023        # copy files from SVN-DIR
1024        for my $file ( glob("$dir_svn/$proj_sub_dir/debian/*") ){
1025            next if -d $file;
1026            copy($file,"$build_dir/debian/")
1027                || $self->error("Cannot copy $file ---> $build_dir/debian/: $!");
1028        }
1029
1030        # apply patch
1031        $self->debug(5,"apply_patch($patch_file)");
1032        my ($rc,$out,$err,$out_all) = $self->command("cd $build_dir/debian/; patch <$patch_file");
1033        if ( $out_all =~ /Hunk .* FAILED at / ) {
1034            $self->error("Error in 'patch <$patch_file'\n".
1035                         "Error '$out_all'");
1036            my (@files) = ($out_all =~ m/saving rejects to file (.+\.rej)/g );
1037            for my $file ( @files ){
1038                my $txt = slurp("$build_dir/debian/$file");
1039                $self->error("\n-------------------------------------------------------------------------\n".
1040                             "Patch Error: '$file'\n".
1041                             "-------------------------------------------------------------------------\n".
1042                             $txt);
1043                    }
1044           
1045            return -1;
1046        }
1047        if ( $rc ) {
1048            $self->error("Error '$rc' in 'patch <$patch_file'");
1049            $self->error("Error '$out_all'");
1050            return -1;
1051        };
1052    }
1053
1054};
1055
1056
1057# ------------------------------------------------------------------
1058# Update the svn source tree to be able to work without a svn-binary
1059sub apply_pre_patch($){
1060    my $self = shift;
1061    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
1062    return -1 if $self->errors();
1063
1064    $self->section("apply_pre_patch");
1065
1066    my $platform = $self->platform();
1067    my $proj     = $self->proj();
1068    my $svn_dir_full = $self->svn_dir_full();
1069
1070    # For josm and all it's plugins replace the svn-REVISION-Command with true-Command File
1071    if ( $proj =~ /josm/ ) {
1072        for my $dir ( glob( "$svn_dir_full/*/build.xml"), glob("$svn_dir_full/*/*/build.xml" ) ) {
1073            $dir = dirname($dir);
1074            my $build_xml = slurp( "$dir/build.xml" );
1075            if ( $build_xml =~ m/exec .*output="REVISION".*executable="svn"/ ) {
1076                $self->debug(4,"replace svn command wit TRUE at $dir");
1077            } else {
1078                $self->debug(4,"no svn REVISION at $dir requested");
1079            }           
1080            $build_xml =~ s/output="REVISION"/output="REVISION.null"/g;
1081            $build_xml =~ s/executable="svn"/executable="true"/g;               
1082            $build_xml =~ s,<delete file="REVISION"/>,,g;
1083            write_file("$dir/build.xml",$build_xml);
1084        }
1085    }
1086   
1087    # <exec append="false" output="REVISION" executable="svn" failifexecutionfails="false">
1088
1089};
1090
1091
1092# ------------------------------------------------------------------
1093# Do one build for platform and Project
1094sub dpkg_checkbuilddeps($) {
1095    my $self = shift;
1096    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
1097    if ( $self->errors() ) {
1098        $self->last_result("fail");
1099        return -1
1100    }
1101
1102    $self->section("debuild");
1103
1104    my $platform = $self->platform();
1105    my $proj     = $self->proj();
1106
1107    $self->debug(4,"");
1108    $self->debug(4,"------------");
1109    $self->debug(3,"dpkg-checkbuilddeps($platform,$proj)");
1110    $self->debug(4,"Platform: $platform");
1111    $self->debug(4,"Proj: $proj");
1112    my $proj_sub_dir = $self->proj_sub_dir();
1113
1114    my ($rc,$out,$err,$out_all) = $self->dchroot($proj_sub_dir ,"dpkg-checkbuilddeps");
1115    if ( $err ) {
1116        print "ERR: $err\n";
1117    }
1118    if ( $err =~ m/error: / ) {
1119        $self->error("Error in debuild Output:\n".$err);
1120    }
1121
1122
1123    # --- Check on missing Build dependencies
1124    my @dependencies= grep { $_ =~ m/^dpkg-checkbuilddeps:/ } split(/\n/,$err);
1125    @dependencies = grep { s/.*Unmet build dependencies: //g; }  @dependencies;
1126    @dependencies = map { s/\s*\|\s*/\|/g; s/\|[^\s]+//g;$_ }  @dependencies; # remove alternatives in dependencies " | xy"
1127    @dependencies = grep { s/\([\>\= \.\d\-]+\)//g;$_ }  @dependencies; # remove  "(>> 0.5.0-1)"
1128#    print "\t -2-- ".join("\n\t --- ", @dependencies)."\n";
1129#    exit;
1130    my $dep_file="$dir_chroot/$platform/home/$user/install-debian-dependencies-$proj.sh";
1131    if (  @dependencies ) {
1132        write_file($dep_file,
1133                   "chroot $dir_chroot/$platform apt-get update\n".
1134                   "chroot $dir_chroot/$platform dpkg --configure -a\n".
1135                   "chroot $dir_chroot/$platform aptitude --assume-yes install ".
1136                   join("\n", @dependencies)."\n");
1137        $self->error("!!!!!!!!!!!!!!!!!!!!!! Cannot Build Debian Package because of Missing Dependencies: \n".
1138                     "\t".join("\n\t", @dependencies)."\n".
1139                     "Written install suggestion to : '$dep_file'\n"   
1140            );
1141        $self->last_result("fail-dependency");
1142        return -1;
1143    } else {
1144        unlink($dep_file);
1145    }
1146    if ( $rc) {
1147        $self->error("Error '$rc' in 'debuild binary'");
1148        $self->warning("Error '$out_all'");
1149    }
1150
1151
1152}
1153
1154
1155# ------------------------------------------------------------------
1156# Do one build for platform and Project
1157sub debuild($) {
1158    my $self = shift;
1159    die "Wrong Reference '".ref($self)."'"  unless ref($self) eq "BuildTask";
1160    if ( $self->errors() ) {
1161        $self->last_result("fail");
1162        return -1
1163    }
1164
1165    $self->section("debuild");
1166
1167    my $platform = $self->platform();
1168    my $proj     = $self->proj();
1169
1170    $self->debug(4,"");
1171    $self->debug(4,"------------");
1172    $self->debug(3,"Debuild($platform,$proj)");
1173    $self->debug(4,"Platform: $platform");
1174    $self->debug(4,"Proj: $proj");
1175    my $proj_sub_dir = $self->proj_sub_dir();
1176
1177    if ( ! $do_fast ) {
1178        my ($rc,$out,$err,$out_all) = $self->dchroot($proj_sub_dir ,"debuild clean");
1179        if ( $err ) {
1180            print "ERR: $err\n";
1181        }
1182    }
1183
1184    my ($rc,$out,$err,$out_all) = $self->dchroot($proj_sub_dir ,"debuild binary");
1185    if ( $err ) {
1186        print "ERR: $err\n";
1187    }
1188    if ( $err =~ m/error: / ) {
1189        $self->error("Error in debuild Output:\n".$err);
1190    }
1191
1192    if ( $rc) {
1193        $self->error("Error '$rc' in 'debuild binary'");
1194        $self->warning("Error '$out_all'");
1195    }
1196
1197    # ------ Collect Resulting *.deb names
1198    my $result_dir=dirname("$dir_chroot/$platform/home/$user/$proj_sub_dir/");
1199    my $svn_revision = $self->svn_revision_platform();
1200    my $revision_string= $svn_revision;
1201    if ( $proj =~ m/gpsdrive-[^\.\d]*([\.\d]+pre\d+)(-)?/ ) {
1202        $revision_string= "$1";
1203    }
1204    my @results= grep { $_ =~ m/\.deb$/ } glob("$result_dir/*$revision_string*.deb");
1205    if ( $proj =~ m/gpsdrive-(.*pre.*)/ ) {
1206    } else {
1207        @results= grep { $_ !~ m/2.10pre/ } @results;
1208    }
1209
1210    my $result_count=scalar(@results);
1211    $self->{'results'}->{'deb-count'}=$result_count;
1212    $self->{'results'}->{'packages'}= \@results;
1213    my $result_expected = scalar(@{$package_names{$proj}});
1214    if ( ! $result_count ) {
1215        my $all_deb_in_results = join(",",glob("$result_dir/*$revision_string*.deb"));
1216        $self->error( "!!!!!!!! WARN: NO resulting Packages for Proj '$proj' on Platform $platform.\n".
1217                      "Expecting $result_expected packages for svn-revision $revision_string\n".
1218                      "see results in '$result_dir'\n".
1219                      "Other Debian Files:  $all_deb_in_results\n");
1220        $self->last_result("fail");
1221    } elsif ( $result_expected !=  $result_count ) {
1222        $self->error( "!!!!!!!! WARN: Number of resulting Packages for Proj '$proj' on Platform $platform is Wrong.\n".
1223                      "Expecting $result_expected packages for svn-revision $revision_string, got: $result_count Packages\n".
1224                      "see results in '$result_dir'");
1225        $self->last_result("fail");
1226    } else {
1227        # Check for missing result-packages
1228        my @names=@{$package_names{$proj}};
1229        my $missing=0;
1230        for my $name ( @{$package_names{$proj}} ) {
1231            my $check_name="${name}_(|2\.10svn)${revision_string}_(i386|amd64|all)\.deb";
1232            if ( ! grep { $_ =~ m/$check_name$/ } @results ) {
1233                $self->error( "!!!!!!!! ERROR: Missing Result Package $name\n");
1234                $missing++;
1235            };
1236        }
1237
1238        my $wrong_name=0;
1239        for my $name ( @results ) {
1240            my $short_name=basename($name);
1241            if ( ! grep { $short_name =~ m/${_}_(|2\.10svn)${revision_string}_(i386|amd64|all)\.deb$/ }  @{$package_names{$proj}} ) {
1242                $self->error( "!!!!!!!! ERROR: Unknown Result Package '$name'\n");
1243                $wrong_name++;
1244            };
1245        }
1246        if ( $missing ) {
1247            $self->last_result("missing");
1248        } elsif ( $wrong_name ) {
1249            $self->last_result("wrong_name");
1250        } else {
1251            $self->last_result("success");
1252        } 
1253    }
1254    $self->debug(3,"Resulting Packages($result_count):");
1255    $self->debug(4,"\n\t".join("\n\t",@results));
1256
1257
1258
1259
1260    # Move Result to one Result Place
1261    my ($distri,$version,$bits)=split_platform($platform);
1262    my $dst_dir="$package_result_dir/$distri/pool/$version";
1263    if ( ! -d $dst_dir ) {
1264        mkpath($dst_dir)
1265            or $self->error( "!!!!!!!! WARNING: Konnte Pfad $dst_dir nicht erzeugen: $!");
1266    }
1267    for my $result ( @results) {
1268        my $fn=basename($result);
1269        rename($result,"$dst_dir/$fn")
1270            || $self->error( "!!!!!!!! WARNING Cannot move result '$result' to '$dst_dir/$fn': $!");
1271    }
1272}
1273
1274
1275# ------------------------------------------------------------------
1276sub show_results(){
1277    printf "%-15s %6s ","Project","svn";
1278    for my $platform ( @platforms ) {
1279        my $print_platform=$platform;
1280        $print_platform=~ s/(debian|ubuntu)-//;
1281        $print_platform=~ s/-.*//g;
1282        printf "%-7s ",$print_platform ;
1283    }
1284    print  "\n";
1285    printf "%-15s %6s ","","";
1286    for my $platform ( @platforms ) {
1287        my $print_platform=$platform;
1288        $print_platform=~ s/(debian|ubuntu)-//;
1289        $print_platform=~ s/.*-//g;
1290        printf "%-7s ",$print_platform ;
1291    }
1292    print  "\n";
1293
1294    for my $proj ( @projs ) {
1295        my $proj_rev=svn_revision( bless({proj=>$proj,platform=>'independent'},'BuildTask') );
1296        my $p_proj=$proj;
1297        $p_proj=~ s/osm-mapnik-world-boundaries/osm-world-bound/;
1298        $p_proj=~ s/gpsdrive-data-maps/gpsdrive-maps/;
1299        printf "%-15s %6d ",$p_proj,$proj_rev;
1300        for my $platform ( @platforms ) {
1301#           print "$platform ";
1302            my $task = $RESULTS->{$platform}->{$proj};
1303            if ( ! defined ( $task ) )  {
1304                $task = BuildTask->new( proj => $proj, platform => $platform );
1305            };
1306            my $svn_revision_platform = $task->svn_revision_platform()||'';
1307            my $svn_revision = $task->svn_revision()||'';
1308            my $last_result=$task->last_result();
1309           
1310            $task->{svn_base_revision}= $svn_revision;
1311            if ( $svn_revision eq $svn_revision_platform) {
1312                $task->{svn_up_to_date}=1;
1313                $task->{color_rev}=$COLOR{GREEN};
1314            } else {
1315                $task->{svn_up_to_date}=0;
1316                $task->{color_rev}=$COLOR{BLUE};
1317            }   
1318            if ( ! $svn_revision_platform ) {
1319                $task->{color_res}="+$COLOR{GREEN}";
1320            } elsif ( $last_result eq "success: $svn_revision_platform" ) {
1321                $task->{color_res}="+$COLOR{GREEN}";
1322            } else {
1323                $task->{color_res}="-$COLOR{RED}";
1324                $task->{color_rev}=$COLOR{RED};
1325            };
1326
1327            my $color_rev = $task->{color_rev};
1328            my $color_res = $task->{color_res};
1329            my ( $res,$rev)  = split(/:\s*/,$task->last_result());
1330            $rev ||='';
1331            my $rev_last_good  = $task->last_good_result();
1332            my $print_platform=$platform;
1333            $print_platform=~ s/(debian-|ubuntu-)//;
1334
1335            if ( $NO_BUILD{$proj} && ($platform =~ m{$NO_BUILD{$proj}} )) {
1336                print "Do not build $proj on $platform\n";
1337                $rev= "no-build";
1338                $color_res="blue";
1339            }
1340
1341            print "$color_res"; #. $print_platform."$COLOR{NORMAL} " ;
1342            printf "$color_rev%-6s$COLOR{NORMAL} ", $rev;
1343            if (  $rev_last_good && $rev ne $rev_last_good ) {
1344                print "$COLOR{GREEN}($rev_last_good)$COLOR{NORMAL}";
1345            }
1346        }
1347        print "\n";
1348    }
1349}
1350# ------------------------------------------------------------------
1351sub write_html_results(){
1352    my $html_report="$dir_log/results.shtml";
1353    my $fh = IO::File->new(">$html_report");
1354#    print $fh "<html>\n";
1355    print $fh "<!--#include virtual=\"/header.shtml\" -->\n";
1356    print $fh "<div id=\"content\">\n";
1357    print $fh "<div>\n";
1358    print $fh "<H1>Results from the Build-Cluster</H1>\n";
1359    print $fh localtime(time())."\n";
1360    print $fh "<br/>\n";
1361    print $fh "<br/>\n";
1362    print $fh "<table border=1>\n";
1363   
1364    print  $fh "<tr><th>Project</th><th>svn</th>";
1365    for my $platform ( @platforms ) {
1366        my $print_platform=$platform;
1367        $print_platform=~ s/(debian|ubuntu)-/$1\<br\/\>/;
1368        $print_platform=~ s/-/ /g;
1369       
1370        print $fh "<th>$print_platform</th>" ;
1371       
1372    }
1373    print  $fh "</tr>\n";
1374
1375    for my $proj ( @projs ) {
1376        print  $fh "<tr>\n";
1377        my $rel_proj_log_dir="$proj";
1378        printf $fh "    <td><a href=\"$rel_proj_log_dir\">%s</a></td>\n",$proj;
1379
1380        my $proj_rev=svn_revision( bless({proj=>$proj,platform=>'independent'},'BuildTask') );
1381        print $fh "     <td>$proj_rev</td>\n";
1382
1383        for my $platform ( @platforms ) {
1384#           print $fh "$platform ";
1385            my $task = $RESULTS->{$platform}->{$proj};
1386            my $rel_log_dir="$proj/$platform";
1387            if ( ! defined ( $task ) )  {
1388                $task = BuildTask->new( proj => $proj, platform => $platform );
1389            };
1390            my $svn_revision_platform = $task->svn_revision_platform()||'';
1391            my $svn_revision = $task->svn_revision()||'';
1392            my $last_result=$task->last_result();
1393            my $color_rev;
1394            my $color_res;
1395            if ( $svn_revision eq $svn_revision_platform) {
1396                $color_rev="GREEN";
1397            } else {
1398                $color_rev="BLUE";
1399            }   
1400            if ( ! $svn_revision_platform ) {
1401                $color_res="GREEN";
1402            } elsif ( $last_result eq "success: $svn_revision_platform" ) {
1403                $color_res="GREEN";
1404            } else {
1405                $color_res="RED";
1406                $color_rev="RED";
1407            };
1408
1409            my ( $res,$rev)  = split(/:\s*/,$task->last_result());
1410            $rev ||='';
1411            my $rev_last_good  = $task->last_good_result();
1412            my $print_platform=$platform;
1413            $print_platform=~ s/(debian-|ubuntu-)//;
1414
1415            if ( $NO_BUILD{$proj} && ($platform =~ m{$NO_BUILD{$proj}} )) {
1416                $rev= "no-build";
1417                $color_rev="black";
1418            }
1419
1420            print $fh "     <td> <A href=\"$rel_log_dir\">";
1421            printf $fh "        <FONT  color=\"$color_rev\">%-6s </font>\t", $rev;
1422            if (  $rev_last_good
1423                  && ( $rev ne $rev_last_good ) 
1424                ) {
1425                print $fh "\n           <FONT color=\"GREEN\">($rev_last_good)</font>\n";
1426            }
1427            print $fh " </a> </td>\n\n";
1428        }
1429        print $fh "\n";
1430        print  $fh "</tr>\n";
1431    }
1432
1433    print $fh "</table>\n";
1434    print $fh "<br/>\n";
1435    print $fh "Colors:\n";
1436    print $fh "<ul>\n";
1437    print $fh "<li><FONT color=\"green\">green</font>: Build successfull</li>\n";
1438    print $fh "<li><FONT color=\"blue\">blue</font>: Build is old but successfull</li>\n";
1439    print $fh "<li><FONT color=\"red\">red</font>: Build failed</li>\n";
1440    print $fh "</ul>\n";
1441    print $fh "</html>\n";
1442    $fh->close();
1443
1444    # Create Index for each proj/platform
1445    for my $proj ( @projs ) {
1446        for my $platform ( @platforms ) {
1447            my $html_index_dir="$dir_log/$proj/$platform";
1448            if ( ! -d $html_index_dir ) {
1449                mkpath($html_index_dir)
1450                    or warn "WARNING: Konnte Pfad $html_index_dir nicht erzeugen: $!\n";
1451            }
1452            my $html_index="$html_index_dir/index.shtml";
1453            my $fh = IO::File->new(">$html_index");
1454            print $fh "<!--#include virtual=\"/header.shtml\" -->\n";
1455            print $fh "<div>\n";
1456            print $fh "<H1><a href=\"../../results.shtml\">Results from the Build-Cluster</a></H1>\n";
1457            print $fh "<H2>Project: $proj</H2>\n";
1458            print $fh "<H2>Platform: $platform</H2>\n";
1459
1460            print $fh "<table><tr>\n";
1461            print $fh "<td valign=\"top\">\n";
1462
1463            print $fh "Log Files:";
1464            print $fh "<ul>";
1465            debug({proj=>$proj,platform=>$platform},5,"Files:");
1466            for my $file ( glob("$html_index_dir/*.shtml") ) {
1467                my $file_name = basename($file);
1468                debug({proj=>$proj,platform=>$platform},5,"              $file");
1469                next if $file_name eq "index.shtml";
1470
1471                my @lines = read_file( $file ) ;
1472                my $count_warn=(grep {$_ =~ m/warn/i } @lines);
1473                my $count_error=(grep {$_ =~ m/error/i } @lines);
1474                my ( $disp_name ) = ( $file_name =~ m/(.*)\.shtml/ );
1475                print $fh "<li><A href=\"$file_name\">$disp_name</a>";
1476                print $fh "<br/>&nbsp;&nbsp;error: $count_error" if $count_error;
1477                print $fh "<br/>&nbsp;&nbsp;warn: $count_warn" if $count_warn;
1478                print $fh "</li>\n";
1479            }
1480            print $fh "</ul>";
1481            print $fh "</td>\n";
1482
1483
1484            # -----------------------------------------------------------------------
1485            # list of Debian Packages
1486            my $task=BuildTask->new( proj     => $proj ,
1487                                     platform => $platform );   
1488            my $rev_last_good  = $task->last_good_result();
1489            my $res_last  = $task->last_result();
1490            #print "rev_last_good($proj ,$platform) '$rev_last_good'\n";
1491
1492            print $fh "<td valign=\"top\">\n";
1493            print $fh "Status:<br/><br/>\n";
1494            print $fh "Last Good Revision:<br/>&nbsp;&nbsp; $rev_last_good<br/><br/>\n";
1495            print $fh "Last Result:<br/>&nbsp;&nbsp; $res_last<br/>\n";
1496            print $fh "</td>\n";
1497
1498
1499            #$package_result_dir
1500            my ($distri,$version,$bits)=split_platform($platform);
1501
1502            my $platform_glob='{i386,amd64,all}';
1503            $platform_glob='{i386,all}' if $bits eq "32";
1504            $platform_glob='{amd64,all}' if $bits eq "64";
1505
1506            print $fh "<td valign=\"top\">\n";
1507            print $fh "<A href=\"/$distri/pool/$version/\">Packages ($distri $version)</a>:\n";
1508            if ( ${rev_last_good} ) {
1509
1510                print $fh "\t<ul>\n";
1511                for my $name ( @{$package_names{$proj}} ) {
1512                    print $fh "\t<li>$name:\n"; 
1513
1514                    $task->debug(7,"glob($package_result_upload_dir/$distri/pool/$version/${name}_${rev_last_good}_${platform_glob}.deb");
1515                    my @files = glob("$package_result_upload_dir/$distri/pool/$version/${name}_*${rev_last_good}_${platform_glob}.deb");
1516                    @files = grep { -s $_ } @files;
1517                    if ( @files ) {
1518                        print $fh "\t<ul>\n";
1519                        for my $file ( @files ) {
1520                            my $file_name = basename($file);
1521                            my $link = $file;
1522                            $link =~ s/^$package_result_upload_dir//;
1523                            #print "\t$link\n";
1524                            print $fh "\t<li><A href=\"$link\"> $file_name</a></li>\n"; 
1525                        }
1526                        print $fh "\t</ul>\n";
1527                    } else {
1528                        print $fh "<FONT color=\"RED\">No Files found</font>\n";
1529                    }
1530                    print $fh "</li>\n";
1531                }
1532                print $fh "\t<ul>\n";
1533            }
1534            print $fh "</td>\n";
1535            print $fh "</tr></table>\n";
1536
1537            print $fh localtime(time())."\n";
1538
1539            print $fh "<br/><br/><a href=\"../../results.shtml\">Back to Overview</a>\n";
1540            print $fh "</div>\n";   
1541            print $fh "<!--#include virtual=\"/footer.shtml\" -->\n";
1542            $fh->close();
1543        }
1544    }
1545}
1546
1547# ------------------------------------------------------------------
1548sub usage($){
1549    my $opt_manual = shift;
1550
1551    print STDERR <<EOUSAGE;
1552usage: $0 [Options]
1553
1554    build_cluster is a tool to compile and build packages for some software-projects.
1555
1556Available Projects:
1557    @available_proj
1558
1559These Projects will be compiled for a set of platforms
1560
1561Available Platforms:
1562    @available_platforms
1563
1564The build-cluster-tool expects a set of chroot environments to work in the
1565directory
1566$dir_chroot
1567
1568Logfiles are written to:
1569       $dir_log
1570
1571The svn Checkout is done to:
1572       $dir_svn
1573
1574Results are collected in the Directory
1575       $package_result_dir
1576
1577EOUSAGE
1578
1579pod2usage(1) if $HELP;
1580pod2usage(-verbose=>2) if $opt_manual;
1581
1582
1583
1584die "\n";
1585
1586}
1587
1588# ------------------------------------------------------------------
1589# Main
1590# ------------------------------------------------------------------
1591@platforms= @default_platforms
1592    unless @platforms;
1593
1594@projs= @default_projs 
1595    unless @projs;
1596
1597
1598if ( $do_write_html_results_only ) {
1599    write_html_results();
1600    exit 0;
1601}
1602
1603if ( $DEBUG >= 1 ) {
1604    print "----------------------------------------\n";
1605    print "Platforms: " . join(" ",@platforms)."\n";
1606    print "Projects:  " . join(" ",@projs)."\n";
1607    print "\t--".($do_svn_up    ?'':'no-')."svn-up\n";
1608    print "\t--".($do_svn_co    ?'':'no-')."svn-co\n";
1609    print "\t--".($do_svn_changelog?'':'no-')."svn-changelog\n";
1610    print "\t--".($do_svn_cp    ?'':'no-')."svn-cp\n";
1611    print "\t--".($do_chk_dep   ?'':'no-')."check_dependencies\n";
1612    print "\t--".($do_debuild   ?'':'no-')."debuild\n";
1613    print "\t--".($do_fast      ?'':'no-')."fast\n";
1614    print "\t--".($FORCE        ?'':'no-')."force\n";
1615    print "\t--".($DEBUG        ?'':'no-')."debug = $DEBUG\n";
1616    print "----------------------------------------\n";
1617}
1618
1619show_results() 
1620    if ( $DEBUG > 1 || $VERBOSE > 1 ) && $do_show_results;
1621
1622# svn Update
1623for my $proj ( @projs ) {
1624    my $task=BuildTask->new( proj     => $proj ,
1625                             platform => 'independent' );
1626
1627    $task->svn_update( )        if $do_svn_up;
1628    $task->svn_checkout(  )     if $do_svn_co;
1629    $task->write_svn_revision() if $do_svn_up || $do_svn_co;
1630    $task->apply_pre_patch()    if $do_svn_up || $do_svn_co || $do_svn_cp;;
1631
1632    # Update Changelogs
1633    $task->svn_changelog()      if $do_svn_changelog;
1634}
1635
1636
1637if ( $DEBUG >= 3 ) {
1638    print "----------------------------------------\n";
1639    print "Platforms: " . join(" ",@platforms)."\n";
1640    print "Projects:  " . join(" ",@projs)."\n";
1641    print "----------------------------------------\n";
1642}
1643
1644for my $platform ( @platforms ) {
1645    #print STDERR "\n";
1646    print STDERR "$COLOR{BLUE}------------------------------------------------------------ Platform: $platform$COLOR{NORMAL}\n"
1647        if $DEBUG > 3;
1648
1649    for my $proj ( @projs ) {
1650
1651        if ( $NO_BUILD{$proj} && $platform =~ m {$NO_BUILD{$proj}} ) {
1652            print "Do not build $proj on $platform\n";
1653            next;
1654        }
1655
1656        my $task = BuildTask->new( 
1657            proj     => $proj, 
1658            platform => $platform ,
1659            );
1660        if ( $DEBUG>2 || $VERBOSE>2 ) {
1661            print STDERR "$COLOR{MAGENTA}------------------------------------------------  Platform: $platform$COLOR{NORMAL}    Project: $proj$COLOR{NORMAL}\n";
1662        }
1663
1664        $task->Clear_Log();
1665
1666        if ( $do_fast ) {
1667            my $svn_revision = $task->svn_revision();
1668            my $last_result=$task->last_result();
1669            if ( $svn_revision && ($last_result eq "success: $svn_revision") ) {
1670                if ( $VERBOSE >1 || $DEBUG >2 ) {
1671                    print STDERR "$COLOR{GREEN}---- Project: $proj ($platform) '$last_result' up-to-date --> skipping$COLOR{NORMAL}\n";
1672                }
1673                next;
1674            } else {
1675                $task->debug(3, "$COLOR{BLUE}------ Project: $proj build not up to date: '$last_result'$COLOR{NORMAL}");
1676            };
1677        }
1678
1679        $task->svn_copy()       if $do_svn_cp;
1680        $task->apply_patch();
1681        $task->dpkg_checkbuilddeps()    if $do_chk_dep;
1682        $task->debuild()        if $do_debuild;
1683        $RESULTS->{$platform}->{$proj}=$task;
1684        $task->section("summary");
1685        $task->Log( 1,"\n\nRESULTS:\n".
1686                    Dumper(\$task) );
1687
1688        my $last_result=$task->last_result();
1689        if ( $VERBOSE || $DEBUG ) {
1690            print STDERR        "$COLOR{MAGENTA}---  Platform: $platform$COLOR{NORMAL}  Project: $proj  $last_result $COLOR{NORMAL}\n";
1691        }
1692       
1693    }
1694};
1695
1696if ( $DEBUG >= 3) {
1697    print "RESULTS:\n";
1698    print Dumper(\$RESULTS);
1699}
1700
1701show_results() 
1702    if $do_show_results;
1703
1704write_html_results()
1705    if $do_show_results;
1706
1707
1708__END__
1709
1710=pod
1711
1712=head1 Options
1713
1714=over
1715
1716=item --debug
1717
1718Add some Debugging Output
1719
1720=item --verbose
1721
1722Be more verbose
1723
1724=item --fast
1725
1726Skip some not really needed tasks. (debuild clean, ...)
1727And check for already successfully build packages.
1728
1729=item --no-color
1730
1731switch of coloring output. This is needed for example if run in a cronjob.
1732
1733=item --svn-up / --no-svn-up
1734
1735Switch on/off doing subversion update to the projects.
1736
1737=item --svn / --no-svn
1738
1739Switch on/off doing all subversion actions.
1740
1741=item --svn-co / --no-svn-co
1742
1743Switch on/off doing subversion co on the projects.
1744
1745=item --svn-changelog / --no-svn-changelog
1746
1747Switch on/off the creation of an automated changelog from subversion.
1748
1749=item --svn-cp / --no-svn-cp
1750
1751Switch on/off doing copying from the subversion folder to the chroot subdirectories.
1752
1753=item --dir-chroot
1754
1755Specify the directory where all chroots are located.
1756
1757=item --dir-svn
1758
1759Specify the directory where the svn checkou copy is located.
1760
1761=item --dir-package-results
1762
1763Specify the directory where the resulting packages are located.
1764
1765=item --user
1766
1767Specify the username to use for the package build directories.
1768
1769=item --check_dependencies
1770
1771Check dependencies
1772
1773=item --debuild
1774
1775do the debuild
1776
1777=item --platforms=
1778
1779Specify the platforms to build for. a * can be used to specify multiple
1780platforms with a wildcard.
1781
1782=item --projects=
1783
1784Specify the projects to build for. a * can be used to specify multiple
1785projects with a wildcard.
1786
1787=item --show-results
1788
1789Show a summary of all results. This also looks for cached results.
1790
1791=item --write-html-results-only
1792
1793Write Html Pages for the Results and exit.
1794
1795=item --help
1796
1797Help Page
1798
1799=item --man
1800
1801A little bit more detailed Man page
1802
1803=back
1804
1805
1806
1807
1808=head1 TODO:
1809
1810  - Check for another build-cluster.pl already running
1811
1812  - Add timeout to command execution. This might prevent hanging
1813    javacompiler from blocking the rest of the build-cluster.pl
1814
1815  - writing Logfiles
1816
1817  - Help/manpage
1818
1819  - Error Code checking
1820
1821  - while doing "svn up" "svn co": Check if another
1822    svn command is running on the same directory
1823
Note: See TracBrowser for help on using the repository browser.