r28836 - in /branches/upstream/libtk-dirselect-perl: ./ current/ current/Changes current/DirSelect.pm current/MANIFEST current/Makefile.PL current/README current/test.pl

ddumont-guest at users.alioth.debian.org ddumont-guest at users.alioth.debian.org
Sun Dec 28 11:37:15 UTC 2008


Author: ddumont-guest
Date: Sun Dec 28 11:37:11 2008
New Revision: 28836

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28836
Log:
[svn-inject] Installing original source of libtk-dirselect-perl

Added:
    branches/upstream/libtk-dirselect-perl/
    branches/upstream/libtk-dirselect-perl/current/
    branches/upstream/libtk-dirselect-perl/current/Changes
    branches/upstream/libtk-dirselect-perl/current/DirSelect.pm
    branches/upstream/libtk-dirselect-perl/current/MANIFEST
    branches/upstream/libtk-dirselect-perl/current/Makefile.PL
    branches/upstream/libtk-dirselect-perl/current/README
    branches/upstream/libtk-dirselect-perl/current/test.pl

Added: branches/upstream/libtk-dirselect-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/Changes?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/Changes (added)
+++ branches/upstream/libtk-dirselect-perl/current/Changes Sun Dec 28 11:37:11 2008
@@ -1,0 +1,48 @@
+Revision history for Perl extension Tk::DirSelect.
+
+1.11 (2005-08-19)
+    * DirTree no longer resets to cwd after a rename.
+
+1.10 (2005-08-17)
+    * Under Tk v804+, make BrowseEntry not look disabled just because it's
+      readonly.
+    * Added context menu for creating, renaming and deleting directories.
+
+1.09 (2004-10-22)
+    * Pass additional arguments to Show() on to Popup().
+    * For Show() default the initial directory to cwd only when first argument
+      is undef, not false. (Just in case someone actually has a directory
+      named '0')
+
+1.08 (2004-10-22)
+    * On Win32, added a work-around for scrollbars sometimes appearing disabled.
+
+1.07 (2004-05-21)
+    * On Win32, added a work-around for inability to see other folders in the 
+      root directory of the drive containing the initial directory. Reselecting 
+      the drive from the drop menu now displays contents properly. (The root 
+      cause of the bug is in DirTree or one of its parent classes...)
+    * Fixed $VERSION in DirSelect.pm (Oops.)
+
+1.06 (2004-05-20)
+    * Add Tk as dependancy in Makefile.PL. Should be beyond obvious to
+      end users, but automated test sites aren't as smart. :)
+
+1.05 (2004-05-20)
+    * First CPAN release.
+    * Added a patch for HList behavior changes around Tk 804.025. Corrects
+      the problem where Show() returned an ARRAY ref instead of a string.
+
+1.04 (2004-05-19)
+    * Cleaned up guts (no longer recreates a DirTree for each drive change)
+    * Generate drive list upon display, not creation.
+    * Initial directory now an argument to Show() (not creation)
+    * Better display of initial directory.
+    * Changed title from default, allow user to set (at creation)
+
+1.03 (2004-05-19)
+    * Maintenance taken over by Michael Carman.
+    * Use a BrowseEntry instead of buttons for Win32 drives
+    * Restores cwd after finished.
+    * Better passthrough of args to DirTree.
+    * Lots of miscellaneous tweaks.

