5 kx #!/bin/env perl
5 kx
5 kx use FindBin;
5 kx use lib $FindBin::Bin;
5 kx
5 kx use strict;
5 kx use warnings FATAL => 'all';
5 kx
5 kx use IO::Handle;
5 kx use File::Basename;
5 kx use File::Temp;
5 kx
5 kx use Time::localtime;
5 kx
5 kx use _kxLab;
5 kx
5 kx #
5 kx # Generate .$(HARDWARE).{json,html} file for current directory
5 kx #
5 kx # usage:
5 kx # $0 topdir toolchain hardware
5 kx #
5 kx # where:
5 kx # 'topdir' - is a absolute path to the top directory of checked out branch
5 kx # 'toolchain' - is a TOOLCHAIN name
5 kx # 'hardware' - is a HARDWARE variant
5 kx #
5 kx
5 kx # global variables
5 kx my ($build_system);
5 kx my ($topdir, $toolchain, $hardware, $flavour);
5 kx my ($target_build_dir, $requires_file);
5 kx my ($html_tree_file, $js_tree_file, $js_min_tree_file, $js_pkgs_file, $js_min_pkgs_file);
5 kx my ($system_version, $distro_name, $distro_version, $url);
5 kx my $tarball_suffix = "txz";
5 kx
5 kx my %sub_trees;
5 kx my %tree;
5 kx
5 kx
5 kx sub usage
5 kx {
5 kx print <<EOF;
5 kx
5 kx Usage: $0 topdir toolchain hardware
5 kx Where:
5 kx topdir - is a absolute path to the top of checked out branch;
5 kx toolchain - is a TOOLCHAIN name;
5 kx hardware - is a HARDWARE variant.
5 kx
5 kx EOF
5 kx exit;
5 kx }
5 kx
5 kx #
5 kx # Getting information from build-system/constants.mk
5 kx #
5 kx sub system_version
5 kx {
5 kx my $build_system = shift;
5 kx my $version;
5 kx
5 kx open( FILE, "< $build_system/constants.mk" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^SYSTEM_VERSION(.+= +)(.+)/ )
5 kx {
5 kx $version = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $version;
5 kx }
5 kx
5 kx sub distro_name
5 kx {
5 kx my $build_system = shift;
5 kx my $name;
5 kx
5 kx open( FILE, "< $build_system/constants.mk" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^DISTRO_NAME(.+= +)(.+)/ )
5 kx {
5 kx $name = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $name;
5 kx }
5 kx
5 kx sub distro_version
5 kx {
5 kx my $build_system = shift;
5 kx my $name;
5 kx
5 kx open( FILE, "< $build_system/constants.mk" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^DISTRO_VERSION(.+= +)(.+)/ )
5 kx {
5 kx $name = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $name;
5 kx }
5 kx
5 kx sub bug_url
5 kx {
5 kx my $build_system = shift;
5 kx my $url;
5 kx
5 kx open( FILE, "< $build_system/constants.mk" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^BUG_URL(.+= +)(.+)/ )
5 kx {
5 kx $url = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $url;
5 kx }
5 kx
5 kx #
5 kx # value_from_makefile( $makefile, $variable_name, $stop_line ):
5 kx # ------------------------------------------------------------
5 kx # This function returns the value of variable defined in the
5 kx # Makefile on global level before od REQUIRES declaration.
5 kx #
5 kx # The optional $stop_line argument presents the start of the
5 kx # line which terminates the analized part of Makefile.
5 kx #
5 kx sub value_from_makefile
5 kx {
5 kx my $makefile = shift;
5 kx my $vname = shift;
5 kx my $stop_line = shift;
5 kx my $value = "";
5 kx
5 kx if( !defined $stop_line || $stop_line eq '' )
5 kx {
5 kx $stop_line = "__END_OF_REQUIRES__";
5 kx }
5 kx else
5 kx {
5 kx $stop_line = "^" . $stop_line;
5 kx }
5 kx
5 kx my $cdir = dirname( $makefile );
5 kx
5 kx my $shell_output = <<`SHELL`;
5 kx cd $cdir
5 kx head -n `cat Makefile | grep -n "$stop_line" | cut -f 1 -d ':'` Makefile | \
5 kx make TOOLCHAIN=$toolchain HARDWARE=$hardware FLAVOUR=$flavour -f - -p __build_requires__ 2>/dev/null | grep "$vname"
5 kx exit 0
5 kx SHELL
5 kx
5 kx if( $shell_output =~ m/^$vname(.+= +)(.+)/gm )
5 kx {
5 kx $value = $2;
5 kx }
5 kx
5 kx return $value;
5 kx }
5 kx
5 kx #
5 kx # Getting information from Makefile
5 kx #
5 kx sub pkg_rootfs_target
5 kx {
5 kx my $makefile = shift;
5 kx my $install = "";
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^ROOTFS_TARGETS(.+= +)(.+)/ )
5 kx {
5 kx if( $2 ne "" ) { $install = "install"; }
5 kx }
5 kx elsif( /^ROOTFS_UPDATE_TARGETS(.+= +)(.+)/ )
5 kx {
5 kx if( $2 ne "" ) { $install = "update"; }
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx if( $install eq "" ) { $install = "no"; }
5 kx # else { $install = "yes"; }
5 kx
5 kx return $install;
5 kx }
5 kx
5 kx sub pkg_group
5 kx {
5 kx my $makefile = shift;
5 kx my $group;
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^PKG_GROUP(.+= +)(.+)/ )
5 kx {
5 kx $group = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $group;
5 kx }
5 kx
5 kx sub pkg_name
5 kx {
5 kx my $makefile = shift;
5 kx my $name = "";
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^[A-Z_0-9]*_PKG_NAME(.+= +)(.+)/ )
5 kx {
5 kx $name = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $name;
5 kx }
5 kx
5 kx sub pkg_version
5 kx {
5 kx my $makefile = shift;
5 kx my $version;
5 kx
5 kx my $stop_line;
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^([A-Z_0-9]*_PKG_VERSION)(.+= +)(.+)/ )
5 kx {
5 kx $stop_line = $1;
5 kx $version = $3;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx # check if version is present as a reference to some variable:
5 kx if( $version =~ m/^\$\((.+)\)/ )
5 kx {
5 kx my $vname = $1;
5 kx
5 kx # get value of referenced variable
5 kx $version = value_from_makefile( $makefile, $vname, $stop_line );
5 kx }
5 kx
5 kx return $version;
5 kx }
5 kx
5 kx sub pkg_license
5 kx {
5 kx my $makefile = shift;
5 kx my $license;
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^[A-Z_0-9]*_PKG_LICENSE(.+= +)(.+)/ )
5 kx {
5 kx $license = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $license;
5 kx }
5 kx
5 kx sub pkg_short_description
5 kx {
5 kx my $makefile = shift;
5 kx my $description;
5 kx
5 kx open( FILE, "< $makefile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^[A-Z_0-9]*_PKG_SHORT_DESCRIPTION(.+= +)(.+)/ )
5 kx {
5 kx $description = $2;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx #
5 kx # In Makefiles we have to mask characters '\', '&', '*', '(', ')' inside
5 kx # the new value in the assignment operator with backslash. So, for axample,
5 kx # the value "name & \ * ( ) end" we have to assign as follow
5 kx #
5 kx # ..._SHORT_DESCRIPTION = name \& \\ \* \( \) end
5 kx #
5 kx # Here we have to remove backslashes and fill escaped symbols as is:
5 kx #
5 kx $description =~ s/\\(.?)/$1/g;
5 kx
5 kx return $description;
5 kx }
5 kx
5 kx #
5 kx # Getting information from tarball/{.PKGINFO | .DESCRIPTION}
5 kx #
5 kx sub get_pkg_info
5 kx {
5 kx my $infofile = shift;
5 kx my $data_field = shift;
5 kx my $data = "";
5 kx
5 kx open( FILE, "< $infofile" );
5 kx
5 kx while( <FILE> )
5 kx {
5 kx if( /^$data_field=(.+)/ )
5 kx {
5 kx $data = $1;
5 kx }
5 kx }
5 kx close( FILE );
5 kx
5 kx return $data;
5 kx }
5 kx
5 kx sub get_pkg_description
5 kx {
5 kx my $descfile = shift;
5 kx my $data = "";
5 kx my @fields;
5 kx
5 kx open( FILE, "< $descfile" );
5 kx
5 kx # Read the first line only
5 kx @fields = split( ':', <FILE> );
5 kx $data = $fields[1];
5 kx $data =~ s/^\s+|\s+$//;
5 kx $data =~ s/\"/\'/g;
5 kx chomp $data;
5 kx
5 kx close( FILE );
5 kx
5 kx return $data;
5 kx }
5 kx
5 kx
5 kx sub get_treedirs
5 kx {
5 kx my @list;
5 kx
5 kx seek( REQUIRES_FILE, 0, SEEK_SET );
5 kx
5 kx while( <REQUIRES_FILE> )
5 kx {
5 kx if( /^TREEDIRS(.+= +)(.+)/ )
5 kx {
5 kx @list = split( ' ', $2 );
5 kx }
5 kx }
5 kx
5 kx return @list;
5 kx }
5 kx
5 kx sub get_ntreedirs
5 kx {
5 kx my @list;
5 kx
5 kx seek( REQUIRES_FILE, 0, SEEK_SET );
5 kx
5 kx while( <REQUIRES_FILE> )
5 kx {
5 kx if( /^TREEDIRS(.+= +)(.+)/ )
5 kx {
5 kx @list = split( ' ', $2 );
5 kx }
5 kx }
5 kx
5 kx return $#list;
5 kx }
5 kx
5 kx sub get_root
5 kx {
5 kx my $root;
5 kx
5 kx seek( REQUIRES_FILE, 0, SEEK_SET );
5 kx
5 kx while( <REQUIRES_FILE> )
5 kx {
5 kx if( /^# ROOT(=)(.+)/ )
5 kx {
5 kx $root = $2;
5 kx }
5 kx }
5 kx
5 kx return $root;
5 kx }
5 kx
5 kx sub get_deps
5 kx {
5 kx my %deps;
5 kx
5 kx seek( REQUIRES_FILE, 0, SEEK_SET );
5 kx
5 kx while( <REQUIRES_FILE> )
5 kx {
5 kx if( /(.+)(: +)(.+)/ )
5 kx {
5 kx $deps{$1} = $3;
5 kx }
5 kx }
5 kx return %deps;
5 kx }
5 kx
5 kx my $root_node = 1;
5 kx
5 kx #
5 kx # PACKAGE HASH:
5 kx # ============
5 kx #
5 kx # name => $(PKG_NAME) from Makefile
5 kx # version => $(PKG_VERSION) from Makefile
5 kx # group => $(PKG_GROUP) from Makefile {app,base,dev,libs,net,...}
5 kx #
5 kx # arch => $toolchain from comandline args
5 kx # hardware => $hardware from comandline args
5 kx # flavour => $flavour from comandline args for ROOT pkg, from REQUIRES for dependencies
5 kx # tarball => "$name-$version-$arch-$distro_name-$distro_version.$tarball_suffix"
5 kx #
5 kx # distro_name => $(DISTRO_NAME) from build-system/constants.mk
5 kx # distro_version => $(DISTRO_VERSION) from build-system/constants.mk
5 kx # url => $(BUG_URL) from build-system/constants.mk
5 kx # license => from Makefile
5 kx # short_description => from Makefile
5 kx # description => first line from .DESCRIPTION
5 kx # uncompressed_size => from .PKGINFO
5 kx # total_files => from .PKGINFO
5 kx #
5 kx # dir => path to Makefile from .$(HW)_requires
5 kx # children =>
5 kx #
5 kx sub fill_package_info
5 kx {
5 kx my $base_dir = shift;
5 kx my $makefile = shift;
5 kx my $flavour = shift;
5 kx my ( $product_path, $tarball_file );
5 kx my %pkg = ();
5 kx
5 kx $pkg{'dir'} = $base_dir;
5 kx $pkg{'install'} = pkg_rootfs_target( $makefile );
5 kx
5 kx $pkg{'name'} = pkg_name( $makefile );
5 kx if( $pkg{'name'} eq "" )
5 kx {
5 kx # There is no package for this Makefile
5 kx $pkg{'name'} = $pkg{'dir'};
5 kx return %pkg;
5 kx }
5 kx
5 kx $pkg{'version'} = pkg_version( $makefile );
5 kx $pkg{'arch'} = $toolchain;
5 kx $pkg{'hardware'} = $hardware;
5 kx $pkg{'flavour'} = $flavour;
5 kx $pkg{'group'} = pkg_group( $makefile );
5 kx $pkg{'distro_name'} = $distro_name;
5 kx $pkg{'distro_version'} = $distro_version;
5 kx $pkg{'url'} = $url;
5 kx $pkg{'license'} = pkg_license( $makefile );
5 kx $pkg{'short_description'} = pkg_short_description( $makefile );
5 kx
5 kx $pkg{'tarball'} = $pkg{'name'} . "-" .
5 kx $pkg{'version'} . "-" .
5 kx $pkg{'arch'} . "-" .
5 kx $distro_name . "-" .
5 kx $distro_version . "." .
5 kx $tarball_suffix;
5 kx
5 kx $pkg{'description'} = $pkg{'name'} . " " . $pkg{'version'} . " (" . $pkg{'short_description'} . ")";
5 kx $pkg{'uncompressed_size'} = '';
5 kx $pkg{'total_files'} = '';
5 kx
5 kx $product_path = $topdir . "/dist/products/" . $toolchain . "/" . $hardware;
5 kx if( $flavour eq "" )
5 kx {
5 kx $tarball_file = $product_path . "/" . $pkg{'group'} . "/" . $pkg{'tarball'};
5 kx }
5 kx else
5 kx {
5 kx $tarball_file = $product_path . "/" . $pkg{'group'} . "/" . $pkg{'flavour'} . "/" . $pkg{'tarball'};
5 kx }
5 kx
5 kx if( -e $tarball_file )
5 kx {
5 kx my $cleanup = 1;
5 kx my $fname = "$target_build_dir/.$hardware.pkginfo.XXXXXXXX";
5 kx my $tempname;
5 kx
5 kx (undef, $tempname) = File::Temp::tempfile( $fname, OPEN => 0, UNLINK => $cleanup );
5 kx
5 kx _kxLab::system( "xzcat $tarball_file | tar -xvf - \".PKGINFO\" -O 1> $tempname 2> /dev/null" );
5 kx
5 kx $pkg{'uncompressed_size'} = get_pkg_info( $tempname, "uncompressed_size" );
5 kx $pkg{'total_files'} = get_pkg_info( $tempname, "total_files" );
5 kx
5 kx unlink $tempname;
5 kx }
5 kx
5 kx return %pkg;
5 kx }
5 kx
5 kx
5 kx sub print_package_head
5 kx {
5 kx my ( $level, $pkg ) = @_;
5 kx my $indent = "";
5 kx
5 kx $level *= 2;
5 kx while( $level )
5 kx {
5 kx $indent .= " ";
5 kx $level--;
5 kx }
5 kx print JS_TREE_FILE $indent . "{\n";
5 kx
5 kx if( $pkg->{'name'} eq $pkg->{'dir'} )
5 kx {
5 kx if( $root_node == 1 )
5 kx {
5 kx print JS_TREE_FILE $indent . " \"distro\": ["
5 kx . " \"" . $distro_name . "\","
5 kx . " \"" . $distro_version . "\","
5 kx . " \"" . $url . "\""
5 kx . " ],\n";
5 kx }
5 kx print JS_TREE_FILE $indent . " \"name\": \"" . $pkg->{'name'} . "\"";
5 kx }
5 kx else
5 kx {
5 kx if( $root_node == 1 )
5 kx {
5 kx print JS_TREE_FILE $indent . " \"distro\": ["
5 kx . " \"" . $distro_name . "\","
5 kx . " \"" . $distro_version . "\","
5 kx . " \"" . $url . "\""
5 kx . " ],\n";
5 kx }
5 kx if( !defined $pkg->{'group'} || $pkg->{'group'} eq "" )
5 kx {
5 kx print JS_TREE_FILE $indent . " \"name\": \""
5 kx . $pkg->{'name'} . "-"
5 kx . $pkg->{'version'} . "\"";
5 kx }
5 kx else
5 kx {
5 kx print JS_TREE_FILE $indent . " \"name\": \""
5 kx . $pkg->{'group'} . ":"
5 kx . $pkg->{'name'} . "-"
5 kx . $pkg->{'version'} . "\"";
5 kx }
5 kx }
5 kx }
5 kx
5 kx sub print_package_start_children
5 kx {
5 kx my $level = shift;
5 kx my $indent = "";
5 kx
5 kx $level *= 2;
5 kx while( $level )
5 kx {
5 kx $indent .= " ";
5 kx $level--;
5 kx }
5 kx print JS_TREE_FILE $indent . " \"children\": [\n";
5 kx }
5 kx
5 kx sub print_package_finish_children
5 kx {
5 kx my $level = shift;
5 kx my $indent = "";
5 kx
5 kx $level *= 2;
5 kx while( $level ) { $indent .= " "; $level--; }
5 kx print JS_TREE_FILE $indent . " ]\n";
5 kx }
5 kx
5 kx sub print_package_tail
5 kx {
5 kx my $level = shift;
5 kx my $indent = "";
5 kx
5 kx $level *= 2;
5 kx while( $level ) { $indent .= " "; $level--; }
5 kx print JS_TREE_FILE $indent . "}";
5 kx }
5 kx
5 kx sub print_comma
5 kx {
5 kx my $comma = shift;
5 kx
5 kx if( $comma > 0 ) { print JS_TREE_FILE ",\n"; }
5 kx else { print JS_TREE_FILE "\n"; }
5 kx }
5 kx
5 kx
5 kx #
5 kx # Parse the command line options
5 kx #
5 kx
5 kx # Get the rest arguments of the command line
5 kx $topdir = shift;
5 kx $toolchain = shift;
5 kx $hardware = shift;
5 kx $flavour = shift;
5 kx
5 kx my $makefile = "Makefile";
5 kx
5 kx if( ! defined $topdir or $topdir eq "" ) { usage; }
5 kx if( ! defined $toolchain or $toolchain eq "" ) { usage; }
5 kx if( ! defined $hardware or $hardware eq "" ) { usage; }
5 kx if( ! defined $flavour or $flavour eq "" ) { $flavour = ""; }
5 kx
5 kx _kxLab::error( "$0: $topdir is not a directory" ) if( ! -d $topdir );
5 kx _kxLab::error( "$0: Makefile missing: $makefile" ) if ( ! -f $makefile );
5 kx
5 kx $build_system = $topdir . "/build-system";
5 kx
5 kx $system_version = system_version( $build_system );
5 kx $distro_name = distro_name( $build_system );
5 kx $distro_version = distro_version( $build_system );
5 kx $url = bug_url( $build_system );
5 kx
5 kx
5 kx if( $flavour eq "" )
5 kx {
5 kx $target_build_dir = "." . $toolchain . "/" . $hardware;
5 kx }
5 kx else
5 kx {
5 kx $target_build_dir = "." . $toolchain . "/" . $hardware . "/" . $flavour;
5 kx }
5 kx
5 kx $requires_file = $target_build_dir . "/.requires";
5 kx
5 kx if( $flavour eq "" )
5 kx {
5 kx $html_tree_file = $target_build_dir . "/" . $hardware . ".tree.html";
5 kx $js_tree_file = $target_build_dir . "/" . $hardware . ".tree.json";
5 kx $js_pkgs_file = $target_build_dir . "/" . $hardware . ".pkgs.json";
5 kx }
5 kx else
5 kx {
5 kx $html_tree_file = $target_build_dir . "/" . $hardware . "-" . $flavour . ".tree.html";
5 kx $js_tree_file = $target_build_dir . "/" . $hardware . "-" . $flavour . ".tree.json";
5 kx $js_pkgs_file = $target_build_dir . "/" . $hardware . "-" . $flavour . ".pkgs.json";
5 kx }
5 kx
5 kx my $jsmin = $ENV{JSMIN};
5 kx if( $jsmin ne "" )
5 kx {
5 kx $js_min_tree_file = $js_tree_file;
5 kx $js_min_tree_file =~ s/\.json$/\.min\.json/;
5 kx
5 kx $js_min_pkgs_file = $js_pkgs_file;
5 kx $js_min_pkgs_file =~ s/\.json$/\.min\.json/;
5 kx }
5 kx
5 kx # open the intput file
5 kx open(REQUIRES_FILE, "< $requires_file") or
5 kx _kxLab::error( "$0: Could not open $requires_file file: $!" );
5 kx # open the output files
5 kx open(JS_TREE_FILE, "> $js_tree_file") or
5 kx _kxLab::error( "$0: Could not open $js_tree_file file: $!" );
5 kx open(JS_PKGS_FILE, "> $js_pkgs_file") or
5 kx _kxLab::error( "$0: Could not open $js_pkgs_file file: $!" );
5 kx
5 kx
5 kx my $depth = 2;
5 kx my $level = 0;
5 kx my $root = get_root();
5 kx my @treedirs = get_treedirs();
5 kx my %deps = get_deps();
5 kx
5 kx sub print_tree
5 kx {
5 kx my ($level, $last, $pkg) = @_;
5 kx
5 kx if( $depth < $level ) { $depth = $level; }
5 kx
5 kx print_package_head( $level, \%{$pkg} );
5 kx $root_node = 0;
5 kx
5 kx if( $pkg->{'children'} )
5 kx {
5 kx print_comma( 1 );
5 kx print_package_start_children( $level );
5 kx
5 kx my @a = @{$pkg->{'children'}};
5 kx my $n = $#a;
5 kx
5 kx foreach my $p ( @{$pkg->{'children'}} )
5 kx {
5 kx print_tree( $level + 1, $n--, \%{$p} );
5 kx }
5 kx
5 kx print_package_finish_children( $level );
5 kx }
5 kx else
5 kx {
5 kx print_comma( 0 );
5 kx }
5 kx print_package_tail( $level );
5 kx print_comma( $last );
5 kx }
5 kx
5 kx
5 kx #
5 kx # This is the root package
5 kx #
5 kx %tree = fill_package_info( $root, $makefile, $flavour );
5 kx
5 kx
5 kx my %sequence;
5 kx my $order = 0;
5 kx
5 kx #################################################################
5 kx # if( there is any dependencies )
5 kx #
5 kx if( %deps )
5 kx {
5 kx my @dep_keys = keys %deps;
5 kx
5 kx my $count = scalar( keys %deps );
5 kx
5 kx foreach my $dir ( @treedirs )
5 kx {
5 kx if( ! grep { $_ eq $dir } @dep_keys )
5 kx {
5 kx my $key = $dir;
5 kx $sequence{$key} = ++$order;
5 kx @treedirs = grep { $_ ne $key } @treedirs;
5 kx
5 kx # Split dir^flavour:
5 kx my ($d, $f);
5 kx $d = `echo $dir | cut -f 1 -d '^'`;
5 kx $d =~ s/^\s+|\s+$//;
5 kx if( $dir =~ m/\^/ )
5 kx {
5 kx $f = `echo $dir | cut -f 2 -d '^'`;
5 kx $f =~ s/^\s+|\s+$//;
5 kx }
5 kx else
5 kx {
5 kx $f = "";
5 kx }
5 kx
5 kx # Insert into sub_trees:
5 kx my %pkg = fill_package_info( $d, $topdir . "/" . $d . "/Makefile", $f );
5 kx $sub_trees{$dir} = \%pkg;
5 kx
5 kx delete $deps{$dir};
5 kx }
5 kx }
5 kx
5 kx
5 kx for( my $i = 0; $i < $count; ++$i )
5 kx {
5 kx my @installed = keys %sequence;
5 kx
5 kx foreach my $key (sort keys %deps)
5 kx {
5 kx my $ok = 1;
5 kx my @dirs = split( ' ', $deps{$key} );
5 kx
5 kx if( $key ne "all" )
5 kx {
5 kx foreach my $dir ( @dirs )
5 kx {
5 kx if( ! grep { $_ eq $dir } @installed )
5 kx {
5 kx $ok = 0;
5 kx }
5 kx }
5 kx
5 kx if( $ok == 1 )
5 kx {
5 kx $sequence{$key} = ++$order;
5 kx
5 kx # Split dir^flavour:
5 kx my ($d, $f);
5 kx $d = `echo $key | cut -f 1 -d '^'`;
5 kx $d =~ s/^\s+|\s+$//;
5 kx if( $key =~ m/\^/ )
5 kx {
5 kx $f = `echo $key | cut -f 2 -d '^'`;
5 kx $f =~ s/^\s+|\s+$//;
5 kx }
5 kx else
5 kx {
5 kx $f = "";
5 kx }
5 kx
5 kx # create package node:
5 kx my %pkg = fill_package_info( $d, $topdir . "/" . $d . "/Makefile", $f );
5 kx # add children:
5 kx foreach my $dir ( @dirs )
5 kx {
5 kx my $child = $sub_trees{$dir};
5 kx push( @{$pkg{'children'}}, $child );
5 kx }
5 kx
5 kx # insert new sub tree into $sub_tree:
5 kx $sub_trees{$key} = \%pkg;
5 kx
5 kx delete $deps{$key};
5 kx }
5 kx }
5 kx }
5 kx }
5 kx
5 kx #
5 kx # The root node children
5 kx #
5 kx my @dirs = split( ' ', $deps{'all'} );
5 kx foreach my $dir ( @dirs )
5 kx {
5 kx my $child = $sub_trees{$dir};
5 kx push( @{$tree{'children'}}, $child );
5 kx }
5 kx
5 kx }
5 kx else
5 kx {
5 kx my %pkg;
5 kx
5 kx $pkg{'dir'} = "void";
5 kx $pkg{'name'} = "void";
5 kx
5 kx push( @{$tree{'children'}}, \%pkg );
5 kx }
5 kx #
5 kx # End if( there is any dependencies )
5 kx #################################################################
5 kx
5 kx
5 kx print_tree( $level, 0, \%tree );
5 kx
5 kx # close tree JSON file:
5 kx close JS_TREE_FILE;
5 kx
5 kx
5 kx #################################################################
5 kx # Calculate SVG size and make HTML from template:
5 kx #
5 kx my $copyright_url = $url;
5 kx my $html_template = $build_system . "/html/requires_tree_html.template";
5 kx my $w = $depth;
5 kx my $h = get_ntreedirs();
5 kx my ($width, $height);
5 kx
5 kx $h = $h * 4 / 5;
5 kx
5 kx $width = ($w + 4) * 160;
5 kx $height = ($h + 4) * 24;
5 kx
5 kx $root =~ s/\//\\\//g;
5 kx $root =~ s/\-/\\\-/g;
5 kx $root =~ s/\+/\\\+/g;
5 kx $root =~ s/\./\\\./g;
5 kx
5 kx $copyright_url =~ s/\//\\\//g;
5 kx $copyright_url =~ s/\-/\\\-/g;
5 kx $copyright_url =~ s/\+/\\\+/g;
5 kx $copyright_url =~ s/\./\\\./g;
5 kx
5 kx
5 kx
5 kx my $js_tree_file_name = basename( $js_tree_file );
5 kx my $js_pkgs_file_name = basename( $js_pkgs_file );
5 kx
5 kx if( $jsmin ne "" )
5 kx {
5 kx # minimize JSON tree file:
5 kx _kxLab::system( "$jsmin -o $js_min_tree_file $js_tree_file" );
5 kx $js_tree_file_name = basename( $js_min_tree_file );
5 kx $js_pkgs_file_name = basename( $js_min_pkgs_file );
5 kx # minimize JSON pkgs file later.
5 kx }
5 kx
5 kx my $copyright = "Radix cross Linux";
5 kx
5 kx my ( $second, $minute, $hour, $day, $month, $year );
5 kx
5 kx #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
5 kx
5 kx $second = localtime->sec();
5 kx $minute = localtime->min();
5 kx $hour = localtime->hour();
5 kx $day = localtime->mday();
5 kx $month = localtime->mon() + 1;
5 kx $year = localtime->year() + 1900;
5 kx
5 kx my $call_string = sprintf( "cat %s | " .
5 kx "sed 's/\@HARDWARE\@/%s/g' | " .
5 kx "sed 's/\@ROOT\@/%s/g' | " .
5 kx "sed 's/\@TARBALL_SUFFIX\@/%s/g' | " .
5 kx "sed 's/\@BUG_URL\@/%s/g' | " .
5 kx "sed 's/\@COPYING\@/%s/g' | " .
5 kx "sed 's/\@YEAR\@/%s/g' | " .
5 kx "sed 's/\@MONTH\@/%s/g' | " .
5 kx "sed 's/\@DAY\@/%s/g' | " .
5 kx "sed 's/\@HOUR\@/%s/g' | " .
5 kx "sed 's/\@MINUTE\@/%s/g' | " .
5 kx "sed 's/\@SECOND\@/%s/g' | " .
5 kx "sed 's/\@SVG_WIDTH\@/%d/g' | " .
5 kx "sed 's/\@SVG_HEIGHT\@/%d/g' | " .
5 kx "sed 's/\@JSON_PKGS_FILE\@/%s/g' | " .
5 kx "sed 's/\@JSON_TREE_FILE\@/%s/g' > " . $html_tree_file,
5 kx $html_template,
5 kx $hardware,
5 kx $root,
5 kx $tarball_suffix,
5 kx $copyright_url,
5 kx $copyright,
5 kx $year, $month, $day,
5 kx $hour, $minute, $second,
5 kx $width, $height,
5 kx $js_pkgs_file_name,
5 kx $js_tree_file_name );
5 kx _kxLab::system( $call_string );
5 kx
5 kx #
5 kx # End of creating HTML file
5 kx #################################################################
5 kx
5 kx
5 kx # close input file:
5 kx close REQUIRES_FILE;
5 kx
5 kx
5 kx #################################################################
5 kx # Write packages JSON file and count the number of packages:
5 kx #
5 kx sub compare_order
5 kx {
5 kx $sequence{$a} <=> $sequence{$b};
5 kx }
5 kx
5 kx print JS_PKGS_FILE "[";
5 kx
5 kx my $packages_done = 0;
5 kx
5 kx sub print_result
5 kx {
5 kx my $out_string = sprintf( "####### Required Packages Tree (done: %4d packages)\n", $packages_done );
5 kx
5 kx print $out_string;
5 kx }
5 kx
5 kx print "#######\n";
5 kx
5 kx foreach my $dir (sort compare_order( (keys %sequence) ))
5 kx {
5 kx my $package;
5 kx
5 kx if( $dir ne "all" )
5 kx {
5 kx $package = $sub_trees{$dir};
5 kx
5 kx if( $package->{'install'} ne "no" )
5 kx {
5 kx
5 kx if( $packages_done == 0 )
5 kx {
5 kx print JS_PKGS_FILE "{\n";
5 kx }
5 kx else
5 kx {
5 kx print JS_PKGS_FILE ",\n";
5 kx print JS_PKGS_FILE " {\n";
5 kx }
5 kx
5 kx if( !defined $package->{'group'} || $package->{'group'} eq "" )
5 kx {
5 kx print JS_PKGS_FILE " \"id\": \""
5 kx . $package->{'name'} . "-"
5 kx . $package->{'version'} . "\",\n";
5 kx }
5 kx else
5 kx {
5 kx print JS_PKGS_FILE " \"id\": \""
5 kx . $package->{'group'} . ":"
5 kx . $package->{'name'} . "-"
5 kx . $package->{'version'} . "\",\n";
5 kx }
5 kx print JS_PKGS_FILE " \"name\": \"" . $package->{'name'} . "\",\n";
5 kx print JS_PKGS_FILE " \"version\": \"" . $package->{'version'} . "\",\n";
5 kx print JS_PKGS_FILE " \"group\": \"" . $package->{'group'} . "\",\n";
5 kx print JS_PKGS_FILE " \"arch\": \"" . $package->{'arch'} . "\",\n";
5 kx print JS_PKGS_FILE " \"hardware\": \"" . $package->{'hardware'} . "\",\n";
5 kx if( defined $package->{'flavour'} && $package->{'flavour'} ne "" )
5 kx {
5 kx print JS_PKGS_FILE " \"flavour\": \"" . $package->{'flavour'} . "\",\n";
5 kx }
5 kx print JS_PKGS_FILE " \"license\": \"" . $package->{'license'} . "\",\n";
5 kx print JS_PKGS_FILE " \"description\": \"" . $package->{'description'} . "\",\n";
5 kx print JS_PKGS_FILE " \"uncompressed_size\": \"" . $package->{'uncompressed_size'} . "\",\n";
5 kx print JS_PKGS_FILE " \"total_files\": \"" . $package->{'total_files'} . "\"\n";
5 kx print JS_PKGS_FILE " }";
5 kx
5 kx ++$packages_done;
5 kx }
5 kx }
5 kx }
5 kx
5 kx #
5 kx # Print the root node of tree:
5 kx #
5 kx my $tree = \%tree;
5 kx
5 kx if( $tree->{'install'} ne "no" )
5 kx {
5 kx
5 kx if( $packages_done == 0 )
5 kx {
5 kx print JS_PKGS_FILE "{\n";
5 kx }
5 kx else
5 kx {
5 kx print JS_PKGS_FILE ",\n";
5 kx print JS_PKGS_FILE " {\n";
5 kx }
5 kx
5 kx if( !defined $tree->{'group'} || $tree->{'group'} eq "" )
5 kx {
5 kx print JS_PKGS_FILE " \"id\": \""
5 kx . $tree->{'name'} . "-"
5 kx . $tree->{'version'} . "\",\n";
5 kx }
5 kx else
5 kx {
5 kx print JS_PKGS_FILE " \"id\": \""
5 kx . $tree->{'group'} . ":"
5 kx . $tree->{'name'} . "-"
5 kx . $tree->{'version'} . "\",\n";
5 kx }
5 kx print JS_PKGS_FILE " \"name\": \"" . $tree->{'name'} . "\",\n";
5 kx print JS_PKGS_FILE " \"version\": \"" . $tree->{'version'} . "\",\n";
5 kx print JS_PKGS_FILE " \"group\": \"" . $tree->{'group'} . "\",\n";
5 kx print JS_PKGS_FILE " \"arch\": \"" . $tree->{'arch'} . "\",\n";
5 kx print JS_PKGS_FILE " \"hardware\": \"" . $tree->{'hardware'} . "\",\n";
5 kx if( defined $tree->{'flavour'} && $tree->{'flavour'} ne "" )
5 kx {
5 kx print JS_PKGS_FILE " \"flavour\": \"" . $tree->{'flavour'} . "\",\n";
5 kx }
5 kx print JS_PKGS_FILE " \"license\": \"" . $tree->{'license'} . "\",\n";
5 kx print JS_PKGS_FILE " \"description\": \"" . $tree->{'description'} . "\",\n";
5 kx print JS_PKGS_FILE " \"uncompressed_size\": \"" . $tree->{'uncompressed_size'} . "\",\n";
5 kx print JS_PKGS_FILE " \"total_files\": \"" . $tree->{'total_files'} . "\"\n";
5 kx print JS_PKGS_FILE " }";
5 kx
5 kx ++$packages_done;
5 kx }
5 kx
5 kx print JS_PKGS_FILE "]\n";
5 kx
5 kx print_result();
5 kx print "#######\n";
5 kx #
5 kx # End of packages JSON file write.
5 kx #################################################################
5 kx
5 kx # close pkgs JSON file:
5 kx close JS_PKGS_FILE;
5 kx
5 kx if( $jsmin ne "" )
5 kx {
5 kx # minimize JSON tree file:
5 kx _kxLab::system( "$jsmin -o $js_min_pkgs_file $js_pkgs_file" );
5 kx }
5 kx