Repository List / sciq4 / genqrc.pl @ HEAD

#!/usr/bin/perl

use strict;
use warnings;
use File::Spec;
use File::Spec::Functions qw/splitdir catdir/;

our $qrc = shift @ARGV;
our $dir = shift @ARGV;
our $indent = 0;

open OUT, ">$qrc" or die "failed to open $qrc for writing: $!\n";
print OUT '<!DOCTYPE RCC>' . "\n" . '<RCC version="1.0">' . "\n";

scandir($dir);

print OUT '</RCC>' . "\n";

sub scandir {
	my $dir = shift;
	local *DIR;
	if(!opendir DIR, $dir) {
		warn "failed to open $dir: $!\n";
		return;
	}

	for(readdir DIR) {
		my $path = catdir($dir,$_);
		next if /^\..*$/;
		next if /^.*\.(?:cpp|qrc)$/;
		next if /^.*~$/;
#		print $path ."\n";
		lstat $path;
		$path =~ s|^qrc/(.*)$|$1|;
		if(-d _) {
			if(!$indent) {
				print OUT '<qresource prefix="' . $_ . '">';
			}

			$indent++;
			scandir(catdir("qrc", $path));
			--$indent;

			if(!$indent) {
				print OUT "\n</qresource>\n";
			}
		}
=pod
		elsif(-l _) {
			my $link = readlink catdir("qrc", $path);

			print OUT "\n\t"x$indent;
			if($indent > 0) {
				my @dirs = splitdir($link);
				my $fn = pop @dirs;
				print OUT "<file alias=\"" . $fn . "\">$link</file>";
			} else {
				print OUT "<file alias=\"" . $path . "\">" . $link . "</file>";
			}
		}
=cut
		elsif(-f _ || -l _) {
			print OUT "\n" . ("\t"x$indent);
			if($indent > 0) {
				my @dirs = splitdir($path); shift @dirs;
				my $npath = catdir(@dirs);
				print OUT "<file alias=\"" . $npath . "\">" . $path . "</file>";
			} else {
				print OUT "<file alias=\"" . $path . "\">" . $path . "</file>";
			}
		}
	}

	closedir DIR;
}