--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/README Wed Feb 15 15:43:53 2017 +0100
@@ -0,0 +1,1 @@
+moved to git
--- a/purge-proe Thu Jul 23 15:57:20 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,127 +0,0 @@
-#!/usr/bin/perl
-
-# Delete old Pro/Engineer files
-# Copyright (C) 2010-2015 Matthias Förste
-#
-# 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/>.
-#
-# Matthias Förste <foerste@schlittermann.de>
-
-use strict;
-use warnings;
-
-use Getopt::Long;
-use Pod::Usage;
-use File::Find;
-use File::Basename;
-
-my $files;
-my $opt = {
-
- dirs => [], # dont set default dir here because arguments to --directory will
- # not overwrite it, but added to it
- keep => 3
-
-};
-
-my $proe_first_line = "#UGC:";
-my $proe_stems = [qw(errors.lst support.inf trail.txt test.txt global_intf.inf outdated.lst outdated.err info.trf)];
-
-die "Failed to read options" unless GetOptions(
- 'directory=s' => $opt->{dirs},
- 'help' => sub { pod2usage(-verbose => 1, -exitval => 0) },
- 'man' => sub { pod2usage(-verbose => 2, -exitval => 0) },
- 'keep=i' => \$opt->{keep},
-);
-
-sub doit {
-
- return if -d;
-
- my $f = $File::Find::name;
- return unless $f =~ /^(.+)\.([0-9]+)$/;
-
- my ($stem, $stembase, $suffix) = ($1, basename($1), $2);
-
- eval {
-
- for (@{$proe_stems}) { return if $stembase eq $_; }
- die "Ignoring '$f': is empty" unless -s $f;
- die "Ignoring '$f': failed to open: $!" unless open FILE, '<', $f;
- # should only happen in case of a read error because we already
- # checked the file for emptiness
- die "Ignoring '$f': failed to read: $!" unless defined ($_ = <FILE>);
- die "Ignoring '$f': not an Pro/Engineerfile" unless /^$proe_first_line/;
-
- };
-
- warn $@ and return if $@ ne '';
- $files->{$stem} = exists $files->{$stem} ? [ $suffix, @{$files->{$stem}} ] : [ $suffix ];
-
-}
-
-$opt->{dirs} = ['.'] unless @{$opt->{dirs}};
-
-find( { wanted => \&doit, no_chdir => 1 }, @{$opt->{dirs}});
-my @sufs;
-for my $stem (keys %{$files}) {
-
- @sufs = sort { $a <=> $b } @{$files->{$stem}};
-
- my $to = $#sufs - $opt->{keep};
- my $from;
- if ($to < 0) { $from = 0; } else { $from = $to + 1; }
-
- for (@sufs[0 .. $to]) {
- print "Going to delete $stem.$_\n";
- warn "Couldn't unlink: $stem.$_: $!" unless unlink "$stem.$_";
- }
-
- for (@sufs[$from .. $#sufs]) {
- print "Going to keep $stem.$_\n";
- }
-
-}
-
-=head1 NAME
-
-purge-proe - delete old Pro/Engineer files
-
-=head1 SYNOPSIS
-
-purge-proe [-d|--directory directory1] [-d|--directory directory2] ...
- [-k|--keep n]
-
-purge-proe [-h|--help]
-
-purge-proe [-m|--man]
-
-=head1 OPTIONS
-
-=over
-
-=item B<-d>|B<--directory> directory
-
-A directory to clean. This option can be given multiple times. (default:
-current directory)
-
-=item B<-k>|B<--keep n>
-
-Number of old files to keep. (default: 3)
-
-=back
-
-=head1 BUGS
-
-Probably.
--- a/test Thu Jul 23 15:57:20 2015 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,81 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-my $purge_cmd = "./purge-proe";
-
-my $stem = "a";
-my $subdir = "x";
-my $proe_first_line = "#UGC:";
-my $num_empty = 69;
-my $num_non_proe = 101;
-my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711);
-
-use Test::Simple tests => 53;
-
-my $files = {
-
- in_workdir => [ map "$stem.$_", @nums_before ],
- in_subdir => [ map "$subdir/$stem.$_", @nums_before ],
- empty => "$subdir/$stem.$num_empty",
- non_proe => "$subdir/$stem.$num_non_proe",
- errors_lst => [ map "errors.lst.$_", @nums_before ],
- trail_txt => [ map "trail.txt.$_", @nums_before ],
- info_trf => [ map "info.trf.$_", @nums_before ]
-
-};
-
-sub prepare;
-
-prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line });
-ok(qx/$purge_cmd/, "Running '$purge_cmd'");
-my (@absent, @present);
-@present = @{$files}{qw(empty non_proe)};
-for (qw(in_workdir in_subdir errors_lst trail_txt info_trf)) {
- push @present, splice @{$files->{$_}}, -3, 3;
- push @absent, @{$files->{$_}};
-}
-for (@present) { ok(-f $_, "Checking for presence of file '$_'"); }
-for (@absent) { ok(! -e $_, "Checking for absence of '$_'"); }
-
-for (@present, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; }
-rmdir $subdir or warn "Can't rmdir '$subdir': $!";
-
-# $opts = {
-# dirs => ['dir1', 'dir2', ..],
-# files => {
-# in_workdir => ['file1', 'file2', ..],
-# in_subdir => ['path1', 'path2', ..],
-# empty => 'path_to_an_empty_file',
-# non_proe => 'path_to_a_nonempty_nonproe_file'
-# errors_lst => [ 'errors.lst.n1', 'errors.lst.n2', ..],
-# trail_txt => [ 'trail.txt.n1', 'trail.txt.n2', ..],
-# info_trf => [ 'info.trf.n1', 'info.trf.n2', ..]
-# },
-# proe_first_line => 'something that should appear in the first line of a file to match'
-# }
-sub prepare {
-
- my ($opts) = @_;
-
- for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; }
-
- for (map { @{$_} } @{$opts->{files}}{qw(in_workdir in_subdir errors_lst trail_txt info_trf)}) {
-
- open F, '>', $_ or warn "Can't open F, '>', '$_': $!";
- print F $proe_first_line;
- close F;
-
- }
-
- my $empty = $opts->{files}->{empty};
- open F, '>', $empty or warn "Can't open F, '>', '$empty': $!";
- close F;
-
- my $non_proe = $opts->{files}->{non_proe};
- open F, '>', $non_proe or warn "Can't open F, '>', '$non_proe': $!";
- print F "foo";
- close F;
-
-}