filemorph: Check-in [6cfe1e1e85]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview

Comment:	Prepare Windows version for deployment
Timelines:	family \| ancestors \| descendants \| both \| trunk
Files:	files \| file ages \| folders
SHA1:	6cfe1e1e85a72fb627442b3e62c88ac9d6c46a1e
User & Date:	kevin 2015-10-05 02:00:08

Context

2015-10-05
02:02		More tweaks check-in: 546b27ed47 user: kevin tags: trunk
02:00		Prepare Windows version for deployment check-in: 6cfe1e1e85 user: kevin tags: trunk
2015-10-04
03:56		More adjustments check-in: bbc7fc8a2d user: kevin tags: trunk

Changes

Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to filemorph.pl.

use Env qw(HOME);
use File::Path qw(remove_tree);
use File::Copy::Recursive qw (rmove);

BEGIN {

    if ($Config{osname} eq "darwin") {
        my $frameworkpath ="$Bin/Contents/Frameworks/Tcl.framework/Tcl";
        $ENV{'PERL_TCL_DL_PATH'} = $frameworkpath;
    }
    if ($Config{osname} eq "MSWin32") {
        if (exists $ENV{PAR_PROGNAME}) {
            my $libtarget ="$ENV{TMP}/lib";
            my $libsrc    ="$ENV{PAR_TEMP}/inc/script/Tcl/lib";
            rmove($libsrc, $libtarget);
            my $bintarget ="$ENV{TMP}/bin";
            my $binsrc    ="$ENV{PAR_TEMP}/inc/script/Tcl/bin";
            rmove($binsrc, $bintarget);
        }

    }

}

#use strict;
use warnings;
use Tkx;

our $IS_AQUA    = &Tkx::tk_windowingsystem eq"aqua";
our $IS_WINDOWS = &Tkx::tk_windowingsystem eq"win32";

use File::Copy qw(move copy);
use Env qw (HOME TMP TEMP TMPDIR);
use Time::Local;
use POSIX qw( strftime );
use File::Basename qw(fileparse basename dirname);
use LWP::Simple;
use Config::IniFiles;
use File::Temp qw(tempfile);

Tkx::set('::argv0', $ARGV[0] ||"");
Tkx::catch('console hide');

Tkx::package_require('tkdnd');
Tkx::package_require('Img');
Tkx::package_require('regproc');
Tkx::package_require('machelp');
Tkx::package_require('softwareupdate');
................................................................................
#initialize the app
&startUp;
&makeImage;

@filelist = ();

if ($IS_AQUA) {
    Tkx::interp_alias("", "::tk::mac::OpenDocument","", [\&openDoc]);
    Tkx::interp_alias("", "::tk::mac::ShowHelp",    "", [\&showHelp]);
    Tkx::interp_alias("", "bgerror",                "", [\&errlog]);
}

if ($IS_WINDOWS) {
    Tkx::package_require("twapi");
    Tkx::twapi__AddFontResourceEx('iconic_stroke.ttf');
}

#draw the GUI
our $mw = Tkx::widget->new(".");
Tkx::wm_title($mw,"FileMorph");
$mw->g_wm_withdraw;
if ($IS_WINDOWS) {
    $mw->g_wm_protocol(WM_DELETE_WINDOW => \&shutdown);
    $mw->g_wm_iconphoto(-default=>$icon);
}

#menubar code
my $menubar = $mw->new_menu();
Tkx::option_add("*tearOff", 0);
our $applemenu;
if ($IS_AQUA) {
................................................................................
);
$folderbutton->g_pack(
    -expand => "no",
    -fill   => "both",
    -side   => "left"
);

Tkx::DynamicHelp__register(
    $folderbutton,"balloon","Select the directory
         "
);

my $filebutton = $toolbar->new_ttk__button(
    -text      => "\x{e000}",
    -style     => "Toolbutton",
    -takefocus => 0,
    -command   => \&setFile,
);
................................................................................

$filebutton->g_pack(
    -expand => "no",
    -fill   => "both",
    -side   => "left"
);

Tkx::DynamicHelp__register($filebutton,"balloon","Select the file");

my $sep = $toolbar->new_ttk__separator(-orient => "vertical");
$sep->g_pack(
    -fill   => "both",
    -expand => "no",
    -side   => "top",
);
................................................................................
);
$listbox->g_pack(
    -fill   => "both",
    -expand => "yes",
    -side   => "left",
);

Tkx::tkdnd__drop___target_register($listbox,"*");
Tkx::bind($listbox,"<<Drop:DND_Files>>",
    [sub {&selectFileSystem;}, Tkx::Ev("%D")]);

