diff options
author | toma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da> | 2009-11-25 17:56:58 +0000 |
---|---|---|
committer | toma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da> | 2009-11-25 17:56:58 +0000 |
commit | e9ae80694875f869892f13f4fcaf1170a00dea41 (patch) | |
tree | aa2f8d8a217e2d376224c8d46b7397b68d35de2d /quanta/scripts/dwt.pl | |
download | tdewebdev-e9ae80694875f869892f13f4fcaf1170a00dea41.tar.gz tdewebdev-e9ae80694875f869892f13f4fcaf1170a00dea41.zip |
Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.
BUG:215923
git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdewebdev@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da
Diffstat (limited to 'quanta/scripts/dwt.pl')
-rw-r--r-- | quanta/scripts/dwt.pl | 409 |
1 files changed, 409 insertions, 0 deletions
diff --git a/quanta/scripts/dwt.pl b/quanta/scripts/dwt.pl new file mode 100644 index 00000000..af823663 --- /dev/null +++ b/quanta/scripts/dwt.pl @@ -0,0 +1,409 @@ +#!/usr/bin/perl + +## dwt - perl script to support dreamweaver templates +## Copyright (C) 2003 Benjamin Stocker <[email protected]> +## +## 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 2 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, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## DESCRIPTION: +## This is a perl script to apply a modified Dreamweaver (DW) +## template to a file using this template. Macromedia +## Dreamweaver manages this automatically whenever you +## change a tepmplate. See DW Documentation for more infos. +## When you have a DW-Project with templates but no DW, you +## cann change templates, but this changes will not be added +## to files using the template. +## This script can solve this problem. It takes the name of a +## file as argument, scans this file for a template and adds +## all template changes to the file. +## +## Check http://sys.4s-hosting.ch/bstocker/dwt/ +## for more informations and updates. +## +## Please, let me know it this script works for you, your questions +## and comments are welcome! + +use Getopt::Std; +use IO::Dir; + +# Write debug informations to STDOUT (-d) +$DEBUG=0; +# Version +$VERSION="1.11 (06/9/2003)"; +# Display result on screen (-o); +$SCREEN=0; +# Extensions to search +$SEXT="php:php3:php4:htm:html:phtml"; +@AEXT=split(':',$SEXT); + +&CheckArguments(); + +## Check command line arguments +if ($ARGV[0] eq '') { + &Usage; +} +$PROJECTPATH=$ARGV[0]; +$PROJECTPATH=&ExpandPath($PROJECTPATH); +unless (-d $PROJECTPATH) { + print "FATAL: Cannot stat '$PROJECTPATH'. argument must be a directory\n"; + exit; +} + +&ScanDir($PROJECTPATH); + +# All done! +exit(0); + +## +## Scan all directories and files in specified path +## +sub ScanDir($) { + my $path=$_[0]; + my ($dirname,$newpath,%dhf); + tie %dhf, IO::Dir, $path; + if (defined %dhf) { + foreach $dirname(keys(%dhf)) { + if ($dirname ne '.' and $dirname ne '..') { + $newpath="$path/$dirname"; + &CheckExtension($newpath); + if (-d $newpath) { + &ScanDir($newpath); + } + } + } + } else { + die "FATAL: Cannot list $path"; + } + undef $dhf; +} + +## +## Check if extension matches +## +sub CheckExtension($) { + my $filename=$_[0]; + my $s; + foreach $s (@AEXT) { + if ($filename=~/\.$s$/i) { + &DebugMsg($filename); + &DoDWT($filename); + } + } +} + +## +## Merge template and document +## +sub DoDWT($) { + my $filename=$_[0]; + my (@v,$source,$templatesource,$templatename); + my ($p1,$p2,$region,$rbegin,$rend,$rbuf,$q1,$q2); + + # Read file into buffer + open HF, $filename or die "FATAL: Cannot open: $filename"; + @v=<HF>; $source=join("",@v); $source=&Dos2Unix($source); + close HF; + + # Extract template name from buffer + $templatename=&GetTemplateName($source); + if ($templatename eq '') { + print "NOTE: Could not extract template name from $filename\n"; + return; # function execution ends here! NW would not like that :) + } + + # Open template file + $templatename=&BuildPathName($templatename,$PROJECTPATH); + open HF, $templatename or die "FATAL: Cannot open template file: $templatename"; + @v=<HF>; $templatesource=join("",@v); + $templatesource=&Dos2Unix($templatesource); + close HF; + + # Correct links in template + $templatesource=&CorrectLinks($templatesource,$PROJECTPATH,$filename); + + # Rebuild file using template + $p1=index($templatesource,"<!-- #BeginEditable "); + while ($p1>=0) { + $p1=index($templatesource,"\"",$p1); + if ($p1>=0) { + $p1=$p1+1; + $p2=index($templatesource,"\"",$p1); + $region=substr($templatesource,$p1,$p2-$p1); + &DebugMsg("Region: $region"); + # Get region from file and paste into template + $rbegin="<!-- #BeginEditable \"$region\" -->"; + $rend="<!-- #EndEditable -->"; # 21 characters, see below! + $q1=index($source,$rbegin); + $q2=index($source,$rend,$q1); + if ($q1>=0 and $q2>=0) { + # Extract from file + $rbuf=substr($source,$q1,$q2-$q1+21); + # Paste into template + $q1=index($templatesource,$rbegin); + $q2=index($templatesource,$rend,$q1); + if ($q1>=0 and $q2>=0) { + $q2=$q2+21; + $templatesource=substr($templatesource,0,$q1).$rbuf.substr($templatesource,$q2); + } else { + print "WARNING: Could not find region '$region' in template $templatename"; + } + } else { + print "WARNING: Could not find region '$region' in $filename"; + } + } + $p1=index($templatesource,"<!-- #BeginEditable ",$p1); + } # while + + # Editable blocks inserted, now get library elements + $templatesource=&InsertLibs($templatesource, $projectpath, $filename); + + # Finally, build frame + $templatesource=&RemoveHtmlTags($templatesource); + $templatesource=&AddHtmlTags($templatesource,$source); + + # Save new file or write it to STDOUT + if (!$SCREEN) { + print "Updating $filename\n"; + open HF,">$filename" or die "FATAL: Cannot create $filename"; + print HF $templatesource; + close HF; + } else { + print $templatesource; + } +} + +## +## Extract template filename +## +sub GetTemplateName() { + my ($p1,$p2,$v); + my $source=$_[0]; + my $templatename=""; + + $p1=index($source, "<!-- #BeginTemplate "); + if ($p1>=0) { + $p1=index($source,"\"",$p1); + if ($p1>=0) { + $p1=$p1+1; + $p2=index($source,"\"",$p1); + $templatename=substr($source,$p1,$p2-$p1); + &DebugMsg("Template to be used: $templatename"); + } + } + return $templatename; +} + +## +## Add path specification to template filename, so it ca be opened +## +sub BuildPathName() { + my $templatename=$_[0]; + my $prp=$_[1]; + $templatename="$prp/$templatename"; + # Remove unneeded slashes + $templatename=~s/\/\//\//g; + return $templatename; +} + +## +## Remove header and footer from Template +## +sub RemoveHtmlTags() { + my $p1; + my $templatesource=$_[0]; + $p1=index($templatesource,"<head>"); # 6 chars + if ($p1>=0) { + $p1=$p1+6; + $templatesource=substr($templatesource,$p1); + } else { + print "WARNING: Could not find <head> tag in template $templatename"; + } + $p1=index($templatesource,"</body>"); + if ($p1>=0) { + $templatesource=substr($templatesource,0,$p1); + } else { + print "WARNING: Could not find </body> tag in template $templatename"; + } + return $templatesource; +} + +## +## Add header and footer tags from source file to template +## +sub AddHtmlTags() { + my ($p1,$hstart,$hend); + my $templatesource=$_[0]; + my $source=$_[1]; + + $p1=index($source,"<head>"); # 6 chars + if ($p1>=0) { + $p1=$p1+6; + $hstart=substr($source,0,$p1); + } else { + print "WARNING: Could not find <head> tag in $filename"; + } + $p1=index($source,"</body>"); + if ($p1>=0) { + $hend=substr($source,$p1); + } else { + print "WARNING: Could not find </body> tag in $filename"; + } + return "$hstart$templatesource$hend"; +} + +## +## Remove '\r' (DOS CRLF Format -> UNIX) +## +sub Dos2Unix() { + my $v=$_[0]; + $v=~s/\r//gm; + return $v; +} + +## +## Correct template links in new created buffer +## +sub CorrectLinks() { + my $ts=$_[0]; + my $prp=$_[1]; + my $filename=$_[2]; + my $l; + + # Remove filename + $l=rindex($filename,'/'); + $filename=substr($filename,0,$l); + # Get remaining path specification + $l=length($prp); $filename=substr($filename,$l); + $filename.='/'; $filename=~s/\/\//\//; + $ts=~s/\.\.$filename//g; + return $ts; +} + +## +## Insert library items (if any) +## +sub InsertLibs() { + my $source=$_[0]; + my $projectpath=$_[1]; + my $sourcepath=$_[2]; + my ($p1, $p2, $p3, $lib, $libpath); + + my (@alb, $lb); + + # Scan for library items + $p1=index($source,"<!-- #BeginLibraryItem "); + while ($p1>=0) { + # Found, get lib name + $p1=index($source,"\"",$p1); + if ($p1>=0) { + $p1=$p1+1; + $p2=index($source,"\"",$p1); + $lib=substr($source,$p1,$p2-$p1); + &DebugMsg("Library item: $lib"); + # Read library from disk + $libpath="$projectpath$lib"; + open LHF, $libpath or die "FATAL: Cannot read library file $libpath"; + @alb=<LHF>; + $lb=join("", @alb); + $lb=&Dos2Unix($lb); + $lb=&CorrectLinks($lb, $projectpath, $sourcepath); + close LHF; + # Replace item + $p2=index($source, "-->", $p2); + if ($p2>=0) { + $p2=$p2+3; + $p3=index($source, "<!-- #EndLibraryItem -->", $p2); + if ($p3>=0) { + # Build the updated document + $source=substr($source, 0, $p2) . $lb . substr($source, $p3); + } else { + print "WARNING: End tag for library $lib not found "; + } + } else { + print "WARNING: Error in library tag $lib. Please correcet markup"; + } + } + $p1=index($source,"<!-- #BeginLibraryItem ", $p1); + } + return $source; +} + +sub DebugMsg($) { + print "# $_[0]\n" if ($DEBUG); +} + +## +## Show a small help screen +## +sub Usage() { + print "Usage: dwt.pl [-dov -e extensions] projectpath\n"; + print " -d Show debug messages\n"; + print " -o Show result but do not save it to file\n"; + print " -v Show version\n"; + print " -e Set extensions to search for (default: $SEXT)\n"; + exit; +} + +## +## Show version +## +sub Version() { + print "this is dwt $VERSION\n"; + exit; +} + +## +## Check command line arguments +## +sub CheckArguments() { + my (%args, $s); + + &getopt('e',\%args); + foreach $s (keys(%args)) { + if ($s eq 'o') { + $SCREEN=1; + } elsif ($s eq 'd') { + $DEBUG=1; + } elsif ($s eq 'v') { + &Version(); + } elsif ($s eq 'e') { + @AEXT=split(':',$args{$s}); + } else { + print "Unknown option: -$s\n"; + &Usage(); + } + } +} + +## +## Convert relative to absolute path +## +sub ExpandPath($) { + my $filename=$_[0]; + my $pwd=$ENV{PWD}; + # Convert filename to full pathname. Maybe there is a better way to do that? + # Could not find answer how to expand filename to full path at comp.lang.perl.* + if (substr($filename,0,1) ne '/') { + $filename="$pwd/$filename"; + $filename=~s/\/[a-zA-Z0-9]+?\/\.\.\//\//; # Remove ' xxx/../ ' + $filename=~s/\/\//\//g; # Remove ' // ' + $filename=~s/\/\.//g; # Remove ' ./ ' + } + $filename=~s/\/$//; + return $filename; +} + +# EOF + |