scripts/files/filedump.pl

   1 #!/usr/bin/perl
   2
   3 ###############################################################################
   4 #                                                                             #
   5 #  Name   : filedump                                                          #
   6 #  Author : Chris Koeritz                                                     #
   7 #  Rights : Copyright (C) 1996-$now by Author                                 #
   8 #                                                                             #
   9 #  Purpose:                                                                   #
  10 #                                                                             #
  11 #    Smashes multiple text files together into one large text file.           #
  12 #                                                                             #
  13 ###############################################################################
  14 #  This program is free software; you can redistribute it and/or modify it    #
  15 #  under the terms of the GNU General Public License as published by the Free #
  16 #  Software Foundation; either version 2 of the License or (at your option)   #
  17 #  any later version.  See: "http://www.gruntose.com/Info/GNU/GPL.html" for a #
  18 #  version of the License.  Please send any updates to "fred@gruntose.com".   #
  19 ###############################################################################
  20
  21 require "filename_helper.pl";
  22
  23 if ($#ARGV < 0) {
  24   &instructions;
  25   exit 0;
  26 }
  27
  28 # iterate over the list of files and dump them to standard output.
  29
  30 foreach $filename (sort &glob_list(@ARGV)) {
  31   &do_dump($filename);
  32 }
  33
  34 exit 0;
  35
  36 ############################################################################
  37
  38 sub instructions {
  39   print "
  40
  41 filedump: this program needs a set of filenames to print out.  they will
  42           be dumped to the standard output.
  43
  44 ";
  45 }
  46
  47 ############################################################################
  48
  49 # do_dump: prints the contents of the first parameter's file out to stdout.
  50
  51 sub do_dump {
  52
  53   ($to_dump) = @_;
  54
  55 #  print "dumpfile=$to_dump\n";
  56
  57   $header = "
  58
  59 %2
  60 %1
  61 %2
  62
  63 ";
  64
  65   $header_copy = $header;
  66   $shorter_name = $to_dump;
  67   $shorter_name =~ s/^\.\///;
  68   $shorter_name =~ s/\.txt$//;
  69   $shorter_name =~ s/_/ /g;
  70
  71   # we're using the extra equals in front as an almost uniquifier for the
  72   # header lines.  we then can treat any matching line as a header, although
  73   # some input files could trick this heuristic.
  74   $munged_name = "= $shorter_name";
  75   $dashed_line = $munged_name;
  76   $dashed_line =~ s/./=/g;
  77
  78   $header_copy =~ s/%1/$munged_name/;
  79   $header_copy =~ s/%2/$dashed_line/g;
  80
  81 ##print $header_copy;
  82 ##print $to_dump;
  83
  84   open(TO_DUMP, "<$to_dump");
  85
  86   print $header_copy;
  87
  88   local($just_started) = 1;  # check for and remove blank lines at top of file.
  89
  90   while (<TO_DUMP>) {
  91     local($line) = $_;
  92 #local($i);
  93 #for ($i = 0; $i < length($line); $i++) {
  94 #$curr_char = substr($line, $i, 1);
  95 #print "[$curr_char]";
  96 #}
  97 #print "\n";
  98     local($curr_char) = 0;
  99 #print "start len=" . length($line) . "\n";
 100     do {
 101 #print "chopping\n";
 102       chop $line;  # remove end of line char(s).
 103       $curr_char = substr($line, length($line) - 1, 1);
 104         # get new last char in string.
 105     } while ( ($curr_char eq "\r") || ($curr_char eq "\n") );
 106     local($do_print) = 1;
 107     if ($just_started) {
 108       if (length($line) == 0) {
 109         #continue;  # skip the first blank lines.
 110         $do_print = 0;  #no continue statement??
 111       } else {
 112         $just_started = 0;
 113           # a non-blank line has been seen.  now we reset our flag so we stop
 114           # checking for blank lines.
 115       }
 116 #print "do print = $do_print\n";
 117     }
 118     if ($do_print) { print $line . "\n"; }
 119   }
 120 }
 121