Most of what I do professionally involves writing Windows apps in Powerbuilder. Powerbuilder has a lot of things going for it in some respects (especially when dealing with databases, especially when compared to Visual Basic), but application deployment is not one of them.

We recently changed the way we deploy our applications, creating a full build monthly and patch versions as needed in the interim. Patches, however, are problematic. Powerbuilder creates it's own little proprietary DLL-like files called PBDs in whatever directory the source file it is generated from is located. For large projects like ours, hunting down all the changed PBDs, zipping them up, and moving them to the network gets to be rather time consuming.

This little app allows our compile guy to select the system he's working on. It brings up a list of all the PBDs in the project. He selects the ones that have changed, changes the version number (if necessary - the app does it's best to get the next one), clicks deploy, and that's when the magic starts. A new folder on the network is created, ALL of the source code for the app gets archived, and then a second zip containing only the files to be deployed is created. Each app has a file called libs.txt in it's root directory that has a list of all the files that comprise the app.

I'm reasonably happy with this. There's no real security though as it only runs on the compiler machine. At some point in the future I would like to replace my kludgy INI file with an XML config file (problem is I don't know jack about XML). I would also like to make the zip self-extracting (I know how using Archive::Zip, but our client sites do not have Perl installations, so I will need to call the WinZip self-extractor), as well as automatically FTPing the release to our update site. I might even have it automatically e-mail our clients informing them of the update.

Anyhow, without further ado, the code:

#!perl

use strict;
use warnings;
use CGI;
use Archive::Zip;
use File::Slurp;
use File::Copy;                                         

# Debugging info
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');

# Get our configuration
my %config = read_ini("AppDeployment.ini");

# Create CGI objects and variables
my $request = new CGI;

# Get parameters
my $action = $request->param("action");
my $system = $request->param("apps");
my $version = $request->param("version");
my @pbds = $request->param("pbds");

# Validate parameters
if(!defined($action)) { $action = "Select"; }

# Print the page header
#print $request->header();
my $JAVASCRIPT=<<END;
function SelectAll()
{
    for (var i=0;i<document.deploy.elements.length;i++) {
        var e = document.deploy.elements[i];
            if (e.name == 'pbds') {
                e.checked = true;
                }
    }
}
function DeselectAll()
{
    for (var i=0;i<document.deploy.elements.length;i++) {
        var e = document.deploy.elements[i];
            if (e.name == 'pbds') {
                e.checked = false;
                }
    }
}
END
print $request->start_html(-title=>"DEVNET, Inc. AppDeployment Agent",
                           -script=>$JAVASCRIPT);

# Take action based upon user's selection
if($action eq "Select")
{
  print $request->startform(-name=>"deploy",
                            -method=>"POST",
                            -action=>"AppDeployment.pl",
                -enctype=>"application/x-www-form-urlencoded");

  # Parse the list of applications
  my $apps = $config{SYSTEMS};
  my @apps;
  push @apps, split(",",$apps);

  # Prompt user for selection of system
  print $request->h3("Select a System:");
  print $request->radio_group(-name=>'apps',
                              -values=>\@apps,
                              -linebreak=>'true');
  print $request->p();
  print $request->submit(-name=>'action',
                         -value=>'Select');
  print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\n";
  print $request->defaults("Reset");

  # If we previously selected a system, show the list of PBDs
  if($system ne "")
  {
    my $path = "$config{LOCAL_PATH}$system\\libs.txt";
    my %library_list = read_libs($path);

    # Increment version
    $version = $config{$system};
    my($major, $minor, $micro) = split(/\./,$version,3);
    ++$micro;
    $version = sprintf("%d.%d.%d",$major,$minor,$micro);
    $config{$system}=$version;

    # Prompt user for selection
    print $request->p();
    print $request->h3("Select PBDs to Zip:");

    # Give user a list of PBDs to selelct
    my @libs = sort keys %library_list;
    print $request->checkbox_group(-name=>'pbds',
                                   -values=>\@libs,
                                   -linebreak=>'true');

    print $request->p();
    print $request->button(-name=>'select_all',
              -value=>'Select All',
              -onClick=>"javascript:SelectAll(); return false;");
    print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\n";
    print $request->button(-name=>'deselect_all',
              -value=>'Deselect All',
              -onClick=>"javascript:DeselectAll(); return false;");
    print $request->p();
    print "Version \n";
    print $request->textfield(-name=>'version',
                              -default=>$version,
                              -size=>10,
                              -maxlength=>10);
    print $request->p();
    print $request->submit(-name=>'action',
                           -value=>'Deploy');
    print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\n";
    print $request->reset;
  }

  print $request->endform();
}
elsif($action eq "Deploy")
{
  my (undef,undef,undef,$mday,$mon,$year) = localtime(time);
  my $date = sprintf("%02d-%02d-%02d",$mon,$mday,$year + 1900);
  my $path = "$config{LOCAL_PATH}$system\\libs.txt";
  my $base = "$config{ZIP_PATH}$system $version $date";
  my %library_list = read_libs($path);
  my $zip;
  my $zip_name = "$base\\$system $version $date-patch.zip";
  my $source_name = "$base\\$system $version $date-source.zip";

  # Make a new directory to put this in
  mkdir "$base", 0777 or die "Could not create directory $base.\n";

  # Save off the changes.txt for this build.
  copy("$config{LOCAL_PATH}$system\\changes.txt",$base) or warn "Could
+ not copy changes.txt.\n";

  # Archive all source used to make the build
  $zip = Archive::Zip->new();
  foreach (sort keys %library_list)
  {
    my $file = $library_list{$_};
    $file =~ s/\.pbd/\.pbl/i; # Swap PBD for PBL in the library list
    $zip->addFile($file) or warn "Can't add file $file to source zip.\
+n";
  }

  # Save the PBR too, and save the zip
  $zip->addFile("$config{LOCAL_PATH}$system\\$system.pbr") or warn "Ca
+n't add file $system.pbr to source zip.\n";
  $zip->writeToFileNamed($source_name);

  # Archive the PBDs that go into the patch
  $zip = Archive::Zip->new();
  foreach (@pbds)
  {
    my $file = $library_list{$_};
    $zip->addFile($file) or warn "Can't add file $file to deployment z
+ip.\n";
  }

  # Get the EXE too!
  $zip->addFile("$config{LOCAL_PATH}$system\\$system.exe");
  $zip->writeToFileNamed($zip_name);

  # Update the INI
  write_ini("AppDeployment.ini");
  
  # Give some feedback
  print $request->h3("Success!");
  print "Successfully built deployment package $zip_name.\n";
  print $request->p();
}

# All done!  Print the page and get out.
print $request->end_html();
exit;

sub read_ini
{
  my @local_ini = read_file(shift);
  my ($key,$value);
  my %config;

  foreach(@local_ini)
  {
    chomp;

    # We should have a usable value now, add it to the hash
    ($key,$value) = split("=",$_);
    next unless $value;
    $config{$key} = $value;
  }

  # Give configuration back to caller
  return %config;
}

sub write_ini
{
  my $ini = shift;
  open INI, ">$ini" or die "Could not open configuration file for writ
+ing.\n";
  foreach(sort keys %config)
  {
    print INI "$_=$config{$_}\n";
  }
  close INI;
}

sub read_libs
{
  my @libs = read_file(shift);
  my %library_list;

  # Strip path info for each PBL
  foreach(@libs)
  {
    chomp;
    next if /^\s*$/;

    s/;//;
    s/\.pbl/\.pbd/i; # Swap PBL for PBD in the library list
    my $dir = $_;
    my $pbl = $& if (/([\w\.\&])+$/);
    $pbl =~ s/$&/\L$&/;
    $library_list{$pbl} = $dir;
  }

  return %library_list;
}
[download]

The INI looks something like this:

Assessor=1.5.499
LOCAL_PATH=d:\pb8\
SYSTEMS=Assessor,Treasurer
Treasurer=1.5.200
ZIP_PATH=p:\
[download]

Any suggestions or improvements always welcome :)

MrCromeDome