view release on metacpan or  search on metacpan

tools/lclean  view on Meta::CPAN

#!/usr/bin/perl
#$Id: lclean,v 1.1.1.1 1998/02/25 21:13:00 schwartz Exp $
#
# lclean, Clean Structured Storage documents
#
# Copyright (C) 1997 Martin Schwartz 
#
# ATTENTION!
# 
# This program modifies some data in Structured Storage documents. Though I 
# think, the program works correctly, there might be errors or there might 
# be in future unpredictable changes in the document layout. Keep in mind, 
# that this program will change your document files! 
#
# Further more, this program can recognize only this garbage, that is not 
# specific to any special program. E.g., in Word 6 documents there are data 
# parts, that lclean can clean, and there are parts, that only Word could 
# clean. So please:
#
#    1. Keep a backup of all treated documents, until you are sure, 
#       that the cleaned documents are proper. 
#
#    2. Don't rely on, that *all* garbage will be cleaned.
#
# See also usage() of this file. General information at:
#    http://wwwwbs.cs.tu-berlin.de/~schwartz/pmh/index.html
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, you should find it at:
#
#    http://wwwwbs.cs.tu-berlin.de/~schwartz/pmh/COPYING
#
# You can contact me via schwartz@cs.tu-berlin.de
#

useress_global: {
#
# Please uncomment (remove '#') / change settings according to your system
#
   $global_targetdir = "doctrash"; # This is the output directory
}

sub error { $Startup->string() }

use Startup;
use Getopt::Std;
use OLE::Storage::Std;

global: {
   $|=1; $[=0;
   $REV = '$Revision: 1.1.1.1 $' =~ /: ([^ ]*)/ && $1;
   $DATE = '$Date: 1998/02/25 21:13:00 $' =~ / ..(..)\/(.{5})/ && "$2/$1";
   getopts ('acdefhi:lnrsz');
   usage() if !@ARGV || $opt_h;
   usage() if !@ARGV
      || $opt_h
      || !($opt_r||$opt_c||$opt_s||$opt_i||$opt_l||$opt_e)
   ;

   require OLE::Storage;

   $Startup = new Startup;
   $Var     = OLE::Storage->NewVar();	# Var Object
   $Doc     = undef;			# Document Object

   @crc32=();
   make_crc32_table();
   $hid_buf="";
   $hid_headerpart="";
}

main: {
   local($errnum); local($dont);
   local($status);
   local($fname);
   local($openmode)= ($opt_c||$opt_i) && 1;

   foreach $infile (@ARGV) {

      $errnum=0; $dont=0;

      print "Processing \"$infile\": ";
      next if !msg (
         $Doc = OLE::Storage->open($Startup, $Var, $infile, $openmode)
      );

      block_a: {
         if ($opt_r) {
            $dont++;
            $errnum++ if !msg (report_trash(-s $infile));
         }
         if ($opt_e) {
            print "Extracting...";
            ($status, $fname) = extract_hidden();
            $errnum++ if !msg ($status, "($fname)");
         }
         if ($opt_l) {
            $dont++;
            $errnum++ if !msg (list_hidden());
         } 
         if ($opt_s||$opt_d) {
            print "Saving... ";
            $errnum++ if !msg (save_all_trash($infile));
         }
      }

      if (!$errnum && !$dont) {
         if ($opt_c) {
            print "Cleaning...";
            ($status, $size) = clean_all_trash();