#!/usr/bin/perl ################################################################################## # This code is Copyright 2010 Tony Lewis . # # 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 3 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, see http://www.gnu.org/licenses/. ################################################################################## # Version 2.1 # # Version 2.1 added --examine option # Version 2.0 converted to Perl script that works on DOCX files. # Version 1 was a Windows executable that worked on RTF files. # # Time-stamp: 2010-09-03 14:06:56 # If your computer has everything you need installed (Perl, zip, and unzip) # then you can just enter the following command to get started: perl oneauth # # You will see the following message: (ignore the Perl wrapper) my $helpMessage = <]*author="([^"]*)[^>]*/g; my $last = ""; my $count = 0; my @selection; print scalar(@authors)," revisions:\n"; foreach my $author (sort {$a cmp $b} @authors) { $count++; if ($author ne "" && $author ne $last) { push @selection, $last if $select && $last ne ""; print " ", ($select ? scalar(@selection) . ". " : ""), "$last ($count revisions)\n" if $last ne ""; $count = 0; } $last = $author; } push @selection, $last if $select; print " ", ($select ? scalar(@selection) . ". " : ""), "$last ($count revisions)\n" if $last ne ""; my $done = !$select; while (!$done) { $done = 1; @selected = (); print "\nEnter the numbers to select (such as 1,3-7 or all): "; $resp = ; chomp $resp; $resp =~ s/ //g; if ($resp eq "") { exit; } elsif ($resp =~ m/^all$/) { $select = 0; } else { my @parts = split(/,/, $resp); foreach my $part (@parts) { if ($part =~ m/^\d+$/) { if (0+$part >= 1 && $part-1 < scalar(@selection)) { push @selected, $selection[$part-1]; } else { print "The value $part is out of range.\n"; $done = 0; } } elsif ($part =~ m/^(\d+)\-(\d+)$/) { my ($low, $high) = (0+$1, 0+$2); if ($low >= 1 && $low-1 < scalar(@selection) && $high >= 1 && $high-1 < scalar(@selection) && $low < $high) { map { push @selected, $selection[$_-1] } $low..$high; } else { print "The range $part is invalid.\n"; $done = 0; } } else { print "I don't understand: \"$part\"\n"; $done = 0; } } } } if ($debug) { print "\nEntries specifying an author:\n\n"; my @types = $contents =~ /]*author="[^"]*[^>]*/g; $last = ""; $count = 0; foreach my $type (sort {$a cmp $b} @types) { $count++; $found = $last =~ m/$re/; if ($type ne "" && $type ne $last) { print "", ($found ? "" : "* "), "$last [$count]",($found ? "" : " <-not found by regex"), "\n" if $last ne ""; $count = 0; } $last = $type; } print "", ($found ? "" : "* "), "$last [$count]",($found ? "" : " <-not found by regex"), "\n" if $last ne ""; print scalar(@types)," entries of all types.\n"; } } if ($examine) { push @selected, $author if $author ne ""; my @elements = $contents =~ m/(<[^>]*>)([^<]*)/g; foreach my $selected (@selected) { print "Revisions made by $selected:\n"; for (my $n = 0; $n < scalar(@elements); $n++) { my $element = $elements[$n]; next if $element =~ m/^\s*$/; if ($element =~ m/]*author="$selected"[^>]*>/) { my ($when) = $element =~ m/w:date="([^"]*)"/; $when = "????-??-??T??:??:??Z" unless $when; $when =~ s/T/ /; $when =~ s/Z$//; if ($element =~ m/\/>$/) { my $pElement = $elements[$n-2]; $pElement =~ s/^$/$1/; print " $when: $pElement\n"; } else { # print " $element\n"; my ($tag) = $element =~ m//) { if ($textNext) { $text .= $elements[$m]; $textNext = 0; } elsif ($elements[$m] =~ m/") { $text .= "-"; } elsif ($elements[$m] =~ m// ) { $action = "style $1"; } $sawField = 1 if $elements[$m] =~ m/\n" if $m >= scalar(@elements); } $text .= "}" if $isField; if ($text eq "" && $action ne "") { print " $when: $action\n"; } elsif ($text ne "") { print " $when: $tag \"$text\"\n"; } elsif ($debug && $sawField == 0 && $tag !~ m/PrChange$/) { print " $when: $tag ???\n"; my $m = $n + 1; while ($elements[$m] !~ m/<\/w:$tag>/) { print "@@@ $elements[$m]\n" unless $elements[$m] =~ m/^\s*$/; $m++; } print "Continue? "; my $resp = ; chomp $resp; exit unless $resp eq "y"; } } } } print "\n"; } } elsif (!$who) { my $count = 0; if ($select) { map { $count += $contents =~ s/(]*author=")($_)("[^>]*>)/$1$author$3/g; } @selected; } else { $count = $contents =~ s/(]*author=")([^"]*)([^>]*>)/$1$author$3/g; } print "Changed $count revision author entries to \"$author\"\n"; open F, ">$file" or die "Cannot write $file: $!"; binmode F; print F $contents; close F; sysZip("-f -q","../$target","$file"); } print "Result is ",length($contents)," bytes.\n" if $debug; sysCD(".."); if ($debug) { doSystem("xattr -d -r com.apple.quarantine $dir") if $os eq "macosx"; } else { sysRemoveDir($dir); } exit; ######################################################################################################################## sub checkCmd { my @path = $os eq "windows" ? split(/;/, $ENV{path}) : split(/:/, $ENV{PATH}); my @missing; foreach my $cmd (@_) { my $found = 0; foreach my $path (@path) { $found = 1 if $os eq "windows" && -f "$path\\$cmd\.EXE"; $found = 1 if $os ne "windows" && -f "$path/$cmd"; } push @missing, $cmd unless $found; } return if scalar(@missing) == 0; print "Could not find the following OS command(s): ",join(" ", @missing), "\n\nSearched the following directories:\n", join("\n", @path), "\n"; exit; } sub sysCD { my ($dir) = @_; print "cd $dir\n" if $debug; chdir($dir); } sub sysCopy { my ($src,$dest) = @_; doSystem(($os eq "windows" ? "copy" : "cp")." \"$src\" \"$dest\""); } sub sysRemoveDir { my ($dir) = @_; doSystem(($os eq "windows" ? "rmdir /S /Q" : "rm -R")." \"$dir\""); } sub sysUnzip { my ($args,@targets) = @_; map { $_ = "\"$_\"" } @targets; doSystem(join(" ","unzip",$args,@targets)); } sub sysZip { my ($args,@targets) = @_; map { $_ = "\"$_\"" } @targets; doSystem(join(" ","zip",$args,@targets)); } sub doSystem { print "@_\n" if $debug; system "@_"; } ######################################################################################################################## sub doHelp { print $helpMessage; }