Added: branches/upstream/libtk-dirselect-perl/current/DirSelect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/DirSelect.pm?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/DirSelect.pm (added)
+++ branches/upstream/libtk-dirselect-perl/current/DirSelect.pm Sun Dec 28 11:37:11 2008
@@ -1,0 +1,502 @@
+#===============================================================================
+# Tk/DirSelect.pm
+# Copyright (C) 2000-2001 Kristi Thompson   <kristi at kristi.ca>
+# Copyright (C) 2002-2005 Michael J. Carman <mjcarman at mchsi.com>
+# Last Modified: 8/19/2005 9:42AM
+#===============================================================================
+# This is free software under the terms of the Perl Artistic License.
+#===============================================================================
+BEGIN { require 5.004 }
+
+package Tk::DirSelect;
+use Cwd;
+use File::Spec;
+use Tk 800;
+require Tk::Frame;
+require Tk::BrowseEntry;
+require Tk::Button;
+require Tk::Label;
+require Tk::DirTree;
+
+use strict;
+use base 'Tk::Toplevel';
+Construct Tk::Widget 'DirSelect';
+
+use vars qw'$VERSION';
+$VERSION = '1.11';
+
+my %colors;
+my $isWin32;
+
+#-------------------------------------------------------------------------------
+# Subroutine : ClassInit()
+# Purpose    : Class initialzation.
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub ClassInit {
+	my ($class, $mw) = @_;
+	$class->SUPER::ClassInit($mw);
+
+	$isWin32 = $^O eq 'MSWin32';
+
+	# Get system colors from a Text widget for use in DirTree
+	my $t = $mw->Text();
+	foreach my $x (qw'-background -selectbackground -selectforeground') {
+		$colors{$x} = $t->cget($x);
+	}
+	$t->destroy();
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : Populate()
+# Purpose    : Create the DirSelect widget
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub Populate {
+	my ($w, $args) = @_;
+	my $directory  = delete $args->{-dir}   || cwd();
+	my $title      = delete $args->{-title} || 'Select Directory';
+
+    $w->withdraw;
+	$w->SUPER::Populate($args);
+	$w->ConfigSpecs(-title => ['METHOD', 'title', 'Title', $title]);
+	$w->bind('<Escape>', sub { $w->{dir} = undef });
+
+	my %f = (
+		drive  => $w->Frame->pack(-anchor => 'n', -fill => 'x'),
+		button => $w->Frame->pack(-side => 'bottom', -anchor => 's', -fill => 'x', -ipady  => 6),
+		tree   => $w->Frame->pack(-fill => 'both', -expand => 1),
+	);
+
+	$w->{tree} = $f{tree}->Scrolled('DirTree',
+		-scrollbars       => 'osoe',
+		-selectmode       => 'single',
+		-ignoreinvoke     => 0,
+		-width            => 50,
+		-height           => 15,
+		%colors,
+		%$args,
+	)->pack(-fill => 'both', -expand => 1);
+
+	$w->{tree}->configure(-command   => sub { $w->{tree}->opencmd($_[0]) });
+	$w->{tree}->configure(-browsecmd => sub { $w->{tree}->anchorClear });
+
+	$f{button}->Button(
+		-width   => 7,
+		-text    => 'OK',
+		-command => sub { $w->{dir} = $w->{tree}->selectionGet() },
+	)->pack(-side => 'left', -expand => 1);
+
+	$f{button}->Button(
+		-width   => 7,
+		-text    => 'Cancel',
+		-command => sub { $w->{dir} = undef },
+	)->pack(-side => 'left', -expand => 1);
+
+	if ($isWin32) {
+		$f{drive}->Label(-text => 'Drive:')->pack(-side => 'left');
+		$w->{drive} = $f{drive}->BrowseEntry(
+			-variable  => \$w->{selected_drive},
+			-browsecmd => [\&_browse, $w->{tree}],
+			-state     => 'readonly',
+		)->pack(-side => 'left', -fill => 'x', -expand => 1);
+
+		if ($Tk::VERSION >= 804) {
+			# widget is readonly, but shouldn't appear disabled
+			for my $e ($w->{drive}->Subwidget('entry')->Subwidget('entry')) {
+				$e->configure(-disabledforeground => $colors{-foreground});
+				$e->configure(-disabledbackground => $colors{-background});
+			}
+		}
+	}
+	else {
+		$f{drive}->destroy;
+	}
+
+	# right-click context menu
+	my $menu = $w->Menu(
+		-tearoff   => 0,
+		-menuitems => [
+			[qw/command ~New/,    -command => [\&_mkdir , $w]],
+			[qw/command ~Rename/, -command => [\&_rename, $w]],
+			[qw/command ~Delete/, -command => [\&_rmdir,  $w]],
+		],
+	);
+	$menu->bind('<FocusOut>' => sub {$menu->unpost});
+	$w->{tree}->bind('<Button-3>' => [\&_context, $menu, Ev('X'), Ev('Y')]);
+
+	# popup overlay for renaming directories
+	$w->{renameval} = undef;
+	$w->{popup}     = $w->Toplevel();
+	$w->{rename}    = $w->{popup}->Entry(
+		-relief       => 'groove',
+		-borderwidth  => 1,
+	)->pack(-fill => 'x', -expand => 1);
+	$w->{popup}->overrideredirect(1);
+	$w->{popup}->withdraw;
+	$w->{rename}->bind('<Escape>',          sub {$w->{renameval} = undef});
+	$w->{rename}->bind('<FocusOut>',        sub {$w->{renameval} = undef});
+	$w->{rename}->bind('<KeyPress-Return>', sub {$w->{renameval} = $w->{rename}->get});
+
+	return $w;
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : Show()
+# Purpose    : Display the DirSelect widget.
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub Show {
+	my $w     = shift;
+	my $dir   = shift;
+	my $cwd   = cwd();
+	my $focus = $w->focusSave;
+	my $grab  = $w->grabSave;
+
+	$dir = $cwd unless defined $dir && -d $dir;
+	chdir($dir);
+
+	if ($isWin32) {
+		# populate the drive list
+		my @drives = _get_volume_info();
+		$w->{drive}->delete(0, 'end');
+		my $startdrive = _drive($dir);
+
+		foreach my $d (@drives) {
+			$w->{drive}->insert('end', $d);
+			if ($startdrive eq _drive($d)) {
+				$w->{selected_drive} = $d;
+			}
+		}
+	}
+
+	# show initial directory
+	_showdir($w->{tree}, $dir);
+
+	$w->Popup(@_);                # show widget
+	$w->focus;                    # seize focus
+	$w->grab;                     # seize grab
+	$w->waitVariable(\$w->{dir}); # wait for user selection (or cancel)
+	$w->grabRelease;              # release grab
+	$w->withdraw;                 # run and hide
+	$focus->();                   # restore prior focus
+	$grab->();                    # restore prior grab
+	chdir($cwd)                   # restore working directory
+		or warn "Could not chdir() back to '$cwd' [$!]\n";
+
+	# HList SelectionGet() behavior changed around Tk 804.025
+	if (ref $w->{dir} eq 'ARRAY') {
+		$w->{dir} = $w->{dir}[0];
+	}
+
+	{
+		local $^W;
+		$w->{dir} .= '/' if ($isWin32 && $w->{dir} =~ /:$/);
+	}
+
+	return $w->{dir};
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : _browse()
+# Purpose    : Browse to a mounted filesystem (Win32)
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub _browse {
+	my ($w, undef, $d) = @_;
+	$d = _drive($d) . '/';
+	chdir($d);
+	_showdir($w, $d);
+
+	# Workaround: Under Win* versions of Perl/Tk, scrollbars have a tendancy
+	# to show up but be disabled.
+	$w->yview(scroll => 1, 'units');
+	$w->update;
+	$w->yview(scroll => -1, 'units');
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : _showdir()
+# Purpose    : Show the requested directory
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub _showdir {
+	my $w   = shift;
+	my $dir = shift;
+	$w->delete('all');
+	$w->chdir($dir);
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : _get_volume_info()
+# Purpose    : Get volume information (Win32)
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub _get_volume_info {
+	require Win32API::File;
+
+	my @drivetype = (
+		'Unknown',
+		'No root directory',
+		'Removable disk drive',
+		'Fixed disk drive',
+		'Network drive',
+		'CD-ROM drive',
+		'RAM Disk',
+	);
+
+	my @drives;
+	foreach my $ld (Win32API::File::getLogicalDrives()) {
+		my $drive = _drive($ld);
+		my $type  = $drivetype[Win32API::File::GetDriveType($drive)];
+		my $label;
+
+		Win32API::File::GetVolumeInformation(
+			$drive, $label, [], [], [], [], [], []);
+
+		push @drives, "$drive  [$label] $type";
+	}
+
+	return @drives;
+}
+
+
+#-------------------------------------------------------------------------------
+# Subroutine : _drive()
+# Purpose    : Get the drive letter (Win32)
+# Notes      : 
+#-------------------------------------------------------------------------------
+sub _drive {
+	shift =~ /^(\w:)/;
+	return uc $1;
+}
+
+
+#-------------------------------------------------------------------------------
+# Method  : _context
+# Purpose : Display the context menu
+# Notes   : 
+#-------------------------------------------------------------------------------
+sub _context {
+	my ($w, $m, $x, $y) = @_;
+	my $wy = $y - $w->rooty;
+	$w->selectionClear();
+	$w->selectionSet($w->nearest($wy));
+	$m->post($x, $y);
+	$m->focus;
+}
+
+
+#-------------------------------------------------------------------------------
+# Method  : _mkdir
+# Purpose : Create a new directory under the current selection
+# Notes   : 
+#-------------------------------------------------------------------------------
+sub _mkdir  {
+	my $w     = shift;
+	my $dt    = $w->{tree};
+	my ($sel) = $dt->selectionGet();
+
+	my $cwd  = Cwd::cwd();
+	if (chdir($sel)) {
+		my $base = 'NewDirectory';
+		my $name = $base;
+		my $i    = 1;
+
+		while (-d $name && $i < 1000) {
+			$name = $base . $i++;
+		}
+
+		unless (-d $name) {
+			if (mkdir($name)) {
+				_showdir($dt, $sel);
+				$dt->selectionClear();
+				$dt->selectionSet($sel . '/' . $name);
+				$w->_rename();
+			}
+			else {
+				$w->messageBox(
+					-title   => 'Unable to create directory',
+					-message => "The directory '$name' could not be created.\n$!",
+					-icon    => 'error',
+					-type    => 'OK',
+				);
+			}
+		}
+
+		chdir($cwd);
+	}
+	else {
+		warn "Unable to chdir() for mkdir() [$!]\n";
+	}
+}
+
+
+#-------------------------------------------------------------------------------
+# Method  : _rmdir
+# Purpose : Delete the selected directory
+# Notes   : 
+#-------------------------------------------------------------------------------
+sub _rmdir {
+	my $w     = shift;
+	my $dt    = $w->{tree};
+	my ($sel) = $dt->selectionGet();
+
+	my @path = File::Spec->splitdir($sel);
+	my $dir  = pop @path;
+	my $pdir = File::Spec->catdir(@path);
+
+	my $cwd  = Cwd::cwd();
+	if (chdir($pdir)) {
+		if (rmdir($dir)) {
+			_showdir($dt, $pdir);
+		}
+		else {
+			$w->messageBox(
+				-title   => 'Unable to delete directory',
+				-message => "The directory '$dir' could not be deleted.\n$!",
+				-icon    => 'error',
+				-type    => 'OK',
+			);
+		}
+		chdir($cwd);
+	}
+	else {
+		warn "Unable to chdir() for rmdir() [$!]\n";
+	}
+}
+
+#-------------------------------------------------------------------------------
+# Method  : _rename
+# Purpose : Rename the selected directory
+# Notes   : 
+#-------------------------------------------------------------------------------
+sub _rename {
+	my $w       = shift;
+	my $dt      = $w->{tree};
+	my $popup   = $w->{popup};
+	my $entry   = $w->{rename};
+	my ($sel)   = $dt->selectionGet();
+	my ($x, $y, $x1, $y1) = $dt->infoBbox($sel);
+
+	my @path = File::Spec->splitdir($sel);
+	my $dir  = pop @path;
+	my $pdir = File::Spec->catdir(@path);
+
+	$entry->delete(0, 'end');
+	$entry->insert(0, $dir);
+	$entry->selectionRange(0, 'end');
+	$entry->focus;
+
+	my $font  = ($entry->configure(-font))[4];
+	my $text  = 'ABCDEFGHIGKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 ';
+	my $width = $entry->fontMeasure($font, $text) / length($text);
+	$entry->configure(-width => ($x1 - $x) / $width);
+
+	$popup->Post($dt->rootx + $x, $dt->rooty + $y);
+	$popup->waitVariable(\$w->{renameval});
+	$popup->withdraw;
+
+	if (defined $w->{renameval} && $w->{renameval} ne $dir) {
+		my $cwd  = Cwd::cwd();
+
+		if (chdir($pdir)) {
+			unless (rename($dir, $w->{renameval})) {
+				$w->messageBox(
+					-title   => 'Unable to rename directory',
+					-message => "The directory '$dir' could not be renamed.\n$!",
+					-icon    => 'error',
+					-type    => 'OK',
+				);
+			}
+			chdir($cwd);
+			_showdir($dt, $pdir); # rebrowse to update the display
+		}
+		else {
+			warn "Unable to chdir() for rename() [$!]\n";
+		}
+	}
+}
+
+
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+Tk::DirSelect - Cross-platform directory selection widget.
+
+=head1 SYNOPSIS
+
+  use Tk::DirSelect;
+  my $ds  = $mw->DirSelect();
+  my $dir = $ds->Show();
+
+=head1 DESCRIPTION
+
+This module provides a cross-platform directory selection widget. For 
+systems running Microsoft Windows, this includes selection of local and 
+mapped network drives. A context menu (right-click or E<lt>Button3E<gt>) 
+allows the creation, renaming, and deletion of directories while 
+browsing.
+
+Note: Perl/Tk 804 added the C<chooseDirectory> method which uses native 
+system dialogs where available. (i.e. Windows) If you want a native feel 
+for your program, you probably want to use that method instead --
+possibly using this module as a fallback for systems with older versions 
+of Tk installed.
+
+=head1 METHODS
+
+=head2 C<DirSelect([-title =E<gt> 'title'], [options])>
+
+Constructs a new DirSelect widget as a child of the invoking object 
+(usually a MainWindow). 
+
+The title for the widget can be set by specifying C<-title =E<gt> 
+'Title'>. Any other options provided will be passed through to the 
+DirTree widget that displays directories, so be sure they're appropriate 
+(e.g. C<-width>)
+
+=head2 C<Show([directory], [options])>
+
+Displays the DirSelect widget and returns the user selected directory or 
+C<undef> if the operation is canceled.
+
+All arguments are optional. The first argument (if defined) is the 
+initial directory to display. The default is to display the current 
+working directory. Any additional options are passed through to the 
+Popup() method. This means that you can do something like
+
+  $ds->Show(undef, -popover => $mw);
+
+to center the dialog over your application.
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item * Perl 5.004
+
+=item * Tk 800
+
+=item * Win32API::File (under Microsoft Windows only)
+
+=back
+
+=head1 AUTHOR
+
+Original author Kristi Thompson <kristi at kristi.ca>
+
+Current maintainer Michael J. Carman <mjcarman at mchsi.com>
+
+This is free software under the terms of the Perl Artistic License.
+
+=cut

Added: branches/upstream/libtk-dirselect-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/MANIFEST?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/MANIFEST (added)
+++ branches/upstream/libtk-dirselect-perl/current/MANIFEST Sun Dec 28 11:37:11 2008
@@ -1,0 +1,6 @@
+Changes
+DirSelect.pm
+Makefile.PL
+MANIFEST
+README
+test.pl

Added: branches/upstream/libtk-dirselect-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/Makefile.PL?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/Makefile.PL (added)
+++ branches/upstream/libtk-dirselect-perl/current/Makefile.PL Sun Dec 28 11:37:11 2008
@@ -1,0 +1,11 @@
+use 5.004;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    'NAME'         => 'Tk::DirSelect',
+    'VERSION_FROM' => 'DirSelect.pm',
+    'PREREQ_PM'    => {'Tk' => 800},
+    ($] >= 5.005 ?
+      (ABSTRACT_FROM => 'DirSelect.pm',
+       AUTHOR        => 'Michael J. Carman <mjcarman at mchsi.com>') : ()),
+);

Added: branches/upstream/libtk-dirselect-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/README?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/README (added)
+++ branches/upstream/libtk-dirselect-perl/current/README Sun Dec 28 11:37:11 2008
@@ -1,0 +1,78 @@
+Tk/DirSelect
+============
+
+This module provides a cross-platform directory selection widget. For 
+systems running Microsoft Windows, this includes selection of local and 
+mapped network drives.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+CHANGES
+
+1.11 (2005-08-19)
+    * DirTree no longer resets to cwd after a rename.
+
+1.10 (2005-08-17)
+    * Under Tk v804+, make BrowseEntry not look disabled just because it's
+      readonly.
+    * Added context menu for creating, renaming and deleting directories.
+
+1.09 (2004-10-22)
+    * Pass additional arguments to Show() on to Popup().
+    * For Show() default the initial directory to cwd only when first argument
+      is undef, not false. (Just in case someone actually has a directory
+      named '0')
+
+1.08 (2004-10-22)
+    * On Win32, added a work-around for scrollbars sometimes appearing disabled.
+
+1.07 (2004-05-21)
+    * On Win32, added a work-around for inability to see other folders in the 
+      root directory of the drive containing the initial directory. Reselecting 
+      the drive from the drop menu now displays contents properly. (The root 
+      cause of the bug is in DirTree or one of its parent classes...)
+    * Fixed $VERSION in DirSelect.pm (Oops.)
+
+1.06 (2004-05-20)
+    * Add Tk as dependancy in Makefile.PL. Should be beyond obvious to
+      end users, but automated test sites aren't as smart. :)
+
+1.05 (2004-05-20)
+    * First CPAN release.
+    * Added a patch for HList behavior changes around Tk 804.025. Corrects
+      the problem where Show() returned an ARRAY ref instead of a string.
+
+1.04 (2004-05-19)
+    * Cleaned up guts (no longer recreates a DirTree for each drive change)
+    * Generate drive list upon display, not creation.
+    * Initial directory now an argument to Show() (not creation)
+    * Better display of initial directory.
+    * Changed title from default, allow user to set (at creation)
+
+1.03 (2004-05-19)
+    * Maintenance taken over by Michael Carman.
+    * Use a BrowseEntry instead of buttons for Win32 drives
+    * Restores cwd after finished.
+    * Better passthrough of args to DirTree.
+    * Lots of miscellaneous tweaks.
+
+DEPENDENCIES
+
+  Perl 5.004
+  Tk 800
+  Win32API::File (under Microsoft Windows only)
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2000-2001 Kristi Thompson   <kristi at kristi.ca>
+Copyright (C) 2002-2004 Michael J. Carman <mjcarman at mchsi.com>
+
+This library is free software under the terms of the Perl Artistic 
+License.

Added: branches/upstream/libtk-dirselect-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtk-dirselect-perl/current/test.pl?rev=28836&op=file
==============================================================================
--- branches/upstream/libtk-dirselect-perl/current/test.pl (added)
+++ branches/upstream/libtk-dirselect-perl/current/test.pl Sun Dec 28 11:37:11 2008
@@ -1,0 +1,17 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+BEGIN { plan tests => 1 };
+use Tk::DirSelect;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+




More information about the Pkg-perl-cvs-commits mailing list