my $noteframe = $textframe->new_ttk__frame;
$noteframe->g_pack(
    -fill   => "both",
    -expand => "yes",
    -side   => "right",
................................................................................
$scrollhouse->g_pack(
    -fill   => "y",
    -expand => "no",
    -side   => "right",
);

my $scrollbar = $scrollhouse->new_ttk__scrollbar(-orient => 'vertical');
$scrollbar->configure(-command => [$listbox,"yview"]);
$scrollbar->g_pack(
    -fill   => "y",
    -expand => "no",
    -side   => "right",
);

$listbox->configure(-yscrollcommand => [$scrollbar,"set"]);

#notebook components
my $extension   = $notebook->new_ttk__frame;
my $replacement = $notebook->new_ttk__frame;
my $text        = $notebook->new_ttk__frame;
my $date        = $notebook->new_ttk__frame;
my $case        = $notebook->new_ttk__frame;
................................................................................
);
my $extundo = $extension->new_ttk__button(
    -text    => "Undo",
    -command => \&undoExtension
);
my $extclear = $extension->new_ttk__button(
    -text    => "Clear",
    -command => sub {$sourceext =""; $targetext ="";}
);

our @extarray = (
    $exsrclabel, $exsrcentry, $extargetlabel, $extargetentry,
    $extchange, $extundo, $extclear
);

................................................................................
);
my $repundo = $replacement->new_ttk__button(
    -text    => "Undo",
    -command => \&undoReplaceString
);
my $repclear = $replacement->new_ttk__button(
    -text    => "Clear",
    -command => sub {$srcstring =""; $targetstring ="";},
);

our @reparray = (
    $repsrclabel, $repsrcentry, $reptargetlabel, $reptargetentry,
    $repbutton, $repundo, $repclear
);

................................................................................
  $text->new_ttk__button(-text => "Change", -command => \&addString);
my $txtundo = $text->new_ttk__button(
    -text    => "Undo",
    -command => \&undoAddString
);
my $txtclear = $text->new_ttk__button(
    -text    => "Clear",
    -command => sub {$prependstring ="";}
);

$prepend = 1;

our @txtarray = (
    $txtsrclabel, $txtsrcentry, $txtbefore, $txtafter,
    $txtbutton,   $txtundo,     $txtclear
................................................................................

my $timeentry = $attributes->new_ttk__entry(-textvariable => \$clocktime,);
my $attbutton = $attributes->new_ttk__button(
    -text    => "Change",
    -command => \&changeTime
);

our @attarray =($todaylabel, $today, $timelabel, $timeentry, $attbutton);

foreach (@attarray) {
    $_->g_pack(
        -fill   => "both",
        -expand => "no",
        -side   => "top",
    );
................................................................................
    # Tkx::catch(remove_tree("$ENV{TMP}/lib"));
    #  Tkx::catch(remove_tree("$ENV{TMP}/bin"));
    &Tkx::exit;
}

sub makeImage {

    my $data ="iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABGdBTUEAALGPC/xh
BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA
CXBIWXMAABYlAAAWJQFJUiTwAAABWWlUWHRYTUw6Y29tLmFkb2JlLnhtcAAAAAAA
PHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0iWE1Q
IENvcmUgNS40LjAiPgogICA8cmRmOlJERiB4bWxuczpyZGY9Imh0dHA6Ly93d3cu
dzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogICAgICA8cmRmOkRl
c2NyaXB0aW9uIHJkZjphYm91dD0iIgogICAgICAgICAgICB4bWxuczp0aWZmPSJo
dHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyI+CiAgICAgICAgIDx0aWZmOk9y
................................................................................
    }
}

