#!/usr/bin/perl
#$Id: lls,v 0.3.8.1 1997/10/25 01:15:07 schwartz Exp $
#
# lls, Laola List
#
# This program lists the structure of ole/com documents.
#
# See also usage() of this file. General information at:
#    http://wwwwbs.cs.tu-berlin.de/~schwartz/pmh/index.html
#
# Copyright (C) 1996, 1997 Martin Schwartz 
#
#    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
#
   $targetdir="analyze"; # This is the output directory
}

sub _error {
   $Error->string(shift);
}
sub croak {
   printf ("Error! %s\n\n", $Error->string() );
}

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

main: {
   $|=1; $[=0;
   getopts ('dhs');
   usage() if !@ARGV || $opt_h;

   require OLE::Storage;

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

   # Please ignore the following three lines...
   $Var -> handler() -> par ("date", "string", 
      ["%02d.%02d.%04d %02d:%02d:%02d", "%02d:%02d:%02d", "<undef>"]
   );

   local($basename);

   foreach $infile (@ARGV) {
      $global_pps_count=0;
      $basename = basename($infile);

      print "Processing \"$infile\":\n";
      if ( ! ($Doc = OLE::Storage->open($Error, $Var, $infile)) ) {
         croak(); next;
      }

      if ($opt_s||$opt_d) {
         $targetdir=$basename if $opt_d;
         if (targetdir($targetdir)) {
            $global_outpath = $targetdir."/".$basename;
         } else {
            $Doc->close($infile);
            croak(); next;
         }
      }

      ppss_info();
      do_directory(0,0);
      print "\n";
      $Doc->close($infile);
   }
   exit 0;
}


##
## main things
##

sub usage {
   print "usage: lls [-s] [-d] {document}\n";
   print "List the property storages of Ole/Com documents\n";
   print "-d  Directory, save all files in an own directory,\n".
         "    e.g. in directory \"test\" for document \"test.doc\"\n";
   print "-s  Save all streams as files in directory \"$targetdir\"\n";
   exit 0;
}

sub do_directory {
   # !recursive!
   my ($directory_pps, $level)=@_;
   my @dir = $Doc->dirhandles($directory_pps);

   for (0 .. $#dir) {
      pps_info($_, $dir[$_], $level);
      if ($Doc->is_file($dir[$_])) {
         croak() if !pps_save($global_outpath, $dir[$_]);
      } elsif ($Doc->is_directory($dir[$_])) {
         do_directory($dir[$_], $level+1);
      }
   }
}


##
## Info things
##

sub ppss_info {
   #
   # generate some information about the root entry of the property 
   # set storage
   #
   pps_info(0,0,0);
}

sub pps_info {
   #
   # generate a line of information about the current property storage
   #
   local($i, $pps, $level)=@_;
   local($name, $out)=("", "");
   ($name=$Doc->name($pps)->string()) =~ s/[^_a-zA-Z0-9]/ /g;

   $out = sprintf ("%2x: " . ("   " x $level) . "%2x '%s' (pps %x) ",
                   $global_pps_count++,         $i+1, $name,   $pps);
   $out .= " " x (54 - length($out));

   # info about the properties type
   if ($Doc->is_directory($pps)) {
      $out .= $Doc->is_root($pps) ? "ROOT " : "DIR  ";
      $out .= $Doc->date($pps)->string();
   } elsif ($Doc->is_file($pps)) {
      $out .= sprintf("FILE        %6x bytes ", $Doc->size($pps));
   } else {
      $out.="unknown type!";
   }

   print $out . "\n";
}


##
## Save things
##

sub targetdir {
#
# If none exists, create a $targetdirectory. This will be readable only to
# the person owning the directory.
#
   my $dir = shift;
   return 1 if -d $dir;
   if (mkdir ($dir, 0700)) {
      print "Created directory \"$targetdir\"\n"; 
      return 1;
   } else {
      print "Cannot create directory \"$targetdir\"!\n"; 
      return 0;
   }
}

sub pps_save {
#
# 1 = pps_save(path, pps)
# 
# Copies the current property stream to an own file as: 
# targetdir/basename.xx, where xx is the hex number of the property 
# storage
#
   my ($outfilebasename, $pps) = @_;
   my $status = 1;
   my $tmp = "";

   return 1 if !($opt_s||$opt_d);
   return 1 if !$outfilebasename; # warning already done
   my $outname = sprintf "$outfilebasename.%02x", $pps;

   return _error ("Cannot open \"$outname\"!")
      if ! ( open(OUT, ">".$outname)  &&  binmode(OUT) )
   ;

   if (!$Doc->read($pps, \$tmp)) {
      $status = _error (sprintf "Error while reading pps #%x\n", $pps);
   } elsif (!print OUT $tmp) {
      $status = _error (sprintf "Error while writing pps #%x!", $pps)
   }
   close(OUT); 

   $status;
}

__END__

=head1 NAME

lls - Laola List

=head1 SYNOPSIS

lls [C<-s>] [C<-d>] document 

 -d  Directory, save all files in an own directory
     e.g. in directory "test" for document "test.doc"

 -s  Save all streams as files in directory "$targetdir"

=head1 DESCRIPTION

Lists the raw document structure of MS Windows Structured Storage files,
like Word and Excel documents.

Demonstration program for OLE::Storage.

=head1 SEE ALSO

L<OLE::Storage>

=head1 AUTHOR

Martin Schwartz E<lt>F<schwartz@cs.tu-berlin.de>E<gt>. 

=cut

