view release on metacpan or  search on metacpan

examples/ss-dups-tk.pl  view on Meta::CPAN

    my ($ft, $r) = @$_;
    Spreadsheet::Read::parses ($ft) or next;
    push @{$ftyp{$r->[0]}}, @{$r->[1]};
    push @{$ftyp{"All spreadsheet types"}}, @{$r->[1]};
    }
$tf->Button (
    -text	=> "Select file",
    -command	=> sub {
	$ss   = undef;
	$file = $mw->getOpenFile (
	    -filetypes => [ ( map { [ $_, $ftyp{$_} ] } sort keys %ftyp ),
		[ "All files", "*" ],
		],
	    );
	ReadFile ();
	},
    )->pack (qw(-side left -expand 1 -fill both));
$tf->Button (
    -text	=> "Detect",
    -command	=> \&Detect,
    )->pack (qw(-side left -expand 1 -fill both));
$tf->Button (
    -text	=> "Show",
    -command	=> \&Show,
    )->pack (qw(-side left -expand 1 -fill both));
$tf->Button (
    -text	=> "Exit",
    -command	=> \&exit,
    )->pack (qw(-side left -expand 1 -fill both));

my $mf = $mw->Frame  ()->pack (qw( -side top -anchor nw -expand 1 -fill both ));
my $sw = $mf->Scrolled ("ROText",
    -scrollbars             => "osoe",
	-height             => 40,
	-width              => 85,
	-foreground         => "Black",
	-background         => "White",
	-highlightthickness => 0,
	-setgrid            => 1)->pack (qw(-expand 1 -fill both));
$dt = $sw->Subwidget ("scrolled");
#$sw->Subwidget ("xscrollbar")->packForget;
$dt->configure (
    -wrap	=> "none",
    -font	=> "mono 12",
    );

my $bf = $mw->Frame  ()->pack (qw( -side top -anchor nw -expand 1 -fill both ));
$bf->Checkbutton (
    -variable	=> \$opt_t,
    -text	=> "True values only",
    )->pack (qw(-side left -expand 1 -fill both));
{   my $opt_S = @opt_S ? join ",", @opt_S : 1;
    $bf->Label (
	-text		=> "Sheet(s)",
	)->pack (qw(-side left -expand 1 -fill both));
    $bf->Entry (
	-textvariable	=> \$opt_S,
	-width		=> 10,
	-validate	=> "focusout",
	-vcmd		=> sub {
	    @opt_S = grep m/\S/, split m/\s*,\s*/ => $opt_S;
	    1;
	    },
	)->pack (qw(-side left -expand 1 -fill both));
    }
{   my $opt_R = join ",", @opt_R;
    $bf->Label (
	-text		=> "Rows(s)",
	)->pack (qw(-side left -expand 1 -fill both));
    $bf->Entry (
	-textvariable	=> \$opt_R,
	-width		=> 10,
	-validate	=> "focusout",
	-vcmd		=> sub {
	    @opt_R = grep m/\S/, split m/\s*,\s*/ => $opt_R;
	    1;
	    },
	)->pack (qw(-side left -expand 1 -fill both));
    }
{   my $opt_C = join ",", @opt_C;
    $bf->Label (
	-text		=> "Columns(s)",
	)->pack (qw(-side left -expand 1 -fill both));
    $bf->Entry (
	-textvariable	=> \$opt_C,
	-width		=> 10,
	-validate	=> "focusout",
	-vcmd		=> sub {
	    @opt_C = grep m/\S/, split m/\s*,\s*/ => $opt_C;
	    1;
	    },
	)->pack (qw(-side left -expand 1 -fill both));
    }

sub ranges (@) {
    my @g;
    foreach my $arg (@_) {
	for (split m/,/, $arg) {
	    if (m/^(\w+)\.\.(\w+)$/) {
		my ($s, $e) = ($1, $2);
		$s =~ m/^[1-9]\d*$/ or ($s, $e) = (qq("$s"), qq("$e"));
		eval "push \@g, $s .. $e";
		}
	    else {
		push @g, $_;
		}
	    }
	}
    $opt_v and print STDERR "( @g )\n";
    @g;
    } # ranges

sub Detect {
    $ss or ReadFile ();

    $dt->delete ($is, "end");
    $dt->insert ("end", join "\n", "",
	"Shts: @opt_S",
	"Rows: @opt_R",
	"Cols: @opt_C",
	"--------------------------------------------------------------",
	"");
    my %done;
    my @S = $opt_S[0] eq "all" ? (1 .. $ss->[0]{sheets}) : ranges (@opt_S);
    my @R = ranges (@opt_R);
    my @C = ranges (@opt_C);
    my %f = map { uc $_ => 1 } ("@opt_F" =~ m/(\b[A-Z]\d+\b)/ig);

    foreach my $s (@S) {
	my $xls = $ss->[$s] or die "Cannot read sheet $s\n";

	my @r = @R ? @R : (1 .. $xls->{maxrow});
	my @c = @C ? @C : (1 .. $xls->{maxcol});

	foreach my $r (@r) {
	    foreach my $c (@c) {
		defined $xls->{cell}[$c][$r] or next;
		my $v    = uc $xls->{cell}[$c][$r];
		my $cell = cr2cell ($c, $r);
		@S > 1 and $cell = $xls->{label} . "[$cell]";

		$opt_t && !$v		and next;
		@opt_F && !exists $f{$cell} and next;

		if (exists $done{$v}) {
		    $dt->insert ("end", sprintf "Cell %-5s is dup of %-5s '%s'\n", $cell, $done{$v}, $v);
		    next;
		    }
		$done{$v} = $cell;
		}
	    }
	}
    } # Detect

sub Show {
    $ss or ReadFile ();

    $dt->delete ($is, "end");