#"about application"command
sub Tkx::tkAboutDialog {

    our $about = $mw->new_toplevel;
    Tkx::wm_title($about,"About FileMorph");

    my $aboutframe  = $about->new_frame;
    my $buttonframe = $about->new_frame;

    $aboutframe->g_pack(
        -fill   => "both",
        -expand => "yes",
................................................................................
#handle errors in Tk
sub errlog {
    my $msg = shift;
    if ($IS_AQUA) {
        system("syslog -s -l Error FileMorph: An error occurred: $msg\n");
    }
    else {
        print"An error occurred: $msg\n";
    }

}

#error message for selected file
sub fileErrMsg {

................................................................................
"Cannot run operation without text.Please enter text into the appropriate entry field to run this operation."
    );
}

#update display of files
sub updateFileDisplay {

    $listbox->delete(0,"end");
    if (scalar(@filelist) > 1) {
        @filelist = <"$folder/*">;
    }
    foreach (@filelist) {
        $listbox->insert("end","$_");
    }
}

#set search directory
sub setDir {
    $listbox->delete(0,"end");
    $folder = Tkx::tk___chooseDirectory(-parent => $mw);
    return unless $folder;
    @filelist = <"$folder/*">;
    foreach (@filelist) {
        $listbox->insert("end","$_");
    }
    return"$folder";
}

#set file to change
sub setFile {

    $listbox->delete(0,"end");
    my $filename = Tkx::tk___getOpenFile(-parent => $mw);
    return unless $filename;
    @filelist = ();
    push(@filelist, $filename);
    foreach (@filelist) {
        $listbox->insert("end","$_");
    }
    return @filelist;
}

#change all file extensions in a directory
sub changeExtension {

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($exsrcentry->get() eq""|| $extargetentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    $sourceext = $exsrcentry->get();
    $targetext = $extargetentry->get();

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($exsrcentry->get() eq""|| $extargetentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    $sourceext = $exsrcentry->get();
    $targetext = $extargetentry->get();

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($repsrcentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    $srcstring    = $repsrcentry->get();
    $targetstring = $reptargetentry->get();

    if ($reptargetentry->get() eq"") {
        my $changeQuestion;
        $changeQuestion = Tkx::tk___messageBox(
            -parent => $mw,
            -title  => "Confirm Removal of Text",
            -type   => "yesno",
            -icon   => "info",
            -message =>
              "Do you want to strip out \"$srcstring\"with no replacement?",
            -detail => "This operation cannot be undone.",
        );

        if ($changeQuestion eq"no") {
            return;
        }
    }

    foreach (@filelist) {
        next unless -f $_;
        my $filename    = $_;
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($repsrcentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    if ($reptargetentry->get() eq"") {
        my $sorryQuestion;
        $sorryQuestion = Tkx::tk___messageBox(
            -parent  => $mw,
            -title   => "Removal Operation Cannot Be Undone",
            -icon    => "info",
            -message => "You confirmed removing the string \"$srcstring.\"",
            -detail  => "This operation cannot be undone.",
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($txtsrcentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    $prependstring = $txtsrcentry->get();

    foreach (@filelist) {
................................................................................
            move $filename, $newname;
        }

        if ($prepend == 1) {
            my $filename = $_;

            my @components = split(/\./, $filename);

            my $newname =$components[0] . $prependstring ."\.". $components[1];
            move $filename, $newname;
        }
    }
    &updateFileDisplay;
}

#replace string in file name
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($txtsrcentry->get() eq"") {
        &dataErrMsg;
        return;
    }

    $prependstring = $txtsrcentry->get();

    foreach (@filelist) {
................................................................................
        -message => "Do you want to change the file modification time?",
        -detail  => "This operation cannot be undone.",
    );

    if ($changeQuestion eq "no") {
        return;
    }
    if ($changeQuestion eq"yes") {
        my @datearray  = split(/\//, $datetime);
        my @clockarray = split(/\:/, $clocktime);
        my $hour;
        my $second ="00";
        if ($timeofday == 1) {
            $hour = $clockarray[0] + 12;
        }
        else {
            $hour = $clockarray[0];
        }

................................................................................
sub validateTime {

    my $time = $timeentry->get();
    if ($time =~ (/\d\d:\d\d/)) {
        return 1;
    }
    else {
        $timeentry->delete(0,"end");

        Tkx::tk___messageBox(
            -parent  => $mw,
            -title   => "Incorrect Time Format",
            -icon    => "info",
            -message => "Incorrect Time Format",
            -detail  => "Please enter the time in HH:MM format, i.e. 12:30.",
................................................................................
}

#select directory from operations--this runs when drag and drop or from external script
sub selectFileSystem {

    my $fname = shift;
    my @name  = Tkx::SplitList($fname);
    my $path  = join"", @name;
    $folder = $path;

    if (-f $folder) {
        $listbox->delete(0,"end");
        @filelist = ();
        push(@filelist, $folder);
        foreach (@filelist) {
            $listbox->insert("end","$_");
        }
    }

    if (-d $folder) {

        $listbox->delete(0,"end");
        @filelist = <"$folder/*">;
        foreach (@filelist) {
            $listbox->insert("end","$_");
        }

        return $folder;
    }

    return $folder;
}
................................................................................
    &Tkx::machelp__userhelp;
}

#initialize the app
sub startUp {

    $appname    = 'FileMorph';
    $appversion = '2.4';
    &Tkx::machelp__setAppName($appname, $appversion);
    &Tkx::softwareupdate__setAppName($appname);
    &Tkx::softwareupdate__setVersion($appname, $appversion);

    #check for app support directory
    our $prefdir = Tkx::xplat__appconfig("FileMorph");
    mkdir $prefdir unless (-d $prefdir);
................................................................................

#check version of installed software
sub checkUpdate {

    &Tkx::softwareupdate__setIcon($icon);
    &Tkx::softwareupdate__checkingForUpdates;

    my $url    ="http://www.codebykevin.com/filemorph.ini";
    my $tmp    = new File::Temp(UNLINK => 1, SUFFIX => ".ini");
    my $parser = get($url);
    print $tmp $parser;
    close $tmp;

    my $cfg = Config::IniFiles->new(
        -file          => $tmp,
................................................................................
}

#-----AppleScript handlers------$

if ($IS_AQUA) {

    sub createAppleScriptCommands {
        Tkx::aem__installeventhandler("CoKv","fMdr", \&scriptSetDir);
        Tkx::aem__installeventhandler("CoKv","fMfl", \&scriptSetFile);
        Tkx::aem__installeventhandler("CoKv","oExt", \&scriptOldExt);
        Tkx::aem__installeventhandler("CoKv","nExt", \&scriptNewExt);
        Tkx::aem__installeventhandler("CoKv","rExt", \&scriptChangeExt);
        Tkx::aem__installeventhandler("CoKv","oTxt", \&scriptOldText);
        Tkx::aem__installeventhandler("CoKv","nTxt", \&scriptNewText);
        Tkx::aem__installeventhandler("CoKv","cTxt", \&scriptChangeText);
        Tkx::aem__installeventhandler("CoKv","beTx", \&scriptAddedText);
        Tkx::aem__installeventhandler("CoKv","afTx", \&scriptPrefixOrSuffix);
        Tkx::aem__installeventhandler("CoKv","adTx", \&scriptAddText);
        Tkx::aem__installeventhandler("CoKv","tmDa", \&scriptSetTime);
        Tkx::aem__installeventhandler("CoKv","cTme", \&scriptFileTime);
    }
}

sub scriptSetDir {
    my $path = shift;

    #join with spaces
................................................................................
    foreach (@_) {
        $path = $_ . ' ';
    }

    $folder = $path;

    if (-f $folder) {
        $listbox->delete(0,"end");
        @filelist = ();
        push(@filelist, $folder);
        foreach (@filelist) {
            $listbox->insert("end","$_");
        }
    }

    if (-d $folder) {

        $listbox->delete(0,"end");
        @filelist = <"$folder/*">;
        foreach (@filelist) {
            $listbox->insert("end","$_");
        }

        return $folder;
    }

    return $folder;
}
................................................................................
    &addString;
}

sub scriptSetTime {
    my $time;
    $time = shift;
    my @datearray = split(/\//, $time);
    $modtime =timelocal("00","00","00", $datearray[1], ($datearray[0] - 1),
        $datearray[2]);
}

sub scriptFileTime {
    return if (scalar(@filelist) == 0);
    foreach (@filelist) {
        utime $modtime, $modtime, $_;
    }
}

#------end of subroutines---------

use Env qw(HOME);
use File::Path qw(remove_tree);
use File::Copy::Recursive qw (rmove);

BEGIN {

    if ($Config{osname} eq "darwin") {
        my $frameworkpath = "$Bin/Contents/Frameworks/Tcl.framework/Tcl";
        $ENV{'PERL_TCL_DL_PATH'} = $frameworkpath;
    }
    if ($Config{osname} eq "MSWin32") {
        if (exists $ENV{PAR_PROGNAME}) {
            my $libtarget = "$ENV{TMP}/lib";
            my $libsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/lib";
            rmove($libsrc, $libtarget);
            my $bintarget = "$ENV{TMP}/bin";
            my $binsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/bin";
            rmove($binsrc, $bintarget);
        }

    }

}

#use strict;
use warnings;
use Tkx;

our $IS_AQUA    = &Tkx::tk_windowingsystem eq "aqua";
our $IS_WINDOWS = &Tkx::tk_windowingsystem eq "win32";

use File::Copy qw(move copy);
use Env qw (HOME TMP TEMP TMPDIR);
use Time::Local;
use POSIX qw( strftime );
use File::Basename qw(fileparse basename dirname);
use LWP::Simple;
use Config::IniFiles;
use File::Temp qw(tempfile);

Tkx::set('::argv0', $ARGV[0] || "");
Tkx::catch('console hide');

Tkx::package_require('tkdnd');
Tkx::package_require('Img');
Tkx::package_require('regproc');
Tkx::package_require('machelp');
Tkx::package_require('softwareupdate');
................................................................................
#initialize the app
&startUp;
&makeImage;

@filelist = ();

if ($IS_AQUA) {
    Tkx::interp_alias("", "::tk::mac::OpenDocument", "", [\&openDoc]);
    Tkx::interp_alias("", "::tk::mac::ShowHelp",     "", [\&showHelp]);
    Tkx::interp_alias("", "bgerror",                 "", [\&errlog]);
}

if ($IS_WINDOWS) {
    Tkx::package_require("twapi");
    Tkx::twapi__AddFontResourceEx('iconic_stroke.ttf');
}

#draw the GUI
our $mw = Tkx::widget->new(".");
Tkx::wm_title($mw, "FileMorph");
$mw->g_wm_withdraw;
if ($IS_WINDOWS) {
    $mw->g_wm_protocol(WM_DELETE_WINDOW => \&shutdown);
    $mw->g_wm_iconphoto(-default => $icon);
}

#menubar code
my $menubar = $mw->new_menu();
Tkx::option_add("*tearOff", 0);
our $applemenu;
if ($IS_AQUA) {
................................................................................
);
$folderbutton->g_pack(
    -expand => "no",
    -fill   => "both",
    -side   => "left"
);

Tkx::DynamicHelp__register($folderbutton, "balloon", "Select the directory");




my $filebutton = $toolbar->new_ttk__button(
    -text      => "\x{e000}",
    -style     => "Toolbutton",
    -takefocus => 0,
    -command   => \&setFile,
);
................................................................................

$filebutton->g_pack(
    -expand => "no",
    -fill   => "both",
    -side   => "left"
);

Tkx::DynamicHelp__register($filebutton, "balloon", "Select the file");

my $sep = $toolbar->new_ttk__separator(-orient => "vertical");
$sep->g_pack(
    -fill   => "both",
    -expand => "no",
    -side   => "top",
);
................................................................................
);
$listbox->g_pack(
    -fill   => "both",
    -expand => "yes",
    -side   => "left",
);

Tkx::tkdnd__drop___target_register($listbox, "*");
Tkx::bind($listbox, "<<Drop:DND_Files>>",
    [sub {&selectFileSystem;}, Tkx::Ev("%D")]);

my $noteframe = $textframe->new_ttk__frame;
$noteframe->g_pack(
    -fill   => "both",
    -expand => "yes",
    -side   => "right",
................................................................................
$scrollhouse->g_pack(
    -fill   => "y",
    -expand => "no",
    -side   => "right",
);

my $scrollbar = $scrollhouse->new_ttk__scrollbar(-orient => 'vertical');
$scrollbar->configure(-command => [$listbox, "yview"]);
$scrollbar->g_pack(
    -fill   => "y",
    -expand => "no",
    -side   => "right",
);

$listbox->configure(-yscrollcommand => [$scrollbar, "set"]);

#notebook components
my $extension   = $notebook->new_ttk__frame;
my $replacement = $notebook->new_ttk__frame;
my $text        = $notebook->new_ttk__frame;
my $date        = $notebook->new_ttk__frame;
my $case        = $notebook->new_ttk__frame;
................................................................................
);
my $extundo = $extension->new_ttk__button(
    -text    => "Undo",
    -command => \&undoExtension
);
my $extclear = $extension->new_ttk__button(
    -text    => "Clear",
    -command => sub {$sourceext = ""; $targetext = "";}
);

our @extarray = (
    $exsrclabel, $exsrcentry, $extargetlabel, $extargetentry,
    $extchange, $extundo, $extclear
);

................................................................................
);
my $repundo = $replacement->new_ttk__button(
    -text    => "Undo",
    -command => \&undoReplaceString
);
my $repclear = $replacement->new_ttk__button(
    -text    => "Clear",
    -command => sub {$srcstring = ""; $targetstring = "";},
);

our @reparray = (
    $repsrclabel, $repsrcentry, $reptargetlabel, $reptargetentry,
    $repbutton, $repundo, $repclear
);

................................................................................
  $text->new_ttk__button(-text => "Change", -command => \&addString);
my $txtundo = $text->new_ttk__button(
    -text    => "Undo",
    -command => \&undoAddString
);
my $txtclear = $text->new_ttk__button(
    -text    => "Clear",
    -command => sub {$prependstring = "";}
);

$prepend = 1;

our @txtarray = (
    $txtsrclabel, $txtsrcentry, $txtbefore, $txtafter,
    $txtbutton,   $txtundo,     $txtclear
................................................................................

my $timeentry = $attributes->new_ttk__entry(-textvariable => \$clocktime,);
my $attbutton = $attributes->new_ttk__button(
    -text    => "Change",
    -command => \&changeTime
);

our @attarray = ($todaylabel, $today, $timelabel, $timeentry, $attbutton);

foreach (@attarray) {
    $_->g_pack(
        -fill   => "both",
        -expand => "no",
        -side   => "top",
    );
................................................................................
    # Tkx::catch(remove_tree("$ENV{TMP}/lib"));
    #  Tkx::catch(remove_tree("$ENV{TMP}/bin"));
    &Tkx::exit;
}

sub makeImage {

    my $data = "iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABGdBTUEAALGPC/xh
BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA
CXBIWXMAABYlAAAWJQFJUiTwAAABWWlUWHRYTUw6Y29tLmFkb2JlLnhtcAAAAAAA
PHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0iWE1Q
IENvcmUgNS40LjAiPgogICA8cmRmOlJERiB4bWxuczpyZGY9Imh0dHA6Ly93d3cu
dzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogICAgICA8cmRmOkRl
c2NyaXB0aW9uIHJkZjphYm91dD0iIgogICAgICAgICAgICB4bWxuczp0aWZmPSJo
dHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyI+CiAgICAgICAgIDx0aWZmOk9y
................................................................................
    }
}

#"about application"command
sub Tkx::tkAboutDialog {

    our $about = $mw->new_toplevel;
    Tkx::wm_title($about, "About FileMorph");

    my $aboutframe  = $about->new_frame;
    my $buttonframe = $about->new_frame;

    $aboutframe->g_pack(
        -fill   => "both",
        -expand => "yes",
................................................................................
#handle errors in Tk
sub errlog {
    my $msg = shift;
    if ($IS_AQUA) {
        system("syslog -s -l Error FileMorph: An error occurred: $msg\n");
    }
    else {
        print "An error occurred: $msg\n";
    }

}

#error message for selected file
sub fileErrMsg {

................................................................................
"Cannot run operation without text.Please enter text into the appropriate entry field to run this operation."
    );
}

#update display of files
sub updateFileDisplay {

    $listbox->delete(0, "end");
    if (scalar(@filelist) > 1) {
        @filelist = <"$folder/*">;
    }
    foreach (@filelist) {
        $listbox->insert("end", "$_");
    }
}

#set search directory
sub setDir {
    $listbox->delete(0, "end");
    $folder = Tkx::tk___chooseDirectory(-parent => $mw);
    return unless $folder;
    @filelist = <"$folder/*">;
    foreach (@filelist) {
        $listbox->insert("end", "$_");
    }
    return "$folder";
}

#set file to change
sub setFile {

    $listbox->delete(0, "end");
    my $filename = Tkx::tk___getOpenFile(-parent => $mw);
    return unless $filename;
    @filelist = ();
    push(@filelist, $filename);
    foreach (@filelist) {
        $listbox->insert("end", "$_");
    }
    return @filelist;
}

#change all file extensions in a directory
sub changeExtension {

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($exsrcentry->get() eq "" || $extargetentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    $sourceext = $exsrcentry->get();
    $targetext = $extargetentry->get();

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($exsrcentry->get() eq "" || $extargetentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    $sourceext = $exsrcentry->get();
    $targetext = $extargetentry->get();

................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($repsrcentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    $srcstring    = $repsrcentry->get();
    $targetstring = $reptargetentry->get();

    if ($reptargetentry->get() eq "") {
        my $changeQuestion;
        $changeQuestion = Tkx::tk___messageBox(
            -parent => $mw,
            -title  => "Confirm Removal of Text",
            -type   => "yesno",
            -icon   => "info",
            -message =>
              "Do you want to strip out \"$srcstring\"with no replacement?",
            -detail => "This operation cannot be undone.",
        );

        if ($changeQuestion eq "no") {
            return;
        }
    }

    foreach (@filelist) {
        next unless -f $_;
        my $filename    = $_;
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($repsrcentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    if ($reptargetentry->get() eq "") {
        my $sorryQuestion;
        $sorryQuestion = Tkx::tk___messageBox(
            -parent  => $mw,
            -title   => "Removal Operation Cannot Be Undone",
            -icon    => "info",
            -message => "You confirmed removing the string \"$srcstring.\"",
            -detail  => "This operation cannot be undone.",
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($txtsrcentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    $prependstring = $txtsrcentry->get();

    foreach (@filelist) {
................................................................................
            move $filename, $newname;
        }

        if ($prepend == 1) {
            my $filename = $_;

            my @components = split(/\./, $filename);
            my $newname =
              $components[0] . $prependstring . "\." . $components[1];
            move $filename, $newname;
        }
    }
    &updateFileDisplay;
}

#replace string in file name
................................................................................

    if (scalar(@filelist) == 1) {

        &fileErrMsg;
        return;
    }

    if ($txtsrcentry->get() eq "") {
        &dataErrMsg;
        return;
    }

    $prependstring = $txtsrcentry->get();

    foreach (@filelist) {
................................................................................
        -message => "Do you want to change the file modification time?",
        -detail  => "This operation cannot be undone.",
    );

    if ($changeQuestion eq "no") {
        return;
    }
    if ($changeQuestion eq "yes") {
        my @datearray  = split(/\//, $datetime);
        my @clockarray = split(/\:/, $clocktime);
        my $hour;
        my $second = "00";
        if ($timeofday == 1) {
            $hour = $clockarray[0] + 12;
        }
        else {
            $hour = $clockarray[0];
        }

................................................................................
sub validateTime {

    my $time = $timeentry->get();
    if ($time =~ (/\d\d:\d\d/)) {
        return 1;
    }
    else {
        $timeentry->delete(0, "end");

        Tkx::tk___messageBox(
            -parent  => $mw,
            -title   => "Incorrect Time Format",
            -icon    => "info",
            -message => "Incorrect Time Format",
            -detail  => "Please enter the time in HH:MM format, i.e. 12:30.",
................................................................................
}

#select directory from operations--this runs when drag and drop or from external script
sub selectFileSystem {

    my $fname = shift;
    my @name  = Tkx::SplitList($fname);
    my $path  = join "", @name;
    $folder = $path;

    if (-f $folder) {
        $listbox->delete(0, "end");
        @filelist = ();
        push(@filelist, $folder);
        foreach (@filelist) {
            $listbox->insert("end", "$_");
        }
    }

    if (-d $folder) {

        $listbox->delete(0, "end");
        @filelist = <"$folder/*">;
        foreach (@filelist) {
            $listbox->insert("end", "$_");
        }

        return $folder;
    }

    return $folder;
}
................................................................................
    &Tkx::machelp__userhelp;
}

#initialize the app
sub startUp {

    $appname    = 'FileMorph';
    $appversion = '2.2';
    &Tkx::machelp__setAppName($appname, $appversion);
    &Tkx::softwareupdate__setAppName($appname);
    &Tkx::softwareupdate__setVersion($appname, $appversion);

    #check for app support directory
    our $prefdir = Tkx::xplat__appconfig("FileMorph");
    mkdir $prefdir unless (-d $prefdir);
................................................................................

#check version of installed software
sub checkUpdate {

    &Tkx::softwareupdate__setIcon($icon);
    &Tkx::softwareupdate__checkingForUpdates;

    my $url    = "http://www.codebykevin.com/filemorph.ini";
    my $tmp    = new File::Temp(UNLINK => 1, SUFFIX => ".ini");
    my $parser = get($url);
    print $tmp $parser;
    close $tmp;

    my $cfg = Config::IniFiles->new(
        -file          => $tmp,
................................................................................
}

#-----AppleScript handlers------$

if ($IS_AQUA) {

    sub createAppleScriptCommands {
        Tkx::aem__installeventhandler("CoKv", "fMdr", \&scriptSetDir);
        Tkx::aem__installeventhandler("CoKv", "fMfl", \&scriptSetFile);
        Tkx::aem__installeventhandler("CoKv", "oExt", \&scriptOldExt);
        Tkx::aem__installeventhandler("CoKv", "nExt", \&scriptNewExt);
        Tkx::aem__installeventhandler("CoKv", "rExt", \&scriptChangeExt);
        Tkx::aem__installeventhandler("CoKv", "oTxt", \&scriptOldText);
        Tkx::aem__installeventhandler("CoKv", "nTxt", \&scriptNewText);
        Tkx::aem__installeventhandler("CoKv", "cTxt", \&scriptChangeText);
        Tkx::aem__installeventhandler("CoKv", "beTx", \&scriptAddedText);
        Tkx::aem__installeventhandler("CoKv", "afTx", \&scriptPrefixOrSuffix);
        Tkx::aem__installeventhandler("CoKv", "adTx", \&scriptAddText);
        Tkx::aem__installeventhandler("CoKv", "tmDa", \&scriptSetTime);
        Tkx::aem__installeventhandler("CoKv", "cTme", \&scriptFileTime);
    }
}

sub scriptSetDir {
    my $path = shift;

    #join with spaces
................................................................................
    foreach (@_) {
        $path = $_ . ' ';
    }

    $folder = $path;

    if (-f $folder) {
        $listbox->delete(0, "end");
        @filelist = ();
        push(@filelist, $folder);
        foreach (@filelist) {
            $listbox->insert("end", "$_");
        }
    }

    if (-d $folder) {

        $listbox->delete(0, "end");
        @filelist = <"$folder/*">;
        foreach (@filelist) {
            $listbox->insert("end", "$_");
        }

        return $folder;
    }

    return $folder;
}
................................................................................
    &addString;
}

sub scriptSetTime {
    my $time;
    $time = shift;
    my @datearray = split(/\//, $time);
    $modtime =timelocal("00", "00", "00", $datearray[1], ($datearray[0] - 1),
        $datearray[2]);
}

sub scriptFileTime {
    return if (scalar(@filelist) == 0);
    foreach (@filelist) {
        utime $modtime, $modtime, $_;
    }
}

#------end of subroutines---------

Added filemorph.sed.

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

[Version]
Class=IEXPRESS
SEDVersion=3
[Options]
PackagePurpose=InstallApp
ShowInstallProgramWindow=0
HideExtractAnimation=0
UseLongFileName=1
InsideCompressed=0
CAB_FixedSize=0
CAB_ResvCodeSigning=0
RebootMode=N
InstallPrompt=%InstallPrompt%
DisplayLicense=%DisplayLicense%
FinishMessage=%FinishMessage%
TargetName=%TargetName%
FriendlyName=%FriendlyName%
AppLaunched=%AppLaunched%
PostInstallCmd=%PostInstallCmd%
AdminQuietInstCmd=%AdminQuietInstCmd%
UserQuietInstCmd=%UserQuietInstCmd%
SourceFiles=SourceFiles

[Strings]
InstallPrompt=Would you like to install FileMorph and its supporting files?
DisplayLicense=mit.txt
FinishMessage=Thank you for installing FileMorph. To run the program, please select it from the start menu.
TargetName=FileMorph_Setup.exe
FriendlyName=FileMorph_Setup
AppLaunched=cmd /c install.bat
PostInstallCmd=<None>
AdminQuietInstCmd=
UserQuietInstCmd=
FILE2="FileMorph.exe"
FILE0="uninstall.bat"
FILE1="install.bat"
[SourceFiles]
SourceFiles0=C:\Users\kevin\Desktop\filemorph
[SourceFiles0]
%FILE0%=
%FILE1%=
%FILE2%=

Added makeinstaller.bat.

>
>
>
>
>
>
>
>

iexpress /n filemorph.sed

set VERSION="2.4.0.0 (%date%)"
set FILEDESCR=/s desc "Installer for FileMorph"
set COMPINFO=/s company "WordTech Communications LLC" /s (c) "(c) 2015"
set PRODINFO=/s product "FileMorph" /pv "2.4.0.0"

"C:\Users\kevin\Desktop\verpatch.exe" /va FileMorph_Setup.exe %VERSION% %FILEDESCR% %COMPINFO% %PRODINFO%

Changes to scriptlibs/machelp/help.tcl.

	
	if {[tk windowingsystem] eq "win32"} {
	 source [file join $library win_images.tcl]
	 }
	 
	 if {[tk windowingsystem] eq "aqua"} {
	 source [file join $library images.tcl]
	 }

  	
}


#
# ::Help::AddPage -- Adds another page to the help system

	
	if {[tk windowingsystem] eq "win32"} {
	 source [file join $library win_images.tcl]
	 }
	 
	 if {[tk windowingsystem] eq "aqua"} {
	 source [file join $library images.tcl]


  	
}


#
# ::Help::AddPage -- Adds another page to the help system

Changes to scriptlibs/machelp/help.txt.

 - [Installing FileMorph]
 - [Using FileMorph]
 - [Scripting FileMorph]
 - [Window Menu]
 - [Help]
 - [Acknowledgments]
 - [FileMorph Version History]


-------------------
title: Introduction to FileMorph
alias: Introduction

FileMorph is a simple but powerful application for searching and replacing text in multiple files, quickly and easily. Using an elegant, intuitive interface, FileMorph allows you to select a directory, specify which files will be modified, enter a new filename, and see the changes instantly. 

................................................................................
 
'''1.1 (November 15, 2012):'''
 * Improved error handling. 
 * Compatibility with Mac sandboxing requirements. 

'''1.0 (August 15, 2012):''' 
 * Initial commercial release.








>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

 - [Installing FileMorph]
 - [Using FileMorph]
 - [Scripting FileMorph]
 - [Window Menu]
 - [Help]
 - [Acknowledgments]
 - [FileMorph Version History]
 - [License]

-------------------
title: Introduction to FileMorph
alias: Introduction

FileMorph is a simple but powerful application for searching and replacing text in multiple files, quickly and easily. Using an elegant, intuitive interface, FileMorph allows you to select a directory, specify which files will be modified, enter a new filename, and see the changes instantly. 

................................................................................
 
'''1.1 (November 15, 2012):'''
 * Improved error handling. 
 * Compatibility with Mac sandboxing requirements. 

'''1.0 (August 15, 2012):''' 
 * Initial commercial release. 

-------------------
title: License
alias: License
 
'''The MIT License (MIT)'''

FileMoroph source code: [http://fossil.codebykevin.com/fossil.cgi/filemorph/]

Copyright (c) 2015 WordTech Communications LLC

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.