######################################################################
+#######
## Name:        build-bundle.pl
## Author:      Graciliano M. P.
## Copyright:   (c) 2003 Graciliano M. P.
## Licence:     This program is free software; you can redistribute it
+ and/or
##              modify it under the same terms as Perl itself
######################################################################
+#######

  use FindBin ;
  use File::Path () ;
  use strict qw(vars) ;

  ## The base directory to look for tar.gz of modules.
  my $base = '/home/gm/dev-perl' ;
  
  my $clean_bulding = 1 ; ## can remove already existent bundles.
  
  my $version = '7.0' ; ## the version of this bundle.

  ## The modules to be in the bundle.
  ## Note that the 1st is the main module.
  
  my @modules = qw(
  A::Main::Module
  Dependency::Module::1
  Dependency::Module::2
  Dependency::Module::3  
  );
  
  ## Note that you need to have the .tar.gz files of this modules in t
+he
  ## tree of $base. Soo, you need to have Foo-Bar-0.01.tar.gz to can u
+se
  ## Foo::Bar in the modules list. note that the script will always ge
+t the
  ## last version of the module that it found.
  
  ## Now just run the script. It will create a bundle directory with
  ## the release inside.
  
  ## You need 'tar' and 'gzip' executables installeds. For Win32 get t
+hem at:
  ## http://unxutils.sourceforge.net/
  
########################
# DON'T EDIT FROM HERE #
########################
  
  #########
  
  my $bundle_dir = $FindBin::RealBin . '/bundle' ;
  my $building_dir = $FindBin::RealBin . '/bulding' ;
  my $tmp_dir = $building_dir . '/tmp' ;
  my $ext_dir = $building_dir . '/ext' ;  
  
  my $MAIN_MODULE_EXT_DIR ;
  my %MOD_INF ;
  
  #########
  
  build_bundle() ;
  
################
# BUILD_BUNDLE #
################

sub build_bundle {

  if ( -e $building_dir ) {
    if ( $clean_bulding ) { File::Path::rmtree($building_dir) ;}
    else { die("Bulding dir already exists!") ;}
  }
  
  mkdir($building_dir , 0775) ;
  mkdir($tmp_dir , 0775) ;
  mkdir($ext_dir , 0775) ;

  foreach my $modules_i ( @modules ) {
    place_dist($modules_i) ;
  }
  
  my $main_module = @modules[0] ;
  
  save_bundle_pm($main_module) ;
  save_makefile_ext($main_module) ;
    
  save_bundle_dist($main_module) ;

  File::Path::rmtree($tmp_dir) ;
  
  my $final_dir = "$bundle_dir/Bundle-$main_module-$version" ;
  $final_dir =~ s/::/-/gs ;
  
  if ( -e $final_dir ) {
    if ( $clean_bulding ) { File::Path::rmtree($final_dir) ;}
    else { die("Bundle dir already exists! $final_dir") ;}
  }
  
  print "\n>> $final_dir\n" ;
  
  utime_all() ;
  
  rename($building_dir , $final_dir) ;
  
}

#############
# UTIME_ALL #
#############

sub utime_all {
  my @files = catdir($building_dir , 0 ,1,1) ;
  
  my $time = time() - (60*60*24) ;
  
  foreach my $files_i ( @files ) {
    utime($time,$time , $files_i) ;
  }

}

####################
# SAVE_BUNDLE_DIST #
####################

sub save_bundle_dist {
  my ( $main_module ) = @_ ;
  
  my $module = "Bundle::$main_module" ;

  my $mod_path_file = $module ;
  $mod_path_file =~ s/::/\//g ;
  $mod_path_file .= '.pm' ;

######################################################################
+##########
my $makefile = qq`###############
# MAKEFILE.PL #
###############

use ExtUtils::MakeMaker;

WriteMakefile(
    'NAME'          => '$module' ,
    'VERSION_FROM'  => 'lib/$mod_path_file' ,
    (\$] >= 5.005 ?
      ( ABSTRACT_FROM => 'lib/$mod_path_file') : ()
     ),
);

1;

`;
######################################################################
+##########

my $cmt = '#' x length($module) ;

my ($mods) = modules_inf() ;
$mods =~ s/(?:^|\n)/\n   /gs ;
  
my $readme = qq`##$cmt##
# \U$module\E #
##$cmt##

$module - install $main_module and all it's dependencies.

###########
# CONTENT #
###########

$mods
################
# INSTALLATION #
################

To install this module type the following:

   perl Makefile.PL
   make
   make test
   make install

Note that "make test" will call all the tests of all the dependencies.
If you want to test one by one, go to "ext/xxxxxx" directory.

############# 
# COPYRIGHT #
#############

This program is free software; you can redistribute it and/or modify i
+t under the same terms as Perl itself.

`;
######################################################################
+##########

my $manifest ;

  my @files = catdir($building_dir , 1,1,1) ;
  
  foreach my $files_i ( sort (qw(MANIFEST Makefile.PL README) , @files
+) ) {
    $manifest .= "$files_i\n" ;
  }

######################################################################
+##########

  my %FILES = (
  "$building_dir/Makefile.PL" => $makefile ,
  "$building_dir/MANIFEST" => $manifest ,
  "$building_dir/README" => $readme ,
  );
  
  foreach my $Key (sort keys %FILES ) {
    if ( !-s $Key ) {
      print "$Key = ". length($FILES{$Key}) ."\n" ;
      savefile($Key , $FILES{$Key}) ;
    }
  }

}

