#!/usr/bin/perl 
#
# Myrpm.pl is distributed under the GPL v2 licence terms
# Contact : Jean-Marie Renouard <jmrenouard at gmail.com>
#
# ENLIGHTMENT ROAD
# FEA 13 : config from rpm --showrc
# FEA 16 : autobuild list for install

use warnings;
use strict;
use Text::Template;
use Archive::Tar;
use File::stat;
use File::Path;
use Getopt::Long;
use File::Find;
use File::Basename;
use File::Spec;
use Cwd;

sub trim($);
sub printUsage($);
sub printError($);

my $version_number = "4.42";
printError("Wrong parameter : -N, -V ,-R at least\n$0 -h for help")
  unless ( $#ARGV >= 0 );

######
# Configuration section
######
my @reserved_dirs = (
    '^\/bin$',    '^\/sbin$',       '^\/dev$',      '^\/home$',
    '^\/lib$',    '^\/media$',      '^\/mnt$',      '^\/proc$',
    '^\/srv$',    '^\/tmp$',        '^\/var\/log$', '^\/var\/lib$',
    '^\/var$',    '^\/boot$',       '^\/etc$',      '^\/etc\/rc.d',
    '^\/initrd$', '^\/lost+found$', '^\/root$',     '^\/selinux$',
    '^\/sys$',    '^\/usr$',        '\/usr\/sbin$', '\/usr\/bin$'
);

my @config_pattern = (
    "config", "conf",, "etc",
    "initrd", "\.conf", "\.properties", "\.cnf",
    "\.ini",  "\.xml"
);
my @doc_pattern =
  ( "doc", "\.txt", "README", "LICENCE", "LICENSE", "TODO", "\.html", "\.tex" );

my %dirAlias = (
    "/usr/sbin"    => "%{_sbindir}",
    "/usr/bin"     => "%{_bindir}",
    "/usr/lib"     => "%{_libdir}",
    "/usr/libexec" => "%{_libexecdir}",
    "/usr/share"   => "%{_datadir}",
    "/var"         => "%{_var}"
);
my $macrosFile = $ENV{'HOME'} . "/.rpmmacros";

my $topdir          = getParameterFromConfig( "_topdir", "/usr/src/redhat" );
my $specDir         = $topdir . "/SPECS";
my $srcDir          = $topdir . "/SOURCES";
my $archiveRootPath = "/tmp/myrpm";

######
# Misc declaration section
######
my $line      = "";
my @files     = ();
my @instFiles = ();
my @instDirs  = ();

my @defFiles     = ();
my @defConfFiles = ();
my @defDocFiles  = ();

######
# Command line option section
######
Getopt::Long::Configure('bundling');

my (
    $help,          $build,           $verbose,     $multi,
    $templateName,  $root_dir,        $snap_dir,    $Name,
    $Version,       $Release,         $Description, $Summary,
    $ChangeLog,     $Packager,        $Vendor,      $VendorUrl,
    $Archi,         $Distro,          $archive,     $requires_string,
    $pre_script,    $build_script,    $post_script, $preun_script,
    $postun_script, $exclude_pattern, $uid,         $gid,
    $nodoc,         $noconf,          $nores
);

GetOptions(
    "h"                => \$help,
    "help"             => \$help,
    "b"                => \$build,
    "build"            => \$build,
    "v"                => \$verbose,
    "verbose"          => \$verbose,
    "m"                => \$multi,
    "multiple"         => \$multi,
    "t=s"              => \$templateName,
    "template=s"       => \$templateName,
    "r=s"              => \$root_dir,
    "root-directory=s" => \$root_dir,
    "d=s"              => \$snap_dir,
    "directory=s"      => \$snap_dir,
    "x=s"              => \$exclude_pattern,
    "exclude=s"        => \$exclude_pattern,
    "a=s"              => \$archive,
    "archive=s"        => \$archive,
    "u=s"              => \$uid,
    "uid=s"            => \$uid,
    "g=s"              => \$gid,
    "gid=s"            => \$gid,
    "n"                => \$nodoc,
    "nodoc"            => \$nodoc,
    "c"                => \$noconf,
    "noconfig"         => \$noconf,
    "s"                => \$nores,
    "noreserved"       => \$nores,
    "N=s"              => \$Name,
    "name=s"           => \$Name,
    "V=s"              => \$Version,
    "version=s"        => \$Version,
    "R=s"              => \$Release,
    "release=s"        => \$Release,
    "C=s"              => \$ChangeLog,
    "changelog=s"      => \$ChangeLog,
    "D=s"              => \$Description,
    "description=s"    => \$Description,
    "S=s"              => \$Summary,
    "summary=s"        => \$Summary,
    "P=s"              => \$Packager,
    "packager=s"       => \$Packager,
    "O=s"              => \$Vendor,
    "vendor=s"         => \$Vendor,
    "U=s"              => \$VendorUrl,
    "url-vendor=s"     => \$VendorUrl,
    "A=s"              => \$Archi,
    "architecture=s"   => \$Archi,
    "T=s"              => \$Distro,
    "distribution=s"   => \$Distro,
    "requires=s"       => \$requires_string,
    "pre-script=s"     => \$pre_script,
    "post-script=s"    => \$post_script,
    "preun-script=s"   => \$preun_script,
    "postun-script=s"  => \$postun_script,
    "build-script=s"   => \$build_script
);

printUsage($0) if defined $help;

($templateName) || ( $templateName = shift ) || ( $templateName = "" );
($root_dir)     || ( $root_dir     = shift ) || ( $root_dir     = "" );
$root_dir =~ s/\/$//;

($snap_dir) || ( $snap_dir = shift ) || ( $snap_dir = "" );
$snap_dir =~ s/\/$//;

($exclude_pattern) || ( $exclude_pattern = shift ) || ( $exclude_pattern = "" );

($archive) || ( $archive = shift ) || ( $archive = undef );

($uid) || ( $uid = shift ) || ( $uid = 0 );
($gid) || ( $gid = shift ) || ( $gid = 0 );
($Name) || ( $Name = shift ) || ( printError("Missing -N option : mandatory") );
($Version)
  || ( $Version = shift )
  || ( printError("Missing -V option : mandatory") );
($Release)
  || ( $Release = shift )
  || ( printError("Missing -R option : mandatory") );
($ChangeLog)
  || ( $ChangeLog = shift )
  || ( $ChangeLog = "http://www.123solution.fr - RPM solution provider" );

($Description)
  || ( $Description = shift )
  || ( $Description = "Package $Name-$Version-$Release" );
($Summary)
  || ( $Summary = shift )
  || ( $Summary = "This package is used for $Name-$Version-$Release" );
($Packager)
  || ( $Packager = shift )
  || ( $Packager =
    getParameterFromConfig( "packager", "jmrenouard\@gmail.com" ) );
($Vendor)
  || ( $Vendor = shift )
  || ( $Vendor = getParameterFromConfig( "vendor", "123Solution" ) );
($VendorUrl)
  || ( $VendorUrl = shift )
  || ( $VendorUrl =
    getParameterFromConfig( "vendor_url", "http://www.123solution.fr" ) );
($Archi)
  || ( $Archi = shift )
  || ( $Archi = getParameterFromConfig( "_arch", "noarch" ) );
($Distro)
  || ( $Distro = shift )
  || ( $Distro = getParameterFromConfig( "_dist", "Generic Red Hat" ) );

($pre_script) || ( $pre_script = shift ) || ( $pre_script = "" );
print "\n * pre : $pre_script" if defined $verbose;

($preun_script) || ( $preun_script = shift ) || ( $preun_script = "" );
print "\n * preun : $preun_script" if defined $verbose;

($post_script) || ( $post_script = shift ) || ( $post_script = "" );
print "\n * post : $post_script" if defined $verbose;

($postun_script) || ( $postun_script = shift ) || ( $postun_script = "" );
print "\n * postun : $postun_script" if defined $verbose;

($build_script) || ( $build_script = shift ) || ( $build_script = "" );
print "\n * install : $build_script" if defined $verbose;

($requires_string) || ( $requires_string = shift ) || ( $requires_string = "" );
print "\n * requires info : $requires_string" if defined $verbose;

my @reqs = split( ',', $requires_string );

######
##
######
@doc_pattern    = () if defined $nodoc;
@config_pattern = () if defined $noconf;
@reserved_dirs  = () if defined $nores;

######
# Checking arguments section
######
print "\t * Version : " . $version_number . "\n" if defined $verbose;

my %lusers;
my %lgroups;

#Version
printError("Wrong version format : XX.YY;ZZ, XX.YY, ...")
  unless ( $Version =~ /^[0-9][0-9\.]*$/ );
print "Checking version : $Version: OK\n" if defined $verbose;

#Release
printError("Wrong release format : X without dots")
  unless ( $Release =~ /^[1-9][0-9]*$/ );
print "Checking release : $Release: OK\n" if defined $verbose;

####
# Handling archive mode
####
my $tmp_dir = undef;
if ( defined $archive ) {

    # check archive permissions
    printError("Unable to read archive file $archive") unless -r $archive;

    # Create temporary dir
    $snap_dir = "$archiveRootPath/$$";
    $tmp_dir  = "$snap_dir/$root_dir";
    print "\n * Try to create $tmp_dir" if defined $verbose;
    eval { mkpath($tmp_dir) };
    if ($@) {
        print "\n * Couldn't create $tmp_dir: $@";
    }
    print "\n* $tmp_dir created." if defined $verbose;

    my $cwdir = getcwd;
    chdir $tmp_dir;

    my $compressed_archive = ( $archive =~ /.+?\.(?:tar\.gz|tgz)$/i );
    my $arch_obj = Archive::Tar->new( $archive, $compressed_archive );
    $arch_obj->extract();

    #change uid if necessary
    print "\n* $uid($gid) rigths setting." if defined $verbose;
    $uid = getUserId($uid);
    $gid = getGroupId($gid);
    find(
        sub {
            print "\n * setting rigths for $_" if defined $verbose;
            chown $uid, $gid, $_;
        },
        $tmp_dir
    );
    chdir $cwdir;

    #Priority for archive option
    $root_dir = $snap_dir;
}

#Checking directory
my $current_dir = getcwd;
$root_dir = trim $current_dir if ( $root_dir =~ /^\.$/ );
print "Root directory : ==>$root_dir<==\n" if defined $verbose;
printError("Root dir doesnt exists or is empty")
  unless ( -d $root_dir || $root_dir eq "" );
print "Checking root_dir OK\n" if defined $verbose;

$snap_dir = trim $current_dir if ( $snap_dir =~ /^\.$/ );
print "Snap directory : ==>$snap_dir<==\n" if defined $verbose;
printError("Snapshot dir doesn t exist or is empty")
  unless ( -d $snap_dir || $snap_dir eq "" );
print "Checking snap_dir OK\n" if defined $verbose;

my @inputFileList = getInputFileLine($snap_dir);

# Pattern exclusion handling
my @exclude_patterns = ();
@exclude_patterns = split /,/, $exclude_pattern if ( $exclude_pattern ne "" );

my %user_infos  = getUserMap();
my %group_infos = getGroupMap();

my %used_users     = ();
my %used_groups    = ();
my %symbolic_links = ();
foreach (@inputFileList) {
    my $line = $_;

    # Removing empty line
    next if ( $line eq "" );

    printError("Unable to read item : $line") unless -r $line || -l $line;

    #Translation of all line starting by a ./something into a absolute path
    $line = File::Spec->rel2abs($line);

    #The root dir is excluded
    next if ( $line eq $root_dir );

    my $pattern_found = 0;
    foreach (@exclude_patterns) {
        if ( $line =~ /$_/ ) {
            $pattern_found = 1;
            print "* Pattern found : $pattern_found for $line\n\n "
              if defined $verbose;
            last;
        }
    }

    next if ( $pattern_found == 1 );

    my $line_chrooted = $line;

    # Removing root_dir entry
    next if ( $line_chrooted eq $root_dir );

    $line_chrooted =~ s/^$root_dir\///;
    print "OK for $line_chrooted" if defined $verbose;

    print "\n* Traitement de '$line'" if defined $verbose;

    #Symbolic link handling
    if ( -l $line ) {
        my $pointedItem = File::Spec->rel2abs( readlink($line) );
        $pointedItem =~ s/^$root_dir\///;
        print "\n * Symbolic link detected : /$line_chrooted => $pointedItem"
          if defined $verbose;

        $symbolic_links{ "/" . $line_chrooted } = $pointedItem;
        next;
    }
    die(" $line does nt exists") unless ( -e $line );

    my $statFile = stat($line);
    my $mode     = $statFile->mode;
    my $uid      = $statFile->uid;
    my $gid      = $statFile->gid;

    print "\n* UID $uid GID : $gid" if defined $verbose;
    $used_users{$uid}++;
    $used_groups{$gid}++;

    print "\n * USED USERS :",  join ',', keys %used_users  if defined $verbose;
    print "\n * USED GROUPS :", join ',', keys %used_groups if defined $verbose;

    print "\n* user=" . $user_infos{$uid}{'name'}   if defined $verbose;
    print "\n* group=" . $group_infos{$gid}{'name'} if defined $verbose;

    my $trueMode = sprintf( "%04o", $mode & 07777 );
    push @files, "./$line_chrooted";
    print "\n\t * $line into Tar ball....\n" if defined $verbose;
    print "\t * $line and $line_chrooted into Spec file....\n"
      if defined $verbose;

    my $final_path = substituteAliasDir("/$line_chrooted");

    my %tmpData = ();
    $tmpData{mode}   = $trueMode;
    $tmpData{file}   = escapeSpecialChars($line_chrooted);
    $tmpData{path}   = escapeSpecialChars($final_path);
    $tmpData{r_path} = $final_path;
    $tmpData{uid}    = $user_infos{$uid}{'name'};
    $tmpData{gid}    = $group_infos{$gid}{'name'};

    #File case
    if ( -f "$line" ) {
        push @instFiles, \%tmpData;

        my $isDoc    = isDocFile("/$line_chrooted");
        my $isConfig = isConfigFile("/$line_chrooted");

        # Fix bug if is config and is doc at the same time
        #Choice to be a config file
        $isDoc = 0 if ( $isDoc && $isConfig );

        push @defFiles, \%tmpData if ( !$isDoc && !$isConfig );
        push @defConfFiles, \%tmpData if ($isConfig);
        push @defDocFiles,  \%tmpData if ($isDoc);
    }

    # Directory case
    # Must not be a reserved directory
    if ( -d "$line" ) {
        $tmpData{comment} = 1 if isReservedDir("/$line_chrooted");
        $tmpData{isDir} = 1;
        push @instDirs, \%tmpData;

        push @defFiles, \%tmpData if ( !isReservedDir("/$line_chrooted") );
    }
}

print "\n * uniq uids :" . join ', ', keys %used_users  if defined $verbose;
print "\n * uniq gids :" . join ', ', keys %used_groups if defined $verbose;

#Handling group creation
my @group_creation = ();
foreach ( keys %used_groups ) {

    #Avoid root group creation
    next if ( $_ == 0 );
    push @group_creation, $group_infos{$_};
}

#Handling user creation
my @user_creation = ();
foreach ( keys %used_users ) {

    #avoid root account :)
    #Avoid root user creation
    next if ( $_ == 0 );
    next if ( $_ < 500 );
    next if ( $user_infos{$_}{'shell'} =~ /nologin/ );
    print "\n*" . $user_infos{$_}{'name'} . " in users $_" if defined $verbose;

    # For all non system account
    # password is the same than user name
    # WARNING : Security issues around this feature
    $user_infos{$_}{init} = 1;
    push @user_creation, $user_infos{$_};
}

my $pre_code = getScriptFileContent($pre_script);

#Handling symbolic link replacement as post install code
my $post_code = getScriptFileContent($post_script);

my $templDef = getSpecTemplate($templateName);

my $template = Text::Template->new(
    SOURCE     => "$templDef",
    TYPE       => 'STRING',
    DELIMITERS => [ "<", ">" ]
) or die "Couldn't construct template: $Text::Template::ERROR";

my %vars = (
    name              => "$Name",
    version           => "$Version",
    release           => "$Release",
    summary           => "$Summary",
    description       => "$Description",
    reqs              => \@reqs,
    packager          => "$Packager",
    vendor            => "$Vendor",
    vendor_url        => "$VendorUrl",
    archi             => "$Archi",
    distro            => "$Distro",
    multiple_packages => defined $multi,
    users             => \@user_creation,
    groups            => \@group_creation,

    #Pre_code must be list
    pre_code => "$pre_code",

    #Post_code must be list
    post_code => "$post_code",

    symbolic_links => \%symbolic_links,
    preun_code     => getScriptFileContent($preun_script),

    postun_code => getScriptFileContent($postun_script),

    build_code => getScriptFileContent($build_script),

    # must be information only
    listOfFiles => \@defFiles,

    # must be information only
    listOfDocFiles => \@defDocFiles,

    # must be information only
    listOfConfFiles => \@defConfFiles,

    instFiles => \@instFiles,
    instDirs  => \@instDirs,

    ChangeLog => $ChangeLog,

    # must be information only
    OldChangeLogs => getChangeLogs("$specDir/$Name.spec"),

    #Avoid system call for portability
    date => trim(`unset LANG && date +"%a %b %d %Y"`)
);

# for debug only
if ( defined $verbose ) {
    use Data::Dumper;
    print Dumper(%vars);
}

my $result = $template->fill_in( HASH => \%vars );

die "Couldn't fill in template: $Text::Template::ERROR"
  unless ( defined $result );

# Chrrooting in fact
if   ( $root_dir eq "" ) { chdir("/") }
else                     { chdir($root_dir); }

#generate Tarball
my $tar = Archive::Tar->new;
foreach my $file (@files) {
    $file =~ s/^\//\.\//;
    print "\n$file to Archive..." if defined $verbose;
    $tar->add_files($file);
}

$tar->write( "$srcDir/$vars{'name'}-$vars{'version'}.tar.gz", 1 );

#Writing spec file
open F, "> $specDir/$vars{'name'}.spec"
  or printError(
"Unable to open $specDir/$vars{'name'}.spec in write mode. please check permissions for this file or directory"
  );
print F $result if defined($result);
print $result if ( defined($result) && $verbose );
close F;

# Cleaning archive tmp dir
if ( defined $archive ) {

    # Create temporary dir
    my $tmp_dir = "/tmp/myrpm/$$";
    eval { rmtree($tmp_dir) };
    if ($@) {
        print "Couldn't create $tmp_dir: $@";
    }
}

#Compiling package

#Avoid system call for portability
my $cmd = "rpmbuild -ba --target=$Archi $specDir/$vars{'name'}.spec";

print "\n#Executing to build package : $cmd\n" if ($verbose);
print `$cmd`                                   if ($build);
exit 0;

sub printUsage($) {
    print `perldoc $0`;
    exit 0;
}

sub printError($) {
    my $message = join( ' ', @_ );
    print STDERR $message;

    exit 1;
}

sub escapeSpecialChars {
    my $line = shift;
    $line =~ s/(\$)/\\$1/g;
    $line =~ s/(\()/\\$1/g;
    $line =~ s/(\))/\\$1/g;

    # since a bug with \\
    #$line=~s/(\&))/\\$1/g;
    #$line=~s/(\\)/\\\\/g;
    return $line;
}

sub isReservedDir {
    my $dir = shift;
    print "\n* Testing $dir as reserved" if defined $verbose;
    foreach my $rdir (@reserved_dirs) {
        return 1 if ( $dir =~ /$rdir/ );
    }
    print "\n* $dir is NOT reserved" if defined $verbose;
    return 0;
}

sub isDocFile {
    my $file = shift;
    print "\n* Testing $file as doc" if defined $verbose;
    foreach my $dpat (@doc_pattern) {
        return 1 if ( $file =~ /$dpat/ );
    }
    print "\n* $file is NOT doc" if defined $verbose;
    return 0;
}

sub isConfigFile {
    my $file = shift;
    print "\n* Testing $file as config" if defined $verbose;
    foreach my $cpat (@config_pattern) {
        return 1 if ( $file =~ /$cpat/ );
    }
    print "\n* $file is NOT config" if defined $verbose;
    return 0;
}

sub substituteAliasDir {
    my $path = shift;

    #my $not_found=1;
    foreach my $subpath ( keys %dirAlias ) {

        #break unless ($not_found);
        print "$subpath lookup\n" if defined $verbose;
        if ( $path =~ /^$subpath/ ) {
            my $alias = $dirAlias{$subpath};
            print "=> $subpath FOUND : substitute by : $alias\n"
              if defined $verbose;
            $path =~ s/^$subpath/$alias/;
            print "* Substitution is :" . $path . "\n" if defined $verbose;
            return $path;
        }
    }
    return $path;
}

sub getChangeLogs {
    my $specFile = shift;
    return '' unless ( -f $specFile );
    print "$specFile found...." if defined $verbose;
    my @lines                = getFileContents($specFile);
    my @changeLogs           = ();
    my $changeLogHeaderFound = 0;
    foreach (@lines) {
        push @changeLogs, $_ if $changeLogHeaderFound == 1;
        $changeLogHeaderFound = 1 if /^%changelog/;
    }
    return join( '', @changeLogs );
}

sub getScriptFileContent {
    my $filename = shift;
    return "" if $filename eq "";
    return "" unless -f $filename;
    my @lines = getFileContents($filename);

    # remove first line
    my $interp;
    if ( defined( $lines[0] ) && $lines[0] =~ /^#!/ ) {

        #$lines[0] =~ s/#!(.*)/$1 << SCRIPT_END/;
        $lines[0] = "";

        #push @lines, "SCRIPT_END";
    }

    return join '', @lines;
}

sub getFileContents {
    my $filename = shift;
    print "* reading $filename " if defined $verbose;

    open( SOURCE, "< $filename" )
      or die "Couldn't open $filename for reading: $!\n";
    my @lines = <SOURCE>;

    close(SOURCE);
    return @lines;
}

sub getUserMap {
    my $file = "/etc/passwd";

    open( FD, $file ) or die "$file : $!";
    my @lines = <FD>;
    close(FD);
    my %localUserMap = ();
    foreach $line (@lines) {
        chomp( $line = $line );
        my ( $user, $passwd, $uid, $gid, $desc, $home, $shell ) =
          split( ":", $line );
        next unless defined $user;
        $desc = 'default comment' if ( $desc eq '' );
        $localUserMap{$uid}{'name'}    = $user;
        $localUserMap{$uid}{'gid'}     = $gid;
        $localUserMap{$uid}{'uid'}     = $uid;
        $localUserMap{$uid}{'comment'} = $desc;
        $localUserMap{$uid}{'shell'}   = $shell;
        $localUserMap{$uid}{'home'}    = $home;
    }

    return %localUserMap;
}

sub getUserId {
    my $search_name = shift;
    my $file        = "/etc/passwd";

    open( FD, $file ) or die "$file : $!";
    my @lines = <FD>;
    close(FD);
    my %localUserMap = ();
    foreach $line (@lines) {
        chomp( $line = $line );
        my ( $user, $passwd, $uid, $gid, $desc, $home, $shell ) =
          split( ":", $line );
        next unless defined $user;
        return $uid if ( $user eq $search_name );
        return $uid if ( $uid  eq $search_name );
    }

    return 0;
}

sub getGroupMap {
    my $file = "/etc/group";

    open( FD, $file ) or die "$file : $!";
    my @lines = <FD>;
    close(FD);
    my %localGroupMap = ();
    foreach $line (@lines) {
        chomp( $line = $line );
        my ( $group, $passwd, $gid, $members ) = split( ":", $line );
        $localGroupMap{$gid}{'gid'}     = $gid;
        $localGroupMap{$gid}{'name'}    = $group;
        $localGroupMap{$gid}{'members'} = $members;
    }

    return %localGroupMap;
}

sub getGroupId {
    my $search_group = shift;
    my $file         = "/etc/group";

    open( FD, $file ) or die "$file : $!";
    my @lines = <FD>;
    close(FD);
    my %localGroupMap = ();
    foreach $line (@lines) {
        chomp( $line = $line );
        my ( $group, $password, $gid, $members ) = split( ":", $line );
        return $gid if ( $group eq $search_group );
        return $gid if ( $gid   eq $search_group );
    }

    return 0;
}

sub getUniqElement {
    my %seen = ();
    return grep { !$seen{$_}++ } shift;
}

sub getInputFileLine {
    my $directory = shift;
    print "==>$directory<== ....\n" if defined($verbose);
    my @result = ();
    my $line   = "";
    if ( defined($directory) && ( -d $directory ) ) {
        print "$directory exists....\n" if defined($verbose);

        find sub {
            my $line = $File::Find::name;
            $line .= "/" if -d;

            #print "=> $line\n" if defined($verbose);
            push @result, $line;
        }, ($directory);
    }
    else {
        print "==>INPUT FILE LIST<== ....\n" if defined($verbose);

        while ( defined( $line = <> ) ) {
            $line = trim($line);

            #print "=> $line\n" if defined($verbose);
            push @result, $line;
        }
    }
    print "\n" if defined $verbose;
    return @result;
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim($) {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

# Retrieve value from files (like .rpmmacros)
sub getParameterFromConfig {
    my $parameter = shift;

    my $res    = shift;
    my $opened = 1;
    open( MACROS, $macrosFile ) || ( $opened = 0 );
    if ($opened) {
        while (<MACROS>) {
            if (m/^\%$parameter\s+(.*)$/) {
                $res = $1;
            }
        }

        close(MACROS);
    }
    return $res;
}

sub getSpecTemplate {
############################
    # THE TEMPLATE
############################
    my $defaultSpecTemplate = 'Summary: 		<$summary> 
Name:			<$name>
Version: 		<$version>
Release:	   	<$release>	
License: 		GPL
URL: 			<$vendor_url>
Source0: 		%{name}-%{version}.tar.gz
Group: 			System/Administration
Vendor:			<$vendor>
Packager:		<$packager>
#Arch: 			<$archi>
<if (@reqs == 0 ) {$OUT.="AutoReqProv: 		no"; } >
BuildRoot: 		%{_tmppath}/%{name}-%{version}-root
< foreach $req (@reqs) { $OUT.= "Requires: $req\n"; }>
%description 
<$description>

< if (@defConfFiles != 0) { 
$OUT.="%package config
Summary: Configuration for $name
Group: System/Administration

%description config
Configuration files for $name
$description";
} >
<if (@defDocFiles != 0) {
$OUT.="%package doc
Summary: Documentation for $name
Group: System/Administration

%description doc
Documentation files for $name
$description"; 
} >
%prep
#%setup -q 
#-n %{name}-%{version}
%setup -c -q

%build
<$build_code>
%install
rm -Rf %{buildroot}
mkdir -p %{buildroot}/usr/lib/debug

#Directory installation
< foreach $i (@instDirs) {
	$comment=$$i{comment};
	$file=$$i{file};
	$mode=$$i{mode};
	$path=$$i{path};
	$OUT.= "#Uncomment if needed - consider as a reserved dir\n#" if ($comment);
	$OUT.="%{__install} -d -m $mode $file %{buildroot}$path\n";

}>
#Files installation
< foreach $i (@instFiles) {
	$file=$$i{file};
	$mode=$$i{mode};
	$path=$$i{path};
        $OUT.= "%{__mkdir_p} `dirname %{buildroot}$path` || true\n";
	$OUT.= "%{__install} -m $mode $file %{buildroot}$path\n";
}>
%pre
< if (@groups == 0 ) {
	$OUT.="# No group Creation";
} else {
	$OUT.="# Group creation"; 
	foreach $i (@groups) {
		$gid=$$i{gid};
		$gname=$$i{name};
		$OUT.="\ngroupadd -g $gid $gname || true";
	}
}
if (@users == 0 ) {
	$OUT.="\n# No User Creation";
} else {
	$OUT.="\n# User creation"; 
	foreach $i (@users) {
		$uname=$$i{name};
		$gid=$$i{gid};
		$shell=$$i{shell};
		$home=$$i{home};
		$comment=$$i{comment};
		$uid=$$i{uid};
		$is_init=$$i{init};

		$OUT.="\nUSER_NEW=0";
		$OUT.="\nadduser -u $uid -g $gid -s $shell -d $home -c \"$comment\" $uname && USER_NEW=1 || true";
		if ($is_init) {	
			$OUT.="\nif [ \"\$USER_NEW\" -eq \"1\" ]; then";
			$OUT.="\n\t# Changing password for non priviliged user";
			$OUT.="\n\techo $uname | passwd --stdin $uname";
			$OUT.="\nfi";
		}
	}
}>

< $OUT.="\n$pre_code";>

%post< foreach $i (keys %symbolic_links) {
	$link=$i;
	$pointee=$symbolic_links{$i};
	$OUT.="\n#Symbolic link $i - $pointee";
	$OUT.="\ncd `dirname $i`";
        $OUT.="\nrm -fv `basename $i`";
        $OUT.="\nln -fvs $pointee `basename $i`";
	$OUT.="\ncd -"; 
}>
<$post_code>
%preun
<$preun_code>
%postun
<$postun_code>
%clean
rm -Rf %{buildroot}

#Regular file and dir list
%files
< foreach $i (@listOfFiles) { 
	$mode=$$i{mode};
	$path=$$i{r_path};
	$comment=$$i{comment};
	$uid=$$i{uid};
	$gid=$$i{gid};
	$OUT.="#Uncomment if needed !\n#" if (defined $comment);
	$OUT.="%attr($mode $uid, $gid) ";
	$OUT.="%dir " if ($$i{isDir});
 	$OUT.="$path\n"; 
}>
< if ( @listOfConfFiles != 0 ) { $OUT.="#Configuration file list"; }>
< if ( $multiple_packages && @listOfConfFiles != 0 ) { $OUT.= "%files config"; }>
< foreach $i (@listOfConfFiles) { $OUT.="%attr($$i{mode} $$i{uid}, $$i{gid}) %config $$i{path}\n"; }>
< if ( @listOfDocFiles != 0 ) { $OUT.= "#Documentation file list"; }>
< if ( $multiple_packages && @listOfDocFiles != 0 ) { $OUT.= "%files doc"; }>
< foreach $i (@listOfDocFiles) { $OUT.= "%doc $$i{path}\n"; }>
%changelog
* <$date> <$packager> <$name>-<$version>-<$release>
- <$ChangeLog>
-  Generated version.

<$OldChangeLogs>';

    my $fileName = shift;
    my $res      = $defaultSpecTemplate;
    if ( $fileName ne "" ) {
        print "\n* Alternate spec skeleton filename : $fileName\n"
          if defined $verbose;

        my $opened = 1;
        open( TEMPLATE, "$fileName" ) || ( $opened = 0 );

        if ($opened) {
            $res = "";
            while (<TEMPLATE>) {
                $res .= $_;
            }
            close(TEMPLATE);
        }
    }
    else {
        print "\n* Using default integrated template\n" if defined $verbose;
    }
    return $res;
}

__END__

=head1 Usage

myrpm.pl [OPTION]

myrpm.pl is a automatic spec file generator and builder.

Myrpm allow you to install freely software on a rpm compliant system 
and realize a binary package from a list of file. 

This program manages rigths and users. It s a simple tool that simplify 
packaging in chroot mode.

=head1 General Options

 -h, --help				: Print this help.
 -v, --verbose				: Print debug information, verbose mode.
 -m, --multiple				: Split into 3 packages : main, doc and config
 -b, --build				: Build the package automatically at the end.
 -a, --archive=filename			: RPM Creation based on a archive file
 -u, --uid=user id or name		: User id for archive file
 -g, --gid=user id or name		: Group id for archive file
 -n, --nodoc				: Avoid documentation file detection
 -c, --noconfig				: Avoid config file detection
 -s, --noreserved			: Avoid reserved directory
 -t, --template=filename		: Generate the spec skeleton from this template.
 -x, --exclude="pattern1,pattern2"	: Exclude some file patterns.
 -r, --root-directory=<directory>	: Root directory ( / by default ).
 -d, --directory=<directory>		: Directory where is the tree to package
                                  by default, list of files is build from the stdin data

=head1 Package Options 

 -N, --name=<name>			: Package name - This option is mandatory
 -V, --version=<version>		: Package version - This option is mandatory
 -R, --release=<release>		: Package release - This option is mandatory
 -C, --changelog=<changelog>		: Package changeLog
 -D, --description=<description>	: Package Description.
 -S, --summary=<summary>		: Package Summary.
 -P, --packager=<packager>		: Packager identity.
 -U, --vendor-url=<vendor url>		: Vendor URL.
 -O, --vendor=<vendor>			: Vendor name.
 -A, --architecture=<archi>		: Target architecture.
 -T, --distribution=<distro>		: Target distribution.
 --requires=<dependency>,...		: Dependency list.
 --build-script=<filename>		: Script filename to include in the %build session.
 --pre-script=<filename>		: Script filename to include in the %pre session.
 --post-script=<filename>		: Script filename to include in the %post session.
 --preun-script=<filename>		: Script filename to include in the %preun session.
 --postun-script=<filename>		: Script filename to include in the %postun session.

=head1 Examples 

=head2 Realize a kick rpm snapshot of /home/jmrenouard/myrpmBuildDir

myrpm.pl -v -d /home/jmrenouard/myrpmBuildDir -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1 -b

=head2 An other version

cd /home/jmrenouard/myrpmBuildDir && myrpm.pl -v -d . -r . -N toto -V 1.0 -R 1 -b

=head2 The same with UNIX tools interaction

cd /home/jmrenouard/myrpmBuildDir && find `pwd` -iname '*' -print | myrpm.pl -v -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1 -b

find /home/jmrenouard/myrpmBuildDir | myrpm.pl -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1

=head2 Explanations

This script performs the following operations :

Find build the list of all the files in /home/jmrenouard/myrpmBuildDir.

myrpm.pl packages all the files /home/jmrenouard/myrpmBuildDir  in a package with toto as name.

myrpm.pl consider /home/jmrenouard/myrpmBuildDir as the root of all the files so all this files will be installed from the root file system by the rpm program.


=head2 Repackage existing configuration

rpm -ql yum |  myrpm.pl -v -N yum -V 2.7 -R 1_jmr -b

=head2 Explanations

Rpm gives the list of the files in the yum package installed on the system.

myrpm.pl packages all the files in a package with yum as name and 1_jmr as release.

This is a new way to package modification on a installed system.


=head1 Configuration file samples

Myrpm tool is an ecology-friendly configurated.

=head2 Standard $HOME/.rpmmacros sample

 %_topdir	/home/jmrenouard/redhat
 %packager	Jean-Marie Renouard<jmrenouard.externe at pagesjaunes.fr>
 %vendor	Pages Jaunes
 %vendor_url	http://www.pagesjaunes.fr
 %distribution  Red Hat Enterprise 4
 %dist_tag      .1
 %_tmppath   	/var/tmp


=head1 Help to improve this tool

=head2 Submit bugs or remarks at http://code.google.com/p/myrpm/issues/list 

=head2 You can also contact me at Jean-Marie Renouard <jmrenouard at gmail.com>

=head1 Documentation fran�aise

=head1 Usage

myrpm.pl [OPTION]

myrpm.pl est un g�n�rateur automatique de fichier spec pr�t � l'emploi.

Myrpm vous prmet d'installer des logiciel librement sur un syst�me Linux compatible RPM 
et de r�aliser des paquets RPMs binaires depuis une liste de fichiers. 

Ce programme g�re les droits et les utilisaterus. C'est un outil simple qui simplifie le packaging
en mode non privil�gi�.

=head1 Options g�n�rales

 -h, --help				: Affichage de l'aide en ligne.
 -v, --verbose				: Mode verbeux, affichage d'information de deboggage.
 -b, --build				: Compilation automatique du package.
 -a, --archive=filename			: Cr�ation d'un RPM � partir d'une archive
 -u, --uid=user id or name		: Identifiant utilisateur pour l'archive
 -g, --gid=user id or name		: Identifiant de groupe pour l'archive
 -n, --nodoc				: Annulation de la detection des fichiers de documentation 
 -c, --noconfig				: Annulation de la detection des fichiers de configuration
 -s, --noreserved			: Annulation de la detection des repertoires r�serv�s
 -m, --multiple 			: S�paration en 3 packets : principal, doc et config
 -t, --template=filename		: Sp�cification d'un fichier template aternatif.
 -x, --exclude="pattern1,pattern2"	: Exclusion de certaines formes de fichier.
 -r, --root-directory=<directory>	: R�pertoire racine  ( / par d�faut ).
 -d, --directory=<directory>		: R�pertoire � packager.
                  Par d�faut, la liste de fichiers est construite depuis le flux d'entr�e standard.


=head1 Options du package RPM 

 -N, --name=<name>			: Nom du package - Option obligatoire.
 -V, --version=<version>		: Version du package - Option obligatoire.
 -R, --release=<release>		: Release du package - Option obligatoire.
 -C, --changelog=<changelog>		: ChangeLog du package
 -D, --description=<description>	: Description du package.
 -S, --summary=<summary>		: R�sum� du package.
 -P, --packager=<packager>		: Identit� du packageur.
 -U, --vendor-url=<vendor url>		: URL du fournisseur.
 -O, --vendor=<vendor>			: Nom du fournisseur.
 -A, --architecture=<archi>		: Architecture cible.
 -T, --distribution=<distro>		: Distribution cible.
 --requires=<dependency>,...		: Liste des d�pendances.
 --build-script=<filename>		: Nom du script � inclure dans la session %build.
 --pre-script=<filename>		: Nom du script � inclure dans la session %pre.
 --post-script=<filename>		: Nom du script � inclure dans la session %post.
 --preun-script=<filename>		: Nom du script � inclure dans la session %preun.
 --postun-script=<filename>		: Nom du script � inclure dans la session %postun.

=head1 Exemples 

=head2 R�alisation rapide d'une image du r�pertoire /home/jmrenouard/myrpmBuildDir

myrpm.pl -v -d /home/jmrenouard/myrpmBuildDir -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1 -b

=head2 Une autre version

cd /home/jmrenouard/myrpmBuildDir && myrpm.pl -v -d . -r . -N toto -V 1.0 -R 1 -b

=head2 La m�me avec des interactions avec les outils UNIX

cd /home/jmrenouard/myrpmBuildDir && find `pwd` -iname '*' -print | myrpm.pl -v -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1 -b

find /home/jmrenouard/myrpmBuildDir | myrpm.pl -r /home/jmrenouard/myrpmBuildDir -N toto -V 1.0 -R 1

=head2 Explications

Le script r�alise les op�rations suivantes :

Find construit la liste de tous les fichiers contenus dans le r�pertoie /home/jmrenouard/myrpmBuildDir.

myrpm.pl packages  tous les fichiers du r�pertoie /home/jmrenouard/myrpmBuildDir dans le package ayant toto comme nom, 1.0 comme version et 1 comme release.

myrpm.pl consid�re /home/jmrenouard/myrpmBuildDir comme r�pertoire root ( / ) si bien que tous les fichiers seront install� � la racine par le programme rpm.


=head2 Repackager une configuration existante

rpm -ql yum |  myrpm.pl -v -N yum -V 2.7 -R 1_jmr -b

=head2 Explications

Rpm donne la liste des fichiers du package Yum install� sur le syst�me.

myrpm.pl packages tous les fichiers de ce package dans un nouveau package avec yum comme nom.

Il s'agit d'un nouveau moyen de packager des modifications depuis un syst�me install�.


=head1 Exemple de fichier de configuration

Myrpm utilise le fichier utilisateur pour configurer les valeurs par d�faut.

=head2 Exemples de $HOME/.rpmmacros standard

 %_topdir	/home/jmrenouard/redhat
 %packager	Jean-Marie Renouard<jmrenouard.externe at pagesjaunes.fr>
 %vendor	Pages Jaunes
 %vendor_url	http://www.pagesjaunes.fr
 %distribution  Red Hat Enterprise 4
 %dist_tag      .1
 %_tmppath   	/var/tmp

=head1 Aide � l'am�lioration du produit

=head2 Merci de soumettre les erreurs et les remarques sur http://code.google.com/p/myrpm/issues/list 

=head2 Vous pouvez contactez Jean-Marie Renouard <jmrenouard at gmail.com> pour plus de d�tails.