###############
# MODULES_INF #
###############

sub modules_inf {
  my $mods ;
  my @dirs ;

  foreach my $modules_i ( @modules ) {
    $mods .= "$modules_i - $MOD_INF{$modules_i}{v}\n\n" ;
    my $d = $MOD_INF{$modules_i}{d} ;
    $d =~ s/^.*?([^\\\/]+)$/$1/gs ;
    push(@dirs , $d) ;
  }  
  
  return( $mods , @dirs ) ;
}

##################
# SAVE_BUNDLE_PM #
##################

sub save_bundle_pm {
  my ( $main_module ) = @_ ;
  
  my $pm = "Bundle::$main_module" ;
  
  my ($mods) = modules_inf() ;
  
  my $data = qq`
package $pm ;

\$VERSION = '$version' ;

1;

__END__

=head1 NAME

$pm - install $main_module and all it's dependencies.

=head1 CONTENTS

$mods
=head1 SEE ALSO

L<$main_module>

L<CPAN/"Bundles">

=cut

`;

  my $lib = "$building_dir/lib" ; 
  
  mkdir($lib , 0775);

  my @dirs = split("::" , $pm) ;
  
  my $name = pop @dirs ;
  my $dir ;
  while( @dirs ) {
    $dir .= '/' . shift(@dirs) ;
    print "MKDIR>> $lib/$dir\n" ;
    mkdir("$lib/$dir" , 0775) ;
  }

  my $file = "$lib/$pm.pm" ;
  $file =~ s/::/\//gs ;
  
  savefile($file , $data) ;
  
  print "$file\n" ;

}

####################
# MOVE_MAIN_MODULE #
####################

sub move_main_module {
  my ( $main_module ) = @_ ;
  
  my $main_dir = "$ext_dir/$MAIN_MODULE_EXT_DIR" ;
  
  my @files = catdir($main_dir , 1) ;
  
  foreach my $files_i ( @files ) {
    my $from = "$main_dir/$files_i" ;
    my $to = "$building_dir/$files_i" ;    
    print "MOVE>> $files_i\n" ;
    rename($from , $to) ;
  }
  
  print "RM>> $main_dir\n" ;
  
  rmdir($main_dir) ;
  
}

#####################
# SAVE_MAKEFILE_EXT #
#####################

sub save_makefile_ext {
  my ( $main_module ) = @_ ;

  my (undef , @ext_dirs) = modules_inf() ;

  my $dirs = join("\n      ", @ext_dirs) ;

  my $data = qq`
  use ExtUtils::MakeMaker;
  
  WriteMakefile(
    NAME => 'Bundle::$main_module',
    DIR => [qw(
      $dirs
    )],
  );
  
  1;
  
  `;
  
  my $file = "$ext_dir/Makefile.PL" ; 
  
  savefile($file , $data) ;
  
  print "$file\n" ;

}

##############
# PLACE_DIST #
##############

sub place_dist {
  my ( $module ) = @_ ;
  
  my $dist_file = find_module($module) ;
  my $dist_name = dist_name($dist_file) ;
  
  my ($ver) = ( $dist_name =~ /(\d(?:\.\d+))/s );
  
  print "** $module - $ver\n" ;
  
  chdir $tmp_dir ;

  my $place_dist = "$tmp_dir/$dist_name" ;

  savefile($place_dist , cat($dist_file)) ;

  call("gzip -d $place_dist") ;

  $place_dist =~ s/\.gz$//i ;

  chdir $ext_dir ;

  call("tar -xf $place_dist") ;
  
  unlink($place_dist);
  
  chdir $FindBin::RealBin ;

  $place_dist =~ s/\.tar$//gs ;
  $place_dist =~ s/^.*?([^\\\/]+)$/$1/ ;
  
  $MOD_INF{$module}{v} = $ver ;
  $MOD_INF{$module}{d} = "$ext_dir/$place_dist" ;
  
  if ( !$MAIN_MODULE_EXT_DIR ) {
    $MAIN_MODULE_EXT_DIR = $place_dist ;
  }
  
  print "\n" ;
  
  return 1 ;
}

#############
# DIST_NAME #
#############

sub dist_name {
  my ( $file ) = @_ ;
  my ($dist) = ( $file =~ /([^\\\/]+)$/ );
  return $dist ;
}
  
###############  
# FIND_MODULE #
###############

sub find_module {
  my ( $mod , $init_dir) = @_ ;
  $init_dir ||= $base ;
  
  $mod =~ s/::/-/gs ;
  
  return scan_file($init_dir , $mod) ;
}

#############
# SCAN_FILE #
#############

sub scan_file {
  my ( $base , $find_file ) = @_ ;
  
  my @files ;
  
  my @DIR = ($base) ;
  foreach my $DIR ( @DIR ) {
    opendir (DIRLOG, $DIR);

    while (my $filename = readdir DIRLOG) {
      if ($filename ne "\." && $filename ne "\.\.") {
        my $file = "$DIR/$filename" ;
        if (-d $file) {
          $file .= '/DEV' if $file =~ /^\Q$base\E\/[^\\\/]+$/ ;
          push(@DIR , $file) ;
        }
        elsif ( $file =~ /(?:^|\/)\Q$find_file\E(?:[\d\.\-]+|\.tar|\.g
+z)*$/ ) { push(@files , $file) ;}
      }
    }
    
    closedir (DIRLOG);  
  }
  
  return (sort @files)[-1] ;
}

#######
# CAT #
#######

sub cat {
  my ( $file ) = @_ ;
  if (ref($file) eq 'SCALAR') { $file = ${$file} ;}
  
  my $fh = $file ;
  if (ref($fh) ne 'GLOB') { open($fh,$file) ; binmode($fh) ;}
  
  if ( *{$fh}->{DATA} && *{$fh}->{content} ne '' ) { return( *{$fh}->{
+content} ) ;}
  
  my $data ;
  seek($fh,0,1) if ! *{$fh}->{DATA} ;
  1 while( read($fh, $data , 1024*8*2 , length($data) ) ) ;
  close($fh) ;

  return( $data ) ;
}

############
# SAVEFILE # (FILE , DATA , OPEN|OVERWRITE , NOBINMODE|ASCII)
############

sub savefile {
  my ( $file ) = @_ ;
  if (ref($file) eq 'SCALAR') { $file = ${$file} ;}
  
  my $fh = $file ;
  if (ref($fh) ne 'GLOB') {
    if ( !$_[2] && -e $file ) { return( undef ) ;}
    open($fh,">$file") ; binmode($fh) if !$_[3] ;
  }
  
  print $fh $_[1] ;
  close($fh) ;

  return( 1 ) ;
}

##########
# CATDIR # (DIR , CUT_BASE , RECURSIVE , ONLY_FILES)
##########

sub catdir {
  my ( $dir , $cut , $r , $f ) = @_ ;
  
  my @files ;
  
  my @DIR = $dir ;
  foreach my $DIR ( @DIR ) {
    my $DH ;
    opendir ($DH, $DIR);

    while (my $filename = readdir $DH) {
      if ($filename ne "\." && $filename ne "\.\.") {
        my $file = "$DIR/$filename" ;
        if ($r && -d $file) { push(@DIR , $file) ;}
        else {
          if (!$f || !-d $file) {
            $file =~ s/^\Q$dir\E\/?//s if $cut ;
            push(@files , $file) ;
          }
        }
      }
    }
    
    closedir ($DH) ;
  }
  
  return( @files ) ;
}

########
# CALL #
########

sub call {
  my ( $cmd ) = @_ ;
  
  print ">> $cmd\n" ;
  
  open (my $ipc,"| $cmd") ;
  my $log_read = join("", <$ipc>) ;
  close ($ipc) ;
  
  $log_read =~ s/\r\n?/\n/gs ;

  return($log_read) ;
}

#######
# END #
#######

1;


__DATA__

my $makefile = qq`###############
# MAKEFILE.PL #
###############

use ExtUtils::MakeMaker;

WriteMakefile(
    'NAME'          => '$module' ,
    'VERSION_FROM'  => 'lib/$mod_path_file' ,
    #'PREREQ_PM'     => {'Foo'  => 0.01} ,
    (\$] >= 5.005 ?
      ( ABSTRACT_FROM => 'lib/$mod_path_file',
        AUTHOR        => '$author'
       ) : ()
     ),
);

1;

`;
######################################################################
+##########

my $manifest = qq`Changes
MANIFEST
Makefile.PL
README
test.pl
lib/$mod_path_file
`;

######################################################################
+##########

my $cmt = '#' x length($module) ;

my $readme = qq`##$cmt##
# \U$module\E #
##$cmt##

$module - bla

###############
# DESCRIPTION #
###############

bla bla

See POD for more...

################
# INSTALLATION #
################

To install this module type the following:

   perl Makefile.PL
   make
   make test
   make install

##########
# AUTHOR #
##########

$author

I will appreciate any type of feedback (include your opinions and/or s
+uggestions). ;-P

############# 
# COPYRIGHT #
#############

This program is free software; you can redistribute it and/or modify i
+t under the same terms as Perl itself.

`;